This is an evolution of one of my previous questions; I've got a partial answer to that question and now have a much cleaner question to ask:
Question: What changes to replacementFunction
(defined below) are required for it work on determinant-like expressions?
The replacementFunction
has shown up multiple times. There's a barebones version of it here. At the bottom of this question, I include a version of it with an optional fourth argument that when set to ON
prints what the function is doing (to aid any noble souls who attempt to assist).
replacementFunction
uses PolynomialReduce
to rewrite sub-expressions in a user-defined way. I am trying to use it on determinant-like expressions, but the iterative structure of replacementFunction
appears to miss something on expressions with Head[expr]===Plus
.
An example where replacementFunction
works:
exprA = (a[1, 1] a[2, 2] + a[1, 2] a[2, 1]);
replacementFunction[exprA^2, {exprA - detA}, Variables[exprA], ON]
(*detA^2*)
and an example where it doesn't work:
exprA = (a[1, 1] a[2, 2] + a[1, 2] a[2, 1]);
replacementFunction[exprA, {exprA - detA}, Variables[exprA], ON]
(* a[1, 1] a[2, 2] + a[1, 2] a[2, 1] *)
The only difference is exprA
vs. exprA^2
in the first argument of replacementFunction
. I think this has to do with the fact that replacementFunction
performs a PolynomialReduce
on expressions with hed===Power
, but doesn't appear to do so for expressions with hed===Plus
, but I can't figure out how to implement this consistently.
Here is the printing version or replacementFunction
:
(* Definition of replacement function *)
replacementFunction // ClearAll;
replacementFunction[expr_, rep_, vars_, TS_: 0] :=
Module[
{num = Numerator[expr], den = Denominator[expr], hed = Head[expr],
base, expon, out, tsp, pr}
,
tsp[x_] := If[TS === ON, Print[x];];
pr := PolynomialReduce[expr, rep, vars];
If[
PolynomialQ[num, vars] && PolynomialQ[den, vars] && ! NumberQ[den]
,
tsp["T1 - A rational function"];
tsp[expr];
out = replacementFunction[num, rep, vars, TS]/replacementFunction[den, rep, vars, TS];
tsp["===T1 out==="];
tsp[out // Flatten // TableForm];
out
,
tsp["F1 - Not a rational function"];
tsp[expr];
If[
hed === Power && Length[expr] == 2
,
tsp["T2 - A power function"];
tsp[expr];
base = replacementFunction[expr[[1]], rep, vars, TS];
expon = replacementFunction[expr[[2]], rep, vars, TS];
out = PolynomialReduce[base^expon, rep, vars];
tsp["===T2 out==="];
tsp[out // Flatten // TableForm];
out[[2]]
,
tsp["F2 - Not a power function"];
tsp[expr];
If[
Head[hed] === Symbol && MemberQ[Attributes[Evaluate[hed]], NumericFunction]
,
tsp["T3 - A numeric function"];
tsp[expr];
Map[replacementFunction[#, rep, vars, TS] &, expr]
,
tsp["F3 - Not a numeric function"];
tsp["***Reduce***"];
tsp["Divide ", expr];
tsp["by ", rep];
out = pr(*PolynomialReduce*);
tsp["===T3 out==="];
tsp[out // Flatten // TableForm];
out[[2]]
]
]
]
];