$latex \\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 $latex \\mathrm{MI}$ into the string $latex \\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][mu-puzzle]. The code ======== The code is not only concerned with deriving $latex \\mathrm{MU}$ from $latex \\mathrm{MI}$, but with derivations as such. Preliminaries ------------- 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] Derivations ----------- 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 ++ > "\n" > > 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.