MIU in Haskell

In the Theory Lunch of the last week, James Chapman talked about the MU puzzle from Douglas Hofstadter’s book Gödel, Escher, Bach. This puzzle is about a string rewriting system. James presented a Haskell program that computes derivations of strings. Inspired by this, I wrote my own implementation, with the goal of improving efficiency. This blog post presents this implementation. As usual, it is available as a literate Haskell file, which you can load into GHCi.

The puzzle

Let me first describe the MU puzzle shortly. The puzzle deals with strings that may contain the characters \mathrm M, \mathrm I, and \mathrm U. We can derive new strings from old ones using the following rewriting system:

\begin{array}{rcl} x\mathrm I & \rightarrow & x\mathrm{IU} \\ \mathrm Mx & \rightarrow & \mathrm Mxx \\ x\mathrm{III}y & \rightarrow & x\mathrm Uy \\ x\mathrm{UU}y & \rightarrow & xy \end{array}

The question is whether it is possible to turn the string \mathrm{MI} into the string \mathrm{MU} using these rules.

You may want to try to solve this puzzle yourself, or you may want to look up the solution on the Wikipedia page.

The code

The code is not only concerned with deriving \mathrm{MU} from \mathrm{MI}, but with derivations as such.


We import Data.List:

import Data.List

Basic things

We define the type Sym of symbols and the type Str of symbol strings:

data Sym = M | I | U deriving Eq

type Str = [Sym]

instance Show Sym where

    show M = "M"
    show I = "I"
    show U = "U"

    showList str = (concatMap show str ++)

Next, we define the type Rule of rules as well as the list rules that contains all rules:

data Rule = R1 | R2 | R3 | R4 deriving Show

rules :: [Rule]
rules = [R1,R2,R3,R4]

Rule application

We first introduce a helper function that takes a string and returns the list of all splits of this string. Thereby, a split of a string str is a pair of strings str1 and str2 such that str1 ++ str2 == str. A straightforward implementation of splitting is as follows:

splits' :: Str -> [(Str,Str)]
splits' str = zip (inits str) (tails str)

The problem with this implementation is that walking through the result list takes quadratic time, even if the elements of the list are left unevaluated. The following implementation solves this problem:

splits :: Str -> [(Str,Str)]
splits str = zip (map (flip take str) [0 ..]) (tails str)

Next, we define a helper function replace. An expression replace old new str yields the list of all strings that can be constructed by replacing the string old inside str by new.

replace :: Str -> Str -> Str -> [Str]
replace old new str = [front ++ new ++ rear |
                          (front,rest) <- splits str,
                          old `isPrefixOf` rest,
                          let rear = drop (length old) rest]

We are now ready to implement the function apply, which performs rule application. This function takes a rule and a string and produces all strings that can be derived from the given string using the given rule exactly once.

apply :: Rule -> Str -> [Str]
apply R1 str        | last str == I = [str ++ [U]]
apply R2 (M : tail)                 = [M : tail ++ tail]
apply R3 str                        = replace [I,I,I] [U] str
apply R4 str                        = replace [U,U]   []  str
apply _  _                          = []

Derivation trees

Now we want to build derivation trees. A derivation tree for a string str has the following properties:

  • The root is labeled with str.
  • The subtrees of the root are the derivation trees for the strings that can be generated from str by a single rule application.
  • The edges from the root to its subtrees are marked with the respective rules that are applied.

We first define types for representing derivation trees:

data DTree = DTree Str [DSub]

data DSub  = DSub Rule DTree

Now we define the function dTree that turns a string into its derivation tree:

dTree :: Str -> DTree
dTree str = DTree str [DSub rule subtree |
                          rule <- rules,
                          subStr <- apply rule str,
                          let subtree = dTree subStr]


A derivation is a sequence of strings with rules between them such that each rule takes the string before it to the string after it. We define types for representing derivations:

data Deriv = Deriv [DStep] Str

data DStep = DStep Str Rule

