Replacement of the variables

I have lots of functions of the form $$-x_4^2+x_0 x_4-x_1 x_3-x_5 x_7+x_1 x_{13}+x_2 x_{22}$$ (this is $$eq_4$$ see below). I want to replace each pair $$x_i x_j$$ by $$y_l=x_i x_j$$. How is it possible to do it?

 Do[{i, j, k} = {0, 0, IntegerDigits[l, 3][[1]]};
Co[i, j, k] = Subscript[x, l], {l, 0, 2, 1}]
Do[{i, j, k} = {0, IntegerDigits[l, 3][[1]],
IntegerDigits[l, 3][[2]]};
Co[i, j, k] = Subscript[x, l], {l, 3, 8, 1}]
Do[{i, j, k} = {IntegerDigits[l, 3][[1]], IntegerDigits[l, 3][[2]],
IntegerDigits[l, 3][[3]]};
Co[i, j, k] = Subscript[x, l], {l, 9, 26, 1}]
Do[lam = j 3^3 + k 3^2 + n 3 + s;
Subscript[eq, lam] =
Sum[Co[j, k, m]*Co[m, n, s] - Co[k, n, m]*Co[j, m, s], {m, 0, 2,
1}], {j, 0, 2, 1}, {k, 0, 2, 1}, {n, 0, 2, 1}, {s, 0, 2, 1}]


Here $$eq_k$$ are the expressions containing $$x_ix_j$$. Below I define $$y[l]$$

 l = 0;
Do[Do[y[l] = Subscript[x, i] Subscript[x, j];
l = l + 1, {j, i, 26}], {i, 0, 26}]

• Easiest way is probably using Eliminate. Nov 30 '18 at 17:22
• You can generate the replacement equations via replacementeqs=With[{indices = {0, 1, 3, 4, 5, 7, 13, 22}}, Equal @@@ (Transpose[{y /@ Range[Length[#]], #}] &[ Times @@@ Tuples[Table[x[i], {i, indices}], 2]])]. Rest should be relatively straight forward. Nov 30 '18 at 17:44

Do[{i, j, k} = {0, 0, IntegerDigits[l, 3][[1]]};
Co[i, j, k] = Subscript[x, l], {l, 0, 2, 1}]
Do[{i, j, k} = {0, IntegerDigits[l, 3][[1]], IntegerDigits[l, 3][[2]]};
Co[i, j, k] = Subscript[x, l], {l, 3, 8, 1}]
Do[{i, j, k} = {IntegerDigits[l, 3][[1]], IntegerDigits[l, 3][[2]],
IntegerDigits[l, 3][[3]]};
Co[i, j, k] = Subscript[x, l], {l, 9, 26, 1}]
Do[lam = j 3^3 + k 3^2 + n 3 + s;
Subscript[eq, lam] =
Sum[Co[j, k, m]*Co[m, n, s] - Co[k, n, m]*Co[j, m, s], {m, 0, 2,
1}], {j, 0, 2, 1}, {k, 0, 2, 1}, {n, 0, 2, 1}, {s, 0, 2, 1}]
p = Flatten[Table[Subscript[x, i] Subscript[x, j] -> y[i + j],
{j, 1, 26}, {i, 1, 26}]];
Subscript[eq, 0] /. p

(*Out[]= -y[4] - y[8] + y[10] + y[20]*)

Subscript[eq, 80] /. p

(*Out[]= y[32] + y[42] - y[44] - y[48]*)

• Thanks. However, your definition of y[k] (Subscript[x, i] Subscript[x, j] -> y[i + j]) doesnt coincide with mine. Is it possible to mix loop and table? Dec 1 '18 at 8:51
• @Chipa-Chipa I just showed how to use the rule xx->y. You can use any rule that does not violate symmetry $x_ix_j=x_jx_i$. Dec 1 '18 at 11:06

Define equations

 Do[{i, j, k} = {0, 0, IntegerDigits[l, 3][[1]]};
Co[i, j, k] = Subscript[x, l], {l, 0, 2, 1}]
Do[{i, j, k} = {0, IntegerDigits[l, 3][[1]],
IntegerDigits[l, 3][[2]]};
Co[i, j, k] = Subscript[x, l], {l, 3, 8, 1}]
Do[{i, j, k} = {IntegerDigits[l, 3][[1]], IntegerDigits[l, 3][[2]],
IntegerDigits[l, 3][[3]]};
Co[i, j, k] = Subscript[x, l], {l, 9, 26, 1}]
Do[lam = j 3^3 + k 3^2 + n 3 + s;
Subscript[eq, lam] =
Sum[Co[j, k, m]*Co[m, n, s] - Co[k, n, m]*Co[j, m, s], {m, 0, 2,
1}], {j, 0, 2, 1}, {k, 0, 2, 1}, {n, 0, 2, 1}, {s, 0, 2, 1}]


Define rules

sss = {}; l = 0;
Do[Do[AppendTo[sss, Subscript[x, i] Subscript[x, j] -> y[l]];
l = l + 1, {j, i, 26}], {i, 0, 26}];


New equations in terms of the new variables

Do[Subscript[eqq, k] = Subscript[eq, k] /. sss, {k, 0, 80}];