Home
Blog
About
Donate

CS141

Functional Programming

Introduction

Editor's Note: I'll try to only cover the harder topics and stuff here. This assumes the reader knows basic functional programming.

  1. Type Classes
  2. Equational Reasoning
  3. Foldables and Functors
  4. Applicatives
  5. Monads

Type Classes

Type classes let us overload functions, and restrict polymorphism. For example, (+) :: Int -> Int -> Int is addition over integers, however addition should work for all numbers, so we can create a Num typeclass to allow addition to be defined over all numbers - which are instances of Num.

class Num a where
	(+) :: a -> a -> a
	(-) :: a -> a -> a
	abs :: a -> a
	...

We have method typings defined under the Num TC.

We can then define instance Num Int where ... and define all the methods underneath for the integers.

class Show a where
	show :: a -> String
instance Show Bool where
	show True = "True"
	show False = "False"

Of course, haskell polymorphism is not the same as OOP polymorphism. There are two main types of polymorphism in java and haskell, which are listed below,

Java Parametric
Parametric Polymorphism. Parameters, with generics, like
class LinkedList<T> { ...
Parametric Polymorthism. With type variables, like
id :: a -> a or head :: [a] -> a
Subtype polymorphism. Inheritance;
class Duck extends Bird { ...
Ad-hoc polymorphism. Restriction via typeclass,
(+) :: Num a => a -> a -> a

Type classes can have superclasses, for example the Ord (total order) constraint has an Eq superclass;

class Eq a => Ord a where
	(<)  :: a -> a -> Bool
	(<=) :: a -> a -> Bool

Functions that are defined with typeclass constraints are overloaded.

Equational Reasoning

Since functional programming is pure, we can use formal reasoning to prove the operation of programs.

When we do equational reasoning, we can use {curly brackets} to denote comments.

Natural Numbers. Let us define natural numbers as

data Nat = Zero
		 | Succ Nat

Given the following definition for add;

add :: Nat -> Nat -> Nat
add Zero m = m
add (Succ n) m = Succ (add n m)

Let us try to prove the following statement: ∀m :: Nat add Zero m = m.

add m Zero {known to be true}

We can prove the statement by induction, given that

add Zero Zero = Zero {base case} add n Zero = n => add (Succ n) Zero = Succ n {recursive case}

To prove the base case,

add Zero Zero = {applying add} Zero. ⊳

To prove the recursive case,

{assuming the inductive step; add n Zero = n} add (Succ n) Zero = {applying add} Succ (add n Zero) = {inductive hypothesis} Succ n. □

The previous example above is fairly straight forward. Often with reasoning there's either direct application, or proving via induction.

