2
$\begingroup$

I would like to make two plots, (preferably side by side). One plot of N1 vs m and another of N2 vs m. Right now my data is in the form of ordered pairs of (N1,N2). I am not sure how to break up my current table of data in order to make these plots.

Here is my code:

bet = 0.001;
fc1 = (2/8)^2;
fc2 = (3/8)^2;
N1p = N1*(1 - m) + N2*m;
N2p = N2*(1 - m) + N1*m;
b1 = 1 - bet*N1p - fc1;
b2 = 1 - bet*N2p - fc2;

ans = Table[
Solve[{N1 == N1p*b1*2, N2 == N2p*b2*2 && N1 > 0 && N2 > 0}, {N1, 
N2}, Reals], {m, 0, 1, 0.1}]

Thanks in advance!

$\endgroup$
3
$\begingroup$
ans = {N1, N2} /. 
   Table[NSolve[{N1 == N1p*b1*2, 
      N2 == N2p*b2*2 && N1 > 0 && N2 > 0}, {N1, N2}, Reals], {m, 0, 1, 0.1}];
N1 = Interpolation@Thread@{Range[0, 1, 0.1], ans[[All, 1, 1]]};
N2 = Interpolation@Thread@{Range[0, 1, 0.1], ans[[All, 1, 2]]};
{Plot[N1[m], {m, 0, 1}, ImageSize -> 250], Plot[N2[m], {m, 0, 1}, ImageSize ->250]}

enter image description here

$\endgroup$
3
$\begingroup$

Okay, so we begin with flatten the list a bit since we only get one solution per m.

N1Data = Flatten[ans, 1]

this gives us:

{{N1 -> 437.5, N2 -> 359.375}, {N1 -> 436.268, 
  N2 -> 362.}, {N1 -> 434.826, N2 -> 363.944}, {N1 -> 433.207, 
  N2 -> 365.4}, {N1 -> 431.443, N2 -> 366.493}, {N1 -> 429.565, 
  N2 -> 367.31}, {N1 -> 427.608, N2 -> 367.915}, {N1 -> 425.603, 
  N2 -> 368.359}, {N1 -> 423.579, N2 -> 368.679}, {N1 -> 421.562, 
  N2 -> 368.904}, {N1 -> 419.576, N2 -> 369.058}}

So we use the Part-Operator: We want all sublists, with the first (1) element.

N1Data=Flatten[ans, 1][[All, 1]]

this gives us:

{N1 -> 437.5, N1 -> 436.268, N1 -> 434.826, N1 -> 433.207, 
 N1 -> 431.443, N1 -> 429.565, N1 -> 427.608, N1 -> 425.603, 
 N1 -> 423.579, N1 -> 421.562, N1 -> 419.576}

Now we could use a rule displacement to gather the values but Part qworks again here as well:

N1Data=Flatten[ans, 1][[All, 1, 2]]

which produces our data Points.

{437.5, 436.268, 434.826, 433.207, 431.443, 429.565, 427.608, 
425.603, 423.579, 421.562, 419.576}

Now lets combine these values to make data points with the m values:

N1Data = Transpose[{Range[0, 1, 0.1], Flatten[ans, 1][[All, 1, 2]]}]
N2Data = Transpose[{Range[0, 1, 0.1], Flatten[ans, 1][[All, 2, 2]]}]

Putting this into ListPlot and arrange them side by side with GraphicsGrid:

GraphicsGrid[{{ListPlot[N1Data, ImageSize -> Medium, 
    PlotTheme -> "Scientific"], 
   ListPlot[N2Data, ImageSize -> Medium, PlotTheme -> "Scientific"]}}]

which gives you: enter image description here

$\endgroup$
1
$\begingroup$

Let's modify slightly ans to have direct access to the m range:

ans = Table[{m, 
   Solve[{N1 == N1p*b1*2, N2 == N2p*b2*2 && N1 > 0 && N2 > 0}, {N1, 
     N2}, Reals]}, {m, 0, 1, 0.1}]

Extract what's needed:

m = First@Transpose@ans;
n1 = Flatten[N1 /. Part[#, 2] &@Transpose@ans];
n2 = Flatten[N2 /. Part[#, 2] &@Transpose@ans];

Compose it:

data = {Transpose@{m, n1}, Transpose@{m, n2}};

And plot it:

GraphicsRow@
 Table[ListPlot[data[[i]], Frame -> True, 
   PlotStyle -> {PointSize[Medium], Black}, ImageSize -> 300], {i, 1, 
   Length@data}]

enter image description here

$\endgroup$

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.