Re: RE: Real Time Animation

*To*: mathgroup at smc.vnet.net*Subject*: [mg36942] Re: [mg36890] RE: [mg36796] Real Time Animation*From*: Omega Consulting <omega_consulting at yahoo.com>*Date*: Wed, 2 Oct 2002 03:33:42 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

At 03:45 AM 10/1/2002, Goyder Dr HGD wrote: >Many thanks to all who replied. > >The original problem was as follows: > >In a presentation I wish to use Plot to generate a sequence of frames and >then animate them. The problem is that the audience sees the animation >twice. Once when the frames are being generated and then again after I have >closed the group and double clicked on the top graphic. However, the first >showing during generation is enough (but uncontrolled). > >Is it possible to tidy up the generation of the graphic so that it becomes >the animation? > > >There were two main solutions which I now apply to my real problem and not >the simple, generic, problem in the original post. >The real problem was how to build up a probably density function (PDF) in >real time. In the examples below I redraw the PDF every time I add 10 >points. > >Initialise > ><<Statistics`ContinuousDistributions`; ><<Statistics`DataManipulation`; ><<Graphics`Graphics`; ><< JLink`; >wb=WeibullDistribution[2.101349094155377,22.58126779173235`]; >midpts=Table[i,{i,0.5,50,1}]; > >Solution from Omega Consulting > >GraphicCell[graphics_] := > Cell[GraphicsData["PostScript", DisplayString[graphics]],"Graphics"] > >Block[{$DisplayFunction=Identity, graphs}, > data={}; > graphs = > Table[data=Flatten[Join[data,RandomArray[wb,10]]]; > freq=BinCounts[data,{0,50,1}]; > GraphicCell[ > BarChart[Transpose[{freq,midpts}],ImageSize ->500] ], {500}]; > NotebookWrite[EvaluationNotebook[],Cell[CellGroupData[graphs,Closed]]]; > SelectionMove[EvaluationNotebook[], All, GeneratedCell]; > FrontEndExecute[{FrontEndToken[EvaluationNotebook[], > "SelectionAnimate"]}] > ] > >This solution works but it generates 500 frames and sometimes exceeds the >memory. >The paradigm here is generate all frames, then animate all frames. We >really need a loop that does: > > generate next frame, delete last frame, show next frame > >Is it possible to do this? Yes, however, I thought you didn't want to see the selection bar moving around during the animation. That's why I chose to generate the whole animation in one shot. Also, when you write the new cell over the old cell there is a "flash" between frames as the old frame is deleted. Here's an example of a frame-by-frame method. GraphicCell[graphics_] := Cell[GraphicsData["PostScript", DisplayString[graphics]],"Graphics"] CellPrint[Cell["","Graphics"]]; Block[{$DisplayFunction=Identity}, Do[ SelectionMove[EvaluationNotebook[], All, GeneratedCell]; NotebookWrite[EvaluationNotebook[], GraphicCell[Plot[x y,{x,0,1}, PlotRange->{0,50}]]], {y,50} ] ] Also, if you add ShowCellBracket->False to GraphicCell and a Pause to the loop, then things get much better visually. -------------------------------------------------------------- Omega Consulting "The final answer to your Mathematica needs" Spend less time searching and more time finding. http://www.wz.com/internet/Mathematica.html