99 problems - 1 to 10

gistfile1.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)