Italian Mathematical Olympiad 2001 Q1
Italian Mathematical Olympiad 2001 Q1
Michael Penn, my favorite Youtube instructor on math channel, discussed this fun problem today.
Let me show how to quickly visualize the problem with Wolfram Language. I will leave the detailed step to you as you can just follow the video by yourself.
Let me show how to quickly visualize the problem with Wolfram Language. I will leave the detailed step to you as you can just follow the video by yourself.
In[]:=
<<MaTeX`
Out[]=
Construct GeometricScene
Construct GeometricScene
The following construction using the fact that in the sum of interior angle sum of a convex hexagon is 720 degree.
In[]:=
WolframAlpha["hexagon",IncludePods"Properties",AppearanceElements{"Pods"},TimeConstraint{20,Automatic,Automatic,Automatic}]
Out[]=
GeometricScence implicitly solve the problem with the given constraints
In[]:=
gs=GeometricScene[{a{0,0},b{5,0},c,d,e,f},{PlanarAngle[{a,b,c}]PlanarAngle[{b,c,d}]==PlanarAngle[{c,d,e}]2π/3,PlanarAngle[{d,e,f}]==PlanarAngle[{e,f,a}]PlanarAngle[{f,a,b}]2π/3,EuclideanDistance[b,c]3,EuclideanDistance[c,d]6,EuclideanDistance[d,e]7,GeometricAssertion[{a,b,c,d,e,f},"Counterclockwise"]}]//RandomInstance
Out[]=
Extract points to form an Association for later use
In[]:=
pts=AssociationThread[{a,b,c,d,e,f}({a,b,c,d,e,f}/.gs["Points"])];
Use generalized ListConvolve to find the side lengths in cyclic order, padded with to complete the circular scan.
a
In[]:=
ListConvolve[{1,1},{a,b,c,d,e,f},2,a,Times,EuclideanDistance]
Out[]=
{EuclideanDistance[a,b],EuclideanDistance[b,c],EuclideanDistance[c,d],EuclideanDistance[d,e],EuclideanDistance[e,f],EuclideanDistance[f,a]}
Replace the symbols with their numerical value
In[]:=
%/.gs["Points"]
Out[]=
{5.,3.,6.,7.,1.,8.}
Therefore the other lengths are 1 and 8.
Quick Visualization for Proof
Quick Visualization for Proof
Basically you need to extend several sides to meet each other so that the new vertices will form a equilateral triangle. I will show you how to quickly draw the diagram with very few lines of code.
Compute the location of intersections with the utility function (defined at the bottom) I use quite often on Community
intersection segmentIntersection[p1,p2,p3,p4]
In[]:=
{ptG,ptH,ptI}=({segmentIntersection[e,f,b,a],segmentIntersection[a,b,d,c],segmentIntersection[c,d,f,e]}/.gs["Points"])[[All,3]];
Generate an Association for generalized point operation for location extraction and labelling.
In[]:=
pts=pts~Join~AssociationThread[{g,h,i}->{ptG,ptH,ptI}];
Very clear visualization cannot be done without proper HatchFilling
In[]:=
Graphics[{{Transparent,EdgeForm[Dashed],Triangle[pts/@{g,h,i}]},{HatchFilling[],EdgeForm[{Thick,Cyan}],Polygon[pts/@{a,b,c,d,e,f}]},label/@Keys[pts]}]
Out[]=
By assuming and , we can find the solution by solving the following set of equations with
(x=EF)
(y=FA)
Solve[{x+y+7y+5+3(*GI=GH*),x+y+73+6+7(*GI=HI*)},{x,y}]
Out[]=
{{x1,y8}}
Summary
Summary
◼
Use GeometricScene to solve implicitly for the proper coordinates of points of interest
◼
Use HatchFilling to highlight the region of interest
◼
Extend sides of the given hexagon to find the bounding equilateral triangle
◼
Solve equation in terms of unknowns sides based on the length equalities from the trianlge above
Utility Functions
Utility Functions
In[]:=
label[sym_Symbol]:=With[{pos=pts[sym]},{PointSize[0.045],Hue[0.58,1,1],Point[pos],Text[Style[sym,White,12],pos]}]
In[]:=
segmentIntersection[p1_List,p2_List,p3_List,p4_List]:=Block[{u,v},Module[{sol},sol=Solve[u*(p2-p1)+p1v*(p4-p3)+p3,{u,v}];{u,v,u*(p2-p1)+p1}/.sol〚1〛]]