How to select p terms with powers larger than 1 in a given expression?

My expression is:

$ expr = \frac{p^{\frac{1}{3}} q + 5}{3q^2} + p^2 + (p -1)^{\frac{1}{3}}$

And I want to single out all terms with $ p^k, k > 1$

How should I do that? (If there is any way other than applying Series[] would be the best, since I want it to be less time-consuming when dealing with large expr.)

System`Private`*Entry* and *Valid*, or: How does Mathematica know which expression is which?


Goal

The answers to this question are intended to be a place to describe the behavior and mechanism of the undocumented functions of the form System`Private`*Entry* and System`Private`*Valid* (and any related functions). This is in somewhat the same style as the Language`* documentation project, but much more tightly focused, and maybe without the need to document each function individually (as many seem closely related).

I’m looking for detailed insight into what’s happening internally, as opposed to simply how I might use such functions in an "engineering" way.

Rough Overview

The *Entry* functions are used to change (and detect) the way Mathematica traverses an expression, but not an expression "in the abstract" as we’re used to it—an actual, specific instance of an expression in memory(?). Not all a[1]‘s are the same!

The Valid functions can be used to set an internal flag on the same (and read it).

Are there other functions which ought to be included in this which also modify specific instances of data, or perhaps set different flags other than Valid?

If anyone wants to just contribute bits and pieces of knowledge, that’s also welcome! I’ll try to compile any such contributions in a CW and include anything I find out personally.


Motivation

System`Private`SetNoEntry

SetNoEntry lets us declare a specific instance of a Mathematica expression as atomic (AtomQ), and so prevents Mathematica from "entering" the expression somehow (e.g. for part extraction). I was reading this answer by Leonid Shifrin, and this comprehensive answer by Mr. Wizard, and started wondering if there are any systematic rules that tell us when Mathematica considers an expression "the same" internally.

Consider

t1 = a[1] t2 = t1 t3 = (# &)[t1] Block[{a}, t4 = t1] t5 = ReplacePart[t1, 1 -> 1] t6 = MapAt[Identity, t1, 1]  System`Private`SetNoEntry[t1];  AtomQ /@ {t1, t2, t3, t4, t5, t6, a[1]}  (* Out: {True, True, True, True, True, False, False} *) 

All of these successfully refer to "the" a[1] in t1‘s OwnValues, except for a different instance of a[1], and one that’s been altered by an evaluation. A close look at the evaluation of ReplacePart shows us that it (apparently) determined that the first part of a[1] was already 1, and didn’t re-evaluate a[1]; so, it "didn’t change". (A chained, nontrivial ReplacePart[ReplacePart[t1, 1 -> 0], 1 -> 1] does indeed change the expression identity, so this isn’t intrinsic to ReplacePart.)

So, any complete-enough documentation of the behavior of these functions should be able to at least suggest how to approach the following: how do we check if two expressions are strictly the same internally or not? (Note that SameQ[t1, a[1]] gives True.)

In the same spirit, it seems that t1‘s ownvalues refer to some specific expression in memory, as opposed to simply being a rule that reconstructs an expression. This forces us to expand the "everything is an expression" abstraction a little bit, and makes us ask: when is it detectable that we’re making a reference to a specific data structure in memory? How and when does Mathematica pin down certain expressions in memory, and when are we acting "in place" as opposed to making a copy?

System`Private`SetValid

A partial solution for how to check if two expressions are "really" the same is given in this answer by b3m2a1: set a System`Private`SetValid flag, and see when it disappears.

Note that these flags seem impervious to Block, suggesting, at the very least, that this flag is not among the dynamic properties typically attachable to a symbol:

Block[{s}, System`Private`SetValid[s]]; System`Private`ValidQ[s] (* Out: True *) 

One would need to manually extract the state of each of the two expressions under the ValidQ functions, clear them both, set the flag of one of them, see if the other has it too, then restore the original Valid states. This seems doable, if a little tedious—but is there a better way, which somehow accesses the "identity" of the expression, and provides some insight on what’s going on where?


Function list

Here’s a list of all such functions. Many might be essentially redundant (easily explained based on the behavior of another), but here they all are anyway.

Note: except for System`Private`ValidMeijerGQ, which seems unrelated.

System`Private`*Entry*

  • System`Private`SetNoEntry
  • System`Private`EntryQ
  • System`Private`NoEntryQ
  • System`Private`HoldSetNoEntry
  • System`Private`HoldEntryQ
  • System`Private`HoldNoEntryQ
  • System`Private`ConstructNoEntry

System`Private`*Valid*

  • System`Private`SetValid
  • System`Private`ValidQ
  • System`Private`NotValidQ
  • System`Private`HoldSetValid
  • System`Private`HoldValidQ
  • System`Private`HoldNotValidQ

The functions here of the form System`Private`*Hold* might well be the same as the ones without Hold in the name, except for the HoldAllComplete attribute, and might just perform the relevant {action on/assignment of flags to} a held argument instead of a fully-evaluated argument. So, they might not need any special treatment or documentation.

Likewise, the *Q functions might be straightforward given other info, but it could be a good chance to document under what circumstances they will evaluate to True.

Conversion to expression in base 17 with particular needs

So, I am trying to write a function that takes a number between 0 and 1 in base 10 as input and gives a list of its decimal figures in it’s expression in base 17. For example, $ f(0.5)= \lbrace 8,8,8,8,8,\ldots\rbrace$ . My function in particular needs to provide the output in a certain manner. For instance, $ f(1/17)=\lbrace 0,16,16,16,16,\ldots\rbrace$ BUT $ f(2/17)=\lbrace 2,0,0,\ldots\rbrace$ .

The function I have writen so far is as follows:

Base17[t_] := Block[{digitsandexponent, listofdigits, n, m},   digitsandexponent = RealDigits[N[t], 17];   listofdigits = digitsandexponent[[1]];   m = digitsandexponent[[2]];   n = 0;   If[m > n,    (*the only considered case in which this could happen is if t=1*)    listofdigits = {16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16},        (*if it's not one, add the decimal 0's to the front*)    While[n < -m,     PrependTo[listofdigits, 0];     n = n + 1]    ];      If[AnyTrue[listofdigits, OddQ],     If[Length[Position[listofdigits, _Integer?OddQ]] > 1,     (*if there's more than one odd number, do nothing*)      listofdigits = listofdigits,               (*if there's exactly one odd number and after that it is all \ 16's, add one to the odd number and turn the 16's into 0's*)     If[listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] +            1 ;;  ]] ==        Table[16, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,          Length[listofdigits]}],      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 1 ;;           Length[listofdigits]]] =        Table[0, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,          Length[listofdigits]}];      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] =        listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] +         1];               (*if there's exactly one odd number and after that it is all 0's,      substract one to the odd number and turn the 0's into 16's*)     If[listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] +            1 ;; Length[listofdigits]]] ==        Table[0, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,          Length[listofdigits]}],      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]] + 1 ;;           Length[listofdigits]]] =        Table[16, {i, Position[listofdigits, _Integer?OddQ][[1, 1]] + 1,          Length[listofdigits]}];      listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] =        listofdigits[[Position[listofdigits, _Integer?OddQ][[1, 1]]]] -         1];     ]    ];      Return[listofdigits]   ]  

In general it works well, but it returns some errors. For example, for $ t=22718/1419857$ , it produces good output but with the next errors:

Part::partw: Part 1 of {} does not exist.  Part::span: 1+{}[[1,1]];;14 is not a valid Span specification. A Span specification should be 1, 2, or 3 machine-sized integers separated by ;;. (Any of the integers can be omitted or replaced with All.)  Part::partw: Part 1 of {} does not exist.  Table::iterb: Iterator {i,1+{}[[1,1]],14} does not have appropriate bounds.  Table::iterb: Iterator {i,1+{}[[1,1]],14} does not have appropriate bounds. 

However, for $ t=22717/1419857$ it produces no errors.

Does anyone have any idea why this happens? Thank you for your time!

enter image description here

Solving generating conditional expression despite assumptions

Solve[(-f0 \[Pi]^2 wi^4 + \[Pi]^2 wi^4 z + f0^2 z \[Lambda]^2)/(    f0 wi Sqrt[((z^2 + (\[Pi]^2 wi^4 (f0 - z)^2)/(        f0^2 \[Lambda]^2)) \[Lambda]^2)/wi^2]) == 0 && z > 0 &&    wi > 0 && f0 > 0, z, Reals] 

This returns a conditional expression with the same assumptions that I have provided:

{{z -> ConditionalExpression[(     f0 \[Pi]^2 wi^4)/(\[Pi]^2 wi^4 + f0^2 \[Lambda]^2),      wi > 0 && f0 > 0]}} 

I know that I can simplify my conditional expression using some assumptions to get rid of this conditional expression wrapper, but this feels inelegant to me because it’s not seeing the assumptions that I gave it in Solve[].

How do I get Mathematica to recognize the assumptions I gave it in Solve[]?

“Total” function for a Boolean expression

I have a very long vector of the form

{a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4,      a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4,      a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4, ...} 

(here I just repeated the elements for simplicity, but in general, each element is different). And I want to transform it into a Boolean expression where Plus->Or and Times->And.

What is the fastest way to do it? At the moment, I use Replace, but it’s really slow when the expression is bigger. Here the simpler example takes 0.000034 seconds:

RepeatedTiming[{a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4,             a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4,             a1 a2 a3 a4 + b1 b2 b3 b4 + c1 c2 c3 c4 + d1 d2 d3 d4 + e1 e2 e3 e4} /. {Times -> And} /. {Plus -> Or}] 

Also, is there an equivalent of the Total function for Boolean expressions?

How to evaluate a binary expression tree in hlsl without recursion or a stack

I’m currently working on a dual contouring implementation for which I want to create procedural terrain based on layers of noise. Both, the terrain generation and the mesh creation via dual contouring run on the GPU in compute shaders.

For configurating the terrain generation I previously changed the specific compute shader’s source code itself to generate different layers of FBM noise and combine them with various CSG operations (e.g. union, intersection, difference) to arrive at the final terrain. But this offers very little flexibility, e.g. I cannot change the terrain generation at runtime.

So in order to get more flexiblity for configuring the terrain generation, I’ve started implementing a graph tool (similiar to ShaderLab) using XNode: enter image description here Red (leaf) nodes are operands, grey (internal) nodes are operators (either binary or unary) and the green (root) node is simple the output node. On the GPU side each operator (internal node) equals a function, e.g. a function that creates the output of the noise node.

The idea is that I can visually create a binary expression tree (with additional unary operators), upload it to the GPU using a StructuredBuffer<NoiseGraphNode> where NoiseGraphNode is

struct NoiseGraphNode {     uint leftNodeIndex;     uint rightNodeIndex;     uint nodeType;     uint dataIndex;         // Index used in conjunction with nodeType                              // to access a node's data located in a                              // nodeType-specific StructuredBuffer, e.g.                              // the noise parameters in case of a noise node. }; 

and have that graph evaluated by the GPU’s compute shader for generating the noise that represents the final terrain. Normally such a graph would be evaluated using a recursive approach, something like:

evaluate(node) {      if(node has children){           left_val = evaluate(node->left);           right_val = evaluate(node->right);            // find operation symbol for node and use it as           // val = left_val operation right_val            return val;      }      else {           return node_value;      } } 

Pseudo-code taken from https://stackoverflow.com/questions/10769174/evaluating-expression-trees.

HLSL doesn’t support recursion though! Another way would be to emulate the recursive implementation using a stack and a while loop (after all recursion is leveraging the call stack). But creating a stack structure in HLSL like so

struct NoiseGraphStack {     uint buffer[20];     uint count;      void Push(uint number)     {         buffer[count++] = number;   // Doesn't work because an array reference                                      // cannot be used as an l-value.     }      float Pop()     {         return buffer[--count];     }      static NoiseGraphStack Create()     {         NoiseGraphStack stack;         stack.count = 0;          return stack;     } }; 

doesn’t work either because it requires the while loop to be unrolled which isn’t possible.

Note: The exact error message referred to in the code above is "array reference cannot be used as an l-value; not natively addressable, forcing loop to unroll."

So is it possible to evaluate a binary expression tree without recursion or a stack? Can I perhaps somehow preprocess the necessary steps for evaluating such a tree on the CPU (where I can use recursion just fine) first and linearize them before I send them to the GPU?

How to minimize that expression in four variables?

I mean $ \sqrt{w^2+(21-x)^2}+\sqrt{(20-w)^2+z^2}+\sqrt{x^2+(20-y)^2}+\sqrt{y^2+(21-z)^2}.$

The command

Minimize[Sqrt[x^2 + (20 - y)^2] + Sqrt[y^2 + (21 - z)^2] +  Sqrt[z^2 + (20 - w)^2] + Sqrt[w^2 + (21 - x)^2], {x, y, z, w}] 

is running without any response on my comp for hours. The numerical optimizations

NMinimize[ Sqrt[x^2 + (20 - y)^2] + Sqrt[y^2 + (21 - z)^2] +  Sqrt[z^2 + (20 - w)^2] + Sqrt[w^2 + (21 - x)^2], {x, y, z, w},  Method -> "DifferentialEvolution"] 

{58., {x -> 11.579, y -> 8.97237, z -> 11.579, w -> 8.97237}

and the same with Method->"RandomSearch"

{58., {x -> 10.5551, y -> 9.94753, z -> 10.5551, w -> 9.94753}}

and the same with Method->"NelderMead"

{58., {x -> 18.3218, y -> 2.55062, z -> 18.3218, w -> 2.55062}}

suggest the optimal value under consideration is taken in many points.

ND gives expression instead of number

I have a function sol defined as a solution to an equation (computed numerically). Specifically

sol[p_, a_] := NSolve[g[p, x, a] == 0, x, Reals][[1, 1, 2]] 

Trying it out

sol[.2, .51] sol[.2, .52] sol[.2, .53] 

gives .51, .52, .53 — on this range it behaves like identity. Now I try

ND[sol[.2, aa], aa, .51 ] 

and instead of giving me 1 as I would expect, it gives me very long expression involving variable x. I am not using the variable aa anywhere else in the code. And yes, I have done Needs["NumericalCalculus`"].

How is this possible? It seems obvious to me that it has to return a number! How can it return anything else?


Edit: here is the whole code (I have simplified it a little bit)

Needs["NumericalCalculus`"] g[  x_, a_] = D[RealAbs[1 - x]^1.2 + RealAbs[a - x]^1.2, x]; sol[a_] := NSolve[g[ x, a] == 0, x, Reals][[1, 1, 2]]; ND[sol[aa], aa, .55]