Let's share our Wolfram Language solutions of any arbitrary quiz/maths challenge which we found on the tube!
I am not subscribed to such channels but once in a while i would see a maths quiz video on my YouTube Recommendations page, for example MindYourDecisions.
So how about this recent one: What Is The Area? "You Should Be Able To Solve This"
I am not interested in his analytical solution, tbh never watched the full video. I stopped the video right after the problem statement! I just want Mathematica to spit out the numerical (exact or approximate) solution. I've come so far:
In[1]:= r1 = Region@Polygon[{{0, 0}, {a/2, 0}, {x, y}, {0, a/2}}];
r2 = Region@Polygon[{{0, a/2}, {x, y}, {a/2, a}, {0, a}}];
r3 = Region@Polygon[{{a/2, a}, {x, y}, {a, a/2}, {a, a}}];
r4 = Region@Polygon[{{a/2, 0}, {a, 0}, {a, a/2}, {x, y}}];
eqs =
{Area[r1] == 16,
Area[r2] == 20,
Area[r3] == 32,
Area[r4] == a^2 - (16 + 20 + 32),
11 > x > 0, (* looking at the picture, i chose an estimated upper bound of 11 *)
11 > y > 0, (* bounding the variables should help the convergence of the numerical solver *)
11 > a > 0 (* but it is not always necessary to provide upper bounds *)
};
Then i've tried NSolve[ ], NMinimize[ ], FindInstance[ ], FindMinimum[ ] and only one of them worked. I must admit that i don't have much experience with these three functions and my PC's memory is limited too.
sol = FindMinimum[{0, eqs}, {x, y, a}, Reals] (* FAIL *)
sol = NSolve[eqs, {x, y, a}, Reals] (* FAIL *)
sol = FindInstance[eqs, {x, y, a}, Reals] (* FAIL *)
In[6]:= sol = Last@NMinimize[{0, eqs}, {x, y, a}, Reals] (* {x -> 2.44949, y -> 4.08248, a -> 9.79796}} *)
Out[6]= {x -> 2.44949, y -> 4.08248, a -> 9.79796}
In[7]:= Area[r4] /. sol
Out[7]= 28.
Whenever you come across a youtube quiz and solved it as recreational task, please share here, it's much fun!