+46 +47 +48 +49 +50

5 files changed, 102 insertions, 0 deletions

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