I was reading Godel, Escher, Bach: An Eternal Golden Braid on the train and when reading about the MU puzzle I decided to give it a go. I wrote most of the code on my lil' eeepc, but I did get a bit stuck with the recursion, it was hard to get the apply-rules function to return the answer once it found a path to “MU”.

In the end with some help from the good folks in #emacs and #lisp I had it working here’s the code:

(defvar *path*)

(defun all-matches (string pattern &key (start 0))
  "Return a list of positions for all matches of the pattern in the string"
  (let ((match (search pattern string :start2 start)))
    (when match
      (append (list match)
              (all-matches string pattern :start (+ match 1))))))

(defun list-if (x)
  (when x
    (list x)))

(defun replace-substr (string start end new)
  (concatenate 'string (subseq string 0 start) new
               (subseq string end)))

(defun replace-all-once (string pattern new)
  (let ((matches (all-matches string pattern)))
     (loop for match in matches
        collect (replace-substr string match (+ match (length pattern)) new))
     :test #'equal)))

(defun string-last (string)
  (aref string (1- (length string))))

(defun rule-1 (string)
  (when (eql (string-last string) #\I)
    (concatenate 'string string "U")))

(defun rule-2 (string)
  (when (eql (aref string 0) #\M)
    (if (> (length string) 1)
        (concatenate 'string string (subseq string 1))

(defun rule-3 (string)
  (replace-all-once string "III" "U"))

(defun rule-4 (string)
  (replace-all-once string "UU" ""))

(defun apply-rules (string depth)
  "Return a list of axioms returned by the various rules"
  (if (or (< depth 1) *path*)
      (if (equal string "MU")
          (push "MU" *path*)
          (let ((results (append
                          (list-if (rule-1 string))
                          (list-if (rule-2 string))
                          (rule-3 string)
                          (rule-4 string))))
            (loop for match in results
               collect (append (list match) (apply-rules match (1- depth)))
               do (when (and match (equal (last *path*) (list match)))
                    (push string *path*)))))))

(defun find-mu (depth)
  (let (tree *path*)
    (setf tree (apply-rules "MI" depth))
    (if *path*
        (format t "The answer is: ~a. ~%" *path*)
        (format t "Couldn't solve it by going through ~a levels of possibilities. ~%  Tree:~A" depth tree))))

(find-mu 5)

Now when Emacs ground to a halt trying to solve the puzzle, beach pointed out that it was actually impossible and it’s explained later in the book… whoops! Anyway, I thought it was a nifty little program so I thought I’d post it anyway.

(Try replacing “MU” with something that is possible to find to see it in action.)

Cheers, Dave.