Function Repository Resource:

BelochFold

Source Notebook

Return the fold that maps two points to two lines

Contributed by: Ed Pegg Jr

ResourceFunction["BelochFold"][{p1,l1},{p2,l2}]

returns the fold(s) that maps points p1 and p2 to lines l1 and l2.

Details

Beloch folds originate in computational origami.
In origami, their are seven Huzita–Hatori axioms: 1. Fold through two points (line through two points). 2. Fold a point onto another point (perpendicular bisector). 3. Fold a line onto a line (angle bisector). 4. Fold through a point perpendicular to a line (line through a point perpendicular to a line). 5. Fold a point onto a line, passing the crease through another point (tangent to a parabola). 6. Fold a point onto a line and another point onto another line (common tangent to two parabolas). 7. Fold a point onto a line, making the crease perpendicular to another line (tangent to a parabola perpendicular to a line).
The sixth axiom was found in 1936 by Margherita Beloch. This fold is now named the Beloch fold, and can be used in origimi to solve various problems that cannot be solved with ruler and compass.
For a given set of two points and two lines, there can be 0, 1, 2 or 3 solutions. Most of the solutions arise from cubic equations.

Examples

Basic Examples (2) 

Find the fold that maps the two given points to the y and x axes:

In[1]:=
{p1, p2} = {{-4, 1}, {-2, 2}};
{yaxis, xaxis} := {{{0, 0}, {0, 1}}, {{0, 0}, {1, 0}}};
folds = ResourceFunction["BelochFold"][{p1, yaxis}, {p2, xaxis}][[
   1]] // RootReduce
Out[3]=

With this fold, show the origami solution to the duplication of the cube problem:

In[4]:=
cube2 = (folds[[1]] + #) & /@ {{0, 0}, {1, 0}, {1, 2^(1/3)}};
newpoints = ResourceFunction["ReflectPoints"][#, {p1, p2}] & /@ {folds};
Graphics[{ {Black, Dashed, InfiniteLine@folds},
  AbsolutePointSize[5], EdgeForm[Black],
  Line[{{-4, 0}, {3, 0}}], Line[{{0, -3}, {0, 4}}],
  {Blue, Line[cube2]},
  Style[Text[1, Mean[Take[cube2, 2]] - {0, .3}], 14],
  Style[Text[2^(1/3), Mean[Take[cube2, -2]] + {.3, 0}], 14],
  Text[#, # + {0, .2}] & /@ {p1, p2},
   Red, Point[{p1, p2}], Green, Point /@ newpoints}]
Out[5]=

Find the folds that map two points to the y and x axes:

In[6]:=
{p1, p2} = {{-Sqrt[3], -1}, {Sqrt[3], 1}};
{yaxis, xaxis} := {{{0, 0}, {0, 1}}, {{0, 0}, {1, 0}}};
folds = ResourceFunction["BelochFold"][{p1, yaxis}, {p2, xaxis}] // RootReduce
Out[8]=

Show the origami steps to fold a regular nonagon:

In[9]:=
newpoints = ResourceFunction["ReflectPoints"][#, {p1, p2}] & /@ folds; Graphics[{ {Black, Dashed, InfiniteLine@# & /@ folds, LightGray,
    InfiniteLine@(# {-1, 1}) & /@ folds, Cyan,
   InfiniteLine@# & /@ Subsets[CirclePoints[3]/Cos[\[Pi]/3], {2}]},
  AbsolutePointSize[5], EdgeForm[Black], {White, Polygon[CirclePoints[9]/Cos[\[Pi]/9]]},
  Line[{{-4, 0}, {3, 0}}], Line[{{0, -3}, {0, 4}}],
  Text[#, # + {0, .2}] & /@ {p1, p2},
   Red, Point[{p1, p2}], Green, Point /@ newpoints}]
Out[9]=

Scope (2) 

Find the fold that map the two given points to the y and x axes:

In[10]:=
{p1, p2} = {{-2, 0}, {-1, 2}};
{yaxis, xaxis} := {{{0, 0}, {0, 1}}, {{0, 0}, {1, 0}}};
folds = ResourceFunction["BelochFold"][{p1, yaxis}, {p2, xaxis}][[
   1]] // RootReduce
Out[11]=

With this fold, show the origami solution for the plastic constant:

In[12]:=
rho = First[m /. Solve[m^3 == m + 1]];
plastic = (folds[[1]] + #) & /@ {{0, 0}, {1, 0}, {1, rho}};
newpoints = ResourceFunction["ReflectPoints"][#, {p1, p2}] & /@ {folds};
Graphics[{ {Black, Dashed, InfiniteLine@folds},
  AbsolutePointSize[5], EdgeForm[Black],
  Line[{{-4, 0}, {3, 0}}], Line[{{0, -3}, {0, 4}}],
  {Blue, Line[plastic]},
  Style[Text[1, Mean[Take[plastic, 2]] - {0, .3}], 14],
  Style[Text["\[Rho]", Mean[Take[plastic, -2]] + {.3, 0}], 14],
  Text[#, # + {0, .2}] & /@ {p1, p2},
   Red, Point[{p1, p2}], Green, Point /@ newpoints}]
Out[13]=

Fold two points to two arbitrary lines:

In[14]:=
{p1, p2} = {{-2, 1}, {-1, 2}};
{l1, l2} := {{{-1, 0}, {0, 1}}, {{0, 2}, {2, 0}}};
folds = ResourceFunction["BelochFold"][{p1, l1}, {p2, l2}] // RootReduce
Out[15]=

Show the fold:

In[16]:=

newpoints = ResourceFunction["ReflectPoints"][#, {p1, p2}] & /@ folds;
Graphics[{ {Black, Dashed, InfiniteLine@# & /@ folds,
   Cyan, InfiniteLine@# & /@ {l1, l2}},
  AbsolutePointSize[5], EdgeForm[Black],
  Line[{{-4, 0}, {3, 0}}], Line[{{0, -3}, {0, 4}}],
  Text[#, # + {0, .2}] & /@ {p1, p2},
   Red, Point[{p1, p2}], Green, Point /@ newpoints}]
Out[17]=

Neat Examples (2) 

Find the folds that map two given points to the y and x axes:

In[18]:=
{p1, p2} = {{-1, -1/2}, {0, 1}};
{yaxis, xaxis} := {{{0, 0}, {0, 1}}, {{0, 0}, {1, 0}}};
folds = ResourceFunction["BelochFold"][{p1, yaxis}, {p2, xaxis}] // RootReduce
Out[20]=

Show the starting origami step for folding a regular heptagon:

In[21]:=
newpoints = ResourceFunction["ReflectPoints"][#, {p1, p2}] & /@ folds;
moveheptagon = ((# - CirclePoints[7][[1]] + folds[[3, 1]]) & /@ CirclePoints[7]) // RootReduce; Graphics[{ {Black, Dashed, InfiniteLine@# & /@ {folds[[3]]}
   },
  AbsolutePointSize[5], EdgeForm[Black],
  Line[{{-4, 0}, {3, 0}}], Line[{{0, -3}, {0, 4}}],
  Line[moveheptagon],
  Text[#, # + {0, .2}] & /@ {p1, p2},
   Red, Point[{p1, p2}], Green, Point /@ {newpoints[[3]]}}]
Out[22]=

Requirements

Wolfram Language 14.0 (January 2024) or above

Version History

  • 1.0.0 – 12 May 2025

Related Resources

License Information