由我来组成头部!

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
Global site tag (gtag.js) - Google Analytics