A Perfect Cognac Glass

RR[x_,xs_]:=4 x Exp[-x/xs]

LL[x_,m_,x1_,y1_]:=m (x-x1)+y1

CC[h_,r_]:=(r^2) ArcCos[h/r]-h r Sin[ArcCos[h/r]]

SCC[h_,r_]:=If[h>0,π (r^2)-CC[h,r],CC[Abs[h],r]]

Volumes[m_,stem_,xs_,xmax_,ymax_]:=Block[{level0,xx,x,vol1,vol2, x0,x1},
level0=LL[0,m,xmax,ymax];
If[level0≤0,
x0=xx/.Quiet[Solve[-RR[xx,xs]==level0,xx]][[1]];
vol1=Re[NIntegrate[CC[Abs[LL[x,m,xmax,ymax]],RR[x,xs]],{x,x0,xmax}]],
x0=xx/.Quiet[Solve[RR[xx,xs]==level0,xx]][[1]];
vol1=Re[NIntegrate[SCC[LL[x,m,xmax,ymax],RR[x,xs]],{x,x0,xmax}]]+π NIntegrate[((RR[x,xs])^2),{x,0,x0}]
];
x1=(vol1 (E^2))/(4  π (-5+(E^2)));
vol2=π NIntegrate[((RR[x,xs])^2),{x,0,xs}];
{vol1,vol2,x0,x1}]

Diagram[m_,stem_,x0_,xs_,xmax_,ymax_]:=Block[{dx=0.1,rt, x1,y1,xxx},
x1=Abs[xxx/.Flatten[Quiet[Solve[-(∂_xxx)RR[xxx,xs]==m,xxx]]]];
y1=-RR[x1,xs];
rt=RotationTransform[-ArcTan[m],{x1,y1}];
{
ListPlot[{rt[Table[{x,-RR[x,xs]},{x,0,xmax,dx}]],rt[Table[{x,LL[x,m,xmax,ymax]},{x,Abs[x0],xmax+dx,dx}]]},Joined->True,PlotStyle->{{Gray,Thick},{Orange,Opacity[0.0]}},Filling->True,FillingStyle->Orange,Axes->False,PlotRange->{All,All}],ListPlot[{rt[Table[{x,LL[x,m,x1,y1]},{x,-2 stem,xmax,dx}]],rt[Table[{x,RR[x,xs]},{x,0,xmax,dx}]]},Joined->True,PlotStyle->{{Black,Thick},{Gray,Thick}}],
ListLinePlot[rt[{{0,0},{-stem,0},{-stem,-LL[-stem,m,x1,y1]},{-stem,LL[-stem,m,x1,y1]}}],PlotStyle->{Gray,Thick}]
}
]

Manipulate[
Module[{xs,xmax,ymax,vol1,vol2,x0,x1},
xs=1;xmax=2.71;ymax=-RR[xmax,xs];
{vol1,vol2,x0,x1}=Volumes[m,stem,xs,xmax,ymax];
Grid[{{
Show[Diagram[m,stem,x0,xs,xmax,ymax],
Graphics[Text[Style[StringForm["traditional measure = ``",NumberForm[vol1,3]],11],{1,-2}]],
PlotRange->{{-1.5,3.5},{-2.5,2.5}},AspectRatio->1,ImageSize->275],
Show[
RevolutionPlot3D[RR[x,xs],{x,0,xmax},RevolutionAxis->{1,0,0},Mesh->None,PlotStyle->{Gray,Opacity[0.1]},Boxed->False,Axes->False],
Graphics3D[{EdgeForm[{Gray,Thin, Dashed}],Opacity[0.0],Cylinder[{{xs-0.001,0,0},{xs,0,0}},RR[xs,xs]]},Boxed->False],Graphics3D[{{EdgeForm[None],FaceForm[Orange],Opacity[0.3],Cylinder[{{x1-0.01,0,0},{x1,0,0}},RR[x1,xs]]},{EdgeForm[None],FaceForm[Gray],Opacity[0.1],Cylinder[{{-stem,0,0},{-stem+0.05,0,0}},-LL[-stem,m,x1,-RR[x1,xs]]]}},Boxed->False],
Graphics3D[Text[Style[StringForm["popular measure = ``",NumberForm[vol2,3]],11],{-1.0,0,0}]],
PlotRange->{{-0.7,2.7},{-0.5,1.7},{-1.7,1.7}},ViewVertical->{1,0,0},ImageSize->275,SphericalRegion-> True]
}}]],
{{stem,0.5,"stem"},0.2,0.8,0.01,Appearance-> "Labeled"},
{{m,0.0,"base"},0.1,-0.36,0.005, Appearance-> "Labeled"},
SaveDefinitions-> True,
TrackedSymbols :> {m,stem}]

CAPTION

The traditional measure of cognac is to place the glass on its side and fill to the brim. An equally popular measure is to place the glass vertically and fill to point of maximum surface area. For a given glass curvature and stem length, by adjusting the base width we can create the perfect cognac glass, where the two measures are equal. Varying the stem length will adjust the base so that the measure is not changed.

DETAILS

The cognac glass is described by its radial function R(x), where x is the height when the glass is sitting on its base. In order to calculate the traditional measure of cognac (when the glass is placed on its side), we need the area enclosed by the chord C(x) created by the cognac level L(x). That area is simply the area of its sector minus the area of its isosceles triangle. The volume is then equal to the integral over C(x) from 0 to (Subscript[x, max]) (the brim of the glass), and depending on L(x), we must switch between the upper and lower areas enclosed by the chord. The popular measure of cognac (when the glass is placed standing up) is simply π(∫_0^(Subscript[x , s]))((R(x))^2)dx, where (Subscript[x, s]) is the point of maximum surface area.

THIS NOTEBOOK IS THE SOURCE CODE FROM

Liam Cleary

"A Perfect Cognac Glass"
 http://demonstrations.wolfram.com/APerfectCognacGlass/
 Wolfram Demonstrations Project
 Published: January 25, 2013

A full-function Wolfram Mathematica system is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »