{- 

VARIOUS EXAMPLES OF USING HASKELL FOR CSE 505, AUTUMN 1997

This file is on orcas on ~borning/505/lecture.hs
To load it into Haskell, copy it to your own directory.
Start Haskell using 
  hugs lecture.hs

Alternatively you can just start Haskell using the command "hugs", then
load the file from within Haskell using 
   :load lecture.hs
Another useful Haskell command is
  :set +t
which causes Haskell to print type information after evaluation.  See the
online manuals for more info.

-}





-- defining a function

double x = x+x

{- ************************************************************ -}

{- recursion examples: -}

-- recursive factorial
rec_factorial n | n==0    = 1
                | n>0     = n * rec_factorial (n-1)
                | n<0     = error "factorial called with n<0"

-- factorial using the built-in prod function
-- note that this doesn't check for the case of n<0
factorial n = product [1..n]

-- mapping function, like mapcar in Lisp
my_map f [] = []
my_map f (a:x) = f a : my_map f x

{- ************************************************************ -}

-- Currying!

plus x y = x+y

f = plus 1

ff = (+) 1

{- ************************************************************ -}

-- Static scoping

hyp x y = sqrt sum
          where sum = x*x + y*y


hyp2 x y = sqrt sum
           where sum = x2 + y2
                       where x2 = x*x
                             y2= y*y

{- here is a static scoping example analogous to the Scheme example -}

n = 0

-- note that n in the following definition of "test" is not the global n
test n = (\x -> x+n)
-- thus test 4 5 evalutes to 9

-- or we can use it to define a function:
add1 = test 1


rtest n func | n==10     =  func n
             | n==5      =  rtest (n+1) (\k -> n+k)
             | otherwise =  rtest (n+1) func

-- just as in scheme we have:
--  rtest 0 (\a -> 10)   
--  => 15


{- ************************************************************ -}

-- List comprehensions

-- quicksort

qsort [] = []
qsort (a:x) = qsort [ b | b <- x, b<=a ] ++ [a] ++ qsort [ b | b <- x, b>a ]


-- all permutations of a list

perms [] = [[]]
perms x  = [ a:y | a <- x, y <- perms (remove a x) ]

remove a [] = []
remove a (x:y) | a==x       = remove a y
               | otherwise  = x : remove a y



{- ************************************************************ -}


-- lazy evaluation and infinite lists

my_if True x y = x
my_if False x y = y


ones = 1 : ones

ints n = n : ints (n+1)

lets = "abc" ++ lets


member x []    = False
member x (y:z) | x==y      = True
               | otherwise = member x z


{- member function for sorted lists -}

smember x []    = False
smember x (y:z) | x==y      = True
                | x<y       = False
                | x>y       = member x z


-- square root 


sqt x =  head (filter close_enough (approximations x))
         where  approximations a = a : approximations ((a + x/a)/2)
		close_enough root = abs (x-root*root) < 1.0e-6


-- to show the list of successive approximations:
trial_roots x = approximations x
                where  approximations a = a : approximations ((a + x/a)/2)


-- two prime number programs:


factors n = [k | k <- [1..n], n `mod` k == 0]

dullprimes = filter isprime [2..]
             where
             isprime p = (factors p == [1,p])


interestingprimes = sieve [2..]
                    where
                    sieve (p:x) = p : sieve [n | n <- x, n `mod` p > 0]



{- HAMMING NUMBERS

The Hamming numbers are defined as the list of all
multiples of 2, 3, and 5, in sorted order. -}


my_merge (x:a) (y:b) | x<y   = x : my_merge a (y:b)
                     | x==y  = y : my_merge a b 
                     | x>y   = y : my_merge (x:a) b

ham = 1: my_merge ham2 (my_merge ham3 ham5)

ham2 = map (*2) ham
ham3 = map (*3) ham
ham5 = map (*5) ham


{- higher-order functions -}

-- double = (*) 2

twice f x = f (f x)


-- example: twice double 4

g = twice double 



my_member a x = or (map (==a) x)


-- This version of length uses the built-in const function,
-- which is defined as:
--      const k x = k
my_length x = sum (map (const 1) x)



--  sum, product, and, or, concat, etc ...
-- 
-- could define recursively, e.g.

my_sum [] = 0
my_sum (a:x) = a+my_sum x


-- foldr :: (u -> t -> t) -> t -> [u] -> t
-- foldr f a []    = a
-- foldr f a (b:x) = f b (foldr f a x)

-- sum = foldr (+) 0
-- product = foldr (*) 1
-- or = foldr (||) False
-- and = foldr (&&) True


{- and finally something strange to think about -}

-- find the fixed point of a function
fix f = a
        where a = f a

-- do these work?
--   fix (const 42)
--   fix double