-- | Laziness
-- Examples to illustrate laziness and infinite data structures
-- Functional Programming course 2017.
-- 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


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

ite b x y = if b then x else y

f n = ite (n==0) 1000 (10 `div` n)
-- f 0 == 1000, division by zero is avoided thanks to laziness
--------------------------------------------------------------------------------
-- * Infinite lists

ones :: [Int]
ones = 1 : ones

numbers :: [Integer]
numbers = [1..]

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

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

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

fibs :: [Integer]
fibs = 1 : 1 : zipWith (+) fibs (tail fibs) 

--------------------------------------------------------------------------------
-- * Primes (the sieve of Eratosthenes)

primes :: [Integer]
primes = sieve [2..]
  where
    sieve (p:ns) = p:sieve [n|n<-ns,n `mod` p /= 0]

ex1 = P.take 20 primes   -- the first 20 primes
ex2 = takeWhile (<100) primes   -- all primes <100


--------------------------------------------------------------------------------
-- * 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)

zip_ex = zip [1..] "Haskell"
test_zip = prop_zip_length_v1 [1..] "Haskell"

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

-- | A type for (lazy) natural numbers ℕ
data Nat = Z | S Nat  deriving (Ord,Show)

instance Eq Nat where
  Z == Z      = True
  S n == S n' = n==n'
  _   == _    = False

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 = S (toNat (n-1))


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

--------------------------------------------------------------------------------
-- * 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' Z returns either
    --    * a number n such that p n, or
    --    * infinity, if no such number is found
    search' :: Nat -> Nat
    search' n | p n = Z
              | otherwise = S (search' (S n))


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

--------------------------------------------------------------------------------
-- * 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

-- | Since readFile reads the contents of the file lazily, this program
-- runs in constant space.
countLines :: FilePath -> IO Int
countLines filename = length . lines <$> readFile filename

-- | Since readFile reads the contents of the file lazily, this program
-- tries to write the result to input file before it has been read.
-- Exercise: rewrite it so that it works
sortFile :: FilePath -> IO ()
sortFile filename = writeFile filename . sortLines =<< readFile filename
  where sortLines = unlines . sort . lines

{- Below are the tests we ran in GHCi:
:l Laziness.hs
:t f
f 0
:r
ones
take 10 ones
P.take 10 ones
:r
numbers
take 10 numbers
Ptake 10 numbers
P.take 10 numbers
:r
fromTo 10 20
:r
P.take 20 fibs
P.take 100 fibs
:r
ex1
:r
ex2
:t iterate 
sqroot 9
sqroot 16
sqrt 16
sqroot 25
zip_ex
test_zip 
:r
test_zip' 
:r
test_zip' 
infinity 
min infinity five 
five < infinity 
five == infinity 
5*5 :: Nat
:r
search (\n -> n*n==25)
search (\n -> n*n==27)
:r
search (\n -> n*n==25)
search (\n -> n*n==27)
infinity == five
search (\n -> n==n+1)
search (\n -> n*n==27)
search (\n -> n*n==25)
:r
infinity == 25
infinity == 27
search (\n->n*n==infinity )
search (\n->n*n==27 )
:r
search' (\n->n*n==27 ) Z
27::Nat
search' (\n -> n*n==25) Z
search' (\n -> n*n==27) Z
n = search' (\n -> n*n==25) Z
n*n==27
infinity == infinity 
infinity == 27
-}