Using Subscript[variable, integer] in Mathematica 7.0+, I have expressions of the following form:
a_-4 ** b_1 ** a_-4 ** b_-4 ** a_1 ** c_-4 ** c_1 ** c_5
I would like to simplify this expression.
Rules:
* Variables with the same subscript to don't commute,
* variables with different subscripts do commute.
I need a way to simplify the expression and combine like terms (if possible); the output should be something like:
(a_-4)^2 ** b_-4 ** c_-4 ** b_1 ** a_1 ** c_1 ** c_5
The most important thing I need is to order the terms in the expression by subscripts while preserving the rules about what commutes and what does not. The second thing (I would like) to do is to combine like terms once the order is correct. I need to at least order expressions like above in the following way:
a_-4 ** a_-4 ** b_-4 ** c_-4 ** b_1 ** a_1 ** c_1 ** c_5,
that is, commute variables with different subscripts while preserving the non-communicative nature of variables with the same subscripts.
All ideas are welcome, thanks.
I cited a library notebook the other day for a related question.
http://library.wolfram.com/infocenter/Conferences/325/
How to expand the arithematics of differential operators in mathematica
I'll crib some relevant code. I first mention (again) that I'm going to define and work with my own noncommutative operator, to avoid pattern matching headaches from built-in NonCommutativeMultiply. Also I will use a[...] instead of Subscript[a,...] for ease of ascii notation and cut-paste of Mathematica input/output.
We will classify certain "basic" entities as scalars or variables, the latter being the things that have commutation restrictions. I am not taking this nearly as far as one might go, and am only defining scalars to be fairly obvious "non-variables".
variableQ[x_] := MemberQ[{a, b, c, d}, Head[x]]
scalarQ[x_?NumericQ] := True
scalarQ[x_[a_]^n_. /; !variableQ[x[a]]] := True
scalarQ[_] := False
ncTimes[] := 1
ncTimes[a_] := a
ncTimes[a___, ncTimes[b___, c___], d___] := ncTimes[a, b, c, d]
ncTimes[a___, x_ + y_, b___] := ncTimes[a, x, b] + ncTimes[a, y, b]
ncTimes[a___, n_?scalarQ*c_, b___] := n*ncTimes[a, c, b]
ncTimes[a___, n_?scalarQ, b___] := n*ncTimes[a, b]
ncTimes[a___, x_[i_Integer]^m_., x_[i_]^n_., b___] /;
variableQ[x[i]] := ncTimes[a, x[i]^(m + n), b]
ncTimes[a___, x_[i_Integer]^m_., y_[j_Integer]^n_., b___] /;
variableQ[x[i]] && ! OrderedQ[{x, y}] := (* !!! *)
ncTimes[a, y[j]^n, x[i]^m, b]
I'll use your input form only slightly modified, so we'll convert ** expressions to use ncTimes instead.
Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[a___] := ncTimes[a]
Here is your example.
In[124]:=
a[-4] ** b[1] ** a[-4] ** b[-4] ** a[1] ** c[-4] ** c[1] ** c[5]
Out[124]= ncTimes[a[-4]^2, a[1], b[1], b[-4], c[-4], c[1], c[5]]
An advantage to this seemingly laborious method is you can readily define commutators. For example, we already have (implicitly) applied this one in formulating the rules above.
commutator[x_[a_], y_[b_]] /; x =!= y || !VariableQ[x[a] := 0
In general if you have commutator rules such as
ncTimes[a[j],a[i]] == ncTimes[a[i],a[i]]+(j-i)*a[i]
whenever j > i, then you could canonicalize, say by putting a[i] before a[j] in all expressions. For this you would need to modify the rule marked (!!!) to account for such commutators.
I should add that I have not in any sense fully tested the above code.
Daniel Lichtblau
Wolfram Research
Is this the type of thing you are looking for
These types of rules can be generalised (e.g. add commutation rules for noncommuting objects, make it handle nonnumeric indices, etc...) and packaged up into a NCMSort routine. You can also optimize it by doing the sorting in a single pass by defining a unique NCMOrder function, e.g.
NCMSort[expr_] := expr /. a_NonCommutativeMultiply :> a[[NCMOrder[a]]]
An aside:
I used such a process in generating the results of arXiv:1009.3298 -- the notebook will be distributed with the (soon to be released) longer paper.
You can do what you want using NCAlgebra. In the case of your example:
<< NC`
<< NCAlgebra`
expr = Subscript[a, -4] ** Subscript[b, 1] ** Subscript[a, -4] ** Subscript[b, -4] ** Subscript[a, 1] ** Subscript[c, -4] ** Subscript[c, 1] ** Subscript[c, 5]
rule = {(Subscript[x_, i_] ** Subscript[y_, j_] /; i > j) -> Subscript[y, j] ** Subscript[x, i]}NCReplaceRepeated[expr, rule]
NCReplaceRepeated[expr, rule]
produces
Subscript[a, -4] ** Subscript[a, -4] ** Subscript[b, -4] ** Subscript[c, -4] ** Subscript[b, 1] ** Subscript[a, 1] ** Subscript[c, 1] ** Subscript[c, 5]
It does not look so nice here but Subscripts will render nicely on a Notebook.
Related
I am trying to evaluate the derivative of a function at a point (3,5,1) in Mathematica. So, thats my input:
In[120]:= D[Sqrt[(z + x)/(y - 1)] - z^2, x]
Out[121]= 1/(2 (-1 + y) Sqrt[(x + z)/(-1 + y)])
In[122]:= f[x_, y_, z_] := %
In[123]:= x = 3
y = 5
z = 1
f[x, y, z]
Out[124]= (1/8)[3, 5, 1]
As you can see I am getting some weird output. Any hints on evaluating that derivative at (3,5,1) please?
The result you get for Out[124] leads me to believe that f was not cleared of a previous definition. In particular, it appears to have what is known as an OwnValue which is set by an expression of the form
f = 1/8
(Note the lack of a colon.) You can verify this by executing
g = 5;
OwnValues[g]
which returns
{HoldPattern[g] :> 5}
Unfortunately, OwnValues supersede any other definition, like a function definition (known as a DownValue or, its variant, an UpValue). So, defining
g[x_] := x^2
would cause g[5] to evaluate to 5[5]; clearly not what you want. So, Clear any symbols you intend to use as functions prior to their definition. That said, your definition of f will still run into problems.
At issue, is your use of SetDelayed (:=) when defining f. This prevents the right hand side of the assignment from taking on a value until f is executed later. For example,
D[x^2 + x y, x]
f[x_, y_] := %
x = 5
y = 6
f[x, y]
returns 6, instead. This occurs because 6 was last result generated, and f is effectively a synonym of %. There are two ways around this, either use Set (=)
Clear[f, x, y]
D[x^2 + x y, x];
f[x_, y_] = %
f[5, 6]
which returns 16, as expected, or ensure that % is replaced by its value before SetDelayed gets its hands on it,
Clear[f, x, y]
D[x^2 + x y, x];
f[x_, y_] := Evaluate[%]
I want to write a
Module Arg[f_,n_]
that takes a function f (having <=n arguments) and a natural number n and outputs the n-th argument of the function f.
As an example, suppose that f is defined by
f[a_,b_]=a^2+b^2.
Then,
Arg[f[s,t],1]
should be s;
while
Arg[f[u,v],2]
should be v.
My question is whether this is possible. If so, what should I write in the place of "???" below?
Arg[f_,n_] := Module[{}, ??? ]
Note that I don't want to specify a_ and b_ in the definition of Arg like
Arg[f_,a_,b_,n_]
EDIT: "Arg" is just my name for the module not the internal function Arg of Mathematica.
Perhaps
SetAttributes[arg, HoldFirst];
arg[f_[x___], n_] := {x}[[n]]
f[a_, b_] := a^2 + b^2.
arg[f[arg[f[s, t], 1], t], 1]
arg[f[s, t], 2]
(*
-> s
-> t
*)
arg[ArcTan[f[Cos#Sin#x, x], t], 1]
(*
-> x^2. + Cos[Sin[x]]^2
*)
Assuming your second example should give u, this should do the job:
ClearAll[arg];
SetAttributes[arg, HoldFirst];
arg[g_, n_] := Module[
{tmp, ret},
Unprotect[Part];
tmp = Attributes[Part];
SetAttributes[Part, HoldFirst];
ret = Part[g, n];
ClearAttributes[Part, HoldFirst];
SetAttributes[Part, tmp];
Protect[Part];
ret
]
so that
f[a_, b_] = a^2 + b^2.;
arg[f[s, t], 1]
gives s.
This is very heavy-handed though, so I expect someone will find something better soon enough.
This is a bit better (doesn't redefine built-in functions even temporarily):
ClearAll[arg2];
SetAttributes[arg2, HoldFirst];
arg2[g_, n_] := Hold[g][[1, n]]
I'm having a sum like this:
Sum[1 + x[i], {i, 1, n}]
Mathematica doesn't simplify it any more. What would I need to do so it translates it into:
n + Sum[x[i],{i,1,n}]
Maybe this?
Distribute[Sum[1 + x[i], {i, 1, n}]]
which returns:
n + Sum[x[i], {i, 1, n}]
AFAIK Sum simply won't give partial answers. But you can always split off the additive part manually, or semi-automatically. Taking your example,
In[1]:= sigma + (x[i] - X)^2 // Expand
Out[1]= sigma + X^2 - 2 X x[i] + x[i]^2
There's nothing we can do with the parts that contain x[i] without knowing anything about x[i], so we just split off the rest:
In[2]:= Plus ## Cases[%, e_ /; FreeQ[e, x[i]]]
Out[2]= sigma + X^2
In[3]:= Sum[%, {i, 1, n}]
Out[3]= n (sigma + X^2)
Unrelated: It is a good idea never to use symbols starting with capital letters to avoid conflicts with builtins. N has a meaning already, and you shouldn't use it as a variable.
A quick and dirty way would be to use Thread, so for example
Thread[Sum[Expand[sigma + (x[i] - X)^2], {i, 1, n}], Plus, 1]
A simpler way would be
Total[Sum[#, {i, 1, n}] & /# {sigma, x[i]}]
If your expression is longer, this should give you the answer without having to manually split the terms
expr = sigma + (x[i] + i)^2 + Cos[Sin[i - x[i]]];
Total[Sum[#, {i, 1, n}] & /# Level[expr, {1}]]
This can also be done in an easy to understand manner with rules:
sumofsumsrule = Sum[a_+b_,{i_,c_,d_}] :> Sum[a,{i,c,d}]+Sum[b,{i,c,d}];
expandsummandrule = Sum[a_,{i_,c_,d_}] :> Sum[Expand[a],{i,c,d}];
MyRules = {sumofsumsrule, expandsummandrule};
Now, if you are messing around, you can use this (here are some examples):
error = Sum[sigma+(x[i]-X)^2,{i,1,n}]
error /. sumofsumsrule
% /. expandsummandrule
error //. MyRules
The derivative functions D and Dt don't appear to be functioning as advertised.
Following the first example in the "Properties and Relations" section of http://reference.wolfram.com/mathematica/ref/Constants.html I have:
In[1]:= {Dt[ax^2 + b, x, Constants -> {a, b}], D[ax^2 + b, x]}
Out[1]= {2 ax Dt[ax, x, Constants -> {a, b}], 0}
I've duplicated the input, but the output is totally different. How do I get the expected output { 2 a x, 2 a x}?
I am using Mathematica 8.0.1.0 64-bit as installed at Rutgers University.
You need a space between a and x, otherwise it thinks you're talking about a variable named ax:
In[2]:= {Dt[a x^2 + b, x, Constants -> {a, b}], D[a x^2 + b, x]}
Out[2]= {2 a x, 2 a x}
(I realize this isn't really answering the OP's question. But given the level of the question, along with OP's desire to use the Contants option, the following info may prove useful for others in the future.)
My 2 cents on Dt.
IMO, using the Constants option is less than ideal---mainly because it produces messy output. For example:
In[1]:= Dt[x^a y^b, Constants -> {a, b}]
Out[1]= a x^(-1 + a) y^b Dt[x, Constants -> {a, b}] +
b x^a y^(-1 + b) Dt[y, Constants -> {a, b}]
Am I the only one who finds the above behavior annoying/redundant? Is there a practical reason for this design? If so, please educate me... :)
Alternative approaches:
If you don't want to use the Constants option, here are some alternative approaches.
Use UpValues to force constants.
In[2]:= Remove[a, b];
a /: Dt[a] = 0;
b /: Dt[b] = 0;
Dt[x^a y^b]
Out[5]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
Use Attributes. (i.e., give certain symbols the Constant Attribute.
In[6]:= Remove[a, b];
SetAttributes[{a, b}, Constant];
Dt[x^a y^b]
Out[8]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
Use Rules to alter the output of the main Dt[] expression.
In[9]:= Remove[a, b];
Dt[x^a y^b] /. Dt[a] -> 0 /. Dt[b] -> 0
Out[10]= a x^(-1 + a) y^b Dt[x] + b x^a y^(-1 + b) Dt[y]
Say I have a list of Rules
rules = {a -> b, c -> d};
which I use throughout a notebook. Then, at one point, it makes sense to want the rules to apply before any other evaluations take place in an expression. Normally if you want something like this you would use
In[2]:= With[{a=b,c=d}, expr[a,b,c,d]]
Out[2]= expr[b, b, d, d]
How can I take rules and insert it into the first argument of With?
Edit
BothSome solutions fail do all that I was looking for - but I should have emphasised this point a little more. See the bold part above.
For example, let's look at
rules = {a -> {1, 2}, c -> 1};
If I use these vaules in With, I get
In[10]:= With[{a={1,2},c=1}, Head/#{a,c}]
Out[10]= {List,Integer}
Some versions of WithRules yield
In[11]:= WithRules[rules, Head/#{a,c}]
Out[11]= {Symbol, Symbol}
(Actually, I didn't notice that Andrew's answer had the Attribute HoldRest - so it works just like I wanted.)
You want to use Hold to build up your With statement. Here is one way; there may be a simpler:
In[1]:= SetAttributes[WithRules, HoldRest]
In[2]:= WithRules[rules_, expr_] :=
With ## Append[Apply[Set, Hold#rules, {2}], Unevaluated[expr]]
Test it out:
In[3]:= f[args___] := Print[{args}]
In[4]:= rules = {a -> b, c -> d};
In[5]:= WithRules[rules, f[a, c]]
During evaluation of In[5]:= {b,d}
(I used Print so that any bug involving me accidentally evaluating expr too early would be made obvious.)
I have been using the following form of WithRules for a long time. Compared to the one posted by Andrew Moylan, it binds sequentially so that you can say e.g. WithRules[{a->b+1, b->2},expr] and get a expanded to 3:
SetAttributes[WithRules, HoldRest]
WithRules[rules_, expr_] := ReleaseHold#Module[{notSet}, Quiet[
With[{args = Reverse[rules /. Rule[a_, b_] -> notSet[a, b]]},
Fold[With[{#2}, #1] &, Hold#expr, args]] /. notSet -> Set,
With::lvw]]
This was also posted as an answer to an unrelated question, and as noted there, it has been discussed (at least) a couple of times on usenet:
A version of With that binds variables sequentially
Add syntax highlighting to own command
HTH
EDIT: Added a ReleaseHold, Hold pair to keep expr unevaluated until the rules have been applied.
One problem with Andrew's solution is that it maps the problem back to With, and that does not accept subscripted variables. So the following generates messages.
WithRules[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Power[Subscript[x, 1], Subscript[x, 2]]]
Given that With performs syntactic replacement on its body, we can set WithRules alternatively as follows:
ClearAll[WithRules]; SetAttributes[WithRules, HoldRest];
WithRules[r : {(_Rule | _RuleDelayed) ..}, body_] :=
ReleaseHold[Hold[body] /. r]
Then
In[113]:= WithRules[{Subscript[x, 1] -> 2,
Subscript[x, 2] -> 3}, Subscript[x, 1]^Subscript[x, 2]]
Out[113]= 8
Edit: Addressing valid concerns raised by Leonid, the following version would be safe:
ClearAll[WithRules3]; SetAttributes[WithRules3, HoldRest];
WithRules3[r : {(_Rule | _RuleDelayed) ..}, body_] :=
Developer`ReplaceAllUnheld[Unevaluated[body], r]
Then
In[194]:= WithRules3[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Subscript[x, 1]^Subscript[x, 2]]
Out[194]= 8
In[195]:= WithRules3[{x -> y}, f[y_] :> Function[x, x + y]]
Out[195]= f[y_] :> Function[x, x + y]
Edit 2: Even WithRules3 is not completely equivalent to Andrew's version:
In[206]:= WithRules3[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[206]= f[y_] :> Function[x, x + y + z]
In[207]:= WithRules[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[207]= f[y$_] :> Function[x$, x$ + y$ + 2]