0
$\begingroup$

The lazy caterer's sequence, more formally known as the central polygonal numbers, describes the maximum number of pieces of a disk (a pancake or pizza is usually used to describe the situation) that can be made with a given number of straight cuts. For example, three cuts across a pancake will produce six pieces if the cuts all meet at a common point inside the circle, but up to seven if they do not. This problem can be formalized mathematically as one of counting the cells in an arrangement of lines; for generalizations to higher dimensions, see arrangement of hyperplanes.

The analogue of this sequence in three dimensions is the cake numbers. Wikipedia--Lazy caterer's sequence

How can I make a function that generates a picture of a pancake or 2D flat cake with the maximum number of pieces separated by n cuts?

I found a function based on the Wolfram Demonstration Pancake-Cutting Problem.

pie[cuts_, mult_ : 1.865] := 
 Module[{n = 2*cuts + 1}, 
  Graphics[{Brown, Disk[{0, 0}, 1], Orange, 
    Table[Line[
      1.1 {{Cos[i*2 \[Pi]/n], 
         Sin[i*2 \[Pi]/n]}, {Cos[(i + cuts)*mult*\[Pi]/n], 
         Sin[(i + cuts)*mult*\[Pi]/n]}}], {i, 1, cuts}]}, 
   ImageSize -> 400, PlotRange -> {{-1.15, 1.15}, {-1.15, 1.15}}, 
   PlotLabel -> 
    Style[Row[{cuts, 
       If[cuts == 1, " cut, ", " cuts, "], (1 + cuts (cuts + 1)/2), 
       If[cuts == 0, " piece", " pieces"]}], "Label"]]]

Here is a picture I made with the function.

enter image description here

My next question is how can I make a 3D version? This could be a geometric object such as MeshRegion so MeshRegionQ would return True.

The Wikipedia article Cake number states:

In mathematics, the cake number, denoted by Cn, is the maximum of the number of regions into which a 3-dimensional cube can be partitioned by exactly n planes. The cake number is so-called because one may imagine each partition of the cube by a plane as a slice made by a knife through a cube-shaped cake. It is the 3D analogue of the lazy caterer's sequence.

The values of Cn for n = 0, 1, 2, ... are given by 1, 2, 4, 8, 15, 26, 42, 64, 93, 130, 176, 232, ... (sequence A000125 in the OEIS).

I think the function Infinite Plane will come in handy here.

There is a related example in Neat Examples, Infinite Plane.

Graphics3D[
 Table[{Hue[RandomReal[]], 
   InfinitePlane[RandomReal[1, {3, 3}]]}, {25}], 
 Lighting -> "Neutral", PlotRange -> 1]

enter image description here

How can I make something like this Wikipedia illustration captioned

Animation showing the cutting planes required to cut a cake into 15 pieces with 4 slices (representing the 5th cake number). Fourteen of the pieces would have an external surface, with one tetrahedron cut out of the middle. ?

enter image description here

Here are some helpful references:

I was originally going to ask about the 2D case and then if that was solved ask about the 3D case but I figured out the 2D case so that can be used to generalize to 3 dimensions.

I found some helpful information on the OEIS page A000125.

Note that a(n) = a(n-1) + A000124(n-1). This has the following geometrical interpretation: Define a number of planes in space to be in general arrangement when (1) no two planes are parallel, (2) there are no two parallel intersection lines, (3) there is no point common to four or more planes. Suppose there are already n-1 planes in general arrangement, thus defining the maximal number of regions in space obtainable by n-1 planes and now one more plane is added in general arrangement. Then it will cut each of the n-1 planes and acquire intersection lines which are in general arrangement. (See the comments on A000124 for general arrangement with lines.) These lines on the new plane define the maximal number of regions in 2-space definable by n-1 straight lines, hence this is A000124(n-1). Each of this regions acts as a dividing wall, thereby creating as many new regions in addition to the a(n-1) regions already there, hence a(n) = a(n-1) + A000124(n-1). - Peter C. Heinig

The OEIS sequence A000124 also has some information that is related.

When constructing a zonohedron, one zone at a time, out of (up to) 3-d non-intersecting parallelepipeds, the n-th element of this sequence is the number of edges in the n-th zone added with the n-th "layer" of parallelepipeds. (Verified up to 10-zone zonohedron, the enneacontahedron.) E.g., adding the 10th zone to the enneacontahedron requires 46 parallel edges (edges in the 10th zone) by looking directly at a 5-valence vertex and counting visible vertices. - Shel Kaphan, Feb 16 2006

I think a good function to use is HalfSpace.

Any convex polygon in 2D can be represented as an intersection of half-spaces:

