## Dawkins’ Weasel

### November 14, 2014

We begin with a simple function that returns a random letter or space:

```(define (rand-letter)   (let ((r (randint 27)))     (if (zero? r) #\space       (integer->char (+ r 64)))))```

Next we write a function that takes a guess and returns a mutation of that guess. Each letter in the input is replaced with one chance in twenty, when a 0 is randomly chosen from the half-open range [0, 20):

```(define (mutate guess)   (map (lambda (g) (if (zero? (randint 20)) (rand-letter) g)) guess))```

The `score` function compares a guess to a target and counts the number of equal characters.

```(define (score guess target)   (apply + (map (lambda (g t) (if (char=? g t) 1 0)) guess target)))```

The next function mutates its input one hundred times and returns the highest-scored mutation:

```(define (get-best guess target)   (let loop ((k 100) (best 0) (mutation guess))     (if (zero? k) (values best mutation)       (let* ((m (mutate guess)) (s (score m target)))         (if (< best s)             (loop (- k 1) s m)             (loop (- k 1) best mutation))))))```

We're almost finished. The `display-weasel` function writes the current guess on the output screen, using lower case letters (a space is made visible using an underscore) for non-matching letters and upper case letters where the guess matches the target, making it easy to see right and wrong:

```(define (display-weasel guess target)   (for-each (lambda (t g)               (if (char=? t g)                   (display g)                   (if (char=? #\space g)                       (display #\_)                       (display (char-downcase g)))))             target guess))```

All that’s left is the main processing loop, which continues running until it reaches the target:

```(define (dawkins target)   (let* ((target (string->list (string-upcase target)))          (len (length target))          (guess (map (lambda (x) (rand-letter)) (range len)))          (current (score guess target)))     (let loop ((i 0) (current current) (guess guess))       (display (align (number->string i) 4 'left))       (display (align (number->string current) 4 'left))       (display-weasel guess target) (newline)       (when (< current len)         (call-with-values           (lambda () (get-best guess target))           (lambda (best mutation)             (loop (+ i 1) best mutation)))))))```

Here’s a sample run:

```> (dawkins "METHINKS IT IS LIKE A WEASEL") 0   2   Mvmdav_krhrxehgr_uz ojeomhhx 1   3   MvmdavvkrIrxehgr_nz ojeomhhx 2   4   MvmdavvSrIrxehgr_nz ojeomhhx 3   5   MvmdavvSrIrxehgr_nE ojeomhhx 4   6   MvmdavvSrITxehgr_nE ojeomhhx 5   7   MvmdavvSrITyehgrInE ojeqmhhx 6   8   MvmdavvS ITyehgrInE ojgqmhhx 7   8   MvmdavvS ITyehgrInE ojgqmhhx 8   9   MvmdavvS ITgehgrInE ojgqAhhx 9   10  MvmdavvS ITgeh rInE ojgpAhhx 10  11  MvmdavvS ITgeh _InE ojWpAhhx 11  12  MvmdavvS ITgeh zInE ojWfAhEx 12  12  MvmdavvS ITgeh zInE ojWfAhEx 13  12  MvmdavvS ITgeh zInE ojWfAhEx 14  13  MvmdavvS ITgeh zInE ojWfASEx 15  14  MEmdavvS ITgeh zInE ojWfASEx 16  15  MEmdavvS ITgeh zInE o WfASEx 17  15  MEmdavvS ITgeh zInE o WfASEx 18  15  MEmdavvS ITgeh zInE o WfASEx 19  16  MEmdaNvS ITgeh zInE o WfASEx 20  17  MEmdaNoS ITgeh zIKE o WfASEx 21  17  MEmdaNoS ITgeh fIKE o WfASEx 22  18  MEmdaNKS ITgeh fIKE o WfASEx 23  19  MEmdaNKS ITgeS fIKE o WfASEx 24  19  MEmdaNKS ITgeS fIKE o WfASEx 25  19  MEe_aNKS ITgeS fIKE o WfASEx 26  20  MEe_aNKS ITgeS fIKE o WEASEx 27  21  MEe_aNKS ITgeS fIKE A WEASEx 28  21  MEe_aNKS ITgeS fIKE A WEASEx 29  21  MEe_aNKS ITgeS fIKE A WEASEx 30  22  MEeHaNKS ITgeS fIKE A WEASEx 31  22  MEeHaNKS ITgeS fIKE A WEASEx 32  23  MEeHaNKS ITgIS fIKE A WEASEx 33  23  MEeHaNKS ITgIS fIKE A WEASEx 34  24  MEeHaNKS IT IS fIKE A WEASEx 35  24  MEeHaNKS IT IS fIKE A WEASEx 36  24  MEeHaNKS IT IS fIKE A WEASEx 37  24  MEeHaNKS IT IS fIKE A WEASEx 38  24  MEeHaNKS IT IS fIKE A WEASEx 39  24  MEeHaNKS IT IS fIKE A WEASEz 40  24  MEeH_NKS IT IS fIKE A WEASEz 41  24  ME_H_NKS IT IS fIKE A WEASEz 42  25  METH_NKS IT IS fIKE A WEASEz 43  26  METHINKS IT IS fIKE A WEASEz 44  26  METHINKS IT IS iIKE A WEASEz 45  27  METHINKS IT IS iIKE A WEASEL 46  27  METHINKS IT IS iIKE A WEASEL 47  27  METHINKS IT IS iIKE A WEASEL 48  27  METHINKS IT IS iIKE A WEASEL 49  28  METHINKS IT IS LIKE A WEASEL```

