{-    myFunctions.hs   -}
-- comment          
-- :set +t   -- types everything

-- arithmetic

-- 20 + 30     -- usual "infix" operator
-- (+) 20 30   -- in LISP (Function Arguments)
-- 20 + 30 * 40
-- (20 + 30) * 40
-- 20.0 + 30.0
-- 20 + 30.0   -- type inference

-- sets (lists)


-- [1,2,3] -- is just itself
three = [1,2,3] 
    -- makes "three" shorthand for that list
-- three
-- three ++ three
    -- concatenation (written @ in ML)
four = [1,2,3,4]
    -- another list
digits = ['0' .. '9']
    -- characters in single quotes (ordered)
lowerCase = ['a' .. 'z']
upperCase = ['A' .. 'Z']

e = 2.718281828459045235360287471352662497757

-- built-in list functions

-- take n list
--     the list consisting of (up to)
--     the first n elements of the list

-- reverse list

-- what really is a list?
-- head list
-- tail list
--     in Haskell written head:tail
--     in ML written head :: tail

-- infinite lists   ("Lazy" evaluation)

naturals = [0 .. ]
positives = [ 1 .. ]
evens = [ 0, 2 .. ]
odds = [ 1, 3 .. ]
squares = [n*n | n <- [0..]]
-- cubes = [n*n*n | n <- [0..]]

fibs = 0:1:zipWith (+) fibs (tail fibs) -- explain later

fact n = product [1..n]

comb n r = fact n `div` (fact r * fact (n-r))

data Time = MakeTime { hours, mins, secs :: Int }

-- Currying functions

{- Definitions not Haskell
----curry  :: ((a,b) -> c) -> (a -> (b -> c))
----uncurry  :: (a -> (b -> c)) -> ((a,b) -> c)
-}


-- Page 595 Sebesta

-- pattern matching

sumAll :: [Integer] -> Integer
sumAll [] = 0
sumAll (a:x) = a + sumAll x

productAll :: [Integer] -> Integer
productAll [] = 1
productAll (a:x) = a * productAll x

colors = [ "blue", "green", "red", "yellow" ]
--	note the type is a list of strings
--  BUT strings are just lists of characters

type String = [Char]

factors :: Integer -> [Integer]
factors n = [ i | i <- [1..n `div` 2], n `mod` i == 0]

factors' :: Integer -> [Integer]
factors' n = [ i | i <- [1..n `div` 2], n `mod` i == 0] ++ [n]

-----------
perfect :: Integer -> Bool
perfect n = (sumAll (factors n)) == n

perfect' :: Integer -> Bool
perfect' n = (sumAll (factors' n)) == 2*n

perfects = [i | i <- [1..] , perfect i]
--	"the list of all i's SUCH THAT i BELONGS TO the
--	 set of positives AND i is perfect"
-----------

--Quicksort (Works in O(n ln n) time)
sort :: [Integer] -> [Integer]
sort [] = []
sort (a:x) = sort [b | b <- x, b <= a] 
             ++ [a] 
			 ++ sort [ b | b <- x, b > a]
 
sortA :: (Ord a) => [a] -> [a]
sortA [] = []
sortA (a:x) = sortA [b | b <- x, b <= a] 
             ++ [a] 
			 ++ sortA [ b | b <- x, b > a]

--ordered list of integers
member :: [Integer] -> Integer -> Bool
member [] n = False
member (m:x) n = ((m < n) && (member x n)) 
                 || (m == n) || False

memberR :: Integer -> [Integer] -> Bool
memberR n [] = False
memberR n (m:x) = ((m < n) && (memberR n x)) 
                 || (m == n) || False

--Greatest Common Divisor

-- guards vs. pattern matching

myGcd m n | (n > m) = myGcd n m    -- so m>=n
          | ((m `mod` n) == 0) = n
          | otherwise = myGcd n (m `mod` n)

cubes = [ n*n*n | n <- [1..] ]



-- ==============================
main = putStrLn "Hello, World!"
-- ==============================

--------------------------
echo =  do 	
		putStr "Prompt: "
		s <- getLine
		putStr "Echo: "
		putStrLn s
	
save =  do
		putStr "Prompt: "
		s <- getLine
		writeFile "testFile.txt" s
		putStr "File written\n"
--------------------------
	
		
-- p. 22
rightTriangles n = [(a,b,c) | c <- [1 .. n], 
                              b <- [1 .. c], 
							  a <- [1 .. b], 
							  a^2 + b^2 == c^2, 
							  (relPrime a b c) == True]

relPrime x y z = ((myGcd x y) == 1) 
                   && ((myGcd y z) == 1) 
				   && ((myGcd z x) == 1)

-------------------------------------------
--PRIMES Reade p.282

sieve (a : xs) = a : sieve (sift a xs)

primes = sieve [2 ..]

--multipleof a b = (b `mod` a == 0)

nextfind a b (c:x) | (c < b) = c : nextfind a b x
				   | (c == b) = nextfind a (a+b) x
				   | otherwise = nextfind a (a+b) (c:x)
		
sift a x = nextfind a (2*a) x

-- Test an alternative (ECP)
sift' a x = nextfind a (a*a) x
sieve' (a : xs) = a : sieve' (sift' a xs)
primes' = sieve' [2 ..]
--

--ML Code----------------------------------

--fun reverse(nil) = nil 
--  | reverse(x::xs) = reverse(xs) @ [x];

myReverse :: [Integer] -> [Integer]
myReverse [] = []
myReverse (x:xs) =  (myReverse xs) ++ [x]

reverse' :: [a] -> [a]
reverse' [] = []
reverse' (x:xs) = (reverse' xs) ++ [x]


--fun polyadd(P,nil) = P 
--  | polyadd(nil,Q) = Q 
--  | polyadd((p:real)::ps,q::qs) = (p+q)::polyadd(ps,qs);

--polyadd([1.0,2.0,3.0],[9.0,8.0,7.0]);


myPolyadd :: [Integer] -> [Integer] -> [Integer]
myPolyadd p q | (p == []) = q
              | (q == []) = p	
			  | otherwise = [(head p) + (head q)] 
			       ++ (myPolyadd (tail p) (tail q)) 

{-
polyadd' :: (Num a) => (Eq a) => [a] -> [a] -> [a]
polyadd' p q 	| (p == []) = q
				| (q == []) = p
				| otherwise = [(head p) + (head q)] 
				   ++ (polyadd' (tail p) (tail q))
-}
			
--------------------------

-- BREADCRUMBS

--Advanced Infinite Lists

fib' = 0 : 1 : map (\(a,b) -> a + b) (zip fib' (tail fib'))

--Composition

descending_sort lst = (reverse . sort) lst

--Function Application Operator

add = (+)  -- now can refer to + as regular function
divide = (/)

-----foo' = add 2.0 $ divide 4 5 
{- blah $ foo bar baz   ===  blah (foo bar baz) -}

--Pattern Matching

len' [] = 0
len' lst = 1 + len' (tail lst)

len'' [] = 0
len'' (x:xs) = 1 + len'' xs

--At Patterns

atPattern allxs@(x:xs) = 	"All xs are: " ++ (show allxs) 
                            ++ "\n"	++ "The first x is: " 
							++ (show x) ++ "\n"
							++ "The rest of the xs are: " 
							++ (show xs)
							
atPatternPrint list = putStrLn $ atPattern list
						 
--Guards   (like Pattern Matching)

signum' n | n < 0 = "negative"
          | n == 0 = "zero"
		  | otherwise = "positive"
		  
--Case

signum'' n = case signum n of
			 (-1) -> "negative"
			 0 -> "zero"
			 1 -> "positive"
			 
--Where

max_list lst = head reversedlist where
	reversedlist = reverse sortedlist
	sortedlist = sort lst
		
--Tuples

magnitude (x,y) = sqrt (x^2 + y^2)

min_max_list lst = (head sortedlist, head reversedsortedlist) where
	sortedlist = sort lst
	reversedsortedlist = reverse sortedlist
	
--map

map' :: (a -> b) -> [a] -> [b]
map' f [] = []
map' f (x:xs) = [f x] ++ (map' f xs)

--Lambdas       (defining local function)

addOneToEverything lst = map (\a -> a + 1) lst



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

--Problems

--append to a list an element

--palindrome?

--(* 1 *) "drop" the first n elements of a list

--(* 2 *) a list "startsWith" the beginning of another list

--(* 3 *) find the "last" element of a list

--(* 4 *) return all the elements from m-th fromTo" the n-th

--(* 5 *) what is a to the b "power"

 
--scalar product

--Curry/unCurry

--Given:  data Nat = Zero | Succ Nat deriving (Show)
--nat2int
--addition
--multiplication
--factorial

--Binary Search Trees
--Given: data BSTree a = Empty | Branch (BSTree a) a (BSTree a)
--            deriving (Show, Ord)
--search
--insert
--equality


-- translate problem 11 on p. 603
{-
y :: (Eq a) => a -> [a] -> [a]
y s [] = []
y s (t:x) | (s==t) = (s:x)
          | otherwise = y s x
-}
-------------------------------------

--Chapter7

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

-- Indexing

-- [1,2,3,4,5,6] !! 3  =>  3

-- Filtering

-- Types

---- Int (bounded)
---- Integer (unbounded)
---- Float
---- Double
---- Bool  (True False)
---- Char  (Unicode0

-- Type Classes

---- Eq
---- Ord     `compare` takes 2 Ord types returns Ordering (GT,LT,EQ)
---- Show
---- Read
---- Num

-- HIGHER-ORDER FUNCTIONS

zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' _ [] _ = []
zipWith' _ _ [] = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys

flip' :: (a -> b -> c) -> (b -> a -> c)
flip' f x y = f y x

myMap :: (a -> b) -> [a] -> [b]
myMap _ [] = []
myMap f (x:xs) = f x : myMap f xs

filter' :: (a -> Bool) -> [a] -> [a]
filter' _ [] = []
filter' p (x:xs)
	| p x		= x : filter' p xs
	| otherwise = filter' p xs
	
-- Let

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
	let smallerOrEqual = filter' (<= x) xs
	    larger = filter' (> x) xs
	in  quicksort smallerOrEqual ++ [x] ++ quicksort larger
	
-- An example

--sum (takeWhile (<10000) (filter odd (map (^2) [1..])))

-- Tail recursion

-- (slow) Mathematical Definition:
fibonacci :: Integer -> Integer
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci n = (fibonacci (n-1)) + (fibonacci (n-2))

-- (fast)
fibonacciAux :: Integer -> Integer -> Integer -> Integer
fibonacciAux a _ 0 = a
fibonacciAux a b c = fibonacciAux b (a+b) (c-1)

fibonacci' :: Integer -> Integer
fibonacci' n = fibonacciAux 0 1 n 
	
fibonacci'' :: Integer -> Integer
fibonacci'' n 
			| n >= 0 = fibonacciAux 0 1 n
			| otherwise = error "n must be non-negative"
			
-- A famous FP function

accumulate :: (Num a) => (a -> a -> a) -> a -> [a] -> a
accumulate f a [] = a
accumulate f a (h:t) = accumulate f (f a h) t

-- Examples using accumulate

sumList' = accumulate (+) 0
productList' = accumulate (*) 1
 
------------------------------------------------
{-
"The Haskell School of Expression" by Paul Hudak

http://www.cs.yale.edu/homes/hudak/SOE

ALSO do the "cabal" stuff as recommended

-}

--import Graphics

--	:cd SOE
--	:cd src
--	:l SimpleGraphics

--OR

--  :cd H:/HaskellPlatform/2013.2.0.0/bin/SOE/src
--  :l SimpleGraphics

--	main0

--	:l Animation

--  main1
--  main2 
--  ...

--	:l Picture

--	main


{-  
windowTest()
	=	runGraphics ( 
		do w <- openWindow 
			"My First Graphics Program" (300,300)
		drawInWindow w (text (100,200) "HelloGraphicsWorld")
	    k <- getKey w
	    closeWindow w
	      )

-}	  

{- HUGS (WinHugs)

Hugs> :cd "Haskell Platform\2013.2.0.0\bin"
Hugs> :l myFunctions
Main> main
Hello, World!

-}

{- WinGHCi 
:cd f:\Haskll
:l simpleGraphics
-}

{- Desktop WinGHCi (ghci-7.6.3)
H:\HaskellPlatform\2013.2.0.0\bin\SOE\src
:l ...
-}