FB Monoid

monoid.hs

--
-- Functional Brighton, LYAHFGG Monoids
-- https://www.meetup.com/Functional-Brighton/events/239127334/
-- 

{-

 About Monoids:

 Needs a binary function:
 - The function takes two parameters.
 - The parameters and the returned value have  the same type.

 Also:
 There exists such a value that doesn't change
 other values when used with the binary function. 
 
 -}

-- "empty" / "identity"
-- Examples:

1 + 0 == 1
7 * 1 == 7
[1,2,3] ++ [] == [1,2,3]

{-
  
 So a monoid is a operation and an empty value:

 Add:  +   , 0
 Mult: *   , 1
 Lists: ++ , []
 -}

-- binary function, "append", associativity
-- mappend :: a -> a -> a

-- All produce: [1,2,3,4]
mappend [1,2] [3,4]
[1,2] `mappend` [3,4]

import Data.Monoid
[1,2] <> [3,4]

-- Produces []
mempty :: [a]

{- regarding applying the function repeatedly, 
   the order in which we apply the binary function 
   to the values doesn't matter. -}

-- mappend mempty x = x
-- mappend x mempty = x

-- mappend x (mappend y z) = mappend (mappend x y) z

3 * (5 * 7) == (3 * 5) * 7

{- Haskell doesn't enforce these laws, 
   so we as the programmer have to be careful
   that our instances do indeed obey them.  -}


-- List are monoids

-- Numbers are a bit tricky. There are multiple possible monoids.
-- E.g., + and *
-- BUT...here can only be one type class instance for a type.

-- The solution is have a wapper type to distinguish between them.
-- Product and Sum in Data.Monoid
-- 

getProduct $ (Product 5) <> 2 -- 10
getProduct $ 3 <> (Product 5) -- 15

-- We were surprised we were able to do this:
getProduct $ 4 <> 5  -- 20
(Product 5) <> 2 -- Product {getProduct = 10}
3 <> (Product 5) -- Product {getProduct = 15}

-- But not...
-- getProduct $ 1.0 <> 2.0

getSum ((Sum 3) <> (Sum 5)) -- 8

-- Boolean Any and All

getAny $ (Any True) <> (Any False) -- True
getAll $ (All True) <> (All False) -- False

-- Maybe and First Maybe

-- Interesting! Maybe has a default monoid:
(Just "a") <> (Just "b") -- Just "ab"
"a" <> "b" -- "ab"

-- An alternative via First:
getFirst $ (First (Just "a")) <> (First (Just "b")) -- Just "a"
getFirst $ (First (Nothing)) <> (First (Just "b")) -- Just "b"

--
-- Functions are monoids
--

import Data.List -- for intersperse

reverse <> (intersperse '-') $ "ABC"
-- "CBAA-B-C"

reverse "ABC" -- "CBA"
intersperse '-' "ABC" -- "A-B-C"

"CBA" <> "A-B-C" -- "CBAA-B-C"

{-
 class Monoid a where
        mempty  :: a
        mappend :: a -> a -> a
        mconcat :: [a] -> a
 -}

{-
 instance Monoid b => Monoid (a -> b) where
        mempty _ = mempty
        mappend f g = \x = f x `mappend` g x
 -}


--
-- The Tree example from the book
--

data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show, Read, Eq) 

testTree = Node 5  
            (Node 3  
                (Node 1 Empty Empty)  
                (Node 6 Empty Empty)  
            )  
            (Node 9  
                (Node 8 Empty Empty)  
                (Node 10 Empty Empty)  
            )

-- We tried out a few folds
F.foldl (+) 0 testTree 
-- 42

F.foldl (\x y -> x + 1) 0 testTree 
-- 7 (a node value, plus 1)


F.foldMap (\x -> [x]) testTree 
-- [5,3,1,6,9]

import Data.Monoid
getSum $ F.foldMap Sum testTree 
-- 42

F.foldMap (Sum . negate) testTree
-- Sum {getSum = -42}

F.foldMap show testTree
-- "53169810"


--
-- Exercise
--
-- Implement Xor monoid
--

xor :: Bool -> Bool -> Bool
xor True a = not a
xor False a = a

newtype Xor = Xor { getXor :: Bool }
 deriving (Eq, Show)

instance Monoid Xor where
   mempty = Xor False
   Xor x `mappend` Xor y = Xor (x `xor` y)
   
(Xor False) <> (Xor False) == (Xor False)
(Xor True)  <> (Xor False) == (Xor True)
(Xor False) <> (Xor True)  == (Xor True)
(Xor True)  <> (Xor True)  == (Xor False)
-- All true


-- Test of associativity rule
-- Should produce of all True values
[
  (Xor x) <> ((Xor y) <> (Xor z)) ==
  ((Xor x) <> (Xor y)) <> (Xor z) | 
  x <- [True, False],
  y <- [True, False],
  z <- [True, False] ]