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.
Perl-HowTo.de: Perl-Profiler-Serie
Beitrag von Uwe am 17.12.2008 um 15:30 Uhr | 1 Kommentar
Ich bin auf ein neues Perl-Blog gestoßen: Perl HowTo.
Besonders hervorheben möchte ich die Serie über verschiedene Perl-Profiler. Da ich selbst vorhatte, über das Profiling (Laufzeitmessung und -verteilung) zu berichten, bin ich besonders froh, da es mir einige Stunden Arbeit abnimmt. Statt selbst einen Artikel zu schreiben, verweise ich Euch auf Thomas' Artikel:
Wer bereits einmal Devel::Cover verwendet hat, dem wird die Ausgabe von Devel::NYTProf sehr bekannt vorkommen. Auch mir hat dieser Profiler schon wertvolle Hinweise gegeben, ein Programm zu beschleunigen.
In diesem Zusammenhang möchte ich auf Nicholas Clark's exzellenten Vortrag "When perl is not quite fast enough" (englisch) hinweisen.
Text::Restructured und Perl 5.10 - BackPan hilft
Beitrag von Uwe am 07.12.2008 um 16:00 Uhr | 1 Kommentar
Dieser Beitrag beantwortet die Frage: "Wie installiere ich ältere Versionen eines CPAN-Moduls?"
Das Modul Text::Restructured läßt sich unter Perl 5.10 nicht fehlerfrei installieren: Die CPAN-Testers-Matrix zeigt, daß die höchste Version ohne Test-Fehler 0.3.36 ist. Dies ist der Vorgänger der aktuellen Version.
Wo bekommt man diese Version nun her? Normalerweise listet search.cpan.org die älteren Versionen als Selectbox auf ( Other Releases zwischen This Release und Links), wie dieser Screenshot von Mojo zeigt:
Warum ist das so? Jeder CPAN-Autor hat ein Verzeichnis (in meinem Fall /authors/id/U/UV/UVOELKER/), wo er all seine Veröffentlichungen hochlädt. Mark (Text::Restructured) hat nun alle älteren Versionen gelöscht, währenddessen Sebastian (Mojo) sie behalten hat. Doch selbst die gelöschten Versionen sind nicht verloren, sie landen im BackPan.
Um die alte Version von Text::Restructured nun im BackPan zu finden, müßt Ihr in das Autor-Verzeichnis navigieren. In unserem Fall ist dies /authors/id/N/NO/NODINE/. Zum Schluß noch der direkte Link auf die Version 0.3.36.
bin/pagerank - Google's "Pagerank" abfragen
Beitrag von Uwe am 04.12.2008 um 22:42 Uhr | 0 Kommentare
Ich habe mir eine neue Serie einfallen lassen: Ich stelle ein paar kleine Tools aus meinem bin-Verzeichnis vor. (Für die Windows-Nutzer: Das Verzeichnis "bin" enthält unter Linux Skripte und ausführbare Programme.)
Heute ist "pagerank" dran, das nächste mal wird "make-index" folgen...
#!/usr/bin/perl use strict; use warnings; use WWW::Google::PageRank; die "Usage: $0 http://..." unless @ARGV == 1; my $pr = WWW::Google::PageRank->new; print scalar($pr->get($ARGV[0]))."\n";
Download pagerank.pl
Die Hauptarbeit erledigt das CPAN-Modul WWW::Google::PageRank. Das Skript macht nichts weiter, als dem Modul die URL zu übergeben. "$0" enthält den Namen des Programms ("pagerank" bzw. "pagerank.pl"). Dies läßt sich mit "perldoc perlvar" nachschlagen.
Die Verwendung ist denkbar einfach:
> pagerank http://www.perl-uwe.de/ 3
Der Wert des Pagerank schwankt zwischen 0 und 10.
> pagerank http://www.google.com/ 10
Ist eine Seite nicht im Such-Index enthalten, erscheint folgende Ausgabe:
> pagerank http://www.root-server-blog.de/ Use of uninitialized value in concatenation (.) or string at pagerank line 12.
Dies könnte man abfangen, indem man prüft, ob der Rückgabewert von "$pr->get" "defined" ist:
my $ret = $pr->get($ARGV[0]); if (defined $ret) { print "$ret\n"; } else { print "Seite nicht im Such-Index.\n"; }
