I have a list of functions and I want to separate them into two lists:
- a list that contains the functions that have at least one zero and
- a list that contains the functions that do not have zeros.
Let's say that the list of functions is this:
listoffuns =
Flatten[Table[
Rationalize[a + b*Cos[c*(t + d)], 0], {a, 0.0003, 0.009, 0.0001}, {b, 0.01, 0.1,
0.01}, {c, 1, 4, 1}, {d, 2, 5, 1}]]
I initially used this:
lengthoflistoffuns = Length[listoffuns]; list1 = {}; list2 = {}; table =
For[i = 1, i <= lengthoflistoffuns, i = i + 1,
If[Resolve[Exists[t, listoffuns[[i]] == 0], Reals], AppendTo[list1, listoffuns[[i]]],
AppendTo[list2, listoffuns[[i]]]]]
because, back then, the number of functions was small and I didn't have problems concerning efficiency. But now it is a problem for me. I know that For and AppendTo
are inefficient commands in Mathematica and I want to replace them. I thought that it would be an efficient way for constructing the above mentioned lists if I used Sow
and Reap
instead of AppendTo
and defined a pure function that would do the separation applied with the Map command to the values of i in the For loop. So help me do this in the way that I proposed or in your own (efficient) way. This is what I tried:
sepfun := If[Resolve[Exists[t, listoffuns[[#]] == 0], Reals],
list1 = Reap[Sow[listoffuns[[#]]]], list2 = Reap[Sow[listoffuns[[#]]]]] &
table1 = Table[j, {j, 1, lengthoflistoffuns, 1}]
sepfun /@ table1
I didn't construct a representative problem before because I expected answers that would also fit my real problem. So, I 'll cite now my real problem.
I want to construct list1
, list2
, list3
and list4
in an efficient way. So, I want to modify table8
and table9
in my code. The listoffuns
corresponds, in my real problem, to the listofMelnfunthroughSimpsintegr
. Each of these functions correspond to an ordered 4-tuple (α, β, Ω, γ). In table8
I want to gather the 4-tuples (α, β, Ω, γ) that correspond to functions that have at least one zero in list1
and in list2
the rest of them. In table9
I want to gather the 4-tuples (α, β, Ω, γ) that correspond to functions that have only simple zeros in list4
and in list3
the rest of them (functions that have at least one zero with multiplicity two or greater). In table9
the functions that I separate are the functions that belong to the list listofMelnfunwhichhavezeros
.
I have fixed γ in my code so some commands seem to be unnecessary but they 're not because I want to be able to vary γ if needed on my way to the solution of the whole problem.
Here is a link that might be helpful for some people http://en.wikipedia.org/wiki/Multiplicity_%28mathematics%29.
Although, I asked this question to solve the above mentioned problem any adaptations that can easily be done in my code that drastically save time are welcome. I know that there are because this is my first program in mathematica and now that I have learned it a little if I did it from the beginning I would have made some changes but I don't know if they are worth the time concerning the gained performance.
I don't know if it's useful for anyone but I tried to separate the functions listofMelnfunthroughSimpsintegr
using the suggestions of Histograms and LLlAMnYP and it took 786 s (13.1 min).
c0 = 0.001; initvlofγ = 1; finvlofγ = 1; incrstepofγ = 1;
s = Partition[
Flatten[Table[
NDSolve[{x1'[t] == x2[t], x2'[t] == -γ*Sin[x1[t]],
x1[0] == -Pi + c0,
x2[0] == 0.9*(Sqrt[γ]*(-Pi + c0) + Sqrt[γ]*Pi),
WhenEvent[
Abs[x2[t]] <= 10^-2, {"StopIntegration", end = t}]}, {x1,
x2}, {t, 0, Infinity}, MaxSteps -> 10^6], {γ, initvlofγ,
finvlofγ, incrstepofγ}]], 2];
lengthofs = Length[s]; listofx1 = Table[s[[x1, 1, 2]], {x1, 1,
lengthofs, 1}];
listofx2 = Table[s[[x2, 2, 2]], {x2, 1, lengthofs, 1}];
listofendfordifferentvlsofγ = Table[s[[nvofγ, 1, 2, 1, 1, 2]], {nvofγ, 1,
lengthofs, 1}];
ParametricPlot[
Evaluate[Table[
ConditionalExpression[{listofx1[[nvofγ]][t], listofx2[[nvofγ]][t]},
0 <= t <= listofendfordifferentvlsofγ[[nvofγ]]], {nvofγ, 1,
lengthofs, 1}]], {t, 0, Max[listofendfordifferentvlsofγ]},
PlotRange -> {{-Pi - 1, Pi + 1}, All},
AxesLabel -> {"\!\(\*SubscriptBox[\(x\), \(1\)]\)",
"\!\(\*SubscriptBox[\(x\), \(2\)]\)"}]
initvlofα = 0.1; finvlofα = 2; incrstepofα = 0.1;
initvlofβ = 0.1; finvlofβ = 2; incrstepofβ = 0.1;
initvlofΩ = 0.1; finvlofΩ = 2; incrstepofΩ = 0.1;
listofzfordifferentvlsofαβΩ =
Flatten[Table[
With[{α = α, β = β, Ω = Ω}, (α*Cos[Ω*(#2 + t0)]*#1 - β*#1^2) &], {α,
initvlofα,
finvlofα, incrstepofα}, {β, initvlofβ, finvlofβ, incrstepofβ}, {Ω,
initvlofΩ, finvlofΩ, incrstepofΩ}]];
timestep = 1;
x2tdyadsfordifferentvlsofγ =
Partition[
Flatten[Table[{listofx2[[nvofγ]][ζ], ζ}, {nvofγ, 1, lengthofs,
1}, {ζ, 0, listofendfordifferentvlsofγ[[nvofγ]], timestep}]], 2];
listoflengthsofsublistsofx2tdyads =
Table[1 +
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep], {nvofγ, 1,
lengthofs, 1}];
lengthoflistoflengthsofsublistsofx2tdyads =
Length[listoflengthsofsublistsofx2tdyads];
table1 = Table[
Sum[listoflengthsofsublistsofx2tdyads[[index1]], {index1,
index1}], {index1, 1, lengthoflistoflengthsofsublistsofx2tdyads, 1}];
table2 = Drop[Riffle[table1, table1], -1];
table3 = Riffle[Table[0^nvofγ, {nvofγ, 1, lengthofs, 1}], 1];
pairs = Partition[Prepend[table2 + table3, 1], 2];
x2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ =
Take[x2tdyadsfordifferentvlsofγ, #] & /@ pairs;
lengthoflistofzfordifferentvlsofαβΩ =
Length[listofzfordifferentvlsofαβΩ];
listofoneplusfloorvls = listoflengthsofsublistsofx2tdyads;
listofpositionsofoneplusfloorvlswhichareeven =
Flatten[Position[listofoneplusfloorvls, _?EvenQ]];
listofx2tdyadstobeinserted =
Partition[
Flatten[Table[{listofx2[[
nvofγ]][(Sum[
timestep, {index3,
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep]}] +
Sum[timestep, {index3,
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep] -
1}])/2], (Sum[
timestep, {index3,
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep]}] +
Sum[timestep, {index3,
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep] - 1}])/
2}, {nvofγ,
listofpositionsofoneplusfloorvlswhichareeven}]],2];
lengthoflistofx2tdyadstobeinserted = Length[listofx2tdyadstobeinserted];
x2tdyadsorganizedinsublistscorrespondingtoevenvlsofγbeforemodification
= Table[AppendTo[
x2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ[[
listofpositionsofoneplusfloorvlswhichareeven[[pos]]]],
listofx2tdyadstobeinserted[[pos]]], {pos,
lengthoflistofx2tdyadstobeinserted}];
listoflengthsofx2tdyadsorganizedinsublistscorrespondingtoevenvlsofγbef
oremodification =
Table[Length[
x2tdyadsorganizedinsublistscorrespondingtoevenvlsofγbeforemodificat
ion[[pos]]], {pos, lengthoflistofx2tdyadstobeinserted}];
x2tdyadsorganizedinsublistscorrespondingtoevenvlsofγ =
Table[Permute[
x2tdyadsorganizedinsublistscorrespondingtoevenvlsofγbeforemodificat
ion[[pos]],
Cycles[{{
listoflengthsofx2tdyadsorganizedinsublistscorrespondingtoevenvlsofγbef
oremodification[[pos]] - 1,
listoflengthsofx2tdyadsorganizedinsublistscorrespondingtoevenvls
ofγbeforemodification[[pos]]}}]], {pos,
lengthoflistofx2tdyadstobeinserted}];
finalx2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ =
ReplacePart[
x2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ,
Table[listofpositionsofoneplusfloorvlswhichareeven[[pos]] ->
x2tdyadsorganizedinsublistscorrespondingtoevenvlsofγ[[pos]], {pos,
lengthoflistofx2tdyadstobeinserted}]];
listoflengthsofsublistsoffinalx2tdyads =
Table[Length[
finalx2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ[[
index]]], {index, lengthofs}];
listoffwedgegvlsfordifferentvlsofαβΩvaryingγ =
Table[Apply[listofzfordifferentvlsofαβΩ[[index2]],
finalx2tdyadsorganizedinsublistscorrespondingtodifferentvlsofγ[[
nvofγ]], {1}], {index2, 1, lengthoflistofzfordifferentvlsofαβΩ,
1}, {nvofγ, 1, lengthofs, 1}];
listofthefirstfactorsofSimpsrule =
Table[((Sum[
timestep, {index3,
Floor[listofendfordifferentvlsofγ[[nvofγ]]/timestep]}] -
0)/(listoflengthsofsublistsoffinalx2tdyads[[nvofγ]] - 1))/
3, {nvofγ, 1, lengthofs, 1}];
numberofvlsofα = Abs[finvlofα - initvlofα]/incrstepofα + 1;
numberofvlsofβ = Abs[finvlofβ - initvlofβ]/incrstepofβ + 1;
numberofvlsofΩ = Abs[finvlofΩ - initvlofΩ]/incrstepofΩ + 1;
listofthefirsttermsofthesecondfactorofSimpsrule =
Flatten[Table[
listoffwedgegvlsfordifferentvlsofαβΩvaryingγ[[index4, index5,
1]], {index4, 1, numberofvlsofα*numberofvlsofβ*numberofvlsofΩ,
1}, {index5, 1, lengthofs, 1}]];
lengthoflistofthefirsttermsofthesecondfactorofSimpsrule =
Length[listofthefirsttermsofthesecondfactorofSimpsrule];
listofthesecondtermsofthesecondfactorofSimpsrule =
Flatten[Table[
4*Sum[listoffwedgegvlsfordifferentvlsofαβΩvaryingγ[[index4, index5,
index6]], {index6, 2,
listoflengthsofsublistsoffinalx2tdyads[[index5]] - 1,
2}], {index4, 1, numberofvlsofα*numberofvlsofβ*numberofvlsofΩ,
1}, {index5, 1, lengthofs, 1}]];
lengthoflistofthesecondtermsofthesecondfactorofSimpsrule =
Length[listofthesecondtermsofthesecondfactorofSimpsrule];
listofthethirdtermsofthesecondfactorofSimpsrule =
Flatten[Table[
2*Sum[listoffwedgegvlsfordifferentvlsofαβΩvaryingγ[[index4, index5,
index7]], {index7,
3, (listoflengthsofsublistsoffinalx2tdyads[[index5]] - 1) - 1,
2}], {index4, 1, numberofvlsofα*numberofvlsofβ*numberofvlsofΩ,
1}, {index5, 1, lengthofs, 1}]];
lengthoflistofthethirdtermsofthesecondfactorofSimpsrule =
Length[listofthethirdtermsofthesecondfactorofSimpsrule];
listofthefourthtermsofthesecondfactorofSimpsrule =
Flatten[Table[
listoffwedgegvlsfordifferentvlsofαβΩvaryingγ[[index4,
index5, (listoflengthsofsublistsoffinalx2tdyads[[index5]] - 1) +
1]], {index4, 1, numberofvlsofα*numberofvlsofβ*numberofvlsofΩ,
1}, {index5, 1, lengthofs, 1}]];
lengthoflistofthefourthtermsofthesecondfactorofSimpsrule =
Length[listofthefourthtermsofthesecondfactorofSimpsrule];
listofMelnfunthroughSimpsintegrbeforemultiplyingwiththefirstfactors =
Table[Rationalize[
listofthefirsttermsofthesecondfactorofSimpsrule[[index8]] +
listofthesecondtermsofthesecondfactorofSimpsrule[[index8]] +
listofthethirdtermsofthesecondfactorofSimpsrule[[index8]] +
listofthefourthtermsofthesecondfactorofSimpsrule[[index8]],
0], {index8, 1,
lengthoflistofthefirsttermsofthesecondfactorofSimpsrule, 1}];
lengthoflistofMelnfunthroughSimpsintegrbeforemultiplyingwiththefirstfa
ctors = Length[
listofMelnfunthroughSimpsintegrbeforemultiplyingwiththefirstfactors];
table4 = PadLeft[listofthefirstfactorsofSimpsrule,
lengthoflistofthefirsttermsofthesecondfactorofSimpsrule,
listofthefirstfactorsofSimpsrule];
lengthoftable4 = Length[table4];
listofMelnfunthroughSimpsintegr =
Thread[Times[table4,
listofMelnfunthroughSimpsintegrbeforemultiplyingwiththefirstfactors]];
lengthoflistofMelnfunthroughSimpsintegr =
Length[listofMelnfunthroughSimpsintegr];
listofzfordifferentvlsofαβΩaccompaniedbythevlsofαβΩ =
Flatten[Table[
With[{α = α, β = β,
Ω = Ω}, (α*Cos[Ω*(#2 + t0)]*#1 - β*#1^2) {α, β, Ω} &], {α,
initvlofα, finvlofα, incrstepofα}, {β, initvlofβ, finvlofβ,
incrstepofβ}, {Ω, initvlofΩ, finvlofΩ, incrstepofΩ}]];
listofthevlsofαβΩ =
Table[listofzfordifferentvlsofαβΩaccompaniedbythevlsofαβΩ[[index9, 1,
2]], {index9, 1, lengthoflistofzfordifferentvlsofαβΩ, 1}];
table5 = Flatten[
Transpose[Table[listofthevlsofαβΩ, {index10, lengthofs}]], 1];
listofthevlsofγ = Table[{γ}, {γ, initvlofγ, finvlofγ, incrstepofγ}];
table6 = Flatten[Table[listofthevlsofγ, {index12,
numberofvlsofα*numberofvlsofβ*numberofvlsofΩ}], 1];
listofthevlsofαβΩγ =
Table[table5[[index13]]~Join~table6[[index13]], {index13, 1,
lengthoflistofMelnfunthroughSimpsintegr, 1}];
table7 = Range[1, lengthoflistofMelnfunthroughSimpsintegr, 1];
listofthevlsofαβΩγaccompaniedbytheindexofthecorrespondingMelnfun =
listofthevlsofαβΩγ[[#]]~Join~{{#}} & /@ table7;
list1 = {};list2 = {};
table8 = For[index15 = 1,
index15 <= lengthoflistofMelnfunthroughSimpsintegr,
index15 = index15 + 1,
If[Resolve[
Exists[t0, listofMelnfunthroughSimpsintegr[[index15]] == 0 ],
Reals], AppendTo[list1,
listofthevlsofαβΩγaccompaniedbytheindexofthecorrespondingMelnfun[[
index15]]],
AppendTo[list2,
listofthevlsofαβΩγaccompaniedbytheindexofthecorrespondingMelnfun[[
index15]]]]];
listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhichMelnfu
nhavezeros = list1;
lengthoflistofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhi
chMelnfunhavezeros =
Length[listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhi
chMelnfunhavezeros];
listofindexesofMelnfunthathavezeros =
Table[listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhic
hMelnfunhavezeros[[index17, 5, 1]], {index17, 1,
lengthoflistofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunfor
whichMelnfunhavezeros, 1}];
lengthoflistofindexesofMelnfunthathavezeros =
Length[listofindexesofMelnfunthathavezeros];
listofMelnfunwhichhavezeros =
Table[listofMelnfunthroughSimpsintegr[[index18]], {index18,
listofindexesofMelnfunthathavezeros}];
lengthoflistofMelnfunwhichhavezeros =
Length[listofMelnfunwhichhavezeros];
listofthederivativesofMelnfunthathavezeros =
D[listofMelnfunwhichhavezeros, t0];
list3 = {};list4 = {};
table9 = For[index25 = 1,
index25 <= lengthoflistofMelnfunwhichhavezeros,
index25 = index25 + 1,
If[Resolve[
Exists[t0,
Abs[listofMelnfunwhichhavezeros[[index25]]] +
Abs[listofthederivativesofMelnfunthathavezeros[[index25]]] ==
0], Reals],
AppendTo[list3,
listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhichMe
lnfunhavezeros[[index25]]],
AppendTo[list4,
listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhichMe
lnfunhavezeros[[index25]]]]];
listofαβΩγaccompaniedbytheindexofthecorrespondingMelnfunforwhichMelnfu
nhaveonlysimplezeros = list4;
{list1,list2} = GatherBy[listoffuns, Resolve[Exists[t, # == 0], Reals] &];
but theResolve[...]
is still the slowest part taking an avg of 0.01742 seconds per function tested on my machine $\endgroup$