Working with Nested Lists, Trying for a Partitioned Average

Questions
, ,
1 
Clear["Global'*"];
errortrial1 = 
 Table[ro2 = 3400; kmrs = 70; kisu = 1.4; kmp = .5; kres = 25;
  kccc1 = 38; k23 = 16; kvp = .04; kc = 21; nc = 5; km1 = 24; nm1 = 3;
  km2 = 15; nm2 = 4.5; kv1 = 17; nv1 = 6; kv2 = 200; nv2 = 4; 
  k32 = 18; n32 = 9; a = .5;
  odec = -(a c[t]) - (
    kccc1 c[t] (1 - 1/((c[t]/kv1)^nv1 + 1)))/((f3[t]/kv2)^nv2 + 1) - (
    kmrs c[t])/((fm[t]/km2)^nm2 + 1) + (khi nut)/((c[t]/kc)^nc + 1);
  odefm = -(a fm[t]) + (kmrs c[t])/((fm[t]/km2)^nm2 + 1) - 
    kisu fm[t] - kmp fm[t] o2[t];
  odefs = kisu fm[t] - a fs[t];
  odemp = kmp fm[t] o2[t] - a mp[t];
  odeo2 = -(kmp fm[t] o2[t]) - kres fs[t] o2[t] + 
    ro2/((o2[t]/245)^9 + 1);
  odef2 = -(a f2[t]) - k23 f2[t] (1 - 1/((c[t]/k32)^n32 + 1)) + (
    kccc1 c[t] (1 - 1/((c[t]/kv1)^nv1 + 1)))/((f3[t]/kv2)^nv2 + 1);
  odef3 = -(a f3[t]) + k23 f2[t] (1 - 1/((c[t]/k32)^n32 + 1)) - 
    kvp f3[t];
  odevp = kvp f3[t] - a vp[t];
  vars = {khi, nut, c[t], f2[t], f3[t], fm[t], fs[t], mp[t], o2[t], 
    vp[t], rmsd};
  solution = 
   NDSolve[{Derivative[1][c][t] == odec, 
     Derivative[1][f2][t] == odef2, Derivative[1][f3][t] == odef3, 
     Derivative[1][fm][t] == odefm, Derivative[1][fs][t] == odefs, 
     Derivative[1][mp][t] == odemp, Derivative[1][o2][t] == odeo2, 
     Derivative[1][vp][t] == odevp, c[0] == 30, f2[0] == 100, 
     f3[0] == 100, fm[0] == 50, fs[0] == 50, mp[0] == 0, o2[0] == 100,
      vp[0] == 100}, vars, {t, 0, 31}];
  vars1 = vars /. solution /. t -> 31;
  vars2 = Flatten[vars1];
  If[nut == 4, {fecell = 153, fef3 = 0, fem = 97, fevp = 0}, 
   "nut not 4"];
  If[nut == 7, {fecell = 250, fef3 = 100, fem = 60, fevp = 30}, 
   "nut not 7"];
  If[nut == 16, {fecell = 395, fef3 = 250, fem = 80, fevp = 0}, 
   "nut not 16"];
  If[nut == 46, {fecell = 440, fef3 = 295, fem = 65, fevp = 45}, 
   "nut not 46"];
  If[nut == 106, {fecell = 440, fef3 = 350, fem = 40, fevp = 20}, 
   "nut not 106"];
  If[nut == 1006, {fecell = 455, fef3 = 360, fem = 30, fevp = 30}, 
   "nut not 1006"];
  If[nut == 10006, {fecell = 465, fef3 = 365, fem = 25, fevp = 35}, 
   "nut not 10006"];
  rmsd = ((((Part[vars2, 3] + Part[vars2, 4] + Part[vars2, 5] + 
           Part[vars2, 6] + Part[vars2, 7] + Part[vars2, 8] + 
           Part[vars2, 10] - fecell)/
         fecell)^2 + ((Part[vars2, 5] - fef3)/
         fecell)^2 + ((Part[vars2, 6] + Part[vars2, 7] + 
           Part[vars2, 8] - fem)/
         fecell)^2 + ((Part[vars2, 10] - fevp)/fecell)^2));
  vars2, {khi, 10, 16, 1}, {nut, {4, 7, 16, 46, 106, 1006, 10006}}]

Currently I am working with this code to try and average out the last value in the lists (rmsd) over the khi values with respect to the nut values. Another way of explaining this, I want an average rmsd over the 7 nut values for each khi in the table. My problem is that since each of the values across this table are technically the same, I’m afraid running a sort or groupby would sort everything together for a global average of the table. Any suggestions?

2

If this gives the result you want

