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 / accumulate_iter_merge_sort.cpp
Last active December 23, 2016 15:36
template<typename ForwardIterator>
void stable_sort_forward(ForwardIterator first, ForwardIterator last)
{
using Range = std::pair<ForwardIterator, ForwardIterator>;
using Counter = binary_counter<merger<ForwardIterator>, Range>;
Counter c { merger<ForwardIterator>{}, { last, last } };
accumulate_iter(first, last, &c,
[](auto c, auto it) {
c->add({it, std::next(it)});
@deque-blog
deque-blog / raw_loop_merge_sort.cpp
Created December 23, 2016 15:43
template<typename ForwardIterator>
void stable_sort_forward(ForwardIterator first, ForwardIterator last)
{
using Range = std::pair<ForwardIterator, ForwardIterator>;
using Counter = binary_counter<merger<ForwardIterator>, Range>;
Counter c { merger<ForwardIterator>{}, { last, last } };
for (; first != last; ++first) {
c.add(std::make_pair(first, std::next(first)));
}
@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_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 / 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 / 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
@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