We used `range` and `randint` from the Standard Prelude and `rept` and `align` from a previous exercise. You can run the program at http://programmingpraxis.codepad.org/26naQWOy.

Pages: 1 2

### 6 Responses to “Dawkins’ Weasel”

1. String manipulation suits Perl down to the ground, here we use implicit lambda functions (which is one of the beauties of perl)

Duration approx 0.15-0.25 seconds depending on randomness…

```use strict;
use warnings;

my @letters = (q( ),'A'..'Z');
my \$string = join q(), map {(\$letters[(rand @letters)])} 1..28;
my \$WEASEL = 'METHINKS IT IS LIKE A WEASEL';
my \$iter = 0;

while( \$string ne \$WEASEL ) {
\$iter++;
my( \$max_score, \$max_word ) = (0,q());
foreach my \$word ( map {( join q(), map {((rand 20 < 1) ? \$letters[(rand @letters)] : \$_ )} split m{}ms, \$string)} 1..100 ) {
my \$score = grep { ! ord \$_ } split m{}ms, (\$word^\$WEASEL);
( \$max_word, \$max_score ) = (\$word, \$score ) if \$score >= \$max_score;
}
\$string = \$max_word;
printf "%4d %2d %s\n", \$iter, \$max_score, \$string;
}
```
2. Joost Kremers said

A Common Lisp version I wrote a number of years ago for a class on the evolution of language:

```(defpackage "WEASEL"
(:use "COMMON-LISP")
(:export "EVOLUTION"))

(in-package weasel)

(defvar *target* "METHINKS IT IS LIKE A WEASEL")

(defvar *characters* (cons #\Space
(loop
for c from (char-code #\A) to (char-code #\Z)
collect (code-char c))))
(defun create (length)
(concatenate 'string (loop
for i from 1 to length
collect (nth (random (length *characters*)) *characters*))))

(defun procreate (text error-rate n-offspring)
(loop
for i from 1 to n-offspring
collect (map 'string #'(lambda (c)
(if (< (random 100) error-rate)
(nth (random (length *characters*)) *characters*)
c))
text)))

(defun select (candidates)
(car (sort candidates #'(lambda (x y)
(< (fitness x) (fitness y))))))

(defun fitness (string)
(loop
for c1 across string
for c2 across *target*
count (char/= c1 c2)))

(defun report (entity generation stream)
(format stream "Generation: ~A~%Entity: ~A~%Fitness (0 is best): ~A~%~%"
generation entity (fitness entity)))

(defun evolution (&key target (error-rate 1) (report-after 10)
(n-offspring 10) max-generations log)
(let ((*target* (if target
(remove-if-not #'(lambda (c) (member c *characters*)) target)
*target*)))
(flet ((evolve (output-stream)
(let ((first (create (length *target*))))
(report first 1 output-stream)
(do ((fittest first (select offspring))
(offspring (procreate first error-rate n-offspring)
(procreate fittest error-rate n-offspring))
(generation 1 (1+ generation)))
((or (and max-generations (= generation max-generations))
(= (fitness fittest) 0))
(report fittest generation output-stream))
(when (and report-after
(= (rem generation report-after) 0))
(report fittest generation output-stream))))))
(if log
(with-open-file (stream log :direction :output :if-exists :overwrite
:if-does-not-exist :create)
(evolve stream))
(evolve *standard-output*)))))
```
3. Graham said

