http://www.seas.upenn.edu/~cis194/spring13/hw/06-laziness.pdf

gistfile1.hs

{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# LANGUAGE FlexibleInstances #-}

-- Homework 6 - http://www.seas.upenn.edu/~cis194/spring13/hw/06-laziness.pdf

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

fibs1 :: [Integer]
fibs1 = map fib [0..]

fibs2 :: [Integer]
fibs2 = 0 : 1 : zipWith (+) fibs2 (tail fibs2)

data Stream a = Cons a (Stream a)

streamToList :: Stream a -> [a]
streamToList (Cons x xs) = x : streamToList xs

instance Show a => Show (Stream a) where
  show = show . take 20 . streamToList

streamRepeat :: a -> Stream a
streamRepeat x = Cons x $ streamRepeat x

streamMap :: (a -> b) -> Stream a -> Stream b
streamMap f (Cons x xs) = Cons (f x) $ streamMap f xs

streamTail :: Stream a -> Stream a
streamTail (Cons x s) = s

streamFromSeed :: (a -> a) -> a -> Stream a
streamFromSeed f x = Cons x $ streamFromSeed f (f x)

nats :: Stream Integer
nats = streamFromSeed (+1) 0

interleaveStreams :: Stream a -> Stream a -> Stream a
interleaveStreams (Cons x1 xs1) (Cons x2 xs2) = Cons x1 $ Cons x2 $ interleaveStreams xs1 xs2

ruler :: Stream Integer
ruler = streamMap twos (streamTail nats)
    where twos n
             | n `mod` 2 == 0    = 1 + twos (n `div` 2)
             | otherwise         = 0

x :: Stream Integer
x = Cons 0 $ Cons 1 $ streamRepeat 0

instance Num (Stream Integer) where
    fromInteger n                 = Cons n $ streamRepeat 0
    negate (Cons n s)             = Cons (-n) $ negate s
    (+) (Cons n1 s1) (Cons n2 s2) = Cons (n1 + n2) $ s1 + s2
    (*) (Cons n1 s1) (Cons n2 s2) = Cons (n1 * n2) $ streamMap (*n1) s2 + s1 * Cons n2 s2

instance Fractional (Stream Integer) where
    (/) (Cons n1 s1) (Cons n2 s2) = q
        where q = Cons (n1 `div` n2) $ streamMap (`div` n2) (s1 - q * s2)

fibs3 :: Stream Integer
fibs3 = x / (1 - x - x^2) -- holy shit

-- Fibonacci numbers via matrices (extra credit)

data Row = Row Integer Integer
data Matrix = Matrix Row Row

instance Num (Matrix) where
    (*) (Matrix (Row x00 x01) (Row x10 x11)) (Matrix (Row y00 y01) (Row y10 y11)) =
        Matrix (Row (x00*y00+x01*y10) $ x00*y01+x01*y11) (Row (x10*y00+x11*y10) $ x10*y01+x11*y11)

extractFibFromMatrix :: Matrix -> Integer
extractFibFromMatrix (Matrix (Row a b) (Row c d)) = b

fib4 :: Integer -> Integer
fib4 0 = 0
fib4 n = extractFibFromMatrix ((Matrix (Row 1 1) (Row 1 0))^n)