# Breaking up the Solutions to Solve

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}]


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]}


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:

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}]