Message Boards Message Boards

0
|
3486 Views
|
3 Replies
|
3 Total Likes
View groups...
Share
Share this post:

Repeating and sequencing procedures with two Do-loops

Felipe Villazon
Posted 3 years ago

I have a Do loop where I'm looking for the value of certain parameters that respect the conditions inside an If, and with those values, a run another Do to make another calculation of an expression that uses the values found previously, how can I do that for every set of value of the parameters that satisfy the condition in the first Do loop automatically go to the second Do loop and at the end, put the found values in both Do loop in the same list, here an example of what I did,

file = File[CreateFile[File@"list1"]]

pr = 1.*10^-13;
mI2 = (0.5)*(v1^2)*(l3+l4-l5) + mu2^2;
mnp2 = (0.5)*(v1^2)*l3 + mu2^2;
Do[
v1= 246.*10^9;
mu2= RandomReal[{1.*10^11, 1.*10^13}]*RandomChoice[{-1., 1.}];
l7= RandomReal[{0, 1.}]*RandomChoice[{-1., 1.}];
l3= RandomReal[{0, 1.}]*RandomChoice[{-1., 1.}];
l4= RandomReal[{0, 1.}]*RandomChoice[{-1., 1.}];
l5= RandomReal[{0, 1.}]*RandomChoice[{-1., 1.}];
mu3= RandomReal[{1.*10^11, 1.*10^13}] RandomChoice[{-1., 1.}];
A= RandomReal[{0, 1.0*10^11}] RandomChoice[{-1., 1.}];
ms2={{(0.5)*v1^2*l7+mu3^2,A*v1},{A*v1,(0.5)*v1^2*(l3+l4+l5)+mu2^2}};

If[Abs[Im[Eigenvalues[ms2][[1]]]] < pr && Abs[Im[Eigenvalues[ms2][[2]]]] < pr &&
3.2*(10^22) < Re[Eigenvalues[ms2][[1]]] < 4.0*(10^23) &&
2.6*(10^22) < Re[Eigenvalues[ms2][[2]]] < 3.4*(10^23) &&
Re[Eigenvalues[ms2][[1]]] > Re[Eigenvalues[ms2][[2]]] &&
Re[Eigenvalues[ms2][[1]]] > 0 && Re[Eigenvalues[ms2][[2]]] > 0,
PutAppend[{Re[Eigenvalues[ms2][[1]]],Re[Eigenvalues[ms2][[2]]],l3,l4,l5,l7,ms2,
Eigenvectors[ms2][[1,1]],Eigenvectors[ms2][[1,2]]},"list1"]],{10000}]//ByteCount//AbsoluteTiming


dn=ReadList["list1"];

Here you can see that I save the result in the list and then once I got them, I use another "Do" to evaluate them as follows

Do[
y1 = RandomReal[{100., 1000.}]*1.*10^9;
y2 = RandomReal[{100., 1000.}]*1.*10^9;
y3 = RandomReal[{100., 1000.}]*1.*10^9;
h1 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
h2 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
h3 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
h4 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
h5 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
h6 = RandomReal[{1.*10^-7, 1.*10^-5}]*RandomChoice[{-1., 1.}];
f1 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];
f2 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];
f3 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];
f4 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];
f5 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];
f6 = RandomReal[{1.*10^-7, 1.*10^-5}] RandomChoice[{-1., 1.}];

m[i_]:={{f1*h1,f1*h2,f1*h3},{f2*h1,f2*h2,f2*h3},{f3*h1,f3*h2,f3*h3}}*
        y1*(dn[[i, 1]]/(dn[[i, 2]] - y2^2))*Log[dn[[i, 1]]/y1^2]+
       {{f2*h2,f2*h4,f2*h3},{f4*h2,f4*h4,f4*h3},{f5*h2,f5*h4,f5*h3}}*
        y2*(dn[[i, 2]]/(dn[[i, 1]] - y2^2))*Log[dn[[i, 1]]/y2^2]+
       {{f3*h3,f3*h5,f3*h6},{f5*h3,f5*h5,f5*h6},{f6*h3,f6*h5,f6*h6}}*
        y3*(dn[[i, 1]]/(dn[[i, 1]] - y3^2))*Log[dn[[i, 2]]/y3^2];

M[i_]:=((dn[[i, 9]]*dn[[i, 8]])/(16.*Sqrt[2]*Pi^2))*m[i];

If[Abs[Im[Eigenvalues[M[i].Transpose[M[i]]][[1]]]] < pr &&
Abs[Im[Eigenvalues[M[i].Transpose[M[i]]][[2]]]] < pr &&
Abs[Im[Eigenvalues[M[i].Transpose[M[i]]][[3]]]] < pr &&
(1.*10^-5)<Re[Eigenvalues[M[i].Transpose[M[i]]][[2]]] -
Re[Eigenvalues[M[i].Transpose[M[i]]][[3]]] < (9.*10^-5) &&
y1 > y2 && y2 > y3 && y1 > y3 && dn[[i, 2]] > y3 &&
(2.000*10^-1) < (Eigenvectors[M[i].Transpose[M[i]]][[1,3]])^2 < (2.9*10^-1),
PutAppend[{f1, f2, f3, f4, f5, f6, h1, h2, h3, h4, h5, h6,
Re[Eigenvalues[M[i].Transpose[M[i]]][[1]]],
Re[Eigenvalues[M[i].Transpose[M[i]]][[2]]],
,M[i].Transpose[M[i]],dn[[i, 1]],dn[[i, 2]],dn[[i, 9]],dn[[i,8]]},"list2"]],
{i, 1, Length[dn]}] // AbsoluteTiming

You can see that in the second Do I use the parameters that satisfy the condition of the first Do but if I want to evaluate like 50000000 points I will have to use a lot of memory, I want that every time the first loop finds a point, go immediately to the second loop to evaluate it and see if it satisfy the conditions of the second loop.

Which would be the better way to do this, saving time and memory. Optimizing the search of the points. Not doing the whole calculation putting all the conditions in the same IF.

Another way to do that would be like putting all in the same "Do" and all the conditions in the same "If" but I don't know how "Do" works, and the first "Do" get the result very easy but in the second "Do" it's hard to find a set of parameters because of the conditions, that's why I want to make them running in different loops.
POSTED BY: Felipe Villazon
3 Replies
Sort By:
Updating Name
Updating Name
Posted 3 years ago

This should do what you want.

Basically what I did was place your second loop within the if statement of the first. once the first condition is met the values are added to a list dnAll. then the second condition is checked and added to the list outAll.

I removed all static and function definitions from the loop since that thakes unneded time and the Eigensystem calculation is now only done once when needed.

I ran 1M in 60s, found 2100 in the first stage and 10 in the second one that are valid. So if you want to scale it up to 50M the memory usage should be ok and done in around 1h. 

dnAll = outAll = {};

Rand1[n_ : 1] := RandomReal[{-1., 1.}, n]
Rand2[n_ : 1] := 
 RandomReal[{10^11, 10^13}, n] RandomChoice[{-1., 1.}, n]
Rand3[n_ : 1] := RandomReal[{-10^11, 10^11}, n]

Rand4[n_ : 1] := RandomReal[{100., 1000.}, n] 10^9
Rand5[n_ : 1] := 
  RandomReal[{10^-7, 10^-5}, n]*RandomChoice[{-1., 1.}, n];

m[dn_, {y1_, y2_, y3_}, {h1_, h2_, h3_, h4_, h5_, h6_}, {f1_, f2_, 
   f3_, f4_, f5_, f6_}] := (
  {{f1*h1, f1*h2, f1*h3}, {f2*h1, f2*h2, f2*h3}, {f3*h1, f3*h2, 
      f3*h3}}*y1*(dn[[1]]/(dn[[2]] - y2^2))*Log[dn[[1]]/y1^2] +
   {{f2*h2, f2*h4, f2*h3}, {f4*h2, f4*h4, f4*h3}, {f5*h2, f5*h4, 
      f5*h3}}*y2*(dn[[2]]/(dn[[1]] - y2^2))*Log[dn[[1]]/y2^2] +
   {{f3*h3, f3*h5, f3*h6}, {f5*h3, f5*h5, f5*h6}, {f6*h3, f6*h5, 
      f6*h6}}*y3*(dn[[1]]/(dn[[1]] - y3^2))*Log[dn[[2]]/y3^2]
  )

M[dn_, m_] := ((dn[[9]]*dn[[8]])/(16.*Sqrt[2]*Pi^2))*m;

pr = 1.*10^-13;
mI2 = (0.5)*(v1^2)*(l3 + l4 - l5) + mu2^2;
mnp2 = (0.5)*(v1^2)*l3 + mu2^2;
v1 = 246.*10^9;
Do[
 {l3, l4, l5, l7} = Rand1[4];
 {mu2, mu3} = Rand2[2];
 {A} = Rand3[];

 ms2 = {{(0.5)*v1^2*l7 + mu3^2, 
    A*v1}, {A*v1, (0.5)*v1^2*(l3 + l4 + l5) + mu2^2}};
 {{val1, val2}, {vec1, vec2}} = Eigensystem[ms2];

 If[Abs[Im[val1]] < pr && Abs[Im[val2]] < pr && 
   3.2*(10^22) < Re[val1] < 4.0*(10^23) && 
   2.6*(10^22) < Re[val2] < 3.4*(10^23) && Re[val1] > Re[val2] && 
   Re[val1] > 0 && Re[val2] > 0,

  dn = {Re[Eigenvalues[ms2][[1]]], Re[Eigenvalues[ms2][[2]]], l3, l4, 
    l5, l7, ms2, Eigenvectors[ms2][[1, 1]], Eigenvectors[ms2][[1, 2]]};
  AppendTo[dnAll, dn];

  y = {y1, y2, y3} = Rand4[3];
  h = Rand5[6];
  f = Rand5[6];

  mat = M[dn, m[dn, y, h, f]];
  mat = mat . Transpose[mat];
  {{val1, val2, val3}, {vec1, vec2, vec3}} = Eigensystem[mat];

  If[Abs[Im[val1]] < pr && Abs[Im[val2]] < pr && 
    Abs[Im[val3]] < pr && (1.*10^-5) < 
     Re[val2] - Re[val3] < (9.*10^-5) && y1 > y2 && y2 > y3 && 
    y1 > y3 && 
    dn[[2]] > y3 && (2.000*10^-1) < (vec1[[3]])^2 < (2.9*10^-1),

   out = Join[f, 
     h, {Re[val1], Re[val2], mat, dn[[1]], dn[[2]], dn[[9]], dn[[8]]}];
   AppendTo[outAll, out];
   ]
  ], {1000000}]
POSTED BY: Updating Name
Mike Besso
Mike Besso
Posted 3 years ago

I don't have the time right now to understand your code, but I think Sow[] and Reap[] might take care of your memory issue.

Here is a overly-simplified example of how Sow and Reap can be used in a situation like this:

f[x_] := Do[
   With[
    {
     r = RandomInteger[i]
     }
    ,
    If[OddQ[r], Sow[r]]
    ]
   ,
   {i, Abs[x]}
   ];

g[x_] := Reap[
   Do[
     With[
      {
       r = RandomInteger[i]
       }
      ,
      If[EvenQ[r], f[r]];
      ]
     , 
     {i, Abs[x]}
     ];
   ] [[2]] // First;;


g[100]

This example wraps the outer Do[] with Reap[] which will collect only those values sowed by Sow[] in the inner Do[].

As I understand it, this technique will only retain in memory the values that you want to keep while immediately discarding those that fail the test.

Good luck, and have a great and safe rest of your weekend.
POSTED BY: Mike Besso
Mike Besso
Mike Besso
Posted 3 years ago

I don't have the time right now to understand your code, but I think Sow[] and Reap[] might take care of your memory issue.

Here is a overly-simplified example of how Sow and Reap can be used in a situation like this:

f[x_] := Do[
   With[
    {
     r = RandomInteger[i]
     }
    ,
    If[OddQ[r], Sow[r]]
    ]
   ,
   {i, Abs[x]}
   ];

g[x_] := Reap[
   Do[
     With[
      {
       r = RandomInteger[i]
       }
      ,
      If[EvenQ[r], f[r]];
      ]
     , 
     {i, Abs[x]}
     ];
   ] [[2]] // First;;


g[100]

This example wraps the outer Do[] with Reap[] which will collect only those values sowed by Sow[] in the inner Do[].

As I understand it, this technique will only retain in memory the values that you want to keep while immediately discarding those that fail the test.

Good luck, and have a great and safe rest of your weekend.
POSTED BY: Mike Besso
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