1
$\begingroup$

I have normally two equations system which I reduce to one equation and make its graphic. I could make the graph of the reduced equation but I can not find the appropriate command to find its root. Here is the code I use (from this answer) ;

u[c_] := (c^(1 - σ) - 1)/(1 - σ)
h[s_] := (2 hbar)/(1 + Exp[η (1 - s/sbar)])
d[s_] := (b s^2)/2
k[m_] := m^α
r[m_, s_] := pricemit - (D[u[c], c] /. c -> (χ s + k[m])/β) D[k[m], m]

The calibration is as follows ;

paramFinal2 = {σ -> 2.1, ρ -> 0.01, sbar -> 50, η -> 5.8, hbar -> 0.04, b -> 0.0001, γ -> 0.6, χ -> 0.025, ω -> 0.185, δ -> 0.0015, x -> 0.0014, β -> 0.8, ζ -> 0.5, τ -> 0.5, pricemit -> 0.006, α -> 0.15};

From the equation "r", I find a different couples of $m$ and $s$ which make this equation equal to zero, with starting to give 0 for $s$ (until 130) and I find corresponding "m" values.

sol[i_] := FindRoot[r[m, i] == 0 /. paramFinal2, {m, 10}];
tab = Table[sol[i], {i, 0, 130}];
Flatten[tab];

I name these values as ;

mylist = Last /@ Flatten[Table[sol[i], {i, 1, 130}]];
mylistrange = Range[1, 130];

I write the reduced equation with command Apply and plot it after ;

sol2adap = Apply[-χ - (ρ + h[#1]) + h'[#1]/(ρ + h[#1]) ((u[χ/β #1 + k[#2]/β] - d[#1] - pricemit #2)/(u'[χ/β #1 + k[#2]/β]/β)) + d'[#1]/(u'[χ/β #1 + k[#2]/β]/β) /. paramFinal2 &, {mylistrange, mylist}];
sol2adapplot = ListPlot[sol2adap, PlotStyle -> {Red, Thick}]

enter image description here

I can see that there exist one root for this last equation and it is around 16.8 but how can I find the exact value for it ? This value is for #1 but as it becomes a numerical value with apply, I can not use FindRoot or other numerical commands for a numerical root.

$\endgroup$
  • $\begingroup$ @Dr. belisarius sorry, I did not think to refer to your answer from the post that you have linked. Thanks for that. $\endgroup$ – optimal control Jan 13 '16 at 17:11
  • 1
    $\begingroup$ It's OK. You should always cite your sources, here and everywhere else. $\endgroup$ – Dr. belisarius Jan 13 '16 at 17:41
2
$\begingroup$

You can make an interpolation function and use FindRoot on it. It seems that you are plotting the value of sol2adap versus the index number of the list, so

func = Interpolation[Transpose[{mylistrange, sol2adap}]];
FindRoot[func[x] == 0, {x, 17}]
(* {x -> 16.4499} *)

gives you what you are looking for.

$\endgroup$
  • $\begingroup$ Thanks a lot ! I did not know that it could be made by Interpolation. $\endgroup$ – optimal control Jan 12 '16 at 13:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.