Practice for H-99: Ninety-Nine Haskell Problems( http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems )

h99_p01_10.hs

-- Problem 1
myLast [] = error "empty list."
myLast [x] = x
myLast (x:xs) = myLast xs 

-- Problem 2
myButLast x = head . drop 1 . reverse $ x

-- Problem 3
elementAt (x:xs) n =
    if n == 1 then x
    else elementAt xs (n-1)

-- Problem 4
myLength x = myLength_ x 0

myLength_ [] n = n
myLength_ (x:xs) n = myLength_ xs (n+1)

myLength' x= foldr (\e n -> n+1) 0 x 

-- Problem 5
myReverse x = myReverse_ x []

myReverse_ [] y = y
myReverse_ (x:xs) y = myReverse_ xs ([x] ++ y)

myReverse' x = foldr (\e y -> y ++ [e]) [] x

-- Problem 6
isPalindrome x = x == myReverse' x

-- Problem 7
data ListType = List [ListType] | Elem Int  deriving (Show)

flatten x = flatten_ x []

flatten_ (Elem a) y = y ++ [a]
flatten_ (List []) y = y
flatten_ (List (x:xs)) y = flatten_ (List xs) (y ++ (flatten_ x [])) 

flatten' (Elem a) = [a]
flatten' (List []) = []
flatten' (List (x:xs)) = flatten' x ++ flatten' (List xs)

-- Problem 8
compress [] = []
compress x = compress_ x [head x]

compress_ [] y = y
compress_ (x:xs) y =
    if x == last y then compress_ xs y
    else compress_ xs (y ++ [x])


-- Problem 9
pack [] = []
pack x =  pack_ (drop 1 rx) [[head rx]]
    where rx = reverse x

pack_ [] y = y
pack_ (x:xs) (y:ys) = 
    if x == head y then pack_ xs ([(x:y)] ++ ys)
    else pack_ xs ([[x]] ++ (y:ys))

-- Problem 10
encode x = map (\e -> (length e, head e)) (pack x)

h99_p11_p20.hs

-- Problem 9
pack [] = []
pack x =  pack_ (drop 1 rx) [[head rx]]
    where rx = reverse x

pack_ [] y = y
pack_ (x:xs) (y:ys) = 
    if x == head y then pack_ xs ([(x:y)] ++ ys)
    else pack_ xs ([[x]] ++ (y:ys))

-- Problem 10
encode x = map (\e -> (length e, head e)) (pack x)

-- Problem 11
data RunLength = Multiple Int Char | Single Char deriving Show

encodeModified x = map (\(x, y) -> if x == 1 then Single y else Multiple x y) $ encode x

-- Problem 12
decodeModified x = foldr decode' [] x 

decode' (Multiple n s) y = replicate n s ++ y
decode' (Single s) y = (s:y)

decode (Multiple n s) y =
    if n == 2 then decode (Single s) (s:y)
    else decode (Multiple (n-1) s) (s:y)
decode (Single s) y = (s:y)

-- Problem 13

-- Problem 14
dulpli x = foldr (\x y-> x:x:y) [] x

-- Problem 15
repli x n = foldr (\e y-> replicate n e ++ y) [] x

-- Problem 16
dropEvery x n = foldr (\(no, e) y -> if no `mod` n == 0 then y else e:y ) [] $ zip [1..] x

dropEvery' l n = map snd 
                   $ filter (\(x, _) -> x `mod` n /=0)
                   $ zip [1..] l

-- Problem 17
mySplit x n = foldr (\(no, e) (u, v) -> if no <= n then (e:u, v) else (u, e:v)) ([],[]) $ zip [1..] x

mySplit' l n = (take n l, drop n l) 

-- Problem 18
mySlice x nb ne = foldr (\(no, e) y -> if no >= nb && no <= ne then e:y else y) [] $ zip [1..] x

mySlice' l nb ne = take (ne-nb+1) $ drop (nb-1) l

-- Problem 19
rotate l rn = (snd $ splitAt prn l) ++ (fst $ splitAt prn l) 
    where prn = if rn < 0 then rn + length l else rn 

