由我来组成头部!
RednaxelaFX
2009-12-12
怪哉,GHC居然不能把无点跟多点混用:
foo :: Bool -> Int -> Int foo True = (+ 1) foo False x = 2 + x << 不行 foo :: Bool -> Int -> Int foo True x = (+ 1) x foo False x = 2 + x << 可以 T T |
|
RednaxelaFX
2009-12-12
lecture 11里我用的代码……
data Op = Add | Sub | Mul | Div instance Show Op where show Add = "+" show Sub = "-" show Mul = "*" show Div = "/" data Expr = Val Int | App Op Expr Expr instance Show Expr where showsPrec _ (Val n) = shows n showsPrec _ (App o l r) = showChar '(' . shows l . shows o . shows r . showChar ')' showList = joinStr "\n" joinStr :: (Show a) => String -> [a] -> ShowS joinStr _ [] = showString "" joinStr s (n:ns) = shows n . showl ns where showl [] = showString "" showl (x:xs) = showString s . shows x . showl xs apply :: Op -> Int -> Int -> Int apply Add = (+) apply Sub = (-) apply Mul = (*) apply Div = div valid :: Op -> Int -> Int -> Bool valid Add _ _ = True valid Sub x y = x > y valid Mul _ _ = True valid Div x y = x `mod` y == 0 eval :: Expr -> [Int] eval (Val n) = [n | n > 0] eval (App o l r) = [apply o x y | x <- eval l , y <- eval r , valid o x y] values :: Expr -> [Int] values (Val n) = [n] values (App _ l r) = values l ++ values r everywhere :: a -> [a] -> [[a]] everywhere n [] = [[n]] everywhere x (y:ys) = (x:y:ys) : [y:zs | zs <- everywhere x ys] permutations :: [a] -> [[a]] permutations [] = [[]] permutations (n:ns) = xss ++ [zs | ys <- xss , zs <- everywhere n ys] where xss = permutations ns split :: [a] -> [([a],[a])] split [] = [] split [n] = [] split (n:ns) = ([n],ns) : [(n:xs,ys) | (xs,ys) <- split ns] combine :: Expr -> Expr -> [Expr] combine l r = [App o l r | o <- [Add, Sub, Mul, Div]] exprs :: [Int] -> [Expr] exprs [] = [] exprs [n] = [(Val n) | n > 0] exprs ns = [e | (ls,rs) <- split ns , l <- exprs ls , r <- exprs rs , e <- combine l r] solutions :: [Int] -> Int -> [Expr] solutions ns n = [e | xs <- permutations ns , e <- exprs xs , eval e == [n]] type Result = (Expr,Int) valid' :: Op -> Int -> Int -> Bool valid' Add x y = x <= y valid' Sub x y = x > y valid' Mul x y = x <= y && x /= 1 && y /= 1 valid' Div x y = y /= 1 && x `mod` y == 0 combine' :: Result -> Result -> [Result] combine' (l,x) (r,y) = [(App o l r, apply o x y) | o <- [Add, Sub, Mul, Div] , valid' o x y] -- result is fusion of exprs and eval results :: [Int] -> [Result] results [] = [] results [n] = [(Val n,n) | n > 0] results ns = [res | (ls,rs) <- split ns , lx <- results ls , ry <- results rs , res <- combine' lx ry] solutions' :: [Int] -> Int -> [Expr] solutions' ns n = [e | xs <- permutations ns , (e,m) <- results xs , m == n] main :: IO () main = do putStr "Number of solutions: " putStrLnX $ length es putStrLnX es where es = solutions' [1,3,7,10,25,50] 765 putStrLnX :: (Show a) => a -> IO () putStrLnX = putStrLn . show |