acl*_*acl 8 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
Run Code Online (Sandbox Code Playgroud)
然后执行
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}];
Run Code Online (Sandbox Code Playgroud)
最后我将点绘制如下(这是问题的真正要点):
plot = ListPlot[pts,
PlotMarkers \[Rule] Graphics[{PointSize[Tiny], Point[{0, 0}]}]]
Run Code Online (Sandbox Code Playgroud)

在我的机器上计算所有点大约需要2.6秒,但是该图需要大约25秒.另一方面,如果我这样绘制它
ListPlot[pts]
Run Code Online (Sandbox Code Playgroud)

然后它几乎是瞬间的,因为它应该(它只是5256点).所以,这似乎让PlotMarkers事情变得非常缓慢.
任何人都可以解释为什么(这个我模糊地理解,与Sort你给它自定义排序功能的情况类比),更重要的是,b)解释如何避免这种减速?我试图创建比这更多点的情节,所以它们真的很慢; 另外,我创造了很多(实际上是一部电影).
一种解决方案是不绘制所有这些,但是当我改变参数时,找出我应该包括哪些以及哪些不存在变得非常重要(如果我只需要这一帧,这当然会起作用).所以,我想在不删除积分的情况下加快情节创作.
编辑:在Sjoerd的提示后回答:
ListPlot[pts] /. Point[List[x___]] \[RuleDelayed] {PointSize[Tiny], Point[List[x]]}
Run Code Online (Sandbox Code Playgroud)
瞬间产生正确的东西.这只是用手将较小的点替换为结构Points内部Graphics.
现在可以将表中的上限fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates增加到80左右以获得更多的点数(这个就是Hofstadter蝴蝶,这是一个分形):

PlotMarkers适用于包含相对较少点的数据图.它在使用标记识别各种条件的图中非常有用.每个标记Inset如下:
Inset[Graphics[List[Hue[0.67`,0.6,0.6`],PointSize[Tiny],Point[List[0, 0]]]],10512].
Run Code Online (Sandbox Code Playgroud)
你可以想象这需要一些时间和记忆.
我还发现了什么似乎是一个错误.情节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
Run Code Online (Sandbox Code Playgroud)
就个人而言,我更喜欢Graphics到ListPlot,尤其是当点的数量是很大的.
Graphics[{Hue[{2/3, 1, 1, .5}], AbsolutePointSize[1.5], Point@pts},
PlotRange -> {{0, 1}, {-4, 4}}, Axes -> False,
AspectRatio -> 1/GoldenRatio]
Run Code Online (Sandbox Code Playgroud)
例如:

Length@pts
Run Code Online (Sandbox Code Playgroud)
102969
| 归档时间: |
|
| 查看次数: |
1421 次 |
| 最近记录: |