Programming in Haskell excercises

4.hs

-- 4.8.1

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

-- Eek, I'm sure that's not ideal!

-- 4.8.2

-- a) Conditional

safetail :: [a] -> [a]
safetail xs = if length xs == 0 then [] else tail xs

-- b) Guarded

safetail' :: [a] -> [a]
safetail' xs | length xs == 0 = []
            | otherwise = tail xs

-- c) Pattern matching

safetail'' :: [a] -> [a]
safetail'' [] = []
safetail'' xs = tail xs

-- Oh, length xs == 0 could be replace with null xs. And I'm sure other wonderful things.

-- 4.8.3

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

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


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

-- I'm not sure what else to do, sure I could make another look different.

--- 4.8.4

and' :: Bool -> Bool -> Bool
and' x y = if x == True then
               if y == True then
                    True
               else
                    False
            else
                False

-- Not sure I'm doing this right yet..

-- 4.8.5

and'' :: Bool -> Bool -> Bool
and'' x y = if x == True then
                y
            else
                False

-- Aha, you save a comparison! 

-- 4.8.6

-- > (\x -> (\y -> (\z -> x * y * z))) 2 4 6
-- 48

5.hs

import Data.List
import Char

-- 5.7.1

-- > sum [x*x|x<-[1..100]]
-- 338350

-- 5.7.2

replicate' :: Int -> a -> [a]
replicate' x y = [y | _ <- [1..x]]

-- 5.7.3

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

-- 5.7.4

factors :: Int -> [Int]
factors x = (\m -> nub(concat [ [x, y] | x <- [1..m], y <- [1..m], x * y == m ])) x

perfects :: Int -> [Int]
perfects x = [ n | n <- [1..x], sum ( filter (\z -> z /= n) ( factors n ) ) == n ]

-- Got there. Not gracefully ;-)

-- 5.7.5

original :: [(Int,Int)]
original = [ (x,y) | x <- [1,2,3], y <- [1,2,3] ]


new :: [(Int,Int)]
new = concat [ [ (x, y) | x <- [1..3]]  | y <- [1..3] ]

-- 5.7.6
--

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

find' :: Eq a => a -> [(a,b)] -> [b]
find' x xs = [ i | (x', i) <- xs, x == x' ]

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

-- 5.7.7

scaleproduct :: [Int] -> [Int] -> Int
scaleproduct os es = sum [ a * b | (a, b) <- zip os es ]

-- 5.7.8

let2int :: Char -> Int
let2int a = Char.ord a - Char.ord 'a'

int2let :: Int -> Char
int2let a = Char.chr (a + Char.ord 'a')

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

encode :: Int -> [Char] -> [Char]
encode d xs = [ shift d r | r <- xs ]

let2int' :: Char -> Int
let2int a | isLower a = Char.ord a - Char.ord 'a'
          | isUpper a = Char.ord a - Char.ord 'A'

int2let' :: Int -> Char
int2let' a | IsLower = Char.chr (a + Char.ord 'A')

shift' :: Int -> Char -> Char
shift' n c | islower c = int2let((let2int c + n) `mod` 26)
           | isupper c = int2let((let2int c + n) `mod` 26)
           | otherwise = c

encode' :: Int -> [Char] -> [Char]
encode' d xs = [ shift d r | r <- xs ]

6.hs

-- 6.8.1

exp' :: Int -> Int -> Int
exp' x 0 = x
exp' x y = exp' (x * y) (y - 1)

-- exp' 2 2
-- exp' 4 1
-- exp' 4 0
-- 4

-- 6.8.2

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

-- length [1, 2, 3]
--      1 + length [2, 3]
--          1 + length [3]
--              1 + length []
--              1 + 0
--          1 + 1 + 0
--      1 + 1 + 1 + 0
--      3

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

-- drop 3 [1,2,3,4,5]
-- drop 2 [2,3,4,5]
-- drop 1 [3,4,5]
-- drop 0 [4,5]
-- [4,5]
--
-- Oh, my definition of drop' is different to the prelude and the book. Seems to work ok (famous last thoughts on the matter?).

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

-- init [1,2,3]
-- 1 : init[2,3]
-- 1 : 2 : init[3]
-- 1 : 2 : []
-- [1, 2]

-- Those three examples seemed to all evaluate differently. First seemed build an arithmetic expression outwards,
-- the second passed all the information to the next function, the last was like the first but building a cons list.
-- I'm sure I've read (and maybe know!) about some of this stuff. Anyways, lots to learn, NEXT!

-- 6.8.3

and' :: [Bool] -> Bool
and' [] = True
and' (False:_) = False
and' (True:xs) = and' xs

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

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

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

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

-- 6.8.4

merge' :: Ord a => [a] -> [a] -> [a]
merge' [] [] = []
merge' [] (y:ys) = y : merge' [] ys
merge' (x:xs) [] = x : merge' [] xs 
merge' (x:xs) (y:ys) | x > y = y : merge' (x:xs) ys
                     | otherwise = x : merge' xs (y:ys)
            

-- 6.8.5

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

qsort :: (Ord a) => [a] -> [a]
qsort [] = []
qsort (x : xs) = qsort smaller ++ [x] ++ qsort larger
    where 
        smaller = [ a | a <- xs, a <= x ]
        larger = [ b | b <-xs, b > x ]

msort :: Ord a => [a] -> [a]
msort a = merge' (qsort b) (qsort c)
    where
        (b, c) = halve a

-- I don't think that's recursive, and I don't think it should use quick sort.
-- This merge sort idea isn't as crazy as I thought.

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

-- 6.8.6

-- step 1
sum' :: [Int] -> Int

-- step 2
-- sum' [] = 
---sum' (x : xs) =

-- step 3
-- sum' [] = 0
-- sum' (x : xs) =

-- step 4
-- sum' [] = 0
-- sum' (x : xs) = x + sum' xs

-- step 5
sum' = foldr (+) 0


-- step 1
take' :: Int -> [Int] -> [Int] 

-- step 2
--take n [] = 
--take' 0 xs =
--take' n (x:xs) = 

-- step 3 & 4
take' n [] = []
take' 0 xs = []
take' n (x:xs) = x : take' (n - 1) xs  

-- step 5 
-- step 5?
-- Hmmm. Simplify? Fold[l/r]?

-- step 1
last' :: [Int] -> Int

-- step 2
-- last' [x] = 
-- last' (x:xs) =

-- step 3 & 4
last' [x] = x
last' (x:xs) = last' xs

-- step 5 
-- step 5?
-- Hmmm. Simplify? Fold[l/r]?