New answers tagged performance-tuning
9
The bottleneck is in evaluating u. Compare:
Map[Eigenvalues[u[#]] &, N@w]; // AbsoluteTiming
(* Out[1437]= {11.4827, Null} *)
Map[u, N@w]; // AbsoluteTiming
(* Out[1438]= {9.57558, Null} *)
Compiling u can remove that bottleneck.
u2 = Compile[{{x, _Real}}, Evaluate[u[x]]];
Map[u2, N@w]; // AbsoluteTiming
Map[Eigenvalues[u2[#]] &, N@w]; // ...
3
We can also using GSL via LibraryLink, almost ten times faster than before.
LaunchKernels[];
ParallelMap[roots, Tuples[N@{-1, 1}, 15]]; // RepeatedTiming
{1.1, Null}
gslRoots@Tuples[N@{-1, 1}, 15]; // RepeatedTiming
{0.12, Null}
It only takes about 3 minutes to calculate the roots of all polynomial equations of degree 24 with a coefficient of ±1.
For ...
1
You may use the Patterns Guide with Attributes and Orderless to identify functions whose parameters can be swapped.
ClearAll[swappableParams]
Options[swappableParams] = {Method -> "Verbose", Indexed -> False};
swappableParams[expr_, OptionsPattern[swappableParams]] :=
Module[{pos, paramsets},
pos = Position[
h_[p__] /; ContainsAny[...
6
Note: As pointed out by @DanielHuber in the comments, my original approach was assuming uniform distribution of the target points along the line instead of uniform distribution of the angles. Here's a corrected version: (the old answer is below)
Updated answer
We can solve this analytically by integrating:
func[x_, y_] = Assuming[0 < x < 1 && 0 ...
0
Thanks to @kglt's comment above, I was able to shrink down my code considerably as well as, I think, handle more equivalent statements than before while maintaining some speed thanks to @kglt's tip to use === for speed. Unfortunately, the extra accuracy comes at the cost of an even slower implementation.
My old code couldn't handle SwappableVariablesIn[Sin[...
1
Two functions that work with expressions that are FullSimplifyed as input:
ClearAll[swappableVariablesIn]
swappableVariablesIn[expr_] := Module[{vl = Variables[Level[expr, {-1}]],
foo = Module[{f = {#, #2} \[Function] Evaluate @ expr}, f[#, #2] === f[#2, #]] &},
Gather[vl, foo]]
ClearAll[swappableVariablesIn2]
swappableVariablesIn2[expr_] := ...
1
Maybe use NMaximize.
n = 4;
A = Table[Indexed[x, {i, j}], {j, 1, n}, {i, 1, n}];
vars = Flatten[A];
solns = NMaximize[{Det[A], 1 <= vars <= n, vars ∈ Integers,
Plus @@ vars == n*Plus @@ Range[n], Times @@ vars == (n!)^n},
vars][[2]]
A /. solns
A /. solns // Transpose
{{3, 4, 1, 2}, {3, 1, 3, 3}, {1, 4, 2, 4}, {1, 2, 4, 2}}
{{3, 3, 1, 1}, {4, ...
1
Note you can use SatisfiabilityInstances[expression, vars, All] to obtain all solutions, but if your specific property is common enough this is indeed inefficient. In this case, a better approach would be to use a randomized algorithm, e.g. try running a few times
FindInstance[expression, vars, Booleans, RandomSeeding -> Automatic]
However, this may or ...
6
If we reduce the dataset to work with (you are only interested in the 5th an 16th atom and this will help your RAM problems) and compile the whole algorithm into something which is still readable but more compact, then we land an around x27 speed improvement.
dataDistances = Compile[{{dat, _Real, 4}}, Module[
{m, count, res, a, d, b, e, c, f, dist},
m = ...
4
We can reduce computational time by 6 times with using compiled version of Distanceas follows
disc = Compile[{{r1, _Real, 1}, {r2, _Real,
1}}, \[Sqrt](If[Abs[r1[[1]] - r2[[1]]] >= 20,
Abs[r1[[1]] - r2[[1]]] - 40, Abs[r1[[1]] - r2[[1]]]]^2 +
If[Abs[r1[[2]] - r2[[2]]] >= 20, Abs[r1[[2]] - r2[[2]]] - 40,
Abs[r1[[2]] - r2[[2]]]]^2 +...
5
First of all, the NDSolve solution can be further improved:
k = 5.;
tf = 3.;
c[θ1_?NumericQ, θ2_?NumericQ] :=
NIntegrate[(Sin[θ1 + t]^2. Cos[θ2 + t])/E^t, {t, 0., tf},
Method -> {Automatic, SymbolicProcessing -> 0}];
sol = NDSolve[{θ1'[t] == θ2[t]/E^(Sin[t]/10.) + c[θ1[t], θ2[t]],
θ2'[t] == -k Sin[θ1[t]]/E^(Sin[t]/10.),
...
2
Lists in Wolfram Language are simple linear arrays in memory. Such arrays, especially packed numeric arrays, are amenable to numerous optimizations all the way from the C compiler through to the hardware: on-chip CPU caching, speculative evaluation, pipelining, etc.
Associations in Wolfram Language are implemented using hash array mapped tries. This is a ...
3
I am running Mathematica version 12.3.0 for Microsoft Windows.
The code
Table[Integrate[Product[x-k, {k, 1, n}], {x, 0, 1}], {n, 8}] //InputForm
returns
{-1/2, 5/6, -9/4, 251/30, -475/12, 19087/84, -36799/24, 1070017/90}
which is correct. Using PARI/GP returns the same result.
However, the code
Timing[Integrate[Product[x - k, {k, 1, n}], {x, 0, 1},
...
1
Not sure why you use the While loop. A faster strategy might be to do the change proportional to the average of the positive eigenvalues. $MinMachineNumber is a very small number; maybe it is better to use MachineEpsilon instead. That is the smallest number will have an actual effect when added to $1$. I am also not sure why you require calling ...
2
Breaking down the basic computation, faster and faster for machine floating-point:
x1 = RandomReal[2, {260, 3}];
x2 = RandomReal[2, {260, 3}];
kk = Kint[x1, x2, 4];
ll = 4;
kkk = Outer[Exp[-Norm[#1 - #2]/ll] &, x1, x2, 1]; // RepeatedTiming
kkk = Exp[-Sqrt[#]/ll] &@
Outer[# . # &[#1 - #2] &, x1, x2, 1]; // RepeatedTiming
kkk = Exp[-Sqrt[#]...
1
We can say that a latin square is standard if the first row is [1,...,n] and the first column is also [1,...,n]. Any latin square arises uniquely as follows: take a standard latin square, apply an arbitrary permutation to the full set of n columns, then apply an arbitrary permutation to the last (n-1) rows. Thus, the number of standard squares is smaller ...
5
If I understand correctly what you want to do the following should work.
We start by
Multifactorial[n_, k_] := Abs[Apply[Times, Range[-n, -1, k]]]
Then we define a function that does the computation but does not show any output. This function also computes the absolute time that mathematica needs. This is done as follows
test1[xx_] := (For[i = 1, i < xx, ...
5
Adding lines one-by-one and continuing only if the newly added line does not give any column duplications. This highly unoptimized code takes about a minute for $n=5$ (thanks @chyanog for speedup!):
addline[lines_] :=
Select[Append[lines, #] & /@ Permutations[Range[Length[Transpose[lines]]]],
AllTrue[DuplicateFreeQ]@*Transpose]
latinsquares[...
4
If you do a "BacktrackSearch" then it will take forever for $n=5$ but use less memory. There are 161280 $5\times5$ Latin squares - I recommend you test this with smaller numbers first like $n=3$:
latinQ[mtx_] :=
AllTrue[mtx, DuplicateFreeQ] &&
AllTrue[Transpose@mtx, DuplicateFreeQ];
n = 5;
lsquares = ResourceFunction["...
12
Let's Compile.
dif = 1/500; pec = 20; U0 = 0; V0 = 0; F0 = 3; dn0 = 1; kap = 5; n = 63(*31*);
n1 = n + 1;(*dt=40./n^2;*)sm = 4 200; r = 20;(*a=dt dif n n;*)
(*c=ConstantArray[0.,{n1,n1}];*)
(*d=ConstantArray[0,{n1,n1}];*)
den = ConstantArray[dn0 (1 + .3 Tanh[-kap Range[-n1/2, n1/2]]), n1];
(*c0=ConstantArray[0,{n1,n1}];*)
u0 = ConstantArray[0., {n1, n1}];
...
Top 50 recent answers are included
