HigherOrder.hs

{-# LANGUAGE DeriveFoldable #-}
module HigherOrder where

import Prelude hiding (sum, product, map, filter)
--import Data.List (unfoldr)

type Lookup key value = key -> Maybe value

nada :: Lookup k v
nada _ = Nothing

abc :: Num v => Lookup String v
abc "a" = Just 1
abc "b" = Just 2
abc "c" = Just 3
abc _   = Nothing


put :: Eq k => k -> v -> Lookup k v -> Lookup k v
put k v lookup = 
    \key -> if key == k 
            then Just v 
            else lookup key

--
sum :: Num a => [a] -> a
sum []     = 0
sum (x:xs) = x + sum xs

product :: Num a => [a] -> a
product []     = 1
product (x:xs) = x * product xs

map :: (a -> b) -> [a] -> [b]
map _ []     = []
map f (x:xs) = f x : map f xs 

filter :: (a -> Bool) -> [a] -> [a]
filter _ [] = []
filter p (x:xs) = if p x then x : filter p xs else filter p xs

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr fn z []     = z
foldr fn z (x:xs) = fn x y 
    where y = HigherOrder.foldr fn z xs

sum' :: Num a => [a] -> a
sum' = HigherOrder.foldr (+) 0

product' :: Num a => [a] -> a
product' = HigherOrder.foldr (*) 1

map' :: (a -> b) -> [a] -> [b]
map' f = HigherOrder.foldr ((:) . f) []

filter' :: (a -> Bool) -> [a] -> [a]
filter' p = HigherOrder.foldr (\x xs -> if p x then x : xs else xs) []

data Tree a = Leaf
            | Node a (Tree a) (Tree a) deriving (Foldable)

sumTree :: Num a => Tree a -> a
sumTree Leaf = 0
sumTree (Node x l r) = x + sumTree l + sumTree r

productTree :: Num a => Tree a -> a
productTree Leaf = 1
productTree (Node x l r) = x * sumTree l * sumTree r

foldTree :: (a -> b -> b) -> b -> Tree a -> b
foldTree f z Leaf = z
foldTree f z (Node a left right) = foldTree f z' left where
   z'  = f a z''
   z'' = foldTree f z right

sumTree' = foldTree (+) 0
productTree' = foldTree (*) 1


unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr f u = case f u of
    Nothing     -> []
    Just (x, v) -> x:(unfoldr f v)


fact = Prelude.foldr (*) 1 . unfoldr (\n -> if n ==0 then Nothing else Just (n, n-1))

fibs = unfoldr (\(a, b) -> Just (a, (b, a + b))) (0, 1)

bubble :: Ord a => [a] -> Maybe (a, [a])
bubble = Prelude.foldr step Nothing where
    step x Nothing = Just (x, [])
    step x (Just (y, ys))
        | x < y     = Just (x, y:ys)
        | otherwise = Just (y, x:ys)

bubbleSort :: Ord a => [a] -> [a]
bubbleSort = unfoldr bubble


higherOrderDemo :: IO ()
higherOrderDemo = do
    putStrLn "higher order functions"
    let get   = put "a" 1 (const Nothing)
        get'  = put "b" 2 get
        get'' = put "c" 3 get'
    print $ get'' "a"
    print $ get'' "b"
    print $ get'' "c"
    print $ get'' "d"

    print $ sum' [1..10]
    print $ product' [1..10]
    print $ map' (*2) [1..10]
    print $ filter' even [1..10]

    let tree = Node 2 (Node 3 Leaf Leaf) (Node 4 Leaf Leaf)
    print $ sumTree tree
    print $ sumTree' tree
    print $ Prelude.foldr (+) 0 tree

    print $ productTree tree
    print $ productTree' tree
    print $ Prelude.foldr (*) 1 tree


    print $ unfoldr (\n -> if n==0 then Nothing else Just (n, n-1)) 10
    print $ fact 10
    print $ take 20 fibs
    print $ bubbleSort [34,13,0,144,1,4181,2,2584,1,377,55,233,3,987,89,610,1597,21,5,8]