2
$\begingroup$

Could anyone help to solve the system of 81 quadratic equations with 27 variables? The system has solutions. Constraint: $\sum_{i=0}^{26} x^2_i=1$

$-x_1 x_3-x_2 x_6+x_1 x_9+x_2 x_{18}=0$

$-x_1 x_4-x_2 x_7+x_1 x_{10}+x_2 x_{19}=0$

$-x_1 x_5-x_2 x_8+x_1 x_{11}+x_2 x_{20}=0$

$-x_3 x_4-x_5 x_6+x_1 x_{12}+x_2 x_{21}=0$

$-x_1 x_3+x_0 x_4-x_4^2-x_5 x_7+x_1 x_{13}+x_2 x_{22}=0$

$-x_2 x_3+x_0 x_5-x_4 x_5-x_5 x_8+x_1 x_{14}+x_2 x_{23}=0$

$-x_3 x_7-x_6 x_8+x_1 x_{15}+x_2 x_{24}=0$

$-x_1 x_6+x_0 x_7-x_4 x_7-x_7 x_8+x_1 x_{16}+x_2 x_{25}=0$

$-x_2 x_6-x_5 x_7+x_0 x_8-x_8^2+x_1 x_{17}+x_2 x_{26}=0$

$x_0 x_3-x_0 x_9+x_4 x_9-x_3 x_{10}-x_6 x_{11}+x_5 x_{18}=0$

$x_1 x_3-x_1 x_9-x_7 x_{11}+x_5 x_{19}=0$

$x_2 x_3-x_2 x_9-x_5 x_{10}+x_4 x_{11}-x_8 x_{11}+x_5 x_{20}=0$

$x_3^2-x_0 x_{12}+x_4 x_{12}-x_3 x_{13}-x_6 x_{14}+x_5 x_{21}=0$

$x_3 x_4-x_1 x_{12}-x_7 x_{14}+x_5 x_{22}=0$

$x_3 x_5-x_2 x_{12}-x_5 x_{13}+x_4 x_{14}-x_8 x_{14}+x_5 x_{23}=0$

$x_3 x_6-x_0 x_{15}+x_4 x_{15}-x_3 x_{16}-x_6 x_{17}+x_5 x_{24}=0$

$x_3 x_7-x_1 x_{15}-x_7 x_{17}+x_5 x_{25}=0$

$x_3 x_8-x_2 x_{15}-x_5 x_{16}+x_4 x_{17}-x_8 x_{17}+x_5 x_{26}=0$

$x_0 x_6+x_7 x_9-x_0 x_{18}+x_8 x_{18}-x_3 x_{19}-x_6 x_{20}=0$

$x_1 x_6+x_7 x_{10}-x_1 x_{18}-x_4 x_{19}+x_8 x_{19}-x_7 x_{20}=0$

$x_2 x_6+x_7 x_{11}-x_2 x_{18}-x_5 x_{19}=0$

$x_3 x_6+x_7 x_{12}-x_0 x_{21}+x_8 x_{21}-x_3 x_{22}-x_6 x_{23}=0$

$x_4 x_6+x_7 x_{13}-x_1 x_{21}-x_4 x_{22}+x_8 x_{22}-x_7 x_{23}=0$

$x_5 x_6+x_7 x_{14}-x_2 x_{21}-x_5 x_{22}=0$

$x_6^2+x_7 x_{15}-x_0 x_{24}+x_8 x_{24}-x_3 x_{25}-x_6 x_{26}=0$

$x_6 x_7+x_7 x_{16}-x_1 x_{24}-x_4 x_{25}+x_8 x_{25}-x_7 x_{26}=0$

$x_6 x_8+x_7 x_{17}-x_2 x_{24}-x_5 x_{25}=0$

$x_9 x_{10}-x_1 x_{12}-x_2 x_{15}+x_{11} x_{18}=0$

$x_1 x_9-x_0 x_{10}+x_{10}^2-x_1 x_{13}-x_2 x_{16}+x_{11} x_{19}=0$

$x_2 x_9-x_0 x_{11}+x_{10} x_{11}-x_1 x_{14}-x_2 x_{17}+x_{11} x_{20}=0$

$-x_4 x_{12}+x_{10} x_{12}-x_5 x_{15}+x_{11} x_{21}=0$

