How to recursively subdivide a quadrilateral?

Question

I have the following problem which is most easily described by this diagram:

We start off with a quadrilateral, not necessarily a square, with four fixed points, here represented in green. We have a fifth point p, here shown in red. At the start, the user can freely place this point anywhere in the initial quad. This could be a Locator in a Manipulate for example. In the remaining iterations, this point is just the centroid of the enclosing quad.

The algorithm looks something like this:

1. Calculate the blue midpoints of the four edges of the current quad enclosing the red point.
2. Create four new quads by joining the midpoints up to the red point. The red point is custom on the first iteration, and after that is just the centroid of the quad.
3. Repeat, continuing to recursively subdivide each new quad until reaching some maximum depth.

One avenue I am exploring is adapting the code from this question but I want most of all to be able to move the seed (red) point around interactively.

Answer 1

ClearAll[splitCoords, step, recursiveSubdivide]

splitCoords = Map[Append[#2]]@
  Partition[RotateRight @ 
    Riffle[#, MovingAverage[Join[#, {First@#}], 2]], 3, 2,1] &;

step = ReplaceAll[p_Polygon :> 
  Module[{rc = RegionCentroid[p], mc = MeshCoordinates[p]}, 
     Map[Polygon] @ splitCoords[mc, rc]]];


recursiveSubdivide[rp_, n_, opts : OptionsPattern[]] /; n >= 1 := 
 DynamicModule[{p = RegionCentroid[rp], mc = MeshCoordinates[rp]}, 
  Deploy @ Graphics[{EdgeForm[Gray], 
     Dynamic @ Map[{{Opacity[.5], FaceForm[RandomColor[]], #} & /@ 
        Nest[Flatten @* step, Polygon @ #, n]} &] @ splitCoords[mc, p], 
     Locator[Dynamic@p]}, opts]]

Examples:

SeedRandom[777];
rp = RandomPolygon[{"Convex", 4}];

recursiveSubdivide[rp, 1, ImageSize -> Medium]

recursiveSubdivide[rp, 3, ImageSize -> Medium]

Answer 2

a starting point.

Clear["Global`*"];
split[polygon_] := Module[{ab, bc, cd, da, centroid},
   {a, b, c, d} = MeshPrimitives[polygon, 1][[;; , 1]][[;; , 1]];
   ab = Mean[{a, b}]; bc = Mean[{b, c}]; cd = Mean[{c, d}];
   da = Mean[{d, a}];
   centroid = RegionCentroid@Polygon@{a, b, c, d};
   {Polygon[{centroid, ab, b, bc}], Polygon[{centroid, bc, c, cd}],
    Polygon[{centroid, cd, d, da}],
    Polygon[{centroid, da, a, ab}]}
   ];
poly = RandomPolygon[{"Convex", 4}];
Graphics[{{RandomColor[], #} & /@ 
   Flatten@Rest@NestList[Flatten@*Map[split], {poly}, 3]}]