wolfram-mathematica - 具有PlotMarkers的慢速ListPlot

Question

我正在这样做:

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

然后执行

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

最后，我将点绘制如下(这是问题的实质):

plot = ListPlot[pts,
 PlotMarkers \[Rule] Graphics[{PointSize[Tiny], Point[{0, 0}]}]]

计算所有点在我的机器上大约需要2.6s，但是绘图大约需要25s。另一方面，如果我这样绘制它

ListPlot[pts]

那么它几乎是瞬时的，正如它应该的那样(仅为5256点)。因此，似乎 PlotMarkers极大地减慢了速度。

谁能
a)解释原因(与您为 Sort提供自定义排序功能类似，我对此有所了解)，更重要的是，
b)解释如何避免这种放缓？我正在尝试创建比该点多得多的图，因此它们的速度确实很慢。另外，我正在制作很多(实际上是电影)。

一种解决方案是不绘制所有图，但是当我更改参数时，找出要包含哪些内容和不包含哪些内容变得很简单(如果我只需要这一帧，这当然可以工作)。因此，我想在不删除点的情况下加快绘图的创建。

编辑:从乔伊德提示后回答:

ListPlot[pts] /. Point[List[x___]] \[RuleDelayed] {PointSize[Tiny], Point[List[x]]}

立即产生正确的事物。这只是用手将 Points结构中的 Graphics替换为较小的点。

现在可以将 fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates中表的上限增加到80左右以获得更多的分数(这是Hofstadter蝴蝶，它是分形的):

Answer 1

PlotMarkers用于包含相对较少点的数据图。在使用标记识别各种条件的绘图中，此功能非常有用。每个单独的标记都是Inset，如下所示:

Inset[Graphics[List[Hue[0.67`,0.6,0.6`],PointSize[Tiny],Point[List[0, 0]]]],10512].

您可以想象这会占用一些时间和内存。

我还发现了似乎是 的错误。带有 PlotMarkers的图的结构为 GraphicsComplex[pointlist,graphicsinstructions]。该点列表似乎两次包含该图中的点!

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