5
$\begingroup$

I am trying to solve the following system. Firstly I have a table of numerical values I will call numbers

    numbers={{8.03077, 7.8435, 0.155633}, {8.02983, 7.90858, 0.155633}, {8.02489, 
  7.94988, 0.155633}, {8.0169, 7.97541, 0.155633}, {8.00632, 7.99063, 
  0.155633}, {7.99326, 7.99916, 0.155633}, {7.9777, 8.00329, 
  0.155633}, {7.95953, 8.00449, 0.155633}, {7.93859, 8.00365, 
  0.155633}}

Now I have to solve a system $$\frac{\cos x}{x}=a$$ and $$\frac{\cos y}{y}=b$$ and $$R(y-x)=c$$ where $a,b,c$ are the numerical values in the table above. A is first, b is second and c is third. Basically this is my formula:

Table[FindRoot[{Cos[x]/x == numbers[[j, 1]], 
     Cos[y]/y == numbers[[j, 2]], 
     R*(-x + y) == 
      numbers[[j, 3]]}, {{x, .01}, {y, .05}, {R, .1}}][[1, 2]], {j, 1,
    Length[numbers], 1}];

Now if you run this code, you will find an error saying:

FindRoot::cvmit: Failed to converge to the requested accuracy or precision within 100 iterations. >>

I assume I have to change the starting points of x,y or R but I tried many different combinations yet nothing seems to work. So my question here is: What can I do? Is there a nice mathematical way to determine the optimum starting points? Is there a way to see which parameter is good and which one is absolutely horrible?

$\endgroup$
3
  • 5
    $\begingroup$ Wouldn't it be easier to (i) solve the first equation for $x$, (ii) solve the second equation for $y$, and then (iii) set $R = c/(y-x)$? $\endgroup$
    – user484
    Dec 18, 2015 at 20:25
  • $\begingroup$ i dont if this help...x0 = Min[Table[ Table[Abs[((Cos[x]/x) - numbers[[j, 1]])], {j, 1, Length[numbers], 1}], {x, 0.0001, 2 Pi}]] y0 = Min[Table[ Table[Abs[(Cos[y]/y - numbers[[j, 2]])], {j, 1, Length[numbers], 1}], {y, 0.0001, 2 Pi}]] R0 = Min[Table[ Table[Abs[(R*(-y0 + x0) - numbers[[j, 3]])], {j, 1, Length[numbers], 1}], {R, 0.0001, 2 Pi}]] Table[FindRoot[{Cos[x]/x == numbers[[j, 1]], Cos[y]/y == numbers[[j, 2]], R*(-x + y) == numbers[[j, 3]]}, {{x, x0}, {y, y0}, {R, R0}}][[1, 2]], {j, 1, Length[numbers], 1}] $\endgroup$
    – Diogo
    Dec 18, 2015 at 20:32
  • $\begingroup$ @Rahul Would you believe me that I am trying to find a good solution to this problem for over a month now and that I am mindblown of how simple your solution is? I can't believe I didn't see that! I fell horrible. Thank you! $\endgroup$
    – skrat
    Dec 18, 2015 at 20:50

4 Answers 4

6
$\begingroup$

You can use FindInstance

Table[FindInstance[
Cos[x]/x == numbers[[i, 1]] && Cos[y]/y == numbers[[i, 2]] && 
R == numbers[[i, 3]]/(-x + y), {x, y, R}, Reals], {i, 
Length[numbers]}]

(*  {{{x -> 0.123572, y -> 0.126476, R -> 53.5889}}, {{x -> 0.123586, 
y -> 0.125451, R -> 83.429}}, {{x -> 0.123661, y -> 0.12481, 
R -> 135.465}}, {{x -> 0.123782, y -> 0.124416, 
R -> 245.438}}, {{x -> 0.123943, y -> 0.124183, 
R -> 649.398}}, {{x -> 0.124143, y -> 0.124052, 
R -> -1726.}}, {{x -> 0.124381, y -> 0.123989, 
R -> -397.389}}, {{x -> 0.124661, y -> 0.123971, 
R -> -225.713}}, {{x -> 0.124984, y -> 0.123984, R -> -155.563}}}*)
$\endgroup$
2
  • $\begingroup$ If I substitute R == numbers[[i, 3]]/(-x + y) with R(-x + y) == numbers[[i, 3]] I was surprised to discover that it would not work. Can you comment on why this is and how you came to the realization of using the first form? $\endgroup$ Dec 18, 2015 at 22:21
  • $\begingroup$ I don't know why the original version doesn't work. Actually I was trying Solve, Reduce and FindInstance nothing worked. Then I saw the first comment by @Rahul which led me to try out this form and it worked. So credit goes to him. $\endgroup$
    – Hubble07
    Dec 19, 2015 at 5:00
