       I->-I, my solution. See examples at the end. Improvements/ suggestions/

• To: mathgroup at smc.vnet.net
• Subject: [mg106423] I->-I, my solution. See examples at the end. Improvements/ suggestions/
• From: Richard Fateman <fateman at cs.berkeley.edu>
• Date: Tue, 12 Jan 2010 04:48:29 -0500 (EST)

```(*Here are some Mathematica programs. (c) 2010 Richard Fateman *)

(
Clear[BetterRules,BRr,BRi,BRc,BRreal,BRnopat,BRpat];
BetterRules[x_List]:=Flatten[ BetterRules /@ x]; (*For a List of Rules,
process each. *)

FreeOfPat= FreeQ[#,_Pattern]&;
ContainsPat = Count[#,_Pattern,Infinity]>0&;
NotOneQ = #!=1&  (* not equal to integer 1 *)

BetterRules[lhs_Rational->rhs_]:=  BRr[lhs,rhs];
BetterRules[lhs_Integer ->rhs_]:=  BRi[lhs,rhs];
BetterRules[lhs_Complex ->rhs_]:=  BRc[lhs,rhs];
BetterRules[lhs_Real ->rhs_]:=  BRreal[lhs,rhs]; (* no ideas here *)
BetterRules[lhs_?FreeOfPat->rhs_]:=  BRnopat[lhs,rhs];
BetterRules[lhs_?ContainsPat -> rhs_]:=BRpat[lhs,rhs];
(* handle delicately or not at all*)

(* Fill in some of the  details *)
(* 1/3 -> rhs  should change n/3 to  n*rhs. Even 5/3 -> 5*rhs*)
BRr[Rational[1,m_],rhs_] := (Rational[k_,m]->k*rhs);
BRr[Rational[n_?NotOneQ,m_],rhs_]:= (n/m->rhs); (*no change if n!=1*)

BRpat[lhs_,rhs_]:= (lhs->rhs);  (*no change*)

(* 3*I -> zz  could change  to  a+3*I-> a+zz. [Or, maybe a+I -> a +zz/3
as here] *)
BRc[Complex[0,m_],rhs_] := (Complex[k_,j_]->k+j/m*rhs);

(* What to do with Real? Just the same old thing?*)
BRreal[m_,rhs_] := (m->rhs);

(* for integer 2->x also do  1/2->1/x ; for 2->0 do 1/2->Infinity..*)

BRi[m_,rhs_] := {m->rhs,BRr[1/m,Quiet[1/rhs,Power::infy]]};

(* x^3 -> s also forces x^(-3)-> 1/s *)
BRnopat1[Power[x_,n_],rhs_]:={ x^n->rhs,
x^(-n)->Quiet[1/rhs,Power::infy]} ;

Findvars[expr_] :=
(* make a list of the symbols in an expression? Is there an easier way?? *)
Block[{varlist = {}},
Map[If[AtomQ[#] && Not[NumericQ[#]], AppendTo[varlist, #];] &,
expr, -1];
DeleteDuplicates[varlist]];

(* There is a decision point based on
whether something with no pattern variables involves exactly one
symbolic variable,
in which case we solve for it and choose first solution. *)

BRnopat[lhs_,rhs_]:=
Block [{v=Findvars[lhs]},
Switch[Length[v],
0, (* Constant Expression. what to do?*)  lhs->rhs,
1,  If [Head[lhs]===Power, BRnopat1[lhs,rhs], (* simple case *)
Block[{RHSx,newrule},
newrule=((Solve[lhs==RHSx,v[]][])/. RHSx->rhs);
Message[BetterRules::solve, lhs->rhs, newrule];
newrule]],
_, (* more than one unknown, can't invert in some obvious way *)
lhs->rhs
]];

BetterRules::solve = "Converting rule `1` into rule `2`"

(* I suppose all the conversions could be incorporated into Messages *)
)
(* end of programs *)

3+0.1 I /. I->0
3+0.1 I /. BetterRules[I->0]

3+12 I /. 3 I -> zz
3+12 I /. BetterRules[3 I -> zz]

3+4 I /.  I -> -I
3+4 I /.  BetterRules[I -> -I]

x^2+1/x^2 /.  x^2-> s
x^2+1/x^2 /.  BetterRules[x^2-> s]

5/3  /. 1/3 -> Third
5/3  /. BetterRules[1/3 -> Third]

Exp[x]+Exp[-x] /. Exp[x]->s
Exp[x]+Exp[-x] /. BetterRules[Exp[x]->s]

1+Cos[x]^2 /. Sin[x]->s
1+Cos[x]^2 /. BetterRules[Sin[x]->s]

e^2 + f^2 /. {1/e^2 -> q, f^2 -> r}
e^2 + f^2 /. BetterRules[{1/e^2 -> q, f^2 -> r}]

```

• Prev by Date: Re: Re: Re: More /.{I->-1} craziness
• Next by Date: Re: More /.{I->-1} craziness
• Previous by thread: Re: Program Generation of Mathematica Code
• Next by thread: Re: I->-I, my solution. See examples at the end. Improvements/ suggestions/