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

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

• To: mathgroup at smc.vnet.net
• Subject: [mg106445] Re: [mg106423] I->-I, my solution. See examples at the end. Improvements/ suggestions/
• From: "David Park" <djmpark at comcast.net>
• Date: Wed, 13 Jan 2010 05:55:56 -0500 (EST)
• References: <4784060.1263292497507.JavaMail.root@n11>

Very nice. I can see that these might be generally useful. But the problem
might be that you will want to keep adding more cases to the list.

Would the following be a reasonable kind of case that one would want to do?

Sqrt[w]/Sqrt[x] + 1/Sqrt[y] /. 
 BetterRules[Sqrt[z_] :> Symbol["s" <> SymbolName[y]]]

This could be done with:

Sqrt[w]/Sqrt[x] + 1/(1 + Sqrt[y]) /. 
 Power[z_, p : (1/2 | -1/2)] :> 
  Power[Symbol["s" <> SymbolName[z]], Sign[p]]

How about if I wanted to mix regular rules in a BetterRules list? The rule
above does not pass through and work.

But that seems somewhat special. It still might be possible to hone down a
really useful short list. Something might not be completely general but
still be very useful because it provides convenient shortcuts for common
cases.

You might get a better notation implemented with the Notations package, or
you could try writing a MakeExpression definition. 


David Park
djmpark at comcast.net
http://home.comcast.net/~djmpark/  


From: Richard Fateman [mailto:fateman at cs.berkeley.edu] 


(*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}]