使用PlotMarkers减慢ListPlot

时间:2011-06-26 20:06:40

标签: wolfram-mathematica

我这样做:

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

Hofstadter

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

ListPlot[pts]

Hofstadter

然后它几乎是瞬间的,因为它应该(它只是5256点)。所以,似乎PlotMarkers使事情变得非常缓慢。

任何人都可以 a)解释原因(这个我模糊地理解,类似于Sort如果给它自定义排序函数会发生什么),更重要的是, b)解释如何避免这种放缓?我试图创建比这更多点的情节,所以它们真的很慢;另外,我创作了很多(实际上是电影)。

一种解决方案是不绘制所有这些,但是当我改变参数时,找出我应该包括哪些以及哪些不应该是非常重要的(如果我只需要这一帧,这当然会起作用)。所以,我想在不删除积分的情况下加快情节创作。

编辑:在Sjoerd的提示后回答:

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蝴蝶,这是一个分形):

enter image description here

3 个答案:

答案 0 :(得分:9)

PlotMarkers适用于包含相对较少点的数据图。它在使用标记识别各种条件的图中非常有用。每个标记都是Inset,如下所示:

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

你可以想象这需要一些时间和记忆。

我还发现了似乎是 bug 的内容。 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

答案 1 :(得分:6)

就个人而言,我更喜欢GraphicsListPlot,尤其是当积分数量很大时。

Graphics[{Hue[{2/3, 1, 1, .5}], AbsolutePointSize[1.5], Point@pts}, 
 PlotRange -> {{0, 1}, {-4, 4}}, Axes -> False, 
 AspectRatio -> 1/GoldenRatio]

给出了例如:

enter image description here

Length@pts

102969

答案 2 :(得分:3)

我相信您附加到问题的解决方案可以简化:

ListPlot[pts] /. x_Point :> {PointSize[Tiny], x}

我投了两个先前的答案,但我同意TomD直接使用Graphics