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.
– bbgodfrey
Aug 28 ’15 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.
– optimal control
Aug 28 ’15 at 20:09

=================

1 Answer
1

=================

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[[1]], eqs[[3]]}, {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[[1]] /. (Equal[z1_, z2_] -> z1 – z2) /. paramFinal, {k, 0, 2}, {r, 0,
2}, PlotPoints -> 50, Contours -> {0}, ContourShading -> None, ContourStyle -> Blue],
ContourPlot[eless[[2]] /. (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.