Experimenting with Haskell while reading Learn you a Haskell for Great Good

learn you a haskell for great good

{-# LANGUAGE ExistentialQuantification #-}
 
module Main where
 
import qualified Data.List as L
import qualified Data.Map as Map
 
{- How to make a heteregenous list of showable items, taken from
- http://www.haskell.org/haskellwiki/Heterogenous_collections-}
data Showable = forall a . Show a => MkShowable a
pack :: Show a => a -> Showable
pack = MkShowable
 
main :: IO ()
main = putStr $ unlines $ map f examples
where
f (MkShowable a) = show a
 
{- Examples!! -}
examples = [ pack $ reverse' [1, 2, 3, 4, 5, 6]
, pack $ reverse' [1, 2, 3, 4, 2, 1]
, pack $ reverse' [1]
{-, pack $ reverse' []-} {- Can't get this one to conform to type Showable! -}
, pack $ reverse' [8, 8, 8, 8, 8, 8]
{- Higher order functions and currying-}
, pack $ zipWith' (+) [4, 2, 5, 6] [2, 6, 2, 3]
, pack $ zipWith' max [6, 3, 2, 1] [7, 3, 1, 5]
, pack $ zipWith' (++) ["foo ", "bar ", "baz "] ["fighters", "hoppers", "aldrin"]
, pack $ zipWith' (*) (replicate 5 2) [1..]
{- Lambdas!-}
, pack $ zipWith (\a b -> (a * 30 + 3) / b) [5,4,3,2,1] [1,2,3,4,5]
, pack $ numLongChains
, pack $ map (\(a,b) -> a + b) [(1,2),(3,5),(6,3),(2,6),(2,5)]
{- Folding-}
, pack $ sum' [3,5,2,1]
, pack $ join ["apples", "oranges", "pears", "strawberries"] ", "
, pack $ product [19, 31]
 
{- Function composition -}
, pack $ negateThreeTimes 9
, pack $ map (negate . abs) [5,-3,-6,7,-3,2,-19,24]
, pack $ map ((++ "x") . (++ "y")) ["A", "B", "C"]
{-, pack $ map (ceiling . negate . tan . cos . max . tail) [-1, -2, -3, -4, -5, -6, -7, -8, -9, -10]-}
 
{- Modules -}
, pack $ L.nub [1, 2, 2, 2, 2, 3, 4, 5]
, pack $ findKey 712 [(123, "John"), (712, "Chris"), (983, "Derek")]
, pack $ findKeyFold 817 [(817, "Trecor"), (712, "Draco"), (983, "Atreyu")]
, pack $ Map.fromList [("betty","555-2938"),("bonnie","452-2928"),("lucille","205-2928")]
, pack $ "Euler..."
, pack $ foldl1 (+) [x | x <- [1..999], (mod x 3 == 0) || (mod x 5 == 0)]
, pack $ foldl1 (+) $ L.nub $ [3,6..999] ++ [5,10..999]
, pack $ sum $ L.nub $ [3,6..999] ++ [5,10..999]
, pack $ fib 10
, pack $ fibList [2, 1]
, pack $ foldl1 (+) [x | x <- fibList [2, 1], even x]
, pack $ [prime 0, prime 1, prime 7, prime 5, prime 11, prime 13, prime 17, prime 19]
, pack $ [prime 4, prime 6, prime 9, prime 10, prime 21, prime 25]
, pack $ [prime' 0, prime' 1, prime' 7, prime' 5, prime' 11, prime' 13, prime' 17, prime' 19]
, pack $ [prime' 4, prime' 6, prime' 9, prime' 10, prime' 21, prime' 25]
, pack $ prime 13
, pack $ factorX
]
 
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' _ [] _ = []
zipWith' _ _ [] = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
 
divideByTen :: (Floating a) => a -> a
divideByTen = (/10)
 
reverse' :: [a] -> [a]
reverse' [] = []
reverse' (x:xs) = reverse' xs ++ [x]
 
{- Collatz conjecture -}
chain :: (Integral a) => a -> [a]
chain 1 = [1]
chain n
| even n = n:chain (n `div` 2)
| odd n = n:chain (n*3 + 1)
 
numLongChains :: Int
numLongChains = length (filter (\xs -> length xs > 15) (map chain [1..100]))
 
sum' :: (Num a) => [a] -> a
sum' xs = foldl (\acc x -> acc + x) 0 xs
 
{-join :: [a] -> a-}
join xs with = foldl1 (\acc x -> acc ++ with ++ x) xs
 
{- Stdlib functions implemented using folds -}
maximum' :: (Ord a) => [a] -> a
maximum' = foldr1 (\x acc -> if x > acc then x else acc)
 
{-reverse' :: [a] -> [a]-}
{-reverse' = foldl (\acc x -> x : acc) []-}
 
product' :: (Num a) => [a] -> a
product' = foldr1 (*)
 
filter' :: (a -> Bool) -> [a] -> [a]
filter' p = foldr (\x acc -> if p x then x : acc else acc) []
 
head' :: [a] -> a
head' = foldr1 (\x _ -> x)
 
last' :: [a] -> a
last' = foldl1 (\_ x -> x)
 
negateThreeTimes = negate . (* 3)
 
findKey :: (Eq k) => k -> [(k,v)] -> Maybe v
findKey key [] = Nothing
findKey key ((k,v):xs) = if key == k
then Just v
else findKey key xs
 
findKeyFold :: (Eq k) => k -> [(k,v)] -> Maybe v
findKeyFold key = foldr (\(k,v) acc -> if key == k then Just v else acc) Nothing
 
{-fib :: (Integral a) => a -> b-}
fib 0 = 0
fib 1 = 1
fib n = fib(n - 1) + fib(n - 2)
 
{-fibList :: a -> [b] -> [b]-}
{-fibList max list =-}
{-let number = fib length list-}
{-in-}
{-if number < max then number ++ fibList max list-}
{-else []-}
 
fibList :: (Num a, Ord a) => [a] -> [a]
fibList (x:xs)
| x > 4000000 = xs
| otherwise = fibList ((x + (head xs)):x:xs)
 
prime n = null [x | x <- [2..(n - 1)], mod n x == 0]
 
divin :: (Integral a) => a -> a -> Bool
divin divisor number = rem divisor number == 0
 
{-prime' :: n -> n-}
prime' 0 = True
prime' n
| even n = False
| odd n = let divisors = [x | x <- [3..div n 2], odd x]
in null [x | x <- divisors, rem n x == 0]
 
{-factorX :: (Num a) => [a]-}
{-factorX = let start = 600851475143-}
{-in [x | x <- [1..round $ sqrt start], rem start x == 0, prime' x]-}
{-factorX = [x | x <- [1..round $ sqrt 600851475143], rem 600851475143 x == 0, prime' x]-}
{-factorX :: (Num a) => a-}
{-factorX :: Integer-}
{-biggestPrimeFactor :: (Integral a) => a -> Integer-}
 
biggestPrimeFactor :: (Integral a) => a -> Integer
biggestPrimeFactor into = last [x | x <- [1..round $ sqrt into], divin into x]
 
factorX = biggestPrimeFactor 600851475143