# Repeated roots/solutions for a numerical solution

Consider the equation,

$$x^2 + e^x + y^2 + y = 4, -2 \leq x \leq 2$$

Solve for $$y$$ numerically using FindRoot

My attempt:

f[y_, x_] := x^2 + y^2 + E^x + y  - 4

startvalues = Table[y /. Solve[f[y, i] == 0, y], {i, -2, 2, 0.5}]

Print[""]

Table[FindRoot[f[y, j] == 0, {y, startvalues}], {j, -2, 2, 0.5}]}



Result:

As observed, there are repeated roots. How do I get rid of the repeated roots such that there's exactly one solution for each initial guess? I have tried using a Do loop, but null values are generated

• Why would you solve something that you already have solved? You already got solutions by using Solve, what is the point of using FindRoot to get the same solutions? Commented Aug 9, 2022 at 16:09
• The question looks like homework, and that suggests to me a particular approach was taught and should be used. Can you clarify? Commented Aug 9, 2022 at 17:11

Clear["Global*"]

f[y_, x_] := x^2 + y^2 + E^x + y - 4

xmax = NMaxValue[{x, f[y, x] == 0}, {x, y}, WorkingPrecision -> 20]

(* 1.1068629565922608666 *)


EDIT: Corrected test used in DeleteDuplicates

data = DeleteDuplicates[
Flatten[
Outer[{#1, y /. FindRoot[f[y, #1], {y, #2},
WorkingPrecision -> 15]} &,
Range[-2, xmax, (xmax + 2)/10], {1/2, -3/2}], 1],
Norm[#1 - #2] < 10^-6 &];

ContourPlot[f[y, x] == 0, {x, -2, 2}, {y, -3, 2},
FrameLabel -> (Style[#, 14] & /@ {x, y}),
Epilog -> {Red, AbsolutePointSize[4], Point[data]}]


• Very nicely done. Just a quick question: is the high value of WorkingPrecision related to the use of FindRoot?
– bmf
Commented Aug 9, 2022 at 16:37
• @bmf - I tend to always use a WorkingPrecision when using FindRoot. The choice of 15 in the FindRoot is somewhat arbitrary. 20 was used in the NMaxValue to ensure the inputs to FindRoot were always consistent with its WorkingPrecision of 15 Commented Aug 9, 2022 at 16:45
• Thanks for breaking it down :)
– bmf
Commented Aug 9, 2022 at 16:56
f[y_, x_] := x^2 + y^2 + E^x + y - 4
startvalues = Table[{i, y /. Solve[f[y, i] == 0, y]}, {i, -2, 2, 0.5}]
FindRoot[f[y, #[[1]]] == 0, {y, #[[2, 1]]}] & /@ startvalues
FindRoot[f[y, #[[1]]] == 0, {y, #[[2, 2]]}] & /@ startvalues
Clear[startvalues, f]

(* {{-2.,{-0.838622,-0.161378}},{-1.5,{-1.83299,0.832993}},{-1.,{-2.19768,1.19768}},{-0.5,{-2.34214,1.34214}},{0.,{-2.30278,1.30278}},{0.5,{-2.03339,1.03339}},{1.,{-1.22919,0.22919}},{1.5,{-0.5-1.57534 I,-0.5+1.57534 I}},{2.,{-0.5-2.6719 I,-0.5+2.6719 I}}} *)
(* {{y->-0.838622},{y->-1.83299},{y->-2.19768},{y->-2.34214},{y->-2.30278},{y->-2.03339},{y->-1.22919},{y->-0.5-1.57534 I},{y->-0.5-2.6719 I}} *)
(* {{y->-0.161378},{y->0.832993},{y->1.19768},{y->1.34214},{y->1.30278},{y->1.03339},{y->0.22919},{y->-0.5+1.57534 I},{y->-0.5+2.6719 I}} *)
`