2
$\begingroup$
(*This program is about finding the roots of the equations stored in \
table t1. Now  i am trying to find the roots of these equation in one \
single run.*)
ClearAll["Global`*"]

a = 1/(2*b^3)
t1 = Table[
   a*(((Sin[b*(1 - i)]*Sin[b*i])/Sin[b]) - ((
       Sinh[b*(1 - i)]*Sinh[b*i])/Sinh[b])), {i, 0.01, 0.5, 0.01}];

t1[[1]]
(* (
Csc[b] Sin[0.01 b] Sin[0.99 b] - 
 Csch[b] Sinh[0.01 b] Sinh[0.99 b])/(2 b^3) *)

f[x_] := t1[[50]] /. b -> x;

p = Plot[{f[x], 0.}, {x, 0.1, 50}, PlotPoints -> 350]

Mathematica graphics

intersections = Graphics`Mesh`FindIntersections[p] // Chop
(* {{7.8527, 0}, {14.136, 0}, {20.4191, 0}, {26.7031, 
  0}, {32.9867, 0}, {39.2698, 0}, {45.5524, 0}} *)

Labeled[Show[p, Frame -> True, Axes -> False, 
  Epilog -> {PointSize[.025], Red, Point[intersections]}], 
 Style[#, 20] &@Column[N[intersections, 10], Frame -> All], Right]

Mathematica graphics

I tried by doing manually it works but it is too time-consuming. I want to somehow put in a loop such that first few roots of the equations in the table can be found.

| improve this question | | | | |
$\endgroup$
3
$\begingroup$

It looks like you're trying to solve for b as a function of i in the following equation:

eqn = a*(((Sin[b*(1-i)]*Sin[b*i])/Sin[b])-((Sinh[b*(1-i)]*Sinh[b*i])/Sinh[b])) == 0;
eqn //TeXForm

$\frac{\csc (b) \sin (b (1-i)) \sin (b i)-\operatorname{csch}(b) \sinh (b (1-i)) \sinh (b i)}{2 b^3}=0$

Instead of using FindRoot on your equation for each value of i, it is much more robust to use NDSolveValue. To do so, we need an initial value:

i0 = Values @ NSolve[(eqn /. i->.1) && 0 < b < 20, b][[All, 1]]

{4.22637, 7.6313, 11.0505, 14.4793, 17.9123}

Next, we need to create an ODE (replace b with b[i] and differentiate), and use NDSolveValue:

sol = NDSolveValue[
    {D[eqn /. b->b[i], i], b[.1] == i0},
    b,
    {i, $MachineEpsilon, .5},
    PrecisionGoal->16
];

Here is a plot:

Plot[sol[x], {x, 0, .5}]

enter image description here

The nice thing about this approach is that we avoid jumping curves as can occur when you use FindRoot independently on each value of i. For example, the following plot superimposes the roots found by @HenrikSchumacher in his answer:

Show[
    Plot[sol[x], {x, 0, .5}, PlotStyle->LightBlue],
    ListPlot[
        MapThread[Thread[{##}]&, {Range[.01,.5,.01], roots[[All, ;;5]]}],
        PlotStyle->Blue
    ]
]

enter image description here

Notice the intervals where there are no dark blue dots on the light blue line. This is where the Graphics`Mesh`FindIntersections/FindRoot approach switched curves.

Finally, finding an initial point using NSolve is rather slow, but solving the ODE is extremely fast. One could speed up the initial point computation by using a FindRoot based technique instead.

| improve this answer | | | | |
$\endgroup$
6
$\begingroup$

This could work for you.

The data

Y = 2*10^11;
Iyy = 8.333*10^-6;
L = 4;
k = 10^12;
a = 1/(2*b^3);
t1 = Table[
   a*(((Sin[b*(1 - i)]*Sin[b*i])/Sin[b]) - ((Sinh[b*(1 - i)]*Sinh[b*i])/Sinh[b])), 
   {i, 0.01, 0.5, 0.01}];

This function takes a function, plots it (PlotPoints -> k) and detects the intersection of the plotted graphs with the x-axis (note that internally, the graphs are polygonal lines that lead to rather coarse approximation to the actual roots). It is sufficient to use very small amounts of PlotPoints since we will refine the roots later with FindRoot.

estimator = {f, k} \[Function] Graphics`Mesh`FindIntersections[
     Plot[{f, 0.}, {b, 0.1, 50}, PlotPoints -> k, 
      PlotRange -> {-0.1, 0.1}]
     ][[All, 1]];

And this is the code that detects the roots very precisely. Note that we can convince FindRoot to apply Newton's method to all points in estimator[f, 2] at once. Drawing the function f from the list t1 and using a Table, this produces a list roots whose i-th entry is the list of roots of t1[[i]].

roots = Table[b /. FindRoot[f, {b, estimator[f, 10]}], {f, t1}];

That's it. For highly oscilating function, estimator[f, 10] might miss some roots. In that case one can try estimator[f, k] with higher k.

| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ tricky, where did you find the infomation concerning Graphics`Mesh`FindIntersections[] ??? $\endgroup$ – Ulrich Neumann Dec 21 '17 at 10:53
  • $\begingroup$ @UlrichNeumann I used Graphics`Mesh`FindIntersections solely because the OP used it. The rest is common sense: Plot generates Graphics objects wherein the curves are stored as Lines, i.e. polygonal curves. Since GraphicsMeshFindIntersections[] is handed over only the Graphics object but not the expression for the plotted function, the best it can do is determining the intersections of the polygonal lines. However, creating the Plot is not a particular efficient way to get initial guesses for FindRoot... $\endgroup$ – Henrik Schumacher Dec 21 '17 at 11:21
  • $\begingroup$ Thanks! Looking for some additional information I tried ??Graphics`Mesh`* MMA returned a long list of possibilities but no further documentation. $\endgroup$ – Ulrich Neumann Dec 21 '17 at 11:47
  • $\begingroup$ @HenrikSchumacher actually there a small typo in the code a=k/2*b^3, if I plot the function i get a lot of straight lines. I may end up with so many spurious roots. and another thing is you didn't give information about how to put in the loop. $\endgroup$ – Vijay Kumar S Dec 21 '17 at 13:38
  • 1
    $\begingroup$ @VijayKumarS Look up Table in the docs eyeroll. $\endgroup$ – Henrik Schumacher Dec 21 '17 at 14:41

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.