Skip to main content

performance tuning - Iterate until condition is met


I want to find the first 5 prime numbers of the form $n^6 + 1091$. I have used this code:


 Timing[Select[Table[n^6 + 1091, {n, 10000}], PrimeQ, 5]]


Which gives the desired answer, and takes 0.0156 seconds. What if I didn't have a rough idea of what values of $n$ to check?


Timing[Select[Table[n^6 + 1091, {n, 100000}], PrimeQ, 5]]

Takes 10 times as long.


So, my question is: Is there a simple(ish) way to make Mathematica stop when the desired number of solutions are found?



Answer



A more efficient use of Select


If the likely bound of the problem is easily stored in memory it is practical to generate a Range, which is fast, and then Select from that. Since the Range will be unpacked by Select you must consider the unpacked size. For example:


ByteCount @ Developer`FromPackedArray @ Range@1*^7



240 000 032



This is a reasonable starting size in many cases.


Finding five values take a quarter of a second:


Select[Range@1*^7, PrimeQ[#^6 + 1091] &, 5] // Length // Timing


{0.249, 5}


Fining all values with a seed <= 10^7:


Select[Range@1*^7, PrimeQ[#^6 + 1091] &] // Length // Timing


{19.797, 3338}

You can see that this scales pretty well, without excessive overhead in the case that values are found quickly, yet for your search 3338 results can be found before the limit is reached.


(The seeds found with this method need to be converted to primes with #^6 + 1091 &.)


A method for larger problems



If this will not work, either because you have no idea what the likely upper bound is, or it is too high to hold a Range in memory, then it will be most efficient to operate in blocks, due to Mathematica's vector optimizations.


First, there is a more efficient way to build the list of candidates:


Range[100]^6 + 1091

This takes full advantage of the vectorized operations available.


Pick a large enough block size that the average element processing time is relatively low, but not so large as to process more elements than are likely needed. I will pick a block size of 100,000 and I will try to find 5,000 solutions:


block = 100000;

result = {};


find = 5000;

hits = 0;

Do[
If[hits >= find, Return["Done!"]];
Select[(n block + Range[block])^6 + 1091, PrimeQ] //
(result = {result, #}; hits += Length@#) &,
{n, 0, 1*^9}
] ~Monitor~ n


The results are stored in a linked list rather than using Sow. This has the advantage of letting you open a sub-session and examine the results up to that point. For example, in a separate cell enter:


Flatten @ result // Short

And use F7 to show the results, then resume calculation.


The Monitor lets you see how many blocks have been processed.




Timings


I made the claim that these methods are efficient. Let me give some comparative timings to support my position. WReach's lazy lists code which Rojo used in his answer is a wonderful approach. It is not however, as written, fast. My methods are by comparison clunky but they are also more practical.


I will use a variation of Timo's timeAvg function:



SetAttributes[timeAvg, HoldFirst]

timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

Compared to my first method:


Table[
{n,
Select[Range@1*^7, PrimeQ[#^6 + 1091] &, n] // timeAvg,
sIntegers[] ~sMap~ (#^6 + 1091 &) ~sFilter~ PrimeQ ~sTake~ n // sList // timeAvg
},

{n, {5, 15, 50, 150, 500}}
] // TableForm[#, TableHeadings -> {None, {"n", "Select", "Lazy"}}] &

Mathematica graphics


My Select method shows the overhead of generating and unpacking the Range but it soon catches up and exceeds the lazy lists method in performance. Remember also the human overhead of writing this if it is not going to be used many times. The Select method is very simple and direct.


Now, for my second method there is a tuning parameter: the block size. It could be argued that changing this parameter mid-test is not fair play so I will use a fixed block size of 1000.


finder[find_, block_: 1000] := Module[{result = {}, hits = 0},
Do[
If[hits >= find, Return[Flatten@result ~Take~ find]];
Select[(n block + Range[block])^6 + 1091, PrimeQ] //

(result = {result, #}; hits += Length@#) &,
{n, 0, 1*^9}
]
]

Table[
{n,
finder[n] // timeAvg,
sIntegers[] ~sMap~ (#^6 + 1091 &) ~sFilter~ PrimeQ ~sTake~ n // sList // timeAvg
},

{n, {5, 15, 50, 150, 500, 1500, 5000}}
] // TableForm[#, TableHeadings -> {None, {"n", "Finder", "Lazy"}}] &

Mathematica graphics


Here the superiority of the block-based method is fully apparent.


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...