How do you interpret negative levels in Mathematica? - wolfram-mathematica

I am trying to gain a deeper understanding of how Mathematica expressions are represented internally, and am puzzled by the logic of the Level command in Mathematica. If we have the following input:
In[1]:= a = z*Sin[x + y] + z1*Cos[x1 + y1]
Out[1]= z1 Cos[x1 + y1] + z Sin[x + y]
In[2]:= FullForm[a]
Out[2]= Plus[Times[z1,Cos[Plus[x1,y1]]],Times[z,Sin[Plus[x,y]]]]
In[3]:= TreeForm[a]
We get the following tree:
If we ask Mathematica to return Level 4 only, we get:
In[4]:= Level[a,{4}]
Out[4]= {x1,y1,x,y}
I understand that we are 4 levels down from the "stem" (the Plus operator at Level 0). In fact, I think I understand that positive indexes are always in relation to the stem position of the tree. (I hope I'm correct about that??)
In contrast, when you ask for a negative level, there is no common reference point (like the stem above), because different branches of the tree are of varying lengths. So, if you ask Mathematica to provide only Level -1, we get:
In[6]:= Level[a,{-1}]
Out[6]= {z1,x1,y1,z,x,y}
I was surprised by this output, when I had guessed that I should get back {x1, y1, x, y} (without z1 & z). But ok, if I try to understand this, I take -1 to mean "the end of each branch". If this is so, then I would expect Level[a,{-2}] to return:
{z1*Cos[x1+y1],z*Sin[x+y],x1+y1,x+y}
But, this is not what I get back, Mathematica yields:
In[8]:= Level[a,{-2}]
Out[8]= {x1+y1,x+y}
So, now I am confused, and don't see a consistent way of understanding the output of negative levels.
Is there a consistent, easier way of understanding this topic? Is there a certain "correct" way I should be reading the structure of the tree?
Sorry for the "long-winded question", but I hope you understand what I am asking.

If you look at the docs, they say:
A negative level -n consists of all parts of expr with depth n.
So negative levels are not counted from a reference point, but are defined based on the depth of subexpressions. z1*Cos[x1+y1] is of depth 4, so it's not returned when you ask for Level[..., {-2}].

Related

How to store punch of equations / constants to solve for any element equation or numerical value

Lets say, that problems are fairly simple - something, that pre-degree theoretical physics student would solve. And student does the hardest part of the task - functional reading: parsing linguistically free form text, to get input and output variables and input variable values.
For example: a problem about kinematic equations, where there are variables {a,d,t,va,vf} and few functions that describe, how thy are dependent of each-other. So using skills acquired in playing fitting blocks where thy fit, you play with the equations to get the output variable you where looking for.
In any case, there are exactly 2 possible outputs you might want and thy are (with working example):
1) Equation for that variable
Physics[have_, find_] := Solve[Flatten[{
d == vf * t - (a * t^2) /2, (* etc. *)
have }], find]
Physics[True, {d}]
{{d -> (1/2)*(2*t*vf - a*t^2)}}
2) Exact or general numerical value for that variable
Physics[have_, find_] := Solve[Flatten[{
d == vf * t - (a * t^2) /2, (* etc. *)
have }], find]
Physics[{t == 9.7, vf == -104.98, a == -9.8}, {d}]
{{d->-557.265}}
I am not sure, that I am approaching the problem correctly.
I think that I would probably prefer an approach like
In[1]:= Physics[find_, have_:{}] := Solve[
{d == vf*t - (a*t^2)/2 (* , etc *)} /. have, find]
In[2]:= Physics[d]
Out[2]= {{d -> 1/2 (-a t^2 + 2 t vf)}}
In[2]:= Physics[d, {t -> 9.7, vf -> -104.98, a -> -9.8}]
Out[2]= {{d -> -557.265}}
Where the have variables are given as a list of replacement rules.
As an aside, in these types of physics problems, a nice thing to do is define your physical constants like
N[g] = -9.8;
which produces a NValues for g. Then
N[tf] = 9.7;N[vf] = -104.98;
Physics[d, {t -> tf, vf -> vf, a -> g}]
%//N
produces
{{d->1/2 (-g tf^2+2 tf vf)}}
{{d->-557.265}}
Let me show some advanges of Simon's approach:
You are at least approaching this problem reasonably. I see a fine general purpose function and I see you're getting results, which is what matters primarily. There is no 'correct' solution, since there might be a large range of acceptable solutions. In some scenario's some solutions may be preferred over others, for instance because of performance, while that might be the other way around in other scenarios.
The only slight problem I have with your example is the dubious parametername 'have'.
Why do you think this would be a wrong approach?

