Regular Heptagon

Author

Eric W. Weisstein
July 3, 2018

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polygons/RegularHeptagon.nb.

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

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

Definitions

ineq=-(1/2) a y Cos[Pi/14] Csc[Pi/7]+1/2 a y Cos[(3 Pi)/14] Csc[Pi/7]-1/2 a x Csc[Pi/7] Sin[Pi/14]+1/4 a^2 Cos[(3 Pi)/14] Csc[Pi/7]^2 Sin[Pi/14]-1/2 a x Csc[Pi/7] Sin[(3 Pi)/14]+1/4 a^2 Cos[Pi/14] Csc[Pi/7]^2 Sin[(3 Pi)/14]≥0&&-(1/2) a x Csc[Pi/7]-1/2 a y Cos[(3 Pi)/14] Csc[Pi/7]+1/4 a^2 Cos[(3 Pi)/14] Csc[Pi/7]^2+1/2 a x Csc[Pi/7] Sin[(3 Pi)/14]≥0&&1/2 a x Csc[Pi/7]-1/2 a y Cos[(3 Pi)/14] Csc[Pi/7]+1/4 a^2 Cos[(3 Pi)/14] Csc[Pi/7]^2-1/2 a x Csc[Pi/7] Sin[(3 Pi)/14]≥0&&-(1/2) a y Cos[Pi/14] Csc[Pi/7]+1/2 a y Cos[(3 Pi)/14] Csc[Pi/7]+1/2 a x Csc[Pi/7] Sin[Pi/14]+1/4 a^2 Cos[(3 Pi)/14] Csc[Pi/7]^2 Sin[Pi/14]+1/2 a x Csc[Pi/7] Sin[(3 Pi)/14]+1/4 a^2 Cos[Pi/14] Csc[Pi/7]^2 Sin[(3 Pi)/14]≥0&&-((a y)/2)+1/2 a x Cot[Pi/7]+1/2 a y Cos[Pi/14] Csc[Pi/7]+1/4 a^2 Cos[Pi/14] Cot[Pi/7] Csc[Pi/7]-1/4 a^2 Csc[Pi/7] Sin[Pi/14]-1/2 a x Csc[Pi/7] Sin[Pi/14]≥0&&a y+1/2 a^2 Cot[Pi/7]≥0&&-((a y)/2)-1/2 a x Cot[Pi/7]+1/2 a y Cos[Pi/14] Csc[Pi/7]+1/4 a^2 Cos[Pi/14] Cot[Pi/7] Csc[Pi/7]-1/4 a^2 Csc[Pi/7] Sin[Pi/14]+1/2 a x Csc[Pi/7] Sin[Pi/14]≥0;

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

verts=a{{1/2 Cos[Pi/14] Csc[Pi/7],-(1/2) Csc[Pi/7] Sin[Pi/14]},{1/2 Cos[(3 Pi)/14] Csc[Pi/7],1/2 Csc[Pi/7] Sin[(3 Pi)/14]},{0,1/2 Csc[Pi/7]},{-(1/2) Cos[(3 Pi)/14] Csc[Pi/7],1/2 Csc[Pi/7] Sin[(3 Pi)/14]},{-(1/2) Cos[Pi/14] Csc[Pi/7],-(1/2) Csc[Pi/7] Sin[Pi/14]},{-(1/2),-(1/2) Cot[Pi/7]},{1/2,-(1/2) Cot[Pi/7]}};

reg=Polygon[verts];

assum=a>0;

Figure

Show[LaminaData["FilledRegularHeptagon","Diagram"],ImageSize->300]

Plots

Diagram

LaminaData["FilledRegularHeptagon","Diagram"]

DiscretizeRegion

