Как я могу симулировать отталкивание между несколькими точечными зарядами (шарикоподшипниками) в Mathematica?

Question

Я пытаюсь написать программу в Mathematica, которая будет имитировать способ распределения заряженных шарикоподшипников, когда они заряжены одинаковыми зарядами (они отталкивают друг друга).Моя программа до сих пор удерживает шариковые подшипники от смещения с экрана и подсчитывает, сколько раз они ударяются о бок коробки.Пока у меня есть шарикоподшипники, которые беспорядочно движутся вокруг коробки, но мне нужно знать, как заставить их отталкиваться друг от друга.

Вот мой код:

Manipulate[
 (*If the number of points has been reduced, discard  points*)
 If[ballcount < Length[contents], 
   contents = Take[contents, ballcount]];

 (*If the number of points has been increased, generate some random points*)
 If[ballcount > Length[contents], 
  contents = 
   Join[contents, 
    Table[{RandomReal[{-size, size}, {2}], {Cos[#], Sin[#]} &[
       RandomReal[{0, 2 \[Pi]}]]}, {ballcount - Length[contents]}]]];

 Grid[{{Graphics[{PointSize[0.02],

  (*Draw the container*)
  Line[size {{-1, -1}, {1, -1}, {1, 1}, {-1, 1}, {-1, -1}}], 
  Blend[{Blue, Red}, charge/0.3],
  Point[

   (*Start the main dynamic actions*)
   Dynamic[

    (*Reset the collision counter*)
    collision = 0;

    (*Check for mouse interaction and add points if there has been one*)
    Refresh[
     If[pt =!= lastpt, If[ballcount =!= 50, ballcount++]; 
      AppendTo[
       contents, {pt, {Cos[#], Sin[#]} &[
         RandomReal[{0, 2 \[Pi]}]]}]; lastpt = pt], 
     TrackedSymbols -> {pt}];

    (*Update the position of the points using their velocity values*)
    contents = Map[{#[[1]] + #[[2]] charge, #[[2]]} &, contents];

    (*Check for and fix points that have exceeded the box in Y
      direction, incrementing the collision counter for each one*)
    contents = Map[
      If[Abs[#[[1, 2]]] > size, 
        collision++; {{#[[1, 1]], 
          2 size Sign[#[[1, 2]]] - #[[1, 2]]}, {1, -1} #[[
           2]]}, #] &,
      contents];


    (*Check for and fix points that have exceeded the box in X 
      direction, incrementing the collision counter for each one*)
    contents = Map[
      If[Abs[#[[1, 1]]] > size, 
        collision++; {{2 size Sign[#[[1, 1]]] - #[[1, 1]], #[[1, 
           2]]}, {-1, 1} #[[2]]}, #] &,
      contents];

    hits = Take[PadLeft[Append[hits, collision/size], 200], 200];
    Map[First, contents]]]},
 PlotRange -> {{-1.01, 1.01}, {-1.01, 1.01}}, 
 ImageSize -> {250, 250}],

(*Show the hits*)
Dynamic@Show
  [
   ListPlot
   [
   Take[MovingAverage[hits, smooth], -100
    ]
   ,
   Joined -> True, ImageSize -> {250, 250}, AspectRatio -> 1, 
   PlotLabel -> "number of hits", AxesLabel -> {"time", "hits"}, 
   PlotRange -> {0, Max[Max[hits], 1]}], Graphics[]
  ]
}}
  ]
 ,
 {{pt, {0, 1}}, {-1, -1}, {1, 1}, Locator, Appearance -> None},
 {{ballcount, 5, "number of ball bearings"}, 1, 50, 1},
 {{charge, 0.05, "charge"}, 0.002, 0.3},
 {smooth, 1, ControlType -> None, Appearance -> None},
 {size, 1, ControlType -> None, Appearance -> None},
 {hits, {{}}, ControlType -> None},
 {contents, {{}}, ControlType -> None},
 {lastpt, {{0, 0}}, ControlType -> None}
 ]

Answer 1

Что вам нужно для симуляции, так это «алгоритм обнаружения столкновений». Область этих алгоритмов широко распространена, поскольку она так же стара, как компьютерные игры (Понг), и здесь невозможно дать полный ответ.

Ваша симуляция в том виде, в каком она есть сейчас, очень проста, потому что вы продвигаете заряженные шары каждый раз, когда они «прыгают» из позиции в позицию. Если движение так же просто, как и с постоянной скоростью и нулевым ускорением, вы знаете точное уравнение движения и можете рассчитать все позиции, просто введя время в уравнения. Когда мяч отскакивает от стены, он получает новое уравнение.

С этим вы можете предсказать, когда два шара столкнутся. Вы просто решаете за два шарика, имеют ли они одновременно одну и ту же позицию. Это называется Априорное обнаружение. Когда вы возьмете симуляцию такой, какая она есть сейчас, вам придется проверять на каждом временном шаге, находятся ли два шара настолько близко друг к другу, что они могут столкнуться.

Проблема в том, что ваша скорость симуляции не бесконечно высока, и чем быстрее ваши шары, тем больше скачков в вашей симуляции. Тогда не исключено, что два шара перепрыгнут друг с другом, и вы пропустите столкновение.

Имея это в виду, вы можете начать с чтения статьи Википедии по этой теме, чтобы получить обзор. Далее вы можете прочитать несколько научных статей об этом или проверить, как это делают взломщики. Например, физический движок Бурундук - это удивительный движок двумерной физики. Чтобы убедиться, что такие вещи работают, я почти уверен, что им пришлось много думать об обнаружении столкновений.

Answer 2

Я не могу выполнить часть обнаружения, так как это сам по себе проект. Но теперь кажется, что взаимодействие происходит быстрее, у вас было немного динамики, которые не были нужны. (если вы видите, что сторона ячейки занята все время, это всегда означает, что Dynamic занят, где он не должен быть).

Я также добавил кнопку STOP / START. Я не мог понять все, что вы делали, но достаточно, чтобы внести изменения, которые я сделал. Вы также используете AppendTo все. Вы должны попытаться распределить содержимое заранее и использовать Part[] для доступа к нему, это будет намного быстрее, так как вы, кажется, знаете максимально допустимое количество баллов?

Мне нравится больше распространять код, это помогает мне лучше видеть логику.

Вот снимок экрана, код обновленной версии приведен ниже. Надеюсь, вы найдете это быстрее.

Пожалуйста, смотрите код ниже, в обновлении (1)

Обновление (1)

(*updated version 12/30/11 9:40 AM*)
Manipulate[(*If the number of points has been reduced,discard points*)
\


 Module[{tbl, rand, npt, ballsToAdd},

  If[running,
   (
    tick += $MachineEpsilon;
    If[ballcount < Length[contents], 
     contents = Take[contents, ballcount]];

    (*If the number of points has been increased,
    generate some random points*)

    If[ballcount > Length[contents],
     (
      ballsToAdd = ballcount - Length[contents];
      tbl = 
       Table[{RandomReal[{-size, size}, {2}], {Cos[#], Sin[#]} &[
          RandomReal[{0, 2 \[Pi]}]]}, {ballsToAdd}];
      contents = Join[contents, tbl]
      )
     ];

    image = Grid[{
       {LocatorPane[Dynamic[pt], Graphics[{

           PointSize[0.02],(*Draw the container*)
           Line[size {{-1, -1}, {1, -1}, {1, 1}, {-1, 1}, {-1, -1}}],
           Blend[{Blue, Red}, charge/0.3],

           Point[(*Start the main dynamic actions*)

            (*Reset the collision counter*)
            collision = 0;

            (*Check for mouse interaction and add points if there has \
been one*)
            If[EuclideanDistance[pt, lastpt] > 0.001, (*adjust*)
             (
              If[ballcount < MAXPOINTS,
               ballcount++
               ];

              rand = RandomReal[{0, 2 \[Pi]}];
              npt = {Cos[rand], Sin[rand]};
              AppendTo[contents, {pt, npt}  ];
              lastpt = pt
              )
             ];

            (*Update the position of the points using their velocity \
values*)

            contents = 
             Map[{#[[1]] + #[[2]] charge, #[[2]]} &, contents];

            (*Check for and fix points that have exceeded the box in \
Y direction,incrementing the collision counter for each one*)

            contents = Map[
              If[Abs[#[[1, 2]]] > size,
                (
                 collision++;
                 {{#[[1, 1]], 
                   2 size Sign[#[[1, 2]]] - #[[1, 2]]}, {1, -1} #[[2]]}
                 ),
                (
                 #
                 )
                ] &, contents
              ];

            (*Check for and fix points that have exceeded the box in \
X direction,
            incrementing the collision counter for each one*)


            contents = 
             Map[If[Abs[#[[1, 1]]] > size, 
                collision++; {{2 size Sign[#[[1, 1]]] - #[[1, 1]], #[[
                   1, 2]]}, {-1, 1} #[[2]]}, #] &, contents
              ];


            hits = Take[PadLeft[Append[hits, collision/size], 200], 
              200];
            Map[First, contents]
            ]
           },
          PlotRange -> {{-1.01, 1.01}, {-1.01, 1.01}}, 
          ImageSize -> {250, 250}
          ], Appearance -> None
         ],(*Show the hits*)

        Show[ListPlot[Take[MovingAverage[hits, smooth], -100],
          Joined -> True, ImageSize -> {250, 250}, AspectRatio -> 1,
          PlotLabel -> "number of hits", AxesLabel -> {"time", "hits"},
          PlotRange -> {0, Max[Max[hits], 1]}
          ]
         ]
        }
       }
      ]
    )
   ];

  image
  ],

 {{MAXPOINTS, 50}, None},
 {pt, {{0, 1}}, None},
 {{ballcount, 5, "number of ball bearings"}, 1, MAXPOINTS, 1, 
  Appearance -> "Labeled", ImageSize -> Small},
 {{charge, 0.05, "charge"}, 0.002, 0.3, Appearance -> "Labeled", 
  ImageSize -> Small},
 Row[{Button["START", {running = True; tick += $MachineEpsilon}], 
   Button["STOP", running = False]}],
 {{tick, 0}, None},
 {smooth, 1, None},
 {size, 1, None},
 {hits, {{}}, None},
 {{contents, {}}, None},
 {lastpt, {{0, 0}}, None},
 {{collision, 0}, None},
 {image, None},
 {{running, True}, None},
 TrackedSymbols ->     { tick},
 ContinuousAction -> False,
 SynchronousUpdating -> True

 ]