# Draw an unusually-shaped vodka bottle, and calculate its volume

The bottom and the top of the vodka bottle shown here,

are two ellipses of the same area and shape; and the vertical axis that joins the intersections of the two ellipses' minor and major axes is perpendicular to both. The angle, however, between the two major axes - bottom and top - is ninety degrees.

1. How to draw it?
2. How to calculate its volume?

(Several degrees of complication can of course be added: Ellipses differ, ellipses not parallel, vertical axis not perpendicular, any degree of twist. Devilish.)

Simple linear interpolation gives a reasonable-looking approximation:

With[{a = Sqrt[2], b = 1, h = 8},
ParametricPlot3D[{(b (1 - v/h) + v/h a) Cos[u], (a (1 - v/h) + v/h b) Sin[u], v},
{u, 0, 2 π}, {v, 0, h}, Lighting -> "Neutral", Mesh -> False,
PlotStyle -> Opacity[1/5, ColorData["Legacy", "PowderBlue"]]]]


For computing the volume:

With[{a = Sqrt[2], b = 1, h = 8},
Volume[ParametricRegion[{r (b (1 - v/h) + v/h a) Cos[u],
r (a (1 - v/h) + v/h b) Sin[u], v},
{{u, 0, 2 π}, {r, 0, 1}, {v, 0, h}}]]]
4/3 (3 + 4 Sqrt[2]) π


or manually,

With[{a = Sqrt[2], b = 1, h = 8},
Integrate[Det[D[{r (b (1 - v/h) + v/h a) Cos[u],
r (a (1 - v/h) + v/h b) Sin[u], v}, {{u, v, r}}]],
{u, 0, 2 π}, {r, 0, 1}, {v, 0, h}]]

• neat, wish I could give more than +1. Happy New Year :) – ubpdqn Jan 14 '17 at 9:54
• J. M. and corey979 thank you! – Matthias Bode Jan 15 '17 at 1:47
• J. M. and corey979 thank you! I took the outside measurements of the original bottle (one liter) with a Vernier Caliper - with the usual measurement errors. Then I used FindRoot to estimate the thickness of bottle's glass sidewall. Result: Six millimeters. This is quite reasonable given the empty bottle's mass of 1.2 kilograms. After correction for glass thickness both volume formulae by J. M. yielded 1'000'000 cubic millimeters as expected. Matthias Bode. – Matthias Bode Jan 15 '17 at 2:16
• @Matthias, if you've found any answer here satisfactory, please don't forget to click on the check-mark under the arrows to the left of the answer. :) – J. M. is away Jan 15 '17 at 12:28

This_could be done with Region functions. Note that while convenient, they are usually not very fast. But FWIW:

a = Sqrt[2];
b = 1;
{zmin, zmax} = {0, 8};


Rotation of the ellipse so that it makes a 90 degree while going from z = 0 to z = 8:

m[z_] = (RotationMatrix[Pi/2 z/zmax].{x, y}/{a, b}).(RotationMatrix[Pi/2 z/zmax].{x, y}/{a, b}) <= 1


A region:

reg = ImplicitRegion[m[z] && zmin < z < zmax && -2 < x < 2 && -2 < y < 2, {x, y, z}];


To view the cross sections at height z:

tab = Table[
RegionPlot[m[z], {x, -2, 2}, {y, -2, 2},
PlotLabel -> "z = " <> ToString[z]], {z, zmin, zmax, 0.5}];
ListAnimate[tab]
Export["plot.gif", tab, "DisplayDurations" -> 0.5]


Drawing the region (slow):

RegionPlot3D[reg, PlotPoints -> 100, BoxRatios -> {a, a, 8}, Axes -> True]


Volume[reg] runs for several minutes without an answer (see also this thread). However, discretizing the region is much faster:

DiscretizeRegion[reg]


and its numerical volume

Volume @ DiscretizeRegion[reg]


35.3772

Volume @ DiscretizeRegion[reg, MaxCellMeasure -> 0.0001] gives a more accurate volume equal to 35.5378; decreasing MaxCellMeasure improves the volume but at the cost of a longer computation. Note that the exact volume is 8 Sqrt[2] Pi, which is approximately 35.5431, so the agreement is quite satisfying. Unfortunately, RootApproximant[v/Pi, 2] fails to recognize the correct volume for any v obtained above (see also this answer and the thread linked there).

Compare to the approximation obtained by J. M. (whose answer is less accurate, but faster; so it depends what's the expectation put on) with ParametricRegion :

4/3 (3 + 4 Sqrt[2]) Pi // N


36.2617

• The exact volume for this approach is $8\sqrt{2}\pi$. – J. M. is away Jan 14 '17 at 18:39