instance Show Deriv where

    show (Deriv steps goal) = "        "           ++
                              concatMap show steps ++
                              show goal            ++

    showList derivs
        = (concatMap ((++ "\n") . show) derivs ++)

instance Show DStep where

    show (DStep origin rule) = show origin ++
                               "\n-> ("    ++
                               show rule   ++
                               ") "

Now we implement a function derivs that converts a derivation tree into the list of all derivations that start with the tree’s root label. The function derivs traverses the tree in breadth-first order.

derivs :: DTree -> [Deriv]
derivs tree = worker [([],tree)] where

    worker :: [([DStep],DTree)] -> [Deriv]
    worker tasks = rootDerivs tasks        ++
                   worker (subtasks tasks)

    rootDerivs :: [([DStep],DTree)] -> [Deriv]
    rootDerivs tasks = [Deriv (reverse revSteps) root |
                           (revSteps,DTree root _) <- tasks]

    subtasks :: [([DStep],DTree)] -> [([DStep],DTree)]
    subtasks tasks = [(DStep root rule : revSteps,subtree) |
                         (revSteps,DTree root subs) <- tasks,
                         DSub rule subtree          <- subs]

Finally, we implement the function derivations which takes two strings and returns the list of those derivations that turn the first string into the second:

derivations :: Str -> Str -> [Deriv]
derivations start end
    = [deriv | deriv@(Deriv _ goal) <- derivs (dTree start),
               goal == end]

You may want to enter

derivations [M,I] [M,U,I]

at the GHCi prompt to see the derivations function in action. You can also enter

derivations [M,I] [M,U]

to get an idea about the solution to the MU puzzle.


9 thoughts on “MIU in Haskell

  1. Pingback: MIU in Haskell, part 2 | Theory Lunch

    1. Wolfgang Jeltsch Post author

      The stripPrefix function returns a Maybe value, since it needs to signal whether the given list starts with the given prefix or not. In the replace function, I have already ensured that it does; so it is simpler to use the solution with drop and length, where I do not have to get rid of the Maybe.


  2. rd6137

    Why is split more efficient than split'?? I was unable to exhibit any difference between the two (Criterion used).

    Thank you!


    1. Wolfgang Jeltsch Post author

      Please enter this on the GHCi prompt:

      length $ splits $ replicate 1000000 M

      This should give you the result 1000001 quite quickly.

      Now try this:

      length $ splits' $ replicate 1000000 M

      I wasn’t able to get a result within a reasonable amount of time.

      The problem with split' lies in the use of inits. The inits function is implemented as follows:

      inits :: [a] -> [[a]]
      inits xs = [] : case xs of
                          []      -> []
                          x : xs' -> map (x : ) (inits xs')

      Note that the recursive application of inits is under a map. So the suffix of an expression inits [x_1,x_2,…,x_n] that starts at an index i is defined by a nested application of map of depth i:

      map (x_1 : ) (map (x_2 : ) (…(map (x_i : ) […])…))

      To detect that the result of an expression map f xs is non-empty, we have to detect that xs is non-empty. So to detect that the above suffix is non-empty, we need to walk through the i layers of maps, which takes \mathcal O(i) time.

      This means that to fetch the k-th element of inits xs, we need

      \sum_{i = 0}^k \mathcal O(i) = \mathcal O(k^2)


      The implementation of split doesn’t suffer from this problem, since it creates prefixes by a single application of map, and computes every single prefix independently.


    2. treeowl

      Back in the day, `inits` was rather inefficient. It’s fixed now. Back then, calculating `length (inits xs)` would take time quadratic in the length of `xs`, and the whole thing was much more expensive than necessary. These days `inits` uses a sort of simplified banker’s queue in its implementation, which (for somewhat mysterious reasons) proved even faster than the `take`-based version in this blog post. It would be worth running those benchmarks again now that GHC has gotten better at join points; I wonder if the `take` version has sped up.


  3. Pingback: MIU in Curry « Wolfgang Jeltsch

When replying to another comment, please press that comment’s “Reply” button.

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s