{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
module Week6 where

import Data.List (foldl')
import Data.Bits (xor, popCount)

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 = map snd $ (0, 0) : iterate (\(x, y) -> (y, x + y)) (0, 1)

data Stream a = Cons a (Stream a)

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

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

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 x xs) ys = Cons x $ interleaveStreams ys xs

-- I did not come up with this. I hope to be able to one day.
ruler :: Stream Integer
ruler = foldr1 interleaveStreams $ map streamRepeat [0..]

-- This was my orginal solution to ruler
-- ruler :: Stream Integer
-- ruler = interleaveStreams (streamRepeat 0) $
--   streamMap snd $ streamFromSeed rulerVal (2, 1)
-- rulerVal :: (Integer, Integer) -> (Integer, Integer)
-- rulerVal (x, v) = (x', v')
--   where
--     x' = x + 2
--     v' = fromIntegral $ popCount $ x `xor` x'
-- rulerVals = streamMap snd $ streamFromSeed rulerVal (1, 2)
-- ruler = interleaveStreams (streamRepeat 0) $
--   streamMap snd $ streamFromSeed rulerVal (2, 1)

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

instance Num (Stream Integer) where
  (+) (Cons a as) (Cons b bs) = Cons (a + b) $ (+) as bs
  (*) (Cons a0 as) b@(Cons b0 bs) = Cons (a0 * b0) $ streamMap (a0 *) bs + as * b
  negate = streamMap negate
  abs = streamMap abs
  signum = streamMap signum
  fromInteger n = Cons n $ streamRepeat 0

instance Fractional (Stream Integer) where
  (/) (Cons a0 a') (Cons b0 b') = q
    where
      q = Cons (a0 `div` b0) $ streamMap (`div` b0) (a' - q * b')

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

data Matrix a = Matrix a a a a

topRight (Matrix _ x _ _) = x

instance Num a => Num (Matrix a) where
  (Matrix a1 b1 c1 d1) * (Matrix a2 b2 c2 d2) = Matrix
    (a1 * a2 + b1 * c2) (a1 * b2 + b1 * d2)
    (c1 * a2 + d1 * c2) (c1 * b2 + d1 * d2)

fib4 :: Integer -> Integer
fib4 0 = 0
fib4 x = topRight $ (Matrix 1 1 1 0) ^ x