Map[Mean[{rmsd, #}] &, errortrial1, {3}]

Then the way to do the same inside errortrial1 is to replace the last vars2 with

Map[Mean[{rmsd, #}] &, vars2, {1}]

or equivalently

Mean[{rmsd, #}]&/@vars2
Mean /@ Thread[{rmsd, vars2}]
3 
Clear["Global'*"];
errortrial1 = 
 Table[ro2 = 3400; kmrs = 70; kisu = 1.4; kmp = .5; kres = 25;
  kccc1 = 38; k23 = 16; kvp = .04; kc = 21; nc = 5; km1 = 24; nm1 = 3;
  km2 = 15; nm2 = 4.5; kv1 = 17; nv1 = 6; kv2 = 200; nv2 = 4; 
  k32 = 18; n32 = 9; a = .5;
  odec = -(a c[t]) - (
    kccc1 c[t] (1 - 1/((c[t]/kv1)^nv1 + 1)))/((f3[t]/kv2)^nv2 + 1) - (
    kmrs c[t])/((fm[t]/km2)^nm2 + 1) + (khi nut)/((c[t]/kc)^nc + 1);
  odefm = -(a fm[t]) + (kmrs c[t])/((fm[t]/km2)^nm2 + 1) - 
    kisu fm[t] - kmp fm[t] o2[t];
  odefs = kisu fm[t] - a fs[t];
  odemp = kmp fm[t] o2[t] - a mp[t];
  odeo2 = -(kmp fm[t] o2[t]) - kres fs[t] o2[t] + 
    ro2/((o2[t]/245)^9 + 1);
  odef2 = -(a f2[t]) - k23 f2[t] (1 - 1/((c[t]/k32)^n32 + 1)) + (
    kccc1 c[t] (1 - 1/((c[t]/kv1)^nv1 + 1)))/((f3[t]/kv2)^nv2 + 1);
  odef3 = -(a f3[t]) + k23 f2[t] (1 - 1/((c[t]/k32)^n32 + 1)) - 
    kvp f3[t];
  odevp = kvp f3[t] - a vp[t];
  vars = {khi, nut, c[t], f2[t], f3[t], fm[t], fs[t], mp[t], o2[t], 
    vp[t], rmsd};
  solution = 
   NDSolve[{Derivative[1][c][t] == odec, 
     Derivative[1][f2][t] == odef2, Derivative[1][f3][t] == odef3, 
     Derivative[1][fm][t] == odefm, Derivative[1][fs][t] == odefs, 
     Derivative[1][mp][t] == odemp, Derivative[1][o2][t] == odeo2, 
     Derivative[1][vp][t] == odevp, c[0] == 30, f2[0] == 100, 
     f3[0] == 100, fm[0] == 50, fs[0] == 50, mp[0] == 0, o2[0] == 100,
      vp[0] == 100}, vars, {t, 0, 31}];
  vars1 = vars /. solution /. t -> 31;
  vars2 = Flatten[vars1];
  If[nut == 4, {fecell = 153, fef3 = 0, fem = 97, fevp = 0}, 
   "nut not 4"];
  If[nut == 7, {fecell = 250, fef3 = 100, fem = 60, fevp = 30}, 
   "nut not 7"];
  If[nut == 16, {fecell = 395, fef3 = 250, fem = 80, fevp = 0}, 
   "nut not 16"];
  If[nut == 46, {fecell = 440, fef3 = 295, fem = 65, fevp = 45}, 
   "nut not 46"];
  If[nut == 106, {fecell = 440, fef3 = 350, fem = 40, fevp = 20}, 
   "nut not 106"];
  If[nut == 1006, {fecell = 455, fef3 = 360, fem = 30, fevp = 30}, 
   "nut not 1006"];
  If[nut == 10006, {fecell = 465, fef3 = 365, fem = 25, fevp = 35}, 
   "nut not 10006"];
  rmsd = ((((Part[vars2, 3] + Part[vars2, 4] + Part[vars2, 5] + 
           Part[vars2, 6] + Part[vars2, 7] + Part[vars2, 8] + 
           Part[vars2, 10] - fecell)/
         fecell)^2 + ((Part[vars2, 5] - fef3)/
         fecell)^2 + ((Part[vars2, 6] + Part[vars2, 7] + 
           Part[vars2, 8] - fem)/
         fecell)^2 + ((Part[vars2, 10] - fevp)/fecell)^2));
  vars2, {khi, 10, 16, 1}, {nut, {4, 7, 16, 46, 106, 1006, 10006}}]

Map[Mean[{rmsd, #}] &, errortrial1, {3}]

For the first part, do you mean something like this? I get values, but I am not entirely sure what they are.

4

Right. What I did was not what you wanted. By mapping down to level 3 in errortrial1, rmsd was averaged with every value. The first two columns are storing the index for khi and nut, they do not need to get involved in the average. The rmsd evaluated outside of Table is 0.322445 and matches the value at the end of the row labled 16, 10006. This is the line I am having trouble understanding.

vars = {khi, nut, c[t], f2[t], f3[t], fm[t], fs[t], mp[t], o2[t], vp[t], rmsd};

By not clearing rmsd in the body on every pass, errortrial1 will get a different result in the row labeled 10, 4, if this Table expression is evaluated more than once in the same session. Storing the symbol rmsd at the end of vars, will only work if there is no value assigned to rmsd at the time.

This will get rmsd averaged will items at position 3 through 10 in vars2

MapAt[
 Mean /@ Thread[rmsd, #] &, 
 vars2, 
 List /@ Range[3, 10]
 ]
5

Not quite what I am looking for, but thanks for being so helpful. I am looking to take the seven rmsd’s produced from the changing nut values per each khi value. So I should be producing one average of the rmsd’s per each khi, 6 in total. Any help with that?

6

Gotcha. The rmsd’s are being stored in the last position of every vars2 result in errortrial1. If they are already grouped together in the way you want them to be averaged, the rmsd can be isolated specifying multiple levels of Part. Then map the averaging function down the list of groups.

In[ ]:= Mean /@ errortrial1[[All, All, -1]]
Out[ ]= {0.233804, 0.212374, 0.194063, 0.179314, 0.168302, 0.160716, 0.155938}

Here is an alternative notation to Plus over multiple targeted Part’s for you.

Total[ vars2[[{3, 4, 5, 6, 7, 8, 10}]] ] - fecell
7

Excellent. Thanks a lot Christopher.