Lecture 1 — 2015-09-02

Introduction, learning Haskell

This lecture is written in literate Haskell; you can download the raw source.

module Lec01 where

We went over the syllabus and we all filled out some notecards, with the following information:

  • Name
  • Have you taken 81?
  • Favorite programming language
  • Least favorite programming language
  • Spoken languages
  • Favorite music right now
  • X or Y (name a dialectic and pick a side)
  • Other interests

As a result, I’ll have to google for what “trap” music is.

After some tooling around in GHCi, the interpreter, we started writing some real code. An easy arithmetic function…

mean :: Int -> Int -> Int
mean x y = (x + y) `div` 2

…followed by some more interesting recursive functions:

fact :: Int -> Int
fact 0 = 1
fact n = n * (fact (n - 1))

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

Then we defined our datatype, discovering along the way that Haskell doesn’t automatically give us things we can show or compare for equality (via ==. The deriving clause lets us get these things.

data Day = 
  Sunday
  | Monday
  | Tuesday
  | Wednesday
  | Thursday
  | Friday
  | Saturday
    deriving (Show,Eq)

We defined isWeekday two different ways. First we had:

isWeekday' :: Day -> Bool
isWeekday' Saturday = False
isWeekday' Sunday = False
isWeekday' _ = True

and then we saw what happens when you drop off pattern match (an error!). We also looked at the case statement:

isWeekday :: Day -> Bool
isWeekday d =
  case d of
    Saturday -> False
    Sunday -> False
    _ -> True

And then we defined functions using other functions. A breeze.

isWeekend :: Day -> Bool
isWeekend d = not (isWeekday d)

This one was boring.

nextDay :: Day -> Day
nextDay Monday = Tuesday
nextDay Tuesday = Wednesday
nextDay Wednesday = Thursday
nextDay Thursday = Friday
nextDay Friday = Saturday
nextDay Saturday = Sunday
nextDay Sunday = Monday

But this was more interesting! We get to use a math-like syntax instead of conditionals.

weekdays :: [Day] -> [Day]
weekdays []     = []
weekdays (d:ds) 
  | isWeekday d = d:weekdays ds
  | otherwise   = weekdays ds

We talked a bit more about lists, defining our own version of the library function last.

last' :: [a] -> a                  
last' []     = error "don't do that"
last' [x]    = x
last' (x:xs) = last' xs

To tie everything together, we worked on some functions for thinking about points and lines on the Cartesian plane.

data Point = Point { xCoord :: Float,
                     yCoord :: Float }
             deriving Show
                      
data Line =                      
    Vert Float
  | Sloped { lineSlope :: Float,
             lineIntercept :: Float }
    deriving Show

We went through a couple versions of a function that takes two points and returns a line going them. First, we had:

mkLine' :: Point -> Point -> Line
mkLine' p1 p2 =
  if xCoord p1 == xCoord p2
  then Vert $ xCoord p1
  else 
    let m = (yCoord p1 - yCoord p2) / 
            (xCoord p1 - xCoord p2) in
    let b = yCoord p1 - (m * xCoord p1) in
    Sloped m b

But then Eric pointed out that this had a funny behavior when p1 and p2 are equal. First we established that you can’t write something like:

mkLine p1 p1 = {- error case where the points are the same -}
mkLine p1 p2 = {- normal function -}

Rather than having the function call error, we decided to use the Maybe datatype. By now we had already used the :i [type name] and :t [expression] commands in GHCi to look at types. Running :i Maybe, we got:

data Maybe a = Nothing | Just a 	-- Defined in ‘GHC.Base’
-- ... and a bunch of instances we don't really care about right now

We then simply changed the type on mkLine to return Maybe Line, and then the type checker guided us to all the spots we needed to fix.

mkLine :: Point -> Point -> Maybe Line
mkLine p1 p2 =
  if xCoord p1 == xCoord p2
  then if yCoord p1 == yCoord p2 
       then Nothing
       else Just $ Vert $ xCoord p1
  else 
    let m = (yCoord p1 - yCoord p2) / 
            (xCoord p1 - xCoord p2) in
    let b = yCoord p1 - (m * xCoord p1) in
    Just $ Sloped m b