Home/ Questions/Q 6067823
In Process

The Archive Base Latest Questions

Editorial Team
  • 0
Asked: 2026-05-23T09:39:00+00:00

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

  • 0

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}]}]]

Hofstadter

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]

Hofstadter

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):

enter image description here

Share

Leave an answer

You must login to add an answer.

Need An Account,

1 Answer

  1. Editorial Team

    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
    • 0