Complete chapter 28

28-basic-libraries/28-basic-libraries.md

@@ -0,0 +1,75 @@
+# Basic Libraries
+
+## 28.6 Exercise: Benchmark Practice
+
+see [src/benchSet.hs](./src/benchSet.hs)
+
+```shell
+benchmarking member check map
+time                 28.57 ns   (28.10 ns .. 29.11 ns)
+                     0.998 R²   (0.996 R² .. 0.999 R²)
+mean                 28.43 ns   (28.09 ns .. 28.97 ns)
+std dev              1.357 ns   (899.3 ps .. 1.950 ns)
+variance introduced by outliers: 70% (severely inflated)
+
+benchmarking member check set
+time                 27.93 ns   (27.55 ns .. 28.34 ns)
+                     0.998 R²   (0.997 R² .. 0.999 R²)
+mean                 27.92 ns   (27.58 ns .. 28.38 ns)
+std dev              1.320 ns   (1.010 ns .. 1.940 ns)
+variance introduced by outliers: 70% (severely inflated)
+
+benchmarking insert check set
+time                 127.9 ns   (127.4 ns .. 128.4 ns)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 127.1 ns   (126.7 ns .. 127.6 ns)
+std dev              1.515 ns   (1.162 ns .. 2.043 ns)
+variance introduced by outliers: 12% (moderately inflated)
+
+benchmarking insert check set
+time                 112.8 ns   (112.4 ns .. 113.3 ns)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 112.6 ns   (112.0 ns .. 113.4 ns)
+std dev              2.414 ns   (1.889 ns .. 3.151 ns)
+variance introduced by outliers: 30% (moderately inflated)
+
+benchmarking union check set
+time                 655.5 μs   (652.0 μs .. 658.8 μs)
+                     1.000 R²   (0.999 R² .. 1.000 R²)
+mean                 638.7 μs   (634.2 μs .. 642.7 μs)
+std dev              15.07 μs   (12.96 μs .. 18.02 μs)
+variance introduced by outliers: 14% (moderately inflated)
+
+benchmarking union check set
+time                 428.9 μs   (423.5 μs .. 433.8 μs)
+                     0.999 R²   (0.999 R² .. 0.999 R²)
+mean                 422.6 μs   (419.7 μs .. 425.9 μs)
+std dev              10.16 μs   (8.544 μs .. 12.44 μs)
+variance introduced by outliers: 15% (moderately inflated)
+```
+
+## 28.9 Excercises: Vector
+
+see [src/benchVector.hs](./src/benchVector.hs)
+
+Using unboxed vector has better time performance. I tried measuring space,
+but the difference is almost negligable.
+
+## 28.10 Chaper Exercises
+
+### Difference List
+
+see [src/DiffList.hs](./src/DiffList.hs)
+
+It is not actually faster, but it has the same performance as Data.DList and
+the same implementation, so I guess this is to be expected?
+
+### A simple queue
+
+see [src/SimpleQueue.hs](./src/SimpleQueue.hs)
+
+Comparing Sequence and Queue seems a bit strange as they serve different
+purposes. I could implement a function to add something to the back of the
+queue (similar to |>) but that kinda defeats the purpose of queue... I compared
+them based on what a queue should be capable of doing and it seem the queue
+is better than the sequence in these cases.

28-basic-libraries/src/DiffList.hs

