New answers tagged performance-tuning
1
The function CurveToBSplineFunction Does something closely related:
dat1 = Table[{i, Sin[i^2]}, {i, 0, 2 Pi, Pi/64}] // N;
dat1 = dat1 /. {x_, y_} :> {x,
y (1 + RandomVariate[NormalDistribution[0, 0.05]])};
pl1 = ListPlot[dat1, PlotStyle -> Red];
g = ResourceFunction["CurveToBSplineFunction"][dat1, 1];
Show[pl1, ParametricPlot[g[u], {u, ...
3
You might like to generalize this problem to work with any number of stocks using a list of prices and returns. This eliminates a lot of extra typing and allows you make quick changes to the lists of prices and returns. Let's use your examples and a modified copy of Domen's comment.
prices = {5, 7, 9, 11};
returns = {.3, .5, .7, .9};
stocks = stock[#] &/@...
4
A zero-order interpolation is a good way to in effect invert the function from positive integers to values in sortedlist.
Timing[
table = Table[N[n^2 + m^2], {n, 1, 3000},
{m, 1, 3000}];
sortedlist = Sort[Apply[Join,
table[[1 ;; 50]]]];
lastpairs =
SplitBy[Join[{{0, 0}},
Transpose[{sortedlist,
Range[Length[sortedlist]]}]],
First][...
3
Here are some suggestions for simpler methods to find the counts, and to make a plot.
Instead of Array[table[[#]]&, 50]] use table[[;; 50]]. Check the documentation for Part.
An easy way to count the number of values that are less or equal to $x$, is to count the values with Tally, and then total the tallies with Accumulate.
table = Table[N[n^2 + m^2], {...
3
R1[p, q] := m p + (1 - m) q;
R2[p, q] := n p + (1 - n) q;
Test[pts] :=
And[(0 <= m <= 1), (0 <= n <= 1)] /.
Solve[R1[pts[[1]], pts[[2]]] == R2[pts[[3]], pts[[4]]], {m, n}];
Draw[pts] :=
Graphics[{Line[{pts[[1]], pts[[2]]}], Line[{pts[[3]], pts[[4]]}]}];
{Test[#][[1]], Draw[#]} &@RandomReal[{-1, 1}, {4, 2}] // Timing
2
The line (AB) intersects the inner part of a non-collinear segment [CD] iff (AB × AC)(AB × AD) < 0 (here × stands for the 2D vector product — which are equal to determinants).
Moreover, the non-collinear segments [AB] and [BC] intersect iff the line (AB) intersects [CD], and the line (CD) intersects [AB].
In non-collinear case, the same holds when one ...
2
We can parametrize the first line segment on the parameter interval $t \in [0,1]$ and the second on the parameter interval $s \in [0,1]$, then use Solve to find the intersection, restricting to those two intervals. If there is no intersection, Solve returns an empty list, so the Length of the result is zero. If there is a single point of intersection, ...
8
This answer provides results of timing tests of the other answers, at least the ones that provided compatible MMA code. The test methods are shown below. With a smaller number indicating a faster method of determining whether the line segments intersect, here is a summary of the latest results: $$\begin{array}{cc}
\text{Original} & 1.207 \\
\text{...
8
How about negating the output of RegionDisjoint?
Borrowing a specific example from the ref page:
SeedRandom[1];
l1 = Line[{{0, 0}, {1, 1}}];
l2 = Line[RandomReal[1, {10, 2}]];
!RegionDisjoint[l1, l2] // AbsoluteTiming
{0.002878, False}
9
In 2D (and only there), you can use the undocumented function Graphics`Mesh`FindIntersections to find the point of intersection. This is often an order of magnitude faster than RegionIntersection. If there isn't any intersection point, then an empty list is returned.
plot[l1_, l2_] := Graphics[{Thick, PointSize[0.025], Darker@Green, Point @@ l1, l1, Darker@...
9
t := RandomReal[{-10, 10}, 2]
ln1 and ln2 will be the coordinates for a Line or InfiniteLine as needed later.
ln1 = {t, t};
ln2 = {t, t};
Clear[sol, x, y]
sol = Solve[{x, y} \[Element]
InfiniteLine@ln1 \[And] {x, y} \[Element] InfiniteLine@ln2, {x,
y}]
{x, y} = {x, y} /. sol[[1]]
Let's say this gives us the following pt of intersection for ...
11
You could try this:
Clear[interQ];
interQ[ Line[{v1_?VectorQ, v2_?VectorQ}],
Line[{v3_?VectorQ, v4_?VectorQ}]] := Block[{
m = Transpose[ {v1 - v2, v4 - v3}], vL},
If[ Det[m] == 0, False,
vL = LeastSquares[ m , v4 - v2];
(* Sow[ v1*vL[[1]] + v2*(1-vL[[1]])]; *)
0 <= vL[[1]] <= 1 && 0 <= vL[[2]] <= 1]]...
1
nodes = Union@Catenate@Keys@assoc
edges = Cases[Normal@assoc, ({x_, y_} -> 1) :> x -> y]
AdjacencyMatrix@Graph[nodes, edges] (* a SparseArray *)
7
We can build a primitive hash table to determine if an element has been seen.
First we key on the first element of each pair, then over the second element. We use a 2D integer array, where each values is stored with a single bit.
For your example our lookup array has dimensions $205 \times 4$ on a 64 bit machine.
With[{len = $SystemWordLength - 1},
...
6
Not an answer at all, but too long for a comment.
In your very particular use case, SparseArray can delete the duplicates a bit faster:
list = RandomInteger[{1, 10}, {10000000, 2}];
aa = DeleteDuplicates[list]; // AbsoluteTiming // First
bb = SparseArray[list -> 1.]["NonzeroPositions"]; // AbsoluteTiming // First
Sort[aa] == Sort[bb]
0.271432
0....
1
You can also use FlipView to flip through a list of styles on each mouse click:
styles = {Thin, AbsoluteThickness[3], Directive[Thick, Dashed]};
ListStepPlot[{{1, 2, 3}, {2, 3, 5}}] /.
l_Line :> MouseAppearance[FlipView @ Thread[{ styles, l}], "SampleStyle"] // Deploy
2
Clear["Global`*"]
d = 3;
ag = 10;
pg = 10;
wp = 20;
SetOptions[NIntegrate,
AccuracyGoal -> ag,
PrecisionGoal -> pg,
WorkingPrecision -> wp,
MaxRecursion -> 20];
SetOptions[FindRoot,
AccuracyGoal -> ag,
PrecisionGoal -> pg,
WorkingPrecision -> wp];
f[z_, zh_] := 1 - (z/zh)^(d + 1);
It is only necessary to ...
9
Switch off adaptive sampling: setting MaxRecursion to zero,
Clear[f1, f2, f3]
mem : f1[x_?NumericQ] := mem = (Pause[1]; x^2)
mem : f2[x_?NumericQ] := mem = (Pause[1]; x^3)
mem : f3[x_?NumericQ] := mem = f1[x]/f2[x]
Plot[f1[x], {x, 0, 1}, PlotPoints -> 10, MaxRecursion -> 0] // AbsoluteTiming
Plot[f2[x], {x, 0, 1}, PlotPoints -> 10, MaxRecursion -&...
1
Borrowing Henrik's thresholding idea, here's a sparse array approach:
SeedRandom[0];
lambda = RandomReal[{-400, 2}, 1000];
h = Exp;
g = Sin;
tol = 10^-10;
res = SparseArray[Threshold[h@lambda, tol], Automatic, 0.];
With[{nzp = Flatten@ res@ "NonzeroPositions"},
res[[nzp]] *= g[lambda[[nzp]]]
];
res
The default tolerance is 10^-10, but I ...
8
Depending on your data, you may define a tolerance eps and use the following function F instead:
eps = 100 $MachineEpsilon;
F = With[{val = h[#]},
If[Abs[val] > eps, g[#] val, 0]
] &;
Map[F, L]
3
Something like this works:
g[x_] := {Pause[1]; x RandomReal[]}
f[x_] := If[x < 5, 0, x]
Map[With[{x = #, fe = f[#]}, If[fe == 0, 0, g[x] fe]] &, Range@10] // AbsoluteTiming
(* {6.02807, {0, 0, 0, 0, {11.9397}, {18.9161}, {14.929}, {28.8704}, {15.9467}, {11.3731}}}*)
2
Transpose is not a bad thing per se. Nonetheless, here are a couple of faster alternatives:
F1 = Transpose[{#, Transpose[{{#[[All, 1, 1]], #[[All, 2, 2]]}, {#[[All, 2, 1]], #[[All, 1, 2]]}}, {2, 3, 1}]}] &;
F2 = Map[
A |-> {A, {{A[[1, 1]], A[[2, 2]]}, {A[[2, 1]], A[[1, 2]]}}}];
F3 = Module[{result},
result = Transpose[{#, #}];
result[[All, ...
2
The problem with some functions and performance is that they unpack packed arrays. When the packed array is large, the unpacked array is larger and may exhaust the memory resources available. Functions such as MemberQ, FreeQ, FirstPosition, etc. unpack, but AnyTrue does not unpack. This is the principal difference in speed on an integer array.
Packed ...
2
You are much better off using Not[FreeQ[expr, form]] in place of MemberQ in almost all cases. MemberQ has a number of different problems, including the tests it uses for equality and the depth of its search into expr, and I don't remember the specifics of them, that you are justified in ignoring it completely. This is not to disparage the other answers ...
6
list1 = Range[10^8];
list2 = RandomInteger[10^10, 10^8];
list3 = RandomInteger[10, 10^8];
elem = 5;
MemberQ[list1, elem] // AbsoluteTiming
MemberQ[list2, elem] // AbsoluteTiming
MemberQ[list3, elem] // AbsoluteTiming
memberQCompiled = Compile[{{a, _Integer, 1}, {e, _Integer}}, MemberQ[a, e]];
memberQCompiled[list1, elem] // AbsoluteTiming
memberQCompiled[...
7
One possibility for lists of integers is to use Clip:
iMemberQ[l_, s_] := s == Max @ Clip[l, {s, s}, {s-1, s-1}]
For your examples:
L = Range[10^8];
iMemberQ[L, 1] //AbsoluteTiming
iMemberQ[L, 10^8] //AbsoluteTiming
iMemberQ[L, 10^9] //AbsoluteTiming
{0.729907, True}
{0.648677, True}
{0.631598, False}
L = RandomSample[Range[10^8]];
iMemberQ[L, 1] //...
Top 50 recent answers are included