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