Concurrent Clean : 小町算

一応作ってみたが、有理数演算になっていないのでだめだった。実行時間は１秒程度らしい。

module Main
extension for-notation

import StdBase, OptEnv
import StdDebug

Start w
    # a = problems 8
          |> (\a = zip2 a $ map calc a)
          |> filter (\(_,x) = x == 100)
          |> map fst
    = for w
        f <- stdio
        f = f |> seqmap print a $> "count = " $> length a $> newline
        _ <- fclose f
        return

::OP a = PLUS a | MULT a | NONE
opToInt (PLUS _) = 1
opToInt (MULT _) = 2
opToInt NONE     = 3

eval (PLUS op) = if op + -
eval (MULT op) = if op * /
eval NONE      = \x y = x * 10 + y

show (PLUS op) = if op "+" "-"
show (MULT op) = if op "*" "/"
show NONE      = ""

problems n | n < 0 = abort "internal error: problems"
problems 0 = [[]]
problems n = [[a:b] \\ a <- [PLUS True, PLUS False, MULT True, MULT False, NONE]
                     , b <- problems (n - 1)]

calc op = calc [1] [2,3,4,5,6,7,8,9] [] op
  where
    calc [res] [] [] [] = res
    calc [n0,n1:nS] [] [o:oS] [] = calc [eval o n1 n0:nS] [] oS []
    calc nS [n:nR] oS [o:oR]
      # (nS,oS) = f o nS oS
      = calc [n:nS] nR oS oR
    calc _ _ _ _ = abort "internal error: calc"

    f op nS [] = (nS,[op])
    f op nS oS=:[o:_] | opToInt op > opToInt o = (nS,[op:oS])
    f op [n0,n1:nS] [o:oS] = f op [eval o n1 n0:nS] oS
    f _ _ _ = abort "internal error: calc"

print op f = f $> 1 |> printOp [2,3,4,5,6,7,8,9] op $> newline
  where
    printOp [] [] f = f
    printOp n [op:o] f = f $> show op |> printNum n o
    printOp _ _ _ = abort "internal error: print"

    printNum [n0:n] o f = f $> n0 |> printOp n o
    printNum _ _ _ = abort "internal error: print"