I am doing this:
ClearAll[matrix];
matrix[p_,q_,nu_:0]:=Module[{sigma},
sigma=p/q;
N@SparseArray[
{{m_,m_}\[Rule]2Cos[2\[Pi]*m*p/q+nu],{i_,j_}/;
Abs[i-j]\[Equal]1\[Rule]1},{q,q}]]
ClearAll[attachsigma]
attachsigma[sigma_,lst_]:={sigma,#}&/@lst
and then execute
fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates;
pq = {Numerator@#, Denominator@#} & /@ fracs;
(ens = Eigenvalues[#] & /@
Normal /@ (matrix[#[[1]], #[[2]]] & /@ pq);) // Timing
pts = Flatten[#, 1] &@MapThread[attachsigma, {fracs, ens}];
and finally I plot the points as follows (here is the real point of the question):
plot = ListPlot[pts,
PlotMarkers \[Rule] Graphics[{PointSize[Tiny], Point[{0, 0}]}]]
Calculating all the points takes around around 2.6s on my machine, but the plot takes around 25s. If, on the other hand, I plot it like this
ListPlot[pts]
then it is almost instantaneous, as it should (it's just 5256 points). So, it seems PlotMarkers
slows things down immensely.
Could anybody
a) explain why (this much I vaguely understand, in analogy with what happens to Sort
if you give it custom ordering function) and, more importantly,
b) explain how to avoid this slowdown? I am trying to create plots with quite a bit more points than this so they're really slow; in addition, I am creating lots of them (a movie actually).
One solution would be to not plot all of them, but as I vary parameters it becomes nontrivial to find out which I should include and which not (this would of course work if I only needed this one frame). So, I'd like to speed up the plot creation without removing points.
EDIT: Answered after hints from Sjoerd:
ListPlot[pts] /. Point[List[x___]] \[RuleDelayed] {PointSize[Tiny], Point[List[x]]}
produces the right thing instantaneously. This simply replaces the Points
inside the Graphics
structure by smaller points by hand.
Now one can increase the upper limit in the table in fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates
to 80 or so to get many more points (this thing is the Hofstadter butterfly, and it's a fractal):
PlotMarkers
is meant for data plots that contain relatively few points. It is very useful in plots in which you use the markers to identify various conditions. Each individual marker is an Inset
as follows:
Inset[Graphics[List[Hue[0.67`,0.6,0.6`],PointSize[Tiny],Point[List[0, 0]]]],10512].
You can imagine this takes up some time and memory.
I also found what seems to be a bug. The plot with PlotMarkers
is structured as GraphicsComplex[pointlist,graphicsinstructions]
. This point list seems to contain the points in the plot twice!
In[69]:= pts // Length
Out[69]= 5256
In[66]:= plot[[1, 1]] // Length
Out[66]= 10512
In[64]:= Union[plot[[1, 1]]] == Union[pts]
Out[64]= True
In[68]:= Tally[plot[[1, 1]]][[All, 2]] // Mean (*the average number each point occurs*)
Out[68]= 2
Personally, I prefer Graphics
to ListPlot
, especially when the number of points is large.
Graphics[{Hue[{2/3, 1, 1, .5}], AbsolutePointSize[1.5], Point@pts},
PlotRange -> {{0, 1}, {-4, 4}}, Axes -> False,
AspectRatio -> 1/GoldenRatio]
gives, for example:
Length@pts
102969
I believe the solution you appended to your question can be simplified:
ListPlot[pts] /. x_Point :> {PointSize[Tiny], x}
I voted for both prior answers, but I agree with TomD on the direct use of Graphics
.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With