CITE THIS NOTEBOOK: Solving math puzzles for American Mathematics Competitions by Peter Burbery. Wolfram Community OCT 2022.
In[]:=
Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]]
Out[]=
+-++-0,+3x-+3z+xz-0,9-+6z0,-3x-+3z-xz-0,--+--0,+-++-0,2+2x-+2z+xz-0,4-+4z0,2-2x-+2z-xz-0,--+--0,+-++-0,+x-+z+xz-0,1-+2z0,-x-+z-xz-0,--+--0,---+-0,-x--z+xz-0,1--2z0,+x--z-xz-0,+----0,---+-0,2-2x--2z+xz-0,4--4z0,2+2x--2z-xz-0,+----0,---+-0,-3x--3z+xz-0,9--6z0,+3x--3z-xz-0,+----0
9
5
12x
5
2
x
5
6z
5
4xz
5
4
2
z
5
9
2
2
x
2
2
z
2
2
x
9
2
2
x
2
2
z
2
9
5
12x
5
2
x
5
6z
5
4xz
5
4
2
z
5
4
5
8x
5
2
x
5
4z
5
4xz
5
4
2
z
5
2
x
2
2
z
2
2
x
2
x
2
2
z
2
4
5
8x
5
2
x
5
4z
5
4xz
5
4
2
z
5
1
5
4x
5
2
x
5
2z
5
4xz
5
4
2
z
5
1
2
2
x
2
2
z
2
2
x
1
2
2
x
2
2
z
2
1
5
4x
5
2
x
5
2z
5
4xz
5
4
2
z
5
1
5
4x
5
2
x
5
2z
5
4xz
5
4
2
z
5
1
2
2
x
2
2
z
2
2
x
1
2
2
x
2
2
z
2
1
5
4x
5
2
x
5
2z
5
4xz
5
4
2
z
5
4
5
8x
5
2
x
5
4z
5
4xz
5
4
2
z
5
2
x
2
2
z
2
2
x
2
x
2
2
z
2
4
5
8x
5
2
x
5
4z
5
4xz
5
4
2
z
5
9
5
12x
5
2
x
5
6z
5
4xz
5
4
2
z
5
9
2
2
x
2
2
z
2
2
x
9
2
2
x
2
2
z
2
9
5
12x
5
2
x
5
6z
5
4xz
5
4
2
z
5
Start with a simple visualization:
In[]:=
ContourPlot[Evaluate[First[Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]]]],{x,-5,5},{z,-5,5}]
Out[]=
In[]:=
ContourPlot[Evaluate@Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]],{x,-5,5},{z,-5,5}]
Out[]=
Find all subsets with two parabolas:
In[]:=
Subsets[Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]],{2}]
Out[]=
Combine the two equations with the boolean and:
In[]:=
And@@@Subsets[Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]],{2}]
Out[]=
Find the answers:
In[]:=
Flatten[FindInstance[#,{x,z},Reals]&/@And@@@Subsets[Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]],{2}]]
Out[]=
Count the intersections:
In[]:=
Length[Flatten[FindInstance[#,{x,z},Reals]&/@And@@@Subsets[Flatten[Table[Table[ConicProperties[<|"Focus"->{0,0},"Directrix"->z==bx+c|>,{x,z},"Equation"]["Equation"],{b,-2,2}],{c,Join[Range[-3,-1],Range[3]]}]],{2}]]]
Out[]=
810
I found the answer on Wikipedia:
I'm not really sure where to go with this one, so I'm going to establish an upper bound.
I'm trying to use the difference instead:
I evaluate all tuples up to 61:
I could have also done this:
I can solve this one with simple arithmetic.
I can use PolyhedronData:
I think image processing is too complicated so I'm just going to manually input the graph.
We shouldn't count Sarah so we subtract one.
Check the answer:
It looks 6 is the most uncommon.
I'm stuck on this next question. I think the issue is its sampling without replacement. For example if Carlos take 8 there's only 9 and 10 left. This situtation can be modeled with the hypergeometric distribution through the function HypergeometricDistribution and the function Probability, but I'm not sure how to add the functino Plus and Times into Probability for example with Transformed Distribution. I could also try to use brute force but I prefer to use a built-in function I'm going to stop working on 1998 AJHSME #19 right now.
Find the probabilities
Subset is used to ensure the numbers are different. Tuples will have duplicates like {3,3} which I don't want. I specify that the length of the subset should be exactly two with the second argument {2} for Subsets.
Create two empirical distributions:
I found another question to work on for now.
The length of AX is 10.
I got the right answer!