# How to identify patterns in a tensor-polynomial and replace appropriate symbol?

I want to write a function tensorReplace[input] that takes a tensor polynomial in $r_i$ such as $r_i r_j r_k+r_i q_j q_k +q_i q_j q_k$ , and replaces each monomial with a function f[{idx}] using the rule $r_i\rightarrow f(\{i\})$, $r_i r_j\rightarrow f(\{i,j\})$, etc. leaving the $q$'s and another other symbols untouched.

So for in the example above, if my input is $$r_i r_j r_k+r_i q_j q_k +q_i q_j q_k\,,$$ I am shooting for an output

$$f(\{i,j,k\})+f(\{i\})q_i q_j+q_i q_j q_k\,.$$

I also need to allow the possibility where a vector with same index is squared (repeated in a monomial) given the obvious $r_i^2\rightarrow f(\{i,i\})$.

I don't know how to even begin, because my input could be an arbitrarily high order polynomial in $r$, with many terms.

-

Since you're talking about polynomials, it's only natural to try and solve this using the built-in functions for extracting polynomial coefficients and variables. It leads to this:

replaceR[poly_, name_, replacementName_] :=
Module[{vars = Cases[Variables[poly], name[_]]},
Apply[Plus,
CoefficientRules[poly, vars] /.
Rule[expo_, coeff_] :>
coeff replacementName[
Inner[Table[#[[1]], {#2}] &, vars, expo, Join]]]]

replaceR[4 q[i] r[h]^2 + 2 r[i] r[j] r[k], r, f]


2 f[{i,j,k}]+4 f[{h,h}] q[i]

The first argument is the polynomial, the second the name to be replaced (r in your question), and the third argument is the name of the function you called f. First, I use Variables and select the ones that are of the form r[_]; then CoefficientRules gives us the powers of all the variables with their coefficients, in a simple list that can be rewritten one monomial at a time into a new form involving f[{...}].

The special case of a constant in the polynomial leads to a corresponding empty function,

replaceR[1, r, f]


f[{}]

I think that's consistent, but if you don't like it one can always append a replacement rule like /. f[{}] :> 1. The use of polynomial manipulation functions makes it possible in principle to input the polynomial in non-expanded form, too.

-
This is my favorite! I am especially impressed by your correct guess that a constant should yield f[{}]. Your code and the accompanying explanation was clear enough for me to be able to tweak and embed it into my program. One question/observation: this code seems to work correctly even when the input polynomial is not expanded out in full: for example $(r_i+q_i)(r_j+q_j)$ works as intended. At what point does Mathematica know to expand everything out? – QuantumDot Jan 20 '13 at 20:32
Thanks - in the docs for CoefficientRules it says that the whole thing "works whether or not poly is explicitly given in expanded form." Of course the other answers would also work if you explicitly use Expand first, but in the polynomial manipulation functions that's built in... – Jens Jan 20 '13 at 20:39

My interpretation:

start = r[i] r[j] r[k] + r[i] q[j] q[k] + q[i] q[j] q[k];

start /. r[x_]^y_ :> r @@ Table[x, {y}] //. r[a__] r[b_] :> r[a, b] /. r[x__] :> f[{x}]

f[{i, j, k}] + f[{i}] q[j] q[k] + q[i] q[j] q[k]

-
Nice and short. The only way I could trip it up was by leaving a power in symbolic form, as in r[i]^n. That's probably not going to happen, though... – Jens Jan 20 '13 at 18:55
Yes, this is very short indeed! And, yes, the power will always be a numeric integer; never symbolic. – QuantumDot Jan 20 '13 at 20:34
(r@i r@j r@k 2 + 4 q@i r@h r@h) /. x_ :> Sort /@ x /. PatternSequence[(r@x_) ..] :> f@{x}
//.  f[{x_}] f[{y__}] :> f[{x, y}] //. f[{s__}]^n_ :> f[Array[s &, n]]

(*
2 f[{k, i, j}] + 4 f[{h, h}] q[i]
*)


Edit

as a function:

tensorRepl[i_, r_, f_] := i /. x_ :> Sort /@ x /. PatternSequence[(r@x_) ..] :> f@{x} //.
f[{x_}] f[{y__}] :> f[{x, y}] //. f[{s__}]^n_ :> f[Array[s &, n]]

tensorRepl[(r@i r@j r@k 2 + 4 q@i r@h r@h), r, f]
(*
2 f[{k, i, j}] + 4 f[{h, h}] q[i]
*)

-
+1 But I just noticed it doesn't work if there's a constant term, as in 1 + r[i] ... – Jens Jan 20 '13 at 5:06
@Jens Good point. The OP's example perhaps (mis)guided me into thinking of sums of products with the same number of tensorial terms. Anyway, adding it's solved with the addition of a last /. Sort[x_]:>x – Dr. belisarius Jan 20 '13 at 6:54