# solving a non trivial equation system

I try to solve a 4 equations, 4 unknowns system. Here is my code

paramFinal = {σ -> 1.6, α -> 0.25, β -> 0.45, γ -> 0.3, ρ -> 0.02, δ -> 0.05, ϕ -> 0.8} // Rationalize;


After I use FindRoot to solve the following system

FindRoot[{n ((α β)/(1 - α) + β) == α k^(α - 1) r^γ + ((α γ + (1 - α) (γ - 1))/(1 - α) ) r, n ( β/(1 - α) - 1) ==  (α k^(α - 1) r^(γ) - ρ)/σ, (β /(1 - α)) n - ((γ r)/(1 - α)) ==  (α k^(α - 1) r^(γ))/α - c/k, n (1/(ϕ (1 - σ)) + (β k^(α) r^(γ))/(ϕ c) + 1) + c^(1 - σ) n^(ϕ (1 - σ)) == ρ} /. paramFinal, {{n, 1}, {r, 1}, {k, 1}, {c, 1}}]


I always get the error message

FindRoot::lstol: The line search decreased the step size to within tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the merit function. You may need more than 15. digits of working precision to meet these tolerances.

As stated on this question asked before, I try to change the machine precision with using the option WorkingPrecision, I always get this error.

Does it mean that the roots that I have found are biased ? How can I remove this message ? Thanks in advance for hints and suggestions.

• The equation contains an undefined symbol ar. Aug 28, 2015 at 19:47
• @bbgodfrey sorry for that. I have forgetten to put spaces between. I edited the question. I think it should work this time. Aug 28, 2015 at 20:09

Define for convenience,

eqs = {n ((α β)/(1 - α) + β) == α k^(α - 1) r^γ + ((α γ + (1 - α) (γ - 1))/(1 - α)) r,
n (β/(1 - α) - 1) == (α k^(α - 1) r^(γ) - ρ)/σ,
(β/(1 - α)) n - ((γ r)/(1 - α)) == (α k^(α - 1) r^(γ))/α - c/k,
n (1/(ϕ (1 - σ)) + (β k^(α) r^(γ))/(ϕ c) + 1) + c^(1 - σ) n^(ϕ (1 - σ)) == ρ}


Then, as stated in the question,

FindRoot[eqs /. paramFinal, {{n, 1}, {r, 1}, {k, 1}, {c, 1}}]


responds with the FindRoot::lstol: error message and incorrect values for the four unknowns (as may be seen by back substitution). Furthermore, WorkingPrecision -> 30 gives the same incorrect answer to higher precision.

In situations like this, the natural course of action is to eliminate some of the variables, n and c being likely candidates.

rnc = First@Solve[{eqs[], eqs[]}, {n, c}] // Simplify
(* {n -> (-k^α r^γ (-1 + α) α + k r (-1 + α + γ))/(k β), c -> k r - k^α r^γ (-1 + α)} *)
eless = Take[eqs /. rnc, {2, 4, 2}]
(* {((-1 + β/(1 - α)) (-k^α r^γ (-1 + α) α + k r (-1 + α + γ)))/(k β) ==
(k^(-1 + α)r^γ α - ρ)/σ,
(k r - k^α r^γ (-1 + α))^(1 - σ) ((-k^α r^γ (-1 + α) α + k r (-1 + α + γ))
/(k β))^((1 - σ) ϕ) + ((-k^α r^γ (-1 + α) α + k r (-1 + α + γ))
(1 + (k^α r^γ β)/((k r - k^α r^γ (-1 + α)) ϕ) + 1/((1 - σ) ϕ)))/(k β) == ρ} *)


Not surprisingly,

FindRoot[eless /. paramFinal, {{r, 1}, {k, 1}}]


still gives incorrect answers (although different ones). But, with fewer variables, it is feasible to plot the remaining equations

Show[
ContourPlot[eless[] /. (Equal[z1_, z2_] -> z1 - z2) /. paramFinal, {k, 0, 2}, {r, 0,
2}, PlotPoints -> 50, Contours -> {0}, ContourShading -> None, ContourStyle -> Blue],
ContourPlot[eless[] /. (Equal[z1_, z2_] -> z1 - z2) /. paramFinal, {k, 0, 2}, {r, 0,
2}, PlotPoints -> 50, Contours -> {0}, ContourShading -> None, ContourStyle -> Red],
FrameLabel -> {k, r}] The first equation vanishes on the Blue curve, and the second on the Red curve. They intersect at r == k == 0, which is not an allowed answer (I think). I have explored the other possible intersection, k tiny and r` large, but the curves do not appear to intersect even there. I conclude that these equations have no real solutions for the parameters given in the question.