Cammelli labirinti e depth-first search: realizzazione di un generatore e risolutore di labirinti in Perl

Se Téseo (Θησεύς), eroe spregiudicato nonchè figlio del re ateniese Ègeo (Αἰγεύς), avesse conosciuto qualche rudimento di Perl, avrebbe potuto risolvere brillantemente il problema del Labirinto di Cnosso adottando l’algoritmo deep-first search, sconfiggere il Minotauro (Μινώταυρος) Asterione ma – soprattutto – non avrebbe spezzato il cuore della povera Arianna (Αριάδνη), figlia di Minosse e Pasifae (ed anche madre del Minotauro), seducendola per ottenere il risolutivo gomitolo di filo rosso (un surrogato di stack analogico ideato da Dedalo ) per poi abbandonarla ancora dormiente nell’isola deserta di Nasso (pare pure dopo una lunga notte di “festeggiamenti” nella sua nave).

labirinto 20 x 20 generato da maze.pl

A chi mi obietta – ingiustamente – che ai tempi non era disponibile un interprete Perl così come un notebook agevolmente trasportabile in un Labirinto, ma anche a tutti gli altri che gridano vendetta contro il comportamento di Téseo nei confronti della povera Arianna, consiglio vivamente la lettura dell’avvincente leggenda del Minotauro; scoprirete che la storia di Téseo, per opera di Poseidone, si conclude in modo tragico a causa dell’inversione di un’informazione booleana (1 bit) ma vitale: il colore delle vele della sua imbarcazione.

Dopo questa mitologica premessa, certo di esser perdonato per eventuali errori sulla mitologia greca, sperando di non deludere il forse unico temerario lettore che avrà avuto l’ardore di proseguire nella lettura di questo articolo, vi presento un semplicissimo generatore e risolutore di labirinti scritto interamente in Perl.

Labirinto 60 x 40 generato da maze.pl

Questo progetto è ispirato da un articolo che ho letto nel blog di Eriol in cui il problema viene affrontato in Python.

In rete esistono anche molti riferimenti sui labirinti (storia, classificazione, generazione, risoluzione, miti e leggende) dove è piacevole perdersi:

Nella mia implementazione, esaltando alcune caratteristiche tipiche del Perl, ho progettato delle strutture dati leggere ed efficienti (memorizzo solo le aperture del labirinto) ed ho adottato la versione dell’algoritmo depth-first search ricorsiva sia per la costruzione del labirinto (metodo Maze::asterione) che per la ricerca del percorso che conduce dall’ingresso all’uscita (metodo Maze::teseo).

Sono disponibili:

l’output del labirinto generato e risolto in modalità ASCII (Maze::toText):

l’output in formato PNG(Maze::toImage):

labirinto 200 x 100 generato da maze.pl

Per la generazione dell’immagine si richiedono le librerie GD.

Il tutto sarebbe ottimizzabile e migliorabile ma al momento sono già abbastanza soddisfatto dei risultati ottenuti!

Potete scaricare i sorgenti di maze.pl nel repository del progetto su github (software libero rilasciato sotto licenza GNU/GPL v. 3)

#!/usr/bin/perl

use strict;
use warnings;

package Maze;

use Carp qw(croak verbose);
use GD;

sub new {
    my ($class, $x, $y) = @_; 

    my $self = { 
        x => $x, 
        y => $y,
        doors => [], 
        solution => [],
    };

    bless $self;
    $self->openWall(0, 0, 'N');
    $self->openWall($x - 1, $y - 1, 'S');

    return $self;
}

sub _getWallIndex($$$){
    my ($self, $x, $y, $dir) = @_;

    my @idx =
        $dir eq 'N' ? ($x,      $y,     'N') :
        $dir eq 'S' ? ($x,      $y + 1, 'N') :
        $dir eq 'W' ? ($x,      $y,     'E') :
        $dir eq 'E' ? ($x + 1,  $y,     'E') :
            croak "wrong direction";

    return @idx;
}

sub isWallOpen($$$){
    my ($self, $x, $y, $dir) = @_;

    my ($wx, $wy, $wdir) = $self->_getWallIndex($x, $y, $dir);    

    return $self->{door}[$wx][$wy]{$wdir} || 0;
}

sub openWall($$$) {
    my ($self, $x, $y, $dir) = @_;

    my ($wx, $wy, $wdir) = $self->_getWallIndex($x, $y, $dir);    

    $self->{door}[$wx][$wy]{$wdir} = 1;
}

sub getCellNeighbors($$$){
    my ($self, $x, $y) = @_;
    grep {
        $_->[0] >= 0 and $_->[0] < $self->{x} and
        $_->[1] >= 0 and $_->[1] < $self->{y}
    } (
        [$x - 1, $y    , 'W'],
        [$x + 1, $y    , 'E'],
        [$x    , $y - 1, 'N'],
        [$x    , $y + 1, 'S']
    );
}

sub getCellOpenedNeighbors($$$){
    my ($self, $x, $y) = @_;
    grep { 
        my (undef, undef, $dir) = @$_;
        $self->isWallOpen($x, $y, $dir)
    } $self->getCellNeighbors($x, $y);
}

sub isCellExit($$$){
    my ($self, $x, $y) = @_;
    return 
        ($x == $self->{x} -1 ) && ($y == $self->{y} -1 );
} 

sub markSolution($$$){
    my ($self, $x, $y) = @_;
    $self->{solution}[$x][$y] = 1;
}

sub isSolution($$$){
    my ($self, $x, $y) = @_;
    $self->{solution}[$x][$y];
}

# generate maze
sub asterione($$$$){
    no warnings 'recursion';
    my ($self, $x, $y, $visited) = @_;
    $visited->[$x][$y] = 1;
    return if $self->isCellExit($x,$y);
    my @neighbors = $self->getCellNeighbors($x, $y);
    while (scalar @neighbors){
        my ($tox, $toy, $dir) = 
            @{ splice(@neighbors, rand(@neighbors), 1) };
        next if $visited->[$tox][$toy];
        $self->openWall($x, $y, $dir);
        $self->asterione($tox, $toy, $visited);
    }
}

# solve maze
sub teseo($$$$){
    no warnings 'recursion';
    my ($self, $x, $y, $visited) = @_;
    $visited->[$x][$y] = 1;
    if ($self->isCellExit($x, $y)){
        $self->markSolution($x, $y);
        return 1;
    }
    my @neighbors = $self->getCellOpenedNeighbors($x, $y);
    while (scalar @neighbors){
        my ($tox, $toy, $dir) = 
            @{ splice(@neighbors, rand(@neighbors), 1) };
        next if $visited->[$tox][$toy];
        my $isSolution = $self->teseo($tox, $toy, $visited);
        if ($isSolution){
            $self->markSolution($x, $y);
            return 1;
        }
    }
    return 0;
}

sub toText(){

    my $self = shift;

    my ($x, $y, @l1, @l2);
    my $out = '';
    for ($y = 0; $y < $self->{y}; $y++){
        @l1 = @l2 = ();
        for ($x = 0; $x < $self->{x}; $x++){
            my $solution = $self->isSolution($x, $y) ? '.' : ' ';
            push(@l1, $self->isWallOpen($x, $y, 'N') ? $solution x 2 : '-' x 2);
            push(@l2, $self->isWallOpen($x, $y, 'W') ? ' ' : '|');
            push(@l2, $solution x 2);
        }
        push(@l2, $self->isWallOpen($x, $y, 'E') ? ' ' : '|');
        $out .= 
            '+' . join('+',@l1) . '+' . "\n" . 
            join('',@l2) . "\n";
    }

    @l1 = ();
    for ($x = 0; $x < $self->{x}; $x++){
        my $solution = $self->{solution}[$x][$self->{y} -1] ? '.' : ' ';
        push(@l1, 
            $self->isWallOpen($x, $self->{y} -1, 'S') ? 
                $solution x 2 : '-' x 2
        );
    }

    $out .= '+' . join('+', @l1) . '+' . "\n";

    print $out;
}

sub toImage($$){

    my ($self, $FILENAME) = @_;

    my ($WX, $WY) = (10, 10);

    my ($SIZEX, $SIZEY) = ($self->{x} * $WX, $self->{y} * $WY);

    my $img = new GD::Image->newTrueColor($SIZEX,$SIZEY)
        or croak "Can't create GD::Image";
 
    my $cl_white = $img->colorAllocate(255,255,255);
    my $cl_black = $img->colorAllocate(  0,  0,  0);
    my $cl_red   = $img->colorAllocate(255,  0,  0);
    
    $img->fill( 0, 0, $cl_white);

    open(my $fh, '>', $FILENAME)
        or croak "Can't open $FILENAME: $!";

    binmode $fh;

    my ($xx, $yy);

    YY: for ($yy = 0; $yy < $self->{y}; $yy++){

        XX: for ($xx = 0; $xx < $self->{x}; $xx++){

            $img->filledRectangle(
                $xx * $WX, $yy * $WY, ($xx + 1) * $WX, ($yy + 1) * $WY, 
                $cl_red
            )
                if $self->isSolution($xx, $yy);
            
            $img->line(
                    $xx * $WX, $yy * $WY, ($xx + 1) * $WX, $yy * $WY, 
                    $cl_black
            )
                unless $self->isWallOpen($xx, $yy, 'N');

            $img->line(
                    $xx * $WX, $yy * $WY, $xx * $WX, ($yy + 1) * $WY, 
                    $cl_black
            )
                unless $self->isWallOpen($xx, $yy, 'W');
        }

        $img->line(
            $xx * $WX - 1, $yy * $WY, $xx * $WX -1, ($yy + 1) * $WY, 
            $cl_black
        )
            unless $self->isWallOpen($xx - 1, $yy, 'E');
    }

    for ($xx = 0; $xx < $self->{x}; $xx++){
        $img->line(
            $xx * $WX, $yy * $WY - 1, ($xx + 1) * $WX, $yy * $WY - 1, 
            $cl_black
    )
                unless $self->isWallOpen($xx, $yy - 1, 'S');
    }

    print $fh $img->png(0);
    close $fh;
}

package main;

# init
my $m = Maze->new(60,40);

# generate paths
$m->asterione(0,0,[]);

# solve maze
$m->teseo(0,0,[]);

# generate PNG
$m->toImage('out.png');

# print ASCII
#$m->toText();
Share

Rappresentazione dell’insieme frattale di Mandelbrot in Perl

La rappresentazione dell’insieme di Mandelbrot, considerato uno dei frattali più popolari, è tra i miei algoritmi di prova preferiti quando studio un nuovo linguaggio di programmazione.

Mandelbrot

L’algoritmo di base è estremamente semplice e si presta facilmente ad esser parallelizzato.

Recentemente, all’interno dei Google Labs, è stata rilasciata un’applicazione Web che, sfruttando le API di Google Maps e canvas di HTML5, permette la navigazione all’interno dell’insieme di Mandelbrot o di altri frattali (es. Julia); vi consiglio di utilizzarla per un tour veloce.

Definizione formale

L’insieme di Mandelbrot è definito come il sottoinsime del piano complesso per cui la successione ricorsiva:

  P^c_n=  \begin{cases}  & Z_0=0 \\  & Z_{n+1}=Z_n^2+c  \end{cases}

al tendere di n all’infinito, rimane limitata nel suo modulo, ovvero:

  M=\left\{c\in \mathbb{C} : \exists s \in \mathbb{R}, \forall n \in \mathbb{N},|P_n^c| \leq s \right\}

Sorgente perl

Ecco un sorgente perl che rappresenta l’insieme in modalità rigorosamente monocromatica:

#!/usr/bin/perl
 
##########################
# M A N D E L B R O T
# Luca Amore
##########################
 
use strict;
use warnings;
 
use GD;
 
my $FILENAME = 'mandelbrot.png';
my $ITERATIONS = 30;
my ($SIZEX, $SIZEY) = (700, 400);
my ($RE_MIN, $RE_MAX) = (-2.5, 1.0);
my ($IM_MIN, $IM_MAX) = (-1.0, 1.0);
 