4
$\begingroup$

This is just a bit faster if you note the equations are decoupled and you separately run FindInstance on the first two and just algebraically solve the third:

f[v_] := {#[[1]], #[[2]] , 
    v[[3]]/(#[[2]] - #[[1]])} &@ (( 
      x /. First@FindInstance[ Cos[x] == # x , x , Reals]   ) & /@ 
    v[[1 ;; 2]])
f /@ numbers // AbsoluteTiming

{0.501644, {{0.123572, 0.126476, 53.5889}, {0.123586, 0.125451, 83.429}, {0.123661, 0.12481, 135.465}, {0.123782, 0.124416, 245.438}, {0.123943, 0.124183, 649.398}, {0.124143, 0.124052, -1726.}, {0.124381, 0.123989, -397.389}, {0.124661, 0.123971, -225.713}, {0.124984, 0.123984, -155.563}}}

Faster still, now you can use FindRoot :

 f[v_] := {#[[1]], #[[2]] , 
    v[[3]]/(#[[2]] - #[[1]])} &@ (( 
          x /. FindRoot[ Cos[x] == # x , {x, 0}]   ) & /@ v[[1 ;; 2]])
 f /@ numbers //AbsoluteTiming

{0.00659699, {{0.123572, 0.126476, 53.5889}, {0.123586, 0.125451, 83.429}, {0.123661, 0.12481, 135.465}, {0.123782, 0.124416, 245.438}, {0.123943, 0.124183, 649.398}, {0.124143, 0.124052, -1726.}, {0.124381, 0.123989, -397.389}, {0.124661, 0.123971, -225.713}, {0.124984, 0.123984, -155.563}}}

For completeness, here is a FindRoot expression that works on the system in one shot:

(FindRoot[{ Cos[x], Cos[y], y - x} == #  { x , y , 1/r} , {{x, 0}, {y,
       0}, {r, 1}} ]) & /@ numbers 

This finds the r>0 solutions if you start with {r,1} and the remaining solutions if you start with {r,-1}

$\endgroup$
1
  • $\begingroup$ Very nice, The middle FindRoot approach is blindingly fast compared to the FindInstance approach. $\endgroup$ Dec 19, 2015 at 9:04
2
$\begingroup$

If you only want to work with FindRoot:

numbers = 
  SetPrecision[{{8.03077, 7.8435, 0.155633}, {8.02983, 7.90858, 
     0.155633}, {8.02489, 7.94988, 0.155633}, {8.0169, 7.97541, 
     0.155633}, {8.00632, 7.99063, 0.155633}, {7.99326, 7.99916, 
     0.155633}, {7.9777, 8.00329, 0.155633}, {7.95953, 8.00449, 
     0.155633}, {7.93859, 8.00365, 0.155633}}, 30];

    sol = FindRoot[{Cos[x]/x == #1, Cos[y]/y == #2, R (y - x) == #3}, {x, 0.1}, {y, 0.2}, {R, 100}, 
WorkingPrecision -> 30, MaxIterations -> 1000] & @@@ numbers;

N[sol, 6]

enter image description here

$\endgroup$
1
$\begingroup$
PaddedForm[TableForm[
  MapThread[
   Append, {#, numbers[[All, 3]]/-Subtract @@@ #} &[
    Map[FindInstance[Cos[x]/x == #, x, Reals][[1, 1, 2]] &, 
     numbers[[All, ;; 2]], {2}]]],
  TableAlignments -> Right,
  TableHeadings -> {None, {"x", "y", "R"}}], {6, 5}]

enter image description here

$\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.