21
$\begingroup$

Consider simple example where a set of points is generated and some are displayed.

k = 10^5;
p = RandomReal[{-1, 1}, {k, 2}];
n = 2
Graphics[Dynamic@Point@p[[;; n]], Frame -> True, PlotRange -> 1]

enter image description here

Let's plot more and more points from the set:

Dynamic@n
While[n += 100; FinishDynamic[]; n < k - 100]

enter image description here

I find the loop will start to slow down as n gets near to 10^5. This should be expected because the code is replotting all the points at each update of the graphics. (Depending on your system, the rate of slowdown my vary.)

But each time only 100 points are added while the rest of the displayed image remains the same. Naive thinking tells me that there must be a way to do this better.

I have tried many things but with no avail; still, I have a feeling I'm missing something basic.

$\endgroup$
  • 2
    $\begingroup$ Interesting, I've thought about this before. Maybe you can make an image? Crazy code btw (I think?) :P $\endgroup$ – Jacob Akkerboom Apr 24 '14 at 21:29
  • 3
    $\begingroup$ I wouldn't expect much improvement to be possible (while maintaining all points as graphics objects) since Dynamic does seem to go blindly through all display related elements that are wrapped by it. So I would use something like ListAnimate with prerendered graphics to achieve similar effects. But even then, rasterization is probably best. $\endgroup$ – Jens Apr 24 '14 at 22:51
  • $\begingroup$ Each time you add 100 points, they are scattered all over the image area. I don't see anyway to insert such a scatter that would be faster than a full redraw. As Jens suggests Dynamic is not a good substitute ListAnimate. $\endgroup$ – m_goldberg Apr 25 '14 at 9:39
  • $\begingroup$ @m_goldberg The difference is, I should've mentioned that, when you want to do this one ListAnimate is ok but when you want to easily recalculate whole set and interrupt the animation to start it with the new one it will glitch. In the approach above with Dynamic it will transition smoothly as there is no pre-processing. $\endgroup$ – Kuba Apr 25 '14 at 9:46
  • 1
    $\begingroup$ You used the term "naive thinking" in your post. I think you hit the target there. $\endgroup$ – m_goldberg Apr 25 '14 at 9:55
10
$\begingroup$

In your example the resolution of image is going to zero with number of points and you will see the scattered field after addition of some dozens of thousands of points.. What is the sense of such drawing and moreover the sense of dynamic updates of such graphics?

May be it is better to use something like this, with pre-defined size:

data = Table[0, {i, 1000}, {j, 1, 1000}];
Dynamic@Image[data, "Byte"]

k = 10^5;
n = 2;
Dynamic@n
While[n < k - 100,
 n += 100;
 p = RandomInteger[{1, 1000}, {1, 2}];
 data[[
    p[[1, 1]], p[[1, 2]]
    ]] = 255
 ]

It works much faster and each added point is resolvable. You can set really big sizes of image - with 1000x1000 it works in a wink. If you need frameticks, then you can make image Framed and dynamically re-draw it..


Kuba's edit...

data = ConstantArray[255, {300, 300}];
Dynamic@Image[data, "Byte"]

enter image description here

Using the code below we can see that performance is the same through the whole process:

