0
$\begingroup$

I have 6 unknown. I want to solve this equation numerically and analytically. First, I tried to solve numerically and it takes too much time for 6 unknown. I need your help, here is my code

Q=ReplaceAll[Table [ Subscript[u, n] == (Subscript[u, n + 1] + Subscript[u, n - 1]) + Subscript[u, n]^3, {n, 1, 6} ], {Subscript[u, 0]-> 0, Subscript[u, 7] -> 0} ] Simplify[NSolve[Q, {Subscript[u, 1], Subscript[u, 2], Subscript[u,3],Subscript[u, 4],Subscript[u, 5],Subscript[u, 6]}]] 

Is there any way to simplify it? Thank you for your help.

$\endgroup$
7
  • 1
    $\begingroup$ What is 0->0? you should look at Recurrence Table or Difference equations . $\endgroup$ Commented Jan 27, 2020 at 9:36
  • $\begingroup$ It is a boundary condition $\endgroup$ Commented Jan 27, 2020 at 12:04
  • $\begingroup$ Did you check that the result of Q makes sense? Note that it involves the variable Subscript[u, 8], but this is not included in the variables listed in NSolve[]. $\endgroup$ Commented Jan 27, 2020 at 12:08
  • 3
    $\begingroup$ Considering that the result of First[GroebnerBasis[{u1 == u1^3 + u2, u2 == u1 + u2^3 + u3, u3 == u2 + u3^3 + u4, u4 == u3 + u4^3 + u5, u5 == u4 + u5^3 + u6, u6 == u5 + u6^3}, {u6, u5, u4, u3, u2, u1}]] is a degree-729 (!) polynomial with frighteningly huge coefficients, I'm not surprised solving for solutions is difficult. $\endgroup$ Commented Jan 27, 2020 at 12:34
  • 1
    $\begingroup$ @J.M. showed exactly how. To repeat: first element in a Groebner basis for the system is a univariate polynomial of degree 729. Every root of that polynomial will be part of a solution to the full system. There are moreover no multiple roots; the polynomial does not have and factors of degree larger than 1. $\endgroup$ Commented Jan 27, 2020 at 15:17

1 Answer 1

1
$\begingroup$

You can get a fast solution, if you solve for u1 analytically with the help of GroebnerBasis and find the other ui with FindRoot to desired accuracy.

eqs = {u1 == u1^3 + u2, u2 == u1 + u2^3 + u3, u3 == u2 + u3^3 + u4, u4 == u3 + u4^3 + u5, u5 == u4 + u5^3 + u6, u6 == u5 + u6^3}; gb6 = GroebnerBasis[eqs, {u6, u5, u4, u3, u2, u1}]; s61 = Flatten[Solve[0 == gb6[[1]], u1, Reals], 1]; $MaxExtraPrecision = 500; g6rule = Transpose[{s61 // N[#, 20] &, First@FindRoot[0 == (gb6[[2]] /. #), {u2, 1}, WorkingPrecision -> 25] & /@ s61, First@FindRoot[0 == (gb6[[3]] /. #), {u3, 1}, WorkingPrecision -> 25] & /@ s61, First@FindRoot[0 == (gb6[[4]] /. #), {u4, 1}, WorkingPrecision -> 25] & /@ s61, First@FindRoot[0 == (gb6[[5]] /. #), {u5, 1}, WorkingPrecision -> 25] & /@ s61, First@FindRoot[0 == (gb6[[6]] /. #), {u6, 1}, WorkingPrecision -> 25] & /@ s61}] 

Result is to long to show here. Test of accuracy:

fs = #[[1]] - #[[2]] & /@ eqs fs /. g6rule // Chop[#, 10^-18] & (* {{0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0}} *) 
$\endgroup$
3
  • $\begingroup$ Thank you Akku14, I think it works, If those unknowns have coefficients like, eqs = {u1 == (0.75 + 0.25 *(-1)) (u1^3 + u2), (0.75 + 0.25 (1)) (u2 == u1 + u2^3 + u3), (0.75 + 0.25 (-1)) (u3 == u2 + u3^3 + u4), (0.75 + 0.25 (1)) (u4 == u3 + u4^3 + u5), (0.75 + 0.25 (-1)) (u5 == u4 + u5^3 + u6), (0.75 + 0.25 (1)) (u6 == u5 + u6^3)} How these systems could solve? Thanks $\endgroup$ Commented Jan 28, 2020 at 8:31
  • $\begingroup$ For u2 to u6, you multiplied both sides of equations with the same factor. This changes nothing. Correct it to eqs = {u1 == (0.75 + 0.25*(-1)) (u1^3 + u2), u2 == (0.75 + 0.25 (1)) (u1 + u2^3 + u3), u3 == (0.75 + 0.25 (-1)) (u2 + u3^3 + u4), u4 == (0.75 + 0.25 (1)) (u3 + u4^3 + u5), u5 == (0.75 + 0.25 (-1)) (u4 + u5^3 + u6), u6 == (0.75 + 0.25 (1)) (u5 + u6^3)} // Rationalize[#, 0] & // ExpandAll and the same procedure as in my answer works fine. Rationalize is in order to get an analytical solution for u1, which allows to get highprecision for the other ui. $\endgroup$ Commented Jan 28, 2020 at 8:47
  • $\begingroup$ It is not same factor, for odd numbers coefficient is 0.5; for even numbers coefficient is 1 $\endgroup$ Commented Jan 28, 2020 at 11:19

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.