在Mathematica中优化"Manipulate"

Question

我想制作一个漂亮的演示，展示我在Mathematica中积分时遇到的问题。但是它非常缓慢，Manipulate也不流畅。

考虑下面的内容，有没有办法可以改善这种情况？即实现更连续的动态效果。此外，我无法使用以下代码打开Manipulator：

Control->Manipulator[Appearance->Open]

arrows = ParallelTable[{
RandomVariate[NormalDistribution[0, Sqrt[1]]],
RandomVariate[NormalDistribution[0, Sqrt[1]]]}, {20000}];

Manipulate[
           Graphics[{
                     White, Rectangle[{-5, -5}, {5, 5}],
                     Red, Disk[{0, 0}, 1],
                     Black, Point /@ (arrows[[;; i]]), 
                     Text[Style[
                               Total[
                                     If[# < 1, 1, 0] & /@  
                       (EuclideanDistance[{0, 0}, #] & /@ 
                       arrows[[;; i]])]/Length@arrows[[;; i]] // N, 
                          Bold, 18, "Helvetica"], {-4.5, 4.5}]}, 
           ImageSize -> 800],
{i, Range[2, 20000, 1]},
ControlType -> Manipulator,
SaveDefinitions -> True]

- 500

---

你需要使用{i，Range [2, 20000, 1]，ControlType->Manipulator，Appearance->{"Open"，"Labeled"}}来获得打开和标记状态的Manipulator。 - kglr

Answer 1

主要原因是由于您正在计算从步骤i到所有点的EuclideanDistance，对于每个步骤i都是如此。如果将此步骤移出Manipulate，您会看到差异。

prob = MapIndexed[#1/#2 &, Accumulate[
    EuclideanDistance[{0, 0}, #] < 1 & /@ arrows // Boole]] ~ N ~ 4;

Heike的解决方案比你和Nasser的都要更加顺畅，所以我将以此为例。您可以在其中使用预先计算好的prob值，例如：

Manipulate[
 Graphics[{White, Rectangle[{-5, -5}, {5, 5}], Red, Disk[{0, 0}, 1], 
   Black, Point[arrows[[;; i]]], 
   Text[Style[First@prob[[i]], Bold, 18, "Helvetica"], {-4.5, 4.5}]}, 
  ImageSize -> 200], {i, Range[2, 20000, 1]}, 
 ControlType -> Manipulator, SaveDefinitions -> True]

我已经统一将精度设置为4位数字，因为否则，当有效数字的数量发生变化时，您会看到数字跳动。

- user616736

---

是的，你的解决方案更加流畅。我甚至没有看算法做了什么。我只是添加了SynchronousUpdating -> False，并在“if”之前添加了一个Dynamic，这也使它稍微快了一点。至于代码实际上是做什么的，我没有看 :) - Nasser

+1 表示中缀使用，并非玩笑。 :-) 顺便说一句，我更喜欢使用排版 a ~N~ b 而不是 a ~ N ~ b，因为它清楚地显示了函数的项。如果你开始串联中缀的话，这是很有帮助的。 - Mr.Wizard

@Mr.Wizard 谢谢，那确实是个好建议！有时候我在拼接字符串时会因为空格的问题搞混自己。 - user616736

Answer 2

也许是这样的

。

Manipulate[
 Graphics[{White, Rectangle[{-5, -5}, {5, 5}],
   Red, Disk[{0, 0}, 1],
   Black, Point[arrows[[;; i]]], 
   Text[Style[Count[arrows[[;; i]], a_ /; (Norm[a] < 1)]/i // N, Bold,
      18, "Helvetica"], {-4.5, 4.5}]}, ImageSize -> 800], {i, 
  Range[2, 20000, 1]}, ControlType -> Manipulator, 
 SaveDefinitions -> True]

- Heike

---

非常快速和响应迅速- +1。您可以通过使用Total[UnitStep[1 -＃]& @Sqrt@ Total [Transpose [arrows [[;; i]] ^ 2]]]/i // N来进一步提高响应性，尽管这只是对代码加速的轻微增加。 - Leonid Shifrin

Answer 3

看看这个对你是否更好：

看看这个对您是否更好：

Manipulate[

 Graphics[{
   White,
   Rectangle[{-5, -5}, {5, 5}],
   Red,
   Disk[{0, 0}, 1],
   Black, Point /@ (arrows[[;; i]]), 
   Text[Style[
     Dynamic@Total[
         If[# < 1, 1, 0] & /@ (EuclideanDistance[{0, 0}, #] & /@ 
            arrows[[;; i]])]/Length@arrows[[;; i]] // N, Bold, 18, 
     "Helvetica"], {-4.5, 4.5}]}, ImageSize -> 200],

 {{i, 2, "i"}, 2, 20000, 1, Appearance -> "Labeled"},
 TrackedSymbols :> {i},
 SynchronousUpdating -> False,
 AppearanceElements -> All,


 Initialization :>
  (
   arrows = 
     ParallelTable[{RandomVariate[NormalDistribution[0, Sqrt[1]]], 
       RandomVariate[NormalDistribution[0, Sqrt[1]]]}, {20000}];
   )

 ]

- Nasser

---

看起来更好了！谢谢。但是文本有误。它应该快速收敛到0.39。另外，您能解释一下为什么更好吗？ :-) - 500

@500，哪个文本是关闭的？我没有触碰文本内容。查看此版本和您的版本之间的差异，您可以看到使其更快的更改。 - Nasser