NAME		: LEONARD LU TZE JIAN
NO MATRIX	: 102217

PROJECT 1

The Chaos Game: How Randomness Creates Deterministic Shapes

ABSTRACT:
Can randomness really create orderliness? Can randomness forms shapes?
Let’s take an example of randomness.
   


Of the above images, which one best represents raindrops falling on a sidewalk? Is it the left or the right?

Your answer is probably wrong because most people would choose the left picture. Most people perceive randomness as being evenly distributed while being grouped is perceived as being deliberate. That is why randomness is able to produce order.

In this first project, we introduce the Chaos Game. A dice, which 6 faces are only labelled with “1”, “2” and “3” is needed. Three points of a triangle is marked as “1”, “2” and “3”.

At the start of a game, a walker is placed at either points of a triangle, determined by the throw of a dice. Let’s denote his initial point as step[1]. The dice is thrown again. Let’s assume it’s 2. Hence, the walker will walk to the midpoint of step[1] and marker labelled 2, which is one of the points of the triangle. Continue this step for a few thousand times and see what orderliness this randomness generates.

(*Defining initial conditions*)
timestep=40000; (*the amount of steps the walker takes*)
side=3;(*the sides of a triangle*)
startpoint=0.0;
maxlength=maxheight=1.0;
setpoints={};
points={};

(*Defining the points of the triangle*)
pointx[1]=pointy[1]=startpoint;
pointx[2]=maxlength;pointy[2]=startpoint;
pointx[3]=startpoint+maxlength/2;pointy[3]=maxheight;

(*Grouping the points of the triangle together and putting them into "setpoints" table *)
For[k=1,k≤side,k++,
point={pointx[k],pointy[k]};
setpoints=Append[setpoints,point];
];

(*Initial position of the walker*)
abc=Random[Integer,{1,side}];
x[0]=pointx[abc];
y[0]=pointy[abc];
path[0]=linepath[0]={{pointx[abc],pointy[abc]}};

Print["timestep progress:  ",ProgressIndicator[Dynamic[t/timestep]]];

(*Begin Chaos Game*)
aa=1;(*an arbitrary constant*)

(*Begin time-stepping*)
For[t=0,t≤timestep,t++,

(*Simulating the throw of the dice*)
a=Random[Integer,{1,side}];
x[t+1]=(x[t]+pointx[a])/2;
y[t+1]=(y[t]+pointy[a])/2;

(*Generating a plot based on the path of the walker*)
If[t≤100,
linepath[t+1]=Append[linepath[t],{x[t+1],y[t+1]}];
];

(*Generating a plot based on the places the walker has been*)

(*Because Mathematic is limited in its memory kernel, this code is written in such a way that for each subsequent generated plot, 10 points will be plotted, rather than the conventional 1 point for generated plot. This way, we can have 10 times the amount of walks*)

(*Grouping 10 points together in the "points" table*)
points=Append[points,{x[t+1],y[t+1]}];

(*Fusing the "points" table with the generated "path" table*)
If[t/10==aa,
{
aa=aa+1;
path[t/10]=path[(t/10)-1];
For[j=1,j≤10,j++,
path[t/10]=Append[path[t/10],points[[j]]];
];
points={};(*emptying the table for the next 10 points*)
}
];
];
(*Chaos Game ends*)

(*Plotting the journey taken by the walker*)
Manipulate[ListPlot[{setpoints,linepath[i],linepath[i]},Axes->False,Joined->{False,False,True},PlotRange->All,AspectRatio->1,PlotStyle->{{PointSize[Large],Black},{PointSize[0.01],Blue},{Red}},PlotLabel->"Journey Taken by Walker for 100 steps"],{i,0,100,1}]

(*Plotting the places the walker has been*)
Manipulate[ListPlot[{setpoints,path[i]},Axes->False,PlotRange->All,AspectRatio->1,PlotStyle->{{PointSize[Large],Black},{PointSize[0.002],Blue}},PlotLabel->"Places the Walker Has Been to"],{i,0,timestep/10,1}]

Print["As you can see, this random walk created such a perfectly deterministic shape. It exhibits something called 'self-similarity', where similar structures can be seen in all segments of the image."];

