new: Solved problems 46 to 50

Problems 46-50/problem_46.hs

@@ -0,0 +1,25 @@
+-- There isn't much point in implementing the basic predicates by hand
+-- as it'd be equivalent to just writing their truth tables
+and' :: Bool -> Bool -> Bool
+and' = (&&)
+
+or' :: Bool -> Bool -> Bool
+or' = (||)
+
+nand' :: Bool -> Bool -> Bool
+nand' x y = not $ and' x y
+
+nor' :: Bool -> Bool -> Bool
+nor' x y = not $ or' x y
+
+xor' :: Bool -> Bool -> Bool
+xor' = (/=)
+
+impl' :: Bool -> Bool -> Bool
+impl' x = or' (not x)
+
+equ' :: Bool -> Bool -> Bool
+equ' = (==)
+
+table :: (Bool -> Bool -> Bool) -> IO ()
+table f = mapM_ putStrLn [show x ++ " " ++ show y ++ " " ++ show (f x y) | x <- [True, False], y <- [True, False]]

Problems 46-50/problem_47.hs

@@ -0,0 +1,39 @@
+-- There isn't much point in implementing the basic predicates by hand
+-- as it'd be equivalent to just writing their truth tables
+and' :: Bool -> Bool -> Bool
+and' = (&&)
+
+infixl 4 `and'`
+
+or' :: Bool -> Bool -> Bool
+or' = (||)
+
+infixl 3 `or'`
+
+nand' :: Bool -> Bool -> Bool
+nand' x y = not $ and' x y
+
+infixl 9 `nand'`
+
+nor' :: Bool -> Bool -> Bool
+nor' x y = not $ or' x y
+
+infixl 9 `nor'`
+
+xor' :: Bool -> Bool -> Bool
+xor' = (/=)
+
+infixl 9 `xor'`
+
+impl' :: Bool -> Bool -> Bool
+impl' x = or' (not x)
+
+infixl 3 `impl'`
+
+equ' :: Bool -> Bool -> Bool
+equ' = (==)
+
+infixl 8 `equ'`
+
+table :: (Bool -> Bool -> Bool) -> IO ()
+table f = mapM_ putStrLn [show x ++ " " ++ show y ++ " " ++ show (x `f` y) | x <- [True, False], y <- [True, False]]

Problems 46-50/problem_48.hs

@@ -0,0 +1,45 @@
+import Control.Monad (replicateM)
+
+-- There isn't much point in implementing the basic predicates by hand
+-- as it'd be equivalent to just writing their truth tables
+and' :: Bool -> Bool -> Bool
+and' = (&&)
+
+infixl 4 `and'`
+
+or' :: Bool -> Bool -> Bool
+or' = (||)
+
+infixl 3 `or'`
+
+nand' :: Bool -> Bool -> Bool
+nand' x y = not $ and' x y
+
+infixl 9 `nand'`
+
+nor' :: Bool -> Bool -> Bool
+nor' x y = not $ or' x y
+
+infixl 9 `nor'`
+
+xor' :: Bool -> Bool -> Bool
+xor' = (/=)
+
+infixl 9 `xor'`
+
+impl' :: Bool -> Bool -> Bool
+impl' x = or' (not x)
+
+infixl 3 `impl'`
+
+equ' :: Bool -> Bool -> Bool
+equ' = (==)
+
+infixl 8 `equ'`
+
+tablen :: Int -> ([Bool] -> Bool) -> IO ()
+tablen n f = mapM_ putStrLn [toStr x ++ show (f x) | x <- replicateM n [True, False]]
+  where
+    toStr = unwords . map ((++) <$> show <*> space)
+    space True = "   "
+    space False = "  "

Problems 46-50/problem_49.hs

@@ -0,0 +1,13 @@
+gray :: Int -> [[Char]]
+gray n
+  | n == 1 = ["0", "1"]
+  | n > 1 =
+      concatMap
+        ( \(i, l) ->
+            if odd i
+              then [(l ++)] <*> ["0", "1"]
+              else [(l ++)] <*> ["1", "0"]
+        )
+        $ zip [1 ..]
+        $ gray (n - 1)
+  | otherwise = error "Not defined for n<1"

Problems 46-50/problem_50.hs

@@ -0,0 +1,29 @@
+import Data.List (sortBy)
+
+data HTree a = HBranch Int (HTree a) (HTree a) | HLeaf Int a
+
+hTreeVal :: HTree a -> Int
+hTreeVal (HLeaf n _) = n
+hTreeVal (HBranch n _ _) = n
+
+toHTree :: [HTree Char] -> HTree Char
+toHTree [t] = t
+toHTree [HLeaf f1 l1, HLeaf f2 l2] =
+  if f1 < f2
+    then HBranch (f1 + f2) (HLeaf f1 l1) (HLeaf f2 l2)
+    else HBranch (f1 + f2) (HLeaf f2 l2) (HLeaf f1 l1)
+toHTree ls = toHTree (mod : tl)
+  where
+    (l1 : l2 : tl) = sortBy sorter ls
+    sorter x y = hTreeVal x `compare` hTreeVal y
+    mod = HBranch (hTreeVal l1 + hTreeVal l2) l1 l2
+
+fromHTree :: HTree Char -> [(Char, String)]
+fromHTree (HLeaf 100 a) = [(a, "0")]
+fromHTree (HLeaf _ a) = [(a, "")]
+fromHTree (HBranch _ t1 t2) = [(c, '0' : s) | (c, s) <- fromHTree t1] ++ [(c, '1' : s) | (c, s) <- fromHTree t2]
+
+huffman :: [(Char, Int)] -> [(Char, String)]
+huffman ls = map snd $ filter (\((c1, _), (c2, _)) -> c1 == c2) $ (,) <$> ls <*> sortedCodes
+  where
+    sortedCodes = fromHTree $ toHTree $ map (\(c, v) -> HLeaf v c) ls