Mathematica: reconstruct an arbitrary nested list after Flatten

What is the simplest way to map an arbitrarily funky nested list expr to a function unflatten so that expr==unflatten##Flatten#expr?
Motivation:
Compile can only handle full arrays (something I just learned -- but not from the error message), so the idea is to use unflatten together with a compiled version of the flattened expression:
fPrivate=Compile[{x,y},Evaluate#Flatten#expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten##fPrivate[x,y]
Example of a solution to a less general problem:
What I actually need to do is to calculate all the derivatives for a given multivariate function up to some order. For this case, I hack my way along like so:
expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}];
unflatten=Module[{f,x,y,a,b,sslot,tt},
tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /.
{Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]};
(Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&,
Flatten[tt]]/. sslot-> Slot]&) ]
Out[1]= {x^2 y + y^3, {2 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
This works, but it is neither elegant nor general.
Edit: Here is the "job security" version of the solution provided by aaz:
makeUnflatten[expr_List]:=Module[{i=1},
Function#Evaluate#ReplaceAll[
If[ListQ[#1],Map[#0,#1],i++]&#expr,
i_Integer-> Slot[i]]]
It works a charm:
In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&
You obviously need to save some information about list structure, because Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].
If ArrayQ[expr], then the list structure is given by Dimensions[expr] and you can reconstruct it with Partition. E.g.
expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]
{2,3}
unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten # Flatten[expr]
(The Partition man page actually has a similar example called unflatten.)
If expr is not an array, you can try this:
expr = {a, {b, c}};
indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& #expr]
{1, {2, 3}}
slots = indexes /. {i_Integer -> Slot[i]}
{#1, {#2, #3}}
unflatten = Function[Release[slots]]
{#1, {#2, #3}} &
expr == unflatten ## Flatten[expr]
I am not sure what you are trying to do with Compile. It is used when you want to evaluate procedural or functional expressions very quickly on numerical values, so I don't think it is going to help here. If repeated calculations of D[f,...] are impeding your performance, you can precompute and store them with something like
Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];
Then just call d[k] to get the kth derivative.
I just wanted to update the excellent solutions by aaz and Janus. It seems that, at least in Mathematica 9.0.1.0 on Mac OSX, the assignment (see aaz's solution)
{i_Integer -> Slot[i]}
fails. If, however, we use
{i_Integer :> Slot[i]}
instead, we succeed. The same holds, of course, for the ReplaceAll call in Janus's "job security" version.
For good measure, I include my own function.
unflatten[ex_List, exOriginal_List] :=
Module[
{indexes, slots, unflat},
indexes =
Module[
{i = 0},
If[ListQ[#1], Map[#0, #1], ++i] &#exOriginal
];
slots = indexes /. {i_Integer :> Slot[i]};
unflat = Function[Release[slots]];
unflat ## ex
];
(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &
It might seem a little like a cheat to use the original expression in the function, but as aaz points out, we need some information from the original expression. While you don't need it all, in order to have a single function that can unflatten, all is necessary.
My application is similar to Janus's: I am parallelizing calls to Simplify for a tensor. Using ParallelTable I can significantly improve performance, but I wreck the tensor structure in the process. This gives me a quick way to reconstruct my original tensor, simplified.

Problem performing a substitution in a multiple derivative

I have a basic problem in Mathematica which has puzzled me for a while. I want to take the m'th derivative of x*Exp[t*x], then evaluate this at x=0. But the following does not work correct. Please share your thoughts.
D[x*Exp[t*x], {x, m}] /. x -> 0
Also what does the error mean
General::ivar: 0 is not a valid variable.
Edit: my previous example (D[Exp[t*x], {x, m}] /. x -> 0) was trivial. So I made it harder. :)
My question is: how to force it to do the derivative evaluation first, then do substitution.
As pointed out by others, (in general) Mathematica does not know how to take the derivative an arbitrary number of times, even if you specify that number is a positive integer.
This means that the D[expr,{x,m}] command remains unevaluated and then when you set x->0, it's now trying to take the derivative with respect to a constant, which yields the error message.
In general, what you want is the m'th derivative of the function evaluated at zero.
This can be written as
Derivative[m][Function[x,x Exp[t x]]][0]
or
Derivative[m][# Exp[t #]&][0]
You then get the table of coefficients
In[2]:= Table[%, {m, 1, 10}]
Out[2]= {1, 2 t, 3 t^2, 4 t^3, 5 t^4, 6 t^5, 7 t^6, 8 t^7, 9 t^8, 10 t^9}
But a little more thought shows that you really just want the m'th term in the series, so SeriesCoefficient does what you want:
In[3]:= SeriesCoefficient[x*Exp[t*x], {x, 0, m}]
Out[3]= Piecewise[{{t^(-1 + m)/(-1 + m)!, m >= 1}}, 0]
The final output is the general form of the m'th derivative. The PieceWise is not really necessary, since the expression actually holds for all non-negative integers.
Thanks to your update, it's clear what's happening here. Mathematica doesn't actually calculate the derivative; you then replace x with 0, and it ends up looking at this:
D[Exp[t*0],{0,m}]
which obviously is going to run into problems, since 0 isn't a variable.
I'll assume that you want the mth partial derivative of that function w.r.t. x. The t variable suggests that it might be a second independent variable.
It's easy enough to do without Mathematica: D[Exp[t*x], {x, m}] = t^m Exp[t*x]
And if you evaluate the limit as x approaches zero, you get t^m, since lim(Exp[t*x]) = 1. Right?
Update: Let's try it for x*exp(t*x)
the mth partial derivative w.r.t. x is easily had from Wolfram Alpha:
t^(m-1)*exp(t*x)(t*x + m)
So if x = 0 you get m*t^(m-1).
Q.E.D.
Let's see what is happening with a little more detail:
When you write:
D[Sin[x], {x, 1}]
you get an expression in with x in it
Cos[x]
That is because the x in the {x,1} part matches the x in the Sin[x] part, and so Mma understands that you want to make the derivative for that symbol.
But this x, does NOT act as a Block variable for that statement, isolating its meaning from any other x you have in your program, so it enables the chain rule. For example:
In[85]:= z=x^2;
D[Sin[z],{x,1}]
Out[86]= 2 x Cos[x^2]
See? That's perfect! But there is a price.
The price is that the symbols inside the derivative get evaluated as the derivative is taken, and that is spoiling your code.
Of course there are a lot of tricks to get around this. Some have already been mentioned. From my point of view, one clear way to undertand what is happening is:
f[x_] := x*Exp[t*x];
g[y_, m_] := D[f[x], {x, m}] /. x -> y;
{g[p, 2], g[0, 1]}
Out:
{2 E^(p t) t + E^(p t) p t^2, 1}
HTH!

How do I make this substitution in Mathematica?

I'm just getting started with Mathematica, and I've got what must be a pretty basic question about making substitutions but I can't get it to work.
I'd like to find the Euler-Lagrange equations for a functional of the function phi[x,y] and then make a substitution for the function phi[x,y]
If I enter the following:
VariationalD[tau*phi[x, y]^2 - 2*phi[x, y]^4 + phi[x, y]^6 + Dot[D[phi[x, y], {{x, y}}], D[phi[x, y, {{x, y}}]]], phi[x, y], {x, y}]
I get
Plus[Times[2,tau,phi[x,y]],Times[-8,Power[phi[x,y],3]],Times[6,Power[phi[x,y],5]],Times[-2,Plus[Derivative[0,2][phi][x,y],Derivative[2,0][phi][x,y]]]]
Now if I try % /. phi[x,y] -> phi0[x,y] + psi[x,y] it makes the substitution for all the polynomial terms, but not for the Derivative terms.
How do I force the substitution into those functions?
I agree with all of what rcollyer says, but I think his final solution might be a little opaque.
The simplest rule that I could come up with (which is the basically the same as rcollyer's) is
{phi[x__] :> phi0[x] + psi[x], f_[phi][x__] :> f[phi0][x] + f[psi][x]}
or something with less possible side effects is
{phi[x__] :> phi0[x] + psi[x], Derivative[n__][phi][x__] :> Derivative[n][phi0][x] + Derivative[n][psi][x]}
It would be a lot easier if Derivative had a Default property (compare Default[Times] with Default[Derivative]). It should be something like Default[Derivative] := Sequence[] but unfortunately that doesn't play nice with the pattern matching.
Getting back to your question, you probably want to define something like
VariationalD[expr_, sym_, var_] := Module[{
vRule = {sym[x__] :> sym[x] + var[x],
Derivative[n__][sym][x__] :> Derivative[n][sym][x] + Derivative[n][var][x]}},
(expr /. vRule) - expr]
Where the variation var of the symbol sym is assumed to be small. Of course what you then need to do is series expand around var=0 and only keep the linear part. Then use integration by parts on any term which has derivatives of var. All of which should be included in the above module.
First, you misplaced a ] in your second derivative term, it should read D[phi[x, y], {{x, y}}]] not D[phi[x, y, {{x, y}}]]].
That said, replacement in Mathematica can be tricky, as has been pointed out in other questions. That isn't to say it is impossible, just requires some work. In this case, the problem comes in in that phi[x,y] is different from Derivative[2, 0][phi][x, y]. So, your pattern won't match the derivative term. The simplest thing to do is to add the rule
Derivative[a__][phi][x__]:> Derivative[a][phi0][x] + Derivative[a][psi][x]
to your list of replacement rules. Three things to note: 1) I use ReplaceDelayed so that both types of derivatives will match without writing multiple rules, 2) since I can use patterns, I named them so that I can refer to them on the RHS of the rule, and 3) I used a double underscore when defining a and x which will match one or more items in a sequence.
Of course, that isn't the most satisfying way to approach the problem, as it will require you to write two rules every time you wish to this sort of replacement. It turns out a more general approach is surprisingly difficult to accomplish, and I'll have to get back to you on it.
Edit: This requires a double replacement, as follows
<result> /. phi -> phi0 + psi /. a_[b__][c__] :> Through[Distribute[a[b]][c]]
Distribute ensures that the derivative works correctly with Plus, and Through does the same with the function args c. The key is that the Head of Derivative[2, 0][phi][x, y] is Derivative[2, 0][phi], hence the several levels of square brackets in the rule.

Targeted Simplify in Mathematica

I generate very long and complex analytic expressions of the general form:
(...something not so complex...)(...ditto...)(...ditto...)...lots...
When I try to use Simplify, Mathematica grinds to a halt, I am assuming due to the fact that it tries to expand the brackets and or simplify across different brackets. The brackets, while containing long expressions, are easily simplified by Mathematica on their own. Is there some way I can limit the scope of Simplify to a single bracket at a time?
Edit: Some additional info and progress.
So using the advice from you guys I have now started using something in the vein of
In[1]:= trouble = Log[(x + I y) (x - I y) + Sqrt[(a + I b) (a - I b)]];
In[2]:= Replace[trouble, form_ /; (Head[form] == Times) :> Simplify[form],{3}]
Out[2]= Log[Sqrt[a^2 + b^2] + (x - I y) (x + I y)]
Changing Times to an appropriate head like Plus or Power makes it possible to target the simplification quite accurately. The problem / question that remains, though, is the following: Simplify will still descend deeper than the level specified to Replace, e.g.
In[3]:= Replace[trouble, form_ /; (Head[form] == Plus) :> Simplify[form], {1}]
Out[3]= Log[Sqrt[a^2 + b^2] + x^2 + y^2]
simplifies the square root as well.
My plan was to iteratively use Replace from the bottom up one level at a time, but this clearly will result in vast amount of repeated work by Simplify and ultimately result in the exact same bogging down of Mathematica I experienced in the outset. Is there a way to restrict Simplify to a certain level(s)?
I realize that this sort of restriction may not produce optimal results, but the idea here is getting something that is "good enough".
There are a number of ways you can do this, but it can be a little tricky and depends on the structure of your actual expression. However, usually a product of a number of terms in brackets will have the head Times, and you can use FullForm to verify this:
In[1]:= FullForm[(a+b)(c+d)]
Out[1]= Times[Plus[a, b], Plus[c, d]]
You can use the higher-order function Map with expressions with head Times the same way you use it with expressions with head List, and that may allow you to Simplify the expression one term at a time, like so:
Map[Simplify, yourGinormousExpression]
You can use Expand on the result if you need to subsequently expand out the brackets.
EDIT to add: If you want to specify the forms that you do want to simplify, you can use Replace or ReplaceAll instead of one of the relatives of Map. Replace is particularly useful because it takes a level specification, allowing you to only affect the factors in the topmost product. As a simple example, consider the following:
In[1]:= expr = Sqrt[(a + 1)/a] Sqrt[(b + 1)/b];
In[2]:= Simplify[expr]
Out[2]= Sqrt[1 + 1/a] Sqrt[1 + 1/b]
If you don't want to simplify factors that depend on a. you can do this instead:
In[3]:= Replace[expr, form_ /; FreeQ[form, a] :> Simplify[form], {1}]
Out[3]= Sqrt[(1 + a)/a] Sqrt[1 + 1/b]
Only the second term, which depends on b, has been changed. One thing to bear in mind though is that some transformations are done automatically by Times or Plus; for instance a + a will be turned into 2 a even without use of Simplify.
I beg to differ with my colleagues, in that using Map to apply Simplify to each subexpression may not save any time as it will still be applied to each one. Instead try, MapAt, as follows:
In[1]:= MapAt[f, SomeHead[a,b,c,d], {4}]
Out[1]:= SomeHead[a, b, c, f[d]]
The tricky part is determining the position specification. Although, if the expression you want to simplify is at the first level, it shouldn't be any more difficult then what I've written above.
Now if you would still like to simplify everything, but you wish to preserve some structure, try using the option ExcludedForms. In the past, I've used to prevent this simplification:
In[2]:= Simplify[d Exp[I (a + b)] Cos[c/2]]
Out[2]:= Exp[I(a + b + c)](d + d Exp[c])
which Mathematica seems to like, so I do
In[3]:= Simplify[d Exp[I (a + b)] Cos[c/2], ExcludedForms -> {_Cos,_Sin}]
Out[3]:= d Exp[I (a + b)] Cos[c/2]
Also, don't forget that the second parameter for Simplify is for assumptions, and can greatly ease your struggles in getting your expressions into a useful form.
You should try Map.
In general, Map[foo, G[a, b, c, ...]] gives G[foo[a], foo[b], foo[c], ...] for any head G and any expression foo, so for
Map[Simplify, a b c d e]
it gives
Simplify[a] Simplify[b] Simplify[c] Simplify[d] Simplify[e]
Note you can denote Map[foo, expr] als foo /# expr if you find that more convenient.

Resources