Rätsel: Priester und Kannibalenvon Thomas Bätzler, <thomas@baetzler.de> Ein Vortrag für die Perl-Mongers Karlsruhe (wenn es sie endlich mal gibt :-)) Neulich hat mir ein Freund folgendes Rätsel zugeschickt:
Natürlich hätte ich das auch per Hand herausknobeln können - aber wozu selbst knobeln, wenn ich das auch dem Computer überlassen kann. Schon nach kürzester Zeit steht der Programmkopf mit den ersten Deklarationen, die ich aus der angegebenen Spezifikation ableite: #!/usr/bin/perl -w use strict; ## ## Global Variables ## # Ausgangsposition: # 1. Insel: 3 Priester, 1 Kannibale/Navigator, 2 Kannibalen # 2. Insel: Niemand my @start = ( 3, 1, 2, '>', 0, 0, 0 ); # Zielposition: # Niemand auf der 1. Insel, alle auf der 2. Insel my $dest = join ',', ( @start[4..6], '<', @start[0..2] ); Die Namen der Priester und Kannibalen sind zunächst einmal ohne Bedeutung, da ich sie ja ohne Beschränkung der Allgemeinheit austauschen kann. Ein wichtiges Faktum hingegen ist die Tatsache, daß es drei Klassen gibt: Die Priester, die Kannibalen und den Kannibalen, der auch das Boot steuern kann.
Als Lösungsansatz wähle ich eine rekursive Suche. Zu Beginn der Rekursion prüfe ich zunächst einmal, ob ich den Zielzustand schon erreicht habe. Anderenfalls merke ich mir den aktuellen Zustand im Hash %triedthis. Gibt es schon einen Eintrag für meinen Zustand, dann wird an dieser Stelle ebenfalls nicht weiter gesucht - das ist ja schließlich schon passiert. Ansonsten stelle ich mir eine Liste möglicher Bootsmannschaften zusammen, die ich dann Zug um Zug ausprobiere. Für alle erlaubten Mannschaften wird die Rekursion ausgeführt. Also definieren wir zunächst unseren globalen Positions-Hash, sowie die Funktion, die die Liste der Bootsmannschaften erzeugt: # In diesem Hash merken wir uns die schon geprüften Stellungen my %triedthis; # # Erzeuge eine Liste aller nach den Regeln gültigen Boots- # besatzungen, die von den ersten drei Positionen in die letzen # drei Positionen wechsel könnten. $sp, $sn und $sc sind die # Anzahl der Priester, Kannibalen/Navigator(en) und Kannibalen # auf der Ausgangsinsel; während $dp, $dn und $dc die selbe # Bedeutung für die Ziel-Insel haben. # sub makecrews { my( $sp, $sn, $sc, $dp, $dn, $dc ) = @_; my @crews = (); if( $sp > 0 ){ push @crews, [ 1, 0, 0 ] unless $sp - 1 > 0 && $sn + $sc > $sp - 1 || $dp + 1 < $dn + $dc; if( $sp > 1 ){ push @crews, [ 2, 0, 0 ] unless $sp - 2 > 0 && $sn + $sc > $sp - 2 || $dp + 2 < $dn + $dc; } if( $sn > 0 ){ push @crews, [ 1, 1, 0 ] unless $sp - 1 > 0 && $sn + $sc - 1 > $sp - 1 || $dp + 1 < $dn + $dc + 1; } if( $sc > 0 ){ push @crews, [ 1, 0, 1 ] unless $sp - 1 > 0 && $sn + $sc - 1 > $sp - 1 || $dp + 1 < $dn + $dc + 1; } } if( $sn > 0 ){ push @crews, [ 0, 1, 0 ] unless $dp > 0 && $dp < $dn + $dc + 1; if( $sn > 1 ){ push @crews, [ 0, 2, 0 ] unless $dp > 0 && $dp < $dn + $dc + 2; } if( $sc > 0 ){ push @crews, [ 0, 1, 1 ] unless $dp > 0 && $dp < $dn + $dc + 2; } } return( @crews ); } Natürlich hätte man die jeweils möglichen Permutationen auch vollständig algorithmisch erzeugen können, aber in diesem Fall habe ich mich für die "billige"Lösung des auscodierens entschieden. Als weitere Hilfsfunktion brauchen wir eine Ausgabefunktion, mit der wir eine gefundene Lösung darstellen können. Da wir ja den Lösungsweg suchen, wird er Schritt für Schritt nachvollzogen. # # Gefundene Lösung (mehr oder weniger) schön darstellen # sub print_solution { my $ref = $_[0]; my $dir = '>'; print "\n\nLösung gefunden:\n"; my @st = @start; print "[", 'P'x$st[0], 'S'x$st[1], 'K'x$st[2], "]\n"; foreach my $crew ( @{$ref} ){ if( $st[3] eq '>' ){ $st[0] -= $$crew[0]; $st[1] -= $$crew[1]; $st[2] -= $$crew[2]; print "[", 'P'x$st[0], 'S'x$st[1], 'K'x$st[2], "] ", ">", 'P'x$$crew[0], 'S'x$$crew[1], 'K'x$$crew[2], ">", "[", 'P'x$st[4], 'S'x$st[5], 'K'x$st[6], "]\n"; $st[3] = '<'; $st[4] += $$crew[0]; $st[5] += $$crew[1]; $st[6] += $$crew[2]; } else { $st[4] -= $$crew[0]; $st[5] -= $$crew[1]; $st[6] -= $$crew[2]; print "[", 'P'x$st[0], 'S'x$st[1], 'K'x$st[2], "]", "<", 'P'x$$crew[0], 'S'x$$crew[1], 'K'x$$crew[2], "< ", "[", 'P'x$st[4], 'S'x$st[5], 'K'x$st[6], "]\n"; $st[3] = '>'; $st[0] += $$crew[0]; $st[1] += $$crew[1]; $st[2] += $$crew[2]; } } } Schließlich brauchen wir auch noch die rekursive Suchroutine: # # Rekursive Suche der Lösung # sub row { # Der "Lösungsweg" wird in einer Liste gespeichert, die der # Funktion als Listenrefernz übergeben wird. Wir erzeugen # aus der Referenz zunächst einmal eine echte Liste, die # eine Kopie des Orginals darstellt. So gehen wir sicher, # daß wir die anderen Lösungsversuche nicht beeinträchtigen. my @solution = @{pop @_}; # Die ersten 7 Argumente stellen den in dieser Rekursion an- # gestrebten Zustand dar. my( $sp, $sn, $sc, $dir, $dp, $dn, $dc ) = @_; # Zum Vergleichen mit dem Zielzustand wird das Zustands-Tupel # "flach" gemacht. my $desc = join( ',', @_ ); # Wenn der aktuelle Zustand der Zielzustand ist, dann haben wir # eine Lösung gefunden, die wir dann ausgeben. Eine weitere # Rekursion ab diesem Punkt ist unnötig. if( $desc eq $dest ){ print_solution( \@solution ); return; } # Anderenfalls prüfen wir, ob wir den aktuellen Zustand schon # einmal erreicht haben. Falls, ja, ist eine weitere Suche ab # diesem Punkt ebenfalls sinnlos, denn sie würde in eine End- # losschleife führen. return if ++$triedthis{ $desc } > 1; # Falls wir nicht am Ziel sind, und weitergesucht werden soll, # dann bilden wir abhängig von der Ruder-Richtung... if( $dir eq '>' ){ # ... eine Liste der möglichen Bootsmannschaften, my @crews = makecrews( $sp, $sn, $sc, $dp, $dn, $dc ); # die wir der Reihe nach ausprobieren. Dabei fügen wir die # aktuelle Crew dem Lösungspfad an, den wir dem rekursiven # Aufruf der Funktion übergeben. foreach my $crew ( @crews ){ row( $sp - $$crew[0], $sn - $$crew[1], $sc - $$crew[2], '<', $dp + $$crew[0], $dn + $$crew[1], $dc + $$crew[2], [ @solution, $crew ] ); } } else { my @crews = makecrews( $dp, $dn, $dc, $sp, $sn, $sc ); foreach my $crew ( @crews ){ row( $sp + $$crew[0], $sn + $$crew[1], $sc + $$crew[2], '>', $dp - $$crew[0], $dn - $$crew[1], $dc - $$crew[2], [ @solution, $crew ] ) } } # Keine weiteren Lösungen gefunden => Abbruch. return; } Nachdem wir jetzt alle wesentlichen Teile definiert haben, fehlt jetzt nur noch das "Hauptprogramm", das erfreulicherweise sehr kompakt ausfällt. # # Hauptprogramm :-) # row( @start, [] );
|
Auswege: Impressum, Haftungsausschluß, Datenschutz,
thb's Perl-Ecke,
meine Homepage.
Links: Imprint,
thb's Perl Corner,
my homepage.
$Id$