Add solutions to the basic libraries chapter and introduce benchmark

suites

Author: BoeingX

README.md

@@ -3,9 +3,6 @@
 [![CircleCI](https://circleci.com/gh/BoeingX/haskell-programming-from-first-principles/tree/master.svg?style=svg)](https://circleci.com/gh/BoeingX/haskell-programming-from-first-principles/tree/master)
 [![License](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause)
 
-
-**Disclaimer: this is an on-going project and is subject to frequent changes.**
-
 This repository hosts my notes and solutions to exercises in the book
 [Haskell Programming from First Principles](http://haskellbook.com/).
 
@@ -16,17 +13,28 @@ Once setup, Stack takes care of any Haskell package dependencies.
 
 ## Project structure
 
-This repository is organized as a single Stack project.
-Exercise(s) solutions can be found at
-```bash
-src/<chapter name>/<section name>/<exercise name>.hs
+This repository is organized as a single Stack project as follows
 ```
-Companion test suites (if available) can be found at
-```bash
-test/<chapter name>/<section name>/<exercise name>Spec.hs
+.
+├── benchmark/
+├── ChangeLog.md
+├── haskell-programming-from-first-principles.cabal
+├── LICENSE
+├── package.yaml
+├── README.md
+├── Setup.hs
+├── src/
+├── stack.yaml
+└── test/
+```
+where `[src](./src)` are solutions whose name follows the pattern
+```
+ChapterName/SectionName/ExerciseName.hs
 ```
+[test](./test/) and [benchmark](./benchmark) are test and benchmark suites following
+the same naming convention.
 
-## Run test
+## Run tests
 
 All test suites can be discovered by `hspec-discover`. To run tests, simply do
 
@@ -39,4 +47,14 @@ stack --fast test
 ```
 if you want avoid GHC optimization (hence faster).
 
-## Troubleshooting
+## Run benchmarks
+
+Run
+
+```bash
+stack bench
+```
+
+> **Never** use the `--fast` flag for benchmarks otherwise you will get **wrong** results.
+
+Reference benchmark results are included in each benchmark file as block comment.

benchmark/BasicLibraries/ChapterExercises/DifferenceListBenchmark.hs

@@ -0,0 +1,39 @@
+module BasicLibraries.ChapterExercises.DifferenceListBenchmark (
+    benchmarks
+) where
+
+import Criterion
+import BasicLibraries.ChapterExercises.DifferenceList
+
+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)
+
+benchmarks :: [Benchmark]
+benchmarks = 
+    [ bench "concat list" $ whnf schlemiel 123456
+    , bench "concat dlist" $ whnf constructDlist 123456
+    ]
+
+{- Reference benchmark results
+
+benchmarking Difference List/concat list
+time                 35.99 ms   (32.95 ms .. 42.01 ms)
+                     0.942 R²   (0.873 R² .. 0.993 R²)
+mean                 38.50 ms   (36.79 ms .. 41.26 ms)
+std dev              4.482 ms   (3.416 ms .. 5.551 ms)
+variance introduced by outliers: 45% (moderately inflated)
+
+benchmarking Difference List/concat dlist
+time                 217.9 μs   (211.2 μs .. 225.5 μs)
+                     0.990 R²   (0.984 R² .. 0.996 R²)
+mean                 217.9 μs   (213.2 μs .. 224.9 μs)
+std dev              19.38 μs   (15.17 μs .. 23.67 μs)
+variance introduced by outliers: 75% (severely inflated)
+-}

benchmark/BasicLibraries/ChapterExercises/QueueBenchmark.hs

@@ -0,0 +1,58 @@
+module BasicLibraries.ChapterExercises.QueueBenchmark (
+    benchmarks
+) where
+
+import Criterion
+import Data.Sequence
+import BasicLibraries.ChapterExercises.Queue
+
+listQueueBench :: Int -> [Int]
+listQueueBench n = foldr go [] [1..2*n]
+    where go x acc
+            | even x = x : acc
+            | otherwise = init acc
+
+queueBench :: Int -> Queue Int
+queueBench n = foldr go initQueue [1..2*n]
+    where initQueue = Queue [] []
+          go x acc
+            | even x = push x acc
+            | otherwise = let Just (_, acc') = pop acc in acc'
+
+sequenceBench :: Int -> Seq Int
+sequenceBench n = foldr go empty [1..2*n]
+    where go x acc
+            | even x = x <| acc
+            | otherwise = let acc' :> _ = viewr acc in acc'
+
+benchmarks :: [Benchmark]
+benchmarks = 
+    [ bench "list queue" $ nf listQueueBench 123456
+    , bench "queue" $ whnf queueBench 123456
+    , bench "sequence" $ whnf sequenceBench 123456
+    ]
+
+{- Reference benchmark results
+
+benchmarking Queue/list queue
+time                 27.27 ms   (26.40 ms .. 27.86 ms)
+                     0.996 R²   (0.991 R² .. 0.999 R²)
+mean                 27.70 ms   (27.21 ms .. 28.66 ms)
+std dev              1.439 ms   (768.4 μs .. 2.317 ms)
+variance introduced by outliers: 16% (moderately inflated)
+
+benchmarking Queue/queue
+time                 10.75 ms   (10.51 ms .. 11.01 ms)
+                     0.996 R²   (0.993 R² .. 0.998 R²)
+mean                 10.98 ms   (10.83 ms .. 11.27 ms)
+std dev              545.3 μs   (329.6 μs .. 914.8 μs)
+variance introduced by outliers: 23% (moderately inflated)
+
+benchmarking Queue/sequence
+time                 7.768 ms   (7.597 ms .. 7.926 ms)
+                     0.996 R²   (0.993 R² .. 0.999 R²)
+mean                 8.119 ms   (7.932 ms .. 8.509 ms)
+std dev              719.3 μs   (393.4 μs .. 1.096 ms)
+variance introduced by outliers: 51% (severely inflated)
+
+-}

benchmark/Main.hs

@@ -0,0 +1,13 @@
+module Main where
+
+import Criterion.Main
+
+import qualified BasicLibraries.ChapterExercises.DifferenceListBenchmark
+import qualified BasicLibraries.ChapterExercises.QueueBenchmark
+
+main :: IO ()
+main = defaultMain
+     [
+       bgroup "Difference List" BasicLibraries.ChapterExercises.DifferenceListBenchmark.benchmarks
+     , bgroup "Queue" BasicLibraries.ChapterExercises.QueueBenchmark.benchmarks
+     ]

package.yaml

@@ -40,6 +40,21 @@ dependencies:
 library:
   source-dirs: src
 
+benchmarks:
+  haskell-programming-from-first-principles-benchmark:
+    dependencies:
+      - base
+      - criterion
+    ghc-options:
+      - -O2
+      - -rtsopts
+      - -threaded
+      - -with-rtsopts=-N
+    main: Main.hs
+    source-dirs: 
+      - src
+      - benchmark
+
 tests:
   haskell-programming-from-first-principles-test:
     main:                Spec.hs

src/BasicLibraries/ChapterExercises/DifferenceList.hs

@@ -0,0 +1,32 @@
+module BasicLibraries.ChapterExercises.DifferenceList where
+
+newtype DList a = DL { unDL :: [a] -> [a] }
+
+empty :: DList a
+empty = DL id
+{-# INLINE empty #-}
+
+singleton :: a -> DList a
+singleton a = DL $ const [a]
+{-# INLINE singleton #-}
+
+toList :: DList a -> [a]
+toList xs = unDL xs []
+{-# INLINE toList #-}
+
+-- Prepend a single element to a dlist.
+infixr `cons`
+cons :: a -> DList a -> DList a
+cons x xs = DL ((x:) . unDL xs)
+{-# INLINE cons #-}
+
+-- Append a single element to a dlist.
+infixl `snoc`
+snoc :: DList a -> a -> DList a
+snoc xs x = DL (unDL xs . (x:))
+{-# INLINE snoc #-}
+
+-- Append dlists.
+append :: DList a -> DList a -> DList a
+append xs ys = DL $ unDL xs . unDL ys
+{-# INLINE append #-}

src/BasicLibraries/ChapterExercises/Queue.hs

@@ -0,0 +1,18 @@
+module BasicLibraries.ChapterExercises.Queue where
+
+-- From Okasaki's Purely Functional Data Structures
+data Queue a =
+    Queue { enqueue :: [a]
+          , dequeue :: [a]
+    } deriving (Eq, Show)
+
+-- adds an item
+push :: a -> Queue a -> Queue a
+push x (Queue [] []) = Queue [] [x]
+push x (Queue xs ys) = Queue (x : xs) ys
+
+pop :: Queue a -> Maybe (a, Queue a)
+pop (Queue [] []) = Nothing
+pop (Queue xs []) = Just (y, Queue [] ys)
+    where (y : ys) = reverse xs
+pop (Queue xs (y : ys)) = Just (y, Queue xs ys)