New answers tagged performance-tuning
8
Certain functionality, most notably rasterizing graphics, is implemented by the front end. In your case it is the JPEG export that triggers this.
3
f1[n_, m_] := IntegerPartitions[m, {n}, Range[m, 0, -1]]
f2[n_, m_] :=
FrobeniusSolve[ConstantArray[1, n], m] // DeleteDuplicatesBy[Sort]
(Please notice that $N$ is before $M$) :P
Validation
f1[6, 10] // RepeatedTiming
f2[6, 10] // RepeatedTiming
%[[2]] === %%[[2]]
{8.628*10^-6, {{0, 0, 0, 0, 0, 10}, {0, 0, 0, 0, 1, 9}, {0, 0, 0, 0,
2, 8}, {0, 0, 0, ...
4
You can do it with FrobeniusSolve like so:
ClearAll[solutions]
byFrobenius[m_Integer?Positive, n_Integer?Positive] :=
FrobeniusSolve[ConstantArray[1, n], m];
This works like so:
byFrobenius[5, 3]
(* {{0, 0, 5}, {0, 1, 4}, {0, 2, 3},
{0, 3, 2}, {0, 4, 1}, {0, 5, 0},
{1, 0, 4}, {1, 1, 3}, {1, 2, 2},
{1, 3, 1}, {1, 4, 0}, {2, 0, 3},
{2, 1,...
3
I think the answer is:
f[m_,n_]:=Flatten[Permutations /@ PadRight[IntegerPartitions[m], {Automatic, n}], 1]
e.g
f[2, 4]
(*=> {{2, 0, 0, 0}, {0, 2, 0, 0}, {0, 0, 2, 0}, {0, 0, 0, 2}, {1, 1, 0, 0},
{1, 0, 1, 0}, {1, 0, 0, 1}, {0, 1, 1, 0}, {0, 1, 0, 1}, {0, 0, 1, 1}} *)
An answer with FrobeniusSolve[] as suggested by @J.M.'s ennui, or any improvements in ...
4
Instead of filtering symbolically, we can filter numerically to remove a large number of undesired tuples. Since the numerators and denominators are quadratic polynomials, the rational functions are determined by their values at five distinct points. To keep things in machine integers, we write a rational function as an ordered pair and code some of the ...
6
If you just want the largest eigenvalue, the Arnoldi method is much faster than calculating all eigenvalues (and associated eigenvectors) and picking the largest:
Eigensystem[A // N, 1,
Method -> {"Arnoldi", "Criteria" -> "RealPart"}] // AbsoluteTiming
(* {0.007187, {{3.95532}, {{-0.00211558, -0.0041839, ......
8
The issue here is that AdjacencyMatrix returns a non-real valued matrix
g = GridGraph[{20, 20}];
amg = AdjacencyMatrix[A1];
meaning the elements are all integers:
In[]:= Map[Head,Normal@amg,{2}]//Flatten//Union
Out[]= {Integer}
and the kernel is trying to find an answer in terms of integers, rational numbers, and roots. Numericizing before computation ...
4
This is more of an extended comment. Here is a slight modification of your code:
parms = {m -> 1, ω -> 1, ℏ -> 1, α -> 1, n0 -> 8};
quadratures = ProbabilityDistribution[(1/Sum[1/k!, {k, 0, n0}]) *
Abs[Sum[(α E^(I ϕ))^n/√(n!) 1/Sqrt[2^n n!] ((m ω)/(π ℏ))^(1/4) *
Exp[-((m ω z^2)/(2 ℏ))] HermiteH[n, Sqrt[(m ω)/ℏ] z], {n, 0, n0}]]^2,
{z, -...
2
A method using SparseArray`SparseArrayRemoveDiagonal to remove the diagonal:
ClearAll[urd, kPaths1, kPaths2]
urd = Unitize @* SparseArray`SparseArrayRemoveDiagonal;
kPaths1[g_, k_] := Module[{a = AdjacencyMatrix @ g}, Nest[urd[a.#] &, a, k - 1]]
Example:
SeedRandom[1];
gr = makegraph2[100, {0}, 10, 0.01, 0.5];
r1 = kPaths1[gr, 6]; // RepeatedTiming /...
4
Why not work with AdjacencyMatrix instead? For example:
KPaths[g_, k_] := Module[{a, m},
a = AdjacencyMatrix[g];
m = 1 - IdentityMatrix[Length[a]];
Nest[Unitize[(a . #) m]&, a, k-1]
]
Comparison:
SeedRandom[1];
gr=makegraph2[100,{0},10,0.01,0.5];
last = Length[FindPath[gr,#,Last@VertexList[gr],{6}]]&/@VertexList[gr]; //...
1
Instead of evaluating a single sum, you could break up the sum into two or more sums.
L = 24;
sind = Range[-Pi, Pi, 2*Pi/L];
a[x_, y_] := x y
g[x_, y_] := x + y
f = Cos[x]*Sin[y]*Sin[x + x1]*Cos[y + y1]*a[x, y] + g[x, y]*Cos[x2 - y2]*Sin[x + x1 + x2];
AbsoluteTiming[sx = Sum[f, {x, sind}, {x1, sind}, {x2, sind}] // Simplify;
sxy = Sum[sx, {y, sind}, {y1, ...
11
Here's a refinement of @Henrik's approach. The key difference is that using Nearest[pts->"Distance"] is over an order of magnitude faster than using Nearest[pts->{"Index", "Distance"}]:
SeedRandom[1];
pts = RandomReal[1, {10000,2}];
AbsoluteTiming[
data=Nearest[pts->"Distance"][pts,2][[All,2]];
d=Min[...
9
Maybe this works for you:
AbsoluteTiming[
data = Nearest[pts -> {"Index", "Distance"}][pts, 2][[All, 2]];
i = OrderingBy[data, Last, 1][[1]];
j = data[[i, 1]];
dist = data[[i, 2]];
result = {dist, pts[[i]], pts[[j]]}
]
i and j are the indices of the pair of points that are closest to each other; dist is their distance.
Nearest[...
9
Straight-forward application of Compile to your code. No effort has been taken towards optimization. You'll need to evaluate this twice for Compile to pick up on the recursion. I flattened the return structure and made it explicitly 2D, but you can easily make it higher-dimensional if you want to by turning the 2;;5 into some calculated parameter.
simpleMin =...
3
I hope that your real data consists of more than 3 data points when fitting a function with 3 parameters (a, b, and an error variance).
While I don't know why the functions hang, for your function there is a simple fix. Because myfunc[x, 4] does not change with the scaling parameter, just replace the predictor with the values of the function. Then both ...
9
You can also get tup2 from tup1 using:
1. Union
ClearAll[fA]
fA = Union[Sort[{#, #[[{4, 5, 6, 1, 2, 3, 10, 11, 12, 7, 8, 9}]]}] & /@ #][[All, 1]] &;
tup2A = fA @ tup1; // AbsoluteTiming // First
0.213222
Length @ tup2A
52650
2. DeleteDuplicates
ClearAll[fB]
fB = DeleteDuplicates[
Sort[{#, #[[{4, 5, 6, 1, 2, 3, 10, 11, 12, 7, 8, 9}]]}] & /@...
11
Here is a semi-imperative way that gives the same result as tup2 from the original question, but much faster:
tup2b = Module[{keep}
, keep[t_] :=
( keep[t] = False
; keep[t[[{4,5,6,1,2,3,10,11,12,7,8,9}]]] = False
; True
)
; Select[tup1, keep]
];
tup2b === tup2
(* True *)
Length[tup2b] === Length[tup2] === 52650
(* True *)
On my machine, ...
7
A tuple is deleted if both its first two triples and its second two triples are identical when exchanged (but not when they're the same when not swapped). That we can construct the undeleted tuples directly like so:
tup2 =
Module[{
pair = Tuples[Tuples[{{0, 1}, {0, -1, 1}, {0, -1, 1}}], 2],
unique
},
unique = DeleteDuplicates[pair, #1 ===...
11
Speed tips:
Explicit is faster than implicit.
"DiscontinuityProcessing" is your friend.
Other tips:
WhenEvent is mysterious sometimes, but not here.
Functions should depend only on their arguments (best practice).
If 1/10^6 is to be a significant value to NDSolve, AccuracyGoal probably has be somewhat larger than 6.
Irrelevent, gratuitous tips:
...
6
By default Mathematica uses $HistoryLength = Infinity, so it stores every output expression since you started Mathematica in the data associated with the System symbol Out. If a lot of your output takes a lot of memory, you can easily slow down your computer. Instead, you could use this
$HistoryLength = 2;
Then Mathematica will only remember the two most ...
1
The "alt" routine seems to be deleting both duplicate values. First I correct the syntax error above replacing 10^-5 with the variable tolerance:
alt[list_,tolerance_]:=
With[{satisfies=(Last[#]>tolerance)&/@Nearest[list->"Distance",
list,2,DistanceFunction->ChessboardDistance]},Pick[list,satisfies]]
Then use the ...
13
It appears that your desired distance function corresponds to the ChessboardDistance (defined as Max[Abs[u-v]])
For most of the built-in distance functions, there are some sophisticated data structures that Nearest can take advantage of to avoid having to check the entire list on each pass.
In the attempt below, we use Nearest to compute the distances to the ...
Top 50 recent answers are included
