Skip to content

Instantly share code, notes, and snippets.

View deque-blog's full-sized avatar

deque-blog

3 followers · 5 following
View GitHub Profile
@deque-blog
deque-blog / rose_tree.hs
Last active December 23, 2016 21:22
data Tree a
= EmptyTree
| Tree { root :: Node a }
data Node a
= Node {
value :: a,
children :: [Node a] }
@deque-blog
deque-blog / rose_tree_naive_walk.hs
Created December 23, 2016 21:23
treeWalkR :: Tree a -> [a]
treeWalkR EmptyTree = []
treeWalkR (Tree root) = treeWalkR' root
treeWalkR' :: Node a -> [a]
treeWalkR' (Node v children) = v : concatMap treeWalkR' children
@deque-blog
deque-blog / rose_tree_iterative_walk.hs
Created December 23, 2016 21:24
treeWalkH :: Tree a -> [a]
treeWalkH EmptyTree = []
treeWalkH (Tree root) = treeWalkH' root
treeWalkH' :: Node a -> [a]
treeWalkH' = reverse . loop [] []
where
loop out [] (Node v []) = v:out -- End of traversal
loop out stack (Node v (c:cs)) = loop (v:out) (toStack (cs:stack)) c
loop out (h:t) (Node v []) = loop (v:out) (toStack (tail h:t)) (head h)
@deque-blog
deque-blog / rose_tree_cps_monad_walk.hs
Created December 23, 2016 21:40
treeWalkM :: Tree a -> [a]
treeWalkM EmptyTree = []
treeWalkM (Tree root) = treeWalkM' root
treeWalkM' :: Node a -> [a]
treeWalkM' n = runCont (loop n) id
where
loop (Node v cs) = do
rs <- mapM loop cs
return (v : concat rs)
@deque-blog
deque-blog / merge_sort_with_fold.hs
Last active December 25, 2016 09:55
foldMergeSort :: (Ord a) => [a] -> [a]
foldMergeSort =
foldl1 (flip merge) . map snd . foldl addToCounter []
where
addToCounter counter x = propagate ((1::Int,[x]) : counter)
propagate [] = []
propagate [x] = [x]
propagate counter@(x:y:xs) -- x arrived last => combine on right
| fst x == fst y = propagate ((fst x + fst y, merge (snd y) (snd x)) : xs)
| otherwise = counter
@deque-blog
deque-blog / merge_monoid_with_fold.hs
Last active December 25, 2016 09:56
foldMonoidTree :: (Monoid a) => [a] -> a
foldMonoidTree =
foldl1 (flip (<>)) . map snd . foldl addToCounter []
where
addToCounter counter x = propagate ((1::Int,x) : counter)
propagate [] = []
propagate [x] = [x]
propagate counter@(x:y:xs) -- x arrived last => combine on right
| fst x == fst y = propagate ((fst x + fst y, snd y <> snd x) : xs)
| otherwise = counter
@deque-blog
deque-blog / rose_tree_cps_walk.hs
Last active December 26, 2016 13:44
treeWalkC :: Tree a -> [a]
treeWalkC EmptyTree = []
treeWalkC (Tree root) = treeWalkC' root
treeWalkC' :: Node a -> [a]
treeWalkC' n = loop n id
where
loop (Node v cs) cont = loopChildren cs (cont . (v:))
loopChildren [] cont = cont []
loopChildren (c:cs) cont =
@deque-blog
deque-blog / fizz_buzz_kata_2016_tests.hs
Created December 31, 2016 15:25
testCases :: [(Int, String)]
testCases = [ (0, "0"), (1, "1"), (3, "Fizz"), (5, "Buzz")
, (7, "7"), (15, "FizzBuzz"), (100, "Buzz")]
tests :: Test
tests = TestList $ map createTestCase testCases
where
createTestCase (input, expected) =
let label = "FizzBuzz of " ++ show input
in TestCase $ assertEqual label expected (fizzBuzz input)
@deque-blog
deque-blog / fizz_buzz_kata_2016_pbt.hs
Created December 31, 2016 15:27
newtype Fizz = Fizz Int deriving (Show)
newtype Buzz = Buzz Int deriving (Show)
newtype Other = Other Int deriving (Show)
instance Arbitrary Fizz where
arbitrary = do
x <- (arbitrary `suchThat` (\n -> fizzBuzz n == "Fizz"))
return (Fizz x)
instance Arbitrary Buzz where
@deque-blog
deque-blog / fizz_buzz_kata_2016.hs
Last active December 31, 2016 15:28
fizzBuzz :: Int -> String
fizzBuzz 0 = "0"
fizzBuzz n =
let res = fizzBuzzImpl [newRule 3 "Fizz", newRule 5 "Buzz"] n
in if res == ""
then show n
else res
type Rule = Int -> String