Re: commutativity
- To: mathgroup@smc.vnet.net
- Subject: [mg11726] Re: commutativity
- From: daiyanh@mindspring.com (Daitaro Hagihara)
- Date: Thu, 26 Mar 1998 03:08:54 -0500
- Organization: MindSpring Enterprises
- References: <6ek4j9$jag@smc.vnet.net>
In article <6ek4j9$jag@smc.vnet.net>, John Albert Horst
<horst@cme.nist.gov> wrote:
> I would like to be able to define a rule called, say, commutativeOff
> that would work as follows:
>
> In[1] := a*b == b*a/.commutativeOff
>
> Out[1] := False
>
> As it is,
>
> In[1] := a*b == b*a
>
> Out[1] := True
>
> How can I do this?
Working on this topic on and off for a week, I came up with a poor man's
non-commutative package. It uses ordinay symbols to represent basic
algebra, and it can be turned on and off by a couple of switches in a
considerately unintrusive way. Just eval all of the following in
brackets ([...]), and it starts out with the usual commutative
behavior; all math is unchanged. Then by issuing "commutativeOff"
command, things will become completely non-commutative. To get back to
the usual behavior, issue "commutativeOn" command. The vector
differentiation is currently nothing more than a hack. Even with a
future improvement, if any, this is no replacement for full tensor
packages out there.
Examples:
commutativeOff --> False
b x 5 a --> 5 b x a
b x 5 a===x b 5 a --> False
D[b x 5 a,x] --> T
5 b a
D[Distribute//@((Y-P T)'W(Y-P T)),T]/.W'->W --> T T
-2 P W Y + 2 P W P T
this last example is from least square
The program is short and does more than what you asked for. So give it
a try.
(*************************************************************************
This is a poor man's non-commutative package. It uses ordinay symbols
to represent basic algebra, and it can be turned on and off by a couple
of switches in a considerately unintrusive way. Just evaluate all of
the following, and it starts out with the usual commutative behavior;
all math is unchanged. Then by issuing "commutativeOff" command,
things will become completely non-commutative. To get back to the
usual behavior, issue "commutativeOn" command. The vector
differentiation is currently nothing more than a hack.
Examples:
commutativeOff --> False
b x 5 a --> 5 b x a
b x 5 a===x b 5 a --> False
D[b x 5 a,x] --> T
5 b a
D[Distribute//@((Y-P T)'W(Y-P T)),T]/.W'->W --> T T
-2 P W Y + 2 P W P T
this last example is from least square
**************************************************************************)
BeginPackage["pmncap`"]
commutativeOff;
commutativeOn;
pmncap`Times;
pmncap`D;
Begin["`private`"]
Module[{privatecommutativity=True},
commutativeOff:=privatecommutativity=False;
commutativeOn:=privatecommutativity=True;
commutativeP:=privatecommutativity;]
Times[x___]:=System`Times[x]/;commutativeP;
Times[x___,n__?NumberQ,y___]:=n Times[x,y]/;!commutativeP;
Times[x___,t_System`Times,y___]:=Times[x,Sequence@@t,y]/;!commutativeP;
Times[x_]:=x/;!commutativeP;
Times[]:=1/;!commutativeP;
Attributes[Times] = {Flat, Listable, OneIdentity}; Default[Times] := 1;
Times[x_^p_.,x_^q_.]:=x^(p+q)/;!commutativeP;
Format[e_Times]:=HoldForm[e]/.Power->power/.Times->System`Times;
Format[e_Times,InputForm]:=ValueList[e]/.Power->power/.Times->System`Times;
Format[power[x__]]:=HoldForm[Power[x]];
Format[power[x__],InputForm]:=ValueList[Power[x]];
Unprotect[Power];
Format[e_Times^p_,InputForm]:=ValueList[e^p]/.Power->power/.Times->System`Times;
Protect[Power];
D[e_,x__]:=System`D[e,x]/;commutativeP;
D[e_,x_?AtomQ]/;!commutativeP:=System`D[e/.(y:(x|tran[x]))^p_Integer?Positive:>Rest[Join@@Table[Times[dummy,y],{p}]]/.Times->(Hold[Times[##]]&)/.tran[x]->Hold[tran[x]],x]//.Hold[y:(Times|tran)[__]]->y/.dummy->1;
D[e_,x_List]:=Fold[D[#1,#2]&,e,Table[#1,#2]&[First@x,Rest@x]]/;!commutativeP;
D[e_,x__]:=Fold[D[#1,#2]&,e,{x}]/;!commutativeP;
System`D[e_Times,x_]^:=Plus@@MapIndexed[tran[MapAt[System`D[#,x]&,##],#2]&,Table[#,{Length@#}]]&@e/;!commutativeP;
tran[e_Times,{n_}]:=Times[tran@Take[e,n-1],Take[e,{n,Length[e]}]];
tran[e_Times]:=Reverse[tran/@e];
tran[e_System`Times,nl___]:=tran[#,nl]&/@e; tran[e_Plus,___]:=tran/@e;
tran[x_Symbol,__]:=tran[x]; (* tran[x_?AtomQ,___]:=x; *)
tran[x_?NumberQ,___]:=x;
tran[x_^p_Integer,___]:=tran[x]^p;
tran[tran[e_],___]:=e;
System`D[tran[x_],x_]^:=1;
Format[tran[x_],OutputForm]:=x^"T";
Format[tran[x_],InputForm]:=OutputForm[x'];
$mypre[e_]:=(If[commutativeP,Identity@#,#/.System`Times->Times//.Derivative[n_][x_]:>Nest[tran,x,n]]&@Hold[e])[[1]];
SetAttributes[$mypre,HoldFirst];
$Pre=$mypre;
End[(*`private`*)]
End[(*pmncap`*)]