Оптимизация «Манипуляции» в Mathematica

Question

Я хочу сделать хорошую демонстрацию проблемы, которую я упомянул в Интеграция в Mathematica , но она очень медленная, а манипуляция совсем не гладкая.

Учитывая следующееЕсть ли средства, с помощью которых я мог бы улучшить ситуацию.То есть увидеть более непрерывную динамику.Также я не могу открыть Манипулятор, используя

Управление-> Манипулятор [Внешний вид-> Открыть]

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]

Answer 1

Основная причина медлительности в том, что вы вычисляете EuclideanDistance из всех точек до шага i для за каждый шаг i. Вы увидите разницу, если вы сделаете этот шаг из Manipulate.

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

Решение Хайке гораздо более гладкое, чем у вас или у Насера, поэтому я буду использовать его в качестве примера. Вы бы использовали предварительно рассчитанное значение 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 цифр, потому что в противном случае вы увидите, как цифра будет расти, когда число значащих цифр изменится.

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]

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

 ]