Group Abstract Group Abstract

Message Boards Message Boards

YouTube quizzes: Share your Wolfram Language solution!

POSTED BY: Raspi Rascal
11 Replies

Thanks xzczd for the pointer! So what about this one where i failed to even code the problem statement:

VERY HARD South Korean Geometry Problem (CSAT Exam) enter image description here

The first step is to identify the three distinct points. Point C be the tip of the cone. The coordinate system's origin be at the center of the cone base:

pA = {20, 0, 0};
pB = {Bx, 0, Bz}; (* y-coordinate of B is zero *)
pC = {0, 0, Cz};
Cz = Sqrt[60^2 - 20^2]; (* Phythagoras for the cone height *)
(20 - Bx)^2 + Bz^2 == 10^2; (* Phythagoras for z-height of B *)
Bx > 0;(* x-coordinate of B *)
Bz > 0; (* z-coordinate of B *)
20/Bx == 60/(60-10); (* intercept theorem *)
Bx = 50/3; (* In[10]:= Solve[{(20-Bx)^2+Bz^2==10^2,Bx>0,Bz>0,20/Bx==60/(60-10)}] *)
Bz = 20 Sqrt[2]/3; (* Out[11]= {{Bx -> 50/3, Bz -> (20 Sqrt[2])/3}} *)

The cone is fully defined, the three points are fully known. It is obvious that point A can be connected to point B through millions of space curves S all of which lie in the region boundary of the cone. We would like to find the shortest path (or tour) S which has the minimum arc length from A to B, under the condition that the path does revolve around the cone once. The most direct mathematical description of a curve in 3D-space is through the parametrization with a single parameter t, $\overset{\rightharpoonup }{r}(t)=\{x(t),y(t),z(t)\}$. Once we know the parametrization of $\overset{\rightharpoonup }{r_S}(t)$, i.e. the full description of the path S in dependence of parameter t, it is a piece of cake to calculate any other quantity, such as the length of S and the length of S up to the point where the curve reaches its maximum z-height.

I've tried the Wolfram Language items Cone[ ], Region[ ], RegionBoundary[ ], RegionMember[ ], RegionMeasure[ ], and also ImplicitRegion[ ], RegionDifference[ ] and didn't get any far. I believe we will need FindMinimum[ ] or NMinimize[ ], with ArcLength[ ] being our objective function for minimization or use FindShortestTour[ ], FindCurvePath[ ], but i fail to put the coding pieces together. This problem has imho more to do with maths than with coding, but we should be able to solve it idiomatically getting an analytical solution anyway, shouldn't we?

Anyone with such a solution?

POSTED BY: Raspi Rascal
Posted 8 years ago

As far as I know, the stand way for attacking this type of problem is unfolding the cone to a sector:

enter image description here

In the new coordinate system the coordinate of A and B is

p@A = {60, 0}; p@B = FromPolarCoordinates@{50, (2 π 20)/60};

and apparently the parametric equation for the shortest tour is

eq2D = (p@A - p@B) t + p@B // ToPolarCoordinates

where 0 < t < 1.

Then we just need some coordinate transform to find the equation in original coordinate system:

α = ArcSin[20/60];    
h = 60 Cos@α;
eq3D = Function[{r, θ}, 
   CoordinateTransform[ 
    "Cylindrical" -> "Cartesian", {r Sin@α, 60 θ/20, h - r Cos@α}]] @@ 
  eq2D

Graphics3D@{Opacity[0.5], Cone[{{0, 0, 0}, {0, 0, h}}, 20]}~Show~
 ParametricPlot3D[eq3D, {t, 0, 1}, PlotRange -> All]

enter image description here

Not sure if this problem can be attacked in a more straightforward way i.e. directly finding the equation in 3D space.

POSTED BY: xzczd  

