0
$\begingroup$

I have the following code:

Subscript[\[Epsilon], 0] = 0.1;
Subscript[\[Epsilon], 1] = 0.1;
u = 0.5;
f0[y_] := PDF[NormalDistribution[-1, 1], y]
f1[y_] := PDF[NormalDistribution[1, 1], y]
opts = {Method -> {Automatic, "SymbolicProcessing" -> None}, AccuracyGoal -> 4};
g0[y_?NumericQ, l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := Exp[ (((l0 + m0 + l0 Log[g0[y, l0, l1, m0, m1]/f0[y]])/(1 - u))^((u - 1)/u) - l1 - m1)/l1] ((l0 + m0 + l0 Log[g0[y, l0, l1, m0, m1]/f0[y]])/(1 - u))^(-1/u) f1[y]
g1[y_?NumericQ, l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := Exp[ (((l1 + m1 + l1 Log[g1[y, l0, l1, m0, m1]/f1[y]])/u)^(u/(-1 + u)) (1 - u) - l0 - m0)/l0] ((l1 + m1 + l1 Log[g1[y, l0, l1, m0,m1]/f1[y]])/u)^(1/(-1 + u)) f0[y]
h0[l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := NIntegrate[g0[y, l0, l1, m0, m1], {y, -Infinity, Infinity}, Evaluate@opts] 
h1[l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := NIntegrate[g1[y, l0, l1, m0, m1], {y, -Infinity, Infinity}, Evaluate@opts]
h2[l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := NIntegrate[g0[y, l0, l1, m0, m1]*Log[g0[y, l0, l1, m0, m1]/f0[y]], {y, -Infinity, Infinity}, Evaluate@opts]
h3[l0_?NumericQ, l1_?NumericQ, m0_?NumericQ, m1_?NumericQ] := NIntegrate[g1[y, l0, l1, m0, m1]* Log[g1[y, l0, l1, m0, m1]/f1[y]], {y, -Infinity, Infinity}, Evaluate@opts]

{l00, l11, m00, m11} = {l0, l1, m0, m1} /. FindRoot[{h0[l0, l1, m0, m1] == 1, h1[l0, l1, m0, m1] == 1, h2[l0, l1, m0, m1] == Subscript[\[Epsilon], 0], h3[l0, l1, m0, m1] == Subscript[\[Epsilon], 1]}, {{l0, 1}, {m0, 2}, {l1, 1}, {m1, 2}}, StepMonitor :> Print["Step to l0,m0,l1,m1 = ", {l0, m0, l1, m1}, Evaluate@opts]]

I have 4 equations in 4 parameters ($l0,m0,l1,m1$) and I should be able to get a solution no matter how long I wait. However, it seems that I may be doing something wrong because after waiting many many hours there wasn't even a single progress. I mean Mathematica didnt print out a single step of its, say Newton-Rapson algorithm. Thats why I hassitated whether something in my code was not understandable for Mathematica.

In my code $g0$ and $g1$ are actually recursively defined. Namely they can be written as

$$g_0[y]=f(g_0[y],f_0[y],f_1[y],l0, l1, m0, m1)$$

$$g_1[y]=f(g_1[y],f_0[y],f_1[y],l0, l1, m0, m1)$$

$f_0$ and $f_1$ are known and $l0, l1, m0, m1$ are the parameters that we are searching for. Given these parameters, $g_0$ and $g_1$ can be obtained via solving an equation. It is like for every $y$, there is an equation to solve in order to get $g[y]$.

I was thinking that Mathematica would do it automaticallly but I suspect that it is not doing anything therefore I am not getting any results. How should one go about the solution of this problem? I am aware that I will need to wait to get a solution but I hope to get one eventually..

I will be also happy to see a figure of $g_0$ or $g_1$ for example given the values of parameters as: $l0=1, l1=1, m0=2, m1=2$.

I dont know how to do it either.

$\endgroup$
  • $\begingroup$ It's not even possible to evaluate, say, g0[0, 1, 2, 1, 2]. How would you integrate this? Your definition is an infinite recursion. You need to define g0 and g1 in a way where the exact same symbol does not appear on the right side of the equation (probably involving another FindRoot). SetDelay is not meant to solve equations. $\endgroup$ – Felix Feb 25 '17 at 3:51
  • $\begingroup$ @Felix exactly. But I dont know how to do it. $\endgroup$ – Seyhmus Güngören Feb 25 '17 at 4:14
  • 1
    $\begingroup$ If that is your question you should re-phrase your post to state your problem clearly ("how can I define this implicit function") and remove everything that is not relevant for that question. If you later get stuck with another part of the code, ask another question. Just one question per post. $\endgroup$ – Felix Feb 25 '17 at 4:41

Your Answer

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

Browse other questions tagged or ask your own question.