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[];
(*
^*)