-1
$\begingroup$

I am doing some work on Archimedes and want to show what the area of a regular n-sided polygon is within a circle. My professor from two years ago was able to show it with an adjustable slider that increased the number of sides of a polygon. I was wondering if it's possible to tack on an equation to display the area of the polygon.

I'm not very good at plotting with Mathematica and need help with all of the code.

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$ – bbgodfrey Feb 21 '15 at 17:44
  • 1
    $\begingroup$ Please show what you have tried so far. $\endgroup$ – bbgodfrey Feb 21 '15 at 17:44
  • $\begingroup$ Related: demonstrations.wolfram.com/ApproximatingPiWithInscribedPolygons $\endgroup$ – Michael E2 Feb 21 '15 at 22:35
15
$\begingroup$
Off[Solve::ztest];
var = {R, r, a, p, s};
assume = Join[
   Thread[var > 0],
   {R > r, Element[n, Integers], n > 2}];
eqns = {
   R == s*Csc[Pi/n]/2,
   r == s*Cot[Pi/n]/2,
   a == n*s^2*Cot[Pi/n]/4,
   p == n*s};

sol = Reverse[Assuming[assume,
     Simplify[Solve[
          Join[eqns, assume], #, Reals][[1]] & /@
       Select[
        Subsets[var, {Length[var] - 1}],
        MemberQ[#, a] &]]]] // FullSimplify;

Manipulate[
 If[IntegerQ[m], v = m, v = 5];
 pts = Table[{Cos[2 Pi*k/v], Sin[2 Pi*k/v]},
   {k, 0, v}];
 Column[{
   Graphics[{
     AbsoluteDashing[8],
     Lighter[Gray, 0.4],
     Circle[],
     If[Not[m === Infinity],
      {Circle[{0, 0}, Cos[Pi/v]],
       Blue,
       Line[{{0, 0}, #}] & /@ Take[pts, 2],
       Text["R", {1/2, 1}*pts[[1]], {0, 2}],
       Magenta, Text["\[Alpha]", Plus @@ Take[pts, 2]/7],
       Text["\[Beta]", 6/7*pts[[3]]],
       Darker[Green, .25],
       AbsoluteDashing[4],
       Line[{{0, 0}, Cos[Pi/v]
          {Cos[5 Pi/v], Sin[5 Pi/v]}}],
       Text["r", Cos[Pi/v]/2
         {Cos[1.1*5 Pi/v], Sin[1.1*5 Pi/v]}]}],
     Dashing[{}],
     Black,
     Thick,
     If[m === Infinity,
      {Circle[{0, 0}]},
      Line[pts]]}],
   Grid[
     ReplacePart[arr = Transpose[
        Join[
         {Style[#, Darker[Blue]] & /@
           {"circumradius", 
            "inradius", "area",
            "perimeter", "edge length",
            "central\nangle, \[Alpha]",
            "interior\nangle, \[Beta]",
            "interior\nangle sum"}},
         tab = (TraditionalForm /@ Join[var,
              {If[m === Infinity, 0,
                Row[{2 Pi/n, " rad", ", i.e., ",
                  FunctionExpand[2 Pi/n/Degree] Degree}]]},
              {If[m === Infinity, "\[Pi] rad, i.e., 180\[Degree]",
                Row[{(n - 2) Pi/n, " rad", ", i.e., ",
                  FunctionExpand[(n - 2) Pi/n/Degree] Degree}]]},
              {If[m === Infinity, "Indeterminate", 
                Row[{(n - 2) Pi, " rad", ", i.e., ",
                  FunctionExpand[(n - 2) Pi/Degree] Degree}]]}]) /.

                    If[m === Infinity,
            Map[#[[1]] -> Limit[#[[-1]] /. s -> 2 R Pi/n,
                n -> Infinity] &, sol, {2}],
            sol]]],
      Flatten[Table[{i, j} -> SpanFromLeft,
        {i, If[m === Infinity, 5, 6], 8},
        {j, 3, 5}]]],
     Frame -> All,
     Alignment -> {Center, Center}] /. n -> m},
  Alignment -> Center],
 {{m, "n", "number of edges"},
  Join[{"n"}, Range[3, 20], {Infinity}],
  ControlType -> SetterBar}]

enter image description here

$\endgroup$
  • $\begingroup$ Quite well-polished :) $\endgroup$ – DumpsterDoofus Feb 22 '15 at 2:40
  • $\begingroup$ @BobHanlon +1 very very nice:) $\endgroup$ – ubpdqn Feb 22 '15 at 3:13
6
$\begingroup$
   Manipulate[
   {Text[Style["Area =" <> ToString[N@n Cos[ (180 Degree)/n] Sin[(180 Degree)/n]], 
        Italic]],
   Graphics[
           {Circle[], 
           {Yellow, Polygon[Table[{Cos[θ], Sin[θ]}, 
               {θ, 0, 2 π, 2 π/n}]]}}]},
    {n, 3, 50, 1}]
$\endgroup$
  • $\begingroup$ Thank you for your answer, this is what I was looking for-something simple! $\endgroup$ – Mackenzie Feb 23 '15 at 16:01
4
$\begingroup$

I understand the down voting for this question. However, for fun:

p[n_] := {Cos[2 Pi #/n], Sin[2 Pi #/n]} & /@ Range[0, n]
piapp[n_] := With[{pg = Polygon[p[n]]},
  Graphics[{Circle[], Red, pg, 
    Text[Style[N@n Sin[2 Pi/n]/2, White, 16], {0, 0}]}, 
   ImageSize -> 300]]
anim = Table[
   Row[{
     piapp[num],
     ListPlot[Table[{j, N@j Sin[2 Pi/j]/2}, {j, Range[3, 100]}], 
      GridLines -> {None, {Pi}}, Joined -> True, 
      Epilog -> {Red, PointSize[0.02], 
        Point[{num, N@num Sin[2 Pi/num]/2}], 
        Text[Style[num, 
          12], {num, N@num Sin[2 Pi/num]/2} - {-5, 0.25}]}, 
      PlotRange -> {0, 3.2}, ImageSize -> 300]}], {num, 
    Range[3, 100]}];

The Table command can be changed to Manipulate. It was used to make animated gif.

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for your answer, I appreciate the response despite the down voting! $\endgroup$ – Mackenzie Feb 23 '15 at 16:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.