What shall we do with the drunken sailor?

Hier mal eine "Simulation" mit Mathematica. Ich habe dieses Thema im "Wolfram-Blog" gefunden und etwas "aufgebohrt".

Der betrunkene Seemann steht auf dem Kai und will über die Planken zum Schiff laufen. Der Weg ist sieben Einheiten breit und 15 Einheiten lang. Bei jeden Schritt hat er die Möglichkeiten geradeaus, nach links oder rechts zu gehen, oder aber stehen zu bleiben. Hier die "Regeln", nach denen sich der betrunkene Seemann bewegt.

Ist er auf dem Schiff, so bleibt er dort, ist er ins Wasser gefallen ebenso. In allen anderen Fällen macht er (zufällig) einen Schritt nach vorn, nach links oder nach rechts (rückwärts geht er nicht, er ist ja nicht volltrunken).

Diese drei Simulationsschritte sind in Mathematica schnell realisiert und, in Analogie zum Wolfram Blog, hier die Möglichkeiten der Regelbasierten Programmierung von Mathematica genutzt.
Stacks Image 124
Der nebenstehende Mathematica Code bewirkt, daß wenn der Seemann nach 16 Schritten das Schiff erreicht hat und danach auf diesem bleibt, bzw. daß er ins Wasser fällt, wenn er zu weit nach links oder rechts vom Weg abkommt... und dort auch bleibt, wenn er hineingefallen ist.
step[{x_,16} | Schiff] := Schiff
step[{0,y_} | {8, y_}| Wasser] := Wasser
Damit liegen die Regeln fest, nach denen der betrunkene Seemann sich fortbewegt. Nun gilt es noch den einzelnen Schritt denn dieser macht als Simulation zu realisieren. Dies geschieht einfach mit dem nebenstehenden Codesegment, in dem eine zufällige Auswahl aus den Möglichkeiten die dieser hat ausgewählt wird.
Die Nachfolgende Simulator führt so lange einen Schritt aus, bis er entweder im Wasser oder auf dem Schiff ist. Entscheiden kann man das, ob die Position des Seemanns, die Variable pos) noch eine Liste ist oder eben "Wasser" bzw. "Schiff"
step[{x_, y_}] := RandomChoice[{{x, y},
{x + 1, y},
{x - 1, y},
{x, y + 1}}
]
simulation[start_List] := Block[{pos = start}, While[Head[pos] === List, pos = step[pos]]; pos ]

Damit haben wir für nun einen kompletten Simulationsschritt. Dieser wird so lange ausgeführt, bis der Seemann entweder im Wasser, oder auf dem Schiff ist. Immer wieder verblüffend, wie klar der Code in Mathematica das Problem beschreibt. Als nächstes wird diese Simulation nun einfach oft genug (hier 10000) mal durchgeführt.

temp = Tally[Table[simulation[{4, 1}], {10000}]]
{{Wasser, 8560}, {Schiff, 1440}}
ergebnis = {nass, trocken} = #[[2]] & /@ temp
{8560, 1440}
Nun muß man nur noch die ermittelten Werte ins Verhältnis setzen, um die entsprechenden Näherungswerte für die Wahrscheinlichkeiten zu erhalten. Die Wahrscheinlichkeit, daß unser Seemann trocken auf das Schiff kommt beträgt also ca. 15%
{pnass, ptrocken} = {ergebnis[[1]], ergebnis[[2]]}/Total[ergebnis] // N
{8560, 1440}
Will man nun alle durch diesen Zufallsalgorithmus erzeugten Wege "aufsammeln", so stellt Mathematica hierzu viele Möglichkeiten zur Verfügung. Ich habe hier zwei Varianten implementiert. Eine im Grunde offensichtliche, mit der Funktion AppendTo. Bei einer zweiten Variante (etwas weiter unten auf der Seite) habe ich die Kombination Sow/Reap verwendet und dann mal überprüft, wie es sich mit der Laufzeit der beiden Varianten verhält. Hier zunächst einmal der unterschiedliche Code der beiden Varianten:
wegeerzeugen[n_Integer] := Module[{wege = {}, temp},
Do[ temp = FixedPointList[step, {4, 1},
SameTest -> (#1 === #2 && Head[#1] === Symbol &)];
AppendTo[wege, temp], {n}
]; wege
]
Nun der Laufzeitzvergleich: Überraschung! Bei der Variante mit AppendTo (rot) gibt es immer wieder Ausreißer, die sehr lange brauchen, während die Version mit Sow/Reap (blau) sich eher so verhält, wie erwartet. Ich habe mir diese Verhalten mit der Speicherverwaltung von Mathematica erklärt, konnte es aber erst nicht endgültig klären. Nachdem ich das mal im der DEMUG (= Deutschsprachige Mathematica User Group) gepostet habe erhielt ich von den Experten dort umgehend Antwort (vielen Dank dafür, an dieser Stelle). Es liegt in der Tat in der Speicherverwaltung in Zusammenhang mit der Verwendung der Variablennamen, das ständige "Ankleben" an die Variable ist die Ursache, das aber nur am Rande; es soll ja hier nur darauf hingewiesen werden, daß es immer mal wieder auch interessant ist, nicht nur ein Problem zu lösen, sondern auch mal rechts und links davon zu schauen.
Stacks Image 125
RapidWeaver Icon

Made in RapidWeaver