Make a RandomChoice inside a RecurrenceTable at each time of use, rather than once at time of definition

Question

I recently watched the Numberphile video "Chaos Game" and I am trying to recreate the phenomenon discussed therein. The video depicts the following process:

• First, draw 3 points somewhere within the unit square to form the vertices A, B, and C of a triangle.
• Also draw one additional starting-point P somewhere in the unit square.
• Now iterate the following process many times:
  • Choose one of the 3 vertices A, B, or C at random.
  • Draw the point Q that is halfway between P and the chosen vertex.
  • Let Q be the new P.

To perform this process using Mathematica, I begin by defining a function to generate a random point on the unit square:

randomPoint[] := {RandomReal[], RandomReal[]}

Using this function I randomly choose 3 vertices for my triangle:

vertices = Table[randomPoint[], {3}];

Now I just need to generate a list of points to mark. The first point is chosen at random; then each successive point is the average of the previous point and a randomly chosen vertex. So I thought a RecurrenceTable might do the trick:

points = RecurrenceTable[
    {p[0] == randomPoint[], p[n+1] == Mean[{p[n], RandomChoice@vertices}]},
    p, {n, 10}];

I expected a result that looks like

ListPlot[{points, vertices},
    PlotRange -> {{0, 1}, {0, 1}}, PlotStyle -> {Black, Red}, AspectRatio -> 1, Frame -> True, FrameTicks -> None, Joined -> True, Mesh -> Full]

but instead I got

At my best guess, rather than make a new RandomChoice of vertex for each iteration of the recurrence, this seems to be making a single RandomChoice at definition-time, so I wind up always approaching halfway to the same vertex in every step. So how can I rewrite this to make an independent random choice of vertex in each step?

Answer 1

If you do not have to use RecurrenceTable you can use NestList to get the desired result:

pts = NestList[Mean[{#, RandomChoice[vertices]}] &, randomPoint[], 20];

ListPlot[{pts, vertices}, PlotRange -> {{0, 1}, {0, 1}}, 
 PlotStyle -> {Black, Red}, AspectRatio -> 1, Frame -> True, 
 FrameTicks -> None, Joined -> True, Mesh -> Full]

Answer 2

sq[n_, m_] := Module[{pts = RandomReal[1, {m + 1, 2}], p, ic, f},
  {p, ic} = {pts[[1 ;; m]], pts[[-1]]};
  f = FoldList[(#2 + #1)/2 &, ic, RandomChoice[p, n]];
  Graphics[{Green, PointSize[0.02], Point[p], Red, PointSize[0.01], 
    Point[f]}]
  ]

e.g.

Partition[Table[sq[10000, 3], 9], 3] // Grid