long algebraic equations + simplification

*To*: mathgroup at yoda.physics.unc.edu*Subject*: long algebraic equations + simplification*From*: "Dr A. Hayes" <hay at leicester.ac.uk>*Date*: Thu, 28 Apr 1994 09:55:54 +0100 (BST)

Mike Sonntag <MICHAEL at usys.informatik.uni-kassel.de> writes (slightly edited): > I have a problem concerning the simplification of long > algebraic equations. > E.g. > fkt =x==a^2+b^3*Sqrt[a^3] > What I want is to simplify this equation by giving combinations > of parameters new names, e.g. > A=a^2 > When I do something like > fkt /. a^2->A > Mma will only change the first a^2 and not the a^3 as it doesn't > correspond to this pattern. I attach a package, AlgebraicRulesExtended, designed to deal with this sort of problem In[19]:= <<Haypacks`AlgebraicRulesExtended` In[20]:= fkt =x==a^2+b^3*Sqrt[a^3]; In[21]:= fkt/.AlgebraicRulesExtended[A == a^2] Out[21]= 3 x == A + Sqrt[a A] b Bug reports and suggestions for improvement will be very welcome. From Allan Hayes Department of Mathematics The University Leicester LE1 7RH U.K. hay at leicester.ac.uk **************************************************** (*^ *) (* :Title: AlgebraicRulesExtended *) (* :Author: Allan Hayes, hay at leicester.ac.uk *) (* :Summary: AlgebraicRulesExtended is a package containing the single function, AlgebraicRulesExtended, an extension of the system function AlgebraicRules. It gives a single rule that can be used exactly like AlgebraicRules (though the latter gives a list of rules). The advantages are that: (1) it does not require the user to list all the symbols occurring in the expression to which the rule is applied in order to avoid error messages; (2)it uses Map so as to get at places that Replace alone cannot reach. *) (* :Context: Haypacks`AlgebraicRulesExtended ` *) (* :Package Version: 1.3 *) (* :Copyright: Copyright 1993,1994 Allan Hayes. *) (* :History: Version 1.1 by Allan Hayes, January 1993; Version 1.2 by Allan Hayes, March 1994; Version 1.3 by Allan Hayes, April 1994. *) (* :Keywords: Algebra, Simplification, Manipulation *) (* :Warning: uses OtherVariables as a special symbol.*) (* :Mathematica Version: 2.2 *) (**Begin Package**) BeginPackage["Haypacks`AlgebraicRulesExtended`","Utilities`FilterOptions`"]; Unprotect["`*"]; ClearAll["`*"]; (**Usage Messages**) AlgebraicRulesExtendedInfo::usage = " AlgebraicRulesExtended is a package that contains one function, AlgebraicRulesExtended, an extension of the system function AlgebraicRules for replacing variables according to given equations.\n Please see the separate entry for more information and examples." AlgebraicRulesExtended::usage = " AlgebraicRulesExtended[eqns], for a list of equations or a single equation eqns gives a replacement rule for replacing earlier variables in the list of variables in eqns (in default order) with later ones according to the equations eqns. The special symbol OtherVariables must not occur in eqns.\n The order of replacement may be modified as follows:\n AlgebraicRulesExtended[eqns, vars] where eqns is a listof equations or a single equation (which should not involve the special variable OtherVariables) and vars is a list of variables or a single variable gives a rule for replacing variables according to eqns. The preferences amongst the variables are determined by vars as follows.\n If vars includes the symbol OtherVariables then this is replaced by the sequence of those variables in eqns which are not in vars (in default order), and then a replacement rule is returned for replacing earlier symbols in the resulting list by later ones.\n If vars does not include OtherVariables then OtherVariables is first appended to vars and the evaluation then proceeds as above.\n AlgebraicRulesExtended[eqns, var] for a single variable var evaluates like AlgebraicRulesExtended[eqns, {var}].\n\n If rule is the rule returned then it is used in the usual way: expr/. rl.\n\n OPTIONS: AlgebraicRulesExtended has the combined options of AlgebraicRules and Cases.\n Changes involving the heads of expressions may be made by using the option Heads -> True. The default, Heads -> False excludes heads from the replacement process.\n\n Examples\n\n (1)\n eqns = { c1^2 + s1^2 == 1, c2^2 + s2^2 == 1, c3^2 + s3^2 == 1 };\n\n expr = Tan[s1^2 + a^c + c1^2]/(b(s2^4 +k + c2^4));\n\n arex = AlgebraicRulesExtended[eqns]\n expr/.arex\n (2)\n eqns = {M == n^4 + 4*k^2*p^2 - 2*n^2*p^2 + p^4, w^2 == n^2-k^2};\n\n expr = (-(((-2*a*k*p - n^4*y0 - 4*k^2*p^2*y0 + 2*n^2*p^2*y0 - p^4*y0)* Cos[(-k^2 + n^2)^(1/2)*t])/ (n^4 + 4*k^2*p^2 - 2*n^2*p^2 + p^4)) - (((n^4 + 4*k^2*p^2 - 2*n^2*p^2 + p^4)* (a*n^2*p - a*p^3 - n^4*yp0 - 4*k^2*p^2*yp0 + 2*n^2*p^2*yp0 - p^4*yp0) - (-(k*n^4) - 4*k^3*p^2 + 2*k*n^2*p^2 - k*p^4)* (-2*a*k*p - n^4*y0 - 4*k^2*p^2*y0 + 2*n^2*p^2*y0 - p^4*y0))*Sin[(-k^2 + n^2)^(1/2)*t])/ ((n^4 + 4*k^2*p^2 - 2*n^2*p^2 + p^4)* (n^4*(-k^2 + n^2)^(1/2) + 4*k^2*(-k^2 + n^2)^(1/2)*p^2 - 2*n^2*(-k^2 + n^2)^(1/2)*p^2 + (-k^2 + n^2)^(1/2)*p^4)))/ E^(k*t) + (-2*a*k*p*Cos[p*t] + a*n^2*Sin[p*t] - a*p^2*Sin[p*t])/ (n^4 + 4*k^2*p^2 - 2*n^2*p^2 + p^4); \n\n arex = AlgebraicRulesExtended[eqns,{OtherVariables,M,w}]\n expr/.arex\n PowerExpand[%]\n\n (3)\n (a x c)[a x c]/.AlgebraicRulesExtended[ a x == b]\n (3a)\n (a x c)[a x c]/.AlgebraicRulesExtended[ a x == b, Heads -> True]\n (4)\n x^3/.AlgebraicRulesExtended[x^2 ->z]\n (4a)\n x^3/.AlgebraicRulesExtended[x^2 ->z, z] "; OtherVariables::usage = "OtherVariables is a special symbol for AlgebraicRulesExtended: the first step in the evaluation of AlgebraicRulesExtended[eqns, vars] is to replace any occurrences of the symbol OtherVariables in vars with the sequence of those variables in eqns that are not in vars (arranged in default order). " (**Begin Private**) Begin["`Private`"]; (* Define a short format for the output.The name \"expression\" is included to localize the format to this context - if it is changed then its other occurrences must also be changed. *) Unprotect[RuleDelayed]; Format[ expression_ :> With[_List, _Off; _ = MapAt[(#/.AR_)&,_,_]; _On; _] ]:= AR; Protect[RuleDelayed]; Options[AlgebraicRulesExtended] = Flatten[Options/@{AlgebraicRules,Cases}]; AlgebraicRulesExtended[eqns_, opts___?OptionQ] := AlgebraicRulesExtended[eqns, {OtherVariables},opts]; AlgebraicRulesExtended[eqns_, var_Symbol, opts___?OptionQ] := AlgebraicRulesExtended[eqns, {var}, opts]; AlgebraicRulesExtended[ eqns_, {var__Symbol}/;Not[MemberQ[{var},OtherVariables]], opts___?OptionQ ] := AlgebraicRulesExtended[eqns, {var, OtherVariables}, opts]; AlgebraicRulesExtended[eqns_, {var__Symbol}, opts___?OptionQ] := Module[ {fullvars, ar}, With[ {filops = ( Off[First::first,Function::fpct]; fop = FilterOptions[##]; On[First::first,Function::fpct]; fop )& }, fullvars = {var}/. OtherVariables:> Sequence@@ Complement[ Cases[ eqns, s_Symbol, Infinity, filops[Cases, opts] ], {var} ]; ar = AlgebraicRules[ eqns, fullvars, filops[AlgebraicRules, opts] ]; With[ {AM = Function[ rules, (#/. rules)& ][ar], lhs = If[ ar[[-2]] === {{}}, {}, Hold@@(Union[Variables[First/@ar[[-2]]]]) ] }, expression_ :> With[ {posn = Position[ expression, p_/; (Not[And@@(FreeQ[p,#]&/@lhs)]), {0,Infinity}, filops[Position, opts], Heads->False ] }, Off[AlgebraicRules::newv,General::ivar]; ans = MapAt[AM,expression,posn]; On[AlgebraicRules::newv,General::ivar]; ans ] ] ] ] (**End**) End[]; Protect["`*"]; EndPackage[]; (* ^*)