Gerver Sofa

Author

Eric W. Weisstein
December 14, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/GerverSofa.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/GerverSofa.html.

©2024 Wolfram Research, Inc. except for portions noted otherwise

Figure

Gerver

Gerver sofa

Shape

Romik from movingsofas-v1 .3.nb:

Graphics[GerverSofa]

Graphics[{GerverSofa,GerverSofaNormalTickMarks},ImageSize->500]

Wikipedia:

Import["https://upload.wikimedia.org/wikipedia/commons/9/92/Gerver.svg"]

Animation

From Dan Romik's SofaVisualizationGerverSofaInHallway routine in movingsofas-v1 .3.nb

GerverSofaAnimation=Table[Show[
SofaMovieWithHallwayMultiPOV[4,1.7,
{GerverSofa},
GerverSofaRotationPath,t,"Hallway",{{-4,1},{-4,1}},{{-0.5+GerverCNumerical[π/2][[1]],1.5},{-0.5,1.5}}]],{t,0,3,.05}]

ListAnimate[GerverSofaAnimation]

(gif=Export[FileNameJoin[{"/Users/eww/Sites/mathworld.wolfram.com/htdocs/images/gifs","MovingSofaGerverAnimation.gif"}],GerverSofaAnimation,ImageSize->150])//AbsoluteTiming

Tally[ImageDimensions/@Import[gif]]

Area parameters

eqns={
A(Cos[θ]-Cos[ϕ])-2B Sin[ϕ]+(θ-ϕ-1)Cos[θ]-Sin[θ]+Cos[ϕ]+Sin[ϕ]==0,
A(3Sin[θ]+Sin[ϕ])-2B Cos[ϕ]+3(θ-ϕ-1)Sin[θ]+3Cos[θ]-Sin[ϕ]+Cos[ϕ]==0,
A Cos[ϕ]-(Sin[ϕ]+1/2-1/2Cos[ϕ]+B Sin[ϕ])==0,
(A+Pi/2-ϕ-θ)-(B-(θ-ϕ)(1+A)/2-(θ-ϕ)^2/4)==0
};

eqns//Column//TraditionalForm

vars={A,B,ϕ,θ};

nsoln=FindRoot[eqns,{A,.1},{B,1.4},{ϕ,.04},{θ,.68},WorkingPrecision->50]

First/@eqns/.nsoln

inits={.1,1.4,.04,.68};

roots[eqns_,vars_,inits_]:=Module[{nsoln,pureeqn,approx,rts},nsoln=FindRoot@@{eqns,Sequence@@Transpose[{vars,inits}],WorkingPrecision->50};
pureeqn=Function/@(Subtract@@@eqns/. Thread[vars->(Slot/@Range[Length[vars]])]);
approx=Round[nsoln[[All,-1]],10^-10.];
Thread[vars->Table[Root@@{{pureeqn,approx},i},{i,Length[vars]}]]]

soln=roots[eqns,vars,inits]

nsoln[[All,-1]]-soln[[All,-1]]

Area

From shape

Area[DiscretizeGraphics[,PerformanceGoal->"Quality"]]

Area[FirstCase[,_Polygon,Missing,∞]]

InputForm[%]

Actual: 2.219531668871967...

Analytic

See Gerver or Finch

r[a_]:=Piecewise[{
{1/2,0<a<ϕ},
{1/2(1+A+a-ϕ),ϕ<a<θ},
{A+a-ϕ,θ<a<Pi/2-θ},
{B-1/2(Pi/2-a-ϕ)(1+A)-(Pi/2-a-ϕ)^2/4,Pi/2-θ<a<Pi/2-ϕ}
}]
s[a_]:=1-r[a]
u[a_]:=Piecewise[{
{B-(a-ϕ)(1+A)/2,ϕ<a<θ},
{A+Pi/2-ϕ-a,θ<a<Pi/4}
}]
du[a_]:=Piecewise[{
{-1/2(1+a)-(a-ϕ)/2,ϕ<a<θ},
{-1,θ<a<Pi/4}
}]

Plot[Evaluate[{r[a],s[a],u[a],du[a]}/.soln],{a,0,Pi/2},
PlotStyle->{Red,Orange,Green,Blue,Purple},
PlotLegends->{HoldForm[r[α]],HoldForm[s[α]],HoldForm[u[α]],HoldForm[(Subscript[D, u])[α]]},
Exclusions->None,LabelStyle->Directive[FontFamily->"Times"]]

Integrate

y1[a_]:=1-Integrate[r[t]Sin[t],{t,0,a}]
y2[a_]:=1-Integrate[s[t]Sin[t],{t,0,a}]
y3[a_]:=1-Integrate[s[t]Sin[t],{t,0,a}]-u[a]Sin[a]

Block[{A=,B=,ϕ=,θ=},
2(Integrate[y1[a]r[a]Cos[a],{a,0,Pi/2-ϕ}]+
Integrate[y2[a]s[a]Cos[a],{a,0,θ}]+
Integrate[y3[a](u[a]Sin[a]-du[a]Cos[a]-s[a]Cos[a]),{a,ϕ,Pi/4}])]//Timing

NIntegrate

Block[{A=,B=,ϕ=,θ=},
2(NIntegrate[y1[a]r[a]Cos[a],{a,0,Pi/2-ϕ}]+
NIntegrate[y2[a]s[a]Cos[a],{a,0,θ}]+
NIntegrate[y3[a](u[a]Sin[a]-du[a]Cos[a]-s[a]Cos[a]),{a,ϕ,Pi/4}])]//Timing

Block[{A=0.0944265608,B=1.3992037273,ϕ=0.0391773648,θ=0.6813015094},
2(NIntegrate[y1[a]r[a]Cos[a],{a,0,Pi/2-ϕ}]+
NIntegrate[y2[a]s[a]Cos[a],{a,0,θ}]+
NIntegrate[y3[a](u[a]Sin[a]-du[a]Cos[a]-s[a]Cos[a]),{a,ϕ,Pi/4}])]//Timing

Block[{A=0.0944265608,B=1.3992037273,ϕ=0.0391773648,θ=0.6813015094},
2(NIntegrate[y1[a]r[a]Cos[a],{a,0,Pi/2-ϕ},Method->"MonteCarlo"]+
NIntegrate[y2[a]s[a]Cos[a],{a,0,θ},Method->"MonteCarlo"]+
NIntegrate[y3[a](u[a]Sin[a]-du[a]Cos[a]-s[a]Cos[a]),{a,ϕ,Pi/4},Method->"MonteCarlo"])]//Timing

Block[{A=0.0944265608,B=1.3992037273,ϕ=0.0391773648,θ=0.6813015094},
2(NIntegrate[y1[a]r[a]Cos[a],{a,0,Pi/2-ϕ},Method->"QuasiMonteCarlo"]+
NIntegrate[y2[a]s[a]Cos[a],{a,0,θ},Method->"QuasiMonteCarlo"]+
NIntegrate[y3[a](u[a]Sin[a]-du[a]Cos[a]-s[a]Cos[a]),{a,ϕ,Pi/4},Method->"QuasiMonteCarlo"])]//Timing

A128463

2.219531668871967...