my $re_factor = ($RE_MAX - $RE_MIN) / $SIZEX;
my $im_factor = ($IM_MAX - $IM_MIN) / $SIZEY;
 
my $img = new GD::Image->newTrueColor($SIZEX,$SIZEY)
    or die "Can't create GD::Image";
 
# palette
my $cl_black = $img->colorAllocate(  0,  0,  0);
my $cl_white = $img->colorAllocate(255,255,255);
 
open(my $fh, '>', $FILENAME)
    or die "Can't open $FILENAME: $!";
 
binmode $fh;
 
my $C_im = $IM_MIN;
 
YY: for (my $yy=0; $yy < $SIZEY; $yy++){
 
    my $C_re = $RE_MIN;
 
    XX: for (my $xx=0; $xx < $SIZEX; $xx++){
 
        my ($Z_re, $Z_im, $i) = (0,0);
 
        # Z0=0, Zn+1 = Zn^2 + C
        ESCAPE_ITERATIONS: for ($i = 1; $i < $ITERATIONS; $i++){
 
            my ($Z_re2, $Z_im2) = ($Z_re * $Z_re, $Z_im * $Z_im);
 
            last ESCAPE_ITERATIONS unless ($Z_re2 + $Z_im2 < 4);
 
            # (a+bi)^2 = a^2 + 2abi - b^2
            $Z_im = 2 * $Z_re * $Z_im + $C_im;
            $Z_re = $Z_re2 - $Z_im2 + $C_re;
 
        } # end: ESCAPE_ITERATIONS
 
        # draw pixel
        $img->setPixel(
            $xx, $yy, $i == $ITERATIONS ? $cl_black : $cl_white
        );
 
        $C_re += $re_factor;
 
    } # end: XX
 
    $C_im += $im_factor;
 
} # end: YY
 
# save image
print $fh $img->png(0);
close $fh;

Il codice è stato mantenuto semplice per facilitare le modifiche e la comprensione.

E’ richiesto il package GD per la produzione dell’immagine di output in formato PNG: “mandelbrot.png“.

mandelbrot.png generato dal sorgente perl

 

Colori

Normalmente, per rendere tale frattale più gradevole, nella sua rappresentazione più semplice, si colorano i punti esterni all’insieme in funzione della velocità con la quale divergono a più infinito. Per la colorazione dei punti interni ed esterni esistono una miriade di algoritmi di complessità crescente; alcuni spunti interessanti.

Insieme di Julia

Una variante dell’insieme di Mandelbrot è l’insieme di Julia definito in questo modo:

  Q_n^K(c)=  \begin{cases}  & Z_0=c \\  & Z_{n+1}=Z_n^2+K  \end{cases}

Rispetto all’insieme di Mandelbrot cambia la successione ricorsiva ed è stata introdotta una costante complessa K.

Analogamente a Mandelbrot i punti appartenenti all’insieme di Julia sono quelli per cui il modulo della successione ricorsiva non diverge.

  J=\left\{c\in \mathbb{C} : \exists s \in \mathbb{R}, \forall n \in \mathbb{N},|Q_n^K(c)| \leq s \right\}

Alcuni valori di K che si consiglia di esplorare:

  • K = 0.353+0.288i
  • K = -0.70176-0.3842i
  • K = -0.835-0.2321i
  • K= -0.45+0.1428i

Dopo aver adeguato lo script perl, ho rappresentato questi insiemi di Julia:

Insieme di Julia (K=0.353+0.288i)
Insieme di Julia (K=0.353+0.288i)
Insieme di Julia (K=-0.835-0.2321i)

Riferimenti

Mandelbrot Set – Wikipedia
Mu-Ency – The Encyclopedia of the Mandelbrot Set
The Mandelbrot Set (algoritmo tracciamento)
Julia Set – Wikipedia

Esplorazione

Visual Guide To Patterns In The Mandelbrot SetMandelbrot: World Map and Popular Tourist Areas

Share