diff options
-rw-r--r-- | H46.hs | 27 | ||||
-rw-r--r-- | H47.hs | 37 | ||||
-rw-r--r-- | H48.hs | 9 | ||||
-rw-r--r-- | H49.hs | 8 | ||||
-rw-r--r-- | H50.hs | 21 |
5 files changed, 102 insertions, 0 deletions
@@ -0,0 +1,27 @@ +and',or',nand',nor',xor',impl',equ' :: Bool -> Bool -> Bool +not' :: Bool -> Bool + +not' True = False +not' _ = True + +and' True True = True +and' _ _ = False + +or' False False = False +or' _ _ = True + +nand' = curry $ not' . (uncurry and') + +nor' = curry $ not' . (uncurry or') + +xor' True True = False +xor' False False = False +xor' _ _ = True + +impl' a b = or' (not' a) b + +equ' = curry $ not' . (uncurry xor') + +table :: (Bool -> Bool -> Bool) -> IO () +table f = mapM_ putStrLn [show a ++ " " ++ show b ++ " " ++ show (f a b) + | a <- [True, False], b <- [True, False]] @@ -0,0 +1,37 @@ +module H47 where +-- Any that lacks a infix precedence declaration will assume 9 + +infixl 4 `or'` +infixl 4 `nor'` +infixl 5 `xor'` +infixl 6 `and'` +infixl 6 `nand'` +infixl 3 `equ'` + +and',or',nand',nor',xor',impl',equ' :: Bool -> Bool -> Bool +not' :: Bool -> Bool + +not' True = False +not' _ = True + +and' True True = True +and' _ _ = False + +or' False False = False +or' _ _ = True + +nand' = curry $ not' . (uncurry and') + +nor' = curry $ not' . (uncurry or') + +xor' True True = False +xor' False False = False +xor' _ _ = True + +impl' a b = or' (not' a) b + +equ' = curry $ not' . (uncurry xor') + +table :: (Bool -> Bool -> Bool) -> IO () +table f = mapM_ putStrLn [show a ++ " " ++ show b ++ " " ++ show (f a b) + | a <- [True, False], b <- [True, False]] @@ -0,0 +1,9 @@ +import H47 +import Control.Monad (replicateM) + +tablen :: Int -> ([Bool] -> Bool) -> IO () +tablen n f = mapM_ putStrLn [toStr a ++ " => " ++ show (f a) | a <- args n] + where args n = replicateM n [True, False] + toStr = unwords . map (\x -> show x ++ space x) + space True = " " + space False = " " @@ -0,0 +1,8 @@ +import Control.Monad (replicateM) + +gray = map construct . (flip replicateM) ['0','1'] + where construct x = zipWith (\a b -> if a == b then '0' else '1') ('0':x) x + +gray' :: Integral a => a -> [String] +gray' 0 = [""] +gray' n = foldr (\s acc -> ("0" ++ s):("1" ++ s):acc) [] $ gray (n-1) @@ -0,0 +1,21 @@ +import Data.List +import Data.Ord (comparing) +import Control.Arrow + +data HTree a = Leaf a | Branch (HTree a) (HTree a) + deriving Show + +huffman :: [(a, Int)] -> [(a,String)] + +huffman xs = serialize "" $ huffcon $ sortBy (comparing fst) $ map (\(x,y) -> (y, Leaf x)) xs +huffcon [(_,a)] = a +huffcon ((v1,t1):(v2,t2):rst) = huffcon $ sortBy (comparing fst) $ (v1+v2,Branch t1 t2):rst + +serialize s (Leaf l) = [(l,s)] +serialize s (Branch t1 t2) = (serialize ('0':s) t1) ++ (serialize ('1':s) t2) + +huffman' :: [(a,Int)] -> [(a,String)] +huffman' xs = huffcon' $ sortBy (comparing fst) [(y,[(x,"")]) |(x,y) <- xs] +huffcon' [(_,a)] = a +huffcon' ((v1,l1):(v2,l2):rst) = huffcon' $ sortBy (comparing fst) $ + (v1+v2,(map (fst &&& ('0':).snd) l1)++(map (fst &&& ('1':).snd) l2)):rst |