folds.py

.gitignore

*.swp

*.o
*.hi
*.txt

rwh??

folds.py

#!/usr/bin/env python2.7

head = lambda xs: xs[0]
tail = lambda xs: xs[1:]

def map1(f, xs):
    if not xs:
        return []
    else:
        return [f(head(xs))] + map1(f, tail(xs))

def filter1(p, xs):
    if not xs:
        return []
    elif p(head(xs)):
        return [head(xs)] + filter1(p, tail(xs))
    else:
        return filter1(p, tail(xs))

def foldl(f, a, xs):
    if not xs:
        return a
    else:
        return foldl(f, f(a, head(xs)), tail(xs))

def foldr(f, a, xs):
    if not xs:
        return a
    else:
        return f(head(xs), foldr(f, a, tail(xs)))

reduce1 = foldl

def map2(f, xs):
    return foldr(lambda x, a: [f(x)]+a, [], xs)

def filter2(p, xs):
    return foldr(lambda x, a: [x]+a if p(x) else a, [], xs)

def reduce2(f, a, xs):
    return foldr(lambda x, a: f(a, x), a, xs)

assert map1(lambda x: x*x, range(1, 6)) == [1, 4, 9, 16, 25]
assert filter1(lambda x: x&1, range(1, 6)) == [1, 3, 5]
assert reduce1(lambda a, x: a/x, 120, range(1, 6)) == 1
assert reduce1(lambda a, x: a+x,   0, range(1, 6)) == 15
assert reduce1(lambda a, x: a*x,   1, range(1, 6)) == 120

assert foldr(lambda x, a: a/x, 120, range(1, 6)) == 1
assert foldr(lambda x, a: x+a,   0, range(1, 6)) == 15
assert foldr(lambda x, a: x*a,   1, range(1, 6)) == 120

assert map2(lambda x: x*x, range(1, 6)) == [1, 4, 9, 16, 25]
assert filter2(lambda x: x&1, range(1, 6)) == [1, 3, 5]
assert reduce2(lambda a, x: a/x, 120, range(1, 6)) == 1
assert reduce2(lambda a, x: a+x,   0, range(1, 6)) == 15
assert reduce2(lambda a, x: a*x,   1, range(1, 6)) == 120

Makefile

tests: \
	.folds.py.txt \
	.rwh00.txt \
	.rwh01.txt \
	.rwh02.txt \
	.rwh03.txt

all-tests: tests \
	.RWH00.hs.txt \
	.RWH01.hs.txt \
	.RWH02.hs.txt \
	.RWH03.hs.txt

rwh00: RWH00.hs
	ghc -dynamic -main-is RWH00 -package HUnit -o $@ -O1 $?

rwh01: RWH01.hs
	ghc -dynamic -main-is RWH01 -package HUnit -o $@ -O1 $?

rwh02: RWH02.hs
	ghc -dynamic -main-is RWH02 -package HUnit -o $@ -O1 $? -fprint-potential-instances

rwh03: RWH03.hs
	ghc -dynamic -main-is RWH03 -package HUnit -o $@ -O1 $?

.%.txt: %
	./$< |& tee $@

clean:
	@rm -fv *.o
	@rm -fv *.hi
	@rm -fv .*.txt
	@rm -fv rwh??

RWH00.hs

#!/usr/bin/env runhaskell
module RWH00 (add, fac, fib, main) where

import Test.HUnit

add :: Int -> Int -> Int
add a b = a + b

fac :: Integer -> Integer
fac n = foldr (*) 1 [1..n]

fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

main :: IO Counts
main = do
    runTestTT $ test [
        "add tests" ~: test [ 5 ~=? (add 2 3),
                              7 ~=? (add 3 4),
                              9 ~=? (add 4 5) ],
        "fac tests" ~: test [ 120 ~=? (fac 5),
                              720 ~=? (fac 6) ],
        "fib tests" ~: test [ 2 ~=? (fib 2) ] ]

RWH01.hs

#!/usr/bin/env runhaskell
module RWH01 (main) where

-- pg 16

import Test.HUnit

lineCount :: String -> Int
lineCount bytes = length $ lines bytes

wordCount :: String -> Int
wordCount bytes = sum $ map (length . words) $ lines bytes

byteCount :: String -> Int
byteCount = length

main :: IO Counts
main = do
    runTestTT $ test [
        "lineCount tests" ~: test [
            3 ~=? (lineCount "foo\nbar\nquux\n")
        ],
        "wordCount tests" ~: test [ 
            5 ~=? (wordCount "foo bar\nquux spam\nalbatross\n")
        ],
        "byteCount tests" ~: test [
            14 ~=? (byteCount "Hello, world!\n")
        ] ]
            

RWH02.hs

#!/usr/bin/env runhaskell
module RWH02 (main) where

{- RWH pg 39
   and http://www.randomhacks.net.s3-website-us-east-1.amazonaws.com/2007/03/10/haskell-8-ways-to-report-errors/
   and https://stackoverflow.com/revisions/6147930/2 ...
   and https://stackoverflow.com/a/6009807/424131 -}

import Control.Exception
import Test.HUnit

last' :: [a] -> a
last' [] = error "last': empty list"
last' (x:xs) | null xs   = x
             | otherwise = last' xs

secondLast :: [a] -> a
secondLast (x1:x2:xs) | null xs   = x1
                      | otherwise = secondLast (x2:xs)
secondLast _ = error "secondLast: list too short"

main :: IO Counts
main = do
    runTestTT $ test [
        "last tests" ~: test [
            test $ do { result <- try $ evaluate $ last' [] :: IO (Either ErrorCall Int)
                      ; case result of
                            Left ex -> return ()
                            Right v -> assertFailure ("expected ErrorCall exception, not " ++ show v)
                      },
            13 ~=? (last' [13]),
            13 ~=? (last' [1, 4, 13])
        ],
        "secondLast tests" ~: test [
            test $ do { result <- try $ evaluate $ secondLast [] :: IO (Either ErrorCall Int)
                      ; case result of
                            Left ex -> return ()
                            Right v -> assertFailure ("expected ErrorCall exception, not " ++ show v)
                      },
            test $ do { result <- try $ evaluate $ secondLast [1] :: IO (Either ErrorCall Int)
                      ; case result of
                            Left ex -> return ()
                            Right v -> assertFailure ("expected ErrorCall exception, not " ++ show v)
                      },
            1 ~=? (secondLast [1, 2]),
            2 ~=? (secondLast [1, 2, 3]),
            3 ~=? (secondLast [1, 2, 3, 4]),
            4 ~=? (secondLast [1, 2, 3, 4, 5])
        ] ]

RWH03.hs

#!/usr/bin/env runhaskell
module RWH03 (main) where

{- RWH ch03 pg60 pg69 pg70 -}

import Data.List (sortBy)
import Control.Exception
import Test.HUnit

data List a = Cons a (List a)
            | Nil
    deriving (Show, Eq)

data Tree a = Node a (Tree a) (Tree a)
            | Empty
    deriving (Show)

data MTree a = MNode a (Maybe (MTree a)) (Maybe (MTree a))
    deriving (Show, Eq)

data Direction = CCW | CL | CW
    deriving (Eq, Show)

fromList :: [a] -> List a
fromList (x:xs) = Cons x $ fromList xs
fromList []     = Nil

toList :: List a -> [a]
toList (Cons x xs) = x : toList xs
toList Nil         = []

listMean :: [Float] -> Float
listMean [] = error "listMean: empty list"
listMean xs = (sum xs) / (fromIntegral $ length xs)

myLength :: [a] -> Int
myLength []     = 0
myLength (_:xs) = 1 + myLength xs

makePalindrome :: [a] -> [a]
makePalindrome xs = xs ++ sx
    where sx = reverse xs

isPalindrome :: (Eq a) => [a] -> Bool
isPalindrome xs = xs == sx
    where sx = reverse xs

sortByLength :: [[a]] -> [[a]]
sortByLength xs = sortBy compareLengths xs
    where compareLengths xs ys = compare (length xs) (length ys)

intersperse :: a -> [[a]] -> [a]
intersperse sep []     = []
intersperse sep (x:xs) | null xs   = x
                       | otherwise = x ++ [sep] ++ (intersperse sep xs)

treeDepth :: Tree a -> Int
treeDepth Empty = 0
treeDepth (Node _ left right) = 1 + (max (treeDepth left) (treeDepth right))

direction :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Direction
direction (x1, y1) (x2, y2) (x3, y3) | crossProduct > 0 = CCW
                                     | crossProduct < 0 = CW
                                     | otherwise        = CL
    where crossProduct = (x2-x1) * (y3-y1) - (y2-y1) * (x3-x1)

directions :: [(Int, Int)] -> [Direction]
directions xs = zipWith3 direction xs ys zs
    where ys = tail xs
          zs = tail ys

main :: IO Counts
main = do
    runTestTT $ test [ "fromList"       ~: [ (Cons 1 (Cons 2 Nil)) ~=? (fromList [1, 2]) ]
                     , "toList"         ~: [ [1, 2] ~=? (toList (Cons 1 (Cons 2 Nil))) ]
                     , "myLength"       ~: [ 0 ~=? (myLength [])
                                           , 3 ~=? (myLength [1..3])
                                           ]
                     , "listMean"       ~: [ test $ do { result <- try $ evaluate $ listMean [] :: IO (Either ErrorCall Float)
                                                       ; case result of
                                                           Left ex -> return ()
                                                           Right v -> assertFailure ("expected ErrorCall exception, not " ++ show v)
                                                       }
                                           , 2.0 ~=? (listMean [1..3])
                                           , 5.5 ~=? (listMean [1..10])
                                           ]
                     , "makePalindrome" ~: [ [1,2,3,3,2,1] ~=? (makePalindrome [1..3]) ]
                     , "isPalindrome"   ~: [ True ~=? (isPalindrome [1,2,3,3,2,1])
                                           , False ~=? (isPalindrome [1..16])
                                           ]
                     , "sortByLength"   ~: [ [[1], [1,2], [1,2,3]] ~=? (sortByLength [[1,2],[1],[1,2,3]]) ]
                     , "intersperse"    ~: [ [1,0,2,0,3] ~=? (intersperse 0 [[1],[2],[3]])
                                           , "" ~=? (intersperse ',' [])
                                           , "foo" ~=? (intersperse ',' ["foo"])
                                           , "foo,bar,baz,quux" ~=? (intersperse ',' ["foo","bar","baz","quux"])
                                           ]
                     , "treeDepth"      ~: [ 0 ~=? (treeDepth Empty)
                                           , 1 ~=? (treeDepth (Node 1 Empty Empty))
                                           , 2 ~=? (treeDepth (Node 2 (Node 1 Empty Empty) Empty))
                                           ]
                     , "direction"      ~: [ CCW ~=? (direction (0, 0) (1, 1) (0, 1))
                                           , CL  ~=? (direction (0, 0) (1, 1) (2, 2))
                                           , CW  ~=? (direction (0, 0) (1, 1) (1, 0))
                                           ]
                     , "directions"     ~: [ [CCW, CL, CW] ~=? (directions [(0,0), (1,1), (1,2), (1,3), (2,4)])
                                           ]
                     ]