Manipulating plot of random iterated function system fractal

As I understand it, you'd like to dynamically illustrate how the chaos game works by showing how the points arise randomly. Here are two approaches, with enough code in common that we can practically do them both at once.

Using Dynamic

First, I think it's quite natural to do this with Dynamic. To do so, we set up an image called dynamicPic that we'll subsequently modify.

dynamicPic = pic[0] = Graphics[{},
  PlotRange -> {{0, 1}, {0, 1}},
  Axes -> True
];
Dynamic[dynamicPic]

You should see just a pair of axes spanning the unit square. (The pic[0] is not relevant until we see the second solution.) Next, we'll modify dynamicPic in a loop and watch the image change. To do so, just execute the following, perhaps in a second notebook that doesn't cover the original image.

If[!MemberQ[$ContextPath,"Internal`"],
  AppendTo[$ContextPath,"Internal`"]
];
Clear[pic, dynamicPic];
f[1] = #/2&;
f[2] = #/2+{1/2,0}&;
f[3] = #/2+{1/4,Sqrt[3]/4}&;
Do[bag[i]=Bag[],{i,1,3}];
SeedRandom[1];
pt = RandomReal[{0,1},{2}];
Do[
  j = RandomInteger[{1,3}];
  pt = f[j][pt];
  StuffBag[bag[j], pt];
  dynamicPic = pic[k] = Graphics[
    Table[{ColorData[1,i], PointSize[Tiny], 
      Point@BagPart[bag[i],All]},{i,1,3}],
    PlotRange -> {{0,1},{0,1}},Axes -> True
  ],{k,1,10000}
];//AbsoluteTiming

Now, the output from the previously executed Dynamic[dynamicPic] should start to change. It takes around 13 seconds on my machine to generate and display all 10000 images. The process slows down as it progresses, since the whole image is displayed with each iteration. In this sense, the process is very different from drawing to a canvas as we see in many GUI type languages.

Using Animate

In the previous example, at each step we defined pic[k], in addition to overwriting dynamicPic. With the images generated we can now pass the result to Animate

Animate[pic[k], {k, 0, 10000, 1}]

Some Comments

Point[{{_,_}..}] is generally much faster than {Point[{_,_}]..}. This so-called "multi-point" syntax was introduced in V6. It can be trickier to work with though. In this example, I used Bag from the Internal context (which feels a lot like a stack) to build three lists of points for each of the colors.

I'm not a big fan of AffineTransform and friends. On the contrary, these functions seem to be a huge disappointment. They're kind of nice when you want to illustrate the effect of an affine transformation on an image in, say, a linear algebra class. But, if you know how to work with Graphics primitives, then it seems quite easy to roll your own and this will likely be more flexible.

Finally, I've written a package that you can grab off of my webspace that expands to a set of packages and documentation notebooks. Using the IteratedFunctionSystems package, Barnsley's fern can be generated quite quickly like so:

barnsleyFernIFS = {
  {{{.85, .04}, {-.04, .85}}, {0, 1.6}},
  {{{-.15, .28}, {.26, .24}}, {0, .44}},
  {{{.2, -.26}, {.23, .22}}, {0, 1.6}},
  {{{0, 0}, {0, .16}}, {0, 0}}
};
ShowIFSStochastic[
  barnsleyFernIFS, 70000,
  Colors -> {Darker[Green, 0.6], Darker[Green, 0.4],
    Darker[Green, 0.4], Black}]

enter image description here

Note that good probabilities are chosen automatically and that an image with 70000 points is generated in about half a second.

As another example, here's another way that one might interact with the Sierpinski triangle:

A = {{1, 0}, {0, 1}}/2;
Manipulate[
  ShowIFS[{{A, pt1/2}, {A, pt2/2}, {A, pt3/2}}, 8, 
    PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}}, Colors -> True,
    Initiator -> {PointSize[Small], Point[{0, 0}]}],
  {pt1, {0, 0}, {1, 1}, Locator}, 
  {{pt2, {1, 0}}, {0, 0}, {1, 1}, Locator}, 
  {{pt3, {1/2, Sqrt[3]/2}}, {0, 0}, {1, 1}, Locator}]

enter image description here


Maybe you can consider a solution like this instead?

newPoint[{col_, Point[pt_]}] := Block[{nc, tr},
   {nc, tr} =
   (* use RandomChoice to pick an affine transformation and its corresponding color *)
   RandomChoice[{{Red, AffineTransform[{{{0.5, 0}, {0, 0.5}}, {0, 0}}]},
                 {Green, AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/2, 0}}]},
                 {Blue, AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/4, Sqrt[3]/4}}]}}];
   {nc, Point[tr[pt]]}]

With[{n = 5*^3}, (* number of iterations *)
     BlockRandom[SeedRandom[42, Method -> "MersenneTwister"]; (* for reproducibility *)
     Graphics[{AbsolutePointSize[1/4], 
               NestList[newPoint,
                        {Black, Point[RandomReal[{0, 1}, 2]]} (* starting point *),
                        n]}, 
              Frame -> True]]]

IFS Sierpinski gasket


To demonstrate another way to color points from different affine transformations, and to also demonstrate the flexibility of RandomChoice[] in supporting probabilities, I'll use Barnsley's fern as an example here:

newPoint[{idx_, pt_?VectorQ}] := Block[{nc, tr},
   {nc, tr} = 
   RandomChoice[{0.85, 0.07, 0.07, 0.01} ->
                {{1, AffineTransform[{{{0.85, 0.04}, {-0.04, 0.85}}, {0, 1.6}}]},
                 {2, AffineTransform[{{{0.2, -0.26}, {0.23, 0.22}}, {0, 1.6}}]},
                 {3, AffineTransform[{{{-0.15, 0.28}, {0.26, 0.24}}, {0, 0.44}}]},
                 {4, AffineTransform[{{{0, 0}, {0, 0.16}}, {0, 0}}]}}];
   {nc, tr[pt]}]

With[{n = 1*^4},
     BlockRandom[SeedRandom[42, Method -> "MersenneTwister"];
     Graphics[{AbsolutePointSize[1/4], 
               MapIndexed[{Extract[{Black, Green, Blue, Cyan, Yellow}, #2],
                           Point[Last /@ #1]} &, 
                          GatherBy[SortBy[NestList[newPoint, {0, {0, 0}}, n],
                                   First], First]]},
              Frame -> True]]]

Barnsley's fern