gistfile1.txt

module ShowExpression where

data Op = Add | Sub | Mul | Div 

instance Show Op where
  show Add = "+"
  show Sub = "-"
  show Mul = "*"
  show Div = "/"

-- valid :: Op -> Int -> Int -> Bool
-- valid Add _ _ = True
-- valid Sub x y = x > y
-- valid Mul _ _ = True
-- valid Div x y = mod x y == 0

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 && (mod x y == 0) 

-- upgraded above with communicative and identity 
-- properties

apply :: Op -> Int -> Int -> Int
apply Add x y = x + y
apply Sub x y = x - y
apply Mul x y = x * y
apply Div x y = div x y

data Expr = Val Int | App Op Expr Expr

instance Show Expr where
        show (Val n)     = show n
        show (App o l r) = brak l ++ show o ++ brak r
          where
            brak (Val n) = show n
            brak e       = "(" ++ show e ++ ")"

values :: Expr -> [Int]
values (Val n) = [n]
values (App _ l r) = values l ++ values r

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]


----------------------------------------------------------------------------------

import ShowExpression


subs :: [a] -> [[a]]
subs []     = [[]]
subs (x:xs) = yss ++ map (x:) yss
  where yss = subs xs

interleave :: a -> [a] -> [[a]]
interleave x []     = [[x]]
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)

perms :: [a] -> [[a]]
perms []     = [[]] 
perms (x:xs) = concat (map (interleave x) (perms xs))

-- to terminate, do: 
-- perms (x:xs) = trace "it terminates" concat (map (interleave x) (perms xs))


choices :: [a] -> [[a]]
choices = concat . map perms . subs 

-- choices xs = concat . map perms . subs $ xs  
-- -- variation with $

-----------------------------------------------------------------------

-- what effect would split have on 'solve' if it was modified to 
-- also return pairs containing the empty list ?   - It won't terminate.

split :: [a] -> [([a], [a])]
split []     = []
-- split [_]    = []
split (x:xs) = ([x], xs) : [(x:ls, rs) | (ls, rs) <- split xs]

-- auxillary function combine in exprs:

combine :: Expr -> Expr -> [Expr]
combine l r = [App o l r | o <- ops]

ops :: [Op]
ops = [Add,Sub,Mul,Div]

-- auxiliary function for results ------------------------

type Result = (Expr, Int)

combine' :: Result -> Result -> [Result]
combine' (l, x) (r, y) =
  [(App o l r, apply o x y) | o <- ops, valid o x y]

-- Prelude> combine' (App Add (Val 2) (Val 2), 4) (App Mul (Val 3) (Val 1), 3)

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]

solve ns n =
  [e | ns' <- choices ns, (e, m) <- results ns', m == n]

-- main :: IO ()
-- main = print (solve [1, 3, 7, 10, 25, 50] 765)

----------------------------------------------------------

removeFirst :: Eq a => a -> [a] -> [a]
removeFirst x []                = []
removeFirst x (y:ys) | x == y   = ys
                     | otherwise = y : removeFirst x ys
   
isChoice :: Eq a => [a] -> [a] -> Bool
isChoice [] _      = True
isChoice (x:xs) [] = False
isChoice (x:xs) ys = elem x ys && isChoice xs (removeFirst x ys)

----------------------------------------------------------