$x_4 x_9-x_3 x_{10}-x_4 x_{13}+x_{10} x_{13}-x_5 x_{16}+x_{11} x_{22}=0$

$x_5 x_9-x_3 x_{11}-x_4 x_{14}+x_{10} x_{14}-x_5 x_{17}+x_{11} x_{23}=0$

$-x_7 x_{12}-x_8 x_{15}+x_{10} x_{15}+x_{11} x_{24}=0$

$x_7 x_9-x_6 x_{10}-x_7 x_{13}-x_8 x_{16}+x_{10} x_{16}+x_{11} x_{25}=0$

$x_8 x_9-x_6 x_{11}-x_7 x_{14}-x_8 x_{17}+x_{10} x_{17}+x_{11} x_{26}=0$

$-x_9^2+x_0 x_{12}-x_{10} x_{12}+x_9 x_{13}-x_{11} x_{15}+x_{14} x_{18}=0$

$-x_9 x_{10}+x_1 x_{12}-x_{11} x_{16}+x_{14} x_{19}=0$

$-x_9 x_{11}+x_2 x_{12}+x_{11} x_{13}-x_{10} x_{14}-x_{11} x_{17}+x_{14} x_{20}=0$

$x_3 x_{12}-x_9 x_{12}-x_{14} x_{15}+x_{14} x_{21}=0$

$x_4 x_{12}-x_{10} x_{12}-x_{14} x_{16}+x_{14} x_{22}=0$

$x_5 x_{12}-x_{11} x_{12}-x_{14} x_{17}+x_{14} x_{23}=0$

$x_6 x_{12}-x_9 x_{15}+x_{13} x_{15}-x_{12} x_{16}-x_{15} x_{17}+x_{14} x_{24}=0$

$x_7 x_{12}-x_{10} x_{15}-x_{16} x_{17}+x_{14} x_{25}=0$

$x_8 x_{12}-x_{11} x_{15}-x_{14} x_{16}+x_{13} x_{17}-x_{17}^2+x_{14} x_{26}=0$

$x_0 x_{15}+x_9 x_{16}-x_9 x_{18}+x_{17} x_{18}-x_{12} x_{19}-x_{15} x_{20}=0$

$x_1 x_{15}+x_{10} x_{16}-x_{10} x_{18}-x_{13} x_{19}+x_{17} x_{19}-x_{16} x_{20}=0$

$x_2 x_{15}+x_{11} x_{16}-x_{11} x_{18}-x_{14} x_{19}=0$

$x_3 x_{15}+x_{12} x_{16}-x_9 x_{21}+x_{17} x_{21}-x_{12} x_{22}-x_{15} x_{23}=0$

$x_4 x_{15}+x_{13} x_{16}-x_{10} x_{21}-x_{13} x_{22}+x_{17} x_{22}-x_{16} x_{23}=0$

$x_5 x_{15}+x_{14} x_{16}-x_{11} x_{21}-x_{14} x_{22}=0$

$x_6 x_{15}+x_{15} x_{16}-x_9 x_{24}+x_{17} x_{24}-x_{12} x_{25}-x_{15} x_{26}=0$

$x_7 x_{15}+x_{16}^2-x_{10} x_{24}-x_{13} x_{25}+x_{17} x_{25}-x_{16} x_{26}=0$

$x_8 x_{15}+x_{16} x_{17}-x_{11} x_{24}-x_{14} x_{25}=0$

$x_9 x_{19}+x_{18} x_{20}-x_1 x_{21}-x_2 x_{24}=0$

$x_1 x_{18}-x_0 x_{19}+x_{10} x_{19}+x_{19} x_{20}-x_1 x_{22}-x_2 x_{25}=0$

$x_2 x_{18}+x_{11} x_{19}-x_0 x_{20}+x_{20}^2-x_1 x_{23}-x_2 x_{26}=0$

$x_{12} x_{19}-x_4 x_{21}+x_{20} x_{21}-x_5 x_{24}=0$

$x_4 x_{18}-x_3 x_{19}+x_{13} x_{19}-x_4 x_{22}+x_{20} x_{22}-x_5 x_{25}=0$

