(* ::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;