Notes week of 15 Oct

{-# LANGUAGE InstanceSigs #-}

import Control.Monad  -- (<=<, >=>)
import Data.Monoid    -- (<>)
import Data.List

• x Ordering data type and compare
• x Monoid review
• x Using Monoid for lexicographic comparisons
• skip newtype to wrap/unwrap types with different type class instances
• zip and zipWith
• Laziness and ‘infinite’ data structures

cmp :: Int -> Int -> String
cmp x y =
  if x < y then "less"
  else if x > y then "greater"
  else "equal"

cmp2 :: Int -> Int -> String
cmp2 x y =
  case compare x y of
    EQ -> "equal"
    LT -> "less"
    GT -> "greater"

data Person =
  Person { firstName :: String
         , lastName :: String
         , birthDate :: Int
         } deriving (Show)

p1 = Person "Chris" "League" 2987574
p2 = Person "Alice" "Smith" 2934723
p3 = Person "Alice" "Chen" 2948574
p4 = Person "Bob" "Smith" 2934723

instance Eq Person where
  a == b =
    firstName a == firstName b
    && lastName a == lastName b
    && birthDate a == birthDate b

instance Ord Person where
  compare a b =
     compare (lastName a) (lastName b)
     <> compare (firstName a) (firstName b)
     <> compare (birthDate a) (birthDate b)

byBirthDate :: Person -> Person -> Ordering
byBirthDate a b =
  compare (birthDate a) (birthDate b)

Laziness

grub x = x*x

blub x = 35

nums = [9, 2, -3, 5, 0, 1, 10, 4]

results = map (1000 `div`) nums

fibs :: [Integer]
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

golden :: Int -> Double
golden n = fromIntegral (fibs !! (succ n)) / fromIntegral (fibs !! n)

data ITree a
  = ILeaf
  | IBranch a (ITree a) (ITree a)
  deriving Show

height :: ITree a -> Int
height ILeaf = 0
height (IBranch _ l r) = 1 + max (height l) (height r)

balancedHeight :: ITree a -> Maybe Int
balancedHeight ILeaf = Just 0
balancedHeight (IBranch _ l r) =
  case balancedHeight l of
    Nothing -> Nothing
    Just hl -> error "TODO"

balancedFromList :: [a] -> ITree a
balancedFromList [] = ILeaf
balancedFromList (x:xs) =
  IBranch x (balancedFromList ys) (balancedFromList zs)
  where
    n = length xs `div` 2
    ys = error "TODO:ys"
    zs = error "TODO:zs"

instance Functor ITree where
  fmap f _ = error "TODO"

data BinOp = Add | Sub | Mul | Div | Pow
  deriving (Eq, Show)

data UnaryOp = Sqrt | Neg
  deriving (Eq, Show)

data Arith
  = Num Double
  | Var String
  | UnaryOp UnaryOp Arith
  | BinOp BinOp Arith Arith
  deriving (Eq, Show)

example1 =
  BinOp Add
    (BinOp Sub
       (BinOp Mul
          (BinOp Add (Num 3) (Num 4))
          (Var "x"))
       (UnaryOp Sqrt (Var "y")))
    (BinOp Pow (Num 3) (Var "y"))

optimize :: Arith -> Arith
-- Here are the real optimizations we're applying
optimize (BinOp Add (Num x1) (Num x2)) =
  Num (x1+x2)
optimize (BinOp Pow (Num 0) t) =
  Num 0
optimize (BinOp Add t (Num 0)) =
  optimize t
optimize (BinOp Add (Num 0) t) =
  optimize t
-- The remaining cases just traverse and
-- rebuild the tree, so that the above
-- optimizations can be applied throughout.
optimize (Num x) = Num x
optimize (Var s) = Var s
optimize (BinOp b t1 t2) =
  BinOp b (optimize t1) (optimize t2)
optimize (UnaryOp u t) =
  UnaryOp u (optimize t)

evaluate :: Arith -> Double
evaluate (Num x) = x
evaluate (Var "x") = 99
evaluate (Var "y") = 52
evaluate (Var s) = error "TODO: evaluate Var"
evaluate (UnaryOp Sqrt t) = sqrt (evaluate t)
evaluate (UnaryOp Neg t) = -(evaluate t)
evaluate (BinOp Add t1 t2) =
  evaluate t1 + evaluate t2
evaluate (BinOp Mul t1 t2) =
  evaluate t1 * evaluate t2
evaluate (BinOp Sub t1 t2) =
  evaluate t1 - evaluate t2
evaluate (BinOp Div t1 t2) =
  evaluate t1 / evaluate t2
evaluate (BinOp Pow t1 t2) =
  evaluate t1 ** evaluate t2

example2 =
  BinOp Add
    (BinOp Sub
       (BinOp Mul
          (BinOp Add (Num 3) (Num 4))
          (Var "x"))
       (UnaryOp Sqrt (Var "y")))
    (BinOp Pow
       (Num 0)
       (BinOp Mul
          (BinOp Add (Num 9) (Var "z"))
          (Var "k")))

main :: IO ()
main = return ()