Haskell で小町算

まぁ、なんか自力で parse してみた。副作用無しで parse するのはこんな感じでいいのかなぁ。

import Char

isNumber :: String -> Bool
isNumber = all isDigit

tokenize :: String -> [String]
tokenize [] = []
tokenize (c:cs) | isSpace c = tokenize cs
tokenize (c:cs) | isDigit c = let (digits, rest) = span isDigit cs
                              in (c:digits) : tokenize rest
tokenize (c:cs) | elem c "+-*/" = [c] : tokenize cs
tokenize _ = error "tokenize failure"

evaluate :: String -> Rational
evaluate xs = expr (tokenize xs) next
  where
    next val [] = val
    next _ (_:_) = error "parse failure"

expr :: [String] -> (Rational -> [String] -> Rational) -> Rational
expr xs cont = term xs next
  where
    next val ("+":ys)  = term ys (\v -> next (val + v))
    next val ("-":ys)  = term ys (\v -> next (val - v))
    next val ys = cont val ys

term :: [String] -> (Rational -> [String] -> Rational) -> Rational
term xs cont = fact xs next
  where
    next val ("*":ys) = fact ys (\v -> next (val * v))
    next val ("/":ys) = fact ys (\v -> next (val / v))
    next val ys = cont val ys

fact :: [String] -> (Rational -> [String] -> Rational) -> Rational
fact (x:xs) cont | isNumber x = cont (fromInteger $ read x) xs
fact ("(":xs) cont = expr xs next
  where
    next val (")":ys) = cont val ys
    next _ _ = error "parse failure"
fact _ _ = error "parse failure"

operators :: [String]
operators = ["", "+", "-", "*", "/"]

expressions :: [Int] -> [String]
expressions [] = []
expressions [x] = [show x]
expressions (x:xs) = [(show x) ++ op ++ e | op <- operators, e <- expressions xs]

komachi :: [String]
komachi = filter (\x -> evaluate x == 100) $ expressions [1..9]

main :: IO ()
main = let exps = komachi
       in putStrLn $ (unlines $ (map appendLeftHandSide exps)) ++ (show $ length exps) ++ " pattern(s) found"
  where
    appendLeftHandSide x = x ++ "=100"

あと、電卓版は Parsec を使ってみるテスト。

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr

operators :: [String]
operators = ["", "+", "-", "*", "/"]

expr :: Parser Rational
expr = buildExpressionParser table factor <?> "expression"
  where
    table = [
             [
              op "*" (*) AssocLeft,
              op "/" (/) AssocLeft,
              op "+" (+) AssocLeft,
              op "-" (-) AssocLeft
             ]
            ]
    op s f assoc = Infix (do { string s; return f}) assoc

factor :: Parser Rational
factor = number <?> "simple expression"

number :: Parser Rational
number = do ds <- many1 digit
            return $ fromInteger (read ds)
         <?> "number"

expressions :: [Integer] -> [String]
expressions [] = error "cannot generate expressions"
expressions [x] = [show x]
expressions (x:xs) = [show x ++ op ++ e | op <- operators, e <- expressions xs]

evaluate :: String -> Rational
evaluate input = case (parse expr "" input) of
                 Left err -> error $ "evaluation failed at " ++ show err
                 Right x  -> x

komachi :: [String]
komachi = filter (\x -> evaluate x == (100 :: Rational)) $ expressions [1..9]

main :: IO ()
main = do mapM_ (\e -> putStrLn $ e ++ "=100") komachi
          print $ length komachi