# How can I get a result with 12 digits of precision? [closed]

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).

-

## closed as off-topic by Yves Klett, Oleksandr R., m_goldberg, Artes, Michael E2Jul 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.

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

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.

-
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

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 *)

-

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]

-
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

## 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.