$x_5 x_{18}+x_{14} x_{19}-x_3 x_{20}-x_4 x_{23}+x_{20} x_{23}-x_5 x_{26}=0$

$x_{15} x_{19}-x_7 x_{21}-x_8 x_{24}+x_{20} x_{24}=0$

$x_7 x_{18}-x_6 x_{19}+x_{16} x_{19}-x_7 x_{22}-x_8 x_{25}+x_{20} x_{25}=0$

$x_8 x_{18}+x_{17} x_{19}-x_6 x_{20}-x_7 x_{23}-x_8 x_{26}+x_{20} x_{26}=0$

$-x_9 x_{18}+x_0 x_{21}-x_{10} x_{21}+x_9 x_{22}+x_{18} x_{23}-x_{11} x_{24}=0$

$-x_9 x_{19}+x_1 x_{21}+x_{19} x_{23}-x_{11} x_{25}=0$

$-x_9 x_{20}+x_2 x_{21}+x_{11} x_{22}-x_{10} x_{23}+x_{20} x_{23}-x_{11} x_{26}=0$

$-x_{12} x_{18}+x_3 x_{21}-x_{13} x_{21}+x_{12} x_{22}+x_{21} x_{23}-x_{14} x_{24}=0$

$-x_{12} x_{19}+x_4 x_{21}+x_{22} x_{23}-x_{14} x_{25}=0$

$-x_{12} x_{20}+x_5 x_{21}+x_{14} x_{22}-x_{13} x_{23}+x_{23}^2-x_{14} x_{26}=0$

$-x_{15} x_{18}+x_6 x_{21}-x_{16} x_{21}+x_{15} x_{22}-x_{17} x_{24}+x_{23} x_{24}=0$

$-x_{15} x_{19}+x_7 x_{21}-x_{17} x_{25}+x_{23} x_{25}=0$

$-x_{15} x_{20}+x_8 x_{21}+x_{17} x_{22}-x_{16} x_{23}-x_{17} x_{26}+x_{23} x_{26}=0$

$-x_{18}^2-x_{19} x_{21}+x_0 x_{24}-x_{20} x_{24}+x_9 x_{25}+x_{18} x_{26}=0$

$-x_{18} x_{19}-x_{19} x_{22}+x_1 x_{24}+x_{10} x_{25}-x_{20} x_{25}+x_{19} x_{26}=0$

$-x_{18} x_{20}-x_{19} x_{23}+x_2 x_{24}+x_{11} x_{25}=0$

$-x_{18} x_{21}-x_{21} x_{22}+x_3 x_{24}-x_{23} x_{24}+x_{12} x_{25}+x_{21} x_{26}=0$

$-x_{19} x_{21}-x_{22}^2+x_4 x_{24}+x_{13} x_{25}-x_{23} x_{25}+x_{22} x_{26}=0$

$-x_{20} x_{21}-x_{22} x_{23}+x_5 x_{24}+x_{14} x_{25}=0$

$x_6 x_{24}-x_{18} x_{24}+x_{15} x_{25}-x_{21} x_{25}=0$

$x_7 x_{24}-x_{19} x_{24}+x_{16} x_{25}-x_{22} x_{25}=0$

$x_8 x_{24}-x_{20} x_{24}+x_{17} x_{25}-x_{23} x_{25}=0$

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}]

