25 lines
987 B
Mathematica
25 lines
987 B
Mathematica
|
(* ::Package:: *)
|
||
|
|
|
||
|
|
TermErsetzung[rep_Equal,vars_][expr_]:=
|
||
|
|
termErsetzung[expr,Evaluate[Subtract@@rep],vars]//Union;
|
||
|
|
|
||
|
|
|
||
|
|
SetAttributes[termErsetzung,Listable];
|
||
|
|
termErsetzung[expr_, rep_, vars_] :=
|
||
|
|
Module[{num = Numerator[expr], den = Denominator[expr],
|
||
|
|
hed = Head[expr], base, expon},
|
||
|
|
If[PolynomialQ[num, vars] && PolynomialQ[den, vars] && ! NumberQ[den],
|
||
|
|
termErsetzung[num, rep, vars]/termErsetzung[den, rep, vars], (*else*)
|
||
|
|
If[hed === Power && Length[expr] === 2,
|
||
|
|
base = termErsetzung[expr[[1]], rep, vars];
|
||
|
|
expon = termErsetzung[expr[[2]], rep, vars];
|
||
|
|
PolynomialReduce[base^expon, rep, vars][[2]], (*else*)
|
||
|
|
If[Head[Evaluate[hed]] === Symbol &&
|
||
|
|
MemberQ[Attributes[Evaluate[hed]], NumericFunction],
|
||
|
|
Map[termErsetzung[#, rep, vars] &, expr], (*else*)
|
||
|
|
PolynomialReduce[expr, rep, vars][[2]] ]]]
|
||
|
|
];
|
||
|
|
TermErsetzung[rep_Equal,vars_][expr_]:=
|
||
|
|
termErsetzung[expr,Evaluate[Subtract@@rep],vars]//Union;
|
||
|
|
|