EXPLOOT project
Ivan Cnop
icnop@vub.ac.be

Role of simulations

Can monkeys draw parabolas?

It may be surprising that placing random dots generates a parabola if we measure their distances to the origin.

Place a number of points in a square.

howmany = 100

choices = 
        Table[{2 Random[] - 1, 2 Random[] - 1}, {i, howmany}];

points = Map[Point, choices];

Show[Graphics[points],AspectRatio -> Automatic,Axes -> True,Ticks -> {{0, 0.5, 1}, {0, 0.5, 1}}]

Color version (optional)

We can color the points according to their directions:

<< Graphics`ArgColors`

complex = 
        Apply[#1 + I #2 &, Transpose[choices]];

colors = Map[ArgColor, complex];

Show[Graphics[Transpose[{colors, points}]], 
      PlotRange -> {{-1, 1}, {-1, 1}}, AspectRatio -> Automatic, 
      Axes -> True, Ticks -> {{-1, 0, 1}, {-1, 0, 1}}]

The square root

Clear[distance]

distance({x_, y_}) := (Sqrt[(x^2) + (y^2)])

alldistances = Map[distance, choices];

ordering = Sort[alldistances];

ListPlot[ordering, PlotRange -> {0, 1}]

We test if it fits a square root. This will involve a multiplicative constant that depends on the choices made (size of the square, howmany, units ...)

Fit[ordering, {Sqrt[x]}, x]

Show[{Plot[%, {x, 0, howmany}], ListPlot[ordering]}, 
      PlotRange -> {0, 1}]

An animation shows a nice fit in the beginning but less so to the right hand side. This is left out in the third graph above.

Reflecting the picture about the first diagonal

ListPlot[Table[{ordering[[i]], i/howmany}, {i, howmany}], 
      PlotRange -> {{0, 1}, All}, AspectRatio -> Automatic]

Is this a coincidence?

howmany  =  1000

choices = 
        Table[{2 Random[] - 1, 2 Random[] - 1}, {i, 
            howmany}];
points = Map[Point, choices];

Counting the points at a certain distance.

Show[Graphics[{points, Circle[{0, 0}, 1]}], AspectRatio -> Automatic, 
      Axes -> True, PlotRange -> {{-1, 1}, {-1, 1}}, 
      Ticks -> {{0, 0.5, 1}, {0, 0.5, 1}}]

Show[Graphics[{points, Table[Circle[{0, 0}, r], {r, 0.05, 1, 0.05}]}], 
      AspectRatio -> Automatic, Axes -> True, 
      PlotRange -> {{-1, 1}, {-1, 1}}, 
      Ticks -> {{0, 0.5, 1}, {0, 0.5, 1}}]

Explains why we obtain a parabola: the number of points in each circle is roughly proportional to the area of the circle.
It breaks down for a circle with radius bigger than the size of the square.

The average of a function.

Choose a number of points in an interval [a,b].

howmany = 200

xes[{a_, b_}] := 
      Table[Random[] (b - a) + a, {i, howmany}]

eindpoints = {-1, 3}

choosen = xes[eindpoints];

To see how they are spread over the interval we draw:

ListPlot[Sort[choosen]]

Take the values of a given function at these choosen points.

Clear[function, values]

function[x_] := x^2

values = function[choosen];

ListPlot[Transpose[{choosen, values}]]

We can now define the average of a function on an interval as the average of these randomly chosen values.

Plus @@ values/Length [values]

Compare this result with the integral of the function (optional)

% (Last[eindpoints] - First[eindpoints])

Integrate[function[x], {x, -1, 3}] // N

Repeat this with other choices of random numbers by clicking again on the cell bracket next to the section heading. 
After this, take higher values of howmany to see what happens.

We could use this for a defintion of the integral without using area under a curve.
For some applications in economy or probability this makes more sense as there is no natural equivalent for area in these settings.