solving a non trivial equation system

Question

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.

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.