Skip to content

Instantly share code, notes, and snippets.

@a2ndrade
Created July 21, 2014 15:06
Show Gist options
  • Save a2ndrade/4e3241f2a73fe93d7a96 to your computer and use it in GitHub Desktop.
Save a2ndrade/4e3241f2a73fe93d7a96 to your computer and use it in GitHub Desktop.
-- Learn you a Haskell for Great Good --
-- GIST: 4e3241f2a73fe93d7a96
import Data.List
import Data.Char
import qualified Data.Map as Map
-- head, tail, take, drop, takeWhile, dropWhile
-- fst, snd, zip, zipWith, flip
-- sum, product, maximum
sum2 :: Int -> Int -> Int
sum2 a b = a + b
-- pattern matching on Ints
factorial :: Int -> Int
factorial 0 = 1
factorial n = n * factorial (n-1)
-- pattern matching on tuples
addTuples :: (Double, Double) -> (Double,Double) -> (Double, Double)
addTuples (a,b) (c,d) = (a + c, b + d)
-- pattern matching on lists
head' :: [a] -> a
head' [] = error "cannot give head"
head' (x:_) = x
-- class constraints
tell :: (Show a) => [a] -> String
tell [] = "empty string"
tell (x:[]) = "list is one item " ++ show x
tell (x:y:_) = "list is more than one item, first two items are " ++ show x ++ " and " ++ show y
-- guards (replacements for big if/else conditions) + where + function body
bmiTell :: Double -> String
bmiTell bmi
| bmi <= 18.5 = "Underweigth"
| bmi <= 25.0 = "Normal"
| bmi <= 30.0 = "Overweigth"
bmiTell bmi = "You are Obese " ++ show doubleBmi
where doubleBmi = bmi * 2
-- where w/ pattern matching
initial :: String -> String -> (Char, Char)
initial firstName lastName = (f, l)
where (f:_) = firstName
(l:_) = lastName
-- case expression
head'' :: [a] -> a
head'' xs = case xs of [] -> error "cannot give head"
(x:_) -> x
-- recursion
fibonacci :: Int -> Int
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci n = fibonacci (n-1) + fibonacci (n-2)
-- sequence
--let fibonacciSeq = [fibonacci x | x <- [2..12]]
-- recursion
maximum' :: (Ord a) => [a] -> a
maximum' [] = error "empty list"
maximum' [x] = x
maximum' (x:xs) = max x (maximum' xs)
-- recursion
replicate' :: Int -> a -> [a]
replicate' 0 _ = []
replicate' 1 x = [x]
replicate' n x = x : replicate' (n-1) x
-- use guards instead of patterns b/c we're testing for a boolean condition
replicate'' :: Int -> a -> [a]
replicate'' n x
| n <= 0 = []
| otherwise = x : replicate'' (n-1) x
take' :: Int -> [a] -> [a]
take' n _
| n <= 0 = []
take' _ [] = []
take' n (x:xs) = x : take' (n-1) xs
zip' :: [a] -> [b] -> [(a,b)]
zip' [] _ = []
zip' _ [] = []
zip' (x:xs) (y:ys) = (x,y) : zip' xs ys
elem' :: (Eq a) => a -> [a] -> Bool
elem' x [] = False
elem' x (y:ys) = x == y || elem' x ys
quicksort' :: (Ord a) => [a] -> [a]
quicksort' [] = []
quicksort' (x:[]) = [x]
quicksort' (x:xs) = let smaller = quicksort' [l | l <- xs, l < x]
largerOrEqual = quicksort' [g | g <- xs, g >= x]
in smaller ++ x : largerOrEqual
-- curried functions
isAlpha :: Char -> Bool
isAlpha = (`elem` ['A'..'Z'])
applyTwice :: (a->a) -> a -> a
applyTwice f x = f (f x)
zipWith' :: (a->b->c) -> [a] -> [b] -> [c]
zipWith' _ [] _ = []
zipWith' _ _ [] = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
flip' :: (a -> b -> c) -> b -> a -> c
flip' f x y = f y x
-- common higher-order functions
map' :: (a -> b) -> [a] -> [b]
map' _ [] = []
map' f (x:xs) = f x : map' f xs
filter' :: (a -> Bool) -> [a] -> [a]
filter' f xs = [y | y <- xs, f y]
--find sum of all odd squares that are smaller than 10,000
--sum (takeWhile (<10000) (filter odd (map (^2) [1..])))
-- collatz sequences
collatz :: Integer -> [Integer]
collatz 1 = [1]
collatz n
| even n = n:collatz (n `div` 2)
| odd n = n:collatz (n * 3 + 1)
-- find # of chains larger than 15 for numbers between 1 and 100
--length (filter (>15) (map length (map collatz [1..100])))
--length (filter (\xs -> length xs > 15) (map collatz [1..100]))
--foldl' :: (a->b->a) -> a -> [b] -> a
--foldr' :: (a->b->b) -> b -> [a] -> b
reverse' :: [a] -> [a]
reverse' = foldl (\acc x -> x : acc) []
-- function composition
--replicate 2 (product (map (*3) (zipWith max [1,2] [4,5])))
--replicate 2 . product . map (*3) $ zipWith max [1,2] [4,5]
digits :: (Integral a) => a -> [a]
digits n
| n < 10 = [n]
| otherwise = digits (n `quot` 10) ++ [n `mod` 10]
-- (length $ takeWhile (/=40) $ map (foldl1 (+)) $ map digits [1..]) + 1
-- dictionaries
--
findByKey :: (Eq k) => [(k,v)] -> k -> Maybe v
findByKey [] key = Nothing
findByKey ((k,v):xs) key
| key == k = Just v
| otherwise = findByKey xs key
-- Map.fromList
-- Map.fromListWith
-- Mat.lookup
-- Mat.insert
-- Map.size
--
-- data types
data MyType = MyValueConstructor1 Int | MyValueConstructor2 Float
deriving (Show)
data SingleValueConstructor = SingleValueConstructor
deriving (Show)
data MyRecord = MyRecord {
name :: String,
age :: Int
} deriving (Show)
-- MyRecord "Antonio" 31
-- MyRecord {age=31, name="Antonio"}
-- value constructors are "tags" used to build new instances of the data (type) and pattern match them
data MyTypeConstructor a = MyOtherValueConstructor1 a | MyOtherValueConstructor2 a
deriving (Show)
myFunction :: (MyTypeConstructor a) -> (MyTypeConstructor a)
myFunction (MyOtherValueConstructor1 n) = MyOtherValueConstructor2 n
myFunction (MyOtherValueConstructor2 n) = MyOtherValueConstructor1 n
-- pattern matching is all about value constructors (including data structures which are
-- simply syntactic sugar for value constructors anyway)
-- type aliases
type MyString = String
-- binary search tree
data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show,Eq)
singleton :: a -> Tree a
singleton v = Node v EmptyTree EmptyTree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert v EmptyTree = singleton v
treeInsert v (Node n left right)
| v < n = Node n (treeInsert v left) right
| v > n = Node n left (treeInsert v right)
| otherwise = Node v left right
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem _ EmptyTree = False
treeElem v (Node n left right)
| v == n = True
| v < n = treeElem v left
| v > n = treeElem v right
-- type classes
class MyClass a where
something :: a -> [a]
instance MyClass (Tree a) where
something EmptyTree = [EmptyTree]
something (Node v _ _) = [Node v EmptyTree EmptyTree]
class YesNo a where
yesno :: a -> Bool
instance YesNo Int where
yesno 0 = False
yesno _ = True
instance YesNo [a] where
yesno [] = False
yesno _ = True
instance YesNo Bool where
yesno = id
-- functor
-- f is a type constructor with a single type parameter, not a concrete type!!!!!!
class Functor' f where
fmap' :: (a -> b) -> f a -> f b
instance Functor' Maybe where
fmap' _ Nothing = Nothing
fmap' f (Just a) = Just (f a)
instance Functor' [] where
fmap' = map
instance Functor' Tree where
fmap' _ EmptyTree = EmptyTree
fmap' f (Node v left right) = Node (f v) (fmap' f left) (fmap' f right)
-- first law of functors
-- fmap' id t == id t
-- second law of functors
-- fmap' ((+3) . (*4)) t == ((fmap' (+3)) . (fmap' (*4))) t
--
instance Functor' IO where
fmap' f action = do
original <- action
return (f original)
-- partially apply type constructor to obtain one with a single type parameter
instance Functor' (Either a) where
fmap' f (Right x) = Right (f x)
fmap' _ (Left x ) = Left x
instance Functor' (Map.Map k) where
fmap' = Map.map
runDo :: String -> IO ()
runDo a = putStrLn a
--data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show)
class Applicative' f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
instance Applicative' Tree where
pure a = Node a EmptyTree EmptyTree
(<*>) _ EmptyTree = EmptyTree
(<*>) EmptyTree _ = EmptyTree
(<*>) (Node g _ _) (Node v a b) = (Node (g v) ((<*>) (pure g) a) ((<*>) (pure g) b))
-- let t = foldr treeInsert EmptyTree [1,2,3]
-- let s = singleton (*2)
-- (<*>) s t
-- s <*> t
-- wrong! (incomplete)
-- instance Applicative' [] where
-- pure a = [a]
-- _ <*> [] = []
-- (x:_) <*> (y:ys) = x y:(pure x <*> ys)
-- right
instance Applicative' [] where
pure a = [a]
fs <*> xs = [f x | f <- fs, x <- xs]
-- [(+),(*)] <*> [1,2] <*> [3,4]
instance Applicative' IO where
pure = return
f <*> x = do
g <- f -- g is the function yielded by f
y <- x -- y is the value yielded by x
return (g y)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment