2
$\begingroup$

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, (I would really appreciate some tips if you don't have time.)

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. https://community.wolfram.com/groups/-/m/t/2283209?p_p_auth=9QRn5tsc

$\endgroup$
7
  • $\begingroup$ Please try your code and fix the errors. $\endgroup$ Jun 5, 2021 at 9:05
  • $\begingroup$ @DanielHuber, I have already fixed the errors, there were typos, I hope you can give a hint to solve my problem, thanks $\endgroup$ Jun 5, 2021 at 10:07
  • $\begingroup$ You store the results of the first do loop in file1. But I can not see where you use these results in the second do loop. If you want to call the second do loop from the first one, for readability, you may put the second one in a function and call this function from the first loop. $\endgroup$ Jun 5, 2021 at 10:22
  • $\begingroup$ @DanielHuber, as you can see, I use the result of the first "Do" in the definition of the matrix m[i_] and M[i_] where I'm calling the list by "dn" and I run the second Do loop from 1 to Length[dn]. Thanks for your advice. $\endgroup$ Jun 5, 2021 at 10:25
  • $\begingroup$ Please add. cross-links to/from the corresponding Wolfram Community post. That way readers in one forum can see what has been written in the other. $\endgroup$ Jun 5, 2021 at 15:23

1 Answer 1

1
$\begingroup$

The goal, as I understand it, is to avoid storing dn. A straightforward approach is

SeedRandom[790];
SetSharedVariable[list];
list = {};

ParallelDo[pr = 1.*10^-13;
 v1 = 246.*10^9;
 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.}];
 mu2 = RandomReal[{1.*10^11, 1.*10^13}]*RandomChoice[{-1., 1.}]; 
 mu3 = RandomReal[{1.*10^11, 1.*10^13}] RandomChoice[{-1., 1.}];
 A = RandomReal[{0, 1.0*10^11}] RandomChoice[{-1., 1.}]; 
 mI2 = (0.5)*(v1^2)*(l3 + l4 - l5) + mu2^2;
 mnp2 = (0.5)*(v1^2)*l3 + mu2^2; 
 ms2 = {{(0.5)*v1^2*l7 + mu3^2, A*v1}, {A*v1, (0.5)*v1^2*(l3 + l4 + l5) + mu2^2}};
 ms2val = Eigenvalues[ms2];
 If[3.2*(10^22) < ms2val[[1]] < 4.0*(10^23) && 2.6*(10^22) < ms2val[[2]] < 3.4*(10^23), 
 dn = {ms2val[[1]], ms2val[[2]], l3, l4, l5, l7, ms2, 
 Eigenvectors[ms2][[1, 1]], Eigenvectors[ms2][[1, 2]]};

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 = {{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[[9]]*dn[[8]])/(16.*Sqrt[2]*Pi^2))*m;
If[Abs[Im[Eigenvalues[M . Transpose[M]][[1]]]] < pr && 
Abs[Im[Eigenvalues[M . Transpose[M]][[2]]]] < pr && 
Abs[Im[Eigenvalues[M . Transpose[M]][[3]]]] < pr && (1.*10^-5) < 
  Re[Eigenvalues[M . Transpose[M]][[2]]] - 
  Re[Eigenvalues[M . Transpose[M]][[3]]] < (9.*10^-5) && y1 > y2 &&
 y2 > y3 && y1 > y3 && 
 dn[[2]] > y3 && (2.000*10^-1) < (Eigenvectors[M . Transpose[M]][[1, 
     3]])^2 < (2.9*10^-1), 
AppendTo[list, {f1, f2, f3, f4, f5, f6, h1, h2, h3, h4, h5, h6, 
 Re[Eigenvalues[M . Transpose[M]][[1]]], Re[Eigenvalues[M . Transpose[M]][[2]]],
 M . Transpose[M], dn[[1]], dn[[2]], dn[[9]], dn[[8]]}]]],

{1000000}]

The major changes in the code given in the question are:

  1. Added RandomSeed so that results are reproducible.
  2. Used AppendTo to store final results in list in memory. If so many answers are produced that they do not fit in memory, the revert to PutAppend.
  3. When a case satisfying the first If is found, store the values in a single dn.
  4. Then, put the second calculation inside the first If to see whether it satisfies the second If.
  5. If the second If is satisfied, store the result in list.
  6. Simplified second block of code, primarily by eliminating unnecessary code in first If.
  7. Moved expressions for mI2 and mnp2 into Do loop, so that their values are updated as the index is advanced.
  8. Replaced Do by ParallelDo, which required declaring loop as a shared variable and moving all constants inside the loop.

The code now runs much faster and uses far less memory. For the given value of RandomSeed and 1000000 tries,

Length@list
(* 11 *)
$\endgroup$
7
  • $\begingroup$ you explained so well what I need, as you can realize that when we decide to make the whole calculation in a single Do loop, we have to evaluate do a lot of iterations in order to find a set satisfying both "If" conditions, I got exactly 6 sets of values too, do you know a better approach to this problem? Mathematica has so many functions that look like all of them can make my code better but I do not really know them and I'm new here. @bbgodfrey $\endgroup$ Jun 5, 2021 at 17:38
  • $\begingroup$ @FelipeVillazon I probably can decrease the run time by a factor of five or so, and shall try to do so soon. However, big savings typically only occur from changing the algorithm, which is where you should look, if you need to reduce run time significantly. $\endgroup$
    – bbgodfrey
    Jun 5, 2021 at 18:09
  • $\begingroup$ Yes, I agree with you, I've been reading the documentation and I thought that "For" could make it better but they recommend using Do, Module, Table instead of "For". I don't see the way to make it better so far, I will keep trying, I would really appreciate it if you can do that. Thank you so much. $\endgroup$ Jun 5, 2021 at 18:40
  • $\begingroup$ @FelipeVillazon Unfortunately, I was able only to reduce run time by about a third, primarily by eliminating unnecessary parts of the first If. Similar changes could be made in the second If, but it would not save much time at all. ParallelDo could save as much as a factor of four, but would require a significant rewrite of the code.. $\endgroup$
    – bbgodfrey
    Jun 5, 2021 at 19:43
  • $\begingroup$ I understand, there is a way to run two Do loops or more but with all of them running only with one iteration number, I mean like Do[ Do[Do[..] ], {i,1,n}] so all are gonna run sequencing from one to n and not independently each of them from 1 to n $\endgroup$ Jun 5, 2021 at 19:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.