# How to use Findroot in a loop

Consider:

i = 0.1;
While[
i < 0.9,
y[x_] :=
y /. FindRoot[{u/(1 - u) (x + Log[y]) - 1 /. u -> i}, {y, 3}];
Plot[y[x], {x, 0, 4}];
i = i + 0.1]


I want to draw graphs for y[x] for different i's in one graph. Then based on the top answer, I write the following code for further progame:

Clear[f, y, i]

f[x_] := Quiet[y /. FindRoot[i (x + Log[y])/(1 - i) - 1, {y, 3}]]

output = {};

i = 0.1;
While[i < 0.9,
AppendTo[output,
g := x /. Last[FindMaximum[-f[x]^(1/4) - 1/f[x], {x, 3}]];
t = Table[{i, g}, {i, 0, 1, 0.1}];
h = Table[{i, f[g]}, {i, 0, 1, 0.1}];
i = i + 0.05]

ListLinePlot[{t,h}]


But I cannot plot h.

• One-space indent? Please, no. Nov 15 '21 at 0:15

Clear[f, y, i]

f[x_] := Quiet[y /. FindRoot[i (x + Log[y])/(1 - i) - 1, {y, 3}]]

output = {};

i = 0.1;
While[i < 0.9,
AppendTo[output, Table[{x, f[x]}, {x, 0, 4, 0.1}]];
i = i + 0.1]

ListLinePlot[output,
PlotLegends -> Map["i = " <> ToString[#] &, Range[8]/10.]]


With PlotRange -> All to include the first curve in the plot.

ListLinePlot[output,
PlotLegends -> Map["i = " <> ToString[#] &, Range[8]/10.],
PlotRange -> All]


Or use log plot

ListLogPlot[output,
PlotLegends -> Map["i = " <> ToString[#] &, Range[8]/10.],
Joined -> True]


Also, super-cautious approach, discarding any points that the root finder had trouble with.

Clear[f, y, i]

f[x_] := Quiet[
ans = y /. FindRoot[i (x + Log[y])/(1 - i) - 1, {y, 3},
MaxIterations -> 1000];

output = {};

i = 0.1;
While[i < 0.9,
AppendTo[output, Table[{x, f[x]}, {x, 0, 4, 0.1}]];
i = i + 0.1]

ListLogPlot[output /. {_, _String} -> Nothing,
PlotLegends -> Map["i = " <> ToString[#] &, Range[8]/10.]]


Show[
ListLinePlot[(i = #;
Cases[Table[{x, -f[x]^(1/4) - 1/f[x]}, {x, -3, 6, 0.01}],
{_, _Real}]) & /@ (Range[8]/10.),
PlotRange -> {{-3, 6}, {-14, 0}}],
ListPlot[(i = #;
MaximalBy[
Cases[Table[{x, -f[x]^(1/4) - 1/f[x]}, {x, -3, 6, 0.01}],
{_, _Real}], Last]) & /@ (Range[8]/10.),
PlotRange -> {{-3, 6}, {-14, 0}}, PlotStyle -> Black]]


{i = #,
MaximalBy[
Cases[Table[{x, -f[x]^(1/4) - 1/f[x]}, {x, -3, 6, 0.01}],
{_, _Real}], Last][[1, 2]]} & /@ (Range[8]/10.)

{{0.1, -2.16679}, {0.2, -1.64939}, {0.3, -1.64939}, {0.4, -1.64939},
{0.5, -1.64939}, {0.6, -1.64939}, {0.7, -1.64938}, {0.8, -1.64939}}


The maximum z value is basically constant.

• thank you very much!! If you don't mind, can I ask another question? I want to find the maximum for this function: -f[x]^(1/4) - 1/f[x] at each i. i.e., for a given i, z=x/. Last[FindMaximum[ -f[x]^(1/4) - 1/f[x],{x,3}]]. And I want to draw a graph of z over i. Nov 16 '21 at 11:37
• FindMaximum doesn't like that much! Using Table again ... (see edit) Nov 16 '21 at 13:59

One way might be

root[x_?NumericQ, i_] := y /. First@FindRoot[i/(1 - i) (x + Log[y]) - 1, {y, 3}]
Last@Reap@Do[
Sow@Plot[root[x, i], {x, 0, 4}], {i, 0.1, 0.9, 0.1}
]


The roots can be found directly with Solve.

sol = Simplify[
SolveValues[{u/(1 - u) (x + Log[y]) - 1 == 0, 0 < u < 1}, y, Reals],
0 < u < 1]

(* {E^(-1 + 1/u - x)} *)

Plot[
Evaluate@
Table[Tooltip[sol[[1]], u], {u, 0.1, 0.8, 0.1}],
{x, 0, 4},
AxesLabel -> (Style[#, 12, Bold] & /@ {x, y}),
PlotLegends ->
Placed[
LineLegend[Range[0.1, 0.8, 0.1],
LegendLabel -> Style[u, 12, Bold]],
{0.9, 0.57}],
PlotLabel ->
StringForm["", u/(1 - u) (x + Log[y]) - 1 == 0]]


The line for u == 0.1 is off the top of the Plot. To show it, all of the other lines would be drawn on top of each other. Consequently, use "Log" scaling.

Plot[
Evaluate@
Table[Tooltip[sol[[1]], u], {u, 0.1, 0.8, 0.1}],
{x, 0, 4},
PlotRange -> All,
AxesLabel -> (Style[#, 12, Bold] & /@ {x, y}),
PlotLegends ->
LineLegend[Range[0.1, 0.8, 0.1],
LegendLabel -> Style[u, 12, Bold]],
PlotLabel ->
StringForm["", u/(1 - u) (x + Log[y]) - 1 == 0],
ScalingFunctions -> "Log"]