eleven-sixteen.hs

import Data.List

-- problem 11
data Element a = Multiple a Int | Single a deriving (Show, Eq)  

encodeModified :: Eq a => [a] -> [Element a]
encodeModified [] = []
encodeModified l = map (\x -> if (length x > 1) then Multiple (head x) (length x) else Single (head x)) $ group l 


-- problem 12
decodeModified :: Eq a => [Element a] -> [a]
decodeModified [] = []
decodeModified l = concatMap innerDecode l 
				   where
				   innerDecode (Single v) = [v]
				   innerDecode (Multiple v t) = replicate t v


-- problem 13
encodeBis :: Eq a => [a] -> [(Int, a)]
encodeBis l = foldl helper [] l
			  where
			  helper [] e = [(1, e)] 
			  helper acc e
			    | e == (snd $ last acc) = init acc ++ [((fst $ last acc) + 1 , snd $ last acc)]
			    | otherwise = acc ++ [(1, e)]


encodeDirect :: Eq a => [a] -> [Element a]
encodeDirect [] = []
encodeDirect l = concatMap innerEncode (encodeBis l)
                 where 
                 innerEncode (1, v) = [Single v]
                 innerEncode (t, v) = [Multiple v t]


-- problem 14 
myDuplicate :: [a] -> [a]
myDuplicate = foldl (\acc x -> acc ++ (replicate 2 x)) [] 

myDuplicateEvenSimpler :: [a] -> [a]
myDuplicateEvenSimpler = foldl (\acc x -> acc ++ [x,x]) []


--problem 15
myRepli :: [a] -> Int -> [a]
myRepli l v = foldl (\acc x -> acc ++ (replicate v x)) [] l

myDuplicateUsingRepli l = myRepli l 2

fortyeight.hs

-- problem 48
tablen f n = do 
              let r = generateResultsAsStrings f n
              mapM_ putStrLn r
              
generateResultsAsStrings :: ([Bool] -> Bool) -> Int -> [String]
generateResultsAsStrings f n = map unwords $ map (\x -> (map show x ++ [show (f x)])) $ sequence $ replicate n [True, False]

logic.hs

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

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

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

infixl 4 `nand'`
nand' :: Bool -> Bool -> Bool
nand' a b = not' $ and' a b

infixl 4 `nor'`
nor' :: Bool -> Bool -> Bool
nor' a b = not' $ or' a b

infixl 4 `xor'`
xor' :: Bool -> Bool -> Bool
xor' True False = True
xor' True True = False
xor' False False = False
xor' False True = True

