Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm making an animation where the number of iterations is known. I tried using Dynamic, as I prefer updating in real time over generating data before plotting. I want it to look like the following, but Mathematica seems to lack a built-in function like MATLAB's hold on, which keeps the current plot when adding new content (lines, points) instead of erasing it first. Is there a pretty way to do this?

Clear["`*"];
forward[{x1_, y1_}, {x2_, y2_}, v_: 5] :=
  Block[{alpha},
   alpha = Switch[Sign[x1 - x2],
     -1, ArcTan[(y2 - y1)/(x2 - x1)],
     1, Pi + ArcTan[(y2 - y1)/(x2 - x1)],
     0, Pi/2,
     _, -Pi/2];
   {x1 + v 0.01 Cos[alpha], y1 + v 0.01 Sin[alpha]}
   ];

Module[{plt, p1, p2, p3, p4},
 {p1, p2, p3, p4} = {{-3, 0}, {0, 3}, {3, 0}, {0, -3}};
 Print@Dynamic@plt;
 While[! Or @@Thread[Norm[# - #2] & @@@ Subsets[{p1, p2, p3, p4}, {2}] < .01],
  p1 = forward[p1, p2];
  p2 = forward[p2, p3];
  p3 = forward[p3, p4];
  p4 = forward[p4, p1];
  plt = ListPlot[List /@ {p1, p2, p3, p4}, 
    PlotRange -> {{-4, 4}, {-4, 4}}, AspectRatio -> Automatic, 
    PlotStyle -> {Red, Green, Blue, Orange}];
  Pause[.05]
  ];
 ]

enter image description here

share|improve this question
1  
What does Matlab's "hold on" do? –  Michael E2 May 8 '13 at 10:38
3  
@Michael E2 Normally when you plot in Matlab, it erases the current plot. If you command "hold on," it leaves the currnent plot in place and adds the new information to it. –  bill s May 8 '13 at 10:52

2 Answers 2

up vote 12 down vote accepted

My take:

toward[p1_, p2_, v_: .05] := p1 + v Normalize[p2 - p1];

{n, r} = {4, 3};
DynamicModule[{pts, history},
  pts = r {Cos[#], Sin[#]} & /@ Range[2 Pi/n, 2 Pi, 2 Pi/n];
  history = {pts};

  Print[Dynamic[ListPlot[Transpose@history,
     AspectRatio -> Automatic, Joined -> True,
     PlotStyle -> Directive[Thick, CapForm["Round"]],
     PlotRange -> (r + 1) {{-1, 1}, {-1, 1}}]]];

  While[EuclideanDistance @@ RandomSample[pts, 2] > .05,
   pts = toward @@@ Partition[pts, 2, 1, 1];
   AppendTo[history, pts];
   Pause[.05]]];

enter image description here

According to the documentation, DynamicModule helps with speed because its variables are held by the frontend. I'm not sure if it makes a difference in any one particular case though. One performance issue is that the Transpose@history will become inefficient for longer calculations. But anyway these plot things are quite fun.

enter image description here

Random starting positions:

enter image description here

Regular radial starting positions, but random love interest using pts = RandomSample[pts]:

enter image description here

Using pts = toward @@@ (1.0015 Partition[pts, 2, 1, 1]) as the update routine:

enter image description here

Using SeedRandom we can get a comparison to what it would have looked like using the normal update routine:

enter image description here

Using pts = toward[##, .5 RandomChoice[{.6, .4} -> {1, -1}]] & @@@ Partition[pts, 2, 1, 1], point mostly goes toward its love interest (lust), but sometimes moves away (fear of long-term commitment):

enter image description here

Using pts = toward[#, MousePosition["Graphics"] /. None -> #, .1] & /@ pts:

enter image description here

These are quite nifty. Add some momentum, throw in some ColorData, perhaps a pack of gravitons here or there, who knows what kinda stuff you can come up with.

enter image description here

Update

By popular demand, a 3D version. The mechanical code is exactly the same (because e.g. Normalize works just the same in 3D as in 2D). But of course 3D allows more kinds of configurations, and I decided to make the code "educational."

toward[p1_, p2_, v_: .05] := p1 + v Normalize[p2 - p1];

HD[g_Graphics3D, {upScale_: 2, downScale_: 2, 
    resolution_: {16, 9} (1080/9)}, {style___}] :=
  Show[g /. l_Line :> {style, l}, Boxed -> False, Method -> {"ShrinkWrap" -> True},
     ImageSize -> upScale resolution] // Rasterize // ImageResize[#, Scaled[1/downScale]] &;

{n, sep} = {30, 1.5};

DynamicModule[{pts},
  pts = #[[3]] &@{
     (**)Module[{ico = PolyhedronData["Icosahedron", "VertexCoordinates"]},
      15 (Normalize /@ ico)],
     (**)RandomReal[{0, 15}, {n, 3}],
     (**)3 Join[{Cos[#], Sin[#], 0} & /@ (2 Pi Range[n]/n),
       Reverse[{Cos[#], Sin[#], sep} & /@ (2 Pi Range[n]/n)]],
     (**)3 Join[{Cos[#], Sin[#], 0} & /@ (2 Pi Range[n]/n),
       RotateLeft[#, Floor[n/2]] &@Reverse[{Cos[#], Sin[#], sep} & /@ (2 Pi Range[n]/n)]],
     (**)3 Riffle[4 {Cos[#], Sin[#], 0} & /@ (2 Pi Range[n]/n),
       RandomSample[{Cos[#], Sin[#], sep} & /@ (2 Pi Range[n]/n)]]};

  history = {pts};

  g3dExpr = Graphics3D[{Thick, Opacity[.9], Dynamic[
      MapIndexed[{ColorData[1][#2[[1]]], Line[#1]} &, Transpose@history]]},
    ImageSize -> Large];

  PrintTemporary[g3dExpr];

  While[EuclideanDistance @@ RandomSample[pts, 2] > .1,
   pts = toward @@@ Partition[pts, 2, 1, 1];
   AppendTo[history, pts];
   (*disable for speed*)Pause[.05]]];

Beep[];

(*note: purpose here is to be able to adjust the perspective before you rasterize*)
(*CellPrint@ExpressionCell[*)
Defer[HD][Setting[g3dExpr], {4, 4, {590, 590}}, {Thickness[.0015]}]
(*,"Input"]*)

enter image description here enter image description here
enter image description here

Spirals of this kind might be useful starting configurations. Also keep in mind that if you try to randomly place points on the surface of a sphere, it may be harder than it sounds.

share|improve this answer
    
Lovely eye candy! –  Yves Klett May 8 '13 at 9:28
    
Very nice! Thank you very much. –  expression May 8 '13 at 9:45
    
+1 for ` Print[Dynamic[...]]`! Great idea:) –  Ajasja May 8 '13 at 11:36
    
Hi, if you have time, maybe there would be a 3D-Version? I think that will be awesome! –  HyperGroups Aug 29 '13 at 13:19

Seems no holdon, but to achive the same effect is easy too. Add a Joined->True, looks like a joined curve now

Clear["`*"];
forward[{x1_,y1_},{x2_,y2_},v_: 5]:=Block[{alpha},alpha=Switch[Sign[x1-x2],-1,ArcTan[(y2-y1)/(x2-x1)],1,Pi+ArcTan[(y2-y1)/(x2-x1)],0,Pi/2,_,-Pi/2];{x1+v 0.01 Cos[alpha],y1+v 0.01 Sin[alpha]}];
list={};
Module[{plt,p1,p2,p3,p4},{p1,p2,p3,p4}={{-3,0},{0,3},{3,0},{0,-3}};
    Print@Dynamic@plt;While[!Or@@Thread[Norm[#-#2]&@@@Subsets[{p1,p2,p3,p4},{2}]<.01],p1=forward[p1,p2];p2=forward[p2,p3];p3=forward[p3,p4];p4=forward[p4,p1];
plt=Show[ListPlot[Transpose@AppendTo[list,{p1,p2,p3,p4}],PlotRange->{{-4,4},{-4,4}},AspectRatio->Automatic,Joined->True,PlotStyle->{Red,Green,Blue,Orange}]];
Pause[.05]];]

enter image description here

share|improve this answer
    
ListLinePlot can also be used instead of ListPlot and Joined -> True. –  Michael E2 May 8 '13 at 10:36
    
@Michael, speaking as an old Mathematica user, that's a hard habit to break. :) –  J. M. May 8 '13 at 11:50

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.