Heptadecagon

Author

Eric W. Weisstein
October 27, 2005

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

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

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

Figure

Graphics[RegularPolygon[17]//N]

Properties

RegularPolygonInformation[17]//TableForm//TraditionalForm

Algebraic Degrees

AlgebraicDegree[FunctionExpand[Cos[((2π)/17)]]]//Timing

RootReduce[FunctionExpand[Cos[((2π)/17)]]]//TraditionalForm

AlgebraicDegree[FunctionExpand[Cos[(π/17)]]]//Timing

RootReduce[FunctionExpand[Cos[(π/17)]]]//TraditionalForm

Analytic Expressions

r

r=RootReduce[FunctionExpand[Cot[Pi/17]/2]]

N[r]

NRoots[r[[1]][x]==0,x]

r[[1]][HoldForm[r]]

R

R=RootReduce[FunctionExpand[Csc[Pi/17]/2]]

N[R]

NRoots[R[[1]][x]==0,x]

R[[1]][HoldForm[R]]

A

area=FunctionExpand[RegularPolygonArea[17]]

RootReduce[area]//Timing

area//N

%21[[1]][x]

NRoots[%21[[1]][x]==0,x]

Construction

o=Point[{0,0}];
p[1]=Point[{1,0}];
j=Point[{0,1/4}];
bb=Point[{0,1}];

OJP1=ArcTan[4]

Solve[Tan[OJP1/4]==ee/(1/4),ee]

e=Point[{(1/4) Tan[((ArcTan[4])/4)],0}];

θ1=ArcTan[ Tan[((ArcTan[4])/4)]];

{OJP1,ArcTan[Tan[((ArcTan[4])/4)]]}//N

Divide@@%

f=Point[{ff=-Tan[π/4-θ1]/4,0}];

Angle[(Coordinates/@{f,j}),
(Coordinates/@{e,j})]//N

Pi/4.

Intersections[Line[{{0,0},{0,1}}],Circle[{(1-(-ff+1)/2),0},(-ff+1)/2]]//FullSimplify

k=Point[{0,(1/2) (Sqrt[Tan[(1/4) (π-ArcTan[4])]])}];

ek=Distance[e,k]//FullSimplify

Intersections[Circle[Coordinates[e],ek],Line[{{0,0},{1,0}}]]//FullSimplify

N[%]

n4=Point[{(1/4) (Tan[((ArcTan[4])/4)]+(Sqrt[4 Tan[(1/4) (π-ArcTan[4])]+((Tan[((ArcTan[4])/4)])^2)])),0}];

p[4]=Intersections[Line[{{#,0},{#,1}}]&[Coordinates[n4][[1]]],
Circle[{0,0},1]][[1]]//Simplify

FullSimplify[p[4]]//Timing

N[%]

Distance[Point[{1,0}],%181]//N

Distance@@(Point[{Cos[#],Sin[#]}]&/@{0,2 3π/17})//N

FullSimplify[Coordinates[p[4]]-Through[{Cos,Sin}[6π/17]]]

N[Coordinates[p[4]]-Through[{Cos,Sin}[6π/17]],5000]

With[{dx=.03},
Show[Graphics[{
Circle[{0,0},1],
Line[{{-1,0},{1,0}}],
{Red,Line[{{0,0},{0,1}}],
Line[{{-dx,1/8},{dx,1/8}}],
Line[{{-dx,3/8+1/4+#},{dx,3/8+1/4+#}}]&/@(Range[-1,1].04)
},
{
Green,Line[Coordinates/@{e,j,f}]
},
Line[Coordinates/@{j,p[1]}],
Circle[{(1-(-ff+1)/2),0},(-ff+1)/2,{0,π}],
Circle[Coordinates[e],ek,{0,π}],
Line[Coordinates/@{n4,p[4]}],
{Blue,Thickness[.01],ClosedLine@@RegularPolygon[17]},
{
Blue,
PointSize[.03],
Point/@Table[Through[{Cos,Sin}[2Pi/17 i]],{i,0,17,3}],
{Circle[#,.05],Point[#]}&/@Table[Through[{Cos,Sin}[2Pi/17 i]],{i,1,16,3}],
{Circle[#,.05],Circle[#,.07],Point[#]}&/@Table[Through[{Cos,Sin}[2Pi/17 i]],{i,2,16,3}]
},
Table[Text[Subscript[P,n]//TraditionalForm,1.15Through[{Cos,Sin}[2Pi(n-1)/17]]],{n,17}],
PointLabels[{
{o,O},
{bb,B,LabelOffset->{0,.1}},
{j,J,{Red,LabelOffset->{-.1,0}}},
{e,"E"},
{f,"F"},
{k,"K",LabelOffset->{-.1,.1}.7},
{n4,(Subscript[N, 4])}
},PointSize[.03],LabelOffset->{0,-.12}]
}],
AspectRatio->Automatic,
PlotRange->All]
]