-- Problem 20
removeAt n l = (last . fst $ splitAt n l, (fst $ splitAt (n-1) l) ++ (snd $ splitAt n l))

h99_p21_p22_p26.hs

import Prime

-- Problem 21
insertAt c l n = (fst $ splitAt (n-1) l) ++ [c] ++ (snd $ splitAt (n-1) l)

-- Problem 22
range b e = reverse $ range_ b e []
range_ p e l = if p <= e then range_ (p+1) e (p:l) else l

-- Problem 26
combination n s =  comb n "" s 

comb n ps s =
    if n == 1 then map (\x-> ps ++ [x]) s
    else 
        if length s < n then [] 
        else concat . map (\x@(l:ls) -> comb (n-1) (ps++[l]) ls) $ reverse $ subList s [] 

subList [] y = y
subList l@(x:xs) y = subList xs (l:y)

-- written by Josh Ko
comb' :: Int -> [a] -> [[a]]
comb' n = filter ((==n) . length) . foldr (\x xss -> map (x:) xss ++ xss) [[]]

h99_p40_p41_p49_p50.hs

import Data.List
import Data.Function

-- Problem 40
goldbach n = flip goldbach1 $ primeList (truncate $ fromIntegral n/2.0)

goldbach1 :: (Integral a) => a -> [a] -> (a, a)
goldbach1 n plist = head . filter (\(_, x) -> isPrime x plist) $ map (\x -> (x, n-x)) plist 

-- Problem 41
goldbachlist :: (Integral a) => a -> a -> [(a, a)]
goldbachlist b e = map (flip goldbach1 $ plist) [x |x <- [b..e], x `mod` 2 == 0]
    where plist = primeList (truncate $ fromIntegral e/2.0)

goldbachlist1 ::  (Integral a) => a -> a -> a -> [(a, a)] 
goldbachlist1 b e lower = filter (\(x, _) -> x >= lower) $ goldbachlist b e

--- Prime
primeList :: (Integral a) => a -> [a]
primeList x = [2, 3] ++ primeList_ 5 x False [] 

primeList_ :: (Integral a) => a -> a -> Bool -> [a] -> [a]
primeList_ c e b x
    = if c < e then
          if isPrime c x then
              primeList_ (c+add) e (not b) (x ++ [c])
          else 
              primeList_ (c+add) e (not b) x
      else x
      where add = if b then 4 else 2

isPrime :: (Integral a) => a -> [a] -> Bool
isPrime x y
    | x == 0 = False
    | x == 1 = False
    | x == 2 = True
    | otherwise =
        isPrime_ x y (truncate (sqrt (fromIntegral x)) + 1)


isPrime_ :: (Integral a) => a -> [a] -> a -> Bool
isPrime_ x y sq =
    case y of
        [] -> True
        y:ys -> if y < sq then
                    if (x `mod` y == 0) then False
                    else isPrime_ x ys sq
                else True

-- Problem 49
gray :: Int -> [[Char]]
gray n = if n == 0 then [[]] else let g = gray (n-1) in map ('0':) g ++ map ('1':) (reverse g)
     
-- Problem 50
data HTree a b = Node (a, b) | INode (HTree a b) (HTree a b) deriving (Show, Eq, Read) 

huffmanCode :: (Num b, Ord b) => [(a, b)] -> [(a, [Char])]
huffmanCode = huffmanCode_ "" . huffmanTree . (map (\(x, y) -> Node (x, y))) 

value :: (Num b) => HTree a b -> b
value (Node (a, b)) = b
value (INode left right) = (value left) + (value right)

huffmanCode_ :: (Num b, Ord b) => [Char] -> (HTree a b) -> [(a, [Char])]
huffmanCode_ s (Node (a, _)) = [(a, s)]
huffmanCode_ s (INode left right) = (huffmanCode_ ('0':s) left ) ++ (huffmanCode_ ('1':s) right)

huffmanTree :: (Num b, Ord b) => [HTree a b] -> (HTree a b)
huffmanTree nl = 
    if length nl == 1 then head nl
    else let snl@(x:xs:xss) = sortBy (compare `on` (\n -> value n)) nl in 
         huffmanTree ((INode x xs):xss)