How can I manipulate this list?

Question

I performed a loop with Table where I solve a system of 4 equations that depends on two parameters: eta and p. I create two lists for each parameter as follows:

t = Table[x, {x, 0.4, 0.8, 0.2}];
t2 = Table[x, {x, 0.4, 0.8, 0.2}];

And ask Mathematica to calculate the system of equations with each possible combination of the parameter values on the list. This gives 9 combinations.

So I command Mathematica to solve:

Table[FindMinimum[{Total[{eq1, eq2, eq3, eq4}^2 /. dat2],subdomain}, {w, r, p2, pw}, AccuracyGoal -> 11], {eta, t}, {p, t2}] 

The problem I have is twofold:

1) FindMinimum gives me a list which first has the accuracy of the solution and then the solution for each variable (notice I have 4 unknowns). But it does this in some strange nested list that I cannot find how to manipulate to extract the solutions. How can I extract these four solutions for each parameter value combination? I get something like this:

{{{6.17743*10^-21, {w -> 0.339965, r -> 0.223645, p2 -> 1.33362, 
pw -> 1.72372}}, {1.90741*10^-25, {w -> 0.542223, r -> 0.371844, 
p2 -> 1.64076, pw -> 2.02472}}, {5.71176*10^-24, {w -> 0.643134, 
r -> 0.450457, p2 -> 1.93086, 
pw -> 2.22915}}}, {{7.33982*10^-22, {w -> 0.311135, r -> 0.209456,
 p2 -> 1.2314, pw -> 1.62681}}, {6.11484*10^-22, {w -> 0.474764, 
r -> 0.339861, p2 -> 1.44227, 
pw -> 1.81857}}, {3.9265*10^-26, {w -> 0.546408, r -> 0.406571, 
p2 -> 1.65072, pw -> 1.96442}}}, {{9.70251*10^-19, {w -> 0.280124,
 r -> 0.193537, p2 -> 1.12081, 
pw -> 1.52232}}, {5.9975*10^-22, {w -> 0.406271, r -> 0.307383, 
p2 -> 1.23501, pw -> 1.56292}}, {1.47675*10^-24, {w -> 0.450644, 
r -> 0.363777, p2 -> 1.3584, pw -> 1.59895}}}}

2) I would like to create a matrix for each variable and assign the solutions to this matrix by a specified order. I do not know how to this with mathematica. Assume the first three solutions for "w" above would make the first column of a matrix, then the next three solutions of "w" would make a second column and so on. How could I do this?

Thanks for your advice

Answer 1

result = {{{6.17743*10^-21, {w -> 0.339965, r -> 0.223645, 
      p2 -> 1.33362, pw -> 1.72372}}, {1.90741*10^-25, {w -> 0.542223,
       r -> 0.371844, p2 -> 1.64076, 
      pw -> 2.02472}}, {5.71176*10^-24, {w -> 0.643134, r -> 0.450457,
       p2 -> 1.93086, 
      pw -> 2.22915}}}, {{7.33982*10^-22, {w -> 0.311135, 
      r -> 0.209456, p2 -> 1.2314, 
      pw -> 1.62681}}, {6.11484*10^-22, {w -> 0.474764, r -> 0.339861,
       p2 -> 1.44227, pw -> 1.81857}}, {3.9265*10^-26, {w -> 0.546408,
       r -> 0.406571, p2 -> 1.65072, 
      pw -> 1.96442}}}, {{9.70251*10^-19, {w -> 0.280124, 
      r -> 0.193537, p2 -> 1.12081, 
      pw -> 1.52232}}, {5.9975*10^-22, {w -> 0.406271, r -> 0.307383, 
      p2 -> 1.23501, pw -> 1.56292}}, {1.47675*10^-24, {w -> 0.450644,
       r -> 0.363777, p2 -> 1.3584, pw -> 1.59895}}}};

table = Transpose[{Tuples[{t, t2}], {w, r, p2, pw} /. 
           Flatten[result, 1][[All, 2]], Flatten[result, 1][[All, 1]]}];

Grid[Join[{{"{eta, p}", "{w, r, p2, pw}", "minvalue"}}, table], Dividers -> All]

Or

table2 = Flatten[Table[{t[[i]], t2[[j]],
    Sequence @@ ({w, r, p2, pw} /. result[[i, j, 2]]), result[[i, j, 1]]},
   {i, Range[Length[t]]}, {j, Range[Length[t2]]}], 1]

Grid[Join[{{eta, p, w, r, p2, pw, minvalue}}, table2],   Dividers -> All]

Update: Per OP's comment

a matrix where the first column has all the "w" for p=0.4, and then the next column has the three "w" for p=0.6, and finally a third column that has "w" for p=0.8

table3 = GatherBy[table2[[All, {2, 3}]], First][[All, All, -1]];
Transpose@table3 // MatrixForm 

Fold[Prepend, Transpose[Prepend[table3, {"", "w", SpanFromAbove}]],
     {{"", 0.4, 0.6, .08}, {"", "p", SpanFromLeft}}] //
 Grid[#, Dividers -> {{2 -> True}, {2 -> True, 3 -> True}}] & 

Answer 2

Just for variety:

t = Table[x, {x, 0.4, 0.8, 0.2}];
t2 = Table[x, {x, 0.4, 0.8, 0.2}];
res = {{{6.17743*10^-21, {w -> 0.339965, r -> 0.223645, p2 -> 1.33362,
       pw -> 1.72372}}, {1.90741*10^-25, {w -> 0.542223, 
      r -> 0.371844, p2 -> 1.64076, 
      pw -> 2.02472}}, {5.71176*10^-24, {w -> 0.643134, r -> 0.450457,
       p2 -> 1.93086, 
      pw -> 2.22915}}}, {{7.33982*10^-22, {w -> 0.311135, 
      r -> 0.209456, p2 -> 1.2314, 
      pw -> 1.62681}}, {6.11484*10^-22, {w -> 0.474764, r -> 0.339861,
       p2 -> 1.44227, pw -> 1.81857}}, {3.9265*10^-26, {w -> 0.546408,
       r -> 0.406571, p2 -> 1.65072, 
      pw -> 1.96442}}}, {{9.70251*10^-19, {w -> 0.280124, 
      r -> 0.193537, p2 -> 1.12081, 
      pw -> 1.52232}}, {5.9975*10^-22, {w -> 0.406271, r -> 0.307383, 
      p2 -> 1.23501, pw -> 1.56292}}, {1.47675*10^-24, {w -> 0.450644,
       r -> 0.363777, p2 -> 1.3584, pw -> 1.59895}}}};

Processing:

v = {w, r, p2, pw};
ans = {Sequence @@ (v /. #2), #1} & @@@ (Join @@ res);
param = ans[[;; , 1 ;; 4]];
sol = ans[[;; , 5]];
Grid[Prepend[ans, Style[ToString[#], Bold] & /@ Join[v, {"Minimum"}]],
  Frame -> All]
tup = Tuples[{t, t2}];
full = MapThread[Join[#1, #2] &, {tup, ans}];
Grid[Prepend[full, 
  Style[ToString[#], Bold] & /@ Join[{"eta", "p"}, v, {"Minimum"}]], 
 Frame -> All]