Yikes, terrific solution (which i don't fully understand tbh np) thanks for the share with the 3D plot, appreciated! Today i watched the video to the end (and understood it np) and was surprised, not impressed, by the easy solution; most of his suggested solutions are only possible because of the symmetry or primitivity of the involved geometric objects, shapes, and whatnot. What if the cone was not a right cone but a skew cone or an arbitrarily shaped mountain 3-D surface given by $\overset{\rightharpoonup }{r_S}(s,t)$ or by $z_S=f(x,y)$ ? Then the unfolding idea to a 2-D flat plane would fail right away. And then we would need to take the straight-forward mathematical way, i.e. using Calculus and possibly some Minimization method, or a purely numerical method using idiomatic coding of the problem statement with the suggested language items. I just couldn't figure out how nm, moving on.

Thanks again, great stuff there xzczd!!

POSTED BY: Raspi Rascal

Not really a quiz but a provocative youtube title anyway: believe in the math, not wolframalpha

$$\sqrt[3]{7+\sqrt{50}}+\sqrt[3]{7-\sqrt{50}}$$ I wasn't able to solve it with

(7 + Sqrt[50])^(1/3) + (7 - Sqrt[50])^(1/3) // Simplify

But this did the trick:

In[1]:= CubeRoot[7 + Sqrt[50]] + CubeRoot[7 - Sqrt[50]] // FullSimplify
Out[1]= 2?

Lol.

You got any other solution method with Mathematica?

POSTED BY: Raspi Rascal
Posted 8 years ago

The two expressions are not equivalent. Try

(-1)^(1/3) // N
CubeRoot[-1] // N

For more information, check these posts:

https://mathematica.stackexchange.com/q/104281/1871 https://mathematica.stackexchange.com/q/3886/1871

POSTED BY: xzczd  
POSTED BY: Raspi Rascal

I quickly turn Mathematica upside down :P.

Execute this code:

r1 = Polygon[{{0, 0}, {a/2, 0}, {x, y}, {0, a/2}}];
r2 = Polygon[{{0, a/2}, {x, y}, {a/2, a}, {0, a}}];
r3 = Polygon[{{a/2, a}, {x, y}, {a, a/2}, {a, a}}];
r4 = 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)} & /@ {WorkingPrecision -> 
MachinePrecision};FindMinimum[{0, eqs}, {x, y, a}]
POSTED BY: Mariusz Iwaniuk
Posted 4 years ago

I'm not sure when it's improved, but at least since v12.3.1, we no longer needs to split into triangle!:

area[pts_] := Area[Polygon[pts], Assumptions -> {0 < x < a, 0 < y < a}]

o = {0, 0}; A = {a, 0}; B = {a, a}; F = {0, a};
G = (o + F)/2; H = (o + A)/2; J = (A + B)/2; L = (F + B)/2;
K = {x, y};
a^2 - 16 - 20 - 32 /. 
 Solve@{area[{o, H, K, G}] == 16, 
        area[{G, K, L, F}] == 20, 
        area[{J, K, L, B}] == 32,
        a > 0}
(* {28} *)
POSTED BY: xzczd  
Posted 8 years ago

Seems that Area isn't strong enough, so let's help it a bit:

enter image description here

Then the analytic solution can be found easily:

area[pts_] := Area[Polygon[pts], Assumptions -> {0 < x < a, 0 < y < a}]

o = {0, 0}; A = {a, 0}; B = {a, a}; F = {0, a};
G = (o + F)/2; H = (o + A)/2; J = (A + B)/2; L = (F + B)/2;
K = {x, y};

a^2 - 16 - 20 - 32 /. Solve@{area[{o, H, K}] + area[{o, K, G}] == 16,
   area[{G, K, F}] + area[{F, L, K}] == 20,
   area[{J, K, B}] + area[{L, K, B}] == 32, a > 0}
(* {28} *)
POSTED BY: xzczd  

Raspi,

I did not think about whether this is the "best" way to solve the problem -- I just looked at fixing what you tried to do. The Region functions (like Area) appear to work numerically so based on that I think you need to take a numerical approach:

areacalc[xi_Real, yi_Real, ai_Real, reg_] :=  Area[reg] /. { x -> xi , y -> yi, a -> ai}

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 = {areacalc[x, y, a, r1] == 16., areacalc[x, y, a, r2] == 20, 
   areacalc[x, y, a, r3] == 32, 
   areacalc[x, y, a, r4] == a^2 - (16 + 20 + 32), 11 > x > 0, 
   11 > y > 0, 11 > a > 0};

In[45]:= NMinimize[Prepend[eqs, 1], {x, y, a}]

Out[45]= {1., {x -> 2.44949, y -> 4.08248, a -> 9.79796}}

The key to making this work is "Protecting" the areacalc function from evaluating until it has numerical values for x,y,and a. This is why I used patterns such as xi_Real. The pattern match will only happen when the xi, yi, and ai get numerical values.

I hope this helps,

Regards,

Neil

POSTED BY: Neil Singer
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard
Be respectful. Review our Community Guidelines to understand your role and responsibilities. Community Terms of Use