infixl 3 `impl'`
impl' :: Bool -> Bool -> Bool
impl' a b = or' (not' a) b

infixl 2 `eq'`
eq' :: Bool -> Bool -> Bool
eq' a b = and' (impl' a b) (impl' b a)

table :: (Bool -> Bool -> Bool) -> IO()
table logicalExp = let values = [(x,y, logicalExp x y) | x <- [True, False], y <- [True, False]]
                   in sequence_ [putStrLn ((show a) ++ "," ++ (show b) ++ "," ++ (show c)) | (a,b,c) <- values]

one-ten.hs

{-# LANGUAGE TemplateHaskell #-}
import Data.List

import Test.QuickCheck
import Test.QuickCheck.All


-- problem 1
myLast :: [a] -> a
myLast (x:[]) = x
myLast (x:xs) = myLast xs
myLast [] = error "Empty list"

myOneLineLast :: [a] -> a
myOneLineLast x = x !! (length x - 1)


-- problem 2
myButLast :: [a] -> a
myButLast (x:[]) = error "One element list"
myButLast (x:xs) = if length xs == 1 then x else myButLast xs
myButLast [] = error "Empty list"

myOneLineButLast :: [a] -> a
myOneLineButLast x = x !! (length x - 2)


-- problem 3
elementAt :: [a] -> Int -> a
elementAt (x:xs) 1 = x
elementAt (x:xs) v = elementAt xs (v-1)
elementAt _ _ = error "Index out of bounds"

myOneLineElementAt :: [a] -> Int -> a
myOneLineElementAt l v = l !! (v-1)


-- problem 4
myLength :: [a] -> Int
myLength l = foldl (\x o-> x+1) 0 l

myLength' :: [a] -> Int
myLength' = sum . map (\_ -> 1)  
    
-- problem 5
myReverse :: [a] -> [a]
myReverse l = foldl (\acc x  -> x:acc) [] l

myReverse' :: [a] -> [a]
myReverse' l = foldr (\x acc  -> acc ++ [x]) l []


-- problem 6
isPalindrome :: Eq a => [a] -> Bool
isPalindrome l = (reverse l) == l

isPalindrome' :: Eq a => [a] -> Bool
isPalindrome' [] = True
isPalindrome' (x:[]) = True
isPalindrome' l = (head l == last l) && isPalindrome (init $ tail l)


-- problem 7
data NestedList a = Elem a | List [NestedList a]

myFlatten :: NestedList a -> [a]
myFlatten (Elem a) = [a]
myFlatten (List x) = concatMap myFlatten x


-- problem 8
myCompress :: Eq a => [a] -> [a]
myCompress l = foldl (\acc x -> if ((length acc == 0) || (not (x == (last acc)))) then acc ++ [x] else acc) [] l
myCompress' :: Eq a => [a] -> [a]
myCompress' = map head . group 

--problem 9
myPackEasy :: Eq a => [a] -> [[a]]
myPackEasy = group 

myPackABitHarder :: Eq a => [a] -> [[a]]
myPackABitHarder [] = []
myPackABitHarder (x:xs) = let (equals, nequals) = span (==x) xs
                          in (x:equals) : myPackABitHarder nequals 

myPack :: Eq a => [a] -> [[a]]
myPack l = innerPack l [] 
            where innerPack [] acc = acc
                  innerPack (x:xs) [] = innerPack xs [[x]]
                  innerPack (x:xs) acc = if (head (last acc) == x) then innerPack xs (init acc ++ [x:(last acc)]) else innerPack xs (acc ++ [[x]])


-- problem 10
myEncode :: Eq a => [a] -> [(a, Int)]
myEncode l = map (\x -> (head x, length x)) (group l)

prop_myLast xs = length xs > 0 ==> myLast xs == last xs
prop_myOneLineLast xs = length xs > 0 ==> myOneLineLast xs == last xs
prop_myButLast xs = length xs > 1 ==> myButLast xs == myOneLineButLast xs
--prop_elementAt xs n = (n < length xs && n >= 1 && length xs > 0) ==> elementAt xs n == xs !! n
--prop_myOneLineElementAt xs n = myOneLineElementAt xs n == xs !! n
prop_myLength xs= myLength xs == length xs
prop_myLength' xs= myLength' xs == length xs
prop_myReverse xs = myReverse xs == reverse xs
prop_myReverse' xs= myReverse' xs == reverse xs



main = $(quickCheckAll)

thirties.hs

import Data.List (nub, group)
-- problem 31

isPrime :: Int -> Bool
isPrime n = length (filter (\x -> (mod n x) == 0) [2..n-1]) == 0 && n > 1

-- problem 32
pgcd :: Int ->  Int -> Int
pgcd a 0 = a
pgcd a b = pgcd b (mod a b)


-- problem 33
coprime :: Int -> Int -> Bool
coprime a b = pgcd a b == 1

-- problem 34
totientPhi :: Int -> Int
totientPhi n = length $ filter (\x -> x == True) $ map (\x -> coprime n x) [1..n]

primes n = [x | x <- [2..n-1], isPrime x]

-- problem 35
primeFactor :: Int -> [Int]
primeFactor n =  reverse $ helper n (reverse $ primes n) [] 
                           where helper 1 _ acc = acc
                                 helper n [] acc = acc
                                 helper n (x:xs) acc = if mod n x == 0 then helper (div n x) xs (acc ++ [x]) else helper n xs acc


generatePrimeFactor :: Int -> [Int] -> [Int] -> [Int]
generatePrimeFactor 1 _ acc = acc
generatePrimeFactor n [] acc = acc
generatePrimeFactor n p@(x:xs) acc = if mod n x == 0 then generatePrimeFactor (div n x) p (acc ++ [x]) else generatePrimeFactor n xs acc

primeFactorAsc :: Int -> [Int]
primeFactorAsc n =  nub $ generatePrimeFactor n (primes n) [] 


primeFactorAsc' :: Int -> [(Int, Int)]
primeFactorAsc' n =  map (\x -> (length x, head x)) $ group $ generatePrimeFactor n (primes n) []

twenties.hs

import Data.List
import System.Random

-- problem 21

myInsertAt :: a -> [a] -> Int -> [a]
myInsertAt newElement [] position = []
myInsertAt newElement l position = let (before, after) = splitAt (position-1) l
                                   in before ++ [newElement] ++ after

-- easy to do also with a zip and iterating on the index + generate back to a simple list element from tuple

myInsertAt' :: a -> [a] -> Int -> [a]
myInsertAt' newElement l position = fst $ foldl helper ([], 1) l
                                    where helper (acc, i) x = if i == position then (acc++[newElement, x], i+1) else (acc ++ [x], i+1) 


-- problem 22

myRange :: Int -> Int -> [Int]
myRange fi la = [fi..la]

myRangeBis fi la = foldl helper ([], fi) [fi]
                   where helper (acc, i) x = if i == (la+1) then (acc, i+1) else (acc ++ [i], i+1) 

myRangeIt :: Int -> Int -> [Int]
myRangeIt fi la = helper fi la []
                  where helper fi la acc = if fi == la then acc ++ [la] else helper (fi+1) la (acc ++ [fi])


---- problem 23
--myRandomSelect :: [a] -> Int -> IO()
myRandomSelect [] _ = return []
myRandomSelect l 0 = error "Number of elements to extract must be greater than 0"
myRandomSelect l n = do
                     randomNumber <- getStdRandom $ randomR(0, (length l)-1)
                     let p = [randomNumber]
                     return p

-- problem 26
myCombination :: Int -> [a] -> [[a]]
myCombination 0 _ = [[]]
myCombination _ [] = []
myCombination n (x:xs) = map (x:) (myCombination (n-1) xs) ++ (myCombination n xs)

myCombinationBis :: Int -> [a] -> [[a]]
myCombinationBis 0 _ = return []
myCombinationBis n l = do y:xs' <- tails l
                          ys <- myCombinationBis (n-1) xs'
                          return (y:ys)


removeAllElementsInList [] _ = []
removeAllElementsInList l1 l2 = map (\x -> snd x) $ filter (\(v, x) -> v == True) $ map (\x -> (notElem x l2, x)) l1

---- problem 27
--myGroup [] = []
--myGroup l = do twoElements <- myCombination 2 l
--               withoutTwoElements <- removeAllElementsInList l twoElements
--               return (withoutTwoElements)

--myCombinationWithLeftValues 0 l = [([], l)]
--myCombinationWithLeftValues n [] = []
--myCombinationWithLeftValues n (x:xs) = ts ++ ds
--                                where
--                                  ts = [ (x:ys, zs) | (ys, zs) <- myCombinationWithLeftValues (n-1) xs ] 
--                                  ds = [ (ys, x:zs) | (ys, zs)] <- myCombinationWithLeftValues n xs 
--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 ]


-- problem 28
compareFst::(Int, [a]) ->(Int, [a]) -> Ordering
compareFst a1 a2 = if (fst a1 > fst a2) then GT else LT

detuple = map (\x -> (snd x))
lsort :: [[a]] -> [[a]]
lsort l = detuple . sortBy compareFst $ map (\x -> (length x, x)) l

frequencySort :: Ord a => [[a]] -> [[a]]
frequencySort l = detuple . sortBy compareFst $ map (\x-> (length x, head x)) $ group $ sort l