Das Glas ist halb voll... oder doch halb leer?

(1)

Das Glas ist halb voll... oder doch halb leer?

Will man der Frage auf den Grund gehen, wann ein vorgegebenes Behältnis, zum Beispiel ein Weinglas halb voll ist, so kann diese Fragestellung zu kurzweiliger mathematischer Beschäftigung führen.

Wir gehen der Frage hier auf den Grund. Als ersten brauchen wir dazu das Bild eines Weinglases.

Das ist einfach, da eines meiner größten Hobbies die Photographie ist. Ein Weinglas? Bitte sehr!

weinglas =

Nun muß das Glas sozusagen in Bits und Bytes gegossen werden. Das ist glücklicherweise leichter als man denkt. In Mathematica können Grafiken zum einen rudimentär bearbeitet werden, zum andern ist die Möglichkeit enthalten durch Mausclicks die aktuellen Koordinaten des Mauzszeigers zu speichern: Mausklick rechts und dann “Get Coordinates”. Damit werden die aktuellen Koordi- naten bei jedem Klick gespeichert und können dann via “Kopieren und Einfügen” direkt einer Vari- ablen in Mathematica zugewiesen werden.

Damit kann man die Konturlinie des Glases abfahren und digitalisieren. Für das hier abgebildete

(2)

g g

Glas liefert diese Methode folgende Koordinaten:

glasKoordinaten = {{519.297`, 765.388`},

{523.983`, 743.523`},{531.792`, 720.096`},{538.039`, 681.051`}, {541.162`, 659.186`},{545.848`, 626.388`},{541.162`, 593.59`}, {533.353`, 552.983`},{516.174`, 517.062`},{494.308`, 488.95`}, {472.443`, 459.276`},{455.264`, 443.658`},{436.522`, 429.602`}, {414.657`, 407.736`},{399.039`, 403.051`},{383.421`, 390.557`}, {374.05`, 379.624`},{369.365`, 365.568`},{367.803`, 334.332`}, {367.803`, 301.534`},{372.488`, 260.928`},{372.488`, 223.444`}, {374.05`, 198.456`},{372.488`, 173.467`},{372.488`, 156.287`}, {381.859`, 142.231`},{402.163`, 129.737`},{427.151`, 118.804`}, {447.455`, 109.433`},{470.882`, 103.186`},{502.117`, 93.8154`}, {517.735`, 90.6918`},{517.735`, 81.321`},{519.297`, 73.512`}};

Zur einfacheren Darstellung im Koordinatensystem ziehen wir von den jeweiligen Koordianten das Minimum über alle Koordinaten ab. Dazu wird das jeweilige Minimum erst einmal ermittelt:

minKoordinatenX = Min @glasKoordinaten[[All, 1]]

367.803

minKoordintaenZ = Min @ glasKoordinaten[[All, 2]]

73.512

Und danach die entsprechenden Interpolationsfunktionen für die Kontour des Glases berechnet. Die Funktion Interpolation berechnet dabei eine Funktoon die die gegbenen Punkte duch ein Polynom interpoliert (wobei stets als x-Wert die Werte 1, 2, 3, ... angenommen werden. Dabei wird das jeweilige Minimum (abgerundet, damit der Glasstil nicht verschwindet) von den Koordinaten abgezogen:

glasX = InterpolationFirst[#] -360& /@ glasKoordinaten;

glasZ = Interpolation[(Last[#] -70)& /@ glasKoordinaten];

Graphics[{

Line@Table[{glasX[t], glasZ[t]},{t, 1, Length[glasKoordinaten], .1}], Line@Table[{-glasX[t], glasZ[t]},{t, 1, Length[glasKoordinaten], .1}]

}]

Das sieht ja schon ganz gut aus, es geht natürlich auch - und das überraschend einfach - dreidimen- sional, einfach als Rotationskörper:

2 2013 Weinglas.nb

(3)

RevolutionPlot3D[{glasX[t], glasZ[t]},{t, 1, Length[glasKoordinaten]}]

Zur Berechnung des Inhalts wird nur derjenige Teil des Glases betrachtet, der die Flüssigkeit aufn- immt, in diesem Falle also den Wein. Dazu werden die entsprechenden Koordinaten aus dem obigen Bild erneut digitalisiert:

volumen = {{383.421`, 395.242`},

{392.792`, 403.051`},{406.848`, 412.422`},{424.028`, 418.669`}, {439.646`, 432.725`},{459.949`, 446.781`},{477.129`, 463.961`}, {488.061`, 478.017`},{503.679`, 493.635`},{514.612`, 512.377`}, {530.23`, 535.804`},{534.915`, 559.231`},{541.162`, 585.781`}, {544.286`, 615.455`},{545.848`, 638.882`},{544.286`, 663.871`}, {538.039`, 690.422`},{533.353`, 710.725`},{530.23`, 731.028`}, {527.106`, 745.084`},{522.421`, 760.702`},{520.859`, 768.511`}};

Wir wollen das Volumen in der (x,y)-Ebene darstellen, also transponierne wir die einzelnen WERte

2013 Weinglas.nb ³

(4)

volumen = volumen /.{x_, y_} → {y, x}

{{395.242, 383.421},{403.051, 392.792},{412.422, 406.848}, {418.669, 424.028},{432.725, 439.646},{446.781, 459.949},

{463.961, 477.129},{478.017, 488.061},{493.635, 503.679},{512.377, 514.612}, {535.804, 530.23},{559.231, 534.915},{585.781, 541.162},{615.455, 544.286}, {638.882, 545.848},{663.871, 544.286},{690.422, 538.039},{710.725, 533.353}, {731.028, 530.23},{745.084, 527.106},{760.702, 522.421},{768.511, 520.859}}

Über welchen x-Bereich muß das Volumen berechnet werden?

Zur Vereinfachung ziehen wir von der x-Koordinate einfach den minimalen x-Wert ab und passen auf den y-Wert so an, daß die Grafik am Koordinatenursprung beginnt.

{xmin, xmax} = {Min[volumen[[All, 1]]], Max[volumen[[All, 1]]]}

{395.242, 768.511}

{ymin, ymax} = {Min[volumen[[All, 2]]], Max[volumen[[All, 2]]]}

{383.421, 545.848}

volumen = {First[#] -xmin, Last[#] -ymin}& /@ volumen {{0., 0.},{7.809, 9.371},{17.18, 23.427},{23.427, 40.607},

{37.483, 56.225},{51.539, 76.528},{68.719, 93.708},{82.775, 104.64}, {98.393, 120.258},{117.135, 131.191},{140.562, 146.809},

{163.989, 151.494},{190.539, 157.741},{220.213, 160.865},

{243.64, 162.427},{268.629, 160.865},{295.18, 154.618},{315.483, 149.932}, {335.786, 146.809},{349.842, 143.685},{365.46, 139.},{373.269, 137.438}}

Nun noch den maximalen x und y-Wert anpassen:

xmax=xmax-xmin; ymax=ymax-ymin;

Sichtkontrolle:

Graphics @ Point@ volumen

Das sieht schon ein wenig wie ein liegendes Weinglas aus. Nun brauchen wir eine Funktion, die diese Punkte interpoliert, kein Problem, dazu gibt es die Funktion Interpolation, welche eine Funktion zurückliefert, die die gegebenen Punkte interpoliert.

contour = Interpolation[volumen]

InterpolatingFunction[{{0., 373.269}},<>]

Nun kann die Interpolation durchgeführt werden:

(5)

glas = Plot[contour[t],{t, 0, xmax}]

50 100 150 200 250 300 350

50 100 150

o.k., ein wenig “hubbelig” (wir haben nur recht wenige Punkte aus der Grafik extrahiert), das ist es aber für unsere Zwecke völlig ausreichend. Nun kann das Volumen im Glas leicht berechnet werden:

volumenGlas=NIntegrate[contour[t],{t, 0, xmax}]

48 074.9

Damit können wir eine Funktion angeben, die den Inhalt des Glases bis zu einem beliebigen

“Füllstand” angibt:

inhaltBisX[x_] =NIntegrate[contour[t],{t, 0, x}]

NIntegrate[contour[t],{t, 0, x}]

Testen wir das für den gesamten Glasinhalt:

inhaltBisX[xmax]

48 074.9

Der Rest ist nun einfach, wir suchen nur noch den Punkt, für den der Inhalt bis zu diesemPunkt gerade den halben Glasinhalt entspricht. Als Näherungswert nehmen wir mal 150, einen Wert den man direkt aus der obigen Graifk ablesen kann.

FindRoot[inhaltBisX[z] ⩵volumenGlas/2,{z, 150}]

{z→216.63}

halbVoll = z/.% 216.63

Nun kann man das Ganze noch grafisch veranschaulichen:

2013 Weinglas.nb ⁵

(6)

Show[glas, Plot[contour[t],{t, 0, halbVoll}, Filling→Bottom]]

Schön. Jetzt aber noch eine ordentliche 3D Darstellung. Dazu rotieren wird die Kontour des Glases um die x-Achse. zur Bestimmung der korrekten Höhen brauchen wir noch den minimalen und maximalen Wert der Funktion contour.

cmax = First @ FindMaximum[contour[x],{x, 200}]

162.435

cmin= First@ FindMinimum[{contour[x], 0≤x≤xmax},{x, 20}]

2.92405×10^-8

Nun also der Rotationskörper:

eins=RevolutionPlot3D[{contour[t] -cmin}, {t, 0., xmax}, RevolutionAxis→ {1, 0, 0}]

Die Stelle, an der das Glas halb voll (oder eben halb leer) ist, machen wir mit einer Markierung sichtbar:

zwei = RevolutionPlot3D[{halbVoll, contour[halbVoll] -cmin},{t, 0., xmax}, RevolutionAxis→ {1, 0, 0}, MeshStyle→ {Green, Thickness[0.01]}];

(7)

Jetzt müssen wir das Ganze nur noch anzeigen und haben dann eine Darstellung des Korpus des Weinglases mit eingezeichneter Markierung für den halben Füllstand.

Show[eins, zwei]

2013 Weinglas.nb ⁷