[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}]
Prev by Date:
**Re: Re: Radicals simplify**
Next by Date:
**Re: Radicals simplify**
Previous by thread:
**I->-I, my solution. See examples at the end. Improvements/ suggestions/**
Next by thread:
**How to declare vectors for solving**
| |