MovingSofas: A companion Mathematica package to the paper “Differential equations and exact solutions in the moving sofa problem”

Dan Romik
Department of Mathematics
University of California, Davis
romik@math.ucdavis.edu

Package version: 1.3 (released July 10, 2016)
See the end of the notebook for a log of changes from earlier versions
Created with Mathematica version 10.3

Table of contents

1.	Introduction
2.	Initialization code
3.	Formulas for the contact paths in Gerver’s sofa
4.	Formulas for the contact paths in the shape Σ
5.	Verifying the ODE general form solutions
6.	Solving the equations for Gerver’s sofa (quick and easy, purely numerical method)
7.	Solving the equations for Gerver’s sofa (second, more algebraic method)
8.	Computing the area of Gerver’s sofa
9.	Solving the equations for the shape Σ (quick and easy numerical method)
10.	Solving the equations for the shape Σ (algebraic, closed form solutions)
11.	Closed form evaluation of the area of the shape Σ
12.	Computation of the minimal polynomials of the parameters of the shape Σ
13.	Verification of the algebraic curve formulas for boundary segments of Σ
14.	Some fun interactive visualizations
15.	Package documentation
16.	Change log

1. Introduction

The moving sofa problem asks for the planar shape of maximal area that can be moved around a right-angled corner in a hallway of unit width. The history and mathematical background to the problem is described in my paper “Differential equations and exact solutions in the moving sofa problem”, which also contains new results on the problem. This Mathematica package includes code and computations that give a way of verifying some of the claims I make in my paper. The package also includes interactive visualizations that make it possible to acquire a good understanding of the moving sofa problem, Hammersley’s sofa, Gerver’s sofa conjectured to be the solution of the moving sofa problem, and the new shape Σ I construct in my paper and that may be a solution to a version of the problem called the “ambidextrous moving sofa problem,” where the clas of shapes over which we try to maximize the areas are shapes that can be moved around right-angled corners both to the right and to the left.

Here’s how to use the package: first, evaluate the initialization code in Section 2 below to load various function and variable definitions. There is a lot of code and the initialization involves some algebraic simplifications, so it may take Mathematica a few seconds. Once this is done, open any of the sections and evaluate the code there, reading the explanations of what the code is doing and how the computation relates to the claims made in the paper.

Section 14 is not related to specific claims from the paper but includes interactive graphical visualizations that illustrate the process of moving different sofa shapes around a corner. 

Section 15 includes some documentation of the code (in case you want to modify or extend it, although it is not necessary to look at the code to read and understand the notebook). Section 16 lists a log of the changes since the initial version release.

Enjoy!

2. Initialization code

(* IMPORTANT NOTE: Evaluate this code before running anything else in the other sections *)

(Subscript[x, 1])[t_]:=RotationMatrix[t].{(Subscript[a, 1])Cos[t]+(Subscript[a, 2])Sin[t]-1,-(Subscript[a, 2])Cos[t]+(Subscript[a, 1])Sin[t]-(1/2)}+{(Subscript[κ, 1,1]),(Subscript[κ, 1,2])};
(Subscript[x, 2])[t_]:=RotationMatrix[t].{-(1/4)(t^2)+(Subscript[b, 1])t+(Subscript[b, 2]),(1/2)t-(Subscript[b, 1])-1}+{(Subscript[κ, 2,1]),(Subscript[κ, 2,2])};
(Subscript[x, 3])[t_]:=RotationMatrix[t].{(Subscript[c, 1])-t,(Subscript[c, 2])+t}+{(Subscript[κ, 3,1]),(Subscript[κ, 3,2])};
(Subscript[x, 4])[t_]:=RotationMatrix[t].{-(1/2)t+(Subscript[d, 1])-1,-(1/4)(t^2)+(Subscript[d, 1])t+(Subscript[d, 2])}+{(Subscript[κ, 4,1]),(Subscript[κ, 4,2])};
(Subscript[x, 5])[t_]:=RotationMatrix[t].{(Subscript[e, 1])Cos[t]+(Subscript[e, 2])Sin[t]-(1/2),-(Subscript[e, 2])Cos[t]+(Subscript[e, 1])Sin[t]-1}+{(Subscript[κ, 5,1]),(Subscript[κ, 5,2])};
(Subscript[x, 6])[t_]:=RotationMatrix[t].{(Subscript[f, 1])Cos[t/2]+(Subscript[f, 2])Sin[t/2]-1,-(Subscript[f, 2])Cos[t/2]+(Subscript[f, 1])Sin[t/2]-1}+{(Subscript[κ, 6,1]),(Subscript[κ, 6,2])};

μ[t_]:={Cos[t],Sin[t]};
ν[t_]:={-Sin[t],Cos[t]};

