0
$\begingroup$

With the following code, I can only get the results when the radius of the ball and the half apex angle of the cone are specific values.

Clear["Global`*"];
v1 = ImplicitRegion[x^2 + y^2 + (z - 2)^2 <= 2^2, {x, y, z}]
v2 = ImplicitRegion[z >= Cot[Pi/3]*(\!\(TraditionalForm\`
\*SqrtBox[\(
\*SuperscriptBox[\(x\), \(2\)] + 
\*SuperscriptBox[\(y\), \(2\)]\)]\)), {x, y, z}]
v = RegionIntersection[v1, v2];
Assuming[a > 0 && Pi/2 > \!\(TraditionalForm\`\[Alpha]\) > 0, 
 Volume[v]]

(*10Pi*)

But very long time by:

Clear["Global`*"];
v1 = Ball[{0, 0, 2}, 2];
v2 = Cone[{{0, 0, 0}, {0, 0, 2*2}}, 2*2*Tan[Pi/3]];
v = RegionIntersection[v1, v2];
Volume[v]

(10Pi)

However, I can't get the result when the radius of the ball and the half apex angle of the cone are variable with the following code:

Clear["Global`*"];
v1 = ImplicitRegion[x^2 + y^2 + (z - a)^2 <= a^2, {x, y, z}]
v2 = ImplicitRegion[z >= Cot[\[Alpha]]*(\!\(TraditionalForm\`
\*SqrtBox[\(
\*SuperscriptBox[\(x\), \(2\)] + 
\*SuperscriptBox[\(y\), \(2\)]\)]\)), {x, y, z}]
v = RegionIntersection[v1, v2];
Assuming[a > 0 && Pi/2 > \!\(TraditionalForm\`\[Alpha]\) > 0, 
 Volume[v]]

($Aborted)

How to get the result?

$\endgroup$
6
  • $\begingroup$ you must know at least one way of doing it based on my previous answer. I am correct to assume that you don't particularly enjoy my FindSequenceFunction approach and you want something more automated? $\endgroup$
    – user49048
    Commented Feb 28, 2022 at 8:20
  • $\begingroup$ The method you mentioned is very creative, but it can only solve some problems and may not be applicable to general situations. @kcr $\endgroup$
    – lotus2019
    Commented Mar 1, 2022 at 1:29
  • $\begingroup$ Maybe I should have explained myself better. I am not trying to make you view this as a golden hammer, of course not. All I meant to point out, is that your previous question was similar in spirit. There was an answer in that previous question, that could be potentially applicable here. So, not really sure why not give it a go. If you tried it, you should have mentioned it in your OP so we know what was tried and did not work and we can try to come up with alternatives. Judging by your comment in the reply here, you did not consider that approach. $\endgroup$
    – user49048
    Commented Mar 1, 2022 at 1:54
  • $\begingroup$ In any case, this was not meant to be a sassy comment, more an effort of explaining how I would go about doing it and also writing the OP and what I expected to see. Maybe I should not have said anything. A final comment about the method discussed, of course it is as good as Mathematica allows :-) $\endgroup$
    – user49048
    Commented Mar 1, 2022 at 1:55
  • $\begingroup$ Thank you. I think you should take a look at Shin Kim 's answer, which uses the method you mentioned. @kcr $\endgroup$
    – lotus2019
    Commented Mar 1, 2022 at 2:12

1 Answer 1

2
$\begingroup$

I doubt Mathematica will find the closed form for that volume with the region given as is, despite it's actually quite simple to derive. I did what @kcr suggested, for the special angles:

LaunchKernels[];
vol = {};
SetSharedVariable[vol];
ParallelDo[
    a = i;
    ang = j;
    v1 = ImplicitRegion[x^2 + y^2 + (z - a)^2 <= a^2, {x, y, z}];
    v2 = ImplicitRegion[z >= Cot[ang]*Sqrt[x^2 + y^2], {x, y, z}];
    v = RegionIntersection[v1, v2];
    AppendTo[vol, {i, ang, Volume[v]}]
, {i, 1, 8}, {j, {Pi/6, Pi/4, Pi/3}}]
CloseKernels[];

vol = Sort[vol]

(* {{1, Pi/6,    (7*Pi)/12}, {1, Pi/4,     Pi}, {1, Pi/3,    (5*Pi)/4},
    {2, Pi/6,   (56*Pi)/12}, {2, Pi/4,   8*Pi}, {2, Pi/3,       10*Pi},
    {3, Pi/6,  (189*Pi)/12}, {3, Pi/4,  27*Pi}, {3, Pi/3,  (135*Pi)/4},
    {4, Pi/6,  (448*Pi)/12}, {4, Pi/4,  64*Pi}, {4, Pi/3,       80*Pi},
    {5, Pi/6,  (875*Pi)/12}, {5, Pi/4, 125*Pi}, {5, Pi/3,  (625*Pi)/4},
    {6, Pi/6,       126*Pi}, {6, Pi/4, 216*Pi}, {6, Pi/3,      270*Pi},
    {7, Pi/6, (2401*Pi)/12}, {7, Pi/4, 343*Pi}, {7, Pi/3, (1715*Pi)/4},
    {8, Pi/6, (3584*Pi)/12}, {8, Pi/4, 512*Pi}, {8, Pi/3,      640*Pi}}  *)

and we know that vol = 4/3*Pi*a^3 for ang >= Pi/4, so what I've got from putting the results for each special angle in FindSequenceFunction is

 7/12*Pi*n^3 (*for Pi/6*)
12/12*Pi*n^3 (*for Pi/4*)
15/12*Pi*n^3 (*for Pi/3*)
16/12*Pi*n^3 (*for Pi/2*)

I put the coefficients again to FindSequenceFunction but no result came out.

The following is the derivation. The intersection simply consists of a cone and a spherical cap who are adjacent at a disk with radius $a\sin(2\alpha)$. Then the height of the cone is $a\sin(2\alpha)\cot(\alpha)$ or, equivalently, $2a\cos^2\alpha$, and that of the cap is $2a\left(1-\cos^2(\alpha)\right)$ or, equivalently, $2a\sin^2(\alpha)$. Put these into the known volume formulas, $$\begin{align*} V_\mathrm{cone}&= \frac{\pi}{3}\left(2a\cos^2\alpha\right)\left(a\sin(2\alpha)\right)^2\\ V_\mathrm{cap}&= \frac{\pi}{6}\left(2a\sin^2(\alpha)\right)\left(3\left(a\sin(2\alpha)\right)^2-(2a\sin^2(\alpha))^2\right)\\ V&=V_\mathrm{cone}+V_\mathrm{cap}=\left(\frac{2}{3}\left(3+\cos(2\alpha)\right)\sin(\alpha)^2\right)\pi a^3 \end{align*}$$

To see this coincides with the computed vol,

A[a_, ang_] := (2/3*(3 + Cos[2*ang])*Sin[ang]^2)*Pi*a^3

Flatten[Table[{i, j, A[i,j]}, {i, 1, 8}, {j, {Pi/6, Pi/4, Pi/3}}], 1] == vol
(* True *)
$\endgroup$
1
  • $\begingroup$ Thank you for your answer. You mean MMA code can't solve this problem? @Shin Kim $\endgroup$
    – lotus2019
    Commented Mar 1, 2022 at 1:27

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.