在 Mathematica 中优化“操纵”答案

【问题标题】：Optimizing a "Manipulate" in Mathematica在 Mathematica 中优化“操纵”
【发布时间】：2011-12-20 15:27:46
【问题描述】：

我希望对我在Integration in Mathematica 中提到的问题做一个很好的演示，但它非常慢而且 Manipulate 一点也不流畅。

考虑到以下情况，有什么方法可以改善这种情况。那就是看到一个更连续的动态。我也无法使用

打开操纵器

控制->操纵器[外观->打开]

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]

【问题讨论】：

您需要{i, Range[2, 20000, 1], ControlType -> Manipulator, Appearance -> {"Open", "Labeled"}} 才能使Manipulator 处于打开和标记状态

标签： wolfram-mathematica

【解决方案1】：

缓慢的主要原因是因为您正在为每个步骤 i 计算直到步骤 i 的所有点中的 EuclideanDistance。如果您将这一步从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 位，否则，当有效位数发生变化时，您会看到该数字跳动。

【讨论】：

是的，您的解决方案更流畅。我真的什至没有看算法是做什么的。我刚刚添加了 SynchronousUpdating -> False，并在“If”之前添加了一个 Dynamic，这也使速度更快。至于代码实际上是做什么的，我没有看:)
+1 用于非玩笑的中缀。 :-) 顺便说一句，我更喜欢排版a ~N~ b 而不是a ~ N ~ b，因为很清楚该函数是哪个术语。如果您开始字符串中缀，这将很有帮助。
@Mr.Wizard 谢谢，这当然是一个很好的提示！在穿线时，我有时会因为均匀间距而感到困惑。

【解决方案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]

【讨论】：

非常快速且响应迅速 - +1。您可以通过使用Total[UnitStep[1 - #]& @Sqrt@Total[Transpose[arrows[[;; i]]^2]]]/i // N 进行计数来进一步提高响应能力，尽管这只是您的代码提供的加速的一小部分。

【解决方案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}];
   )

 ]

【讨论】：

似乎更好！谢谢你。但是文本已关闭。我应该会迅速收敛到 0.39。你也能解释一下为什么它更好:-)？
@500，哪个文本是关闭的？我没有碰文字的东西。查看此版本与您的版本之间的差异，您可以看到使其更快的更改。