2
$\begingroup$

I have multiple parts in my question. You are welcome to answer to any of them :)

Part 1 :

I have 3 equations $p(x_1,y_1)=p(x_2,y_2),\mu_x(x_1,y_1)=\mu_x(x_2,y_2),\mu_y(x_1,y_1)=\mu_y(x_2,y_2)$. I'm looking for non trivial solutions :$x_1\neq x_2$ and $y_1\neq y_2$. This is my code :

F[x_, y_, l_, m_, n_] = 
  x*Log[x] + y*Log[y] + (1 - x - y)*Log[1 - x - y] - l*x*y - m*x^2 + 
   n*(x + y)^4;
Mux[x_, y_, l_, m_, n_] = D[F[x, y, l, m, n], x];
Muy[x_, y_, l_, m_, n_] = D[F[x, y, l, m, n], y];
p[x_, y_, l_, m_, n_] = 
  F[x, y, l, m, n] - x*Mux[x, y, l, m, n] - y*Muy[x, y, l, m, n];

sol[x1_, l_, m_, n_] := 
  FindMinimum[{(p[x1, y1, l, m, n] - 
        p[x2, y2, l, m, n])^2 + (Mux[x1, y1, l, m, n] - 
        Mux[x2, y2, l, m, n])^2 + (Muy[x1, y1, l, m, n] - 
        Muy[x2, y2, l, m, n])^2, Element[x2, Reals], 
    Element[y2, Reals], 
    Element[y1, Reals]}, {{x2, 0.4}, {y2, 0.4}, {y1, 0.05}}];

n0 = 0;
m0 = 10;
l0 = 20;
{Plot[{y1 /. sol[x, l0, m0, n0][[2]], x2 /. sol[x, l0, m0, n0][[2]], 
   y2 /. sol[x, l0, m0, n0][[2]]}, {x, 0, 0.1}, 
  PlotLegends -> "Expressions"], 
 Plot[{sol[x, l0, m0, n0][[1]]}, {x, 0, 0.1}, 
  PlotLegends -> "Expressions"]}

I'm getting this error and this result :

FindMinimum::nrlnum: The function value {-0.901139+0. I,2.56722 +4.44288 I,-1.31381+0. I} is not a list of real numbers with dimensions {3} at {x2,y2,y1} = {0.207934,0.310486,-0.0659817}. enter image description here

I don't really understand the error. Moreover as you can see the results are good in some regions of $x_1$ and all of the sudden I'm getting wrong results as you can see in the pics.

Part 2 :

I noticed that NMinimize is very very slow if one had conditions.

So I was wondering how to make it faster.

Also, I wanted to know when it is better to use NMinimize or NSolve or FindRoot.

I find NMinimize quite convenient and efficient in the way I used it. What do you think about it ? How would you have tackle this system of equation ?

Part 3 :

Also, I'm looking for making a lot of graphs like that :

Clear[l0]

Table[{Plot[{y1 /. sol[x, l0, m0, n0][[2]], 
    x2 /. sol[x, l0, m0, n0][[2]], y2 /. sol[x, l0, m0, n0][[2]]}, {x,
     0, 0.1}, PlotLegends -> "Expressions"], 
  Plot[{sol[x, l0, m0, n0][[1]]}, {x, 0, 0.1}, 
   PlotLegends -> "Expressions"]}, {l0, {5, 10, 20}}]

Do you think it's a good strategy with NMinimize and Table ?

$\endgroup$

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.