ListPlot[path[timestep/10],PlotRange->{{0,0.5},{0,0.5}},AspectRatio->1,PlotLabel->"Image at 200% Magnification"]

ListPlot[path[timestep/10],PlotRange->{{0,0.25},{0,0.25}},AspectRatio->1,PlotLabel->"Image at 400% Magnification"]

ListPlot[path[timestep/10],PlotRange->{{0,0.125},{0,0.125}},AspectRatio->1,PlotLabel->"Image at 800% Magnification"]

DISCUSSION:

The generated image is called a Sierpinski Gasket, which is a famous fractal.

In this project, we can see if we follow the time process step by step, we cannot predict where the next game point will land becasue it is determined by throwing a dice. Nevertheless, the pattern which all the game points together leave behind an absolutely predictable pattern. This demonstrates an interesting interplay between randomness and deterministic fractals

A Chaos Game can be done for a poligon other than a triangle. The sample code is written below.

(*Chaos Game for different poligons*)

(*Defining initial conditions*)
timestep=40000; (*the amount of steps the walker takes*)
side=Input["Please enter the number of sides of the poligon:\n(For better visualisation, enter ≤ 6)"];(*the sides of the poligon*)
startpoint=0.0;
maxlength=maxheight=1.0;
setpoints={};
points={};

(*Defining the points of the poligon*)
oo=1;
For[i=1,i≤2,i++,
(*separating the poligon into 2 sides: Top and bottom*)
For[j=1,j≤IntegerPart[(side+1)/2],j++,(*side+1 to prevent any missing points if it is an odd number*)
If[oo>side,Break[];Break[],
pointx[oo]=Random[Real,{(j-1)*maxlength/(IntegerPart[side/2]),j*maxlength/(IntegerPart[side/2])}];
pointy[oo]=Random[Real,{(i-1)*maxheight/(side-IntegerPart[side/2]),i*maxheight/(side-IntegerPart[side/2])}];
Print[oo," ",pointx[oo]," ",pointy[oo]];
oo=oo+1;
];
];
];

(*Grouping the points of the triangle together and putting them into "setpoints" table *)
For[k=1,k≤side,k++,
point={pointx[k],pointy[k]};
setpoints=Append[setpoints,point];
];

(*Initial position of the walker*)
abc=Random[Integer,{1,side}];
x[0]=pointx[abc];
y[0]=pointy[abc];
path[0]=linepath[0]={{pointx[abc],pointy[abc]}};

Print["timestep progress:  ",ProgressIndicator[Dynamic[t/timestep]]];

(*Begin Chaos Game*)
aa=1;(*an arbitrary constant*)

(*Begin time-stepping*)
For[t=0,t≤timestep,t++,

(*Simulating the throw of the dice*)
a=Random[Integer,{1,side}];
x[t+1]=(x[t]+pointx[a])/2;
y[t+1]=(y[t]+pointy[a])/2;

(*Generating a plot based on the path of the walker*)
If[t≤100,
linepath[t+1]=Append[linepath[t],{x[t+1],y[t+1]}];
];

(*Generating a plot based on the places the walker has been*)

(*Because Mathematic is limited in its memory kernel, this code is written in such a way that for each subsequent generated plot, 10 points will be plotted, rather than the conventional 1 point for generated plot. This way, we can have 10 times the amount of walks*)

(*Grouping 10 points together in the "points" table*)
points=Append[points,{x[t+1],y[t+1]}];

(*Fusing the "points" table with the generated "path" table*)
If[t/10==aa,
{
aa=aa+1;
path[t/10]=path[(t/10)-1];
For[j=1,j≤10,j++,
path[t/10]=Append[path[t/10],points[[j]]];
];
points={};(*emptying the table for the next 10 points*)
}
];
];
(*Chaos Game ends*)

(*Plotting the places the walker has been*)
Manipulate[ListPlot[{setpoints,path[i]},Axes->False,PlotRange->All,AspectRatio->1,PlotStyle->{{PointSize[Large],Black},{PointSize[0.002],Blue}},PlotLabel->"Places the Walker Has Been to"],{i,0,timestep/10,1}]