I'm generating the Sierpinski Gasket by implementing a chaos game in Mathematica. What I'd like to do is create an interactive manipulation with a slider, whereby moving it forward, plots all the points produced at each level of iteration (described in the code below). I'd also like to associate each point with a color depending on the affine transformation that was used to produce it. There are three affine transformations being used for this iterated function system $W_{1},W_{2},W_{3}$. So, if a point was produced using $W_{1}$, I'd like to color it red. If a point was produced with $W_{2}$, then color it blue, and so on. How would I go about doing this, preferrably using the code I've concocted thus far?
Here is the code I've made thus far:
Clear[A, B, W, X, i, ITERATIONS, roll]
(* Transformation matrices A[i] given below *)
A[1] = {{0.5, 0}, {0, 0.5}};
A[2] = {{0.5, 0}, {0, 0.5}};
A[3] = {{0.5, 0}, {0, 0.5}};
(* Translation vectors B[i] are defined below *)
B[1] = {0, 0};
B[2] = {1/2, 0};
B[3] = {1/4, Sqrt[3]/4};
(* Format of affine Transformation *)
W[i_, X_] := A[i].X + B[i]
RandomComponent := Random[Real, {0, 1}];
(* Initial point within bounds of unit square *)
X[0] = {RandomComponent, RandomComponent};
(* Iteration Process is defined here:
At each level of iteration we roll a standard dice. Depending on the outcome, we apply one of the affine transformations defined above to the point provided during the previous level of iteration *)
ITERATIONS = 100000;
X[i_] = For[i = 0, i <= ITERATIONS, i++,
roll = Random[Integer, {1, 6}];
If[roll == 1 || roll == 2,
X[i + 1] = W[1, X[i]],
If[roll == 3 || roll == 4,
X[i + 1] = W[2, X[i]],
If[roll == 5 || roll == 6,
X[i + 1] = W[3, X[i]]]]]]
fractal1 = Table[X[n], {n, 1, ITERATIONS}];
ListPlot[fractal1, Axes -> False, AspectRatio -> Automatic,
PlotStyle -> {PointSize[0.001]}]
UPDATE 1 (Code for interactive plot):
Here is the code for interactively plotting the Sierpinski Triangle via a Random Iterated Function System. The coloring aspect is still something I'm trying to work on as I wrangle through J.M.'s code. I was already aware of the affine transform and nested list functionality, but for the sake of my audience, I didn't resort to using it until now. The RandomChoice
function has been very useful, credits to J.M. for pointing this out.
Clear[W, W1, W2, W3, P1, P2, P3, X, n, x]
(* The Affine Transformations *)
W1 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {0, 0}}];
W2 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/2, 0}}];
W3 = AffineTransform[{{{0.5, 0}, {0, 0.5}}, {1/4, Sqrt[3]/4}}];
(* Their Associated Probabilities (weights) *)
P1 = 0.33;
P2 = 0.33;
P3 = 0.34;
RandomComponent := Random[Real, {0, 1}];
(* Produces Initial Point *)
X[0] := {RandomComponent, RandomComponent}
(* Chooses Affine Transformations according to their weights *)
RandomChoice[{P1, P2, P3} -> {W1, W2, W3}];
(* Applies selected transformation to given point *)
W[x_] := RandomChoice[{P1, P2, P3} -> {W1, W2, W3}][x];
(* NestedList provides us with a way of collecting the output from iterating W[x_] *)
Clear[n]
Animate[ListPlot[BlockRandom[NestList[W, X[0], n]], Axes -> False,
AspectRatio -> Automatic, PlotStyle -> {PointSize[0.006]},
PlotRange -> {{0, 1}, {-0.09, 1}}], {n, 0, 10000, 1},
DisplayAllSteps -> True, AnimationRunning -> False,
AnimationRate -> 1000]
X[0];
The result is: