We had a little activity after school today and one of the questions was:
All diagonals are drawn in a regular octagon. At how many distinct points in the interior of the octagon (not on the boundary) do two or more diagonals intersect?
So I came home and I wanted to draw the image, which I managed to do, but not very sophisticated code. :-)
pts = Table[{Cos[t], Sin[t]}, {t, 0, 7 Pi/4, Pi/4}];
diags1 = Table[Line[{pts[[1]], pts[[j]]}], {j, {3, 4, 5, 6, 7}}];
diags2 = Table[Line[{pts[[2]], pts[[j]]}], {j, {4, 5, 6, 7, 8}}];
diags3 = Table[Line[{pts[[3]], pts[[j]]}], {j, {5, 6, 7, 8}}];
diags4 = Table[Line[{pts[[4]], pts[[j]]}], {j, {6, 7, 8}}];
diags5 = Table[Line[{pts[[5]], pts[[j]]}], {j, {7, 8}}];
diags6 = Table[Line[{pts[[6]], pts[[j]]}], {j, {8}}];
Show[
Graphics[{
EdgeForm[Black], White, Polygon[pts]
}],
Graphics[{
diags1, diags2, diags3, diags4, diags5, diags6
}]
]
I am looking for a more sophisticated manner to draw the image. Also, is there something in Mathematica that would easily include the points of intersection and count the number of points of intersection?
Answer
Here's one way to use Mathematica to calculate the positions of the internal intersections for you:
(* CirclePoints is an alternative to manually generating the vertex list *)
pts = CirclePoints[{1, 90 Degree}, 8];
(* Generate all edges and internal diagonals as Line objects *)
lines = Line /@ Subsets[pts, {2}];
(* List all possible pairs of lines from the set above *)
linepairs = Subsets[lines, {2}];
(* Find unique intersection points between lines in each pair *)
intersectionpts =
DeleteDuplicatesBy[N]@
Simplify@
DeleteCases[RegionIntersection /@ linepairs, _EmptyRegion];
(* Remove intersection points that are also vertices *)
internalpts = Complement[intersectionpts, Point[{#}] & /@ pts];
RegionIntersection
(docs) returns a list of Point
objects at which the pairs of diagonals and edges intersect. This list contains duplicates and EmptyRegion
s corresponding to those line pairs that do not intersect (docs). The EmptyRegion
s are removed by DeleteCases
. The results of the calculation are expressed analytically, and the expressions are not always returned in their simplest form; Simplify
then brings them all to a comparable format. Rather than attempting to compare the analytical forms directly, it is more reliable to remove the duplicate points by comparison of the numerical values of their coordinates, which is taken care of by DeleteDuplicatesBy
(docs).
internalpts
contains a list of Point
objects representing those unique intersections. Therefore the number of internal intersection points is:
Length@internalpts
(* Out: 49 *)
Finally we can show the results graphically:
(* Draw results *)
Graphics[{
lines,
Red, PointSize[0.02], internalpts
}]
Comments
Post a Comment