(Subscript[A, j_])[t_]:=Collect[Simplify[(Subscript[x, j])[t]+μ[t]+((Subscript[x, j])'[t].μ[t])ν[t]],{Cos[t],Sin[t]}];
(Subscript[B, j_])[t_]:=Collect[Simplify[(Subscript[x, j])[t]+((Subscript[x, j])'[t].μ[t])ν[t]],{Cos[t],Sin[t]}];
(Subscript[C, j_])[t_]:=Collect[Simplify[(Subscript[x, j])[t]+ν[t]-((Subscript[x, j])'[t].ν[t])μ[t]],{Cos[t],Sin[t]}];
(Subscript[D, j_])[t_]:=Collect[Simplify[(Subscript[x, j])[t]-((Subscript[x, j])'[t].ν[t])μ[t]],{Cos[t],Sin[t]}];

Gerverx[t_]:=({{\[Piecewise], ({{(Subscript[x, 1])[t], 0≤t<ϕ}, {(Subscript[x, 2])[t], ϕ≤t<θ}, {(Subscript[x, 3])[t], θ≤t<π/2-θ}, {(Subscript[x, 4])[t], π/2-θ≤t<π/2-ϕ}, {(Subscript[x, 5])[t], π/2-ϕ≤t≤π/2}})}})
GerverA[t_]:=({{\[Piecewise], ({{(Subscript[A, 1])[t], 0≤t<ϕ}, {(Subscript[A, 2])[t], ϕ≤t<θ}, {(Subscript[A, 3])[t], θ≤t<π/2-θ}, {(Subscript[A, 4])[t], π/2-θ≤t<π/2-ϕ}, {(Subscript[A, 5])[t], π/2-ϕ≤t≤π/2}})}})
GerverB[t_]:=({{\[Piecewise], ({{(Subscript[B, 1])[t], 0≤t<ϕ}, {(Subscript[B, 2])[t], ϕ≤t<θ}, {(Subscript[B, 3])[t], θ≤t<π/2-θ}, {(Subscript[B, 4])[t], π/2-θ≤t<π/2-ϕ}, {(Subscript[B, 5])[t], π/2-ϕ≤t≤π/2}})}})
GerverC[t_]:=({{\[Piecewise], ({{(Subscript[C, 1])[t], 0≤t<ϕ}, {(Subscript[C, 2])[t], ϕ≤t<θ}, {(Subscript[C, 3])[t], θ≤t<π/2-θ}, {(Subscript[C, 4])[t], π/2-θ≤t<π/2-ϕ}, {(Subscript[C, 5])[t], π/2-ϕ≤t≤π/2}})}})
GerverD[t_]:=({{\[Piecewise], ({{(Subscript[D, 1])[t], 0≤t<ϕ}, {(Subscript[D, 2])[t], ϕ≤t<θ}, {(Subscript[D, 3])[t], θ≤t<π/2-θ}, {(Subscript[D, 4])[t], π/2-θ≤t<π/2-ϕ}, {(Subscript[D, 5])[t], π/2-ϕ≤t≤π/2}})}})

Ambix[t_]:=({{\[Piecewise], ({{(Subscript[x, 1])[t], 0≤t<β}, {(Subscript[x, 6])[t], β≤t<π/2-β}, {(Subscript[x, 5])[t], π/2-β≤t≤π/2}})}})

AmbiA[t_]:=({{\[Piecewise], ({{(Subscript[A, 1])[t], 0≤t<β}, {(Subscript[A, 6])[t], β≤t<π/2-β}, {(Subscript[A, 5])[t], π/2-β≤t≤π/2}})}})

AmbiB[t_]:=({{\[Piecewise], ({{(Subscript[B, 1])[t], 0≤t<β}, {(Subscript[B, 6])[t], β≤t<π/2-β}, {(Subscript[B, 5])[t], π/2-β≤t≤π/2}})}})

AmbiC[t_]:=({{\[Piecewise], ({{(Subscript[C, 1])[t], 0≤t<β}, {(Subscript[C, 6])[t], β≤t≤π/2-β}, {(Subscript[C, 5])[t], π/2-β≤t≤π/2}})}})

AmbiD[t_]:=({{\[Piecewise], ({{(Subscript[D, 1])[t], 0≤t<β}, {(Subscript[D, 6])[t], β≤t<π/2-β}, {(Subscript[D, 5])[t], π/2-β≤t≤π/2}})}})

GerverEquations={
  (Subscript[e, 1])==(Subscript[a, 1]),
  (Subscript[e, 2])==-(Subscript[a, 2]),
  (Subscript[d, 1])==(π/4)-(Subscript[b, 1]),
  (Subscript[d, 2])==(Subscript[b, 2])+(π/4)(2(Subscript[b, 1])-(π/4)),
  (Subscript[c, 2])==(Subscript[c, 1])-(π/2),
  (Subscript[κ, 1,1])==1-(Subscript[a, 1]),
  (Subscript[κ, 1,2])==1/2+(Subscript[a, 2]),
  (Subscript[κ, 1,2])==-(Subscript[a, 2]),
  (Subscript[x, 1])[ϕ][[1]] == (Subscript[x, 2])[ϕ][[1]],
  (Subscript[x, 1])[ϕ][[2]] == (Subscript[x, 2])[ϕ][[2]],
  (Subscript[x, 1])'[ϕ][[1]] == (Subscript[x, 2])'[ϕ][[1]],
  (Subscript[x, 1])'[ϕ][[2]] == (Subscript[x, 2])'[ϕ][[2]],
  (Subscript[x, 2])[θ][[1]] == (Subscript[x, 3])[θ][[1]],
  (Subscript[x, 2])[θ][[2]] == (Subscript[x, 3])[θ][[2]],
  (Subscript[x, 2])'[θ][[1]] == (Subscript[x, 3])'[θ][[1]],
  (Subscript[x, 2])'[θ][[2]] == (Subscript[x, 3])'[θ][[2]],
  (Subscript[x, 3])[π/2-θ][[1]] == (Subscript[x, 4])[π/2-θ][[1]],
  (Subscript[x, 3])[π/2-θ][[2]] == (Subscript[x, 4])[π/2-θ][[2]],
  (Subscript[x, 3])'[π/2-θ][[1]] == (Subscript[x, 4])'[π/2-θ][[1]],
  (Subscript[x, 3])'[π/2-θ][[2]] == (Subscript[x, 4])'[π/2-θ][[2]],
  (Subscript[x, 4])[π/2-ϕ][[1]] == (Subscript[x, 5])[π/2-ϕ][[1]],
  (Subscript[x, 4])[π/2-ϕ][[2]] == (Subscript[x, 5])[π/2-ϕ][[2]],
  (Subscript[x, 4])'[π/2-ϕ][[1]] == (Subscript[x, 5])'[π/2-ϕ][[1]],
  (Subscript[x, 4])'[π/2-ϕ][[2]] == (Subscript[x, 5])'[π/2-ϕ][[2]],
  (Subscript[x, 1])[ϕ][[1]] == (Subscript[B, 3])[π/2-θ][[1]],
  (Subscript[x, 1])[ϕ][[2]] == (Subscript[B, 3])[π/2-θ][[2]],
  (Subscript[x, 5])[π/2-ϕ][[1]] == (Subscript[D, 2])[θ][[1]],
  (Subscript[x, 5])[π/2-ϕ][[2]] == (Subscript[D, 2])[θ][[2]]
};

AmbidextrousEquations={
  (* equation (48) in the paper *) (Subscript[e, 1])==(Subscript[a, 1]), 
  (* equation (49) in the paper *) (Subscript[e, 2])==-(Subscript[a, 2]),
  (* equation (50) in the paper *) (Subscript[f, 2])==(1-(Sqrt[2]))(Subscript[f, 1]),
  (* equation (51) in the paper *) (Subscript[κ, 1,1])==1-(Subscript[a, 1]),
  (* equation (52) in the paper *) (Subscript[κ, 1,2])==1/2+(Subscript[a, 2]),
  (* equation (53) in the paper *) (Subscript[κ, 1,2])==1/2-(Subscript[a, 2]),
  (* x-component of equation (54) in the paper *) (Subscript[x, 1])[β][[1]] == (Subscript[x, 6])[β][[1]],
  (* y-component of equation (54) in the paper *) (Subscript[x, 1])[β][[2]] == (Subscript[x, 6])[β][[2]],
  (* x-component of equation (55) in the paper *) (Subscript[x, 1])'[β][[1]] == (Subscript[x, 6])'[β][[1]],
  (* y-component of equation (55) in the paper *) (Subscript[x, 1])'[β][[2]] == (Subscript[x, 6])'[β][[2]],
  (* x-component of equation (56) in the paper *) (Subscript[x, 6])[π/2-β][[1]] == (Subscript[x, 5])[π/2-β][[1]],
  (* y-component of equation (56) in the paper *) (Subscript[x, 6])[π/2-β][[2]] == (Subscript[x, 5])[π/2-β][[2]],
  (* x-component of equation (57) in the paper *) (Subscript[x, 6])'[π/2-β][[1]] == (Subscript[x, 5])'[π/2-β][[1]],
  (* y-component of equation (57) in the paper *) (Subscript[x, 6])'[π/2-β][[2]] == (Subscript[x, 5])'[π/2-β][[2]],
  (* x-component of equation (58) in the paper *) (Subscript[x, 1])[β][[1]] == (Subscript[B, 1])[β][[1]],
  (* y-component of equation (58) in the paper *) (Subscript[x, 1])[β][[2]] == (Subscript[B, 1])[β][[2]],
  (* x-component of equation (59) in the paper *) (Subscript[x, 5])[π/2-β][[1]] == (Subscript[D, 2])[π/2-β][[1]],
  (* y-component of equation (59) in the paper *) (Subscript[x, 5])[π/2-β][[2]] == (Subscript[D, 2])[π/2-β][[2]],
  (* equation (60) in the paper *) (Subscript[x, 1])'[β].μ[β]==0
};

GerverAngleϕ=0.0391773647900836418632178752424;
GerverAngleθ=0.681301509382724894473855757083;
GerverPrecomputedNumericalArea=2.21953166887196742554628410079679;
  
GerverPrecomputedNumericalConstants= {
  ϕ->0.0391773647900836418632178752424, 
  θ->0.681301509382724894473855757083, 
  (Subscript[κ, 1,1])->-0.210322422072688751416185718488, 
  (Subscript[κ, 1,2])->1/4, 
  (Subscript[κ, 2,1])->-0.919179292771593322274696102894,
  (Subscript[κ, 2,2])->0.472406619750805465181760762512,
  (Subscript[κ, 3,1])->-0.613763229430251668554914291318,
  (Subscript[κ, 3,2])->0.889626479003221860727043050048, 
  (Subscript[κ, 4,1])->-0.308347166088910014835132479741,
  (Subscript[κ, 4,2])->0.472406619750805465181760762512,
  (Subscript[κ, 5,1])->-1.01720403678781458569364286415,
  (Subscript[κ, 5,2])->1/4,
  (Subscript[a, 1])->1.21032242207268875141618571849,
  (Subscript[a, 2])->-1/4,
  (Subscript[b, 1])->-0.527624598026784624160503809373,
  (Subscript[b, 2])->0.920258385160637622893705795012,
  (Subscript[c, 1])->0.626045522848465867552329310386,
  (Subscript[c, 2])->-0.944750803946430751678992381254,
  (Subscript[d, 1])->1.31302276142423293377616465519,
  (Subscript[d, 2])->-0.525382670414554437202836294305,
  (Subscript[e, 1])->1.21032242207268875141618571849,
  (Subscript[e, 2])->1/4
};

AmbidextrousAngleβ=0.289653820817320941743521611736;

AmbidextrousPrecomputedNumericalConstants = {
  β->0.289653820817320941743521611736,
  (Subscript[κ, 1,1])->0.124712637587267758739932415305,
  (Subscript[κ, 1,2])->1/2,
  (Subscript[κ, 6,1])->-0.167049816550309655013423446260,
  (Subscript[κ, 6,2])->1/2,
  (Subscript[κ, 5,1])->-0.458812270687887068766779307825,
  (Subscript[κ, 5,2])->1/2,
  (Subscript[a, 1])->0.875287362412732241260067584695,
  (Subscript[a, 2])->0,
  (Subscript[f, 1])->1.20293890815691138907022280034,
  (Subscript[f, 2])->-0.498273610464875672029397859080,
  (Subscript[e, 1])->0.875287362412732241260067584695,
  (Subscript[e, 2])->0
};


AmbidextrousSymbolicBeta=ArcTan[(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3)))];
AmbidextrousSymbolicBetaAlternative=ArcTan[((((Sqrt[2])+1))^(1/3))]-ArcTan[((((Sqrt[2])-1))^(1/3))];
AmbidextrousSymbolicTanBeta=(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3)));
AmbidextrousSymbolicCosineBeta=(1/2) (-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3)));
AmbidextrousSymbolicCosineBetaOverTwo=(1/2) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicSineBetaOverTwo=(1/2) (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicaOne=(1/4)(Sqrt[4+(((71+8(Sqrt[2])))^(1/3))+(((71-8(Sqrt[2])))^(1/3))]);
AmbidextrousSymbolicKappaOneOne=1-AmbidextrousSymbolicaOne;
AmbidextrousSymbolicKappaSixOne=1-(4/3)AmbidextrousSymbolicaOne;
AmbidextrousSymbolicKappaFiveOne=1-(5/3)AmbidextrousSymbolicaOne;
AmbidextrousSymbolicfOne=(1/(3(Sqrt[2(2-(Sqrt[2]))])))(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4));
AmbidextrousSymbolicfTwo=-((Sqrt[2-(Sqrt[2])])/6)(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4));
AmbidextrousSymbolicAreaMinusBeta=(((3-2 (Sqrt[2])))^(1/3))+(((3+2 (Sqrt[2])))^(1/3))-1;
AmbidextrousSymbolicArea=(((3+2 (Sqrt[2])))^(1/3))+(((3-2 (Sqrt[2])))^(1/3))-1+ArcTan[(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3)))];
AmbidextrousSymbolicaSofaLength=(2/3)(Sqrt[4+(((71+8(Sqrt[2])))^(1/3))+(((71-8(Sqrt[2])))^(1/3))]);


GerverxNumerical:=Function[t,Gerverx[t]/.GerverPrecomputedNumericalConstants];
GerverANumerical:=Function[t,GerverA[t]/.GerverPrecomputedNumericalConstants];
GerverBNumerical:=Function[t,GerverB[t]/.GerverPrecomputedNumericalConstants];
GerverCNumerical:=Function[t,GerverC[t]/.GerverPrecomputedNumericalConstants];
GerverDNumerical:=Function[t,GerverD[t]/.GerverPrecomputedNumericalConstants];

AmbixNumerical:=Function[t,Ambix[t]/.AmbidextrousPrecomputedNumericalConstants];
AmbiANumerical:=Function[t,AmbiA[t]/.AmbidextrousPrecomputedNumericalConstants];
AmbiBNumerical:=Function[t,AmbiB[t]/.AmbidextrousPrecomputedNumericalConstants];
AmbiCNumerical:=Function[t,AmbiC[t]/.AmbidextrousPrecomputedNumericalConstants];
AmbiDNumerical:=Function[t,AmbiD[t]/.AmbidextrousPrecomputedNumericalConstants];

SofaDefaultNumSubdivisionPoints=300;
SofaDefaultFillingColor=RGBColor[1,1,0.87];
SofaHallwayDefaultFillingColor=GrayLevel[0.75];
SquareSofaDefaultFillingColor=RGBColor[0.95,1,0.9];
SemicircleSofaDefaultFillingColor=RGBColor[1,1,0.85];
HammersleySofaDefaultFillingColor=RGBColor[0.9,0.9,1];
GerverSofaDefaultFillingColor=RGBColor[0.9,0.83,1];
AmbidextrousSofaDefaultFillingColor=RGBColor[1,0.8,0.7];

SofaHallway[armlength_]:={
  EdgeForm[None],
  SofaHallwayDefaultFillingColor,
  AbsoluteThickness[1.5],
    Polygon[{{-armlength,0},{0,0},{0,-armlength},{1,-armlength},{1,1},{-armlength,1}}],
  {Black,Line[{{-armlength,0},{0,0},{0,-armlength}}],
         Line[{{-armlength,1},{1,1},{1,-armlength}}]}
};

SofaHallwayTwoCorners[armlength_]:={
  EdgeForm[None],
  SofaHallwayDefaultFillingColor,
  AbsoluteThickness[1.5],
    Polygon[{{-armlength,0},{0,0},{0,-armlength},{armlength+1,-armlength},{armlength+1,-armlength+1},{1,-armlength+1},{1,1},{-armlength,1}}],
  {Black,Line[{{-armlength,0},{0,0},{0,-armlength},{armlength+1,-armlength}}],
         Line[{{-armlength,1},{1,1},{1,-armlength+1},{armlength+1,-armlength+1}}]}
};

SquareSofa={
  EdgeForm[{Black,AbsoluteThickness[2]}],
  SofaDefaultFillingColor,
  Polygon[{{0,0},{1,0},{1,1},{0,1}}]
};

SemicircleSofa={
  EdgeForm[{Black,AbsoluteThickness[2]}],
  SofaDefaultFillingColor,
  Disk[{0,0},1,{0,π}]
};

SemicircleSofaRotationPath:=Function[t,{0,0}];

HammersleyGeneralizedSofa[innerradius_]:={
  EdgeForm[{Black,AbsoluteThickness[1.5]}],
  SofaDefaultFillingColor,
  If[innerradius==0,SemicircleSofa,
    Polygon[
      Join[
        Table[{Cos[t],Sin[t]},{t,0.0,π/2-(10^(-8)),((π/2)/SofaDefaultNumSubdivisionPoints)}],
        {{0,1},{-2innerradius,1}},
        Table[{-2innerradius+Cos[t],Sin[t]},{t,π/2,π-(10^(-8)),((π/2)/SofaDefaultNumSubdivisionPoints)}],
        {{-2innerradius,0},{-2innerradius,0}},
        Table[{-innerradius+innerradius Cos[t],innerradius Sin[t]},
                   {t,π-(π/(Ceiling[innerradius×SofaDefaultNumSubdivisionPoints])),0,-(π/(Ceiling[innerradius×SofaDefaultNumSubdivisionPoints]))}]
      ]
    ]
  ]
};

HammersleySofa:=HammersleyGeneralizedSofa[2/π];

HammersleyGeneralizedSofaRotationPath[innerradius_]:=Function[t,{-innerradius+innerradius Cos[2t],innerradius Sin[2t]}];

HammersleySofaRotationPath:=Function[t,{-(2/π)+(2/π) Cos[2t],(2/π) Sin[2t]}];

HammersleyGeneralizedSofaArea[r_]:=(π/2)+r(2-(π/2)r);

HammersleyGeneralizedSofaContactPoints[r_,angle_]:={
  {0,0},
  {-2r,0},
  r{Cos[2angle]-1,Sin[2angle]},
  {Cos[angle],Sin[angle]},
  {-2r-Sin[angle],Cos[angle]}
};

HammersleySofaContactPoints[angle_]:={
  {0,0},
  {-4/π,0},
  (2/π){Cos[2angle]-1,Sin[2angle]},
  {Cos[angle],Sin[angle]},
  {-4/π-Sin[angle],Cos[angle]}
};

SofaRotatedWithHallwayGraphics[armlength_,sofagraphics_,rotationpath_,angle_]:=Graphics[{
  SofaHallway[armlength],
  Rotate[Translate[sofagraphics,-rotationpath[angle]],-angle,{0,0}]
}];

SofaWithRotatedHallwayGraphics[armlength_,sofagraphics_,rotationpath_,angle_,plotrange_]:=Graphics[{
  Translate[Rotate[SofaHallway[armlength],angle,{0,0}],rotationpath[angle]],
  sofagraphics
},PlotRange->plotrange];

SofaMovieWithHallway[armlength_,xinitial_,sofagraphics_,rotationpath_,time_]:=Graphics[{
  SofaHallway[armlength],
  If[time≤1,Translate[sofagraphics,{-xinitial×(1-time),0}],
    If[time≤2,Rotate[Translate[sofagraphics,-rotationpath[(π/2)(time-1)]],-(π/2)(time-1),{0,0}],
      Translate[Rotate[Translate[sofagraphics,-rotationpath[(π/2)]],-(π/2),{0,0}],
          {0,-xinitial×(time-2)}]
    ]
  ]
}];

SofaMovieWithHallwayTwoCorners[armlength_,leftendpoint_,sofagraphics_,rotationpath_,time_]:=Module[{basebpoint,xinitial},
xinitial=armlength+leftendpoint;
Graphics[{
  SofaHallwayTwoCorners[armlength],
  If[time≤1,Translate[sofagraphics,{-xinitial×(1-time),0}],
    If[time≤2,Rotate[Translate[sofagraphics,-rotationpath[(π/2)(time-1)]],-(π/2)(time-1),{0,0}],
      If[time≤3,Translate[Rotate[Translate[sofagraphics,-rotationpath[(π/2)]],-(π/2),{0,0}],
          {0,-xinitial×(time-2)}],
        If[time≤4,
            basepoint=rotationpath[(π/2)(4-time)];
            basepoint[[1]]=rotationpath[(π/2)][[1]]-basepoint[[1]]; basepoint[[2]]=1-basepoint[[2]];
            Translate[Rotate[Translate[sofagraphics,-basepoint],-(π/2)(4-time),{0,0}],{1,-armlength+1}],
          If[time≤5,Translate[sofagraphics,{-rotationpath[(π/2)][[1]]+1+xinitial×(time-4),-armlength}],{}]
         ]
       ]
     ]
   ]
}]];

GerverSofaCurveSegment1=Table[GerverxNumerical[t],{t,GerverAngleϕ,π/2-GerverAngleϕ,(π/2-GerverAngleϕ)/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaCurveSegment2=Table[GerverDNumerical[t],{t,GerverAngleθ,0,-(π/2-GerverAngleθ)/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaCurveSegment3=Table[GerverCNumerical[t],{t,π/2,GerverAngleϕ,-(π/2-GerverAngleϕ)/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaCurveSegment4=Table[GerverANumerical[t],{t,π/2,GerverAngleϕ,-(π/2-GerverAngleϕ)/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaCurveSegment5=Table[GerverBNumerical[t],{t,π/2,π/2-GerverAngleθ,-GerverAngleθ/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaCurveSegmentsCombined=Join[GerverSofaCurveSegment1,GerverSofaCurveSegment2,GerverSofaCurveSegment3,GerverSofaCurveSegment4,GerverSofaCurveSegment5];
GerverSofaRotationPathDashedSegment1=Table[GerverxNumerical[t],{t,0,GerverAngleϕ,GerverAngleϕ/Floor[SofaDefaultNumSubdivisionPoints/5]}];
GerverSofaRotationPathDashedSegment2=Table[GerverxNumerical[t],{t,π/2-GerverAngleϕ,π/2,GerverAngleϕ/Floor[SofaDefaultNumSubdivisionPoints/5]}];

GerverSofa:={
  EdgeForm[{Black,AbsoluteThickness[1.5]}],
  SofaDefaultFillingColor,
  Polygon[GerverSofaCurveSegmentsCombined]
};

GerverSofaRotationPathDashedSegments:={
  AbsoluteThickness[1.5],Dashing[Tiny],Black,Line[GerverSofaRotationPathDashedSegment1],Line[GerverSofaRotationPathDashedSegment2]
};

GerverSofaRotationPath:=Function[t,GerverxNumerical[t]];

GerverSofaNormalTickMarkData = {
{GerverxNumerical[GerverAngleϕ],-{Sin[GerverAngleθ],Cos[GerverAngleθ]}},
{GerverxNumerical[GerverAngleθ],-{Cos[1.35],Sin[1.35]}},
{GerverxNumerical[π/2-GerverAngleθ],{Cos[1.35],-Sin[1.35]}},
{GerverxNumerical[π/2-GerverAngleϕ],{Sin[GerverAngleθ],-Cos[GerverAngleθ]}},{GerverBNumerical[π/2-GerverAngleϕ],-{Cos[π/2-GerverAngleϕ],Sin[π/2-GerverAngleϕ]}},
{GerverBNumerical[π/2],{0,-1}},
{GerverDNumerical[GerverAngleϕ],{Sin[GerverAngleϕ],-Cos[GerverAngleϕ]}},
{GerverDNumerical[0],{0,-1}},
{GerverANumerical[GerverAngleθ],{Cos[GerverAngleθ],Sin[GerverAngleθ]}},
{GerverANumerical[π/2-GerverAngleθ],{Cos[π/2-GerverAngleθ],Sin[π/2-GerverAngleθ]}},
{GerverANumerical[π/2-GerverAngleϕ],{Cos[π/2-GerverAngleϕ],Sin[π/2-GerverAngleϕ]}},
{GerverANumerical[π/2],{0,1}},
{GerverCNumerical[π/2-GerverAngleθ],{-Sin[π/2-GerverAngleθ],Cos[π/2-GerverAngleθ]}},
{GerverCNumerical[GerverAngleθ],{-Sin[GerverAngleθ],Cos[GerverAngleθ]}},
{GerverCNumerical[GerverAngleϕ],{-Cos[π/2-GerverAngleϕ],Sin[π/2-GerverAngleϕ]}},
{GerverCNumerical[0],{0,1}},
{{1,0},{0.707,-0.707}},
{GerverCNumerical[π/2],-{0.707,0.707}}
};

GerverSofaNormalTickMarks={Black,Map[Line[{#[[1]]-0.03(#[[2]]/Norm[#[[2]]]),#[[1]]+0(#[[2]]/Norm[#[[2]]])}]&,GerverSofaNormalTickMarkData]};

GerverSofaContactPoints[angle_]:=({{\[Piecewise], ({{{{1,0},GerverCNumerical[angle],GerverDNumerical[angle]}, angle<GerverAngleϕ}, {{GerverxNumerical[angle],GerverANumerical[angle],GerverCNumerical[angle],GerverDNumerical[angle]}, GerverAngleϕ≤angle≤GerverAngleθ}, {{GerverxNumerical[angle],GerverANumerical[angle],GerverCNumerical[angle]}, GerverAngleθ<angle<(π/2)-GerverAngleθ}, {{GerverxNumerical[angle],GerverANumerical[angle],GerverBNumerical[angle],GerverCNumerical[angle]}, (π/2)-GerverAngleθ≤angle≤(π/2)-GerverAngleϕ}, {{GerverANumerical[angle],GerverBNumerical[angle],GerverCNumerical[angle]}, (π/2)-GerverAngleϕ<angle≤(π/2)}})}})

AmbiReflection[pt_]:={pt[[1]],1-pt[[2]]};
AmbidextrousSofaCurveSegment1=Rest[Table[AmbixNumerical[t],{t,AmbidextrousAngleβ,π/2-AmbidextrousAngleβ,(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaCurveSegment2=Table[AmbiDNumerical[t],{t,π/2-AmbidextrousAngleβ,0,-(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}];
AmbidextrousSofaCurveSegment3=Table[AmbiReflection[AmbiCNumerical[t]],{t,0,π/2-AmbidextrousAngleβ,(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}];
AmbidextrousSofaCurveSegment4=Table[AmbiCNumerical[t],{t,π/2-AmbidextrousAngleβ,0,-(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}];
AmbidextrousSofaCurveSegment5=Table[AmbiReflection[AmbiDNumerical[t]],{t,0,π/2-AmbidextrousAngleβ,(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}];
AmbidextrousSofaCurveSegment6=Most[Table[AmbiReflection[AmbixNumerical[t]],{t,π/2-AmbidextrousAngleβ,AmbidextrousAngleβ,-(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaCurveSegment7=Rest[Table[AmbiReflection[AmbiBNumerical[t]],{t,AmbidextrousAngleβ,π/2,(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaCurveSegment8=Append[Most[Table[AmbiANumerical[t],{t,π/2,AmbidextrousAngleβ,-(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]],{1,1/2}];
AmbidextrousSofaCurveSegment9=Rest[Table[AmbiReflection[AmbiANumerical[t]],{t,AmbidextrousAngleβ,π/2,(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaCurveSegment10=Most[Table[AmbiBNumerical[t],{t,π/2,AmbidextrousAngleβ,-(π/2-AmbidextrousAngleβ)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];

AmbidextrousSofaRotationPathDashedSegment1=Most[Table[AmbixNumerical[t],{t,0,AmbidextrousAngleβ,AmbidextrousAngleβ/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaRotationPathDashedSegment2=Table[AmbixNumerical[t],{t,π/2-AmbidextrousAngleβ,π/2,AmbidextrousAngleβ/Floor[SofaDefaultNumSubdivisionPoints/3]}];

AmbidextrousSofaCurveSegmentsCombined=Join[AmbidextrousSofaCurveSegment1,AmbidextrousSofaCurveSegment2,AmbidextrousSofaCurveSegment3,AmbidextrousSofaCurveSegment4,AmbidextrousSofaCurveSegment5,AmbidextrousSofaCurveSegment6,AmbidextrousSofaCurveSegment7,AmbidextrousSofaCurveSegment8,AmbidextrousSofaCurveSegment9,AmbidextrousSofaCurveSegment10];

AmbidextrousSofa:={
  EdgeForm[{Black,AbsoluteThickness[1.5]}],
  SofaDefaultFillingColor,
  Polygon[AmbidextrousSofaCurveSegmentsCombined]
};

AmbidextrousSofaRotationPathDashedSegments:={
  AbsoluteThickness[1.5],Dashing[Tiny],Black,Line[AmbidextrousSofaRotationPathDashedSegment1],Line[AmbidextrousSofaRotationPathDashedSegment2]
};

OneSidedAmbidextrousSofaCurve=Join[AmbidextrousSofaCurveSegment1,AmbidextrousSofaCurveSegment2,{{AmbidextrousSofaCurveSegment4[[1]][[1]],0}},AmbidextrousSofaCurveSegment4,AmbidextrousSofaCurveSegment8,{{1,0}},AmbidextrousSofaCurveSegment10];

OneSidedAmbidextrousSofa:={
  EdgeForm[{Black,AbsoluteThickness[1.5]}],
  SofaDefaultFillingColor,
  Polygon[OneSidedAmbidextrousSofaCurve]
};

OneSidedAmbidextrousSofaWithReflection:={
  EdgeForm[{Black,AbsoluteThickness[1.5]}],
  SofaDefaultFillingColor,
  Polygon[OneSidedAmbidextrousSofaCurve],
  {Black,Dashed,
   Line[AmbidextrousSofaCurveSegment3],
   Line[Join[AmbidextrousSofaCurveSegment5,
             AmbidextrousSofaCurveSegment6,
             AmbidextrousSofaCurveSegment7]],
   Line[AmbidextrousSofaCurveSegment9],
   Line[{{AmbiCNumerical[π/2][[1]],1/2},{1,1/2}}]}
};


AmbidextrousSofaContactPoints[angle_]:=({{\[Piecewise], ({{{{1,1/2},AmbiCNumerical[angle],AmbiDNumerical[angle]}, angle<AmbidextrousAngleβ}, {{AmbixNumerical[angle],AmbiANumerical[angle],AmbiBNumerical[angle],AmbiCNumerical[angle],AmbiDNumerical[angle]}, AmbidextrousAngleβ<angle<(π/2)-AmbidextrousAngleβ}, {{AmbiANumerical[angle],AmbiBNumerical[angle],AmbiCNumerical[angle]}, (π/2)-AmbidextrousAngleβ<angle≤(π/2)}})}})

AmbidextrousSofaRotationPath:=Function[t,AmbixNumerical[t]];

AmbidextrousSofaNormalTickMarkData = {
  {AmbixNumerical[AmbidextrousAngleβ],-{Cos[AmbidextrousAngleβ],Sin[AmbidextrousAngleβ]}},
  {AmbixNumerical[π/2-AmbidextrousAngleβ],{Sin[π/2-AmbidextrousAngleβ],-Cos[π/2-AmbidextrousAngleβ]}},
  {AmbiReflection[AmbixNumerical[AmbidextrousAngleβ]],-{Cos[AmbidextrousAngleβ],-Sin[AmbidextrousAngleβ]}},
  {AmbiReflection[AmbixNumerical[π/2-AmbidextrousAngleβ]],{Sin[π/2-AmbidextrousAngleβ],Cos[π/2-AmbidextrousAngleβ]}},
  {AmbiDNumerical[AmbidextrousAngleβ],{Sin[AmbidextrousAngleβ],-Cos[AmbidextrousAngleβ]}},
  {AmbiReflection[AmbiDNumerical[AmbidextrousAngleβ]],{Sin[AmbidextrousAngleβ],Cos[AmbidextrousAngleβ]}},
  {AmbiDNumerical[0],{0,-1}},
  {AmbiReflection[AmbiDNumerical[0]],{0,1}},
  {AmbiBNumerical[π/2-AmbidextrousAngleβ],-{Cos[π/2-AmbidextrousAngleβ],Sin[π/2-AmbidextrousAngleβ]}},
  {AmbiReflection[AmbiBNumerical[π/2-AmbidextrousAngleβ]],-{Cos[π/2-AmbidextrousAngleβ],-Sin[π/2-AmbidextrousAngleβ]}},
  {AmbiBNumerical[π/2],{0,-1}},
  {AmbiReflection[AmbiBNumerical[π/2]],{0,1}},
  {AmbiCNumerical[AmbidextrousAngleβ],{-Sin[AmbidextrousAngleβ],Cos[AmbidextrousAngleβ]}},
  {AmbiReflection[AmbiCNumerical[AmbidextrousAngleβ]],{-Sin[AmbidextrousAngleβ],-Cos[AmbidextrousAngleβ]}},
  {AmbiANumerical[π/2-AmbidextrousAngleβ],{Cos[π/2-AmbidextrousAngleβ],Sin[π/2-AmbidextrousAngleβ]}},
  {AmbiReflection[AmbiANumerical[π/2-AmbidextrousAngleβ]],{Cos[π/2-AmbidextrousAngleβ],-Sin[π/2-AmbidextrousAngleβ]}},
  {{1,1/2},{1,0}},
  {{AmbiCNumerical[π/2][[1]],1/2},{-1,0}}
};

AmbidextrousSofaNormalTickMarks={Black,Map[Line[{#[[1]]-0.025(#[[2]]/Norm[#[[2]]]),#[[1]]+0(#[[2]]/Norm[#[[2]]])}]&,AmbidextrousSofaNormalTickMarkData]};

(* Code to draw figures for the paper *)

SofaPaperFigureSquareSemicircle = Graphics[{
  SofaHallway[3],
  {Dashed,Arrow[Table[0.85{Cos[t],Sin[t]},{t,-π/10-π/20,-π/2+π/20,-0.01}]]},
  Rotate[SemicircleSofa,-π/10,{0,0}],Translate[SquareSofa,{-2.5,0}]}
];

SofaPaperFigureGerverSofaWithTicks = Graphics[{
  GerverSofa, GerverSofaNormalTickMarks
}];

SofaPaperFigureAmbidextrousSofaWithTicks = Graphics[{
  AmbidextrousSofa, AmbidextrousSofaNormalTickMarks
}];

SofaPaperFigureOneSidedAmbidextrousSofaWithReflection = Graphics[OneSidedAmbidextrousSofaWithReflection];

AmbidextrousSofaCurveSegment8Modified=Most[Table[AmbiANumerical[t],{t,1.4,0.5,-(1.4-0.5)/Floor[SofaDefaultNumSubdivisionPoints/3]}]];
AmbidextrousSofaCurveSegment4Modified=Table[AmbiCNumerical[t],{t,1.4-0.5,0,-(1.4-0.5)/Floor[SofaDefaultNumSubdivisionPoints/3]}];SofaPaperContactPathsFigureAngle=0.65;
SofaPaperContactPathsFigureRightDashedcurve={{0.9354166666666666`,0.6479166666666667`},{1.0145833333333332`,0.4104166666666669`},{1.0229166666666665`,0.16041666666666687`},{0.9937500000000001`,0.05208333333333348`},{0.8520833333333331`,-0.002083333333333215`},{0.5770833333333332`,-0.010416666666666519`},{0.423,0}};
SofaPaperContactPathsFigureLeftDashedcurve={{-0.7729166666666667`,0.002083333333333215`},{-1.1062500000000002`,0.002083333333333215`},{-1.1812500000000001`,0.04791666666666661`},{-1.2270833333333333`,0.2729166666666665`},{-1.2437500000000001`,0.6229166666666666`},{-1.2104166666666667`,0.7312499999999997`}};
SofaPaperContactPathsFigureTopDashedcurve={{-0.7395833333333334`,1.0020833333333332`},{0.4770833333333332`,0.9937499999999999`}};
SofaPaperContactPathsFigureRightDashedcurveContactPathColorA=RGBColor[0.7,0,0];
SofaPaperContactPathsFigureRightDashedcurveContactPathColorB=RGBColor[0,0.5,0];
SofaPaperContactPathsFigureRightDashedcurveContactPathColorC=Blue;
SofaPaperContactPathsFigureRightDashedcurveContactPathColorD=Purple;
SofaPaperContactPathsFigureRightDashedcurveContactPathColorx=RGBColor[0.9,0.45,0];

SofaPaperContactPathsFigure=
Graphics[{
Translate[Rotate[SofaHallway[2],SofaPaperContactPathsFigureAngle,{0,0}],
AmbixNumerical[SofaPaperContactPathsFigureAngle]],
{SofaDefaultFillingColor,FilledCurve[
BSplineCurve[
Join[
AmbidextrousSofaCurveSegment10,AmbidextrousSofaCurveSegment1,AmbidextrousSofaCurveSegment2,SofaPaperContactPathsFigureLeftDashedcurve,AmbidextrousSofaCurveSegment4Modified,
SofaPaperContactPathsFigureTopDashedcurve,AmbidextrousSofaCurveSegment8Modified,SofaPaperContactPathsFigureRightDashedcurve
]
]]},
{
AbsoluteThickness[2],
{SofaPaperContactPathsFigureRightDashedcurveContactPathColorB,Line[Join[AmbidextrousSofaCurveSegment10]]},
{SofaPaperContactPathsFigureRightDashedcurveContactPathColorx,Line[Join[AmbidextrousSofaCurveSegment1]]},
{SofaPaperContactPathsFigureRightDashedcurveContactPathColorD,Line[Join[AmbidextrousSofaCurveSegment2]]},
{SofaPaperContactPathsFigureRightDashedcurveContactPathColorA,Line[AmbidextrousSofaCurveSegment8Modified]},
{SofaPaperContactPathsFigureRightDashedcurveContactPathColorC,Line[AmbidextrousSofaCurveSegment4Modified]}
},
{Dashing[{0.003,0.01}],AbsoluteThickness[1.5],Line[SofaPaperContactPathsFigureTopDashedcurve],BSplineCurve[SofaPaperContactPathsFigureLeftDashedcurve],BSplineCurve[SofaPaperContactPathsFigureRightDashedcurve]},
{
AbsolutePointSize[6],
Point[AmbixNumerical[SofaPaperContactPathsFigureAngle]],
Point[AmbiANumerical[SofaPaperContactPathsFigureAngle]],
Point[AmbiBNumerical[SofaPaperContactPathsFigureAngle]],
Point[AmbiCNumerical[SofaPaperContactPathsFigureAngle]],
Point[AmbiDNumerical[SofaPaperContactPathsFigureAngle]]
},
Style[Text["A",{0.94,0.77}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorA,Bold}],
Style[Text["B",{-0.02,0.09}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorB,Bold}],
Style[Text["x",{-0.09,0.44}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorx,Bold}],
Style[Text["D",{-0.41,0.04}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorD,Bold}],
Style[Text["C",{-1.19,0.92}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorC,Bold}],
Style[Text["(t)",{1.005,0.77}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorA,Italic}],
Style[Text["(t)",{0.045,0.09}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorB,Italic}],
Style[Text["(t)",{-0.03,0.44}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorx,Italic}],
Style[Text["(t)",{-0.345,0.04}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorD,Italic}],
Style[Text["(t)",{-1.125,0.92}],{18,SofaPaperContactPathsFigureRightDashedcurveContactPathColorC,Italic}],
{Black, Line[{{0.06561575948419139`,0.22152003469603787`},{0.041657189264183714`,0.21437952259864868`}}],
Line[{{-0.3997153945203201`,0.22152002820182118`},{-0.37575682430031242051509084749700119417`18.79934718963173,0.2143795161044319779301884245624498240300202134184892311637`18.67899172106783}}]}
},PlotRange->{{-1.4,1.1},{-0.1,1.2}},ImageSize->600];

rotationpathspecialx[t_]:={0.613763(Cos[2t]-1),0.75Sin[2t]};
rotationpathspecialA[t_]:=Collect[Simplify[rotationpathspecialx[t]+μ[t]+(rotationpathspecialx'[t].μ[t])ν[t]],{Cos[t],Sin[t]}];
rotationpathspecialB[t_]:=Collect[Simplify[rotationpathspecialx[t]+(rotationpathspecialx'[t].μ[t])ν[t]],{Cos[t],Sin[t]}];
rotationpathspecialC[t_]:=Collect[Simplify[rotationpathspecialx[t]+ν[t]-(rotationpathspecialx'[t].ν[t])μ[t]],{Cos[t],Sin[t]}];
rotationpathspecialD[t_]:=Collect[Simplify[rotationpathspecialx[t]-(rotationpathspecialx'[t].ν[t])μ[t]],{Cos[t],Sin[t]}];
rotationpathfigurepointsx=Table[rotationpathspecialx[t],{t,0.103,π/2-0.103,π/2/SofaDefaultNumSubdivisionPoints/5}];
rotationpathfigurepointsxdashed1=Table[rotationpathspecialx[t],{t,0,0.103,π/2/SofaDefaultNumSubdivisionPoints/5}];
rotationpathfigurepointsxdashed2=Table[rotationpathspecialx[t],{t,π/2-0.103,π/2,π/2/SofaDefaultNumSubdivisionPoints/5}];
rotationpathfigurepointsD=Reverse[Table[rotationpathspecialD[t],{t,0,π/2-0.736,π/2/SofaDefaultNumSubdivisionPoints/5}]];
rotationpathfigurepointsC=Reverse[Table[rotationpathspecialC[t],{t,0,π/2,π/2/SofaDefaultNumSubdivisionPoints/5}]];
rotationpathfigurepointsA=Reverse[Table[rotationpathspecialA[t],{t,0,π/2,π/2/SofaDefaultNumSubdivisionPoints/5}]];
rotationpathfigurepointsB=Reverse[Table[rotationpathspecialB[t],{t,0.736,π/2,π/2/SofaDefaultNumSubdivisionPoints/5}]];
rotationpathfiguredashedpath=Table[{rotationpathspecialx[π/4][[1]],0}+0.86{rotationpathspecialx[t][[1]]-rotationpathspecialx[π/4][[1]],rotationpathspecialx[t][[2]]},{t,0.04,π/2-0.04,π/2/SofaDefaultNumSubdivisionPoints/5}];
rotationpathfigurehighlightedhallwaytime=6*π/2/20;
rotationpathfigurerotatedhallwayhighlighted={SofaHallwayDefaultFillingColor,EdgeForm[Black],Table[
Translate[Rotate[Polygon[{
{0,0},
{0,-3},
{1,-3},
{1,1},
{-3,1},
{-3,0}
}],t,{0,0}],rotationpathspecialx[t]]
,{t,{rotationpathfigurehighlightedhallwaytime}}]
};
rotationpathfigurerotatedhallways2={RGBColor[0,0,0,0],EdgeForm[RGBColor[0.4,0.4,0.4,0.6]],Table[
Translate[Rotate[Polygon[{
{0,0},
{0,-3},
{1,-3},
{1,1},
{-3,1},
{-3,0}
}],t,{0,0}],rotationpathspecialx[t]]
,{t,0,π/2,π/2/20}]
};

SofaPaperRotationPathFigure=Graphics[{
rotationpathfigurerotatedhallwayhighlighted,
rotationpathfigurerotatedhallways2,
{EdgeForm[{Black,AbsoluteThickness[1.5]}],SofaDefaultFillingColor,AbsoluteThickness[2],
Polygon[Join[rotationpathfigurepointsx,rotationpathfigurepointsD,rotationpathfigurepointsC,rotationpathfigurepointsA,rotationpathfigurepointsB]],
{Black,Dashing[Tiny],Line[rotationpathfigurepointsxdashed1],Line[rotationpathfigurepointsxdashed2]}
},
{RGBColor[0,0,0.7],Dashed,Arrowheads[0.02],Arrow[rotationpathfiguredashedpath]},
{Black,AbsolutePointSize[5],Point[{0,0}],Point[rotationpathspecialx[rotationpathfigurehighlightedhallwaytime]]},
{
Style[Text["(0,0)",{-0.12,-0.08}],14],
Style[Text["x",{-0.21,0.68}],14,Bold],
Style[Text["(t)",{-0.13,0.68}],14]
}
},PlotRange->{{rotationpathspecialC[π/2][[1]]-0.3,1.3},{-0.3,1.3}},ImageSize->600];

SofaPaperFigureHammersleySofa=Graphics[{
HammersleySofa,
{GrayLevel[0.7],Dashed,Line[{{0,1},{0,0},{-4/π,0},{-4/π,1}}]}
}];

(* Code for interactive visualizations *)

SofaVisualizationGeneralizedHammersleySofasAreas:=Manipulate[
Column[{
 Row[{
 Show[Plot[HammersleyGeneralizedSofaArea[t],{t,0,1},ImageSize->240,AxesLabel->{"r","Sofa area"},PlotStyle->{Black,Thickness[0.005]},PlotRange->{1.5,2.3}],Graphics[{AbsolutePointSize[6],Point[{r,HammersleyGeneralizedSofaArea[r]}]}]],
 "   ",
 Graphics[HammersleyGeneralizedSofa[r],ImageSize->{Automatic,160}]
}],"","Inner radius: "<>ToString[r],"Area:   "<>ToString[HammersleyGeneralizedSofaArea[r]]
}],{r,0.0,1.0},FrameLabel->{"","",Style["Generalized Hammersley sofas: the area as a function of the inner radius",14,Bold]}];

SofaVisualizationGeneralizedHammersleySofasInHallway:=Manipulate[Show[
SofaMovieWithHallway[Max[4,2.5+2r],1.5,HammersleyGeneralizedSofa[r],HammersleyGeneralizedSofaRotationPath[r],t],ImageSize->400
],{r,0.00000000001,1.0},{t,0,3,ImageSize->400},FrameLabel->{"","",Style["Generalized Hammersley sofas moving around a corner",14,Bold]}]; 
(**** A small bug here with r=0 ****)

SofaMovieWithHallwayMultiPOV[armlength_,xinitial_,sofagraphics_,rotationpath_,time_,pov_,plotrangepov1_,plotrangepov2_]:=Module[{sofatrans,hallwaytrans},
sofatrans=Function[graphx,
If[time≤1,Translate[graphx,{-xinitial×(1-time),0}],
    If[time≤2,Rotate[Translate[graphx,-rotationpath[(π/2)(time-1)]],-(π/2)(time-1),{0,0}],
      Translate[Rotate[Translate[graphx,-rotationpath[(π/2)]],-(π/2),{0,0}],
          {0,-xinitial×(time-2)}]]]];
hallwaytrans=Function[graphx,
If[time≤1,Translate[graphx,-{-xinitial×(1-time),0}],
    If[time≤2,Translate[Rotate[graphx,(π/2)(time-1),{0,0}],rotationpath[(π/2)(time-1)]],
      Translate[Rotate[Translate[graphx,-{0,-xinitial×(time-2)}],(π/2),{0,0}],
          rotationpath[(π/2)]]]]];
If[pov!="Sofa",
Graphics[{SofaHallway[armlength],sofatrans[sofagraphics]},PlotRange->plotrangepov1],
Graphics[{hallwaytrans[SofaHallway[armlength]],sofagraphics},PlotRange->plotrangepov2]]
];

SofaVisualizationGerverSofaInHallway:=Manipulate[
If[pov=="Hallway",
Show[
SofaMovieWithHallwayMultiPOV[4,1.7,
{GerverSofa,If[showrotationpath,GerverSofaRotationPathDashedSegments,{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,GerverSofaContactPoints[(π/2)(t-1)]]}},{}],
If[showtickmarks,GerverSofaNormalTickMarks,{}]},
GerverSofaRotationPath,t,"Hallway",{{-4,1},{-4,1}},{{-0.5+GerverCNumerical[π/2][[1]],1.5},{-0.5,1.5}}],ImageSize->400
],
If[pov=="Sofa",
Show[
SofaMovieWithHallwayMultiPOV[4,1.7,
{GerverSofa,If[showrotationpath,GerverSofaRotationPathDashedSegments,{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,GerverSofaContactPoints[(π/2)(t-1)]]}},{}],
If[showtickmarks,GerverSofaNormalTickMarks,{}]},
GerverSofaRotationPath,t,"Sofa",{{-4,1},{-4,1}},{{-0.5+GerverCNumerical[π/2][[1]],1.5},{-0.5,1.5}}],ImageSize->400
],
Row[{
Show[
SofaMovieWithHallwayMultiPOV[4,1.7,
{GerverSofa,If[showrotationpath,GerverSofaRotationPathDashedSegments,{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,GerverSofaContactPoints[(π/2)(t-1)]]}},{}],
If[showtickmarks,GerverSofaNormalTickMarks,{}]},
GerverSofaRotationPath,t,"Hallway",{{-4,1},{-4,1}},{{-0.5+GerverCNumerical[π/2][[1]],1.5},{-0.5,1.5}}],ImageSize->400
],"     ",
Show[
SofaMovieWithHallwayMultiPOV[4,1.7,
{GerverSofa,If[showrotationpath,GerverSofaRotationPathDashedSegments,{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,GerverSofaContactPoints[(π/2)(t-1)]]}},{}],
If[showtickmarks,GerverSofaNormalTickMarks,{}]},
GerverSofaRotationPath,t,"Sofa",{{-4,1},{-4,1}},{{-0.5+GerverCNumerical[π/2][[1]],1.5},{-0.5,1.5}}],ImageSize->400
]
}]
]],
{t,0,3,ImageSize->300},{{showcontactpoints,False,"Show contact points:"},Checkbox},{{showtickmarks,False,"Show tick marks:"},Checkbox},
{{showrotationpath,False,"Show rotation path:"},Checkbox},
{{pov,"Hallway","Point of view:"},{"Hallway","Sofa","Both"}},
  FrameLabel->{"","",Style["Gerver's sofa moving around a corner",14,Bold]}];


SofaMovieWithHallwayTwoCornersMultiPOV[armlength_,leftendpoint_,sofagraphics_,rotationpath_,time_,pov_,plotrange1_,plotrange2_]:=Module[{basebpoint,xinitial,sofatrans,hallwaytrans},
xinitial=armlength+leftendpoint;
sofatrans=Function[graphx,
If[time≤1,Translate[graphx,{-xinitial×(1-time),0}],
    If[time≤2,Rotate[Translate[graphx,-rotationpath[(π/2)(time-1)]],-(π/2)(time-1),{0,0}],
      If[time≤3,Translate[Rotate[Translate[graphx,-rotationpath[(π/2)]],-(π/2),{0,0}],
          {0,-xinitial×(time-2)}],
        If[time≤4,
            basepoint=rotationpath[(π/2)(4-time)];
            basepoint[[1]]=rotationpath[(π/2)][[1]]-basepoint[[1]]; basepoint[[2]]=1-basepoint[[2]];
            Translate[Rotate[Translate[graphx,-basepoint],-(π/2)(4-time),{0,0}],{1,-armlength+1}],
          If[time≤5,Translate[graphx,{-rotationpath[(π/2)][[1]]+1+xinitial×(time-4),-armlength}],{}]
         ]
       ]
     ]
   ]
];
hallwaytrans=Function[graphx,
If[time≤1,Translate[graphx,-{-xinitial×(1-time),0}],
    If[time≤2,Translate[Rotate[graphx,(π/2)(time-1),{0,0}],rotationpath[(π/2)(time-1)]],
      If[time≤3,Translate[Rotate[Translate[graphx, -{0,-xinitial×(time-2)}],(π/2),{0,0}],
         rotationpath[(π/2)]],
        If[time≤4,
            basepoint=rotationpath[(π/2)(4-time)];
            basepoint[[1]]=rotationpath[(π/2)][[1]]-basepoint[[1]]; basepoint[[2]]=1-basepoint[[2]];
            Translate[Rotate[Translate[graphx,-{1,-armlength+1}],(π/2)(4-time),{0,0}],basepoint],
          If[time≤5,Translate[graphx,-{-rotationpath[(π/2)][[1]]+1+xinitial×(time-4),-armlength}],{}]
         ]
       ]
     ]
   ]
];
If[pov≠ "Sofa",
Graphics[{SofaHallwayTwoCorners[armlength],sofatrans[sofagraphics]},PlotRange->plotrange1],
Graphics[{hallwaytrans[SofaHallwayTwoCorners[armlength]],sofagraphics},PlotRange->plotrange2]
]];

SofaVisualizationAmbidextrousSofaInHallway:=Manipulate[
If[pov=="Hallway",
Show[SofaMovieWithHallwayTwoCornersMultiPOV[4,-1.334099633,
{AmbidextrousSofa,If[showrotationpath,{AmbidextrousSofaRotationPathDashedSegments,Rotate[AmbidextrousSofaRotationPathDashedSegments,π,{AmbixNumerical[π/4][[1]],1/2}]},{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,AmbidextrousSofaContactPoints[(π/2)(t-1)]]}},
If[showcontactpoints&&3≤t≤4,{{AbsolutePointSize[5],Map[Point[AmbiReflection[#]]&,AmbidextrousSofaContactPoints[(π/2)(t-3)]]}},
{}]],
If[showtickmarks,AmbidextrousSofaNormalTickMarks,{}]},
AmbidextrousSofaRotationPath,t,pov,{{-4,5},{-4,1}},{{-0.5+AmbiCNumerical[π/2][[1]],1.5},{-0.25,1.25}}],ImageSize->600],
If[pov=="Sofa",Show[
SofaMovieWithHallwayTwoCornersMultiPOV[4,-1.334099633,
{AmbidextrousSofa,If[showrotationpath,{AmbidextrousSofaRotationPathDashedSegments,Rotate[AmbidextrousSofaRotationPathDashedSegments,π,{AmbixNumerical[π/4][[1]],1/2}]},{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,AmbidextrousSofaContactPoints[(π/2)(t-1)]]}},
If[showcontactpoints&&3≤t≤4,{{AbsolutePointSize[5],Map[Point[AmbiReflection[#]]&,AmbidextrousSofaContactPoints[(π/2)(t-3)]]}},
{}]],
If[showtickmarks,AmbidextrousSofaNormalTickMarks,{}]},
AmbidextrousSofaRotationPath,t,pov,{{-4,5},{-4,1}},{{-0.5+AmbiCNumerical[π/2][[1]],1.5},{-0.25,1.25}}],ImageSize->600
],Row[{
Show[SofaMovieWithHallwayTwoCornersMultiPOV[4,-1.334099633,
{AmbidextrousSofa,If[showrotationpath,{AmbidextrousSofaRotationPathDashedSegments,Rotate[AmbidextrousSofaRotationPathDashedSegments,π,{AmbixNumerical[π/4][[1]],1/2}]},{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,AmbidextrousSofaContactPoints[(π/2)(t-1)]]}},
If[showcontactpoints&&3≤t≤4,{{AbsolutePointSize[5],Map[Point[AmbiReflection[#]]&,AmbidextrousSofaContactPoints[(π/2)(t-3)]]}},
{}]],
If[showtickmarks,AmbidextrousSofaNormalTickMarks,{}]},
AmbidextrousSofaRotationPath,t,"Hallway",{{-4,5},{-4,1}},{{-0.5+AmbiCNumerical[π/2][[1]],1.5},{-0.25,1.25}}],ImageSize->450],"    ",
Show[SofaMovieWithHallwayTwoCornersMultiPOV[4,-1.334099633,
{AmbidextrousSofa,If[showrotationpath,{AmbidextrousSofaRotationPathDashedSegments,Rotate[AmbidextrousSofaRotationPathDashedSegments,π,{AmbixNumerical[π/4][[1]],1/2}]},{}],
If[showcontactpoints&&1≤t≤2,{{AbsolutePointSize[5],Map[Point,AmbidextrousSofaContactPoints[(π/2)(t-1)]]}},
If[showcontactpoints&&3≤t≤4,{{AbsolutePointSize[5],Map[Point[AmbiReflection[#]]&,AmbidextrousSofaContactPoints[(π/2)(t-3)]]}},
{}]],
If[showtickmarks,AmbidextrousSofaNormalTickMarks,{}]},
AmbidextrousSofaRotationPath,t,"Sofa",{{-4,5},{-4,1}},{{-0.5+AmbiCNumerical[π/2][[1]],1.5},{-0.25,1.25}}],ImageSize->450]
}]]]
,{t,0,5,ImageSize->500},{{showcontactpoints,False,"Show contact points:"},Checkbox},{{showtickmarks,False,"Show tick marks:"},Checkbox},
{{showrotationpath,False,"Show rotation paths:"},Checkbox},
{{pov,"Hallway","Point of view:"},{"Hallway","Sofa","Both"}},
  FrameLabel->{"","",Style["Ambidextrous sofa moving around two corners",14,Bold]}];

SofaVisualizationSquareSofaInHallway:=Module[{r},
r=0.0001;
Manipulate[Graphics[{
SofaHallway[3],Translate[SquareSofa/.{SofaDefaultFillingColor->SquareSofaDefaultFillingColor},Piecewise[{{2.5{t-1,0},t≤1},{2.5{0,1-t},t≤2}}]]
},ImageSize->400],{t,0,2,ImageSize->400},FrameLabel->{"","",Style["Square sofa moving around a corner",14,Bold]}]
];

SofaVisualizationSemicircularSofaInHallway:=
Manipulate[Show[
SofaMovieWithHallway[4,1.5,HammersleyGeneralizedSofa[0.0001],HammersleyGeneralizedSofaRotationPath[0.0001],t],ImageSize->400
],{t,0,3,ImageSize->400},FrameLabel->{"","",Style["Semicircular sofa moving around a corner",14,Bold]}];

SofaVisualizationHammersleySofaInHallway:=
Manipulate[Show[
SofaMovieWithHallway[4,1.5,HammersleyGeneralizedSofa[2/π],HammersleyGeneralizedSofaRotationPath[2/π],t],ImageSize->400
],{t,0,3,ImageSize->400},FrameLabel->{"","",Style["Hammersley sofa moving around a corner",14,Bold]}];

SofaVisualizationsCombined=Manipulate[Piecewise[{{SofaVisualizationSquareSofaInHallway,vis=="Square"},
{SofaVisualizationSemicircularSofaInHallway,vis=="Semicircle"},
{SofaVisualizationHammersleySofaInHallway,vis=="Hammersley"},
{SofaVisualizationGeneralizedHammersleySofasInHallway,vis=="Generalized Hammersley"},
{SofaVisualizationGerverSofaInHallway,vis=="Gerver"},
{SofaVisualizationAmbidextrousSofaInHallway,vis=="Ambidextrous"}}],
{{vis,"Square","Choose sofa visualization:"},
{"Square","Semicircle","Hammersley","Generalized Hammersley","Gerver","Ambidextrous"}}];

3. Formulas for the contact paths in Gerver’s sofa

The definition of Gerver’s sofa involves the so-called rotation path x(t), defined in equation (25) in the paper as a path in the plane gluing together the solutions (Subscript[x, 1])(t), (Subscript[x, 2])(t), (Subscript[x, 3])(t), (Subscript[x, 4])(t), (Subscript[x, 5])(t) to five of the six basic ordinary differential equations described in Theorems 2 and 3 of the paper, and the additional contact paths A(t), B(t), C(t), D(t), that are computed from x(t) by the formulas (9)-(12) in Theorem 1. The code below illustrates how Mathematica can simplify the results of the computation to provide clean, simple formulas for the rotation path and contact paths. Try evaluating the next five commands.

Gerverx[t]//TraditionalForm

GerverA[t]//TraditionalForm

GerverB[t]//TraditionalForm

GerverC[t]//TraditionalForm

GerverD[t]//TraditionalForm

The functions above were presented in symbolic form involving the 22 numerical parameters associated with Gerver’s sofa. The functions GerverxNumerical[t], GerverANumerical[t], GerverBNumerical[t], GerverCNumerical[t], GerverDNumerical[t] give the same functions after the precomputed approximate numerical values of the parameters have been substituted in. This is useful when you want to do numerical computations or draw graphical figures related to the sofa. For example, try evaluating the command below.

GerverxNumerical[t]

4. Formulas for the contact paths in the shape Σ

The shape Σ constructed in the paper is defined in terms of its own rotation path, defined in equation (47) in the paper, and the associated contact paths A(t), B(t), C(t), D(t). Again the commands below display formulas for these functions, written in symbolic form involving the 13 numerical parameters associated with Σ.

Ambix[t]//TraditionalForm

AmbiA[t]//TraditionalForm

AmbiB[t]//TraditionalForm

AmbiC[t]//TraditionalForm

AmbiD[t]//TraditionalForm

The functions AmbixNumerical[t], AmbiANumerical[t], AmbiBNumerical[t], AmbiCNumerical[t], AmbiDNumerical[t] give the same functions after the precomputed approximate numerical values of the parameters have been substituted in. Try the next two commands.

AmbiANumerical[t]

AmbiBNumerical[π/2]

5. Verifying the ODE general form solutions

This code below verifies that the functions (Subscript[x, j])(t) (j=1,2,3,4,5,6) satisfy the six ODEs listed in Theorem 2 in the paper. First, evaluate the next command to define expressions for the right-hand sides of the six ODEs.

(Subscript[SofaODE, 1])[t_]:=RotationMatrix[t].({-1,-1/2}+{{2Sin[t],-2Cos[t]},{2Cos[t],2Sin[t]}}.(Subscript[x, 1])'[t]);
(Subscript[SofaODE, 2])[t_]:=RotationMatrix[t].({-1,-1/2}+{{Sin[t],-Cos[t]},{3/2Cos[t],3/2Sin[t]}}.(Subscript[x, 2])'[t]);
(Subscript[SofaODE, 3])[t_]:=RotationMatrix[t].({-1,-1}+{{Sin[t],-Cos[t]},{Cos[t],Sin[t]}}.(Subscript[x, 3])'[t]);
(Subscript[SofaODE, 4])[t_]:=RotationMatrix[t].({-1/2,-1}+{{3/2Sin[t],-3/2Cos[t]},{Cos[t],Sin[t]}}.(Subscript[x, 4])'[t]);
(Subscript[SofaODE, 5])[t_]:=RotationMatrix[t].({-1/2,-1}+{{2Sin[t],-2Cos[t]},{2Cos[t],2Sin[t]}}.(Subscript[x, 5])'[t]);
(Subscript[SofaODE, 6])[t_]:=RotationMatrix[t].({-1/2,-1/2}+{{3/2Sin[t],-3/2Cos[t]},{3/2Cos[t],3/2Sin[t]}}.(Subscript[x, 6])'[t]);

Now evaluate the next line to check that the ODEs are satisfied. You should get a list of six boolean values, all equal to True.

Table[Simplify[(Subscript[SofaODE, j])[t]==(Subscript[x, j])''[t]],{j,1,6}]

6. Solving the equations for Gerver’s sofa (quick and easy, purely numerical method)

Here we show how the system of equations for the parameters involved in the definition of Gerver’s sofa (equations (26)-(43) in the paper) can be solved numerically using Mathematica’s FindRoot[...] command. We have 28 equations in 22 unknowns, but, as explained in the paper, 6 of the equations are linearly dependent on the remaining 22. To use FindRoot only the linearly independent set of equations should be used.

Evaluate the next line. This solves the equations and stores the results in the variable GerverNumericalSolutions.

GerverNumericalSolutions=FindRoot[
GerverEquations[[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,21,22,25,26}]]
,{ϕ,0.05},{θ,0.6},{(Subscript[κ, 1,1]),0},{(Subscript[κ, 1,2]),0},{(Subscript[κ, 2,1]),0},{(Subscript[κ, 2,2]),0},{(Subscript[κ, 3,1]),0},{(Subscript[κ, 3,2]),0},{(Subscript[κ, 4,1]),0},{(Subscript[κ, 4,2]),0},{(Subscript[κ, 5,1]),0},{(Subscript[κ, 5,2]),0},{(Subscript[a, 1]),0},{(Subscript[a, 2]),0},{(Subscript[b, 1]),0},{(Subscript[b, 2]),0},{(Subscript[c, 1]),0},{(Subscript[c, 2]),0},{(Subscript[d, 1]),0},{(Subscript[d, 2]),0},{(Subscript[e, 1]),0},{(Subscript[e, 2]),0},AccuracyGoal->22,PrecisionGoal->22,MaxIterations->200,WorkingPrecision->30];

Evaluate the next line to format the solutions nicely in a table and display the results.

GerverNumericalSolutionsFormatted=NumberForm[MatrixForm[Transpose[{{ϕ,θ,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2])},{ϕ,θ,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2])}/.GerverNumericalSolutions}]],22,DigitBlock->3]

7. Solving the equations for Gerver’s sofa (second, more algebraic method)

This section illustrates a second approach to solving the equations for the values of the parameters in Gerver’s sofa. In this approach we treat the system as a linear system in the 20 variables (Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2]), with coefficients that are functions of ϕ and θ. This system can be solved symbolically if we focus our attention temporarily on only 20 out of the set of 22 equations that was used in the completely numerical solution method described above. This symbolic solution gives expressions for all the parameters in terms of ϕ and θ. Substituting these expressions back into the remaining two equations gives two nonlinear equations in the two variables ϕ and θ. Finally, the two nonlinear equations are solved numerically.

Evaluate the next line to solve the 20 linear equations symbolically.

GerverSymbolicSolutions=Solve[
GerverEquations[[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,21,22}]],
{(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2])}
][[1]];

Now evaluate the next commands to substitute the solutions back into the remaining two equations and get two nonlinear equations in ϕ and θ, which are stored in the variable GerverThetaPhiNumericalSolutions.

GerverPhiThetaEquations=Simplify[GerverEquations[[{25,26}]]/.GerverSymbolicSolutions];
GerverThetaPhiNumericalSolutions=FindRoot[GerverPhiThetaEquations,{ϕ,0.05},{θ,0.6},AccuracyGoal->22,PrecisionGoal->22,MaxIterations->200,WorkingPrecision->30];

Evaluate the next line to inspect the result to see that we got something interesting:

GerverThetaPhiNumericalSolutions

Now that we got the numerical values of ϕ and θ, with the next command we recover the numerical values for the remaining parameters and display them in a formatted table.

GerverNumericalSolutionsSecondMethodFormatted=NumberForm[MatrixForm[Transpose[{{ϕ,θ,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2])},{ϕ,θ,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 2,1]),(Subscript[κ, 2,2]),(Subscript[κ, 3,1]),(Subscript[κ, 3,2]),(Subscript[κ, 4,1]),(Subscript[κ, 4,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[d, 1]),(Subscript[d, 2]),(Subscript[e, 1]),(Subscript[e, 2])}/.GerverSymbolicSolutions/.GerverThetaPhiNumericalSolutions}]],22,DigitBlock->3]

8. Computing the area of Gerver’s sofa

After using the algebraic method to find the parameters for Gerver’s sofa described in Section 7 above, we have the values of the 20 linear parameters stored in the variables GerverSymbolicSolutions as functions of ϕ and θ, and the numerical values of ϕ and θ stored in GerverThetaPhiNumericalSolutions. The code below computes several integrals of the functions appearing in the definition of Gerver’s sofa, and substitutes in the symbolic expressions and numerical parameter values to evaluate the area of Gerver’s sofa. Evaluate it - this may take Mathematica a minute or two. The area of the shape will be displayed when the computation is done.

GerverSofaAreaIntegral1Symbolic=-Integrate[(1-(Subscript[x, 2])[t][[2]])(Subscript[x, 2])'[t][[1]],{t,ϕ,θ}];
GerverSofaAreaIntegral2Symbolic=-Integrate[(1-(Subscript[x, 3])[t][[2]])(Subscript[x, 3])'[t][[1]],{t,θ,π/4}];
GerverSofaAreaIntegral3Symbolic=Integrate[(1-(Subscript[B, 4])[t][[2]])(Subscript[B, 4])'[t][[1]],{t,π/2-θ,π/2-ϕ}];
GerverSofaAreaIntegral4Symbolic=Integrate[(1-(Subscript[B, 5])[t][[2]])(Subscript[B, 5])'[t][[1]],{t,π/2-ϕ,π/2}];
GerverSofaAreaIntegral5Symbolic=-Integrate[(Subscript[A, 2])[t][[2]](Subscript[A, 2])'[t][[1]],{t,ϕ,θ}];
GerverSofaAreaIntegral6Symbolic=-Integrate[(Subscript[A, 3])[t][[2]](Subscript[A, 3])'[t][[1]],{t,θ,π/2-θ}];
GerverSofaAreaIntegral7Symbolic=-Integrate[(Subscript[A, 4])[t][[2]](Subscript[A, 4])'[t][[1]],{t,π/2-θ,π/2-ϕ}];
GerverSofaAreaIntegral8Symbolic=-Integrate[(Subscript[A, 5])[t][[2]](Subscript[A, 5])'[t][[1]],{t,π/2-ϕ,π/2}];

GerverSofaAreaTotalSymbolic=2(GerverSofaAreaIntegral1Symbolic+GerverSofaAreaIntegral2Symbolic+GerverSofaAreaIntegral3Symbolic+GerverSofaAreaIntegral4Symbolic+GerverSofaAreaIntegral5Symbolic+GerverSofaAreaIntegral6Symbolic+GerverSofaAreaIntegral7Symbolic+GerverSofaAreaIntegral8Symbolic);

GerverSofaAreaNumerical=GerverSofaAreaTotalSymbolic/.GerverSymbolicSolutions/.GerverThetaPhiNumericalSolutions

9. Solving the equations for the shape Σ (quick and easy numerical method)

We can repeat the equation-solving procedure shown above for Gerver’s sofa in the case of the system of 19 equations for the ambidextrous sofa, involving the 13 variables β,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[κ, 6,1]),(Subscript[κ, 6,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[e, 1]),(Subscript[e, 2]),(Subscript[f, 1]),(Subscript[f, 2]). After removing six redundant equations we call FindRoot[...], and Mathematica gives the numerical values.

Evaluate the next block of code. It computes the solutions, formats them in a table and displays the results.

AmbidextrousNumericalSolutions=FindRoot[
AmbidextrousEquations[[{1,2,3,4,5,6,7,8,9,10,11,12,15}]],
{β,0.3},{(Subscript[κ, 1,1]),0},{(Subscript[κ, 1,2]),0},{(Subscript[κ, 6,1]),0},{(Subscript[κ, 6,2]),0},{(Subscript[κ, 5,1]),0},{(Subscript[κ, 5,2]),0},{(Subscript[a, 1]),0},{(Subscript[a, 2]),0},{(Subscript[f, 1]),0},{(Subscript[f, 2]),0},{(Subscript[e, 1]),0},{(Subscript[e, 2]),0},AccuracyGoal->22,PrecisionGoal->22,MaxIterations->200,WorkingPrecision->30];

AmbidextrousNumericalSolutionsFormatted=NumberForm[MatrixForm[Transpose[{{β,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 6,1]),(Subscript[κ, 6,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[f, 1]),(Subscript[f, 2]),(Subscript[e, 1]),(Subscript[e, 2])},{β,(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 6,1]),(Subscript[κ, 6,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[f, 1]),(Subscript[f, 2]),(Subscript[e, 1]),(Subscript[e, 2])}/.AmbidextrousNumericalSolutions}]],22,DigitBlock->3];

AmbidextrousNumericalSolutionsFormatted

10. Solving the equations for the shape Σ (algebraic, closed form solutions)

In this section we show how the equations for the shape Σ can be solved in closed form in terms of radicals -- the process described in the proof of Theorem 4 in the paper. The idea is similar to the algebraic method for solving the equations for Gerver’s sofa described in section 7 above: solve 12 of the 13 independent equations for the 13 parameters to express all the “linear” parameters as functions of the angle β, and then substitute those solutions into the 13th equation to get a single nonlinear equation for β. That equation turns out to be algebraic in (e^(iβ)).

Evaluate the next command to solve the 12 linear equations symbolically in terms of β:

AmbidextrousSymbolicSolutions=Solve[
AmbidextrousEquations[[{1,2,3,4,5,6,7,8,9,10,11,12}]],
{(Subscript[κ, 1,1]),(Subscript[κ, 1,2]),(Subscript[κ, 6,1]),(Subscript[κ, 6,2]),(Subscript[κ, 5,1]),(Subscript[κ, 5,2]),(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[f, 1]),(Subscript[f, 2]),(Subscript[e, 1]),(Subscript[e, 2])}
][[1]];

Evaluate the next command to substitute the solutions back into the remaining equation to get a single nonlinear equation for β, and display the result so we can see what it looks like.

AmbidextrousBetaEquation=Simplify[AmbidextrousEquations[[19]]/.AmbidextrousSymbolicSolutions]

Note that this is an algebraic equation in W=Cos[(β/2)] and Sin[(β/2)]=(Sqrt[1-(W^2)]), so it can be solved algebraically without much effort:

AmbidextrousBetaEquationAlgebraic=TrigExpand[AmbidextrousBetaEquation]/.{Cos[(β/2)]->W,Sin[(β/2)]->(Sqrt[1-(W^2)])}//Simplify

AmbidextrousZSolutions=(W/.Solve[AmbidextrousBetaEquationAlgebraic,W])

We are interested in solutions that are real and in (0,1):

Select[Select[AmbidextrousZSolutions,Element[#,Reals]&],0<#<1&]

Success! We’ve found that W=Cos[(β/2)]=(1/2) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]). It turns out that Tan[β] has an even simpler formula, which results in the simplest way we found to express β. To verify this, first check that Sin[(β/2)]=(Sqrt[1-(W^2)])=(1/2) (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))]), by evaluating the next block of code computing the difference of those two quantities, which should evaluate to 0.

AmbidextrousSymbolicCosineBetaOverTwo=(1/2) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicSineBetaOverTwo=(1/2) (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicSineBetaOverTwo-(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])//Simplify (* This should evaluate to 0, which shows that our formula for Sin[(β/2)] is correct *)

Since Tan[β]=((Sin[β/2])/(Cos[β/2]))=((2Sin[β/2]Cos[β/2])/(((Cos[β/2])^2)-((Sin[β/2])^2))), the next command verifies that  Tan[β] is given by the expression (1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3))). Evaluating the difference and applying the FullSimplify command should give 0:

(2AmbidextrousSymbolicSineBetaOverTwo×AmbidextrousSymbolicCosineBetaOverTwo)/((AmbidextrousSymbolicCosineBetaOverTwo^2)-(AmbidextrousSymbolicSineBetaOverTwo^2))-(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3)))//FullSimplify

It is also interesting to compute the minimal polynomials of Cos[(β/2)], Sin[(β/2)], Tan[(β/2)], Cos[β], Sin[β], and Tan[β]. (There are more minimal polynomial computations in Section 12 below.) Try evaluating the next few commands.

(* The minimal polynomial of Cos[(β/2)] *)
MinimalPolynomial[AmbidextrousSymbolicCosineBetaOverTwo,x]//TraditionalForm

Cos[(β/2)] and Sin[(β/2)] have the same minimal polynomial:

(* The minimal polynomial of Sin[(β/2)] *)MinimalPolynomial[(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)]),x]//TraditionalForm

The minimal polynomial of Tan[(β/2)] is a bit simpler than the ones for the sine and cosine:

(* The minimal polynomial of Tan[(β/2)] *)
MinimalPolynomial[(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])/AmbidextrousSymbolicCosineBetaOverTwo,x]//TraditionalForm

(* The minimal polynomial of Cos[β] *)MinimalPolynomial[(AmbidextrousSymbolicCosineBetaOverTwo^2)-(AmbidextrousSymbolicSineBetaOverTwo^2),x]//TraditionalForm

(* The minimal polynomial of Sin[β] *)MinimalPolynomial[2AmbidextrousSymbolicSineBetaOverTwo×AmbidextrousSymbolicCosineBetaOverTwo,x]//TraditionalForm

(* The minimal polynomial of Tan[β] - the simplest one so far *)MinimalPolynomial[(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3))),x]//TraditionalForm

Next, we derive closed form expressions for the remaining parameters. Start with (Subscript[a, 1]). The evaluation is done in several steps: first, we take the symbolic formula for (Subscript[a, 1]) in terms of β, apply the TrigExpand[...] Mathematica function to it to bring it to a convenient form as a polynomial in Cos[(β/2)] and Sin[(β/2)]. Then  we substitute in the explicit algebraic values we found for Cos[(β/2)] and Sin[(β/2)].

a1symbolicexpression=TrigExpand[(Subscript[a, 1])/.AmbidextrousSymbolicSolutions]//Simplify

The second step, in the next command is to substitute in the explicit algebraic values we found for Cos[(β/2)] and Sin[(β/2)], and then apply the FullSimplify[...] command to invoke Mathematica’s powerful algebraic simplification machinery. The result expresses (Subscript[a, 1]) as the root of a certain polynomial.

a1symbolicexpressionsimplified=a1symbolicexpression/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])}//FullSimplify

Finally, applying the ToRadicals[...] command converts the number into an expression in radicals. Try the next command.

ToRadicals[a1symbolicexpressionsimplified]

Another success -- we have shown that (Subscript[a, 1])= (1/4) (Sqrt[4+(((71-8 (Sqrt[2])))^(1/3))+(((71+8 (Sqrt[2])))^(1/3))]).

Next, the parameters (Subscript[κ, 1,1]), (Subscript[κ, 6,1]), (Subscript[κ, 5,1]) are related to (Subscript[a, 1]) through simple relations, which are easy to verify:

((Subscript[κ, 1,1])+(Subscript[a, 1])/.AmbidextrousSymbolicSolutions)//Simplify   (* This should evaluate to 1, showing that (Subscript[κ, 1,1])=1-(Subscript[a, 1]) *)

For the verification of the claim about (Subscript[κ, 6,1]), we need to work a bit harder. First, define a variable encoding the linear combination (Subscript[κ, 6,1])+(4/3)(Subscript[a, 1])-1, which we want to verify is equal to 0. Applying TrigExpand[...] does some initial simplification.

KappaSixOneLinearCombination=TrigExpand[(Subscript[κ, 6,1])+(4/3)(Subscript[a, 1])-1/.AmbidextrousSymbolicSolutions]//Simplify

It turns out the expression involves factors like Cos[((3β)/2)]. The following command does some simple substitutions to express all such factors as polynomials in Cos[(β/2)] and Sin[(β/2)].

KappaSixOneLinearCombinationExpanded=KappaSixOneLinearCombination/.{Cos[((3 β)/2)]->TrigExpand[Cos[((3 β)/2)]],Sin[((3 β)/2)]->TrigExpand[Sin[((3 β)/2)]],Cos[((5 β)/2)]->TrigExpand[Cos[((5 β)/2)]],Sin[((5 β)/2)]->TrigExpand[Sin[((5β)/2)]]}

Finally, run the next command to substitute in the two explicit algebraic numbers Cos[(β/2)] and Sin[(β/2)] and invoke FullSimplify[...]. If the expression evaluates to 0, this proves our formula for (Subscript[κ, 6,1]).

(* If this next command evaluates to 0, this shows that (Subscript[κ, 6,1])=1-(4/3)(Subscript[a, 1]) *)
KappaSixOneLinearCombinationExpanded/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])}//FullSimplify

We repeat the same method for (Subscript[κ, 5,1]) to prove the formula (Subscript[κ, 5,1])=1-(5/3)(Subscript[a, 1]). Evaluate the next three code blocks. The last one should give 0.

KappaFiveOneLinearCombination=TrigExpand[(Subscript[κ, 5,1])+(5/3)(Subscript[a, 1])-1/.AmbidextrousSymbolicSolutions]//Simplify

KappaFiveOneLinearCombinationExpanded=KappaFiveOneLinearCombination/.{Cos[((3 β)/2)]->TrigExpand[Cos[((3 β)/2)]],Sin[((3 β)/2)]->TrigExpand[Sin[((3 β)/2)]],Cos[((5 β)/2)]->TrigExpand[Cos[((5 β)/2)]],Sin[((5 β)/2)]->TrigExpand[Sin[((5β)/2)]]}

(* If this next command outputs 0, this shows that (Subscript[κ, 5,1])=1-(5/3)(Subscript[a, 1]) *)
KappaFiveOneLinearCombinationExpanded/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])}//FullSimplify

Next, we calculate (Subscript[f, 1]), which also gives (Subscript[f, 2])=(1-(Sqrt[2]))(Subscript[f, 1]). Start by running the next command to represent (Subscript[f, 1]) symbolically in terms of β, after some initial TrigExpand[...] substitution and simplification.

f1SymbolicAsFunctionOfBeta=TrigExpand[(Subscript[f, 1])/.AmbidextrousSymbolicSolutions]//Simplify

Since Cos[β]=2((Cos[(β/2)])^2)-1, this can be written explicitly as ((-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3)))/(-3 (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))])+3 (-1+(Sqrt[2])) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]))), or as (1/3)((2(AmbidextrousSymbolicCosineBetaOverTwo^2)-1)/(((Sqrt[2])-1)AmbidextrousSymbolicCosineBetaOverTwo-AmbidextrousSymbolicSineBetaOverTwo)). This can be brought to the simpler form (1/(3(Sqrt[2(2-(Sqrt[2]))])))(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4)). To verify this, run the next command, which should evaluate to 1, proving equation (68) in the paper.

(* This should return 1 *)((1/3)((2(AmbidextrousSymbolicCosineBetaOverTwo^2)-1)/(((Sqrt[2])-1)AmbidextrousSymbolicCosineBetaOverTwo-AmbidextrousSymbolicSineBetaOverTwo)))/((1/(3(Sqrt[2(2-(Sqrt[2]))])))(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4)))//FullSimplify

Two remaining identities to verify are (Subscript[κ, 5,2])=1/2 and (Subscript[κ, 6,2])=1/2. Evaluate the next two commands to verify these claims.

(Subscript[κ, 5,2])/.AmbidextrousSymbolicSolutions//Simplify 
(* This should evaluate to 1/2 *)

((Subscript[κ, 6,2])/.AmbidextrousSymbolicSolutions//TrigExpand)/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])}//FullSimplify
(* This should evaluate to 1/2 *)

11. Closed form evaluation of the area of the shape Σ

The goal of this section is to prove:

Theorem. The area of the ambidextrous shape is  β+(((3-2 (Sqrt[2])))^(1/3))+(((3+2 (Sqrt[2])))^(1/3))-1
(This is the computational part of Theorem 5 in the paper.)

First, we express the area of the shape as a sum of several integrals, making use of the left-right and up-down symmetries. Evaluate the next block of code. (Note: this requires running the code in Section 10 first.) This may take a minute or two.

AmbidextrousAreaPart1=Integrate[-((Subscript[A, 6])[t][[2]]-1/2)(Subscript[A, 6])'[t][[1]],{t,β,π/2-β}];
AmbidextrousAreaPart2=Integrate[-((Subscript[A, 5])[t][[2]]-1/2)(Subscript[A, 5])'[t][[1]],{t,π/2-β,π/2}];
AmbidextrousAreaPart3=Integrate[(1/2-(Subscript[B, 6])[t][[2]])(Subscript[B, 6])'[t][[1]],{t,β,π/2-β}];
AmbidextrousAreaPart4=Integrate[(1/2-(Subscript[B, 5])[t][[2]])(Subscript[B, 5])'[t][[1]],{t,π/2-β,π/2}];
AmbidextrousAreaPart5=Integrate[-(1/2-(Subscript[x, 6])[t][[2]])(Subscript[x, 6])'[t][[1]],{t,β,π/4}];

AmbidextrousAreaTotal=4(AmbidextrousAreaPart1+AmbidextrousAreaPart2+AmbidextrousAreaPart3+AmbidextrousAreaPart4+AmbidextrousAreaPart5);

AmbidextrousAreaTotalNumerical=AmbidextrousAreaTotal/.AmbidextrousSymbolicSolutions/.AmbidextrousPrecomputedNumericalConstants;

As a sanity check to see that we got something reasonable, evaluate the next line to get the numerical value of the area:

AmbidextrousAreaTotalNumerical

We are more interested however in the area as a symbolic expression in the critical angle β. Run the next command to get such an expression. We make the substitution β=2η to get a less messy formula.

ambiareasymbolic=((AmbidextrousAreaTotal/.AmbidextrousSymbolicSolutions//Simplify)/.{β->2η})

On inspecting the formula, we see that it is of the form P(η)η+Q(η), where P(η) and Q(η) are each rational functions in Cos(η) and Sin(η) and are therefore algebraic numbers. Our goal is to find them, and we can achieve it using a bit of automated symbolic math wizardry. First, run the next command to separate P(η) and Q(η), replace any appearance of η inside a cosine or sine with a different variable, ν, then collect over powers of η:

ambiareasymbolicmodified=Collect[ambiareasymbolic/.{Cos[η]->Cos[ν],Sin[η]->Sin[ν],Cos[k_ η]->Cos[k ν],Sin[k_ η]->Sin[k ν]},η]

We can now isolate the P and Q coefficients, expressing them in terms of the original variable β. Evaluate the next block of code to do this.

Pcoefficient=CoefficientList[ambiareasymbolicmodified,η][[2]]/.{ν->β/2};
Qcoefficient=CoefficientList[ambiareasymbolicmodified,η][[1]]/.{ν->β/2};

(* Look to see what we got *)
{Pcoefficient,Qcoefficient}

As always, it helps to look at numerical values for error-checking and to keep our algebraic intuition grounded in reality. Try this line:

{Pcoefficient,Qcoefficient}/.AmbidextrousPrecomputedNumericalConstants

The P coefficient appears to be equal to 2. That corresponds to a contribution of 2η=β to the area, as the theorem claims. By substituting the values Cos[(β/2)]=(1/2) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]), Sin[(β/2)]=(1/2) (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))]) and Cos[β]=(1/2) (-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))), Sin[β]=(Sqrt[1-((Cos[β])^2)]) into the formula we can verify this rigorously. Evaluate the next line, which should evaluate to 2.

(* This should evaluate to 2 *)Pcoefficient/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->AmbidextrousSymbolicSineBetaOverTwo,Cos[β]->AmbidextrousSymbolicCosineBeta,Sin[β]->(Sqrt[1-(AmbidextrousSymbolicCosineBeta^2)])}//FullSimplify

The formula for the Q coefficient is more complicated so we have to work a bit harder. First, evaluate the next block of code. This expresses everything in the Q coefficient in terms of Cos(β/2) and Sin(β/2) by using the TrigExpand[] command to expand out more complicated trigonometric factors, like Sin(4β):

Qcoefficientalgebraic=Qcoefficient/.{Sin[2β]->TrigExpand[Sin[2 β]],Sin[3β]->TrigExpand[Sin[3 β]],Sin[4β]->TrigExpand[Sin[4 β]],Sin[5β]->TrigExpand[Sin[5 β]],Cos[2β]->TrigExpand[Cos[2 β]],Cos[3β]->TrigExpand[Cos[3 β]],Cos[4β]->TrigExpand[Cos[4 β]],Cos[5β]->TrigExpand[Cos[5 β]],Cos[((3β)/2)]->TrigExpand[Cos[((3β)/2)]],Cos[((5β)/2)]->TrigExpand[Cos[((5β)/2)]],Cos[((7β)/2)]->TrigExpand[Cos[((7β)/2)]],Sin[((3β)/2)]->TrigExpand[Sin[((3β)/2)]],Sin[((5β)/2)]->TrigExpand[Sin[((5β)/2)]],Sin[((7β)/2)]->TrigExpand[Sin[((7β)/2)]]}/.{Cos[β]->((Cos[(β/2)])^2)-((Sin[(β/2)])^2),Sin[β]->2Sin[(β/2)]Cos[(β/2)]}/.{Cos[(β/2)]->AmbidextrousSymbolicCosineBetaOverTwo,Sin[(β/2)]->(Sqrt[1-(AmbidextrousSymbolicCosineBetaOverTwo^2)])};

Evaluate the next line to see the result if you dare - the resulting expression is too big to display on the screen (but don’t worry, Mathematica will recognize this and only display a small part of the output, giving you the option to control how much more you want displayed).

Qcoefficientalgebraic

Mathematica however is unfazed by such complexity. The number is algebraic, and by calling the FullSimplify[...] command we tell Mathematica to express the number as a root of a polynomial (or some other simple form if one exists). To see this in action, run the next command, and go make yourself a cup of tea (the computation takes a few minutes...). When you return, the answer will be waiting.

Qcoefficientalgebraicsimplified=Qcoefficientalgebraic//FullSimplify

We have obtained our Q coefficient as the root of a cubic equation. Finally, by running the next line and checking that it evaluates to 0, we can verify that it is indeed given by the value (((3-2 (Sqrt[2])))^(1/3))+(((3+2 (Sqrt[2])))^(1/3))-1 claimed in the theorem.

FullSimplify[Qcoefficientalgebraicsimplified-((((3-2 (Sqrt[2])))^(1/3))+(((3+2 (Sqrt[2])))^(1/3))-1)]

The proof is complete.

12. Computation of the minimal polynomials of the parameters of the shape Σ

In the previous two sections we found formulas for all the parameters and for the area of the shape in terms of radicals. Here we compute the associated minimal polynomials that are listed in Table 2 of the paper.

First, repeat some definitions (also contained in the initialization code) to remind ourselves of the formulas we are working with, and define an array containing the names and values of the quantities to display them in a formatted table. Run the next block of code to display the resulting table (just for reference - no minimal polynomials are computed yet).

AmbidextrousSymbolicTanBeta=(1/2)(((((Sqrt[2])+1))^(1/3))-((((Sqrt[2])-1))^(1/3)));
AmbidextrousSymbolicCosineBeta=(1/2) (-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3)));
AmbidextrousSymbolicSineBeta=(Sqrt[1-(AmbidextrousSymbolicCosineBeta^2)]);
AmbidextrousSymbolicCosineBetaOverTwo=(1/2) (Sqrt[2-(Sqrt[2])+(((2 (-4+3 (Sqrt[2]))))^(1/3))+(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicSineBetaOverTwo=(1/2) (Sqrt[2+(Sqrt[2])-(((2 (-4+3 (Sqrt[2]))))^(1/3))-(((2 (4+3 (Sqrt[2]))))^(1/3))]);
AmbidextrousSymbolicaOne=(1/4)(Sqrt[4+(((71+8(Sqrt[2])))^(1/3))+(((71-8(Sqrt[2])))^(1/3))]);
AmbidextrousSymbolicKappaOneOne=1-AmbidextrousSymbolicaOne;
AmbidextrousSymbolicKappaSixOne=1-(4/3)AmbidextrousSymbolicaOne;
AmbidextrousSymbolicKappaFiveOne=1-(5/3)AmbidextrousSymbolicaOne;
AmbidextrousSymbolicfOne=(1/(3(Sqrt[2(2-(Sqrt[2]))])))(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4));
AmbidextrousSymbolicfTwo=-((Sqrt[2-(Sqrt[2])])/6)(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4));
AmbidextrousSymbolicAreaMinusBeta=(((3+2 (Sqrt[2])))^(1/3))+(((3-2 (Sqrt[2])))^(1/3))-1;
AmbidextrousSymbolicaSofaLength=(2/3)(Sqrt[4+(((71+8(Sqrt[2])))^(1/3))+(((71-8(Sqrt[2])))^(1/3))]);

AmbidextrousSofaAlgebraicParameters={
{"Tan(β)",AmbidextrousSymbolicTanBeta},
{"Cos(β)",AmbidextrousSymbolicCosineBeta},
{"Sin(β)",AmbidextrousSymbolicSineBeta},
{"Tan(β/2)",AmbidextrousSymbolicSineBetaOverTwo/AmbidextrousSymbolicCosineBetaOverTwo},{"Cos(β/2)",AmbidextrousSymbolicCosineBetaOverTwo},
{"Sin(β/2)",AmbidextrousSymbolicSineBetaOverTwo},
{"(Subscript[a, 1])",AmbidextrousSymbolicaOne},
{"(Subscript[f, 1])",AmbidextrousSymbolicfOne},
{"(Subscript[f, 2])",AmbidextrousSymbolicfTwo},
{"(Subscript[κ, 1, 1])",AmbidextrousSymbolicKappaOneOne},
{"(Subscript[κ, 6, 1])",AmbidextrousSymbolicKappaSixOne},
{"(Subscript[κ, 5, 1])",AmbidextrousSymbolicKappaFiveOne},
{"Λ-β",AmbidextrousSymbolicAreaMinusBeta},
{"length",AmbidextrousSymbolicaSofaLength}
};

AmbidextrousSofaAlgebraicParameters//MatrixForm

The next command will now compute the associated minimal polynomial for each of the quantities and again display the results in a table.

Map[{#[[1]],MinimalPolynomial[#[[2]]][x]}&,AmbidextrousSofaAlgebraicParameters]//MatrixForm//TraditionalForm

13. Verification of the algebraic curve formulas for boundary segments of Σ

In this section we verify the claims made in Section 6 in the paper that the boundary segments (Subscript[σ, 18]), (Subscript[σ, 4]) and (Subscript[σ, 9]) lie on specific algebraic curves of degree 6.

13.1 Definitions of various algebraic constants

Start by redefining the algebraic constant (Subscript[f, 1]) associated with Σ, and defining the numerical parameters (Subscript[γ, 1]),(Subscript[γ, 2]),(Subscript[γ, 3]),(Subscript[γ, 4]),(Subscript[γ, 5]),(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4]), all of which are cubic algebraic numbers. Evaluate the next command to load the definitions.

AmbidextrousSymbolicfOne=(1/(3(Sqrt[2(2-(Sqrt[2]))])))(((83+(((420619+15104 (Sqrt[2])))^(1/3))+(((420619-15104 (Sqrt[2])))^(1/3))))^(1/4));

Z=(((4-2 (Sqrt[2])))^(1/3))+(((4+2(Sqrt[2])))^(1/3)); (* Z is the real root of the cubic polynomial (x^3)-6x-8 *)

(* Calling RootReduce in the definitions of (Subscript[α, j]), (Subscript[γ, j]) reduces the time it takes Mathematica to verify the algebraic identities below *)
(Subscript[γ, 1])=-3Z+14//RootReduce;
(Subscript[γ, 2])=-Z+4//RootReduce;
(Subscript[γ, 3])=-27(Z^2)+156Z-190//RootReduce;
(Subscript[γ, 4])=8(Z^2)-26Z+8//RootReduce;
(Subscript[γ, 5])=9Z-20//RootReduce;

(Subscript[α, 1])=-3Z+16//RootReduce; 
(Subscript[α, 2])=27(Z^2)-240Z+592//RootReduce;
(Subscript[α, 3])=12(Z^2)-54Z+56//RootReduce;
(Subscript[α, 4])=-9Z+28//RootReduce;

Evaluate the next two commands to see the numerical values of the parameters and their minimal polynomials.

{(Subscript[γ, 1]),(Subscript[γ, 2]),(Subscript[γ, 3]),(Subscript[γ, 4]),(Subscript[γ, 5]),(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4])}//N

{(Subscript[γ, 1]),(Subscript[γ, 2]),(Subscript[γ, 3]),(Subscript[γ, 4]),(Subscript[γ, 5]),(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4])}//MinimalPolynomial[#,x]&//Column//TraditionalForm

13.2 Definitions of the bivariate polynomials

Evaluate the next command to load the definitions of the polynomials P[X,Y], Q[X,Y], R[X,Y]. For each of the algebraic equations P[X,Y]=0, Q[X,Y]=0, R[X,Y]=0 we want to show that a boundary segment of the shape Σ lies on the curve.

P[X_,Y_]:=((((X^2)+(Y^2)-8))^3)-216(((Y-X))^2);
Q[X_,Y_]:=((((X^2)+(Y^2)))^3)-12(Subscript[γ, 1])((((X^2)+(Y^2)))^2)-216(Sqrt[(Subscript[γ, 2])])((X^2)+(Y^2))(Y-X)-12(Subscript[γ, 3])((X^2)+(Y^2))-432(Sqrt[(Subscript[γ, 4])])(Y-X)+432X Y-32(Subscript[γ, 5]);
R[X_,Y_]:=((((X^2)+(Y^2)))^3)-24(Subscript[α, 1])((((X^2)+(Y^2)))^2)+48(Subscript[α, 2])((X^2)+(Y^2))+ 13824(Sqrt[(Subscript[α, 3])])Y+4096(Subscript[α, 4]);

1.3 Definitions of the functions associated with the boundary segments (Subscript[σ, 18]), (Subscript[σ, 4]) and (Subscript[σ, 5]) of the shape Σ

The next command defines functions associated with the boundary segments (Subscript[σ, 18]), (Subscript[σ, 4]) and (Subscript[σ, 5]), by taking the generic formula for the rotation path (Subscript[x, 6])[t] (the solution of the ODE associated with Case 6 in Theorem 2) and the associated contact paths (Subscript[A, 6])[t], (Subscript[B, 6])[t] and making the substitution (Subscript[f, 2])->(1-(Sqrt[2]))(Subscript[f, 1]).

AmbidextrousBoundarySegment18=(Subscript[A, 6])[t]/.{(Subscript[f, 2])->(1-(Sqrt[2]))(Subscript[f, 1])};
AmbidextrousBoundarySegment4=(Subscript[B, 6])[t]/.{(Subscript[f, 2])->(1-(Sqrt[2]))(Subscript[f, 1])};
AmbidextrousBoundarySegment5=(Subscript[x, 6])[t]/.{(Subscript[f, 2])->(1-(Sqrt[2]))(Subscript[f, 1])};

Evaluate the next commands to inspect the functions.

AmbidextrousBoundarySegment18

AmbidextrousBoundarySegment4

AmbidextrousBoundarySegment5

13.4 The boundary segment (Subscript[σ, 18])

The next line verifies the algebraic equation P[X,Y]=0 for the boundary segment (Subscript[σ, 18]) of the shape Σ, by plugging in the x and y components of AmbidextrousBoundarySegment18, after the appropriate affine change of variables., and simplifying the result. Run the command - it should evaluate to 0.

P[((AmbidextrousBoundarySegment18[[1]]-(Subscript[κ, 6,1]))/((Subscript[f, 1])((Sqrt[2-(Sqrt[2])])/4))),((AmbidextrousBoundarySegment18[[2]]-(Subscript[κ, 6,2]))/((Subscript[f, 1])((Sqrt[2-(Sqrt[2])])/4)))]//Simplify

13.5 The boundary segment (Subscript[σ, 4])

Next, we try to verify the algebraic relation for the boundary segment (Subscript[σ, 4])of the shape Σ. The command below substitutes the functions for the parametric representation of the boundary segment (Subscript[σ, 4]) into Q[X,Y] after making the affine change of variables. The resulting expression should be identically 0, but it’s quite a complicated expression involving a polynomial in various algebraic numbers and trigonometric functions. In order to get Mathematica to verify that it simplifies ot 0 using a FullSimplify command, it’s beneficial to first do a bit of symbolic math manipulation to represent the expression as a polynomial in Cos[t/2] and Sin[t/2]=(Sqrt[1-((Cos[t/2])^2)]) and then simplify each of the coefficients of the polynomial separately. 

To do this, evaluate the next two code blocks. If the second evaluation returns an array of zeroes, that means the expression simplified to 0, which proves that the AmbidextrousBoundarySegment4 function lies on the algebraic curve Q[X,Y]=0 (with the appropriate affine change of variables).

ExpressionThatShouldBeZero=(Q[Simplify[((AmbidextrousBoundarySegment4[[1]]-(Subscript[κ, 6,1]))/((Subscript[f, 1])((Sqrt[2-(Sqrt[2])])/4)))],Simplify[((AmbidextrousBoundarySegment4[[2]]-(Subscript[κ, 6,2]))/((Subscript[f, 1])((Sqrt[2-(Sqrt[2])])/4)))]]/.{(Subscript[f, 1])->AmbidextrousSymbolicfOne,(Subscript[f, 1]^(k_))->(AmbidextrousSymbolicfOne^k),t->2s});
ExpressionThatShouldBeZeroCoefficientsAfterSubstitutions=CoefficientList[Collect[((ExpressionThatShouldBeZero//TrigExpand)/.{Cos[s]->u,Sin[s]->(Sqrt[1-(u^2)])}),(Sqrt[1-(u^2)])]/.{(Sqrt[1-(u^2)])->v},{u,v}];

The next command should evaluate to an array of zeroes. The computation takes a couple of minutes.

ExpressionThatShouldBeZeroCoefficientsAfterSubstitutions//RootReduce

13.6 The boundary segment (Subscript[σ, 5])

Next, we verify the algebraic relation Q[X,Y]=0 for the boundary segment (Subscript[σ, 5]) of the shape Σ, following a similar approach as the one used above for the boundary segment (Subscript[σ, 4]). Again, evaluate the next two blocks of code. The second block should give an array of zeroes.

AnotherExpressionThatShouldBeZero=(R[Simplify[((AmbidextrousBoundarySegment5[[1]]-(Subscript[κ, 6,1]))/((Subscript[f, 1])(Sqrt[2-(Sqrt[2])])/4))],Simplify[((AmbidextrousBoundarySegment5[[2]]-(Subscript[κ, 6,2]))/((Subscript[f, 1])(Sqrt[2-(Sqrt[2])])/4))]]/.{(Subscript[f, 1])->AmbidextrousSymbolicfOne,(Subscript[f, 1]^(k_))->(AmbidextrousSymbolicfOne^k),t->2s});
AnotherExpressionThatShouldBeZeroCoefficientsAfterSubstitutions=CoefficientList[Collect[((AnotherExpressionThatShouldBeZero//TrigExpand)/.{Cos[s]->u,Sin[s]->(Sqrt[1-(u^2)])}),(Sqrt[1-(u^2)])]/.{(Sqrt[1-(u^2)])->v},{u,v}];

The next command should evaluate to an array of zeroes. The computation takes a couple of minutes.

AnotherExpressionThatShouldBeZeroCoefficientsAfterSubstitutions//RootReduce

14. Some fun interactive visualizations

The understanding of the moving sofa problem can be greatly enhanced by the ability to easily visualize the different shapes appearing in the study of the problem, and the process of moving a shape around a corner. Here you can experiment with several interactive visualizations that help develop your intuition. Try running the commands below and experimenting with the sliders and other interactive controls.

SofaVisualizationGeneralizedHammersleySofasAreas

SofaVisualizationSquareSofaInHallway

SofaVisualizationSemicircularSofaInHallway

SofaVisualizationHammersleySofaInHallway

SofaVisualizationGeneralizedHammersleySofasInHallway

SofaVisualizationGerverSofaInHallway

SofaVisualizationAmbidextrousSofaInHallway

If you haven’t had enough, here is a single visualization combining the above visualizations of moving the various sofas around a corner:

SofaVisualizationsCombined

15. Package documentation

The initialization code in this package is functional and correct as far as I know, but has not been thoroughly polished and may violate some coding best practices (especially the last section with the figures and interactive visualizations) -- sorry. Here is a documentation of some of the main functions and symbols the package defines and how you can use them (of course, the main intended use is just running the code in Sections 2-13, which does not require understanding the initialization code definitions). Feel to modify, extend, or otherwise experiment with the code - for example, if you are writing a blog or paper about the moving sofa problem, you can use the code for my figures, change the colors, add or remove some graphic elements, etc., to generate your own figures and animations. (If you create such material, I’d love to see it, so feel free to email me about it! And if you are a student using my code or figures for an assignment or project, remember that you must cite this package as a source; not doing so constitutes plagiarism and is very likely to get you into trouble.)

(Subscript[x, 1])[t_], (Subscript[x, 2])[t_], (Subscript[x, 3])[t_], (Subscript[x, 4])[t_], (Subscript[x, 5])[t_], (Subscript[x, 6])[t_]
The functions defined in Theorem 3 of the paper. 
Try evaluating: (Subscript[x, 1])[t]

μ[t_], ν[t_]
The basis vectors of a rotating orthonormal frame defined just before Theorem 1 in the papre. 
Try evaluating: μ[t]

(Subscript[A, j_])[t_], (Subscript[B, j_])[t_], (Subscript[C, j_])[t_], (Subscript[D, j_])[t_]
The contact paths A[t], B[t], C[t], D[t], computed from the respective rotation path (Subscript[x, j])[t], i.e., (Subscript[A, 1])[t] is calculated from (Subscript[x, 1])[t] according to equation (9) in the paper.
Try evaluating: (Subscript[C, 4])[t]

Gerverx[t_], GerverA[t_], GerverB[t_], GerverC[t_], GerverD[t_]
Gerverx[t] is the rotation path x(t) associated with Gerver’s sofa, defined in equation (25) in the paper. The remaining four functions are the contact paths associated with the same rotation path, obtained from it by substituting Gerverx[t] into the right-hand side of equations (9)-(12).
Try evaluating: GerverD[0] to get the coordinates of one of the interesting points on the boundary of the sofa.

Ambix[t_], AmbiA[t_], AmbiB[t_], AmbiC[t_], AmbiD[t_]
Ambix[t] is the rotation path x(t) associated with Gerver’s sofa, defined in equation (47) in the paper. The remaining four functions are the contact paths associated with the same rotation path, obtained from it by substituting Ambix[t] into the right-hand side of equations (9)-(12).
Try evaluating: AmbiC[π/2] to get the coordinates of the left endpoint of the shape Σ.

GerverEquations
Equations (27)-(44) from the paper, the system of equations that need to be solved to get the numerical values of the parameters associated with Gerver’s sofa. This definition is used in Sections 6-7 of this notebook.

AmbidextrousEquations
Equations (48)-(60) from the paper, the system of equations that need to be solved to get the numerical values of the parameters associated with Gerver’s sofa. This definition is used in Sections 9-10 of this notebook.

GerverAngleϕ
GerverAngleθ
GerverPrecomputedNumericalArea
GerverPrecomputedNumericalConstants
These variables contain precomputed numerical values for the critical angles ϕ and θ and the remaining parameters associated with Gerver’s sofa. Useful for doing numerical computations, creating graphics of the sofa, etc.

AmbidextrousAngleβ
AmbidextrousPrecomputedNumericalConstants
These variables contain precomputed numerical values for the critical angle β and the remaining parameters associated with the ambidextrous sofa shape Σ..

AmbidextrousSymbolicBeta
AmbidextrousSymbolicBetaAlternative
AmbidextrousSymbolicTanBeta
AmbidextrousSymbolicCosineBeta
AmbidextrousSymbolicCosineBetaOverTwo
AmbidextrousSymbolicSineBetaOverTwo
AmbidextrousSymbolicaOne
AmbidextrousSymbolicKappaOneOne
AmbidextrousSymbolicKappaSixOne
AmbidextrousSymbolicKappaFiveOne
AmbidextrousSymbolicfOne
AmbidextrousSymbolicfTwo
AmbidextrousSymbolicAreaMinusBeta
AmbidextrousSymbolicArea
AmbidextrousSymbolicaSofaLength
These variables contain closed form algebraic formulas the parameters associated with the ambidextrous sofa shape Σ.

GerverxNumerical[t_]
GerverANumerical[t_]
GerverBNumerical[t_]
GerverCNumerical[t_]
GerverDNumerical[t_]
These functions are like Gerverx[t], GerverA[t], etc., except that the symbolic references to the parameters of Gerver’s sofa are substituted with their numerically computed values. Again useful for computations and graphics.

AmbixNumerical[t_]
AmbiANumerical[t_]
AmbiBNumerical[t_]
AmbiCNumerical[t_]
AmbiDNumerical[t_]
These functions are like Ambix[t], AmbiA[t], etc., except that the symbolic references to the parameters of the shape Σ are substituted with their numerically computed values.

SofaDefaultNumSubdivisionPoints
SofaDefaultFillingColor
SofaHallwayDefaultFillingColor
SquareSofaDefaultFillingColor
SemicircleSofaDefaultFillingColor
HammersleySofaDefaultFillingColor
GerverSofaDefaultFillingColor
AmbidextrousSofaDefaultFillingColor
Definitions related to plotting graphics of various sofa shapes. For example, change the definition of SofaDefaultFillingColor (globally, or locally through a ReplaceAll[...] substitution) to create figures where the sofa interior is a different color.

SofaHallway[armlength_]
SofaHallwayTwoCorners[armlength_]
These functions return graphics primitives for plotting a hallway with either one or two right-angled corners. 
Try evaluating: Graphics[SofaHallway[3]]

SquareSofa
SemicircleSofa
SemicircleSofaRotationPath
HammersleyGeneralizedSofa[innerradius_]
HammersleySofa
GerverSofa
AmbidextrousSofa
OneSidedAmbidextrousSofa
OneSidedAmbidextrousSofaWithReflection
These variables contain graphics primitives for plotting the different kinds of sofa shapes described in the paper.
Try evaluating:
Graphics[SemicircleSofa]
Graphics[{HammersleyGeneralizedSofa[0.3], SofaHallway[3]}]
etc.

GerverSofaRotationPathDashedSegments
GerverSofaNormalTickMarks
AmbidextrousSofaRotationPathDashedSegments
AmbidextrousSofaNormalTickMarks
Variables that contain graphics primitives for interesting features associated with Gerver’s sofa and the shape Σ.
Try evaluating: Graphics[{AmbidextrousSofa, AmbidextrousSofaNormalTickMarks}]

SofaPaperFigureSquareSemicircle
SofaPaperFigureGerverSofaWithTicks
SofaPaperFigureAmbidextrousSofaWithTicks
SofaPaperFigureOneSidedAmbidextrousSofaWithReflection
SofaPaperContactPathsFigure
SofaPaperRotationPathFigure
SofaPaperFigureHammersleySofa
Figures I created for the paper.

SofaVisualizationGeneralizedHammersleySofasAreas
SofaVisualizationSquareSofaInHallway
SofaVisualizationSemicircularSofaInHallway
SofaVisualizationHammersleySofaInHallway
SofaVisualizationGeneralizedHammersleySofasInHallway
SofaVisualizationGerverSofaInHallway
SofaVisualizationAmbidextrousSofaInHallway
SofaVisualizationsCombined
The interactive visualizations (see Section 14).

16. Change log

Version 1.0: released June 26, 2016

Initial version

Version 1.1: released June 28, 2016

Added code in Section 10 to verify that (Subscript[κ, 5,2])=(Subscript[κ, 6,2])=0

Version 1.2: released July 6, 2016

Added new interactive graphics visualizations SofaVisualizationSquareSofaInHallway, SofaVisualizationSemicircularSofaInHallway, SofaVisualizationHammersleySofaInHallway, and an “ultimate” visualization SofaVisualizationsCombined that combines the various different visualizations of sofas moving around a corner.

Added a new section, Section 13, in which an automated verification is given for the new claims that were added in the updated version of the paper about segments of the boundary of the shape Σ lying on algebraic curves of degree 6.

Version 1.3: released July 10, 2016

Simplified the definitions of the constants (Subscript[γ, 1]),(Subscript[γ, 2]),(Subscript[γ, 3]),(Subscript[γ, 4]),(Subscript[γ, 5]),(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4]) and the polynomials P[X,Y], Q[X,Y], R[X,Y] in Section 13.