Solve[
 Subscript[eq, 1] == 0 && Subscript[eq, 2] == 0 && 
  Subscript[eq, 3] == 0 && Subscript[eq, 4] == 0 && 
  Subscript[eq, 5] == 0 && Subscript[eq, 6] == 0 && 
  Subscript[eq, 7] == 0 && Subscript[eq, 8] == 0 && 
 Subscript[eq, 9] == 0 && Subscript[eq, 10] == 0 &&
  Subscript[eq, 11] == 0 && Subscript[eq, 12] == 0 && 
  Subscript[eq, 13] == 0 && Subscript[eq, 14] == 0 && 
  Subscript[eq, 15] == 0 && Subscript[eq, 16] == 0 && 
  Subscript[eq, 17] == 0 && Subscript[eq, 18] == 0 && 
  Subscript[eq, 19] == 0 && Subscript[eq, 20] == 0 &&
  Subscript[eq, 21] == 0 && Subscript[eq, 22] == 0 && 
  Subscript[eq, 23] == 0 && Subscript[eq, 24] == 0 && 
  Subscript[eq, 25] == 0 && Subscript[eq, 26] == 0 && 
  Subscript[eq, 27] == 0 && Subscript[eq, 28] == 0 && 
  Subscript[eq, 29] == 0 && Subscript[eq, 30] == 0 &&
  Subscript[eq, 31] == 0 && Subscript[eq, 32] == 0 && 
  Subscript[eq, 33] == 0 && Subscript[eq, 34] == 0 && 
  Subscript[eq, 35] == 0 && Subscript[eq, 36] == 0 && 
  Subscript[eq, 37] == 0 && Subscript[eq, 38] == 0 && 
  Subscript[eq, 39] == 0 && Subscript[eq, 40] == 0 &&
  Subscript[eq, 41] == 0 && Subscript[eq, 42] == 0 && 
  Subscript[eq, 43] == 0 && Subscript[eq, 44] == 0 && 
  Subscript[eq, 45] == 0 && Subscript[eq, 46] == 0 && 
  Subscript[eq, 47] == 0 && Subscript[eq, 48] == 0 && 
  Subscript[eq, 49] == 0 && Subscript[eq, 50] == 0 &&
  Subscript[eq, 51] == 0 && Subscript[eq, 52] == 0 && 
  Subscript[eq, 53] == 0 && Subscript[eq, 54] == 0 && 
  Subscript[eq, 55] == 0 && Subscript[eq, 56] == 0 && 
  Subscript[eq, 57] == 0 && Subscript[eq, 58] == 0 && 
  Subscript[eq, 59] == 0 && Subscript[eq, 60] == 0 &&
  Subscript[eq, 61] == 0 && Subscript[eq, 62] == 0 && 
  Subscript[eq, 63] == 0 && Subscript[eq, 64] == 0 && 
  Subscript[eq, 65] == 0 && Subscript[eq, 66] == 0 && 
  Subscript[eq, 67] == 0 && Subscript[eq, 68] == 0 && 
  Subscript[eq, 69] == 0 && Subscript[eq, 70] == 0 &&
  Subscript[eq, 71] == 0 && Subscript[eq, 72] == 0 && 
  Subscript[eq, 73] == 0 && Subscript[eq, 74] == 0 && 
  Subscript[eq, 75] == 0 && Subscript[eq, 76] == 0 && 
  Subscript[eq, 77] == 0 && Subscript[eq, 78] == 0 && 
  Subscript[eq, 79] == 0 && Subscript[eq, 80] == 0 &&
  Subscript[eq, 0] == 0
 , {Subscript[x, 0], Subscript[x, 1], Subscript[x, 2], Subscript[x, 
  3], Subscript[x, 4], Subscript[x, 5], Subscript[x, 6], Subscript[x, 
  7], Subscript[x, 8], Subscript[x, 9], Subscript[x, 10], Subscript[x,
   11], Subscript[x, 12], Subscript[x, 13], Subscript[x, 14], 
  Subscript[x, 15], Subscript[x, 16], Subscript[x, 17], Subscript[x, 
  18], Subscript[x, 19], Subscript[x, 20], Subscript[x, 21], 
  Subscript[x, 22], Subscript[x, 23], Subscript[x, 24], Subscript[x, 
     25], Subscript[x, 26]}]