@@ -0,0 +1,61 @@
+module Main where
+
+import Criterion.Main
+
+-- import qualified Data.DList as DL
+
+newtype DList a = DL { unDL :: [a] -> [a] }
+
+-- 1
+empty :: DList a
+empty = DL id
+{-# INLINE empty #-}
+
+-- 2
+singleton :: a -> DList a
+singleton = DL . (:)
+{-# INLINE singleton #-}
+
+-- 3
+toList :: DList a -> [a]
+toList dl = unDL dl []
+{-# INLINE toList #-}
+
+-- 4
+infixr `cons`
+cons :: a -> DList a -> DList a
+cons x xs = DL ((x:) . unDL xs)
+{-# INLINE cons #-}
+
+-- 5
+infixl `snoc`
+snoc :: DList a -> a -> DList a
+snoc xs x = DL $ ((unDL xs) . (x:))
+{-# INLINE snoc #-}
+
+-- 6
+append :: DList a -> DList a -> DList a
+append d d' = DL $ (unDL d . unDL d')
+{-# INLINE append #-}
+
+schlemiel :: Int -> [Int]
+schlemiel i = go i []
+    where go 0 xs = xs
+          go n xs = go (n - 1) ([n] ++ xs)
+
+constructDList :: Int -> [Int]
+constructDList i = toList $ go i empty
+    where go 0 xs = xs
+          go n xs = go (n - 1) (singleton n `append` xs)
+
+-- constructDList' :: Int -> [Int]
+-- constructDList' i = DL.toList $ go i DL.empty
+--     where go 0 xs = xs
+--           go n xs = go (n - 1) (DL.singleton n `DL.append` xs)
+
+main :: IO ()
+main = defaultMain
+    [ bench "concat list" $ whnf schlemiel 123456
+    , bench "concat dlist" $ whnf constructDList 123456
+    -- , bench "concat dlist'" $ whnf constructDList' 123456
+    ]

28-basic-libraries/src/SimpleQueue.hs

@@ -0,0 +1,106 @@
+module Main where
+
+import Criterion.Main
+import qualified Data.Sequence as S
+
+data Queue a = Queue { enqueue :: [a]
+                     , dequeue :: [a]
+                     } deriving (Show, Eq)
+
+empty :: Queue a
+empty = Queue [] []
+
+push :: a -> Queue a -> Queue a
+push a q = q { enqueue = a : enqueue q}
+
+pop :: Queue a -> Maybe (a, Queue a)
+pop (Queue [] []) = Nothing
+pop (Queue xs []) = pop $ Queue [] (reverse xs)
+pop (Queue xs (y:ys)) = Just (y, Queue xs ys)
+
+alternateQ :: [Int] -> Bool
+alternateQ [] = True
+alternateQ (x:xs) = go x empty && alternateQ xs
+    where go y q = f (pop $ push y q) y
+          f Nothing _ = False
+          f (Just (a, _)) b = a == b
+
+pushL :: a -> [a] -> [a]
+pushL = (:)
+
+popL :: [a] -> Maybe (a, [a])
+popL [] = Nothing
+popL xs = let xs' = reverse xs
+          in Just (head $ xs', reverse $ tail xs')
+
+alternateL :: [Int] -> Bool
+alternateL [] = True
+alternateL (x:xs) = go x [] && alternateL xs
+    where go y q = f (popL $ pushL y q) y
+          f Nothing _ = False
+          f (Just (a, _)) b = a == b
+
+pushThenPop :: [Int] -> [Int]
+pushThenPop xs = (go' $ go xs empty)
+    where go [] q = q
+          go (y:ys) q = go ys (push y q)
+          go' q = let r = pop q
+                  in case r of
+                    Nothing -> []
+                    (Just (a, q')) -> a : go' q'
+
+pushThenPopL :: [Int] -> [Int]
+pushThenPopL xs = (go' $ go xs [])
+    where go [] q = q
+          go (y:ys) q = go ys (pushL y q)
+          go' q = let r = popL q
+                  in case r of
+                    Nothing -> []
+                    (Just (a, q')) -> a : go' q'
+
+--
+fromList :: [a] -> Queue a
+fromList = flip Queue []
+
+fromList' :: [a] -> Queue a
+fromList' = Queue [] . reverse
+
+(><) :: Queue a -> Queue a -> Queue a
+(><) (Queue e d) (Queue e' d') = Queue [] q''
+    where q'' = d ++ reverse e ++ d' ++ reverse e'
+
+testConcat :: [Int] -> Queue Int
+testConcat xs = fromList xs >< fromList xs
+
+testConcat' :: [Int] -> S.Seq Int
+testConcat' xs = S.fromList xs S.>< S.fromList xs
+
+pushA :: [Int] -> Queue Int
+pushA xs = go xs empty
+    where go [] q = q
+          go (x:xs) q = go xs $ push x q
+
+pushA' :: [Int] -> S.Seq Int
+pushA' xs = go xs S.empty
+    where go [] s = s
+          go (x:xs) s = go xs $ x S.<| s
+
+main :: IO ()
+main = defaultMain
+    -- List will be faster because it has no overehead for Queue construction
+    -- and queue still needs to reverse for every element just as list.
+    [ bench "queue" $ nf alternateQ [1..1000]
+    , bench "list" $ nf alternateL [1..1000]
+    -- List will be slower than queue, because it needs to reverse for every
+    -- element, while queue only reverse on empty dequeue.
+    , bench "queue push pop" $ nf pushThenPop [1..1000]
+    , bench "list push pop" $ nf pushThenPopL [1..1000]
+    -- Queue is quite efficient at what it is good at:
+    , bench "queue fromList" $ whnf fromList ([1..1000] :: [Int])
+    , bench "queue fromList'" $ whnf fromList' ([1..1000] :: [Int])
+    , bench "sequence fromList" $ whnf S.fromList ([1..1000] :: [Int])
+    , bench "queue concat" $ whnf testConcat ([1..100] :: [Int])
+    , bench "sequence concat" $ whnf testConcat' ([1..100] :: [Int])
+    , bench "insert queue" $ whnf pushA [1..1000]
+    , bench "insert sequence" $ whnf pushA' [1..1000]
+    ]

28-basic-libraries/src/StringMemory.hs

@@ -0,0 +1,23 @@
+module Main where
+
+import Control.Monad
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import qualified System.IO as SIO
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TLIO
+
+dictWords :: IO String
+dictWords = SIO.readFile "/usr/share/dict/words"
+
+dictWordsT :: IO T.Text
+dictWordsT = TIO.readFile "/usr/share/dict/words"
+
+dictWordsTL :: IO TL.Text
+dictWordsTL = TLIO.readFile "/usr/share/dict/words"
+
+main :: IO ()
+main = do
+    replicateM_ 1000 (dictWords >>= print)
+    replicateM_ 1000 (dictWordsT >>= TIO.putStrLn)
+    replicateM_ 1000 (dictWordsTL >>= TLIO.putStrLn)

28-basic-libraries/src/benchSet.hs

@@ -0,0 +1,52 @@
+module Main where
+
+import Criterion.Main
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+bumpIt :: (Num a, Num b) => (a, b) -> (a, b)
+bumpIt (i, v) = (i + 1, v + 1)
+
+m :: M.Map Int Int
+m = M.fromList $ take 10000 stream
+    where stream = iterate bumpIt (0, 0)
+
+s :: S.Set Int
+s = S.fromList $ take 10000 stream
+    where stream = iterate (+1) 0
+
+membersMap :: Int -> Bool
+membersMap i = M.member i m
+
+membersSet :: Int -> Bool
+membersSet i = S.member i s
+
+insertMap :: (Int, Int) -> M.Map Int Int
+insertMap (k, v) = M.insert k v m
+
+insertSet :: Int -> S.Set Int
+insertSet k = S.insert k s
+
+m1 :: M.Map Int Int
+m1 = M.fromList $ take 5000 stream
+    where stream = iterate (bumpIt . bumpIt) (0, 0)
+m2 :: M.Map Int Int
+m2 = M.fromList $ take 5000 stream
+    where stream = iterate (bumpIt . bumpIt) (1, 1)
+
+s1 :: S.Set Int
+s1 = S.fromList $ take 5000 stream
+    where stream = iterate (+2) 0
+s2 :: S.Set Int
+s2 = S.fromList $ take 5000 stream
+    where stream = iterate (+2) 1
+
+main :: IO ()
+main = defaultMain
+    [ bench "member check map" $ whnf (membersMap) 9999
+    , bench "member check set" $ whnf (membersSet) 9999
+    , bench "insert check set" $ whnf (insertMap) (10001, 10001)
+    , bench "insert check set" $ whnf (insertSet) 100001
+    , bench "union check set" $ whnf (M.union m1) m2
+    , bench "union check set" $ whnf (S.union s1) s2
+    ]

28-basic-libraries/src/benchVector.hs

@@ -0,0 +1,24 @@
+module Main where
+
+import Criterion.Main
+import qualified Data.Vector as BV
+import qualified Data.Vector.Unboxed as UV
+
+import Control.Monad
+
+total :: Int
+total = 10^6
+
+boxed :: BV.Vector Bool
+boxed = BV.fromList $ replicate total True
+
+unboxed :: UV.Vector Bool
+unboxed = UV.fromList $ replicate total True
+
+main :: IO ()
+main =
+    defaultMain
+    [
+        bench "any boxed"   $ whnf (BV.and) boxed,
+        bench "any unboxed" $ whnf (UV.and) unboxed
+    ]