キップパズル

http://homepage3.nifty.com/iromono/diary/200511A.html#03

「００００から９９９９までの中に、どんなに四則演算しても１０にできない数は　ん　が　個ある」

ごりごりとやるプログラムを書きましたよ。こういうのは人がやるものじゃないと思っているんでね。
プログラムを信用すると書けるのが7629個でした。だから2371個かけないのだと思うよ。1853個が正しそうです。
ghcで3分40秒くらい。非可換なのが/だけとかを利用すれば大分早くなるだろうけど、高速化はCでなければ気にしないので。

import Ratio
import Maybe
import List

data Op = ADD | SUB | MUL | DIV
  deriving Show
data Ctree = Cal (Op, Ctree, Ctree) | Number Rational
  deriving Show

eval :: Ctree -> Maybe Rational
eval (Number r) = Just r
eval (Cal (o, a, b)) = let a0 = eval a;b0=eval b in 
                        case a0 of 
                         Nothing  -> Nothing
                         Just a1  ->
                          case b0 of
                           Nothing  -> Nothing
                           Just b1  ->
                            case o of
                              ADD -> Just$a1+b1
                              SUB -> Just$a1-b1
                              MUL -> Just$a1*b1
                              DIV -> if b1==0 then Nothing else Just (a1/b1)
splitList :: [a] -> [([a],[a])]
splitList xs = filter (\(p,q) -> not (null p || null q) ) $ splitList' xs
splitList' [] = [([],[])]
splitList' (x:xs) = map (\(a,b)->(x:a,b)) ss ++ map (\(a,b)->(a,x:b)) ss
  where ss = splitList' xs
makeTreeList :: [Rational] -> [Ctree]
makeTreeList [a] = [Number a]
makeTreeList input = [Cal (op,l,r)|op<-[ADD,SUB,MUL,DIV],(lh,rh)<-splitList input,r<-makeTreeList rh,l<-makeTreeList lh]
test2 = (filter (\(_,s) -> s==Just 10 ) . map (\x-> (x, eval x)) . makeTreeList)main = print z >> print  (length z)
 where z =  map head $! filter (not.null) x
       x = map test2 $ iterate (concat .map (flip map (map (:) [0..9]).flip($))) [[]] !! 4

エレガントな回答求む。