Is there a better way to add elements to a Graphics expression repeatedly?

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]


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

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


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.

-
Interesting, I've thought about this before. Maybe you can make an image? Crazy code btw (I think?) :P –  Jacob Akkerboom Apr 24 at 21:29
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. –  Jens Apr 24 at 22:51
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. –  m_goldberg Apr 25 at 9:39
@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. –  Kuba Apr 25 at 9:46
You used the term "naive thinking" in your post. I think you hit the target there. –  m_goldberg Apr 25 at 9:55

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"]


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 :)

-
You got my +1 - you need to set k=10^9 to see any change, that's how fast this is. –  gpap Apr 25 at 14:00
@gpap It's not as fast when you add FinishDynamic[] but the idea is very good. –  Kuba Apr 25 at 14:19
It is much easier to set Pause[x] than increase the speed of work in another case.. @Kuba, Yes, you can edit it :) –  Rom38 Apr 25 at 14:23
@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 :) –  Kuba Apr 25 at 14:41
@Kuba. You'll obtain the same deceleration of perfomance if you use the Graphics directly inside the Image –  Rom38 Apr 25 at 14:46

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


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.

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.