Der 11. Deutsche Perl-Workshop
Beitrag von Uwe am 28.02.2009 um 19:30 Uhr | 0 Kommentare
Vom 25. - 27. Februar fand in Frankfurt der 11. Deutsche Perl-Workshop statt. Der Aufbau hat seit vielen Jahren Tradition: parallele Tutorials am Mittwoch vormittag und anschließend zweieinhalb Tage Vorträge.
Zwei Vorträge, die mir besonders gut gefallen haben, waren "IPv6 und Perl" von Steffen Ullrich, sowie Marc Lehmann's Threads-Vortrag. Letztgenannter hat anschaulich gezeigt, dass das aktuelle Gerede von "multi-threaded" Anwendungen angesichts derzeitiger Multi-Core-Architekturen Schwachsinn ist. Stattdessen müßten "multi-process" Anwendungen gefordert werden!
Neben interessanten Vorträgen dient ein solches Zusammentreffen von Perl-Entwicklern auch dazu, dem ein oder anderen CPAN-Autor oder Blogger-Kollegen, den man bisher nur vom Namen kannte, ein Gesicht zuzuordnen.
Der diesjährige Perl-Workshop war mein sechster, damit wird es mehr als Zeit, das nächste Mal ebenfalls mit einem Vortrag dabei zu sein. Inspiriert von Nicholas Clarks hervorragendem Vortrag/Tutorial "When Perl is not quite fast enough" möchte ich 2010 zwei Aspekte davon mit Beispielen illustrieren: Profiling mit Devel::NYTProf und ("the last resort") Perl durch C/XS ersetzen. Die Beispiele dazu werde ich im Laufe dieses Jahres bereits hier im Blog veröffentlichen.
Array-Overhead mit Devel::Size bestimmen
Beitrag von Uwe am 24.12.2008 um 08:30 Uhr | 0 Kommentare
Perl's dynamische Arrays und Hashes sind eine feine Sache. Aber wenn man sie in großen Mengen verwendet, sollte man eins wissen: Sie brauchen viel Speicherplatz.
Am Beispiel von Holzwurm Bertolt möchte ich dies demonstrieren:
#!/usr/bin/perl use strict; use warnings; use Devel::Size qw(total_size); my $map = 'aaABbb'. 'a## #b'. 'a C b'. 'a#C##b'. 'aABbbb'. '##### '; my @map = [['a', 'a', 'A', 'B', 'b', 'b'], ['a', '#', '#', ' ', '#', 'b'], ['a', ' ', 'C', ' ', ' ', 'b'], ['a', '#', 'C', '#', '#', 'b'], ['a', 'A', 'B', 'b', 'b', 'b'], ['#', '#', '#', '#', '#', ' '], ]; printf("Skalar: %4d\n", total_size(\$map)); printf("Array: %4d\n", total_size(\@map));
Download: array-size.pl
Ausgabe:
Skalar: 88 Array: 3512
Die Darstellung des Zustandes als Skalar (String) benötigt 88 Bytes. Für ein Array-of-Arrays fallen gleich 3.512 Bytes an. Dies ist quasi das Vierzigfache!
Nun aber an jeder Stelle auf Arrays oder Hashes zu verzichten, wäre die falsche Schlußfolgerung. Aber wenn es darum geht, sich möglichst viele Zustände zu merken (wie bei einer Spielbaumsuche), dann sollte diese Repräsentation möglichst kompakt sein.
In eigener Sache
Dies wird mein letzter Post im Jahr 2008 sein. Ich wünsche meinen Lesern ein frohes Weihnachtsfest und einen guten Rutsch ins neue Jahr.
Mein im November gestecktes Ziel von fünf Beiträgen konnte ich sogar übertreffen. Ich hoffe, für den einen oder anderen war etwas interessantes dabei. Im neuen Jahr werde ich mehr über Mojo berichten und die bin-Serie fortführen. Ebenfalls in Planung ist ein anschauliches Beispiel fürs Profiling (inkl. XS-Implementierung).
"Holzwurm Bertolt" - mit Perl Rätsel lösen
Beitrag von Uwe am 22.12.2008 um 22:30 Uhr | 0 Kommentare
Auf dem Adventskalender der TU Chemnitz ist hinter dem 12. Türchen ein Rätsel versteckt. Holzwurm Bertolt möchte aus einem Labyrinth entkommen:
Holzwurm Bertolt (der blaue Wurm) möchte den Ausgang (türkis) erreichen. Die Würmer können am Kopf (rosa) oder Ende (gelb) durch das Labyrinth gezogen werden.
Als ich nach einigen Versuchen immer noch keine Lösung gefunden hatte, kam mir die Idee, ein Perl-Programm zu schreiben, welches die kürzeste Lösung berechnet. (Der Quelltext ist diesmal am Ende des Artikels.)
Zunächst wird das Labyrinth als ein String dargestellt. Die Würmer werden dabei durch die Buchstaben "a", "b" und "c" dargestellt. Der Kopf oder das Ende als Großbuchstaben, weil nur diese sich bewegen können. Die kompakte Darstellung als String ist notwendig, weil alle Zustände gespeichert werden. Ein "Array-of-Arrays" ist dabei zu speicherintensiv.
In einer Queue (realisiert als Array @next) wird der Startzustand und später alle weiteren, noch nicht verarbeiteten Zustände gespeichert. Für jeden dieser Zustände wird nun geprüft, welcher Wurm sich bewegen kann. Jede mögliche Bewegung wird dabei ausgeführt, wenn sich dabei ein neuer Zustand ergibt. Dies wird mit dem Hash %move abgeprüft. Dieser speichert gleichzeitig die Anzahl an Zügen, die notwendig sind, um in diesen Zustand zu gelangen. (Dabei ist der Wert um eins zu hoch, was aber am Ende kompensiert wird.)
Bei der Bewegung nach unten wird auf das Ende geprüft: Wenn Bertolt auf Position 29 (oberhalb des einzelnen Feldes) steht und nach unten ziehen kann, so ist er "befreit". Anschließend werden alle Zustände, beginnend mit dem Ende, rückwärts ausgegeben.
Die Subroutine move() sucht im Wesentlichen den Wurm im Labyrinth und bewegt ihn an seine neue Stelle, indem Korrekturen am Anfang und Ende vorgenommen werden. Damit dies auch beim dem kurzen Wurm "C" funktioniert, ist die Reihenfolge der 3 substr-Operationen wichtig.
#!/usr/bin/perl use strict; use warnings; my $start = 'aaABbb'. # 0 - 5 'a## #b'. # 6 - 11 'a C b'. # 12 - 17 'a#C##b'. # 18 - 23 'aABbbb'. # 24 - 29 '##### '; # 30 - 35 my %move = ($start => 1); my @next = ($start); my %parent = (); while (@next) { # Breitensuche my $map = shift @next; for (my $pos = 0; $pos < length $map; $pos++) { if ((my $wurm = substr($map, $pos, 1)) =~ /[ABC]/) { # hoch if ($pos > 5 and substr($map, $pos - 6, 1) eq ' ') { my $map2 = move($map, $pos - 6, $wurm); unless ($move{$map2}) { $move{$map2} = $move{$map} + 1; push @next, $map2; $parent{$map2} = $map; } } # runter if ($pos < 30 and substr($map, $pos + 6, 1) eq ' ') { my $map2 = move($map, $pos + 6, $wurm); unless ($move{$map2}) { $move{$map2} = $move{$map} + 1; push @next, $map2; $parent{$map2} = $map; } # Abbruch-Bedingung if ($pos == 29 and $wurm eq 'A') { print "Ende erreicht: $move{$map2} Zuege.\n"; while ($map2 ne $start) { show_map($map2); $map2 = $parent{$map2}; } exit; } } # links if ($pos % 6 > 0 and substr($map, $pos - 1, 1) eq ' ') { my $map2 = move($map, $pos - 1, $wurm); unless ($move{$map2}) { $move{$map2} = $move{$map} + 1; push @next, $map2; $parent{$map2} = $map; } } # rechts if ($pos % 6 < 5 and substr($map, $pos + 1, 1) eq ' ') { my $map2 = move($map, $pos + 1, $wurm); unless ($move{$map2}) { $move{$map2} = $move{$map} + 1; push @next, $map2; $parent{$map2} = $map; } } } } } sub move { my ($map, $pos, $wurm) = @_; my $map2 = $map; substr($map2, $pos, 1, $wurm); my @wurm = ($pos); my %wurm = ($pos => 1); my $found = 1; while ($found) { # hoch if ($pos > 5 and not $wurm{$pos - 6} and substr($map2, $pos - 6, 1) =~ /$wurm/i) { $pos = $pos - 6; push @wurm, $pos; $wurm{$pos} = 1; } # runter elsif ($pos < 30 and not $wurm{$pos + 6} and substr($map2, $pos + 6, 1) =~ /$wurm/i) { $pos = $pos + 6; push @wurm, $pos; $wurm{$pos} = 1; } # links elsif ($pos % 6 > 0 and not $wurm{$pos - 1} and substr($map2, $pos - 1, 1) =~ /$wurm/i) { $pos = $pos - 1; push @wurm, $pos; $wurm{$pos} = 1; } # rechts elsif ($pos % 6 < 5 and not $wurm{$pos + 1} and substr($map2, $pos + 1, 1) =~ /$wurm/i) { $pos = $pos + 1; push @wurm, $pos; $wurm{$pos} = 1; } else { $found = 0; } } # 2. Position klein substr($map2, $wurm[1], 1, lc $wurm); # Ende weg substr($map2, $wurm[-1], 1, ' '); # neues Ende gross substr($map2, $wurm[-2], 1, $wurm); return $map2; } sub show_map { my ($map) = @_; printf("%s\n%s\n%s\n%s\n%s\n%s\n\n", substr($map, 0, 6), substr($map, 6, 6), substr($map, 12, 6), substr($map, 18, 6), substr($map, 24, 6), substr($map, 30, 6), ); }
Download: bertolt.pl
Es ist vielleicht etwas knapp erklärt, wenn Ihr Fragen habt, scheut Euch nicht, sie zu stellen. Nutzt dazu bitte die Kommentarfunktion.
