New answers tagged performance-tuning
2
Another option is to use FunctionCompile (I also called Simplify on expression first):
cf=FunctionCompile[Function[{}, Table[With[{R = (i + 0.5)*5, \[Phi] = (j + 0.5)*5, Z = k*0.0785},
((5. + 5.*R^10)*Z*Cos[5*\[Phi]] + (1.2351190476190474 - 0.08680555555555555*R^4 + 0.22321428571428573*R^14 - 7.6388888888888875*Z^2 -
6.944444444444444*Z^4 + ...
5
ClearAll[groupedByCounts]
groupedByCounts[max_] := GroupBy[
Tally[Join @@ Map[Select[# <= max &]]@
Join[Table[Binomial[n, Range[n - 1]], {n, 0, Ceiling[(3 + Sqrt[1 + 8 max])/2]}],
ConstantArray[Range[1 + Ceiling[(3 + Sqrt[1 + 8 max])/2], max], 2]]],
Last -> First]
Examples:
groupedByCounts[100]
<|1 -> {2},
2 ->...
0
I'd recommend doing the whole calculation with symbols and substituting only at the end:
ft[t1_] = a*Exp[-t1/d] - b*Exp[-t1/e];
g[t1_, t2_, t3_] = ft[t1]*ft[t2]*ft[t3];
factor[x_, y_] = factor[x, y] = g[0, x*dt, y*dt];
sumfactor[h_, g_] = Sum[factor[x, y], {x, 0, h}, {y, 0, g}] // FullSimplify
(* (1/((-1 + E^(dt/d))^2 (-1 + E^(dt/e))^2))(a - b) E^(-((dt (...
2
In version 12.1, you can speed up the accepted answer from Szabolcs with FunctionCompile:
cf = FunctionCompile[
Function[{Typed[k, "MachineInteger"]},
Module[{a, b, c, d, tau, dt, e, ft, g, factor, xx, yy},
a = -0.07;
b = -0.45;
c = 2.0;
d = 3.0;
tau = 2.0;
dt = 0.01;
e = c*tau;
xx = ConstantArray[N@Range[0, k], ...
4
This is a good case that can sped up with FunctionCompile. My starting point is Leonid's code from his accepted answer:
pts = RandomVariate[NormalDistribution[], {10000, 2}];
AbsoluteTiming[
d1 = With[{tr = Transpose[pts]},
Function[point, Sqrt[Total[(point - tr)^2]]] /@ pts];]
Gives: {1.7097, Null}
Write the code as a function, with typed arguments:
...
1
If I want to make my code faster, I check if I can use FunctionCompile to speed it up:
https://reference.wolfram.com/language/guide/CodeCompilation.html
This compiler translates WL code into LLVM byte-code, which can then be compiled to native machine code. There is a very good tutorial video on YouTube which explains what you can
do with this compiler:
...
0
I face a similar problem in my calculation and I want to share my answer here.
The following argument is related to two-dimension, but it can also generalize to other dimensions,
lets first make random points
SeedRandom[253]
pts = RandomReal[{-1, 1}, {1000, 2}];
Then, using NearestNeighborGraph and ConnectedComponents, we can find nearby points with some ...
3
I looked at your original code and tried it with the newer FunctionCompile function.
Here is your code:
modProper1 =
Compile[{{initCoords, _Integer, 2}, {tSteps, _Integer}},
Module[{coordMat = initCoords, modMat, gridNRows, gridNCols},
gridNRows = Length@coordMat;
gridNCols = Length@coordMat[[1]];
Do[modMat =
Table[Mod[i - 1, gridNRows, ...
4
Here is an example that uses Table (well, ParallelTable) instead of For. I've also used ParametricNDSolveValue instead of With, mostly to simplify the Table.
phifunc = ParametricNDSolveValue[
{\[Phi]''[x] + 2 \[Phi]'[x]/x + (2 (zg + zh Exp[-zh x/dh])/x + 1) \[Phi][x] == 0
, \[Phi][$MachineEpsilon] == 1
, \[Phi]'[$MachineEpsilon] == -(zg + zh)
}
,...
0
@DanielHuber's comment turned out to be the most general and fast for nested lists, with some modifications:
(* helper to join singletons/nonlists to nearest list *)
join[a_List, b_List] := Join[a, b];
join[a_List, b_] := Join[a, {b}];
join[a_, b_List] := Join[{a}, b];
list = {{0, {1, 2}, {3}, 4, {5, 6}, {7}}, {8}, {{1}, {2}}, 3, {{4, 5, 6}}, {{7}}};
...
2
lst = {{}, {1, 2, 3}, {4}, {5, 6}, {7}, {}};
We can use SequenceReplace:
ClearAll[appendLeft1, appendRight1]
appendLeft1[l_, n_: 1] := SequenceReplace[{a_, b__} /;
(And @@ Thread[Length /@ {b} <= n]) :> Join[a, b]] @ l
appendLeft1 @ lst
{{}, {1, 2, 3, 4}, {5, 6, 7}}
appendRight1[l_, n_: 1] := SequenceReplace[{a__, b_} /;
(And @@ Thread[...
1
The excellent second solution by Roman, with R slightly modified, produces
R = HornerForm[(a (3 + a) (-12 + 5 a) + 3 (9 - 14 b) b)/
((-1 + a) a (3 + a) - 3 (-1 + b) b)]
With[{s = 10^4}, Do[If[Divisible[a (3 + a) (-12 + 5 a) + 3 (9 - 14 b) b,
(-1 + a) a (3 + a) - 3 (-1 + b) b] && R >= 3, Sow[{a, b, R}]],
{a, s}, {b, s}] // Reap // ...
6
Much faster to solve for $r$ and check that it's an integer: (it's always rational; no square-roots involved)
Solve[(a(a+3)(a(r-5)+(12-r)))/9 == (b(9+b(-14+r)-r))/3, r] // FullSimplify
(* {{r -> (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b)}} *)
R = (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b);
With[{s = 10^3},
Do[If[IntegerQ[R] &&...
3
Try NSolve with restricted parameter range 1<= a,b,r <=50
NSolve[{1/9 a (a + 3) (a (r - 5) + 12 - r) ==1/3 b (9 + b (-14 + r) - r) , 50 >= a >= 1, 50 >= b >= 1 ,50 > r >= 1}, {a, b, r}, Integers]
(**{{a -> 3, b -> 6, r -> 24},
{a -> 5, b -> 10, r -> 31},
{a -> 5,b -> 14, r -> 19},
{a -> 9, b -> 20, ...
3
Borrowing a fast perfect-square test from Fastest square number test, and shortening the length of the test case:
(* OP's *)
Table[
If[IntegerQ[
FullSimplify[
Sqrt[3*((4 a (3 + a) (12 + a (-5 + r) - r) (-14 + r) +
3 (-9 + r)^2)/(-14 + r)^2)]]], {a, r}, Nothing], {a, 1,
300}, {r, 3, 30}] // Flatten[#, 1] & // ...
2
This code devoted for testing to demonstrate effect of parallel job. Let take number of kernels used equal nk, then we can distribute computation as follows
SeedRandom[1234](*we set randomizer for testing only!*); degree = 4;
dim = 5;
LaunchKernels[]; nk = $KernelCount;
Q[z_] := Sum[z[[i]]^degree, {i, 1, dim}];
findPoints$test[d_, deg_, N_,
i_] := (x =...
4
Approach 1, more concise
Clear[search];
search[n_] :=
Join @@ Table[With[{s = Subsets[a, {2}]},
Pick[s, Boole@MemberQ[a, Total@#] & /@ s, 1]],
{a, GatherBy[Select[Range[10^(n - 1), 10^n - 1], Divisible[#, 9] &],
Sort@*IntegerDigits]}];
search[4] // Length // AbsoluteTiming
search[5] // Length // AbsoluteTiming
search[6] // ...
0
Divide the numbers from 1000 to 9999 into a few hundred sets of integers that have the same digits, for example [1234, 1243, 1324, 1342, 1423, 1432 ... ]. Then a and b must be in the same set, and a+b must be in that set as well. So you loop over the 400 or so sets S of integers, then iterate over all elements a < 5000 of the set S, iterate b over all ...
0
Maybe out of slope...
Since this range is kind of huge. So use Python's Api maybe a better choice?
ExternalEvaluate["Python", "[(i, j, i+j)for i in range(1000, 9999) for j in range(i, 9999-i)
if sorted(str(i)) == sorted(str(j)) == sorted(str(i+j))]"] // AbsoluteTiming
{27.2873, {{1089, 8019, 9108}, {1089, 8091, 9180}, {1269, 1692,
...
12
ClearAll[pairS]
pairS[n_] := SortBy[First] @
Apply[Join] @
KeyValueMap[Function[{k, v},
Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]] @
GroupBy[Sort@*IntegerDigits] @
(999 + 9 Range[10^(n - 1)])
Examples:
pairS[4] // AbsoluteTiming // First
0.0445052
pairS[5] // AbsoluteTiming // First
1.19877
Multicolumn[pairS[4],...
2
But it took ages to give the output.
It took ~170 seconds on my computer; with ParallelTable it took ~97 seconds.
I assume two-times speed-up is not good enough, but it was very easy to get it.
1
FindRoot works well on this problem:
Clear[f, g]
f[k_, l_, m_, n_, o_] := (k^0.05) (l^0.09) (m^0.08) (n^0.43) (o^0.35);
g[k_, l_, m_, n_, o_] := 116.7 k + 216.7 l + 183 m + 31 n + 833.3 o - 71500;
FindRoot[D[f[k, l, m, n, o] -
lambda g[k, l, m, n, o], {{k, l, m, n, o, lambda}}], {#, 1} & /@ {k, l, m, n, o,
lambda}] // AbsoluteTiming
(*
{0....
3
Clear["Global`*"]
Rationalize all of the constants
f[k_, l_, m_, n_, o_] = (k^0.05) (l^0.09) (m^0.08) (n^0.43) (o^0.35) //
Rationalize;
g[k_, l_, m_, n_, o_] =
116.7 k + 216.7 l + 183 m + 31 n + 833.3 o - 71500 // Rationalize;
eqns = Thread[
D[f[k, l, m, n, o] -
lambda g[k, l, m, n, o], {{k, l, m, n, o, lambda}}] == 0] // ...
6
The answer to the question
does Mathematica first materialize the entire 1000x1000 matrix and then compute the max on it
is "Yes". Max does not hold its arguments, and so Max[foo] will first evaluate foo and then take its maximum.
The most straightforward way to compute the table maximum without storing all the values would be
max = -Infinity;
Do[...
1
I tested the methods from Henrik and got the following timings
linAlgZeroArrayQ = LinearAlgebra`Private`ZeroArrayQ;
statZeroArrayQ =
Statistics`Library`ConstantVectorQ[#] && #[[1]] == 0 &;
totalZeroArrayQ = Total[#] == 0 &;
n = 10^5;
exactZeros = ConstantArray[0, n];
numericalZeros = ConstantArray[0., n];
exactSparse = exactZeros; ...
3
Edit
Tried an anylytical solution as shown below.
Sorry, but didn't see a programming error. So it turned out that it is much slower. I show it anyway.
Learn, how anylytical solutions look like ...
p = {p1, p2, p3, p4, p5}; q = {q1, q2, q3, q4, q5};
Q[z_] := Total@(z^4)
sol[{p1_, p2_, p3_, p4_, p5_}, {q1_, q2_, q3_, q4_, q5_}] =
t /. Solve[Q[p + t q] ==...
7
LinearAlgebra`Private`ZeroArrayQ seems to do quite a good job. Curiously enough, Statistics`Library`ConstantVectorQ[#] && #[[1]] == 0 & tends to be a little bit faster on my machine.
2
Why not just use Accumulate on x and avoid creating the sublists (which is very slow because the sublists can't be packed). Your version (with $n=10^8$ because I'm not patient):
n=10^8; AbsoluteTiming@MaxMemoryUsed[x=RandomChoice[{0,0,0,0,0,0,1},n];
i=Sort[{1}~Join~RandomInteger[{0,n},n/10]~Join~{n}]]
AbsoluteTiming@MaxMemoryUsed[y=TakeList[x,i[[2;;]]-i[[;;-...
1
n = 10^8; x = RandomInteger[{-100, 100}, n]; i = RandomInteger[{0, 1}, n];
z1 = z2 = z3 = x;
AbsoluteTiming @ MaxMemoryUsed[z1 = z1 (1 - i)]
{2.00115, 1600000424}
AbsoluteTiming @ MaxMemoryUsed[z3[[Random`Private`PositionsOf[i, 1]]] = 0]
{3.52455, 1599995920}
AbsoluteTiming @ MaxMemoryUsed[z2[[Pick[Range @ n, i, 1]]] = 0] (* ciao's comment*)
{4.8352, ...
4
LetterCounts[str, 2]
and
KeyMap[FromCharacterCode,
Sort[Counts[Partition[ToCharacterCode[str], 2, 1]], Greater]];
are not equivalent operations - just try the inputs found in the LetterCounts documentation and you'll quickly see differences. So the timing comparison is not very meaningful.
edit: To answer the question in the comments, the self-written
...
4
For short strings LetterCounts is slower, not sure why, for longer strings the timings are identical. Do you see similar behavior?
randomString[n_] :=
RandomInteger[{1, 26}, n] /.
Thread[Range[26] -> CharacterRange["A", "Z"]] // StringJoin
counts[str_] :=
KeyMap[FromCharacterCode,
Sort[Counts[Partition[ToCharacterCode[str], ...
3
Another trick, not so efficient.
nmax = 1000;
r = Range[nmax];
f[x_] := {x, x^2, If[EvenQ@x, "even", "odd"]};
SetAttributes[f, Listable];
res1 = (f@r); // AbsoluteTiming
{0.0026543, Null}
This is the origin code.
{0.003949, Null}
res1 == res2
True
6
res = Transpose[{r, r^2, Mod[r, 2]}];
This is about 50 times faster than the original code on my machine and contains the same information. I replaced the strings by integers (0 or 1), because that allows one to use vectorization and packed arrays.
If you insist on the strings, you can try
res = Transpose[{r, r^2, {"odd", "even"}[[Mod[r, ...
0
There is
fu3 = Dot @@ Lookup[#, Union @@ Keys[#], 0] &[Counts@*ToCharacterCode /@ {#, #2}] &;
Last@Table[fu[str1, str2], {100}] // RepeatedTiming
Last@Table[fu3[str1, str2], {100}] // RepeatedTiming
(* {2.3, 3013} *)
(* {0.0029, 3013} *)
1
First I will put kglr's remarkable solution on record.
Show[plottz /.
Join[
Thread[
ColorData[97] /@ Range[5] -> ColorData["Rainbow"] /@ Subdivide[4]],
{AbsoluteThickness[_] -> AbsoluteThickness[4],
LineLegend[a_, b_, opts : OptionsPattern[]] :>
LineLegend[a /. AbsoluteThickness[_] -> ...
0
NDSolve does not have problems with interpolating functions. Not from my experience at least. Can you post an example where you run into problems?
A few other thoughts:
Are you by any chance using BesselJZero in $F$ and $G$ (BesselJZero is even slower than BesselJ)
Bessel functions have other parametrizations which you could try
Try using Compile
Check this ...
6
Equal@@MinMax[array] might be quite fast if array is a packed list of integers. But it cannot short-circuit like Statistics`Library`ConstantVectorQ does. And it is also not very robust with regard to (machine) floating point numbers: Equal and SameQ both use a certain tolerance for their equality checks (I forgot which precise one they use; I just recall ...
9
Statistics`Library`ConstantVectorQ is quite fast.
Using Sjoerd's input examples:
const = ConstantArray[1, 100000];
nonconst = Append[const, 2];
nonconst2 = Prepend[const, 2];
t11 = Statistics`Library`ConstantVectorQ@const // RepeatedTiming;
t21 = CountDistinct[const] == 1 // RepeatedTiming;
t31 = MatchQ[const, {Repeated[x_]}] // RepeatedTiming;
t41 = Length[...
9
Here are two methods that are quite fast for flat lists (you can flatten arrays to test at deeper levels):
const = ConstantArray[1, 100000];
nonconst = Append[const, 2];
Using CountDistinct (or CountDistinctBy):
CountDistinct[const] === 1
CountDistinct[nonconst] === 1
True
False
Based on pattern matching:
MatchQ[const, {Repeated[x_]}]
MatchQ[nonconst , {...
Top 50 recent answers are included
