Evoluution simulointia sanoilla

muta.pl

use utf8;
use warnings;

@kirjaimet = ( "a" .. "z", "å", "ä", "ö" );

$alkutilanne  = "aaaaaaaaaaaaaaa";
$valintapaine = "kehitysoppi";

# Elinkelpoisuutta simuloidaan ns. Levenšteinin etäisyydellä, joka sopii esimerkkiimme
use Text::Levenshtein qw(fastdistance);

# Ensimmäinen suvunjatkaja on alkutilanteen molekyyli
$suvunjatkaja = $alkutilanne;

while (1) {

    # Seuraava sukupolvi
    $sukupolvi++;

    undef @poikue;

    # Tehdään 10 jälkeläistä
    for $tama_jalkelainen ( 0 .. 9 ) {

        # Jälkeläisen rakenteen pohjana on edellinen suvunjatkaja
        $poikue[$tama_jalkelainen] = $suvunjatkaja;

        # Poistetaan satunnainen kirjain 1 % todennäköisyydellä
        if ( rand() < .01 && length( $poikue[$tama_jalkelainen] ) > 1 ) {
            $paikka = int( rand( length( $poikue[$tama_jalkelainen] ) ) );
            substr( $poikue[$tama_jalkelainen], $paikka, 1 ) = "";
        }

        # Lisätään satunnainen kirjain 1 % todennäköisyydellä
        if ( rand() < .01 ) {
            $paikka = int( rand( length( $poikue[$tama_jalkelainen] ) + 1 ) );
            substr( $poikue[$tama_jalkelainen], $paikka, 0 ) =
              &satunnainen_kirjain;
        }

        # Muutetaan satunnainen kirjain toiseksi 5 % todennäköisyydellä
        if ( rand() < .05 ) {
            $paikka = int( rand( length( $poikue[$tama_jalkelainen] ) ) );
            substr( $poikue[$tama_jalkelainen], $paikka, 1 ) =
              &satunnainen_kirjain;
        }

        # Määritetään elinkelpoisuus Levenšteinin etäisyytenä
        # valintapainesanasta (pienempi lukuarvo = parempi)
        $kelpoisuus = fastdistance( $poikue[$tama_jalkelainen], $valintapaine );

        # Pidetään kirjaa kelpoisimmasta yksilöstä
        if ( $tama_jalkelainen == 0 or $kelpoisuus < $paras_kelpoisuus ) {
            $paras_kelpoisuus = $kelpoisuus;
            $kelpoisin        = $tama_jalkelainen;
        }

    }

    # Valitaan seuraava suvunjatkaja
    $suvunjatkaja = $poikue[$kelpoisin];

    # Tulostetaan tilanne 50 sukupolven välein
    if ( $sukupolvi < 10 or $sukupolvi % 50 == 0 ) {

        # Kelpoisin merkitään tähdellä
        $poikue[$kelpoisin] = "*" . $poikue[$kelpoisin];

        print $sukupolvi . " " . join( " ", @poikue ) . "\n";

    }

}

sub satunnainen_kirjain {
    return $kirjaimet[ rand($#kirjaimet) ];
}