File:Lawoflargenumbersanimation.gif

Summary[edit]

Licensing[edit]

I, the copyright holder of this work, release this work into the public domain. This applies worldwide. In some countries this may not be legally possible; if so: I grant anyone the right to use this work for any purpose, without any conditions, unless such conditions are required by law.

(* Source code written in Mathematica 6.0, by Steve Byrnes, 2010. I release this code into the public domain. *)

SeedRandom[1]

NumBalls = 500;

(*Build list of point coordinates and radii*)

BuildCoordList[LeftX_, RightX_, BotY_, TopY_, Cols_, Rows_] := 
 Flatten[Table[{i, j}, {j, BotY, TopY, (TopY - BotY)/(Rows - 1)}, {i, LeftX, RightX, (RightX - LeftX)/(Cols - 1)}], 1];

BlueCoordsList = BuildCoordList[.15, .85, .15, 4.75, 5, 24];
RedCoordsList = BuildCoordList[1.15, 1.85, .15, 4.75, 5, 24];
radius = .05;

(*Draw borders*)

lines = {Line[{{0, 0}, {0, 5}}], Line[{{1, 0}, {1, 5}}], 
   Line[{{2, 0}, {2, 5}}], Line[{{0, 0}, {2, 0}}]};

(*Draw pie chart*)

DrawPie[CenterX_, CenterY_, Radius_, 
   FracRed_] := {{Red, 
    Disk[{CenterX, CenterY}, Radius, {-FracRed \[Pi], FracRed \[Pi]}]}, {Blue,
     Disk[{CenterX, CenterY}, 
     Radius, {FracRed \[Pi], 2 \[Pi] - FracRed \[Pi]}]}};

(* Randomly generate order that red and blue appear *)

AppearOrder = Table[RandomInteger[{0, 1}], {i, 1, NumBalls}];

(* Calculate number of red and blue balls at any given time, and their proportions. *)

NumAppeared[time_] := Floor[time];
NumRed[time_] := Total[AppearOrder[[1 ;; NumAppeared[time]]]];
NumBlue[time_] := NumAppeared[time] - NumRed[time];
FracRed[time_] := NumRed[time]/NumAppeared[time];

(* Put everything together! *)

Video = {};
NumFrames = 220;
For[frame = 1, frame <= NumFrames, frame++,
  t = frame;
  ImageGraphicsList = lines;
  For[pt = 1, pt <= NumBlue[t], pt++,
   ImageGraphicsList = Append[ImageGraphicsList, {Blue, Disk[BlueCoordsList[[pt]], radius]}]];
  For[pt = 1, pt <= NumRed[t], pt++,
   ImageGraphicsList = Append[ImageGraphicsList, {Red, Disk[RedCoordsList[[pt]], radius]}]];
  ImageGraphicsList = Append[ImageGraphicsList, DrawPie[2.5, 2.5, .4, FracRed[t]]];
  Video = Append[Video, Graphics[ImageGraphicsList, ImageSize -> 100]];];

(* Slow the movie down at the beginning and end to make it easier to see *)
Video = Join[
   Table[Video[[1]], {i, 1, 3}], Table[Video[[2]], {i, 1, 3}], Table[Video[[3]], {i, 1, 3}], 
   Table[Video[[4]], {i, 1, 3}], Table[Video[[5]], {i, 1, 3}], Table[Video[[6]], {i, 1, 2}],
   Table[Video[[7]], {i, 1, 2}], Table[Video[[8]], {i, 1, 2}], Table[Video[[9]], {i, 1, 2}], 
   Table[Video[[10]], {i, 1, 2}], Video[[11 ;;]], Table[Video[[NumFrames]], {i, 1, 5}]];

(* Export *)
Export["test.gif", Video, "DisplayDurations" -> {14}, "AnimationRepititions" -> Infinity]