FP Solution

import Data.Char

fact1 :: Int -> Int
fact1 0 = 1
fact1 n = n * fact1 (n-1)

fact2 :: Int -> Int
fact2 n | n==0 = 1
        | otherwise = n * fact2 (n-1)

fact3 :: Int -> Int        
fact3 n = if n==0 then 1 else n * fact3 (n-1)

fib :: Int -> Int
fib 0 = 0
fib 1 = 1
fib n = tmp n 0 1 where
  tmp 1 _ b = b 
  tmp x a b = tmp (x-1) b (a+b)

gcd' :: Int -> Int -> Int
gcd' a b | a > b = gcd' (a-b) b
         | a < b = gcd' a (b-a)
         | a==b = a

gcd2 :: Int -> Int -> Int         
gcd2 a 0 = a
gcd2 a b = gcd2 b (a `mod` b)

isPrime :: Int -> Bool
isPrime 1 = False
isPrime y = isPrimeTest y (ceiling (sqrt (fromIntegral y)::Double))
  where
  isPrimeTest _ 1 = True 
  isPrimeTest n x | n `mod` x ==0 = False
                  | otherwise = isPrimeTest n (x-1)

length' :: [a] -> Int
length' []  = 0
length' (_:xs) = 1 + length' xs

sumIt :: [Int] -> Int
sumIt []  = 0
sumIt (x:xs) = x + sumIt xs

getHead :: [a] -> a
getHead (x:_) = x

getLast :: [a] -> a
getLast (x:xs) | length xs == 0 = x
               | otherwise = getLast xs

isElement :: Eq a => a -> [a] -> Bool
isElement _ [] = False
isElement a (x:xs) | a == x = True 
                   | otherwise = isElement a xs 
                   
getTail :: [a] -> [a]                   
getTail (_:xs) = xs

getInit :: [a] -> [a]
getInit [_] = []
getInit (x:xs) = x : getInit xs

combine :: [a] -> [a] -> [a]
combine [] y = y
combine (x:xs) y = x : combine xs y

max' :: [Int] -> Int
max' [x] = x
max' (x:y:z) | x > y = max' (x:z)
             | otherwise = max' (y:z)

max2 :: [Int] -> Int
max2 (y:ys) = tmp y ys where
   tmp a [] = a
   tmp a (x:xs) | x > a = tmp x xs
                |otherwise = tmp a xs

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

reverse'' :: [a] -> [a] 
reverse'' n = tmp n  []
  where tmp [] ys = ys 
        tmp (x:xs) ys = tmp xs (x:ys)

take' :: Int -> [a] -> [a]
take' 0 _ = []
take' _ [] = []
take' n (x:xs) = x: take' (n-1) xs

drop' :: Int -> [a] -> [a]
drop' 0 x = x
drop' _ [] = []
drop' n (_:xs) = drop' (n-1) xs

minimum' :: Ord a => [a] -> a -- Is this right?
minimum' [x] = x
minimum' (x:y:z) | x < y = minimum' (x:z)
                 | otherwise = minimum' (y:z)

divisors :: Int -> [Int]
divisors n = tmp n where
  tmp 0 = []
  tmp x | n `mod` x == 0 = x: tmp (x-1)
        | otherwise = tmp (x-1)

divisors' :: Int -> [Int]
divisors' n =  filter (\x -> n `mod` x == 0) [1..n] 

divisors'' :: Int -> [Int]
divisors'' n =  [x | x<-[1..n], n `mod` x == 0] 

zipThem:: [a] -> [b] -> [(a,b)]
zipThem (x:xs) (y:ys) = (x,y) : zipThem xs ys
zipThem _ _ = []

dotProduct :: [a] -> [b] -> [(a,b)]
dotProduct [] _ = []
dotProduct (x:xs) ys = tmp ys ++ dotProduct xs ys where
  tmp [] = []
  tmp (b:bs) = (x,b) : tmp bs

dotProduct' :: [a] -> [b] -> [(a,b)]  
dotProduct' xs ys = [(x,y)|x<-xs, y<-ys]

dotProduct'' :: [a] -> [b] -> [(a,b)]
dotProduct'' x y = 
  zip (concat (map (replicate (length y)) x))
                     (concat (replicate (length x) y))


fibonacci :: Int -> Int
fibonacci n = fst (tmp n) where
  fibStep (a,b) = (b,a+b)
  tmp 0 = (0,1)
  tmp x = fibStep (tmp (x-1))

allToUpper :: String -> String
allToUpper xs = [toUpper x |x<-xs]                     

allToUpper' :: String -> String
allToUpper' xs = map toUpper xs

quicksort :: (Ord a) => [a] -> [a]
quicksort (x:xs) = let lp = filter (< x) xs
                       rp = filter (>= x) xs
                   in quicksort lp ++ [x] ++ quicksort rp

oddList :: Int -> Int -> [Int]
oddList a b = [ x |x<-[a..b], odd x]

removeAllUpper :: String -> String
removeAllUpper xs = [ x |x<-xs, not (isUpper x)]

union :: Eq a => [a] -> [a] -> [a]
union xs ys = xs ++ [y| y<-ys, not (elem y xs)]

intersection ::  Eq a =>  [a] -> [a] -> [a]
intersection xs ys = [y| y<-ys, elem y xs]

unique :: String -> String
unique n = reverse(tmp n "") where
  tmp [] store = store
  tmp (x:xs) store | x `elem` store = tmp xs store
                   | otherwise = tmp xs (x:store)

unique' :: String -> String                   
unique' [] = []
unique' (x:xs) = x: unique' (filter (/=x)xs)

countThem :: String -> [(Char, Int)]
countThem xs = let u = unique xs
               in [(x, length (filter (==x) xs)) |x<-u]

isPrime :: Int -> Bool
isPrime n = null [x |x<-[2..ceiling (sqrt (fromIntegral n)::Double)], n `mod` x == 0]

goldbach :: Int-> [(Int, Int)]
goldbach n = let primes = [x |x<-[2..(n `div` 2)+1], isPrime x]
             in [(x,n-x) |x<-primes, isPrime (n-x)]

goldbachList :: Int -> Int-> Int -> [(Int, Int)]
goldbachList a b limit = filter (\(x,_)-> x>limit) [head (goldbach x) | x<-[a..b], even x]

combinations :: Int -> String -> [String]
combinations 1 xs = [[x]| x<-xs]
combinations n (x:xs) | n == length (x:xs) = [(x:xs)]
                      |otherwise = [[x] ++ y |y<-combinations (n-1) xs ] 
                                    ++ (combinations n xs)

not' :: Bool -> Bool
not' True = False
not' False = True
infixl 5 `not'` 

and' :: Bool -> Bool -> Bool
and' True True = True
and' _ _ = False
infixl 4 `and'` 

or' :: Bool -> Bool -> Bool
or' False False = False
or' _ _ = True
infixl 3 `or'` 

nand' :: Bool -> Bool -> Bool
nand' x y = not' (and' x y)
infixl 4 `nand'` 

xor' :: Bool -> Bool -> Bool
xor' x y = x/=y
infixl 3 `xor'` 

impl' :: Bool -> Bool -> Bool
impl' True False = False
impl' _ _ = True
infixl 2 `impl'` 

equ' :: Bool -> Bool -> Bool
equ' x y = x == y
infixl 7 `equ'` 

tablen :: Int -> ([Bool] -> Bool) -> IO ()
tablen n f = putStr(concat [show x ++ " -> " ++ show(f x) ++ "\n" |x<-allValues n]) where 
  allValues 1 = [[True], [False]]
  allValues n = [x:y| x<-[True,False], y<-allValues (n-1)]

huffman :: [(Char, Int)] -> [(Char, String)] 
huffman input = let 
                    prep = [ (y, [(x,"")] ) | (x,y)<-input]
                in sortBy (\ (x,_) (y,_) -> compare x y) (step prep) where
                    step :: [(Int, [(Char, String)])] -> [(Char, String)]
                    step [(_, result) ] = result
                    step list = let ((a1, as2):(b1,bs2):rest) = sortBy (\ (x,_) (y,_) -> compare x y) list
                                in step ((a1+b1, [(x,'0':a2)|(x,a2)<-as2]++[(x,'1':b2)|(x,b2)<-bs2])  : rest)

type Pic = [String]

pic :: Pic
pic = [ "....#....",
        "...###...",
        "..#.#.#..",
        ".#..#..#.",
        "....#....",
        "....#....",
        "....#####"]

pp :: Pic -> IO ()
pp x = putStr (concat (map (++"\n") x))

flipV :: Pic -> Pic
flipV = map reverse 

flipV' :: Pic -> Pic
flipV' xs = [reverse x|x<-xs]

flipH :: Pic -> Pic
flipH = reverse 

above :: Pic -> Pic -> Pic
above x y = x ++ y

sideBySide :: Pic -> Pic -> Pic
sideBySide xs ys = map (\(x,y) -> x ++ y)(zip xs ys) 

sideBySide':: Pic -> Pic -> Pic
sideBySide' (x:xs) (y:ys) = (x ++ y) : sideBySide' xs ys
sideBySide' _ _ = []

sideBySide'' :: Pic -> Pic -> Pic
sideBySide'' = zipWith (++)

toRow :: String -> Pic
toRow xs = map (\x -> [x]) xs -- [[x]|x<-xs]

rotateR :: Pic -> Pic
rotateR [x] = toRow x
rotateR (x:xs) = (rotateR xs) `sideBySide` (toRow x)

rotateR' :: Pic -> Pic
rotateR' x = foldl1 sideBySide (reverse (map toRow x))


rotateL :: Pic -> Pic
rotateL [x] = reverse(toRow x)
rotateL (x:xs) = reverse(toRow x) `sideBySide` (rotateL xs)

rotateL' :: Pic -> Pic
rotateL' x = foldl1 sideBySide (map (reverse.toRow) x)

zoom :: Int -> Pic -> Pic
zoom n xs = [concat(map (replicate n) x)|x<-concat (map (replicate n) xs)]

data Expr = Num Int
          | Add Expr Expr
          | Sub Expr Expr
          | Mul Expr Expr
          | Div Expr Expr
          | Var Char
    deriving (Eq)

testExpr1 :: Expr
testExpr1 = Sub (Num 1) (Add (Num 2) (Num 3))  

testExpr2 :: Expr
testExpr2 = Add (Mul (Add (Num 1) (Num 2)) (Add (Num 4) (Var 'x')))
            (Mul (Num 1) (Var 'x'))
           
eval :: Expr -> Int
eval (Num x) = x
eval (Add l r) =  (eval l) + (eval r)
eval (Sub l r) =  (eval l) - (eval r)
eval (Mul l r) =  (eval l) * (eval r)
eval (Div l r) =  (eval l) `div` (eval r)

showExpr :: Expr -> String
showExpr expr = showExpr' expr NoOp

data Operation = Hi | HiDiv | Lo | LoSub | NoOp deriving (Eq)

showExpr' :: Expr -> Operation -> String
showExpr' (Num x) _ = show x
showExpr' (Var x) _ =  [x]
showExpr' (Add l r) op = let
  x = showExpr' l Lo ++"+"++showExpr' r Lo
  in if op == Hi || op == HiDiv || op==LoSub 
     then "(" ++ x ++")"
     else x
showExpr' (Sub l r) op = let
  x = showExpr' l Lo ++"-"++showExpr' r LoSub
  in if op == Hi || op == HiDiv || op==LoSub 
     then "(" ++ x ++")"
     else x     
showExpr' (Mul l r) op = let
  x = showExpr' l Hi ++"*"++showExpr' r Hi
  in if op == HiDiv
     then "(" ++ x ++")"
     else x
showExpr' (Div l r) _ = showExpr' l Hi ++"/"++showExpr' r HiDiv     

instance (Show Expr) where
  show = showExpr 

deriv :: Expr-> Char -> Expr

deriv (Num _) _ = (Num 0)     
deriv (Var x) y | x==y = (Num 1)
                | otherwise = (Num 0)
deriv (Add l r) x = Add (deriv l x) (deriv r x)                
deriv (Sub l r) x = Sub (deriv l x) (deriv r x)
deriv (Mul l r) x = Add (Mul (deriv l x) r) (Mul l (deriv r x))
deriv (Div l r) x = 
   Div
    (Sub (Mul (deriv l x) r) (Mul l (deriv r x)))
    (Mul r r)

simplify :: Expr -> Expr 
simplify x = 
  let 
    (continue, x') = simplify' x 
    simplify' :: Expr -> (Bool, Expr)
    simplify' (Add l r) = 
      let 
        ((lC, lE),(rC, rE)) = process l r
        (thisC, thisE) = simplify'(Add lE rE)  
      in (lC || rC || thisC, thisE)
    
    simplify' expr = basicRules expr

    process l r = (simplify' l, simplify' r)

    basicRules expr = (False,expr)
  in if continue then simplify x' else x'