Region[RegionIntersection @@ (HalfSpace[#, 1] & /@ CirclePoints[6])]

Any convex polyhedron in 3D can be represented as an intersection of half-spaces:

Region[RegionIntersection @@ (HalfSpace[#, #] & /@ 
    Tuples[{{-1, 1}, {-1, 1}, {-1, 1}}])]

enter image description here

The challenge then becomes figuring out what half space.

Here's an example.

FoldList[Region[RegionIntersection[#1, HalfSpace[#2, {0, 0, 0}]]] &, 
 Region[Cube[]], (Take[Tuples[{{-1, 1}, {-1, 1}, {-1, 1}}], 
   3](*if you keep taking away you will have nothing left so I'm just \
taking the first 3 parts so I have something left.*))]

enter image description here

Fold[Region[RegionIntersection[#1, HalfSpace[#2, {0, 0, 0}]]] &, 
 Region[Cube[]], (Take[Tuples[{{-1, 1}, {-1, 1}, {-1, 1}}], 
   3](*if you keep taking away you will have nothing left so I'm just \
taking the first 3 parts so I have something left.*))]

enter image description here

My goal is to generate a function CakeNumberVisualization that can be used to output a region (Region and RegionQ) and Graphics3D output for a given n. For example, CakeNumberVisualization[5] would look like something similar to the Wikipedia image.

enter image description here

For an example of how Mathematica and the Wolfram Language would represent this, we can consult the versions after 13.1. New in 13.1 states in the section Geometric Computation and the subsection Mesh Regions,

VoronoiMesh (updated) -- now support 3D Voronoi decompositions.

Although there are no examples of three-dimensional Voronoi mesh decompositions on the documentation page VoronoiMesh's section Examples, there is an example in the Details and Options section.

enter image description here

$\endgroup$

2 Answers 2

1
$\begingroup$
  • A starting point.
n = 5;
colors = 
  Table[RGBColor[RandomReal[], RandomReal[], RandomReal[]], 2^n];
list = Table[None, 2^n - 1];
meshshading = 
  Nest[Partition[#, 2] &, #, n - 1] &@Insert[list, colors[[#]], #] & /@
    Range[2^n];
r = 5;
normals = 
  Normalize /@ Select[SpherePoints[2 n], Last[#] >= 0 &, n] + 
   RandomReal[{-0.1, 0}, {n, 3}];
dists = RandomReal[{0, 0.5}, n];
surfaces = 
  Table[ContourPlot3D[
    x^2 + y^2 + z^2 == r^2, {x, -r, r}, {y, -r, r}, {z, -r, r}, 
    Mesh -> {{0}, {0}, {0}}, 
    MeshFunctions -> 
     Function /@ (Slot /@ Range[3] . # & /@ normals + dists), 
    MeshShading -> meshshading[[k]], Boxed -> False, 
    Axes -> False], {k, 1, 2^n}];
cuts = ContourPlot3D[
   Thread[{x, y, z} . # & /@ normals + dists == Table[0, n]] // 
    Evaluate, {x, -r, r}, {y, -r, r}, {z, -r, r}, 
   ContourStyle -> White, Lighting -> {{"Ambient", White}}];
Show[surfaces, cuts]

enter image description here

$\endgroup$
0
$\begingroup$
split[c_, InfinitePlane[{p1_, p2_, p3_}]] := Block[{bounds, r1, r2, h},
  bounds = RegionBounds[c];
  h = HalfSpace[-Cross[p2 - p1, p3 - p1], p1];
  r1 = RegionIntersection[c, 
    BoundaryDiscretizeRegion[ h, 
     CoordinateBounds[
      Join[Transpose@bounds, Transpose[RegionBounds[h, "Finite"]]], 
      Scaled[.1]], MaxCellMeasure -> Infinity]];
  h = HalfSpace[Cross[p2 - p1, p3 - p1], p1];
  r2 = RegionIntersection[c, 
    BoundaryDiscretizeRegion[ h, 
     CoordinateBounds[
      Join[Transpose@bounds, Transpose[RegionBounds[h, "Finite"]]], 
      Scaled[.1]], MaxCellMeasure -> Infinity]];
  {r1, r2}
  ]

Randomly generate planes:

planes = Table[InfinitePlane[RandomReal[1, {3, 3}]], {5}];
pieces = 
  DeleteCases[
   Fold[With[{h = #2}, 
      Flatten[split[#, h] & /@ #1]] &, {BoundaryDiscretizeGraphics[
      Cube[]]}, planes], _EmptyRegion];

Verify it's the correct partition:

Total[Volume[pieces]]
Graphics3D[{{GrayLevel[.5, .5], pieces}, 
  Riffle[RandomColor[Length[planes]], planes]}, 
 PlotRange -> .7 Table[{-1, 1}, 3], Axes -> True, 
 Lighting -> "Neutral"]

enter image description here

Graphics3D[{Opacity[.8], {RandomColor[], 
     TransformedRegion[#, 
      TranslationTransform[.15 Normalize[RegionCentroid[#]]]]} & /@ 
   pieces}, Lighting -> "Neutral"]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.