From 13c0046a6dbd41b15358e76856922144ac76e768 Mon Sep 17 00:00:00 2001 From: Joe Zhao Date: Sat, 4 Apr 2015 17:38:20 +0800 Subject: +46 +47 +48 +49 +50 --- H46.hs | 27 +++++++++++++++++++++++++++ H47.hs | 37 +++++++++++++++++++++++++++++++++++++ H48.hs | 9 +++++++++ H49.hs | 8 ++++++++ H50.hs | 21 +++++++++++++++++++++ 5 files changed, 102 insertions(+) create mode 100644 H46.hs create mode 100644 H47.hs create mode 100644 H48.hs create mode 100644 H49.hs create mode 100644 H50.hs diff --git a/H46.hs b/H46.hs new file mode 100644 index 0000000..41b56a2 --- /dev/null +++ b/H46.hs @@ -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]] diff --git a/H47.hs b/H47.hs new file mode 100644 index 0000000..44a62a9 --- /dev/null +++ b/H47.hs @@ -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]] diff --git a/H48.hs b/H48.hs new file mode 100644 index 0000000..bba2dcc --- /dev/null +++ b/H48.hs @@ -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 = " " diff --git a/H49.hs b/H49.hs new file mode 100644 index 0000000..57f16b5 --- /dev/null +++ b/H49.hs @@ -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) diff --git a/H50.hs b/H50.hs new file mode 100644 index 0000000..c422775 --- /dev/null +++ b/H50.hs @@ -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 -- cgit v1.2.3-70-g09d2