-- | Laziness
-- Examples to illustrate laziness and infinite data structures
-- Functional Programming course 2018.
-- Thomas Hallgren

{-
This started as a skeleton, the definitions were filled in
during the lecture.
-}
--------------------------------------------------------------------------------

module Laziness where
--import Prelude hiding (take,zip)
--import qualified Prelude as P
import Data.List(sort)
import Test.QuickCheck hiding (choose)


--------------------------------------------------------------------------------
-- * First examples

-- f 0 == 1000, division by zero is avoided
f n = if n==0 then 1000 else 10 `div` n

choose b x y = if b then x else y

-- This works thanks to lazy evaluation, it would not work in an eager language
g n = choose (n==0) 1000 (10 `div` n)

--------------------------------------------------------------------------------
-- * Observing laziness with :sprint

squares :: [Int]
squares = [x*x | x<-[0..10]]

-- try :sprint squares

--------------------------------------------------------------------------------
-- * Infinite lists

ones :: [Int]
ones = 1:ones

numbers :: [Integer]
numbers = [0..]

countUp :: Int -> [Int]
countUp n = n:countUp (n+1)

fromTo :: Int -> Int -> [Int]
fromTo start stop = take (stop-start+1) (countUp start)

--------------------------------------------------------------------------------
-- * Fibonacci numbers

-- | Inefficient computation of Fibonacci numbers
fib :: Int -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n+2) + fib (n-1)


-- | Efficient computation of Fibonacci numbers, fibs !! n == fib n 
fibs :: [Integer]
--fibs = 1 : 1 : [fibs !! (n-2) + fibs !! (n-1) | n<-[2..]]
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

-- [fibs !! (n-2) | n <- [2..]] == fibs
-- [fibs !! (n-1) | n <- [2..]] == tail fibs
-- map (uncurry (+)) (zip fibs (tail fibs)))
-- zipWith (+) fibs (tail fibs)

--------------------------------------------------------------------------------
-- * Prime numbers

-- List of all prime numbers (simple solution)
primes_v1 :: [Integer]
primes_v1 = filter isPrime [2..]
  where
    isPrime n = factors n == [1,n]
    factors n = [i|i<-[1..n], n `mod` i == 0]

-- List of all prime numbers (the sieve of Eratosthenes)
primes :: [Integer]
primes = sieve [2..]
  where
    sieve (p:ns) = p : sieve [ n | n<-ns, n `mod` p /= 0]

-- Separately decide how many prime numbers we want to use
ex1 = take 20 primes           -- the first 20 primes
ex2 = takeWhile (<100) primes  -- all primes <100

--------------------------------------------------------------------------------
-- See also examples in the slides

--------------------------------------------------------------------------------
-- * Newtons method

sqroot x = head [a | (a',a) <- zip as (tail as), abs (a'-a) < 1e-5]
  where
    as = iterate next 1   -- infinite list of improving approximations
    next a = (a+x/a)/2    -- next approximation

--------------------------------------------------------------------------------
-- * prop_zip_length problem

{-
-- | zip [1,2,3] "abcde" == [(1,'a'),(2,'b'),(3,'c')]
zip :: [a] -> [b] -> [(a,b)]
zip (x:xs) (y:ys) = (x,y):zip xs ys
zip _      _      = []
-}

prop_zip_length_v1 xs ys = length (zip xs ys) == min (length xs) (length ys)
-- What does quickCheck say?

zip_ex = zip [1..] "Haskell"
test_zip = prop_zip_length_v1 [1..] "Haskell" -- infinite loop!

--------------------------------------------------------------------------------

-- | A type for (lazy) natural numbers â„•
data Nat = Z | S Nat   deriving (Eq,Ord,Show)

-- Z < S n
-- S n < S m = n<m

infinity :: Nat
infinity = S infinity

five = (S . S . S . S . S) Z

len :: [a] -> Nat
len [] = Z
len (x:xs) = S (len xs)

--------------------------------------------------------------------------------
-- * prop_zip_length problem solved

prop_zip_length xs ys = len (zip xs ys) == min (len xs) (len ys)

test_zip' = prop_zip_length [1..] "Haskell"

--------------------------------------------------------------------------------
-- * More examples with natural numbers
-- ** Examples where Nat is more appropriate that Int or Integer

--power :: Integer -> Nat -> Integer
--power b n = -- left as an exercise

--take :: Nat -> [a] -> [a]
--take n xs =  -- left as an exercise

--------------------------------------------------------------------------------
fromNat :: Num a => Nat -> a
fromNat Z = 0
fromNat (S n) = fromNat n + 1

toNat :: Integer -> Nat
toNat 0             = Z
toNat n | n>0       = S (toNat (n-1))
        | otherwise = error "toNat of negative number"

instance Num Nat where
  Z + b   = b
  S a + b = S (a+b)

  Z * b   = Z
  S a * b = b + a * b    -- (1+a)*b = b+a*b

  fromInteger n = toNat n

  abs n = n
  signum Z = Z
  signum _ = S Z
  negate Z = Z
  negate _ = error "negating natural number"

--------------------------------------------------------------------------------
-- * Search example

-- | search p returns Just n, if n is the smallest Nat such that p n is True
--            returns Nothing, if p n is False for all n::Nat
search :: (Nat->Bool) -> Maybe Nat
search p = if p n then Just n else Nothing
  where
    n = search' Z
    
    search' n | p n       = Z
              | otherwise = S (search' (S n))


search_ex1 = search (\n -> n*n==25)   -- Just 5
search_ex2 = search (\n -> n*n==27)   -- Nothing

--------------------------------------------------------------------------------
-- * Fringe example

data Tree a = L a | Tree a :+: Tree a
            deriving (Eq,Show)

-- | Tree equality (same shape, same leaves)
eqTree :: Eq a => Tree a -> Tree a -> Bool
eqTree (L x)     (L y)     = x==y
eqTree (l1:+:r1) (l2:+:r2) = l1==l2 && r1==r2
eqTeee _         _         = False

-- | Fringe equality
-- (The trees have the same sequence of leaves, but can have different shape)
eqFringe :: Eq a => Tree a -> Tree a -> Bool
eqFringe t1 t2 = fringe t1 == fringe t2

fringe :: Tree a -> [a]
fringe = undefined -- left as an exercise

--------------------------------------------------------------------------------
-- * Lazy IO

-- | Read a text file and count the number of lines
-- (should run in constant space, since readFile reads the file on demand)
countLines :: FilePath -> IO Int
countLines filename = length . lines <$> readFile filename

-- | Read a text file, sort the lines, and write the result back to
-- the same file.
sortFile :: FilePath -> IO ()
sortFile filename = undefined
   -- need be careful not to overwrite a file before all the contents
   -- have been read