Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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[[1]]][[1]])/. 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}]