Block[{a=1},DiscretizeRegion[#]]&/@{reg,implreg}

Polygon

Graphics[RegularPolygon[7]]

Schematic Diagram

r=RegularPolygon[7][[1,1]];
o={0,0};
m=(r[[7]]+r[[1]])/2;
x={Cos[3Pi/7],Sin[3Pi/7]};
mox=(o+x)/2;
pts={r[[7]],"A",r[[1]],"B",r[[2]],"C",o,"O",
	m,"(Subscript[M, AB])",x,"(Subscript[X, CB])",mox,"(Subscript[M, OX])"};

Show[Graphics[{
		RegularPolygon[7],
			Line[{o,m}],Line[{o,x}],
			PointLabels[pts,.03],
			{Dashing[{.02,.02}],Circle[o,1]},
			{Thickness[.015],Line[{mox,m}]}
		}],AspectRatio->Automatic]

FullSimplify[Expand[(mox-m).(mox-m)]]

r=RegularPolygon[7][[1,1]];
o={0,0};
m=(r[[7]]+r[[1]])/2;
x={Cos[3Pi/7],Sin[3Pi/7]};
mox=(o+x)/2;
b=r[[1]];
f=r[[5]];
mof=(o+f)/2;
j=m+Sqrt[(m-x).(m-x)](b-m)/Sqrt[(b-m).(b-m)];
pts={r[[7]],"A",r[[1]],"B",r[[2]],"C",r[[3]],
			"D",r[[4]],"E",r[[5]],"F",r[[6]],"G",j,"J",
		o,"O",m,"(Subscript[M, AB])",x,"(Subscript[X, CB])",mox,"(Subscript[M, OX])",mof,"(Subscript[M, OF])"};

Show[Graphics[{
		RegularPolygon[7],
			Line[{o,m}],Line[{f,x}],Line[{m,x}],Line[{mof,m}],
			Line[{b,j}],Line[{o,j}],
			PointLabels[pts,.03],
			{Dashing[{.02,.02}],Circle[o,1]},
			Line[{mox,m}],
			{Dashing[{.01,.02}],Circumcircle[{m,o,mof}]}
		}],AspectRatio->Automatic]

FullSimplify[Sqrt[(m-mof).(m-mof)]]

NRoots[-1+12 x^2-20 (x^4)+8 (x^6)==0,x]

N[Sqrt[2]Cos[Pi/7]]

FullSimplify[Sqrt[(o-j).(o-j)]]

Equations

Inequality

RegularPolygon[7,1/2Csc[π/7],-π/14]

Refine[Inequalities[RegularPolygon[7,a/2Csc[π/7],-π/14],{x,y}],a>0]

ineq[x_,y_]:=-(1/2) a y Cos[(π/14)] Csc[(π/7)]+(1/2) a y Cos[((3 π)/14)] Csc[(π/7)]-(1/2) a x Csc[(π/7)] Sin[(π/14)]+(1/4) (a^2) Cos[((3 π)/14)] ((Csc[(π/7)])^2) Sin[(π/14)]-(1/2) a x Csc[(π/7)] Sin[((3 π)/14)]+(1/4) (a^2) Cos[(π/14)] ((Csc[(π/7)])^2) Sin[((3 π)/14)]≥0&&-(1/2) a x Csc[(π/7)]-(1/2) a y Cos[((3 π)/14)] Csc[(π/7)]+(1/4) (a^2) Cos[((3 π)/14)] ((Csc[(π/7)])^2)+(1/2) a x Csc[(π/7)] Sin[((3 π)/14)]≥0&&(1/2) a x Csc[(π/7)]-(1/2) a y Cos[((3 π)/14)] Csc[(π/7)]+(1/4) (a^2) Cos[((3 π)/14)] ((Csc[(π/7)])^2)-(1/2) a x Csc[(π/7)] Sin[((3 π)/14)]≥0&&-(1/2) a y Cos[(π/14)] Csc[(π/7)]+(1/2) a y Cos[((3 π)/14)] Csc[(π/7)]+(1/2) a x Csc[(π/7)] Sin[(π/14)]+(1/4) (a^2) Cos[((3 π)/14)] ((Csc[(π/7)])^2) Sin[(π/14)]+(1/2) a x Csc[(π/7)] Sin[((3 π)/14)]+(1/4) (a^2) Cos[(π/14)] ((Csc[(π/7)])^2) Sin[((3 π)/14)]≥0&&-((a y)/2)+(1/2) a x Cot[(π/7)]+(1/2) a y Cos[(π/14)] Csc[(π/7)]+(1/4) (a^2) Cos[(π/14)] Cot[(π/7)] Csc[(π/7)]-(1/4) (a^2) Csc[(π/7)] Sin[(π/14)]-(1/2) a x Csc[(π/7)] Sin[(π/14)]≥0&&a y+(1/2) (a^2) Cot[(π/7)]≥0&&-((a y)/2)-(1/2) a x Cot[(π/7)]+(1/2) a y Cos[(π/14)] Csc[(π/7)]+(1/4) (a^2) Cos[(π/14)] Cot[(π/7)] Csc[(π/7)]-(1/4) (a^2) Csc[(π/7)] Sin[(π/14)]+(1/2) a x Csc[(π/7)] Sin[(π/14)]≥0

RegionPlot[Chop[ineq[x,y]/.a->1],{x,-1.2,1.2},{y,-1.2,1.2}]

Properties

Area

Area

Assuming[assum,FullSimplify[Area[reg/.a->1]]]//Timing

Assuming[assum,FullSimplify[Area[implreg/.a->1]]]//Timing

NIntegrate

Block[{a=1},NIntegrate[Boole[ineq[x,y]],{x,-1.2,1.2},{y,-1.2,1.2}]]

Integrate

Area[RegularPolygon[7,1/2Csc[π/7]]]//FullSimplify

N[%]

(area=Block[{a=1},Integrate[Boole[ineq[x,y]],{x,-∞,∞},{y,-∞,∞}]])//Timing

...ran overnight and crashed/ran out of memory?...

RegionMeasure

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

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

AreaInertiaTensor

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

Centroid

NIntegrate

Block[{a=1},NIntegrate[{x,y}Boole[ineq[x,y]],{x,-1.2,1.2},{y,-1.2,1.2}]]

Block[{a=1},NIntegrate[{x,y}Boole[ineq[x,y]],{x,-1.2,1.2},{y,-1.2,1.2},Method->"QuasiMonteCarlo"]]

Integrate

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

RegionCentroid

Assuming[assum,FullSimplify[RegionCentroid[reg/.a->1]]]//Timing

Assuming[assum,FullSimplify[RegionCentroid[implreg/.a->1]]]//Timing

Circumradius

With[{n=7},a/2 Csc[Pi/n]]//FullSimplify

TrigToExp[%]//FullSimplify

Convex

TimeConstrained[Region`ConvexRegionQ[reg],600]//Timing

TimeConstrained[Region`ConvexRegionQ[implreg],600]//Timing

Diagonals

Length[v={{1/2 Cos[Pi/14] Csc[Pi/7],-(1/2) Csc[Pi/7] Sin[Pi/14]},{1/2 Cos[(3 Pi)/14] Csc[Pi/7],1/2 Csc[Pi/7] Sin[(3 Pi)/14]},{0,1/2 Csc[Pi/7]},{-(1/2) Cos[(3 Pi)/14] Csc[Pi/7],1/2 Csc[Pi/7] Sin[(3 Pi)/14]},{-(1/2) Cos[Pi/14] Csc[Pi/7],-(1/2) Csc[Pi/7] Sin[Pi/14]},{-(1/2),-(1/2) Cot[Pi/7]},{1/2,-(1/2) Cot[Pi/7]}}]

ds=With[{n=Length[v]},Select[Subsets[Range[n],{2}],Mod[Subtract@@#,n]≠n-1≠1&]]

Length[%]

FullSimplify[Binomial[n,2]-n]

n(n-3)/2/.n->Length[v]

Graphics[{
{Yellow,Opacity[.2],EdgeForm[Black],Polygon[v]},
Line[ds]/.Thread[Range[Length[v]]->v]
}]

SortBy[FullSimplify@RootReduce[Norm[Subtract@@v[[#]]]&/@ds],N]

EdgeLengths

s=FullSimplify[Norm/@(Subtract@@@Partition[verts,2,1,1]),assum]

GeneralizedDiameter

FullSimplify[Sqrt[a^2((((1/2)Csc[(π/n)]+(1/2)Cot[(π/n)]))^2)+(1/4)(a^2)],a>0&&n>0]

GD[n_]:=If[OddQ[n],(1/2) Csc[(π/(2 n))],Csc[(π/n)]]a

GD[7]

(1/2) a Csc[(π/14)]//N

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

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

Inradius

With[{n=7},a/2 Cot[Pi/n]]//FullSimplify

TrigToExp[%]//FullSimplify

Perimeter

Total[s]

Vertices

Graphics[MapIndexed[{Point[#1],Text[#2[[1]],#1,Background->White]}&,p=RegularPolygon[7,1/2Csc[π/7],-π/14][[1]]]]

FullSimplify[Through[{MinValue,MaxValue}[{x,ineq[x,y]},{x,y}]],a>0]//Timing

FullSimplify[Through[{MinValue,MaxValue}[{y,ineq[x,y]},{x,y}]],a>0]//Timing

Lengths

in=ineq[x1,y1]&&ineq[x2,y2]/.a->1

minx=p[[5,1]];
maxx=p[[1,1]];
miny=p[[6,2]];
maxy=p[[3,2]];

{{minx,maxx},{miny,maxy}}//N

NIntegrate[Boole[in],{x1,minx,maxx},{y1,miny,maxy},{x2,minx,maxx},{y2,miny,maxy},Method->"QuasiMonteCarlo"]

(((area=(1/4)n Cot[(π/n)]/.n->7))^2)//N

NIntegrate[(Sqrt[(x1-x2)^2+(((y1-y2))^2)])Boole[in],{x1,minx,maxx},{y1,miny,maxy},{x2,minx,maxx},{y2,miny,maxy},Method->"QuasiMonteCarlo",MaxPoints->10^8,PrecisionGoal->2]//Timing

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

NIntegrate[(Sqrt[(x1-x2)^2+(((y1-y2))^2)])Boole[in],{x1,minx,maxx},{y1,miny,maxy},{x2,minx,maxx},{y2,miny,maxy},Method->"QuasiMonteCarlo",MaxPoints->10^8,PrecisionGoal->4]//Timing

ineq[x,y]/.a->1

f[x_,y_]:=-(1/2) y Cos[(π/14)] Csc[(π/7)]+(1/2) y Cos[((3 π)/14)] Csc[(π/7)]-(1/2) x Csc[(π/7)] Sin[(π/14)]+(1/4) Cos[((3 π)/14)] ((Csc[(π/7)])^2) Sin[(π/14)]-(1/2) x Csc[(π/7)] Sin[((3 π)/14)]+(1/4) Cos[(π/14)] ((Csc[(π/7)])^2) Sin[((3 π)/14)]≥0&&-(1/2) x Csc[(π/7)]-(1/2) y Cos[((3 π)/14)] Csc[(π/7)]+(1/4) Cos[((3 π)/14)] ((Csc[(π/7)])^2)+(1/2) x Csc[(π/7)] Sin[((3 π)/14)]≥0&&(1/2) x Csc[(π/7)]-(1/2) y Cos[((3 π)/14)] Csc[(π/7)]+(1/4) Cos[((3 π)/14)] ((Csc[(π/7)])^2)-(1/2) x Csc[(π/7)] Sin[((3 π)/14)]≥0&&-(1/2) y Cos[(π/14)] Csc[(π/7)]+(1/2) y Cos[((3 π)/14)] Csc[(π/7)]+(1/2) x Csc[(π/7)] Sin[(π/14)]+(1/4) Cos[((3 π)/14)] ((Csc[(π/7)])^2) Sin[(π/14)]+(1/2) x Csc[(π/7)] Sin[((3 π)/14)]+(1/4) Cos[(π/14)] ((Csc[(π/7)])^2) Sin[((3 π)/14)]≥0&&-(y/2)+(1/2) x Cot[(π/7)]+(1/2) y Cos[(π/14)] Csc[(π/7)]+(1/4) Cos[(π/14)] Cot[(π/7)] Csc[(π/7)]-(1/4) Csc[(π/7)] Sin[(π/14)]-(1/2) x Csc[(π/7)] Sin[(π/14)]≥0&&y+(1/2) Cot[(π/7)]≥0&&-(y/2)-(1/2) x Cot[(π/7)]+(1/2) y Cos[(π/14)] Csc[(π/7)]+(1/4) Cos[(π/14)] Cot[(π/7)] Csc[(π/7)]-(1/4) Csc[(π/7)] Sin[(π/14)]+(1/2) x Csc[(π/7)] Sin[(π/14)]≥0

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

((((area/((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^5},{2}],And@@f@@@#&]]//Timing

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

Histogram[ds]