Related
I want to teach mathematica that Subscript[w, i] differentiated by Subscript[w, j] is KroneckerDelta[i, j].
I tried
Unprotect[D]; D[Subscript[x_, i_], Subscript[x_, j_]] :=
KroneckerDelta[i, j]; Protect[D]
And this works with D[Subscript[w, i], Subscript[w, j]], but not with more complex expressions, e.g. D[Times[k, Subscript[w, i]], Subscript[w, j]]
I understand from the answer to this question: How to define a function that commutes with D in Mathematica that mathematica isn't matching my rule, but I don't understand why. Why does Mathematica not use the product rule, and then invoke my rule?
I think I see now what is happening.
Mathematica does not recursively define the D operator using the chain rule, presumably because this is too slow. It does some pattern matching on subexpressions to see if they contain the variable of differentiation, and subexpressions which don't are treated as constants; so my pattern for D is never applied.
The way around this turns out to be to tell Mathematica explicitly that
Subscript[w, i]
is not a constant.
My pattern now looks like this
Unprotect[D];
D[Subscript[x_, i_], Subscript[x_, j_],
NonConstants -> {___, Subscript[x_, i_], ___} ] := KroneckerDelta[i, j];
Protect[D]
And I have to apply it this way:
D[k * Subscript[w, i], Subscript[w, j], NonConstants -> Subscript[w, i]]
Mathematica does not have "mathematical maturity" which means it is not a competent graduate student who can look at your request, figure out what you actually meant and give you what you should get. In particular, pattern matching is "structural", which means it just literally matches exactly the structure of what the rules say. That means it doesn't realize that you probably meant k to be a constant and thus understand that the derivative of a constant times a function should be the constant times the derivative.
You can add more and more rules to try to simulate mathematical maturity, but many typical users don't have all the skills needed to exactly correctly write all the rules needed. You can include:
Unprotect[D];
D[Times[k_, Subscript[w_, i_]], Subscript[x_, j_]] := k*KroneckerDelta[i, j];
Protect[D];
D[Times[k, Subscript[w, i]], Subscript[x_, j_]]
but that is assuming that k is free of Subscript[w, i]] and you may want to enhance that rule with a condition ensuring that. This still doesn't deal with k+KroneckerDelta[i, j] or k*KroneckerDelta[i, j]+m, etc.
First of all, it's usually a bad idea to Unprotect symbols in Mathematica in order to add DownValues. In addition to the reasons Bill gave, this forces D to check that the arguments you give it doesn't match your patterns, before it can do its normal work. That can slow the system down.
You can often get away with UpValues (via UpSetDelayed) instead of DownValues. That doesn't require that you Unprotect, and it causes your rules to fire only when they apply.
In this case, though, I think you just want a custom differentiator on top of D:
myD[f_, Subscript[x_, i_]] :=
With[{vars = DeleteDuplicates[Cases[f, Subscript[x, _], {0, Infinity}]]},
Sum[D[f, v]*KroneckerDelta[i, v[[2]]], {v, vars}]
]
(if I'm not missing something crucial.)
I want to evaluate f below by passing a list to some function:
f = {z[1] z[2], z[2]^2};
a = % /. {z[1]-> #1,z[2]-> #2};
F[Z_] := Evaluate[a] & ## Z ;
So now if I try F[{1,2}] I get {2, 4} as expected. But looking closer ?F returns the definition
F[Z_] := (Evaluate[a] &) ## Z
which depends on the value of a, so if we set a=3 and then evaluate F[{1,2}], we get 3. I know that adding the last & makes the Evaluate[a] hold, but what is an elegant work around? Essentially I need to force the evaluation of Evaluate[a], mainly to improve efficiency, as a is in fact quite complicated.
Can someone please help out, and take into consideration that f has to contain an Array[z,2] given by some unknown calculation. So writing
F[Z_] := {Z[[1]]Z[[2]],Z[[2]]^2}
would not be enough, I need this to be generated automatically from our f.
Many thanks for any contribution.
Please consider asking your future questions at the dedicated StackExchange site for Mathematica.
Your questions will be much less likely to become tumbleweeds and may be viewed by many experts.
You can inject the value of a into the body of both Function and SetDelayed using With:
With[{body = a},
F[Z_] := body & ## Z
]
Check the definition:
Definition[F]
F[Z$_] := ({#1 #2, #2^2} &) ## Z$
You'll notice Z has become Z$ due to automatic renaming within nested scoping constructs but the behavior is the same.
In the comments you said:
And again it bothers me that if the values of z[i] were changed, then this workaround would fail.
While this should not be a problem after F[Z_] is defined as above, if you wish to protect the replacement done for a you could use Formal Symbols instead of z. These are entered with e.g. Esc$zEsc for Formal z. Formal Symbols have the attribute Protected and exist specifically to avoid such conflicts as this.
This looks much better in a Notebook than it does here:
f = {\[FormalZ][1] \[FormalZ][2], \[FormalZ][2]^2};
a = f /. {\[FormalZ][1] -> #1, \[FormalZ][2] -> #2};
Another approach is to do the replacements inside a Hold expression, and protect the rules themselves from evaluation by using Unevaluated:
ClearAll[f, z, a, F, Z]
z[2] = "Fail!";
f = Hold[{z[1] z[2], z[2]^2}];
a = f /. Unevaluated[{z[1] -> #1, z[2] -> #2}] // ReleaseHold;
With[{body = a},
F[Z_] := body & ## Z
]
Definition[F]
F[Z$_] := ({#1 #2, #2^2} &) ## Z$
I have a following problem.
f[1]=1;
f[2]=2;
f[_]:=0;
dvs = DownValues[f];
this gives
dvs =
{
HoldPattern[f[1]] :> 1,
HoldPattern[f[2]] :> 2,
HoldPattern[f[_]] :> 0
}
My problem is that I would like to extract only definitions for f[1] and f[2] etc but not the general definition f[_], and I do not know how to do this.
I tried,
Cases[dvs, HoldPattern[ f[_Integer] :> _ ]] (*)
but it gives me nothing, i.e. the empty list.
Interestingly, changing HoldPattern into temporary^footnote
dvs1 = {temporary[1] :> 1, temporary[2] :> 2, temporary[_] :> 0}
and issuing
Cases[dvs1, HoldPattern[temporary[_Integer] :> _]]
gives
{temporary[1] :> 1, temporary[2] :> 2}
and it works. This means that (*) is almost a solution.
I do not not understand why does it work with temporary and not with HoldPattern? How can I make it work directly with HoldPattern?
Of course, the question is what gets evaluated and what not etc. The ethernal problem when coding in Mathematica. Something for real gurus...
With best regards
Zoran
footnote = I typed it by hand as replacement "/. HoldPattern -> temporary" actually executes the f[_]:=0 rule and gives someting strange, this excecution I certainly would like to avoid.
The reason is that you have to escape the HoldPattern, perhaps with Verbatim:
In[11]:= Cases[dvs,
Verbatim[RuleDelayed][
Verbatim[HoldPattern][HoldPattern[f[_Integer]]], _]]
Out[11]= {HoldPattern[f[1]] :> 1, HoldPattern[f[2]] :> 2}
There are just a few heads for which this is necessary, and HoldPattern is one of them, precisely because it is normally "invisible" to the pattern-matcher. For your temporary, or other heads, this wouldn't be necessary. Note by the way that the pattern f[_Integer] is wrapped in HoldPattern - this time HoldPattern is used for its direct purpose - to protect the pattern from evaluation. Note that RuleDelayed is also wrapped in Verbatim - this is in fact another common case for Verbatim - this is needed because Cases has a syntax involving a rule, and we do not want Cases to use this interpretation here. So, this is IMO an overall very good example to illustrate both HoldPattern and Verbatim.
Note also that it is possible to achieve the goal entirely with HoldPattern, like so:
In[14]:= Cases[dvs,HoldPattern[HoldPattern[HoldPattern][f[_Integer]]:>_]]
Out[14]= {HoldPattern[f[1]]:>1,HoldPattern[f[2]]:>2}
However, using HoldPattern for escaping purposes (in place of Verbatim) is IMO conceptually wrong.
EDIT
To calrify a little the situation with Cases, here is a simple example where we use the syntax of Cases involving transformation rules. This extended syntax instructs Cases to not only find and collect matching pieces, but also transform them according to the rules, right after they were found, so the resulting list contains the transformed pieces.
In[29]:= ClearAll[a, b, c, d, e, f];
Cases[{a, b, c, d, e, f}, s_Symbol :> s^2]
Out[30]= {a^2, b^2, c^2, d^2, e^2, f^2}
But what if we need to find elements that are themselves rules? If we just try this:
In[33]:= Cases[{a:>b,c:>d,e:>f},s_Symbol:>_]
Out[33]= {}
It doesn't work since Cases interprets the rule in the second argument as an instruction to use extended syntax, find a symbol and replace it with _. Since it searches on level 1 by default, and symbols are on level 2 here, it finds nothing. Observe:
In[34]:= Cases[{a:>b,c:>d,e:>f},s_Symbol:>_,{2}]
Out[34]= {_,_,_,_,_,_}
In any case, this is not what we wanted. Therefore, we have to force Cases to consider the second argument as a plain pattern (simple, rather than extended, syntax). There are several ways to do that, but all of them "escape" RuleDelayed (or Rule) in some way:
In[37]:= Cases[{a:>b,c:>d,e:>f},(s_Symbol:>_):>s]
Out[37]= {a,c,e}
In[38]:= Cases[{a:>b,c:>d,e:>f},Verbatim[RuleDelayed][s_Symbol,_]:>s]
Out[38]= {a,c,e}
In[39]:= Cases[{a:>b,c:>d,e:>f},(Rule|RuleDelayed)[s_Symbol,_]:>s]
Out[39]= {a,c,e}
In all cases, we either avoid the extended syntax for Cases (last two examples), or manage to use it to our advantage (first case).
Leonid, of course, completely answered the question about why your temporary solution works but HoldPattern does not. However, as an answer to your original problem of extracting the f[1] and f[2] type terms, his code is a bit ugly. To solve just the problem of extracting these terms, I would just concentrate on the structure of the left-hand-side of the definition and use the fact that FreeQ searches at all levels. So, defining
f[1] = 1; f[2] = 2; f[_] := 0;
dvs = DownValues[f];
All of the following
Select[dvs, FreeQ[#, Verbatim[_]] &]
Select[dvs, FreeQ[#, Verbatim[f[_]]] &]
Select[dvs, ! FreeQ[#, HoldPattern[f[_Integer]]] &]
yield the result
{HoldPattern[f[1]] :> 1, HoldPattern[f[2]] :> 2}
Provided there are no f[...] (or, for the first version, Blank[]) terms on the right-hand-side of the downvalues of f, then one of the above will probably be suitable.
Based on Simon's excellent solution here, I suggest:
Cases[DownValues[f], _?(FreeQ[#[[1]], Pattern | Blank] &)]
With the help of some very gracious stackoverflow contributors in this post, I have the following new definition for NonCommutativeMultiply (**) in Mathematica:
Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply]
NonCommutativeMultiply[] := 1
NonCommutativeMultiply[___, 0, ___] := 0
NonCommutativeMultiply[a___, 1, b___] := a ** b
NonCommutativeMultiply[a___, i_Integer, b___] := i*a ** b
NonCommutativeMultiply[a_] := a
c___ ** Subscript[a_, i_] ** Subscript[b_, j_] ** d___ /; i > j :=
c ** Subscript[b, j] ** Subscript[a, i] ** d
SetAttributes[NonCommutativeMultiply, {OneIdentity, Flat}]
Protect[NonCommutativeMultiply];
This multiplication is great, however, it does not deal with negative values at the beginning of an expression, i.e.,
a**b**c + (-q)**c**a
should simplify to
a**b**c - q**c**a
and it will not.
In my multiplication, the variable q (and any integer scaler) is commutative; I am still trying to write a SetCommutative function, without success. I am not in desperate need of SetCommutative, it would just be nice.
It would also be helpful if I were able to pull all of the q's to the beginning of each expression, i.e.,:
a**b**c + a**b**q**c**a
should simplify to:
a**b**c + q**a**b**c**a
and similarly, combining these two issues:
a**b**c + a**c**(-q)**b
should simplify to:
a**b**c - q**a**c**b
At the current time, I would like to figure out how to deal with these negative variables at the beginning of an expression and how to pull the q's and (-q)'s to the front as above. I have tried to deal with the two issues mentioned here using ReplaceRepeated (\\.), but so far I have had no success.
All ideas are welcome, thanks...
The key to doing this is to realize that Mathematica represents a-b as a+((-1)*b), as you can see from
In[1]= FullForm[a-b]
Out[2]= Plus[a,Times[-1,b]]
For the first part of your question, all you have to do is add this rule:
NonCommutativeMultiply[Times[-1, a_], b__] := - a ** b
or you can even catch the sign from any position:
NonCommutativeMultiply[a___, Times[-1, b_], c___] := - a ** b ** c
Update -- part 2. The general problem with getting scalars to front is that the pattern _Integer in your current rule will only spot things that are manifestly integers. It wont even spot that q is an integer in a construction like Assuming[{Element[q, Integers]}, a**q**b].
To achieve this, you need to examine assumptions, a process that is probably to expensive to be put in the global transformation table. Instead I would write a transformation function that I could apply manually (and maybe remove the current rule form the global table). Something like this might work:
NCMScalarReduce[e_] := e //. {
NonCommutativeMultiply[a___, i_ /; Simplify#Element[i, Reals],b___]
:> i a ** b
}
The rule used above uses Simplify to explicitly query assumptions, which you can set globally by assigning to $Assumptions or locally by using Assuming:
Assuming[{q \[Element] Reals},
NCMScalarReduce[c ** (-q) ** c]]
returns -q c**c.
HTH
Just a quick answer that repeats some of the comments from the previous question.
You can remove a couple of the definitions and solve all of the parts of this question using the rule that acts on Times[i,c] where i is commutative and c has the default of Sequence[]
Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply]
NonCommutativeMultiply[] := 1
NonCommutativeMultiply[a___, (i:(_Integer|q))(c_:Sequence[]), b___] := i a**Switch[c, 1, Unevaluated[Sequence[]], _, c]**b
NonCommutativeMultiply[a_] := a
c___**Subscript[a_, i_]**Subscript[b_, j_] ** d___ /; i > j := c**Subscript[b, j]**Subscript[a, i]**d
SetAttributes[NonCommutativeMultiply, {OneIdentity, Flat}]
Protect[NonCommutativeMultiply];
This then works as expected
In[]:= a**b**q**(-c)**3**(2 a)**q
Out[]= -6 q^2 a**b**c**a
Note that you can generalize (_Integer|q) to work on more general commutative objects.
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.