  • If you can rewrite a statement directly, do it.
  • If there are a finite number of values, you can do case analysis
  • If there are infinite values, it's a case of induction.

Since proofs here are always \(\Longleftrightarrow\) (even if it's not explicitly denoted), if it is hard to go forward, try starting with the end result and move backwards.

Lists. Let us define lists as

data [] a = []
		| (:) a [a]

-- thus
[] :: [a]
∀x :: a, ∀xs :: [a], x:xs :: [a]

Let us define map as

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

We want to prove "map fusion";
map f (map g xs) == map (f.g) xs.

We can also use induction here,

  • map f (map g []) == map (f.g) [] (Base case)
  • map f (map g xs) == map (f.g) xs => map f (map g (x:xs)) == map (f.g) (x:xs) (Recursive case)

To prove the base case,

map f (map g []) = {mapping} map f [] = {mapping} [] = {unmapping with function (f.g)} map (f.g) []. ⊳

To prove the inductive case,

map f (map g (x:xs)) = {mapping} map f (g x : map g xs) = {mapping} f (g x) : map f (map g xs) = {inductive step} f (g x) : map (f.g) xs = {unapply . (composition)} (f.g) x : map (f.g) xs = {unapply map} map (f.g) (x:xs). □

There's more equational reasoning, as well as the compiler thing and stuff, but admittedly it is rather beyond me.

Foldables and Functors

Foldables

A foldable is defined by the following typeclass

class Foldable t where
	foldr :: (a->b->b) -> b -> t a -> b

Where t a is the foldable type. A foldable (one example of which being a binary tree) is a data structure / container that stores many data, and can be "collapsed down".

t then would be a type that can contain another type, like [a], BinTree a.

foldr takes a function (a to b to b), an initial value b, a "container" t a, and returns the result of type b.

instance Foldable BinTree where
	foldr f z Leaf = z
	foldr f z (Node l x r) = f x (foldr f (foldr f z r) l)

This implementation is a postfix (DLR) implementation of folding over binary trees. However, foldables can generally be derived by the compiler automatically, though you're not allowed to do that in the exam.

Functors

A data type f is a functor if there is a function fmap (or (<$>)) :: (a->b -> f a -> f b, and

  • fmap id = id
  • fmap (f.g) = fmap f . fmap g

Basically, f is a container which stores a type, and it's a functor if you can map a function over elements in that container, whilst keeping it in said container form.

Recall map, and note the Maybe data type;

data Maybe a = Nothing | Just a

Maybe here is a functor, and lists are also functors, as the follwing definitions show:

instance Functor [] where
	fmap = map

instance Functor Maybe where
	fmap f (Just x) = Just $ f x
	fmap _ Nothing = Nothing 

Applicatives

Kinds and the Either Type

Kinds are the types of types. Similar to the expression :: type notation, we have type :: kind "kinding", however kinding is rarely written.

The most important kind is Type, or *. Simple types have a kind of just *, however types that take constructors, such as [a], has a kind of [] :: * -> *, same with Maybe.

Recall how functors are written like f a, thus all functors should have kind f :: * -> *.

Maybe can be used to propagate an error case (with Nothing), however it is not very descriptive. Thus, we have an Either type, with a kind of * -> * -> *, and is defined

data Either e a = Left e | Right a

Left binds stronger than Right, and is used as an error case, but allows one to specify an error code (with custom data types).

Either is an instance of Functor, however since Either is of kind * -> * -> *, and functors must be of kind * -> *, we have to specify the first argument and treat Either e as one block. Thus,

instance Functor (Either e) where
	-- it is often useful to write the specific type signature when defining;
	-- fmap :: (a->b) -> (Either e) a -> (Either e) b  
	fmap f (Left x) = Left x  -- the "Nothing" case
	fmap f (Right y) = Right $ f y  -- the "f a" case

Applicative Functors

Some type f of kind * -> * is an applicative functor if it is a functor, and there exists a function of type f (a->b) -> f a -> f b. Thus, along with $, <$> there is also

<*> :: Applicative f => f (a->b) -> f a -> f b

Thus the applicative class is defined as follows,

class Functor f => Applicative f where
	pure :: a -> f a
	(<*>) :: f (a->b) -> f a -> f b   -- "apply"

Think of <*> as an operator that applies a function stored in a container to a value stored in another container of the same type, and keeps the result in the container.

It is often handy when applying a function do :: a -> b -> c to multiple arguments, all inside Applicatives (i.e. f a, f b), to do do <$> f a <*> f b, since the first operation would yield a curried function (do a) :: b -> c inside the container f.

Applicative Laws. An instance of Applicative must also follow all applicative laws, those being

  • pure id <*> x = x
  • pure f <*> pure x = pure (f x)
         m <*> pure y = pure ($ y) <*> m

Maybe, Either are all instances of Applicative, and for example Maybe is defined as follows:

instance Applicative Maybe where
	pure = Just
	Nothing <*> _ = Nothing
	(Just f) <*> x = f <$> x

There are also the rather weird operations <* and *>, which (seem to) take two Applicatives, and discard either the first or second entirely, however they keep error cases. They are defined as follows (along with the const function):

const :: a -> b -> a
const x _ = x

(<*) :: Applicative f => f a -> f b -> f a
x <* y = const <$> x <*> y

(*>) :: Applicative f => f a -> f b -> f b
x *> y = flip const <$> x <*> y

From this StackOverflow Post, it seems that *> is called "ignored" and <* is called "ignoring".

So this is all well and good, but there are some things to bear in mind.

	Just 4 <* Nothing
==> const <$> Just 4 <*> Nothing
==> Just (const 4) <*> Nothing
==> Nothing.  -- even when "Ignoring" since we have a Nothing argument we get Nothing.
	Just 4 *> Just 8
==> flip const <$> Just 4 <*> Just 8
==> Just (flip const 4 8)
==> Just 8.

The unit type is () :: (). () is the sole value. It is also an empty tuple.

Take f <$> as <*> bs <*> cs, if the applicatives were lists, this would be the same as [f a b c | a <- as, b <- bs, c <- cs].

Random Numbers. Random numbers are, by definition, random, and in a pure language we can't have something be undeterminable, so how do we do it when we want random numbers? (Well, first, they're pseudorandom, but still)

In Haskell we have the package System.Random. Within, we have the following:

StdGen :: *  -- this is a basic type
MkStdGen :: Int -> StdGen  -- this is a type constructor
next :: StdGen -> (Int, StdGen)

So with the basic next function and a StdGen (which is like a pseudorandom generator class). However if we wanted two random numbers, then we'd have to do something like

twoRandomNumbers :: StdGen -> ((Int, Int), StdGen)
twoRandomNumbers rng = ((x, y), rng'')
	where (x, rng')  = next rng
		  (y, rng'') = next rng'

However this is rather clumsy of an implementation, and not very generalisable. So let us redo it whilst using a new State type that we make.

-- State is of kind * -> * -> *
data State s a = St (s -> (a, s))

-- we also have an accompanying function
runState :: State a s -> s -> (a, s)
runState (St m) = m

Yep, it's what it looks like; the data type State stores a function. The runState function thus extracts the function from the State data type.

It represents a computation of the initial state s, to give a result of type a and the "next" or resulting state s. State here is an applicative functor.

We can "clean up" our random number functions with State as follows

randomNumber :: State StdGen Int
randoNumber = St next

twoRandomNumbers :: State StdGen (Int, Int)
twoRandomNumbers = mkPair <$> randomNumber <*> randomNUmber
	where mkPair a b = (a, b)

Note that these are no longer functions but rather just definitions, there's no arrows going on. However, random numbers can still be extracted by runStateing the twoRandomNumbers with an initial seed.

M̶̿̿̈́́̉̄̃҉͕̜̟̠͕̯̼͡o̡̙ͣ̂͑̇ͨ̕n̢̡̠̦̺̳͚͓͇ͣ̑̏̿̄a̛̠̝͍̜̠̞͖ͨ͆̄d͎̟̺̘̦̙̻͒̄͝s̄͗̅̿̚҉̷̩̖

Introduction

"A monad is just a monoid in the category of endofunctors, what's so hard about that?"

Suppose we have a basic programming language and intepreter defined in Haskell. Expr is the expression to evaluate, and we have a function eval which will return an evaluated value.

data Expr = Val Int
		  | Add Expr Expr
		  | Div Expr Expr

eval :: ??

We want to write eval such that we don't get a runtime error when we divide by zero, so perhaps it would be prudent to use a safe division function.

safeDiv :: Int -> Int -> Maybe Int
Which will return Nothing if we try to divide by zero.

We can then use this safeDiv function to write eval, however the following looks good at a glance, but does not typecheck:

eval :: Expr -> Maybe Int
eval (Val n) = Just n
eval (Add l r) = (+) <$> eval l <*> eval r  -- Need to use apply over maybes
eval (Div l r) = safeDiv <$> eval l <*> eval r

This is because of the last line, which will make the compiler throw up an error. When we do eval l and eval r, we'll get Maybe x and Maybe y let's say, to use some unknowns x and y. Then, when we try to apply safeDiv over the two, we would get Maybe (safeDiv x y) which will be of type Maybe(Maybe Int). Ah.

Let's introduce a function called bind to solve this, which is often written as >>=. It can be defined for Maybe as the following:

(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
(>>=) Nothing _ = Nothing
(>>=) (Just x) f = f x

This lets us write our code in a way that actually works, that is as follows;

eval (Div l r) = eval l >>= (\x -> eval r >>= (\y -> x `safeDiv` y))
You don't actually need the brackets, and convention is to have a new line after the arrow, however I've put in brackets so you can see what is an argument of what.

The Monad Class

What we have just done is defined and used the essential function in the Monad class.

Monads are subclasses of applicative functors, and are defined as follows:

class Applicative m => Monad m where
	(>>=) :: m a -> (a -> m b) -> m b

	return :: a -> m a
	return = pure

"return" is just a legacy from when Monads and Applicatives were not so linked.

It is of kind * -> *

Monad Laws. Monads also have laws they must follow.

  • The left identity: pure x >>= f = f x
  • The right idenity: m >>= pure = m
  • The associativity rule: (m >>= f) >>= y \(\equiv\) m >>= (\x -> f x >>= y)

Monads have helper functions in Control.Monad, some of which are listed below.

  • mapM :: Monad m => (a -> m b) -> [a] -> m [b]
  • void :: Functor f => f a -> f ()
  • join :: Monad m => m (m a) -> m a
  • replicateM :: Applicative f => Int -> f a -> f [a]

Since binds have a rather inconvenient notation, monads in haskell come with do-notation, which is a very imperative notation for monad binding. A do statement opens the block, and within x <- code is the equivalent of binding, with x being the computation the result of the code is bound to.

A do block will run all the way to the end regardless, and so return or pure won't stop the running of the block, unlike an imperative return.

Note that the error case is bound more strongly than the normal case, so if a <- bind encounters a Nothing or a Left e (of an Either monad - did I mention Either is also a monad?) it will immediately return the error and not consider subsequent lines.

To demonstrate, here's some example code.

main :: IO ()
main = do
    line <- getLine
    if null line
        then return ()
        else do
            putStrLn $ reverseWords line
            main 

reverseWords :: String -> String
reverseWords = unwords . map reverse . words

To differentiate monadic from regular values, regular values are often called computaitons. The things that are bound in do statements are said computations.