This is a fun genetic algorithm experiment! Thanks for posting it.

```#!/usr/bin/env python3

from random import choice, random
from string import ascii_uppercase

GENES = "".join([ascii_uppercase, " "])
TARGET = "ME THINKS IT IS LIKE A WEASEL"
LENGTH = len(target)

def reproduce(sequence):
return [sequence] * 100

def mutate(sequence):
return "".join(choice(GENES) if random() < 0.05 else c for c in sequence)

def fitness(sequence):
return sum(c == t for (c, t) in zip(sequence, TARGET))

def evolve(max_iters=int(1e3)):
sequence = "".join(choice(GENES) for _ in range(LENGTH))
for i in range(max_iters):
population = map(mutate, reproduce(sequence))
sequence = max(population, key=fitness)
score = fitness(sequence)
print("{0:5}: ({1:5}) {2}".format(i, score, sequence))
if score == LENGTH:
return

if __name__ == "__main__":
evolve()
```
4. Graham said

oops! s/ME THINKS/METHINKS

5. A Java solution:

```public class DawkinWeasel {

private static final Random RANDOM = new Random();

private static final String ASCII_UPPERCASE = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";

private static int score(String s1, String s2) {
int score = 0;
for (int i = 0; i < s1.length(); i++) {
if (s1.charAt(i) == s2.charAt(i)) score++;
}
return score;
}

private static String mutate(String s, int p) {
StringBuilder sb = new StringBuilder();
for (int i = 0; i < s.length(); i++) {
if (RANDOM.nextInt(100) < p) {
sb.append(randomChar());
} else {
sb.append(s.charAt(i));
}
}
return sb.toString();
}

private static char randomChar() {
return ASCII_UPPERCASE.charAt(RANDOM.nextInt(ASCII_UPPERCASE.length()));
}

private static String randomString(int length) {
StringBuilder sb = new StringBuilder();
for (int i = 0; i < length; i++) {
sb.append(randomChar());
}
return sb.toString();
}

private static int evolveTo(String ref) {
String s = randomString(ref.length()),
bestMatch = s;
int iterations = 0,
bestScore = score(s, ref);
while (true) {
iterations++;
for (int i = 0; i < 100; i++) {
String mutatedCopy = mutate(s, 5);
int score = score(mutatedCopy, ref);
if (score == ref.length()) {
// Perfect match
return iterations;
}
if (score > bestScore) {
bestScore = score;
bestMatch = mutatedCopy;
}
}
s = bestMatch;
}
}

public static void main(String[] args) {
String ref = "METHINKS IT IS LIKE A WEASEL";
System.out.println("Evolved in " + evolveTo(ref) + " iterations");
}
}
```
6. Tom said

My attempt at a clojure version here (apologies for formatting):

```
(ns weasel)

(defn rand-char [] (.charAt "ABCDEFGHIJKLMNOPQRSTUVWXYZ " (rand-int 27)))

(defn mutate [chr-vec]
(assoc chr-vec (rand-int (count chr-vec)) (rand-char)))

(defn score [target candidate]
(reduce + (map #(if (= %1 %2) 1 0) target candidate)))

(defn next-gen-best [target candidate]
(apply max-key #(score target %1) (vec (repeatedly 100 #(mutate candidate)))))

(defn best-fit [target first second]
(if (> (score target first) (score target second)) first second))

(defn run [target-str]
(let [target (vec (char-array target-str))
initial (vec (repeatedly (count target) rand-char))]
(loop [best initial
i 0]
(if (= (score target best) (count target))
i
(recur (best-fit target best (next-gen-best target best)) (inc i))))))

; (run "METHINKS IT IS LIKE A WEASEL")
```