Reuleaux Triangle

Author

Eric W. Weisstein
July 30, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Laminae/ReuleauxTriangle.nb.

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

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

Definitions

ineq=(-(a/2)+x)^2+(a/(2 Sqrt[3])+y)^2≤a^2&&x^2+(-(a/Sqrt[3])+y)^2≤a^2&&(a/2+x)^2+(a/(2 Sqrt[3])+y)^2≤a^2;

implreg=ImplicitRegion[ineq,{x,y}];

reg=RegionIntersection@@(Disk[a#,a]&/@{{(1/2),0},{0,((Sqrt[3])/2)},{-(1/2),0}});

assum=a>0;

Plots

Diagram

LaminaData["ReuleauxTriangle","Diagram"]

DiscretizeRegion

Block[{a=1},Show[DiscretizeRegion[reg],ImageSize->Small]]

Equations

Inequalities

p=a Table[{Cos[#],Sin[#]}&[2Pi(n-1/4)/3]/Sqrt[3],{n,0,2}]

And@@(Function[v,v.v][{x,y}-#]<=a^2&/@p)

FullSimplify[%,a>0]

ineq[x_,y_]:=a (-3 x+(Sqrt[3]) y)+3 ((x^2)+(y^2))<2 (a^2)&&(x^2)+(((-(a/(Sqrt[3]))+y))^2)<(a^2)&&a (3 x+(Sqrt[3]) y)+3 ((x^2)+(y^2))<2 (a^2)

Area

p={0,1/(2Sqrt[3])}+#&/@Table[{Cos[#],Sin[#]}&[2Pi(n-1/4)/3]/Sqrt[3],{n,0,2}]

Simplify[(#[[1]]-#[[2]]).(#[[1]]-#[[2]])&/@Subsets[p,{2}]]

Show[Graphics[{PointSize[.08],Point/@p},AspectRatio->Automatic],PlotRange->All]

ineqs=And@@(Function[v,v.v][{x,y}-#]<1&/@p)

Show[Graphics[{
InequalityPlot[ineqs,{x,-2,2},{y,-2,2},Ticks->None,DisplayFunction->Identity][[1]],
Circle[#,1]&/@p},
AspectRatio->Automatic],DisplayFunction->$DisplayFunction]

Integrate[Boole[ineqs],{x,-∞,∞},{y,-∞,∞}]

p=r({0,1/(2Sqrt[3])}+#&/@Table[{Cos[#],Sin[#]}&[2Pi(n-1/4)/3]/Sqrt[3],{n,0,2}])

ineqs=And@@(Function[v,v.v][{x,y}-#]<r^2&/@p)

Integrate[Boole[ineqs],{x,-∞,∞},{y,-∞,∞}]//Timing

FullSimplify[Last[%]]

With[{θ=(π/3)},
3(1/2)(r^2)(θ-Sin[θ])+(1/4)(Sqrt[3])(r^2)]//Simplify

Area Covered

<<Graphics`InequalityGraphics`

eqn=(x^2)+(y^2)-(Sqrt[3])x y-(2-(Sqrt[3]))x-(2-(Sqrt[3]))y+1-(Sqrt[3]);

Solve[(eqn/.y->0)==0,x]

Solve[(eqn/.x->0)==0,y]

eqns=eqn>0&&-1<x<1-(Sqrt[3])&&-1<y<1-(Sqrt[3]);

InequalityPlot[eqns,{x},{y}]

Simplify[1-Integrate[Boole[eqns],{x,-∞,∞},{y,-∞,∞}]]

N[%,20]

a1=2Sqrt[3]+Pi/6-3;

a2=Pi+2Sqrt[3]-3-2 ArcSin[Sqrt[2]/2 Sqrt[1+Sqrt[3]/2]];

Solve[(Pi+2Sqrt[3]-3-2aa)==a1,aa]

N[5Pi/12-ArcSin[(Sqrt[(1/2) (1+((Sqrt[3])/2))])],1000]

N[a1-a2,1000]

Properties

Area

Area

Assuming[assum,FullSimplify[Area[reg]]]

Assuming[assum,FullSimplify[Area[implreg]]]

Integrate

Assuming[a>0,FullSimplify[Area[ineq[x,y],{x,y}]]]//Timing

RegionMeasure

Assuming[assum,FullSimplify[RegionMeasure[reg]]]

Assuming[assum,FullSimplify[RegionMeasure[implreg]]]

Centroid

Integrate

Assuming[a>0,FullSimplify[Centroid[ineq[x,y],{x,y}]]]//Timing

RegionCentroid

Assuming[assum,FullSimplify[RegionCentroid[reg]]]

Assuming[assum,FullSimplify[RegionCentroid[implreg]]]

Circumradius

Block[{a=1},Show[{
RegionPlot[(((-(a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2)&&(x^2)+(((-(a/(Sqrt[3]))+y))^2)≤(a^2)&&((((a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2),{x,-1,1},{y,-1,1}],
Graphics[{PointSize[.02],Point[{0,0}],Point[{-(1/2) (-1+(Sqrt[3])) a,-(1/6) (-3+(Sqrt[3])) a}]}],
Graphics[Circle[{0,0},1/(Sqrt[3])]],
Graphics[Circle[{0,0},1-(1/(Sqrt[3]))]]
}]]

{(((-(a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2),(x^2)+(((-(a/(Sqrt[3]))+y))^2),((((a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)}/.{x->((Sqrt[2])-1)a/(Sqrt[2]),y->((Sqrt[2])-1)a/(Sqrt[2])}//FullSimplify

soln=With[{x0=a/2,y0=-(a/(2 (Sqrt[3])))},
FullSimplify[Solve[(((x-x0))^2)+(((y-y0))^2)==a^2&&y==y0/x0 x,{x,y}],a>0]]

{x,y}/.First[soln]

FullSimplify[Norm[{x,y}/.First[soln]],a>0]

1-(1/(Sqrt[3]))//N

GeneralizedDiameter

InertiaTensor

Assuming[a>0,FullSimplify[AreaInertiaTensor[ineq[x,y],{x,y}]]]//Timing

RadiiOfGyration

Assuming[a>0,FullSimplify[RadiiOfGyration[ineq[x,y],{x,y}]]]//Timing

Region

FullSimplify[Maximize[{x,ineqs},{x,y}],a>0]

FullSimplify[Maximize[{y,ineqs},{x,y}],a>0]

FullSimplify[Minimize[{y,ineqs},{x,y}],a>0]

ineq[x_,y_]:=(((-(a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2)&&(x^2)+(((-(a/(Sqrt[3]))+y))^2)≤(a^2)&&((((a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2)

ineqs=FullSimplify[And@@ineq@@@{{x1,y1},{x2,y2}}/.a->1]

Maximize[{(x1-x2)^2+(y1-y2)^2,ineqs},{x1,x2,y1,y2}]//Timing

...ran overnight...

Boundary Plot

b1=Sqrt[3]/3Sqrt[1+Sqrt[3]/2];
b2=Sqrt[3]/3Sqrt[1-Sqrt[3]/2];
{xp,yp}={{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[Pi/4].{x-1,y-1};

Solve[(1-Cos[β]-Sqrt[3]Sin[β])==-1,β]

Solve[(1-Sin[β]-Sqrt[3]Cos[β])==-1,β]

{(1-Cos[β]-Sqrt[3]Sin[β]),(1-Sin[β]-Sqrt[3]Cos[β])} /. β->Pi/6

1-(Sqrt[3])-(-1)

N[%]

a=1-(Sqrt[3]);

eqn={(1-Cos[β]-Sqrt[3]Sin[β]),(1-Sin[β]-Sqrt[3]Cos[β])};

d[β_]:=#.#&@(eqn-{1,1})

Plot[d[β],{β,0,2Pi}]

Solve[D[d[β],β]==0,β]

{FullSimplify[Sqrt[#.#]&@(eqn-{1,1} /. β->Pi/4)],
FullSimplify[Sqrt[#.#]&@(eqn-{1,1} /. β->3Pi/4)]}

{xp,yp}={{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[Pi/4].{x-1,y-1}

Expand[FullSimplify[xp^2/(1+(Sqrt[3]))^2+yp^2/(1-(Sqrt[3]))^2-1]]

<<Graphics`ImplicitPlot`

Show[{ImplicitPlot[(x^2)+x (-2-(Sqrt[3]) (-1+y))+(-1+y) (-1+(Sqrt[3])+y)==0,{x,-1,0},{y,-1,0},PlotPoints->50,DisplayFunction->Identity],
ParametricPlot[eqn,
{β,Pi/6,Pi/3},PlotStyle->{RGBColor[1,0,0]},AspectRatio->Automatic,DisplayFunction->Identity]
},DisplayFunction->$DisplayFunction]

ParametricPlot[eqn,
{β,Pi/6,Pi/3},PlotStyle->{RGBColor[1,0,0]},AspectRatio->Automatic,
Epilog->{Line[{{a,-1},{-1,-1},{-1,a}}]},Axes->None]

Show[
Graphics[{Reuleaux[0],
RGBColor[1,0,0],PointSize[.03],Point[{1,1}],
ParametricPlot[eqn,
{β,0,2Pi},PlotStyle->{RGBColor[1,0,0]},DisplayFunction->Identity][[1]]
},
Axes->None,
AspectRatio->Automatic,PlotRange->{{-1.02,3},{-1.02,3}},DisplayFunction->$DisplayFunction
]
]

Centroid Plot

ReuleauxCenterPath[Ticks->None]

FullSimplify[Solve[{(x0-x)^2+(y0-1)^2==(x-1)^2+(1-y)^2==(x0-1)^2+(y0-y)^2},{x,y}]]

Simplify[({x0,y0}+{2-x0-(Sqrt[3]) (-1+y0),1}+{1,2-(Sqrt[3]) (-1+x0)-y0})/3]

eqn2=Expand[{(1/3) (3-(Sqrt[3]) (-1+eqn[[2]])),(1/3) (3-(Sqrt[3]) (-1+eqn[[1]]))}]

d[β_]:=#.#&@(eqn2-{1,1})

Plot[d[β],{β,0,2Pi}]

Solve[D[d[β],β]==0,β]

{FullSimplify[Sqrt[#.#]&@(eqn2-{1,1} /. β->Pi/4)],
FullSimplify[Sqrt[#.#]&@(eqn2-{1,1} /. β->3Pi/4)]}

Expand[FullSimplify[xp^2/(1+1/(Sqrt[3]))^2+yp^2/(1-1/(Sqrt[3]))^2-1]]

ImplicitPlot[5-3 (Sqrt[3])-6 x+3 (Sqrt[3]) x+3 (x^2)-6 y+3 (Sqrt[3]) y-3 (Sqrt[3]) x y+3 (y^2)==0,{x,-1,1},{y,-1,1}]

<<Graphics`

Show[Graphics[{Reuleaux[0],
ParametricPlot[eqn2,{β,0,2Pi},DisplayFunction->Identity,PlotStyle->RGBColor[1,0,0]][[1]],
ReuleauxCenterPath[DisplayFunction->Identity][[1]],
RGBColor[1,0,0],PointSize[.02],Point[{1,1}]
},DisplayFunction->$DisplayFunction,Axes->None,AspectRatio->Automatic]]

Show[Graphics[{Reuleaux[0],
ImplicitPlot[5-3 (Sqrt[3])-6 x+3 (Sqrt[3]) x+3 (x^2)-6 y+3 (Sqrt[3]) y-3 (Sqrt[3]) x y+3 (y^2)==0,{x,-2,3},PlotStyle->{Dashing[{.02,.02}],Thickness[.01],RGBColor[0,0,1]},DisplayFunction->Identity][[1]],
ParametricPlot[eqn2,{β,0,2Pi},DisplayFunction->Identity,PlotStyle->RGBColor[1,0,0]][[1]],
ReuleauxCenterPath[DisplayFunction->Identity][[1]],
RGBColor[1,0,0],PointSize[.02],Point[{1,1}]
},DisplayFunction->$DisplayFunction,Axes->None,AspectRatio->Automatic]]

Centroid Area Covered

Integrate[Boole[5-3 (Sqrt[3])-6 x+3 (Sqrt[3]) x+3 (x^2)-6 y+3 (Sqrt[3]) y-3 (Sqrt[3]) x y+3 (y^2)<0&&x<0&&y<0],{x,-∞,∞},{y,-∞,∞}]//Simplify

ac=1-2/3Sqrt[3]+Pi/3-2/3ArcSin[Sqrt[2]/2Sqrt[1+Sqrt[3]/2]]

ac=1-2/3Sqrt[3]+Pi/3-2/3 5Pi/12

N[%]

FullSimplify[4 ac]

N[%]

Show[Graphics[{Reuleaux[0],
ParametricPlot[eqn2,{β,0,2Pi},DisplayFunction->Identity,PlotStyle->RGBColor[1,0,0]][[1]],
ReuleauxCenterPath[DisplayFunction->Identity][[1]],
RGBColor[1,0,0],PointSize[.02],Point[{1,1}]
},DisplayFunction->$DisplayFunction,Axes->None,AspectRatio->Automatic,PlotRange->{{-.2,.5},{-.2,.5}}]]

Animation

?ReuleauxMovie

Show[Graphics[Reuleaux[t]],AspectRatio->Automatic]

Show[GraphicsArray[Partition[ReuleauxMovie[6,DisplayFunction->Identity],3]]]

Big version for main page

Export[GIFDirectory<>"reuleaux.gif",ReuleauxMovie[20],"GIF"]

Small version for rotor page

Export["Phosphine:MathOzTeX:gifs:reuleasm.gif",ReuleauxMovie[10],
"GIF",ImageSize->200,AnimationDirection->ForwardBackward]

Length Distribution

(-(a/2)+x)^2+(a/(2 Sqrt[3])+y)^2≤a^2&&x^2+(-(a/Sqrt[3])+y)^2≤a^2&&(a/2+x)^2+(a/(2 Sqrt[3])+y)^2≤a^2/.a->1

ineq[x_,y_]:=(((-(1/2)+x))^2)+((((1/(2 (Sqrt[3])))+y))^2)≤1&&(x^2)+(((-(1/(Sqrt[3]))+y))^2)≤1&&((((1/2)+x))^2)+((((1/(2 (Sqrt[3])))+y))^2)≤1

RegionPlot[(((-(1/2)+x))^2)+((((1/(2 (Sqrt[3])))+y))^2)≤1&&(x^2)+(((-(1/(Sqrt[3]))+y))^2)≤1&&((((1/2)+x))^2)+((((1/(2 (Sqrt[3])))+y))^2)≤1,{x,-1/2,1/2},{y,-.45,.6},AspectRatio->Automatic]

Monte Carlo

maxx=(1/2);
minx=-maxx;
maxy=-.45;
miny=.6;

Length[pts=Select[Table[{RandomReal[{minx,maxx}],RandomReal[{miny,maxy}]},{10^4},{2}],And@@ineq@@@#&]]//Timing

Graphics[Point[Take[Flatten[pts,1],All]]]

(((((1/2 (Pi-Sqrt[3]))/((maxx-minx)(maxy-miny)))))^2)//N

Through[{Min,Mean,Max}[ds=Norm/@(Subtract@@@pts)]]

Histogram[ds]

Length[pts=Select[Table[{RandomReal[{minx,maxx}],RandomReal[{miny,maxy}]},{10^6},{2}],And@@ineq@@@#&]]//Timing

Through[{Min,Mean,Max}[ds=Norm/@(Subtract@@@pts)]]

Histogram[ds]

Mean

in=And@@ineq@@@{{x1,y1},{x2,y2}}/.a->1

in=(((-(1/2)+x1))^2)+((((1/(2 (Sqrt[3])))+y1))^2)≤1&&(x1^2)+(((-(1/(Sqrt[3]))+y1))^2)≤1&&((((1/2)+x1))^2)+((((1/(2 (Sqrt[3])))+y1))^2)≤1&&(((-(1/2)+x2))^2)+((((1/(2 (Sqrt[3])))+y2))^2)≤1&&(x2^2)+(((-(1/(Sqrt[3]))+y2))^2)≤1&&((((1/2)+x2))^2)+((((1/(2 (Sqrt[3])))+y2))^2)≤1;

(1/(((1/2 (Pi-Sqrt[3])))^2))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2]Boole[in],{x1,minx,maxx},{y1,miny,maxy},{x2,minx,maxx},{y2,miny,maxy}]

(1/(((1/2 (Pi-Sqrt[3])))^2))NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2]Boole[in],{x1,minx,maxx},{y1,miny,maxy},{x2,minx,maxx},{y2,miny,maxy},Method->"QuasiMonteCarlo"]

(1/(((1/2 (Pi-Sqrt[3])))^2))Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2]Boole[in],{x1,-∞,∞},Assumptions->in]