Dawkins ‘Weasel’ program as a Perl one-liner
Explained at Panda’s Thumb:
Over at uncommon descent William Dembski is musing over Richard Dawkins Weasel program. Why you may ask? Way back in prehistory (the 1980’s) Dawkins wrote a little BASIC program (in Apple BASIC of all things) to demonstrate the difference between random mutation and random mutation with selection, which many people were having trouble grasping. Now, this wasn’t a simulation of natural selection, and Dawkins was very careful to point this out.
But as a demonstration of selection versus simple random mutation, with the string “methinks it is a weasel†being selected in a matter of minutes, when simple random mutation would take longer than the age of the Universe, it was pretty stunning. As a result, creationists have been having conniption fits over this little program for decades. Such is its power, the Issac Newton of Information Theory, William Dembski, spent a not inconsiderable portion of his time attacking this toy program. In particular, he claimed that after every successful mutation, the successful mutation was locked into place, and couldn’t be reversed. But he was wrong, and it seems he just can’t admit it.
The Weasel program starts with a random string. Then each generation ‘offspring’ strings are generated, each with one letter randomly changed. From among the offspring, the string closest to the target string is chosen each generation. Rather quickly this process of mutation and selection will change any string into the target string. I start with “Creationism is nonsense” and my target is “methinks it is a weasle”, the target Dawkins uses.
Since the creationists are having trouble making such a program, I wondered *just how short* a program could be written to do this. Here’s a first attempt as a eight line Perl one-liner. It can be cut & pasted into a Unix terminal:
perl -e '$|=1;$s="Creationism is nonsense";$e="methinks it is a weasle";$try=11;$let=length($s);@e=split(//,$e);while($s ne $e){$i=-1;while($i++< $try){$new_s[$i]=$s;$chr=int(rand(27))||-64;substr($new_s[$i],int(rand($let)),1,chr(96+$chr));@spl=split(//,$new_s[$i]);$j=0;$new_sc[$i]=0;while($j<@e){$new_sc[$i]++if$e[$j]eq$spl[$j++]}}@sc=sort{$new_sc[$b]<=>$new_sc[$a]}(0..$#new_sc);@new=(shift@sc);while(@sc&&$new_sc[$sc[0]]==$new_sc[$new[0]]){push@new,shift@sc}$s=$new_s[$new[int(rand(@new))]];printf("Generation %5d, %-2dmismatches: $sr",++$n,$let-$new_sc[$new[0]]);}print"n";'
(When I cut & paste the one liner on my Mac it changes the final single quote to an end quote and the last two pairs of double quotes to funny double quotes, so keep an eye out and change them back if you need to).
And the normal length 35 line program with comments:
#!/usr/bin/perl
$|=1;
$s="Creationism is nonsense";
$e="methinks it is a weasle";
$try=11; #New offspring per generation.
$let=length($s);
@e=split(//,$e);
while($s ne $e) {
$i=-1;
#Make $try new strings.
while($i++< $try){
$new_s[$i]=$s;
#Mutate one char of the new string.
$chr = int(rand(27)) || -64;
substr($new_s[$i],int(rand($let)),1,chr(96+$chr));
#Count the characters in the new string that match the target string.
@spl=split(//,$new_s[$i]);
$j=0;
$new_sc[$i]=0;
while($j<@e){$new_sc[$i]++ if $e[$j] eq $spl[$j++]}
}
#Find high scoring offspring strings.
@sc = sort {$new_sc[$b]<=>$new_sc[$a]}(0..$#new_sc);
@new=(shift @sc);
while(@sc && $new_sc[$sc[0]] == $new_sc[$new[0]]){push @new,shift @sc}
#Set new string to a random offspring strings from among the high scoring offspring.
$s = $new_s[$new[int(rand(@new))]];
printf("Generation %5d, %-2dmismatches: $sr",++$n,$let-$new_sc[$new[0]]);
}
print"n";