Message Boards Message Boards

0
|
13666 Views
|
6 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Working with Nested Lists, Trying for a Partitioned Average

 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?
POSTED BY: Josh Wofford
6 Replies
Sort By:
Excellent. Thanks a lot Christopher.
POSTED BY: Josh Wofford
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
POSTED BY: Christopher French
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?
POSTED BY: Josh Wofford
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]
]
POSTED BY: Christopher French
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}]
POSTED BY: Christopher French
 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.
POSTED BY: Josh Wofford
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract