Skip to content

Instantly share code, notes, and snippets.

@yen3
Last active September 15, 2016 15:43
Show Gist options
  • Save yen3/6403224 to your computer and use it in GitHub Desktop.
Save yen3/6403224 to your computer and use it in GitHub Desktop.
Practice for H-99: Ninety-Nine Haskell Problems( http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems )
-- 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)
-- 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))
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) [[]]
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment