exercises of `programming haskell`

programming_haskell.hs

-- 1.7.3
product' []     = 1
product' (x:xs) = x * product xs

-- 1.7.4
qsort []     = []
qsort (p:xs) = qsort smaller ++ [p] ++ qsort larger
               where
                 smaller = [x | x <- xs, x < p]
                 larger  = [x | x <- xs, x >= p]

-- 2.6.3
nsf = a `div` (length xs)
      where
        a = 10
        xs = [1,2,3,4,5]

-- 2.6.4
last'  xs = xs !! (length xs - 1)
last'' xs = head (drop (length xs - 1) xs)

-- 2.6.5
init' xs = take (length xs - 1) xs
init'' xs = reverse (tail (reverse xs))

-- 4.8.1
halve :: [a] -> ([a],[a])
halve xs | (length xs) `mod` 2 == 0 = (take hl xs, drop hl xs)
  where hl = (length xs) `div` 2

-- 4.8.2
safetail1 [] = []
safetail1 (x:xr) = xr
safetail2 xs = if null xs then [] else tail xs
safetail3 xs | null xs   = []
             | otherwise = tail xs

-- 4.8.3
True  || True  = True
True  || False = True
False || True  = True 
False || False = False

False || False = False
_     || _     = True

False || b = b
True  || _ = True

b || c | b == c    = b
       | otherwise = True

-- 4.8.4
b && c = if b then
           if c then True else False
         else False
              
-- 4.8.5
b && c = if b then c else False

-- 5.8.6
mult = \x -> (\y -> (\z -> x * y * z))

-- 5.7.1
sum [x*x | x <- [1..100]]

-- 5.7.2
replicate :: Int -> a -> [a]
replicate n x = [x| _ <- [1..n]]

-- 5.7.3
pyths :: Int -> [(Int,Int,Int)]
pyths n = [(x,y,z)|z <- [1..n], x <- [1..z], y <- [1..z], x^2 + y^2 == z^2]

-- 5.7.4
perfects :: Int -> [Int]
perfects n = [x| x <- [1..n], sum (init (factors x)) == x]
  where factors n = [x| x <- [1..n], n `mod` x == 0]

-- 5.7.5
concat [[(x,y)| y <- [4,5,6]]| x <- [1,2,3]]

-- 5.7.6
positions :: Eq a => a -> [a] -> [Int]
positions x xs = [i| (k,i) <- zip xs [0..n-1], k == x]
  where find k t = [v| (k',v) <- t, k == k']
        n = length xs

-- 5.7.7
scalarproduct :: [Int] -> [Int] -> Int
scalarproduct xs ys = sum [x * y | (x,y) <- (zip xs ys)]

-- 5.7.8
-- 
-- let2int c = ord c - ord 'a'
-- int2let n = chr (ord 'a' + n)

-- shift n c | isLower c = int2let ((let2int c + n) `mod` 26)
--           | otherwise = c

-- rotate n xs = drop n xs ++ take n xs

-- encode n xs = [shift n x| x <- xs]

-- crack :: String -> String
-- crack xs = encode (-factor) xs
--   where
--     factor = head (positions (minimum chitab) chitab)
--     chitab = [chisqr (rotate n table') table | n <- [0..25]]
--     table' = freqs xs

-- 6.8.1
(^) :: Int -> Int -> Int
n ^ 0 | n > 0 = 1
n ^ m | n >= 0 && m > 0 = n * n^(m-1)

-- 6.8.3
and :: [Bool] -> Bool
and []     = True
and (x:xr) = x && and xr

concat :: [[a]] -> [a]
concat []       = []
concat (xs:xss) = xs ++ concat xss

replicate :: Int -> a -> [a]
replicate 0 a = []
replicate n a = a:replicate (n-1) a

(!!) :: [a] -> Int -> a
(x:xr) !! 0 = x
(x:xr) !! n = xr !! (n-1)

elem :: Eq a => a -> [a] -> Bool
elem a []     = False
elem a (x:xs) = (a == x) || elem a xs

-- 6.8.4
merge :: Ord a => [a] -> [a] -> [a]
merge xs     []     = xs
merge []     ys     = ys
merge (x:xs) (y:ys) = if x > y then y:merge (x:xs) ys
                               else x:merge xs (y:ys)

-- 6.8.5
halve :: [a] -> ([a],[a])
halve xs | (length xs) >= 2 = (take hl xs, drop hl xs)
  where hl = (length xs) `div` 2

msort :: Ord a => [a] -> [a]
msort []  = []
msort [x] = [x]
msort xs  = merge (msort ys) (msort zs)
  where (ys,zs) = halve xs

-- 6.8.6
sum :: Num a => [a] -> a
sum []     = 0
sum (x:xs) = x + sum xs

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

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

-- 7.8.1
--- [f x| x <- xs, p x]
map f (filter p xs)

-- 7.8.2
all :: (a -> Bool) -> [a] -> Bool
all p []     = True
all p (x:xs) = p x && all p xs

any :: (a -> Bool) -> [a] -> Bool
any p [] = False
any p (x:xs) = p x || any p xs

takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p [] = []
takeWhile p (x:xs) | p x       = x : takeWhile p xs
                   | otherwise = []

dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p [] = []
dropWhile p (x:xs) | p x       = dropWhile p xs
                   | otherwise = x:xs

all p = (foldl (&&) True) . map p
any p = (foldl (||) False) . map p

-- 7.8.3
map f = foldr f []
  where f x xs = f x : xs

filter p = foldr g []
  where f x xs = if p x then x : xs else xs

-- 7.8.4
dec2int :: [Int] -> Int
dec2int = foldl f 0 where f acc i = 10*acc + i

-- 7.8.6
curry :: ((a,b) -> c) -> (a -> b -> c)
curry f = \x -> (\y -> f (x,y))

uncurry :: (a -> b -> c) -> ((a,b) -> c)
uncurry f = \(x,y) -> f x y

-- 7.8.7
unfold p h t x | p x       = []
               | otherwise = h x : unfold p h t (t x)

chop8 = unfold null (take 8) (drop 8)
map f = unfold null (f . head) tail
iterate f x = x : unfold (\_ -> False) f f