# FindRoot with input as a list

I have three equations: eq1, eq2, eq3 with variables a,b,d,k. I wish to find the roots of these equations by assuming a=0.5,b=0.5,d=0.5 and k as a list from 1 to 5 with steps 0.01. The code for this is:

eq1 = 1 + a/6 + (1/200)*k*(-k^3 + 2*k*a + d*b);
eq2 = a + (1/30)*k*(-k^3 + 2*k*a + d*b);
eq3 = b + (1/60)*k*(-1 + k*b) + (1/120)*((-k)*(k^2 + a) + k^4*b);
FindRoot[{eq1, eq2, eq3}, {{a, 0.5}, {b, 0.5}, {d, 0.5}}]


I want to know what is the simplest way to find the roots for each k from the list?

• Without example equations it is difficult to be certain. Is Table[FindRoot[{eq1,eq2,eq3},{{a,0.5},{b,0.5},{d,50},{k,j}}],{j,1,10,0.001}] simple enough and does what you need? If not then please provide a more detailed example of what you have, don't need all10,000 values listed, a dozen will be enough.
– Bill
Commented Nov 22, 2023 at 16:07
• Your question is not clear. Please provide a concrete example and the code that you have tried. Commented Nov 22, 2023 at 16:08
• Table[FindRoot[{eq1, eq2, eq3}, {{a, 0.5}, {b, 0.5}, {d, 0.5}}], {k,1,5,0.01}]? Commented Nov 22, 2023 at 18:15
• Actually, Clear[a,b,d,k]; Solve[{eq1, eq2, eq3} == 0, {a, b, d}] gives formulas for a,b,d in terms of k -- isn't that good enough? Then you can plug in values for k. Commented Nov 22, 2023 at 18:47
• Perhaps TableForm[ Table[FindRoot[{eq1, eq2, eq3}, {{a, 0.5}, {b, 0.5}, {d, 0.5}}], {k, 1, 5, 0.01}], TableHeadings -> {Range[1., 5., 0.01], {a, b, d}}] or Table[{k, FindRoot[{eq1, eq2, eq3}, {{a, 0.5}, {b, 0.5}, {d, 0.5}}]}, {k, 1, 5, 0.01}] or something like that. There are various ways one could combine k with the output of FindRoot. Commented Nov 22, 2023 at 19:41

\$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global*"]

eq1 = 1 + a/6 + (1/200)*k*(-k^3 + 2*k*a + d*b);
eq2 = a + (1/30)*k*(-k^3 + 2*k*a + d*b);
eq3 = b + (1/60)*k*(-1 + k*b) + (1/120)*((-k)*(k^2 + a) + k^4*b);


Eliminating two of the variables {a, b, d} from the equations

eqns = Collect[#, k] & /@ Eliminate[{eq1 == 0, eq2 == 0, eq3 == 0}, #] & /@
Subsets[{a, b, d}, {2}]

(* {216000 + (18000 + 58 d) k^2 + (2160 - d) k^4 + 122 k^6 + k^8 == 0,
120 b + 58 k + 2 b k^2 - k^3 + b k^4 == 0, 60 + a == 0} *)


Setting the remaining variable to 1/2

eqnsk = {repl = Variables[Level[#, {-1}]][[1]] -> 1/2, (# /. repl)} & /@ eqns

{* {{d -> 1/2,
216000 + 18029 k^2 + (4319 k^4)/2 + 122 k^6 + k^8 == 0}, {b -> 1/2,
60 + 58 k + k^2 - k^3 + k^4/2 == 0}, {a -> 1/2, False}} *)

{#[[1]], Solve[#[[2]], k, Reals]} & /@ Most[eqnsk] /. r_Root :> N[r]

(* {{d -> 1/2, {}}, {b -> 1/2, {{k -> -3.66155}, {k -> -1.08937}}}} *)


Only the second case has real solutions.

Checking,

Solve[{eq1 == 0, eq2 == 0, eq3 == 0} /. b -> 1/2, {a, d, k}, Reals] /.
r_Root :> N[r]

(* {{a -> -60, d -> -3568.68, k -> -1.08937},
{a -> -60, d -> -1960.14, k -> -3.66155}} *)


Your equations are simple enough that you can use Solve:

Solve[{eq1==0, eq2==0, eq3==0}, {a, b, d}]


{{a -> -60, b -> (k (-58 + k^2))/(120 + 2 k^2 + k^4), d -> (216000 + 18000 k^2 + 2160 k^4 + 122 k^6 + k^8)/(k^2 (-58 + k^2))}}

Just plug in whatever values of k` you want.