Last active
August 29, 2015 13:56
-
-
Save sw17ch/9201326 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| -- | For reference, see http://en.wikipedia.org/wiki/MU_puzzle. | |
| module Main where | |
| import Control.Monad ((>=>)) | |
| import Data.Maybe (mapMaybe) | |
| -- | The base language primitives. | |
| data MuVal = U | I | M deriving (Show, Eq) | |
| -- | Names for the MU rules. | |
| data MuRule = R1 | R2 | R3 | R4 deriving (Show, Eq, Ord) | |
| -- | A string of the primitives. | |
| type MuString = [MuVal] | |
| -- | The type of the 4 rules in the language. | |
| type Rule = (MuString -> Maybe MuString) | |
| -- | Function to convert from a Rule name to a Rule function | |
| ruleFn :: MuRule -> Rule | |
| ruleFn R1 = rule1 | |
| ruleFn R2 = rule2 | |
| ruleFn R3 = rule3 | |
| ruleFn R4 = rule4 | |
| -- | Rule 1: Add a `U` to the end of any string ending in I. | |
| -- For example: `MI` to `MIU` | |
| rule1 :: MuString -> Maybe MuString | |
| rule1 s = case reverse s of | |
| (I:_) -> Just (s ++ [U]) | |
| _ -> Nothing | |
| -- | Rule 2: Double the string after the `M` (that is, change `Mx`, to `Mxx`). | |
| -- For example: `MIU` to `MIUIU`. | |
| rule2 :: MuString -> Maybe MuString | |
| rule2 s = case s of | |
| (M:rst) -> Just $ [M] ++ rst ++ rst | |
| _ -> Nothing | |
| -- | Rule 3: Replicate `III` with a `U`. | |
| -- For example: `MUIIIU` to `MUUU`. | |
| rule3 :: MuString -> Maybe MuString | |
| rule3 s = applyIfApplicable s r3 | |
| where | |
| r3 (I:I:I:rs) = U : r3 rs | |
| r3 (r:rs) = r : r3 rs | |
| r3 [] = [] | |
| -- | Rule 4: Remove any `UU`. | |
| -- For example: `MUUU` to `MU`. | |
| rule4 :: MuString -> Maybe MuString | |
| rule4 s = applyIfApplicable s r4 | |
| where | |
| r4 (U:U:rs) = r4 rs | |
| r4 (r:rs) = r : r4 rs | |
| r4 [] = [] | |
| -- | Returns the result of applying `fn` to `s` if and only if the result of | |
| -- `fn s` differs from `s`. | |
| applyIfApplicable :: (Eq a) => a -> (a -> a) -> Maybe a | |
| applyIfApplicable s fn = let s' = fn s | |
| in if s == s' | |
| then Nothing | |
| else Just s' | |
| -- | Accepts a string and a list of rules to apply to the string in order. | |
| runRules :: MuString -> [Rule] -> Maybe MuString | |
| runRules s [] = Just s | |
| runRules s (r:rs) = foldl (>=>) r rs s | |
| -- | Creates all possible combinations of list of values. | |
| -- > take 10 $ sequences "ab" | |
| -- ["a","b","aa","ab","ba","bb","aaa","aab","aba","abb"] | |
| -- | |
| -- Note: Job Vranish helped me with this one a lot. | |
| sequences :: [a] -> [[a]] | |
| sequences ls = ls' ++ [i ++ [a] | i <- sequences ls, a <- ls] | |
| where | |
| ls' = map (:[]) ls | |
| -- | Produce a show-your-work result from an initial string and a list of rules. | |
| ruleResult :: MuString -> [MuRule] -> Maybe ([MuRule], MuString) | |
| ruleResult s rs = let ruleFns = map ruleFn rs | |
| in case runRules s ruleFns of | |
| Just s' -> Just (rs, s') | |
| Nothing -> Nothing | |
| -- | Make a result into a something printable. | |
| showRule :: ([MuRule], MuString) -> String | |
| showRule (rs, s) = concat [ "By: " | |
| , show rs | |
| , "\n" | |
| , "Found string: " | |
| , show s | |
| , "\n" | |
| ] | |
| -- | Print out found strings seraching from the initial string of "MI" | |
| main :: IO () | |
| main = mapM_ (putStrLn . showRule) $ mapMaybe (ruleResult initial) ruleSeqs | |
| where | |
| initial = [M,I] | |
| ruleSeqs = sequences [R1,R2,R3,R4] |
Author
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Here's the output of this program when using an initial string of [M,I] and outputting 100 strings.