Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I tried to get a solution with 12 digits of precision using N[_,12] and WorkingPrecision -> 12. However all my trials failed.

The following is my notebook file.

q = 31;
For[i = 2, i <= 15, i++, p[2 i] = i];
N[
  Solve[
    Join[
      Table[Sum[w[i] r[i]^(2 k), {i, 1, q}] == 
        Gamma[k + 1/2.]/Sqrt[Pi], {k, 0, (q + 1)/2}], 
      {r[1] == 0}, 
      Table[r[i] == -r[i + 1], {i, 2, (q - 1), 2}], 
      Table[r[i] == p[i] r[2], {i, 4, q - 1, 2}], 
      Table[w[i] == w[i + 1], {i, 2, q - 1, 2}]],
    Join[Table[w[i], {i, 1, q}], Table[r[i], {i, 1, q}]], 
    WorkingPrecision -> 12],
  12][[29]]

The result is the following.

{w[1.00000000000] -> 0.234777, w[2.00000000000] -> 0.197447, 
 w[3.00000000000] -> 0.197447, w[4.00000000000] -> 0.117446, 
 w[5.00000000000] -> 0.117446, w[6.00000000000] -> 0.0494099, 
 w[7.00000000000] -> 0.0494099, w[8.00000000000] -> 0.0147022, 
 w[9.00000000000] -> 0.0147022, w[10.0000000000] -> 0.00309414, 
 w[11.0000000000] -> 0.00309414, w[12.0000000000] -> 0.000460564, 
 w[13.0000000000] -> 0.000460564, w[14.0000000000] -> 0.0000484875, 
 w[15.0000000000] -> 0.0000484875, w[16.0000000000] -> 3.61045*10^-6, 
 w[17.0000000000] -> 3.61045*10^-6, w[18.0000000000] -> 1.90144*10^-7,
 w[19.0000000000] -> 1.90144*10^-7, w[20.0000000000] -> 7.08261*10^-9, 
 w[21.0000000000] -> 7.08261*10^-9, w[22.0000000000] -> 1.86595*10^-10, 
 w[23.0000000000] -> 1.86595*10^-10, w[24.0000000000] -> 3.47566*10^-12, 
 w[25.0000000000] -> 3.47566*10^-12, w[26.0000000000] -> 4.58847*10^-14, 
 w[27.0000000000] -> 4.58847*10^-14, w[28.0000000000] -> 4.18496*10^-16, 
 w[29.0000000000] -> 4.18496*10^-16, w[30.0000000000] -> 3.29279*10^-18, 
 w[31.0000000000] -> 3.29279*10^-18, r[31.0000000000] -> -6.24196, 
 r[30.0000000000] -> 6.24196, r[29.0000000000] -> -5.82583, 
 r[28.0000000000] -> 5.82583, r[27.0000000000] -> -5.4097, 
 r[26.0000000000] -> 5.4097, r[25.0000000000] -> -4.99357, 
 r[24.0000000000] -> 4.99357, r[23.0000000000] -> -4.57744, 
 r[22.0000000000] -> 4.57744, r[21.0000000000] -> -4.16131, 
 r[20.0000000000] -> 4.16131, r[19.0000000000] -> -3.74518, 
 r[18.0000000000] -> 3.74518, r[17.0000000000] -> -3.32905, 
 r[16.0000000000] -> 3.32905, r[15.0000000000] -> -2.91292, 
 r[14.0000000000] -> 2.91292, r[13.0000000000] -> -2.49679, 
 r[12.0000000000] -> 2.49679, r[11.0000000000] -> -2.08065, 
 r[10.0000000000] -> 2.08065, r[9.00000000000] -> -1.66452, 
 r[8.00000000000] -> 1.66452, r[7.00000000000] -> -1.24839, 
 r[6.00000000000] -> 1.24839, r[5.00000000000] -> -0.832262, 
 r[4.00000000000] -> 0.832262, r[3.00000000000] -> -0.416131, 
 r[1.00000000000] -> 0., r[2.00000000000] -> 0.416131}

What I want to get is something like w[1]-> 0.234777123456 (12 digits) and not 0.234777 (6 digits).

share|improve this question
    
I need to solve the question with Solve but not with Nsolve because I have tried to use Nsolve, however, the calculation continues and does not finish. –  nes Jul 6 '13 at 8:48
4  
This question appears to be off-topic because it is too localized and probably not helpful for future visitors. –  Yves Klett Jul 6 '13 at 21:37
add comment

closed as off-topic by Yves Klett, Oleksandr R., m_goldberg, Artes, Michael E2 Jul 8 '13 at 0:42

  • The question does not concern the technical computing software Mathematica by Wolfram Research. Please see the help center to find out about the topics that can be asked here.
If this question can be reworded to fit the rules in the help center, please edit the question.

3 Answers

This is a rather complex set of equations. It would have been better to try this first with something smaller. Setting q to 5 certainly gives a quicker result and helps identify the issue.

Firstly, if you want approximate numerical numbers, it makes no sense to use Solve. Use NSolve instead. Also, you are not actually setting your numerical quantities to have the desired precision, using SetPrecision. You are just setting WorkingPrecision, which is not the same thing. Try the following instead:

NSolve[SetPrecision[
  Join[Table[
    Sum[w[i] r[i]^(2 k), {i, 1, q}] == Gamma[k + 1/2.]/Sqrt[Pi], {k, 
     0, (q + 1)/2}], {r[1] == 0}, 
   Table[r[i] == -r[i + 1], {i, 2, (q - 1), 2}], 
   Table[r[i] == p[i] r[2], {i, 4, q - 1, 2}], 
   Table[w[i] == w[i + 1], {i, 2, q - 1, 2}]], 12], 
 Join[Table[w[i], {i, 1, q}], Table[r[i], {i, 1, q}]], 
 WorkingPrecision -> 12] 

I certainly get results with twelve decimal places when I do it this way.

In fact you can take the WorkingPrecision option out and get the same result.

share|improve this answer
    
Nsolve does not give any solution when q=31. It seems it takes too much time than Solve. I would like to get a solution of Solve with 12 digits. –  nes Jul 6 '13 at 8:04
    
Is there a particular reason why you want 12 digits, or is that just because you are trying to find ways to reduce the calculation time? In any case, difficulties solving this particular system is a separate question to the one you asked about how to enforce a particular precision. I did actually answer the one you asked. –  Verbeia Jul 6 '13 at 12:11
add comment

Some of the equations are simple substitutions. You can simplify the job by using them to reduce the complexity of the system. Rewrite them using Rule and store them in a variable substitutionRules. Use ReplacedRepeated (//.) to eliminate many of the variables in the system and to recover their values at the end.

Also FindRoot works well (and fairly quickly) on the reduced problem. The system seems to require a higher WorkingPrecision and MaxIterations, in order to for FindRoot not to complain. One can then reduce the number of digits to 12, as desired. (Note: I changed Gamma[k + 1/2.] to be exact, to make arbitrary precision possible.)

substitutionRules = Join[
   {r[1] -> 0},
   Table[r[i + 1] -> -r[i], {i, 2, (q - 1), 2}],
   Table[r[i] -> p[i] r[2], {i, 4, q - 1, 2}],
   Table[w[i + 1] -> w[i], {i, 2, q - 1, 2}]
   ];
sol = FindRoot[
   Table[Sum[w[i] r[i]^(2 k), {i, 1, q}] - 
      Gamma[k + 1/2]/Sqrt[Pi], {k, 0, (q + 1)/2}] //. 
    substitutionRules,
   Transpose[{#, Array[1/2/q &, Length[#] - 1] ~Append~ 1}] &@
    Join[{w[1]}, Table[w[i], {i, 2, q, 2}], {r[2]}],
   WorkingPrecision -> 24, MaxIterations -> 300
   ] /. HoldPattern[v_ -> ans_] :> v -> N[ans, 12]

(* {w[1]  -> 0.234779427192,        w[2]  -> 0.197448451490, 
    w[4]  -> 0.117445075622,        w[6]  -> 0.0494086830802, 
    w[8]  -> 0.0147014147974,       w[10] -> 0.00309387221155, 
    w[12] -> 0.000460503563940,     w[14] -> 0.0000484787058109, 
    w[16] -> 3.60957754733*10^-6,   w[18] -> 1.90085672828*10^-7, 
    w[20] -> 7.07991595053*10^-9,   w[22] -> 1.86512020617*10^-10, 
    w[24] -> 3.47427494505*10^-12,  w[26] -> 4.58816624769*10^-14, 
    w[28] -> 4.18614945467*10^-16,  w[30] -> 3.29353033309*10^-18, 
    r[2]  -> 0.416135699877} *)

You can then use the substitutionRules to recover all the variables values as follows:

Thread[# -> (# //. substitutionRules /. sol)] &@
 Join[Table[w[i], {i, 1, q}], Table[r[i], {i, 1, q}]]
(* output omitted *)
share|improve this answer
add comment

I have found an answer!

q = 31;
For[i = 2, i <= 15, i++, p[2 i] = i];
SetPrecision[
 Solve[
   Join[
    Table[
     Sum[w[i] r[i]^(2 k), {i, 1, q}] == Gamma[k + 1/2.]/Sqrt[Pi], {k, 
      0, (q + 1)/2}], {r[1] == 0},
    Table[r[i] == -r[i + 1], {i, 2, (q - 1), 2}], 
    Table[r[i] == p[i] r[2], {i, 4, q - 1, 2}], 
    Table[w[i] == w[i + 1], {i, 2, q - 1, 2}]
    ], Join[Table[w[i], {i, 1, q}], Table[r[i], {i, 1, q}]]
   ][[29]], 12]
share|improve this answer
1  
You realise that this is just padding the result with rubbish and that none of the additional places are actually significant? –  Oleksandr R. Jul 6 '13 at 21:55
add comment

protected by Community Jul 6 '13 at 17:37

Thank you for your interest in this question. Because it has attracted low-quality answers, posting an answer now requires 10 reputation on this site.

Would you like to answer one of these unanswered questions instead?

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