$\endgroup$
  • 3
    $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Michael E2 Nov 23 '18 at 21:46
  • $\begingroup$ People here generally like users to post code as Mathematica code instead of just images or TeX, so they can copy-paste it. It makes it convenient for them and more likely you will get someone to help you. You may find this this meta Q&A helpful $\endgroup$ – Michael E2 Nov 23 '18 at 21:47
  • $\begingroup$ Maybe FindMinimum[#.#&[eqns /. Equal -> Subtract], Variables[eqns /. Equal -> Subtract]]... $\endgroup$ – Michael E2 Nov 23 '18 at 21:50
  • 2
    $\begingroup$ I don't know if I could solve it given input (probably not would be my guess). I do know I cannot solve it without cut-and-pastable input. $\endgroup$ – Daniel Lichtblau Nov 23 '18 at 21:51
  • $\begingroup$ How do you know that this system of equations has a solution. Also, are the variables Real? By the way, your code is missing the normalization equation. (sum of squares equals 1). $\endgroup$ – bbgodfrey Nov 24 '18 at 0:51
4
$\begingroup$
NMinimize[Total[Map[Norm,{
  x0^2+x1^2+x2^2+x3^2+x4^2+x5^2+x6^2+x7^2+x8^2+x9^2+
  x10^2+x11^2+x12^2+x13^2+x14^2+x15^2+x16^2+x17^2+x18^2+x19^2+
  x20^2+x21^2+x22^2+x23^2+x24^2+x25^2+x26^2-1,
  -x1*x3-x2*x6+x1*x9+x2*x18,
  -x1*x4-x2*x7+x1*x10+x2*x19,
  -x1*x5-x2*x8+x1*x11+x2*x20,
  -x3*x4-x5*x6+x1*x12+x2*x21,
  -x1*x3+x0*x4-x4^2-x5*x7+x1*x13+x2*x22,
  -x2*x3+x0*x5-x4*x5-x5*x8+x1*x14+x2*x23,
  -x3*x7-x6*x8+x1*x15+x2*x24,
  -x1*x6+x0*x7-x4*x7-x7*x8+x1*x16+x2*x25,
  -x2*x6-x5*x7+x0*x8-x8^2+x1*x17+x2*x26,
  x0*x3-x0*x9+x4*x9-x3*x10-x6*x11+x5*x18,
  x1*x3-x1*x9-x7*x11+x5*x19,
  x2*x3-x2*x9-x5*x10+x4*x11-x8*x11+x5*x20,
  x3^2-x0*x12+x4*x12-x3*x13-x6*x14+x5*x21,
  x3*x4-x1*x12-x7*x14+x5*x22,
  x3*x5-x2*x12-x5*x13+x4*x14-x8*x14+x5*x23,
  x3*x6-x0*x15+x4*x15-x3*x16-x6*x17+x5*x24,
  x3*x7-x1*x15-x7*x17+x5*x25,
  x3*x8-x2*x15-x5*x16+x4*x17-x8*x17+x5*x26,
  x0*x6+x7*x9-x0*x18+x8*x18-x3*x19-x6*x20,
  x1*x6+x7*x10-x1*x18-x4*x19+x8*x19-x7*x20,
  x2*x6+x7*x11-x2*x18-x5*x19,
  x3*x6+x7*x12-x0*x21+x8*x21-x3*x22-x6*x23,
  x4*x6+x7*x13-x1*x21-x4*x22+x8*x22-x7*x23,
  x5*x6+x7*x14-x2*x21-x5*x22,
  x6^2+x7*x15-x0*x24+x8*x24-x3*x25-x6*x26,
  x6*x7+x7*x16-x1*x24-x4*x25+x8*x25-x7*x26,
  x6*x8+x7*x17-x2*x24-x5*x25,
  x9*x10-x1*x12-x2*x15+x11*x18,
  x1*x9-x0*x10+x10^2-x1*x13-x2*x16+x11*x19,
  x2*x9-x0*x11+x10*x11-x1*x14-x2*x17+x11*x20,
  -x4*x12+x10*x12-x5*x15+x11*x21,
  x4*x9-x3*x10-x4*x13+x10*x13-x5*x16+x11*x22,
  x5*x9-x3*x11-x4*x14+x10*x14-x5*x17+x11*x23,
  -x7*x12-x8*x15+x10*x15+x11*x24,
  x7*x9-x6*x10-x7*x13-x8*x16+x10*x16+x11*x25,
  x8*x9-x6*x11-x7*x14-x8*x17+x10*x17+x11*x26,
  -x9^2+x0*x12-x10*x12+x9*x13-x11*x15+x14*x18,
  -x9*x10+x1*x12-x11*x16+x14*x19,
  -x9*x11+x2*x12+x11*x13-x10*x14-x11*x17+x14*x20,
  x3*x12-x9*x12-x14*x15+x14*x21,
  x4*x12-x10*x12-x14*x16+x14*x22,
  x5*x12-x11*x12-x14*x17+x14*x23,
  x6*x12-x9*x15+x13*x15-x12*x16-x15*x17+x14*x24,
  x7*x12-x10*x15-x16*x17+x14*x25,
  x8*x12-x11*x15-x14*x16+x13*x17-x17^2+x14*x26,
  x0*x15+x9*x16-x9*x18+x17*x18-x12*x19-x15*x20,
  x1*x15+x10*x16-x10*x18-x13*x19+x17*x19-x16*x20,
  x2*x15+x11*x16-x11*x18-x14*x19,
  x3*x15+x12*x16-x9*x21+x17*x21-x12*x22-x15*x23,
  x4*x15+x13*x16-x10*x21-x13*x22+x17*x22-x16*x23,
  x5*x15+x14*x16-x11*x21-x14*x22,
  x6*x15+x15*x16-x9*x24+x17*x24-x12*x25-x15*x26,
  x7*x15+x16^2-x10*x24-x13*x25+x17*x25-x16*x26,
  x8*x15+x16*x17-x11*x24-x14*x25,
  x9*x19+x18*x20-x1*x21-x2*x24,
  x1*x18-x0*x19+x10*x19+x19*x20-x1*x22-x2*x25,
  x2*x18+x11*x19-x0*x20+x20^2-x1*x23-x2*x26,
  x12*x19-x4*x21+x20*x21-x5*x24,
  x4*x18-x3*x19+x13*x19-x4*x22+x20*x22-x5*x25,
  x5*x18+x14*x19-x3*x20-x4*x23+x20*x23-x5*x26,
  x15*x19-x7*x21-x8*x24+x20*x24,
  x7*x18-x6*x19+x16*x19-x7*x22-x8*x25+x20*x25,
  x8*x18+x17*x19-x6*x20-x7*x23-x8*x26+x20*x26,
  -x9*x18+x0*x21-x10*x21+x9*x22+x18*x23-x11*x24,
  -x9*x19+x1*x21+x19*x23-x11*x25,
  -x9*x20+x2*x21+x11*x22-x10*x23+x20*x23-x11*x26,
  -x12*x18+x3*x21-x13*x21+x12*x22+x21*x23-x14*x24,
  -x12*x19+x4*x21+x22*x23-x14*x25,
  -x12*x20+x5*x21+x14*x22-x13*x23+x23^2-x14*x26,
  -x15*x18+x6*x21-x16*x21+x15*x22-x17*x24+x23*x24,
  -x15*x19+x7*x21-x17*x25+x23*x25,
  -x15*x20+x8*x21+x17*x22-x16*x23-x17*x26+x23*x26,
  -x18^2-x19*x21+x0*x24-x20*x24+x9*x25+x18*x26,
  -x18*x19-x19*x22+x1*x24+x10*x25-x20*x25+x19*x26,
  -x18*x20-x19*x23+x2*x24+x11*x25,
  -x18*x21-x21*x22+x3*x24-x23*x24+x12*x25+x21*x26,
  -x19*x21-x22^2+x4*x24+x13*x25-x23*x25+x22*x26,
  -x20*x21-x22*x23+x5*x24+x14*x25,
  x6*x24-x18*x24+x15*x25-x21*x25,
  x7*x24-x19*x24+x16*x25-x22*x25,
  x8*x24-x20*x24+x17*x25-x23*x25}]],
  {x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,
  x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26},WorkingPrecision->32]

which in less than a minute responds with

{1.23221*^-15,
{x0->-0.250578,x1->-0.0381668,x2->0.00865906,x3->0.420365,
 x4->0.0032783,x5->0.0148975,x6->0.0305201,x7->0.0128096,
 x8->-0.172474,x9->0.420365,x10->0.0032783,x11->0.0148975,
 x12->-0.0488025,x13->0.393529,x14->-0.0379868,x15->-0.00345047,
 x16->-0.000137412,x17->0.392945,x18->0.0305201,x19->0.0128096,
 x20->-0.172474,x21->-0.00345047,x22->-0.000137412,x23->0.392945,
 x24->-0.00125624,x25->-0.0147376,x26->0.228844}}

You can adjust WorkingPrecision, PrecisionGoal, AccuracyGoal and other options to to try to get a better approximation if you need that.

Check this very carefully to make certain I have made no mistakes before you depend on it.

$\endgroup$
  • $\begingroup$ Interestingly, I get different results depending on the order of the equations and the value of WorkingPrecision. In no case do I reproduce your result. But, this does not surprise me. Due to the symmetries of the equations, there probably are many solutions. $\endgroup$ – bbgodfrey Nov 24 '18 at 5:01
  • $\begingroup$ I have tried Solve, but at my age I probably would not live long enough to see the result. Even FindInstance produces nothing in a reasonable time. It also devours a lot of memory, perhaps trying to construct a Groebner Basis. $\endgroup$ – bbgodfrey Nov 24 '18 at 5:19
  • $\begingroup$ @ bbgodfrey, I also tried 'Solve' and 'FindInstance'. The problem has solutions that are parameterized. For example, one can consider the case in which all the indices run from 0 to 1. In this case the system obtained (16 equations with 8 variables) has 12 solutions, some of them are parameterized. $\endgroup$ – Chipa-Chipa Nov 24 '18 at 8:42
4
$\begingroup$

Symbolic solutions can be obtained as follows.

Compact derivation of equations

To begin, it is convenient to simplify the code in the question, which is equivalent to

Clear[C0, eq];
Set @@@ Table[{Co @@ IntegerDigits[l, 3, 3], x[l]}, {l, 0, 26}];
eqs = Set @@@ Table[{j, k, n, s} = IntegerDigits[lam, 3, 4]; {eq[lam], 
  Sum[Co[j, k, m]*Co[m, n, s] - Co[k, n, m]*Co[j, m, s], {m, 0, 2}]}, {lam, 0, 80}];
norm = Sum[x[l]^2, {l, 0, 26}];

The natural next step is to try to Solve the 81 equations directly for the 27 variables with

Solve[Thread[eqs == 0], Table[x[l], {l, 0, 26}]]

However, Solve eventually devoured the entire 16 GB memory of my computer and had to be terminated. (It is convenient to ignore the normalization constraint, norm, when attempting to derive a symbolic solution. See one of the OP's comments above.)

Using a Numerical Solution for Guidance

Bill derived an accurate numerical solution earlier. Using the formulation in my answer, a numerical result is obtained by

sol = NMinimize[Total[Map[Norm, Join[eqs, {norm - 1}]]], 
    Table[x[l], {l, 0, 26}], WorkingPrecision -> 30]

Although the result is a bit long to reproduce here, three points should be made. First, norm - 1 must be included in the numerical calculation to avoid the trivial solution. Second, my solution differs substantially from Bill's, which is not surprising, because the equations have many solutions. (See a comment above by the OP.) Third, several pairs of x[_] have the same values to high precision. The pairs can be identified and linked with Rule by

GatherBy[Last[sol], Round[Last[#], 10^-6] &];
sim = Cases[%, {Rule[z1_, _], Rule[z2_, _]} -> Rule[z2, z1]]
(* {x[9] -> x[3], x[10] -> x[4], x[11] -> x[5], x[18] -> x[6], x[19] -> x[7], 
    x[20] -> x[8], x[21] -> x[15], x[22] -> x[16], x[23] -> x[17]} *)

Several other numerical solutions can be obtain by, for instance, varying WorkingPrecision slightly or by reordering the equations in Join[eqs, {norm - 1}]. All have the identical relationships among x[_], suggesting that they represent true identities. Applying these rules reduces the number of independent variables and equations by a third each.

varsim = Union[Table[x[l], {l, 0, 26}] /. sim];
Length@varsim
(* 18 *)

eqssim = DeleteCases[eqs /. sim, 0];
Length@eqssim
(* 54 *)

(27 of the eqs equations vanish identically and can be eliminated.) Unfortunately, Solve cannot handle this reduced set of equations either, crashing after about three hours on my computer.

General Solution

The OP in a comment above described a similar but simpler problem involving eight variables and sixteen equations. Solving that problem is straightforward, resulting in expressions for four of the variables in terms of the other four (or five in terms of three, if norm == 1 is included in the computation.) With this as an example, I found that I could Solve eqssim for the last nine elements of varsim in terms of the first nine elements.

Solve[Thread[eqssim == 0], varsim[[10 ;; 18]]] // Simplify

which yields a general solution of rational expressions for the last nine elements of varsim in about a minute. In other words, nine of the variables can be specified arbitrarily, and from them the other nine can be calculated (ten in terms of eight, if norm == 1 is included). Although the expressions are too long to be reproduced here, an example is

x[12] -> (x[1] x[5] (x[3] x[4] + x[5] x[6]) - x[2] (x[4] x[5] x[6] + x[3] (x[4]^2 + 
    x[5] x[7] - x[4] x[8])))/(x[1]^2 x[5] - x[2]^2 x[7] + x[1] x[2] (-x[4] + x[8]))

Attempting to specify more than half of the variables arbitrarily does not, in general, satisfy eqssim, and Solve returns an empty list as the solution.

Special Solutions

Clearly, the expression above for x[12] of the general solution is invalid for {x[1] -> 0, x[2] -> 0}, in which case many special solutions can be obtained by

n1 = 1; n2 = 2; 
eqs1 = eqs /. {x[n1] -> 0, x[n2] -> 0}; norm1 = norm /. {x[n1] -> 0, x[n2] -> 0};
sol1 = NMinimize[Total[Map[Norm, Join[{norm1 - 1}, eqs1]]], 
    Delete[Table[x[l], {l, 0, 26}], {{n1 + 1}, {n2 + 1}}], WorkingPrecision -> 30];
GatherBy[Last[sol1], Round[Last[#], 10^-6] &];
Cases[%, {Rule[z1_, _], Rule[z2_, _]} -> Rule[z2, z1]];
Cases[sol1, (Rule[z1_, z2_] /; Abs[z2] < 10^-6) -> Rule[z1, 0], 2];
sim1 = Flatten[{{x[n1] -> 0, x[n2] -> 0}, %, %%}]
(* {x[1] -> 0, x[2] -> 0, x[4] -> 0, x[5] -> 0, x[7] -> 0, x[8] -> 0, 
    x[10] -> 0, x[11] -> 0, x[19] -> 0, x[20] -> 0, x[9] -> x[3], 
    x[18] -> x[6], x[21] -> x[15], x[22] -> x[16], x[23] -> x[17]} *)

Applying these rules greatly reduceseqs and the number of remaining variables

varsim1 = DeleteCases[Union[Table[x[l], {l, 0, 26}] /. sim1], 0]
Length@varsim1
(* 12 *)

eqssim1 = DeleteCases[eqs /. sim1, 0]; 
Length@eqssim1
(* 20 *)

Solve[Thread[eqssim1 == 0], varsim1] // Simplify

The resulting list of 67 solutions is quite lengthy and cannot be reproduced here. As a sample, the first special solution is

{x[0] -> (x[3] (x[6] - x[16]) - x[6] x[17])/x[15], 
 x[13] -> x[3] + (x[12] (-x[6] + x[16]))/x[15] + 
     (x[6] (-x[14] + (x[12] x[17])/x[15]))/x[3], 
 x[24] -> (x[6] x[14] x[15] - x[6] x[12] x[17] + x[3] x[15] x[17])/(x[3] x[14]), 
 x[25] -> (x[16] x[17])/x[14], 
 x[26] -> (1/(x[3] x[14] x[15]))(-x[3]^2 x[15] x[17] + x[6] x[17] 
     (x[14] x[15] - x[12] x[17]) + x[3] (x[14] x[15] x[16] + x[17] 
     (x[6] x[12] - x[12] x[16] + x[15] x[17])))}

Of course, several of these solutions are invalid for other x[_] == 0. In the case of x[3] == 0, the same process as applied earlier in this section yields 91 special solutions, all but ten of which are distinct from those above. The total number of special solutions must be very large indeed.

$\endgroup$
0
$\begingroup$

Here one of the possible solutions based on the so-called relinearization technique (see, i.e., https://eprint.iacr.org/2010/596.pdf). The main idea of the technique is to solve the system in terms of y s.t. Subscript[x, i] Subscript[x, j] = Subscript[y, l]

Here I 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}]

Here I set the correspondence rule:

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

Define the newequations in terms of y:

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

Here is the solution:

  Solve[And @@ Table[Subscript[eqq, k] == 0, {k, 0, 80}], 
  Table[y[k], k, 0, 377]]

We have 378 variables and 81 equations. Is it possible to express the solutions in terms of the old variables, x?

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.