i = 0;
Dynamic@i
Do[
   i++;
   p = RandomInteger[{1, 300}, {90, 2}];
   Scan[(data[[#[[1]], #[[2]]]] = 0) &, p];
   FinishDynamic[];

 , {1000}]

Kuba:

It's not an answer for the general question about dynamic but it performs extremely well the special case that was shown by me in the question.

Moreover if one removes FinishDynamic[] it will be even faster but not each step is being shown.

At the end I want to remind that the point is not to do that extremely fast but to not lose speed at each iteration like in the question. This code does this so +1 for Rom38 :)

$\endgroup$
  • $\begingroup$ You got my +1 - you need to set k=10^9 to see any change, that's how fast this is. $\endgroup$ – gpap Apr 25 '14 at 14:00
  • $\begingroup$ @gpap It's not as fast when you add FinishDynamic[] but the idea is very good. $\endgroup$ – Kuba Apr 25 '14 at 14:19
  • $\begingroup$ It is much easier to set Pause[x] than increase the speed of work in another case.. @Kuba, Yes, you can edit it :) $\endgroup$ – Rom38 Apr 25 '14 at 14:23
  • $\begingroup$ @Rom38 You have inspired me, I think I can use it for general case with Graphics. p.s. I hope you find my edit useful but feel free to revert it if not :) $\endgroup$ – Kuba Apr 25 '14 at 14:41
  • $\begingroup$ @Kuba. You'll obtain the same deceleration of perfomance if you use the Graphics directly inside the Image $\endgroup$ – Rom38 Apr 25 '14 at 14:46
4
$\begingroup$

I feel it should be emphasised this answer is quite unpractical and probably a mess.


Note that the FrontEnd displays boxes. So to tell the FrontEnd to draw a Graphics[{Disk[]}] is less direct than to tell it to draw a GraphicsBox[DiskBox[{0, 0}]]. Furthermore, it may be the case that if a box is not changed, it will not have to be redrawn. Even unchanged elements of a GraphicsBox may not have to be redrawn, but loaded from a cache instead. Lastly, it is probably more efficient to render a RasterBox (Image) than other boxes. Despite all this, the code I present here is quite slow, but keep in mind that I draw proper Disks and only one at a time.

Anyway, what the code does is overlay a dynamically generated graphic over another dynamic graphic, which is a raster. The idea is that we periodically put all points/disks into a rasterized graphic and display new points on top of that raster. I have used MousePosition[], as the setting I was thinking of was games, like the game by Michael Hale. In case you want to use MousePosition[], it is not possible to use something like ListAnimate, as you want to generate new graphics on the fly (and also you don't care about old graphics).

Initialisations

kk = 20;
size = 360;
diskSize = 2;

Unevaluated[  
  setGBBAndGB :=
   ({graphicsBuffer, graphicsBufferBoxes} = 
     Transpose[{Disk[#, diskSize], DiskBox[#, diskSize]} & /@ 
       RandomReal[{diskSize, size - diskSize}, {kk, 2}]]);
  ] /. Join[OwnValues[diskSize], OwnValues[size], OwnValues[kk]]

expandRaster := (raster = 
   Rasterize[Graphics[{First@raster, Black, graphicsBuffer}, 
     PlotRange -> {{0, size}, {0, size}}], 
    RasterSize -> {rasterSize, rasterSize}])

jj = 1;
ii = 1;
setGBBAndGB; ;
yMax = 880;
offset = 20;
delay = 2;
rasterSize = 360;

raster = Rasterize[
    Graphics[{White, Rectangle[{0, 0}, {size, size}]}], 
    RasterSize -> {rasterSize, rasterSize}]; ;

Boxes

With[{Yellow = Yellow, 
   rasterBoxes = rasterPrimitiveToBoxes@First@raster, Red = Red, 
   tenK = 10*kk, size = size, delay = delay, quot = quot},
  Cell[

   BoxData@
    GraphicsBox[{
      DynamicBox[
       ToBoxes@raster // First
       ]
      ,
      DynamicBox[
       graphicsBufferBoxes[[;; ii]]
       ]
      ,

      Yellow
      ,

      DynamicBox[
       If[jj == 0,
        If[
         ii == kk - 1
         ,
         expandRaster;
         setGBBAndGB
         ];
        ii = Mod[ii + 1, kk]
        ];
       jj = Mod[jj + 1, delay];



       RectangleBox @@ (Function[
           Function[{#, # + offset}]@{#1/4, (yMax - #2)/3}] @@ 
          MousePosition[])
       ]

      }
     ,
     PlotRange -> {{0, size}, {0, size}}
     ]
   ,
   "Input"
   ]
  ] // CellPrint

enter image description here

Where the code comes from

I evaluated expressions like this

GraphicsRow[{img, Graphics[{Yellow, Disk[{0, 0}, 1]}]}, 
 Spacings -> Scaled[-1.5]]

and fiddled around with the "cell expression" of the result, or the result of calling ToBoxes on this kind of expression.

More about the code

You can see that the rasterisation takes a significant portion of the time, as "Dynamic" lags when rasterisation is being done. You can make everything more smooth by increasing delay.

An improvement would be to use a separate kernel to do the rasterisation. Another improvement might be to rasterise to an image and use an OverlayBox, rather than putting everything into one GraphicsBox.

$\endgroup$
  • $\begingroup$ I'm still thinking... $\endgroup$ – Kuba Apr 25 '14 at 14:00
  • $\begingroup$ @Kuba I'm also still thinking :P. I think I make some reasonable points, but really the answer is too much of wild exploration into the entire world of graphics/boxes/dynamics to be useful. I'm hoping to update it in a bit $\endgroup$ – Jacob Akkerboom Apr 26 '14 at 14:22
  • $\begingroup$ @Kuba it's hard... Needsless to say I'm still looking at the low level optimized general case :P. Silly me $\endgroup$ – Jacob Akkerboom Apr 26 '14 at 19:19
  • $\begingroup$ You may be interested in my new answer :) $\endgroup$ – Kuba Jan 22 '17 at 8:53
3
$\begingroup$

This is not production ready yet but I won't have time to focus on that soon. Maybe someone else can polish this.

The idea

  1. set selection after desired graphics primitive (tricky)
  2. NotebookWrite graphics primitives boxes

To manage selection I will use BoxId as in How to set focus of a dialog window?.

Graphics[{ RawBoxes @ PointBox[{0, 0}, "BoxID" -> "test"]}, 
  PlotRange -> 1, 
  ImageSize -> 800, 
  Frame -> True, 
  BaseStyle -> {Red, AbsolutePointSize[1]}
]

Performance test

And now let's start writting:

MathLink`CallFrontEnd[
 FrontEnd`BoxReferenceFind[
  FE`BoxReference[EvaluationNotebook[], {{"test"}}, 
   FE`SearchStart -> "StartFromBeginning"]]
];

SelectionMove[EvaluationNotebook[], After, Box];

tm = First @ Last @ Reap @ Do[
  t = AbsoluteTime[];
  FinishDynamic[];
  NotebookWrite[
    EvaluationNotebook[], PointBox[#]
  ] & @ RandomReal[{-1, 1}, {2000, 2}];
  Sow[{i 2000, AbsoluteTime[] - t}]
  ,
  {i, 100}
]

enter image description here

Initial Dynamic based approach performance test:

x = RandomReal[{-1, 1}, {200001, 2}];
n = 1;
Graphics[Point @ Dynamic @ x[[;; n]], 
  PlotRange -> 1, 
  Frame -> True, 
  BaseStyle -> {Red, AbsolutePointSize[1]}, 
  ImageSize -> 800
]

tm2 = First @ Last @ Reap @ Do[
  t = AbsoluteTime[];
  FinishDynamic[];
  n += 2000;
  Sow[{n , AbsoluteTime[] - t}]
  ,
  {100}
];

Comparison

ListLinePlot[{tm, tm2}, 
  Frame -> True, Axes -> False, 
  FrameLabel -> {"points already in plot", "time spent adding 2000 points"}, 
  BaseStyle -> 18, 
  ImageSize -> 500, 
  PlotLegends -> {"NotebookWrite/PointBox", "Point@Dynamic@x"}
]

enter image description here

So yes, it is way better but unfortunately there is no stable/general way to do this.

$\endgroup$
  • $\begingroup$ This looks funky, but also quite tricky :P. I haven't looked at any details, are you changing the boxes of a cell without destroying and reprinting the cell? I didn't know that was possible. So no dynamics are used in the "NotebookWrite/PointBox" method? I see only FinishDynamic[] but I guess that does not count. $\endgroup$ – Jacob Akkerboom Jan 27 '17 at 10:41
  • $\begingroup$ @JacobAkkerboom no dynamics :) FinishDynamic is only to ensure the timing was done after stuff was rendered, so it really should be be called FinishRendering[]. $\endgroup$ – Kuba Jan 27 '17 at 10:43
  • $\begingroup$ @JacobAkkerboom and yep, in ..., PointBox[...] (*here*)}] Im inserting new boxes in here. $\endgroup$ – Kuba Jan 27 '17 at 10:45
  • $\begingroup$ Ok, that's very cool, nice to know this is possible. I always wanted to take a closer look at NotebookApply, do you think this function may relevant? $\endgroup$ – Jacob Akkerboom Jan 27 '17 at 10:47
  • $\begingroup$ @JacobAkkerboom I'd say it is like NotebookWrite + TemplateApply + NotebookRead and I didn't find it useful here. $\endgroup$ – Kuba Jan 27 '17 at 10:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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