Koans

myLast :: [a] -> a
myLast xs = last xs

myButLast :: [a] -> a
myButLast = last . init

elementAt :: [a] -> Int -> a
elementAt xs num =
  last $ take num xs

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

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

isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs =
  if xs == reverse xs
  then True
  else False

data NestedList a = Elem a | List [NestedList a]

flatten :: NestedList a -> [a]
flatten (Elem e) = [e]
flatten (List (x:xs)) = flatten x ++ flatten (List xs)
flatten (List []) = []

compress :: Eq a => [a] -> [a]
compress [] = []
compress (x:xs) = x : (compress $ filter (/= x) xs)

pack :: Eq a => [a] -> [[a]]
pack [] = []
pack (x:xs) = (x : takeWhile (==x) xs) : pack (dropWhile (==x) xs)

encode :: Eq a => [a] -> [(Int, a)]
encode [] = []
encode xs =
  count p where
  p = pack xs
  count [] = []
  count (x:xs) = (length x, head x) : count xs

data EncodedData a = Single a | Multiple Int a
                   deriving (Show)

pack :: (Eq a) => [a] -> [[a]]
pack [] = []
pack (x:xs) = [x : takeWhile (==x) xs] ++ pack (dropWhile (==x) xs)

encodeModified :: (Eq a) => [a] -> [EncodedData a]
encodeModified = encode . pack
  where
    encode [] = []
    encode (x:xs) =
      if length x == 1
      then Single (head x) : encode xs
      else Multiple (length x) (head x) : encode xs

data EncodedData a = Single a | Multiple Int a
                   deriving (Show)

decodeModified :: Eq a => [EncodedData a] -> [a]
decodeModified = concatMap decode
  where
    decode (Single x) = [x]
    decode (Multiple n x) = replicate n x

data EncodedData a = Single a | Multiple Int a
                   deriving (Show)

encodeDirect :: (Eq a) => [a] -> [EncodedData a]
encodeDirect [] = []
encodeDirect (x:xs) =
  if (head xs) /= x
  then Single x : encodeDirect xs
  else
    Multiple (((+1) . length . takeWhile (==x)) xs) x
    : encodeDirect (dropWhile (==x) xs)

dupli :: [a] -> [a]
dupli [] = []
dupli (x:xs) =
  x : x : dupli xs

repli :: [a] -> Int -> [a]
repli [] _ = []
repli (x:xs) n =
  replicate n x ++ repli xs n

dropEvery :: [a] -> Int -> [a]
dropEvery [] _ = []
dropEvery xs n = dhelper xs n n
  where
    dhelper [] _ _ = []
    dhelper (x:xs) n 1 = dhelper xs n n
    dhelper (x:xs) n m = x : (dhelper xs n (m - 1))

split :: [a] -> Int -> ([a], [a])
split [] _ = ([], [])
split l@(x:xs) n =
  if n > 0
  then (x : ys, zs)
  else ([], l)
       where (ys, zs) = split xs (n - 1)

slice :: [a] -> Int -> Int -> [a]
slice [] _ _ = []
slice l start end =
  if start >= end
  then l
  else drop (start - 1) $ take end l

rotate :: [a] -> Int -> [a]
rotate [] _ = []
rotate xs n
  | abs n >= length xs = xs
  | n >= 0 = drop n xs ++ take n xs
  | otherwise = drop trunk xs ++ take trunk xs
                where trunk = length xs + n

removeAt :: Int -> [a] -> (Maybe a, [a])
removeAt _ [] = (Nothing, [])
removeAt ith xs
  | ith > length xs
    || ith <= 0 = (Nothing, xs)
  | otherwise = (Just cha, str) where
    cha = (last . (take ith)) xs
    str = (take (ith-1) xs) ++ (drop ith xs)

insertAt :: a -> [a] -> Int -> [a]
insertAt ch xs i
  | i <= 0 = ch : xs
  | i > length xs = xs ++ [ch]
  | otherwise = (take (i-1) xs) ++ [ch] ++ (drop (i-1) xs)

range :: (Enum a, Ord a) => a -> a -> [a]
range i j
  | i > j = []
  | otherwise = helper [i] j where
      helper xs j
        | last xs == j = xs
        | otherwise = helper (xs ++ [(succ . last) xs]) j

import System.Random (randomRIO)

rnd_select :: [a] -> Int -> IO [a]
rnd_select xs n
  | n < 0 = error "N must be greater than zero."
  | n == 0 = return []
  | otherwise = do
      r <- randomRIO (1, length xs)
      rest <- rnd_select (init (take r xs) ++ drop r xs) (n - 1)
      return $ (xs !! (r - 1)) : rest

import System.Random (randomRIO)

diff_select :: Int -> Int -> IO [Int]
diff_select n m
  | m < 1 = error "M must be greater than 1"
  | n > m = error "N must be less than M"
  | otherwise = helper n [1..m] where
      helper :: Int -> [Int] -> IO [Int]
      helper n xs =
        if n <= 0
        then return []
        else do
          r <- randomRIO (1, length xs)
          rest <- helper (n - 1) (init (take r xs) ++ drop r xs)
          return $ (xs !! (r - 1)) : rest

import System.Random (randomRIO)

rnd_permu :: [a] -> IO [a]
rnd_permu xs
  | length xs == 0 = return []
  | otherwise = do
      r <- randomRIO (1, length xs)
      rest <- rnd_permu $ (init $ take r xs) ++ drop r xs
      return $ xs !! (r - 1) : rest

combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations _ [] = [[]]
combinations i (x:xs) = x_start ++ others
  where x_start = [x : rest | rest <- combinations (i-1) xs]
        others = if i <= length xs
                 then combinations i xs
                 else []

import Data.List
import Data.Ord (comparing)
combination :: Int -> [a] -> [([a], [a])]
combination 0 xs = [([], xs)]
combination n [] = []
combination n (x:xs) = ts ++ ds
  where ts = [ (x:ys, zs) | (ys, zs) <- combination (n-1) xs ]
        ds = [ (ys, x:zs) | (ys, zs) <- combination n xs ]

group :: [Int] -> [a] -> [[[a]]]
group [] _ = [[]]
group (n:ns) xs =
  [ g:gs | (g, rs) <- combination n xs
         , gs      <- group ns rs ]

import Data.List
import Data.Ord (comparing)
lsort :: [[a]] -> [[a]]
lsort = sortBy (comparing length)
lfsort :: [[a]] -> [[a]]
lfsort lists = concat groups
  where groups = lsort $ groupBy equalLength $ lsort lists
        equalLength xs ys = length xs == length ys

isPrime :: Integral a => a -> Bool
isPrime n
  | n < 2 = error "Error!"
  | n == 2 = True
  | otherwise = pprime [2..n]
  where
    pprime (x:xs)
      | xs == [] = True
      | mod (last xs) x == 0 = False
      | otherwise = pprime xs

myGCD :: Integral a => a -> a -> a
myGCD x y =
  helper x' y' where
    x' = maximum [abs x, abs y] -- greater one
    y' = minimum [abs x, abs y] -- less one
    helper a b =
      let m = mod a b in
        if m == 0
        then b
        else
          helper b m

coprime :: Integral a => a -> a -> Bool
coprime x y =
  if gcd x y == 1 then True else False

totient :: Int -> Int
totient x
  | abs x == 0 = error "Error."
  | otherwise = length primes
  where 
    x' = abs x
    primes = filter (coprime x') [1..x']

import Data.List

primeFactors :: Integral a => a -> [a]
primeFactors n =
  if n == 1 || ps' == []
  then []
  else
    head ps' : primeFactors (div n' (head ps'))
  where
    primes = filterPrime [2..]
      where filterPrime (p:xs) =
              p : filterPrime [x | x <- xs, mod x p /= 0]
    n' = abs n
    ps = filter (<= n') primes
    ps' = filter ((==0) . mod n') ps

prime_factors_mult :: Int -> [(Int, Int)]
prime_factors_mult x =
  concatMap (\x -> [(x, pcount x ps)]) ups
  where
    ps = primeFactors x
    ups = nub ps
    pcount p ps = length $ filter (==p) ps

totient m =
  product [(p - 1) * p ^ (c - 1)
          | (p, c) <- prime_factors_mult m]

import Data.Maybe

isPrime :: Integral a => a -> Bool
isPrime n
  | n < 2 = error "Error!"
  | n == 2 = True
  | otherwise = pprime [2..n]
  where
    pprime (x:xs)
      | xs == [] = True
      | mod (last xs) x == 0 = False
      | otherwise = pprime xs

primesR :: Integral a => a -> a -> [a]
primesR x y
  | x > y || x < 2 = error "Error!!!"
  | otherwise =
    [x | x <- [x..y], isPrime x]

goldbach :: Integral a => a -> Maybe (a, a)
goldbach n =
  if l == []
  then Nothing
  else Just $ head l
  where
    l = [(x, y) | x <- pr, y <- pr, x + y == n]
    pr = primesR 2 (n-2)

goldbachList :: Integral a => a -> a -> Maybe [(a, a)]
goldbachList x y
  | x > y = Nothing
  | otherwise = Just s
    where
      s = [(fromJust . goldbach) a
          | a <- [x..y],
            (not . isNothing . goldbach) a,
            even a]

import Control.Monad (replicateM)

and' :: Bool -> Bool -> Bool
and' True True = True
and' _ _ = False

or' :: Bool -> Bool -> Bool
or' False False = False
or' _ _ = True

equ' :: Bool -> Bool -> Bool
equ' False False = True
equ' True True = True
equ' _ _ = False

table :: (Bool -> Bool -> Bool) -> IO ()
table f = putStrLn $ concatMap (++ "\n")
          [show a ++ " " ++ show b ++ " " ++ show (f a b)
          | a <- [True, False], b <- [True, False]]

-- Problem 47
infixl 4 `or'`
infixl 6 `and'`

table2 = table

-- Problem 48
infixl 3 `equ'`

tablen :: Int -> ([Bool] -> Bool) -> IO ()
tablen n f = mapM_ putStrLn [toStr a ++ " " ++ show (f a) | a <- args n]
  where args n = replicateM n [True, False]
        toStr = unwords . map (\x -> show x)

import Control.Monad (replicateM)

gray :: Int -> [[Char]]
gray x = replicateM x ['0', '1']

import Data.List
import Data.Ord (comparing)

data HTree a = Leaf a | Branch (HTree a) (HTree a)
             deriving Show

huffman :: (Ord a, Ord w, Num w) => [(a, w)] -> [(a, [Char])]
huffman freq = sortBy (comparing fst) $ serialize $
               htree $ sortBy (comparing fst) $ [(w, Leaf x) | (x, w) <- freq]
  where htree [(_, t)] = t
        htree ((w1, t1) : (w2, t2) : wts) =
          htree $ insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts
        serialize (Branch l r) =
          [(x, '0':code) | (x, code) <- serialize l] ++
          [(x, '1':code) | (x, code) <- serialize r]
        serialize (Leaf x) = [(x, "")]

import Data.List
import Data.Maybe (fromJust)

data Tree a = Empty | Branch a (Tree a) (Tree a)
            deriving (Show, Eq)

cbalTree :: Int -> [Tree Char]
cbalTree 0 = [Empty]
cbalTree n = let (q, r) = (n - 1) `quotRem` 2
  in [Branch 'x' left right | i     <- [q .. q + r],
                              left  <- cbalTree i,
                              right <- cbalTree (n - i - 1)]

mirror :: Tree a -> Tree a -> Bool
mirror Empty Empty = True
mirror (Branch _ l r) (Branch _ l' r') = mirror l r' && mirror r l'
mirror _ _ = False

symmetric :: Tree a -> Bool
symmetric t = mirror t t

-- Binary Search Tree
construct :: Integral a => [a] -> Tree a
construct [] = Empty
construct (x:xs) =
  let (l, r) = partition (< x) xs in
    Branch x (construct l) (construct r)
-- BST ends here.

symCbalTree :: Int -> [Tree Char]
symCbalTree = (filter symmetric) . cbalTree

hbalTree :: a -> Int -> [Tree a]
hbalTree x 0 = [Empty]
hbalTree x 1 = [Branch x Empty Empty]
hbalTree x h = [Branch x l r |
                (hl, hr) <- [(h-2, h-1), (h-1, h-1), (h-1, h-2)],
                l <- hbalTree x hl, r <- hbalTree x hr]

hbalTreeNodes :: a -> Int -> [Tree a]
hbalTreeNodes _ 0 = [Empty]
hbalTreeNodes x n = concatMap toFilteredTrees [minHeight .. maxHeight]
  where toFilteredTrees = filter ((n ==) . countNodes) . hbalTree x
        minNodesSeq = 0:1:zipWith ((+) . (+1)) minNodesSeq (tail minNodesSeq)
        minNodes = (minNodesSeq !!)
        minHeight = ceiling $ logBase 2 $ fromIntegral (n+1)
        maxHeight = (fromJust $ findIndex (>n) minNodesSeq) - 1
        countNodes Empty = 0
        countNodes (Branch _ l r) = 1 + countNodes l + countNodes r

data Tree a = Empty | Branch a (Tree a) (Tree a)
  deriving (Show, Eq)

tree4 = Branch 1 (Branch 2 Empty (Branch 4 Empty Empty))
                 (Branch 2 Empty Empty)

countLeaves :: Tree a -> Integer
countLeaves Empty = 0
countLeaves (Branch _ Empty Empty) = 1
countLeaves (Branch _ l r) =
  countLeaves l + countLeaves r

leaves :: Tree a -> [a]
leaves Empty = []
leaves (Branch x Empty Empty) = [x]
leaves (Branch _ l r) =
  leaves l ++ leaves r

internals :: Tree a -> [a]
internals Empty = []
internals (Branch _ Empty Empty) = []
internals (Branch x l r) =
  x : (internals l ++ internals r)

atLevel :: Tree a -> Int -> [a]
atLevel Empty _ = []
atLevel (Branch x l r) n =
  if n == 1
  then [x]
  else
    atLevel l (n-1) ++ atLevel r (n-1)

completeBinaryTree :: Int -> Tree Char
completeBinaryTree n = generate_tree 1
  where generate_tree x =
          if x > n then Empty
          else Branch 'x' (generate_tree (2*x))
                          (generate_tree (2*x+1))

calCompleteHeight :: Tree Char -> Maybe Int
calCompleteHeight Empty = Just 0
calCompleteHeight (Branch _ l r) = do
  hr <- calCompleteHeight r
  hl <- calCompleteHeight l
  if (hl == hr) || (hl - hr == 1)
    then return $ 1 + hl
    else Nothing
isCompleteBinaryTree = (/= Nothing) . calCompleteHeight

data Tree a = Empty | Branch a (Tree a) (Tree a)
  deriving (Show, Eq)

tree64 = Branch 'n'
                (Branch 'k'
                        (Branch 'c'
                                (Branch 'a' Empty Empty)
                                (Branch 'h'
                                        (Branch 'g'
                                                (Branch 'e' Empty Empty)
                                                Empty
                                        )
                                        Empty
                                )
                        )
                        (Branch 'm' Empty Empty)
                )
                (Branch 'u'
                        (Branch 'p'
                                Empty
                                (Branch 's'
                                        (Branch 'q' Empty Empty)
                                        Empty
                                )
                        )
                        Empty
                )

type Pos = (Int, Int)

layout :: Tree a -> Tree (a, Pos)
layout t = fst (layoutHelper 1 1 t)
  where layoutHelper x y Empty = (Empty, x)
        layoutHelper x y (Branch a l r) = (Branch (a, (x', y)) l' r', x'')
          where (l', x') = layoutHelper x (y+1) l
                (r', x'') = layoutHelper (x'+1) (y+1) r

-- 10.10
-- Given the following sets of consonants and vowels...
-- 1
stops = "pbtdkg"
vowels = "aeiou"
-- a)
triples stops vowels = [(x, y, z) | x <- stops, y <- vowels, z <- stops]
-- b)
triplesP stops vowels = [(x, y, z) | x <- stops, y <- vowels, z <- stops, x == 'p']
-- c)
nouns = ["cat", "dog", "banana"]
verbs = ["love", "kiss", "like"]
nounVerbNoun nouns verbs = [n ++ " " ++ v ++ " " ++ n' | n <- nouns, v <- verbs, n' <- nouns]

-- 2
-- this function calculates the average number of letters every word contains
avgWordLength x =
  (/) (fromIntegral letterNum) (fromIntegral wordNum)
    where
      letterNum = (sum (map length (words x)))
      wordNum = (length (words x))

-- rewrite functions using folds
-- 1
myOr :: [Bool] -> Bool
myOr = foldr (||) False

-- 2
myAny :: (a -> Bool) -> [a] -> Bool
myAny f = foldr ((||) . f) False

-- 3
myElem :: Eq a => a -> [a] -> Bool
myElem n = foldr ((||) . (==) n) False

-- 4
myReverse :: [a] -> [a]
myReverse = foldl (flip (:)) []

-- 5
myMap :: (a -> b) -> [a] -> [b]
myMap f = foldr ((:) . f) []

-- 6
myFilter :: (a -> Bool) -> [a] -> [a]
myFilter f = foldr (\x y -> if (f x) then x : y else y) []

-- 7
squish :: [[a]] -> [a]
squish = foldr (++) []

-- 8
squishMap :: (a -> [b]) -> [a] -> [b]
squishMap f = foldr ((++) . f) []

-- 9
squishAgain :: [[a]] -> [a]
squishAgain = squishMap id

-- 10
myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
myMaximumBy f xs = foldr (\x y -> if f x y == GT then x else y) (last xs) xs

-- 11
myMinimumBy :: (a -> a -> Ordering) -> [a] -> a
myMinimumBy f xs = foldr (\x y -> if f x y == LT then x else y) (last xs) xs

data Price =
  Price Integer
  deriving (Eq, Show)

data Manufacturer =
  Mini | Mazda | Tata
  deriving (Eq, Show)

data Airline =
  PapuAir | CatapultsR'Us | TakeYourChancesUnited
  deriving (Eq, Show)

data Vehicle =
  Car Manufacturer Price
  | Plane Airline
  deriving (Eq, Show)

myCar = Car Mini (Price 14000)
urCar = Car Mazda (Price 20000)
clownCar = Car Tata (Price 7000)
doge = Plane PapuAir

isCar :: Vehicle -> Bool
isCar (Car _ _) = True
isCar (Plane _) = False

isPlane :: Vehicle -> Bool
isPlane (Car _ _) = False
isPlane (Plane _) = True

areCars :: [Vehicle] -> [Bool]
areCars = map isCar

getManu :: Vehicle -> Manufacturer
getManu (Car m _) = m

data OperatingSystem =
  GnuPlusLinux
  | OpenBSDPlusNevermindJustBSDStill
  | Mac
  | Windows
  deriving (Eq, Show)

data ProgrammingLanguage =
  Haskell
  | Agda
  | Idris
  | PureScript
  deriving (Eq, Show)

data Programmer =
  Programmer { os :: OperatingSystem
             , lang :: ProgrammingLanguage }
  deriving (Eq, Show)

allOperatingSystems :: [OperatingSystem]
allOperatingSystems =
  [ GnuPlusLinux
  , OpenBSDPlusNevermindJustBSDStill
  , Mac
  , Windows ]

allLanguages :: [ProgrammingLanguage]
allLanguages =
  [ Haskell
  , Agda
  , Idris
  , PureScript ]

allProgrammers :: [Programmer]
allProgrammers = [Programmer { os = o, lang = l}
                 | o <- allOperatingSystems , l <- allLanguages]

-- Write map for BinaryTree
data BinaryTree a =
  Leaf
  | Node (BinaryTree a) a (BinaryTree a)
  deriving(Ord, Eq, Show)

mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left a right) =
  Node (mapTree f left) (f a) (mapTree f right)

testTree' :: BinaryTree Integer
testTree' =
  Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)

mapExpected =
  Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)

mapOkay =
  if mapTree (+1) testTree' == mapExpected
  then print "yup okay!"
  else error "test failed!"

-- Convert binarry trees to lists
preorder :: BinaryTree a -> [a]
preorder Leaf = []
preorder (Node left b right) = [b] ++ (preorder left) ++ (preorder right)

inorder :: BinaryTree a -> [a]
inorder Leaf = []
inorder (Node left b right) = (inorder left) ++ [b] ++ (inorder right)

postorder :: BinaryTree a -> [a]
postorder Leaf = []
postorder (Node left b right) = (postorder left) ++ (postorder right) ++ [b]

testTree :: BinaryTree Integer
testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf)

testPreorder :: IO ()
testPreorder =
  if preorder testTree == [2, 1, 3]
  then putStrLn "Preorder succeeded!"
  else putStrLn "Preorder failed!"

testInorder :: IO ()
testInorder =
  if inorder testTree == [1, 2, 3]
  then putStrLn "Inorder succeeded!"
  else putStrLn "Inorder failed!"

testPostorder :: IO ()
testPostorder =
  if postorder testTree == [1, 3, 2]
  then putStrLn "Postorder succeeded!"
  else putStrLn "Postorder failed!"

-- Write foldr for BinaryTree
foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b
foldTree f b bt = foldr f b (preorder bt)

testFoldTree :: IO ()
testFoldTree =
  if (foldTree (+) 1 testTree == 7)
  then putStrLn "foldTree succeeded!"
  else putStrLn "foldTree failed!"

import Data.Char

-- 1
isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool
isSubsequenceOf [] _ = True
isSubsequenceOf _ [] = False
isSubsequenceOf xa@(x:xs) (y:ys) =
  if x == y
  then isSubsequenceOf xs ys
  else isSubsequenceOf xa ys

-- 2
capitalizeWords :: String -> [(String, String)]
capitalizeWords [] = []
capitalizeWords s =
  [(w, ((toUpper . head $ w) : tail w)) | w <- (words s)]

import Data.Char

-- 1
capitalizeWord :: String -> String
capitalizeWord [] = []
capitalizeWord (w:ws) = toUpper w : ws
-- 2
capitalizeParagraph :: String -> String
capitalizeParagraph = go True
  where
    go _ [] = []
    go doIt (' ':cs) = ' ' : go doIt cs
    go doIt ('.':cs) = '.' : go True cs
    go False (c:cs) = c : go False cs
    go True (c:cs) = toUpper c : go False cs

import Data.Char
import Data.List

-- 1
type Digit = Char
type Presses = Int

data Button = Button Digit String deriving (Show)
data DaPhone = DaPhone [Button] deriving (Show)
phone :: DaPhone
phone = DaPhone [ Button '1' "1"
                , Button '2' "abc2"
                , Button '3' "def3"
                , Button '4' "ghi4"
                , Button '5' "jkl5"
                , Button '6' "mno6"
                , Button '7' "pqrs7"
                , Button '8' "tuv8"
                , Button '9' "wxyz9"
                , Button '*' ""
                , Button '0' " 0"
                , Button '#' "." ] 
-- 2
convo :: [String]
convo = [ "Wanna play 20 questions"
        , "Ya"
        , "U 1st haha"
        , "Lol ok. Have u ever tasted alcohol lol"
        , "Lol ya"
        , "Wow ur cool haha. Ur turn"
        , "Ok. Do u think I am pretty Lol"
        , "Lol ya"
        , "Haha thanks just making sure rofl ur turn" ]

containCharacter :: Char -> Button -> Bool
containCharacter x (Button y ys) = (toLower x) `elem` ys

findButton :: DaPhone -> Char -> Button
findButton (DaPhone buttons) x =
  head $ filter (containCharacter x) buttons

numberOfPresses :: String -> Char -> Presses
numberOfPresses [] _ = 0
numberOfPresses (x:xs) y =
  if x == toLower y
  then 1
  else 1 + numberOfPresses xs y

reverseTaps :: DaPhone -> Char -> [(Digit, Presses)]
reverseTaps phone x = uppercaseTap ++ digitTap
  where
    (Button digit chars) = findButton phone x
    uppercaseTap = if isUpper x then [('*', 1)] else []
    digitTap = [(digit, numberOfPresses chars x)]

flatten :: [[a]] -> [a]
flatten = foldr (++) []

cellPhonesDead :: DaPhone -> String -> [(Digit, Presses)]
cellPhonesDead p = flatten . map (reverseTaps p)

-- 3
fingerTaps :: [(Digit, Presses)] -> Presses
fingerTaps = sum . map snd

-- 4
countLetters :: String -> Char -> Int
countLetters str c = length $ filter (== c) str

mostPopularLetter :: String -> Char
mostPopularLetter [] = '\x0'
mostPopularLetter str = fst $ head $ filter ((== mx) . snd) lc
  where
    lc = [(e, countLetters str e) | e <- nub str]
    mx = maximum $ map snd lc

countWords :: String -> String -> Int
countWords str w = length $ filter (== w) (words str)

mostPopularWord :: String -> String
mostPopularWord [] = "\x0"
mostPopularWord str = fst $ head $ filter ((== mx) . snd) lc
  where
    lc = [(e, countWords str e) | e <- nub $ words str]
    mx = maximum $ map snd lc

coolestLtr :: [String] -> Char
coolestLtr = mostPopularLetter . flatten

coolestWord :: [String] -> String
coolestWord = mostPopularWord . flatten

data Expr =
  Lit Integer
  | Add Expr Expr

eval :: Expr -> Integer
eval (Lit i) = i
eval (Add e e') = (eval e) + (eval e')

printExpr :: Expr -> String
printExpr (Lit i) = show i
printExpr (Add e e') = (printExpr e) ++ " + " ++ (printExpr e')

-- 12.5 Chapter Exercises
import Data.Char
import Data.List
-- String processing
-- 1
notThe :: String -> Maybe String
notThe w =
  if w /= "the"
  then Just w
  else Nothing

vowels = "aeiou"

replaceThe :: String -> String
replaceThe s = unwords $ map (sub . notThe) (words s)
  where
    sub Nothing = "a"
    sub (Just w) = w

-- 2
countTheBeforeVowel :: String -> Integer
countTheBeforeVowel [] = 0
countTheBeforeVowel s =
  if length w <= 1
  then 0
  else
    if w!!0 == "the" && (w!!1)!!0 `elem` vowels
    then 1 + (countTheBeforeVowel s')
    else countTheBeforeVowel s'
  where
    w = words s
    s' = unwords $ drop 1 w

-- 3
countVowels :: String -> Integer
countVowels [] = 0
countVowels (c:cs) =
  if (toLower c) `elem` vowels
  then 1 + countVowels cs
  else countVowels cs
-- Another solution
countVowels' :: String -> Integer
countVowels' = sum . map (\x -> if (toLower x) `elem` vowels
                           then 1 else 0)
-- Validate the word
consonants = ['a'..'z'] \\ vowels
countConsonants :: String -> Integer
countConsonants = sum . map (\x -> if (toLower x) `elem` consonants
                              then 1 else 0)
newtype Word' = Word' String
  deriving (Eq, Show)
mkWord :: String -> Maybe Word'
mkWord str =
  if vn > cn
  then Nothing
  else Just (Word' str)
  where
    vn = countVowels str
    cn = countConsonants str

-- It's only Natural
data Nat =
  Zero
  | Succ Nat
  deriving (Eq, Show)

natToInteger :: Nat -> Integer
natToInteger Zero = 0
natToInteger (Succ n) = 1 + (natToInteger n)

integerToNat :: Integer -> Maybe Nat
integerToNat i
  | i < 0 = Nothing
  | i == 0 = Just Zero
  | otherwise = fmap Succ (integerToNat (i - 1))

-- Small library for Maybe

-- 1
isJust :: Maybe a -> Bool
isJust Nothing = False
isJust (Just _) = True

isNothing :: Maybe a -> Bool
isNothing Nothing = True
isNothing (Just _) = False

-- 2
mayybee :: b -> (a -> b) -> Maybe a -> b
mayybee m _ Nothing = m
mayybee _ f (Just n) = f n

-- 3
fromMaybe :: a -> Maybe a -> a
fromMaybe m Nothing = m
fromMaybe _ (Just n) = n

-- 4
listToMaybe :: [a] -> Maybe a
listToMaybe [] = Nothing
listToMaybe (x:xs) = Just x

maybeToList :: Maybe a -> [a]
maybeToList Nothing = []
maybeToList (Just x) = [x]

-- 5
catMaybes :: [Maybe a] -> [a]
catMaybes = concatMap m2l
  where
    m2l Nothing = []
    m2l (Just x) = [x]

-- 6
flipMaybe :: [Maybe a] -> Maybe [a]
flipMaybe xs = ck $ catMaybes xs
  where
    ck [] = Nothing
    ck x = Just x

-- Small library for Either

-- 1
lefts' :: [Either a b] -> [a]
lefts' = foldr pickLeft []
  where pickLeft (Right x) l = l
        pickLeft (Left x) l = x:l

-- 2
rights' :: [Either a b] -> [b]
rights' = foldr pickRight []
  where pickRight (Right x) l = x:l
        pickRight (Left x) l = l

-- 3
partitionEithers' :: [Either a b] -> ([a], [b])
partitionEithers' xs = (lefts' xs, rights' xs)

-- 4
eitherMaybe' :: (b -> c) -> Either a b -> Maybe c
eitherMaybe' _ (Left x) = Nothing
eitherMaybe' f (Right x) = Just (f x)

-- 5
either' :: (a -> c) -> (b -> c) -> Either a b -> c
either' f _ (Left x) = f x
either' _ f (Right x) = f x

-- 6
eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c
eitherMaybe'' f = either' (\_ -> Nothing) (Just . f)

-- Write your own iterate and unfoldr
myIterate :: (a -> a) -> a -> [a]
myIterate f x = [x] ++ (myIterate f (f x))

myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a]
myUnfoldr f x = [pickFst (f x)] ++ (myUnfoldr f (pickSnd (f x)))
  where
    pickFst :: Maybe (a, b) -> a
    pickFst (Just (x, y)) = x
    pickSnd :: Maybe (a, b) -> b
    pickSnd (Just (x, y)) = y

betterIterate :: (a -> a) -> a -> [a]
betterIterate f x = myUnfoldr (\x -> Just (x, (f x))) x

-- Finally something other than a list!
data BinaryTree a =
    Leaf
  | Node (BinaryTree a) a (BinaryTree a)
  deriving (Eq, Ord, Show)

-- 1
-- unfold (\x -> Myabe (x, x+1, x)) 0
unfold :: (a -> Maybe (a, b, a)) -> a -> BinaryTree b
unfold f a =
  case f a of
    Nothing -> Leaf
    Just (x, y, z) -> Node (unfold f x) y (unfold f z)

-- 2
treeBuild :: Integer -> BinaryTree Integer
treeBuild n = unfold treeHelper 0
  where treeHelper a
          | a < n = Just (a+1, a , a+1)
          | otherwise = Nothing

-- Optional monoid
import Data.Monoid

data Optional a =
    Nada
  | Only a
  deriving (Eq, Show)

instance Monoid a => Monoid (Optional a) where
  mempty = Nada
  mappend (Only x) Nada = Only x
  mappend Nada (Only x) = Only x
  mappend (Only x) (Only y) = Only (mappend x y)

-- Exercises: Heavy Lifting
a = fmap (+1) $ read "[1]" :: [Int]
b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"])
c = fmap (*2) (\x -> x - 2)
d = fmap ((return '1' ++) . show) (\x -> [x, 1..3])
e :: IO Integer
e = let ioi = readIO "1" :: IO Integer
        changed = fmap read $ fmap ("123"++) $ fmap show ioi
    in fmap (*3) changed

-- 16.10 Exercises: Instances of Func
-- 1
newtype Identity a = Identity a deriving (Eq, Show)
instance Functor Identity where
  fmap f (Identity a) = Identity (f a)
-- 2
data Pair a = Pair a a deriving (Eq, Show)
instance Functor Pair where
  fmap f (Pair a b) = Pair (f a) (f b)
-- 3
data Two a b = Two a b deriving (Eq, Show)
instance Functor (Two a) where
  fmap f (Two a b) = Two a (f b)
-- 4
data Three a b c = Three a b c deriving (Eq, Show)
instance Functor (Three a b) where
  fmap f (Three a b c) = Three a b (f c)
-- 5
data Three' a b = Three' a b b deriving (Eq, Show)
instance Functor (Three' a) where
  fmap f (Three' a b c) = Three' a (f b) (f c)
-- 6
data Four a b c d = Four a b c d deriving (Eq, Show)
instance Functor (Four a b c) where
  fmap f (Four a b c d) = Four a b c (f d)
-- 7
data Four' a b = Four' a a a b deriving (Eq, Show)
instance Functor (Four' a) where
  fmap f (Four' a b c d) = Four' a b c (f d)
-- 8
-- Trivial cannot be implemented because it has kind * while a Functor
-- instance requires a kind * -> *

-- Exercise: Possibly
data Possibly a =
    LolNope
  | Yeppers a
  deriving (Eq, Show)

instance Functor Possibly where
  fmap f (Yeppers a) = Yeppers (f a)
  fmap f LolNope = LolNope

-- Short Exercise
-- 1
data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)
instance Functor (Sum a) where
  fmap f (First a) = First a
  fmap f (Second b) = Second (f b)
-- 2
-- becuase the Left argument is a part of the Fucntor instance

{-# LANGUAGE FlexibleInstances #-}
-- 16.17 Chapter exercises
import GHC.Arr
-- 1
data Bool =
  False | True
-- no Functor instance
-- 2
data BoolAndSomethingElse a = False' a | True' a
instance Functor BoolAndSomethingElse where
  fmap f (False' a) = False' (f a)
  fmap f (True' a) = True' (f a)
-- 3
data BoolAndMaybeSomethingElse a = Falsish | Truish a
instance Functor BoolAndMaybeSomethingElse where
  fmap f (Truish a) = Truish (f a)
-- 4
newtype Mu f = InF { outF :: f (Mu f) }
-- I try to write implement a Functor instance for Mu but I failed. I
-- think it cannot be a Functor instance because Mu has kind (* -> *)
-- -> * but a Functor requires kind * -> *
-- 5
data D = D (Array Word Word) Int Int
-- It cannot be a Functor instance

-- Rearrange the arguments to the type constructor of the datatype so
-- the Functor instance works.
-- 1
data Sum a b =
    First b
  | Second a
instance Functor (Sum e) where
  fmap f (First a) = First (f a)
  fmap f (Second b) = Second b
-- 2
data Company a b c =
    DeepBlue a b
  | Something c
instance Functor (Company e e') where
  fmap f (Something b) = Something (f b)
  fmap _ (DeepBlue a c) = DeepBlue a c
-- 3
data More a b =
    L b a b
  | R a b a
  deriving (Eq, Show)
instance Functor (More x) where
  fmap f (L a b a') = L (f a) b (f a')
  fmap f (R b a b') = R b (f a) b'

{-# LANGUAGE FlexibleInstances #-}
-- 16.17 Chapter exercises
import GHC.Arr
-- 1
data Bool =
  False | True
-- no Functor instance
-- 2
data BoolAndSomethingElse a = False' a | True' a
instance Functor BoolAndSomethingElse where
  fmap f (False' a) = False' (f a)
  fmap f (True' a) = True' (f a)
-- 3
data BoolAndMaybeSomethingElse a = Falsish | Truish a
instance Functor BoolAndMaybeSomethingElse where
  fmap f (Truish a) = Truish (f a)
-- 4
newtype Mu f = InF { outF :: f (Mu f) }
-- I try to write implement a Functor instance for Mu but I failed. I
-- think it cannot be a Functor instance because Mu has kind (* -> *)
-- -> * but a Functor requires kind * -> *
-- 5
data D = D (Array Word Word) Int Int
-- It cannot be a Functor instance

-- Rearrange the arguments to the type constructor of the datatype so
-- the Functor instance works.
-- 1
data Sum a b =
    First b
  | Second a
instance Functor (Sum e) where
  fmap f (First a) = First (f a)
  fmap f (Second b) = Second b
-- 2
data Company a b c =
    DeepBlue a b
  | Something c
instance Functor (Company e e') where
  fmap f (Something b) = Something (f b)
  fmap _ (DeepBlue a c) = DeepBlue a c
-- 3
data More a b =
    L b a b
  | R a b a
  deriving (Eq, Show)
instance Functor (More x) where
  fmap f (L a b a') = L (f a) b (f a')
  fmap f (R b a b') = R b (f a) b'
-- Write Functor instances for the following datatypes.
-- 1
data Quant a b =
    Finance
  | Desk a
  | Bloor b
instance Functor (Quant a) where
  fmap f Finance = Finance
  fmap f (Desk a) = Desk a
  fmap f (Bloor b) = Bloor (f b)
-- 2
data K a b = K a
instance Functor (K a) where
  fmap f (K a) = K a
-- 3
newtype Flip f a b =
  Flip (f b a)
  deriving (Eq, Show)
newtype K' a b = K' a
instance Functor (Flip K' a) where
  fmap f (Flip (K' a)) = Flip $ K' (f a)
-- 4
data EvilGoateeConst a b =
  GoatyConst b
instance Functor (EvilGoateeConst a) where
  fmap f (GoatyConst a) = GoatyConst (f a)
-- 5
data LiftItOut f a =
  LiftItOut (f a)
instance Functor g => Functor (LiftItOut g) where
  fmap f (LiftItOut a) = LiftItOut (fmap f a)
-- 6
data Parappa f g a =
  DaWrappa (f a) (g a)
instance (Functor g, Functor h) => Functor (Parappa g h) where
  fmap f (DaWrappa g h) = DaWrappa (fmap f g) (fmap f h)
-- 7
data IgnoreOne f g a b =
  IgnoringSomething (f a) (g b)
instance Functor g => Functor (IgnoreOne f g a) where
  fmap f (IgnoringSomething x y) = IgnoringSomething x (fmap f y)
-- 8
data Notorious g o a t =
  Notorious (g o) (g a) (g t)
instance Functor g => Functor (Notorious g o a) where
  fmap f (Notorious x y z) = Notorious x y (fmap f z)
-- 9
data List a'' =
    Nil
  | Cons a'' (List a'')
instance Functor List where
  fmap f Nil = Nil
  fmap f (Cons a'' b'') = Cons (f a'') (fmap f b'')
-- 10
data GoatLord a =
    NoGoat
  | OneGoat a
  | MoreGoats (GoatLord a) (GoatLord a) (GoatLord a)
instance Functor GoatLord where
  fmap f NoGoat = NoGoat
  fmap f (OneGoat a) = OneGoat (f a)
  fmap f (MoreGoats x y z) = MoreGoats (fmap f x) (fmap f y) (fmap f z)
-- 11
data TalkToMe a =
    Halt
  | Print String a
  | Read (String -> a)
instance Functor TalkToMe where
  fmap _ Halt = Halt
  fmap f (Print str a) = Print str (f a)
  fmap f (Read s2a) = Read (f . s2a)

-- 17.5 Applicative in use
-- Exercises: Lookups
import Data.List (elemIndex)
-- 1
added :: Maybe Integer
added = (+3) <$> (lookup 3 $ zip [1, 2, 3] [4, 5, 6])
-- 2
y :: Maybe Integer
y = lookup 3 $ zip [1, 2, 3] [4, 5, 6]
z :: Maybe Integer
z = lookup 2 $ zip [1, 2, 3] [4, 5, 6]
tupled :: Maybe (Integer, Integer)
tupled = (,) <$> y <*> z
-- 3
x' :: Maybe Int
x' = elemIndex 3 [1..5]
y' :: Maybe Int
y' = elemIndex 4 [1..5]
max' :: Int -> Int -> Int
max' = max
maxed :: Maybe Int
maxed = max' <$> x' <*> y'
-- 4
xs = [1..3]
ys = [4..6]
x'' :: Maybe Integer
x'' = lookup 3 $ zip xs ys
y'' :: Maybe Integer
y'' = lookup 2 $ zip xs ys
summed :: Maybe Integer
summed = sum <$> ( (,) <$> x'' <*> y'' )

-- Exercise: Identity Instance
newtype Identity a = Identity a
  deriving (Eq, Ord, Show)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
  pure a = Identity a
  (<*>) (Identity f) (Identity a) = Identity (f a)

-- Exercise: Constant Instance
newtype Constant a b =
  Constant { getConstant :: a }
  deriving (Eq, Ord, Show)

instance Functor (Constant a) where
  fmap f (Constant b) = Constant b

instance Monoid a => Applicative (Constant a) where
  pure _ = Constant { getConstant = mempty }
  (<*>) (Constant x) (Constant y) = Constant (mappend x y)

-- Exercise: Fixer Upper
import Data.Maybe

main :: IO ()
main = do
  str1 <- return $ fromJust $ const <$> Just "Hello" <*> pure "World"
  str2 <- return $ fromJust $ (,,,) <$> Just 90
                                    <*> Just 10
                                    <*> Just "Timerness"
                                    <*> pure [1, 2, 3]
  print str1
  print str2

-- List Applicative Exercise

append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x $ xs `append` ys

fold :: (a -> b -> b) -> b -> List a -> b
fold _ b Nil = b
fold f b (Cons h t) = f h (fold f b t)

concat' :: List (List a) -> List a
concat' = fold append Nil

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons x y) = Cons (f x) (fmap f y)

instance Applicative List where
  pure x = Cons x Nil
  (<*>) _ Nil = Nil
  (<*>) Nil _ = Nil
  (<*>) (Cons f fs) xs = append (fmap f xs) (fs <*> xs)

flatMap :: (a -> List b) -> List a -> List b
flatMap f as = concat' $ fmap f as

take' :: Int -> List a -> List a
take' _ Nil = Nil
take' 0 _ = Nil
take' n (Cons x xs) = Cons x (take' (n-1) xs)

-- 17.9 Chapter Exercises

-- 1
data Pair a =
  Pair a a
  deriving Show
instance Functor Pair where
  fmap f (Pair x y) = Pair (f x) (f y)
instance Applicative Pair where
  pure x = Pair x x
  (<*>) (Pair f g) (Pair a b) = Pair (f a) (g b)

-- 2
data Two a b = Two a b
instance Functor (Two a) where
  fmap f (Two x y) = Two x (f y)
instance Monoid a => Applicative (Two a) where
  pure x = Two mempty x
  (<*>) (Two f g) (Two a b) = Two (mappend f a) (g b)
-- 3
data Three a b c = Three a b c
instance Functor (Three a b) where
  fmap f (Three x y z) = Three x y (f z)
instance (Monoid a, Monoid b) => Applicative (Three a b) where
  pure x = Three mempty mempty x
  (<*>) (Three f g h) (Three x y z) = Three (mappend f x) (mappend g y) (h z)
-- 4
data Three' a b = Three' a b b
instance Functor (Three' a) where
  fmap f (Three' x y z) = Three' x (f y) (f z)
instance Monoid a => Applicative (Three' a) where
  pure x = Three' mempty x x
  (<*>) (Three' f g h) (Three' x y z) = Three' (mappend f x) (g y) (h z)
-- 5
data Four a b c d = Four a b c d
instance Functor (Four a b c) where
  fmap f (Four x y z z') = Four x y z (f z')
instance (Monoid a, Monoid b, Monoid c) => Applicative (Four a b c) where
  pure x = Four mempty mempty mempty x
  (<*>) (Four f g h h') (Four x y z z') = Four (mappend f x) (mappend g y) (mappend h z) (h' z')
-- 6
data Four' a b = Four' a a a b
instance Functor (Four' a) where
  fmap f (Four' x y z z') = Four' x y z (f z')
instance Monoid a => Applicative (Four' a) where
  pure x = Four' mempty mempty mempty x
  (<*>) (Four' f g h h') (Four' x y z z') = Four' (mappend f x) (mappend g y) (mappend h z) (h' z')

-- Combinations
import Control.Applicative (liftA3)

stops :: String
stops = "pbtdkg"

vowels :: String
vowels = "aeiou"

combos :: [a] -> [b] -> [c] -> [(a, b, c)]
combos x y z = liftA3 (,,) x y z

main :: IO ()
main = do
  print . show $ combos stops vowels stops

-- The answer is the exercise
bind :: Monad m => (a -> m b) -> m a -> m b
bind = flip (>>=)

-- Short Exercise: Either Monad
data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

instance Functor (Sum a) where
  fmap f (First x) = First x
  fmap f (Second x) = Second (f x)

instance (Monoid a) => Applicative (Sum a) where
  pure x = Second x
  (<*>) (First x) _ = First x
  (<*>) _ (First x) = First x
  (<*>) (Second f) (Second x) = Second (f x)

instance (Monoid a) => Monad (Sum a) where
  return = pure
  (>>=) (First x) _ = First x
  (>>=) (Second x) f = f x

-- 18.7 Chapter Exercises
-- 1
data Nope a =
  NopeDotJpg
instance Functor Nope where
  fmap _ _ = NopeDotJpg
instance Applicative Nope where
  pure _ = NopeDotJpg
  (<*>) _ _ = NopeDotJpg
instance Monad Nope where
  return = pure
  (>>=) NopeDotJpg _ = NopeDotJpg
-- 2
data PhhhbbtttEither b a =
    Left' a
  | Right' b
instance Functor (PhhhbbtttEither b) where
  fmap _ (Right' x) = Right' x
  fmap f (Left' x) = Left' (f x)
instance (Monoid b) => Applicative (PhhhbbtttEither b) where
  pure x = Left' x
  (<*>) (Right' f) _ = Right' f
  (<*>) _ (Right' x) = Right' x
  (<*>) (Left' f) (Left' x) = Left' (f x)
instance (Monoid b) => Monad (PhhhbbtttEither b) where
  return = pure
  (>>=) (Right' x) _ = Right' x
  (>>=) (Left' x) f = f x
-- 3
newtype Identity a = Identity a
  deriving (Eq, Ord, Show)
instance Functor Identity where
  fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
  pure x = Identity x
  (<*>) (Identity f) (Identity x) = Identity (f x)
instance Monad Identity where
  return = pure
  (>>=) (Identity x) f = f x 
-- 4
data List a =
    Nil
  | Cons a (List a)
append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x $ xs `append` ys
instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons x l) = Cons (f x) (fmap f l)
instance Applicative List where
  pure x = Cons x Nil
  (<*>) Nil _ = Nil
  (<*>) _ Nil = Nil
  (<*>) (Cons f g) xs = fmap f xs `append` (g <*> xs) where
    append Nil ys = ys
    append (Cons x xs) ys = Cons x $ xs `append` ys
instance Monad List where
  return = pure
  (>>=) Nil _ = Nil
  (>>=) (Cons x l) f = f x `append` (l >>= f)

-- 18.7 Chapter Exercises
-- Write the following functions...
import Control.Monad
-- 1
j :: Monad m => m (m a) -> m a
j x = x >>= id
-- 2
l1 :: Monad m => (a -> b) -> m a -> m b
l1 = fmap
-- 3
l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c
l2 = liftM2
-- 4
a :: Monad m => m a -> m (a -> b) -> m b
a = flip (<*>)
-- 5
meh :: Monad m => [a] -> (a -> m b) -> m [b]
meh [] _ = return []
meh (x:xs) f = (++) <$> (fmap (\x -> [x]) $ f x) <*> (meh xs f)
-- 6
flipType :: (Monad m) => [m a] -> m [a]
flipType xs = meh xs id

def quick_sort(arr, first, last):
    if (first < last):
        wall = partition(arr, first, last)
        quick_sort(arr, first, wall - 1)
        quick_sort(arr, wall + 1, last)

def partition(arr, first, last):
    # use last element as pivot
    wall = first
    for pos in range(first, last):
        if (arr[pos] < arr[last]):
            arr[pos], arr[wall] = arr[wall], arr[pos]
            wall += 1
    arr[wall], arr[last] = arr[last], arr[wall]
    return wall

a = [5, 1, 6, 2, 4]
print(a)
quick_sort(a, 0, len(a) - 1)
print(a)

quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort small ++ (x : quicksort large)
  where small = [y | y <- xs, y <= x]
        large = [y | y <- xs, y > x]
main :: IO ()
main = do
  let test = [5, 1, 6, 2, 4] :: [Int]
  putStrLn $ show test
  putStrLn $ show (quicksort test)

def bubble_sort(arr):
    swapped = True
    while swapped:
        swapped = False
        for i in range(0, len(arr) - 1):
            if arr[i] > arr[i + 1]:
                arr[i], arr[i + 1] = arr[i + 1], arr[i]
                swapped = True

arr = [5, 1, 6, 2, 4]
print(arr)
bubble_sort(arr)
print(arr)

import numpy as np
import pandas as pd
from numpy.linalg import inv

data = pd.DataFrame({"square": [150, 200, 250, 300, 350, 400],
                     "price": [6450, 7450, 8450, 9450, 15450, 18450]})

x = data["square"]
x = np.row_stack((np.ones_like(x), x))
y = np.array(data["price"])
# Solution 1: normal equation
theta = np.dot(y, np.dot(x.T, inv(np.dot(x, x.T))))
print("[S1]: Results: {}".format(theta))
# Solution 2: Batch gradient descent.
theta = [-2400, 50]
alpha = 0.00000000001
for i in range(100000):
    hypo = np.dot(theta, x)
    loss = hypo - y
    cost = np.sum(loss ** 2) / (2 * x.shape[1])
    gradient = np.dot(loss, x.T) / x.shape[1]
    theta = theta - alpha * gradient
print("[S2]: Results: {}".format(theta))

import numpy as np
import pandas as pd
from sklearn import linear_model

data = pd.DataFrame({"square": [150, 200, 250, 300, 350, 400],
                     "price": [6450, 7450, 8450, 9450, 15450, 18450]})
regr = linear_model.LinearRegression()
regr.fit(data["square"].values.reshape(-1, 1), data["price"])
a, b = regr.coef_, regr.intercept_
print("Results: {}\t{}".format(b, a[0]))