Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Trees!
Case Allocated GCs
1000 sort 636,000 1
10000 sort 6,971,800 13
100000 sort 77,884,680 149
1000000 sort 847,753,632 1,622
benchmarking Tree/1000
time 212.8 μs (202.0 μs .. 222.9 μs)
0.987 R² (0.980 R² .. 0.993 R²)
mean 197.0 μs (190.7 μs .. 204.0 μs)
std dev 21.97 μs (19.60 μs .. 27.46 μs)
variance introduced by outliers: 84% (severely inflated)
benchmarking Tree/10000
time 3.531 ms (3.398 ms .. 3.675 ms)
0.959 R² (0.931 R² .. 0.980 R²)
mean 3.649 ms (3.431 ms .. 3.991 ms)
std dev 864.7 μs (611.4 μs .. 1.295 ms)
variance introduced by outliers: 91% (severely inflated)
benchmarking Tree/100000
time 35.92 ms (33.24 ms .. 37.77 ms)
0.988 R² (0.976 R² .. 0.995 R²)
mean 37.55 ms (35.96 ms .. 39.22 ms)
std dev 3.231 ms (2.401 ms .. 4.366 ms)
variance introduced by outliers: 32% (moderately inflated)
benchmarking Tree/1000000
time 356.3 ms (326.6 ms .. 434.8 ms)
0.991 R² (0.968 R² .. 1.000 R²)
mean 369.4 ms (348.8 ms .. 384.8 ms)
std dev 23.56 ms (0.0 s .. 26.74 ms)
variance introduced by outliers: 19% (moderately inflated)
module Data.Tree where
import Data.Monoid
data KeyValue k v = KeyValue k v
instance (Show k, Show v) => Show (KeyValue k v) where
show (KeyValue k v) = "(" ++ show k ++ ", " ++ show v ++ ")"
instance (Eq k) => Eq (KeyValue k v) where
(KeyValue k _) == (KeyValue k' _) = k == k'
instance (Ord k) => Ord (KeyValue k v) where
(KeyValue a _) `compare` (KeyValue b _) = a `compare` b
instance Functor (KeyValue k) where
fmap f (KeyValue k v) = KeyValue k (f v)
instance (Monoid k) => Applicative (KeyValue k) where
pure v = KeyValue mempty v
(KeyValue k f) <*> (KeyValue k' v) = KeyValue (k `mappend` k') (f v)
type Height = Int
data Tree k v = Leaf | Branch !Height (KeyValue k v) (Tree k v) (Tree k v)
deriving Show
height :: Tree k v -> Int
height Leaf = 0
height (Branch h _ _ _) = h
{-# INLINABLE height #-}
branch :: KeyValue k v -> Tree k v -> Tree k v -> Tree k v
branch kv a b
| height a > height b = Branch (1 + height a) kv a b
| otherwise = Branch (1 + height b) kv b a
{-# INLINABLE branch #-}
merge :: (Ord k) => Tree k v -> Tree k v -> Tree k v
merge a Leaf = a
merge Leaf b = b
merge a @ (Branch _ kva la ra) b @ (Branch _ kvb lb rb)
| kva < kvb = branch kva la (merge ra b)
| otherwise = branch kvb lb (merge a rb)
{-# INLINABLE merge #-}
singleton k v = branch (KeyValue k v) Leaf Leaf
{-# INLINABLE singleton #-}
instance (Ord k) => Monoid (Tree k v) where
mempty = Leaf
mappend = merge
instance Functor (Tree k) where
fmap _ Leaf = Leaf
fmap f (Branch _ kv a b) = branch (fmap f kv) (fmap f a) (fmap f b)
instance (Monoid k, Ord k) => Applicative (Tree k) where
pure a = branch (pure a) Leaf Leaf
Leaf <*> _ = Leaf
_ <*> Leaf = Leaf
(Branch _ (KeyValue k f) lfs rfs) <*> t @ (Branch _ kv l r) =
branch (fmap f kv) (fmap f l) (fmap f r) <> (lfs <*> t) <> (rfs <*> t)
fromList :: (Ord a) => [a] -> Tree a a
fromList = foldl (\t a -> t <> singleton a a) mempty
{-# INLINABLE fromList #-}
toList :: (Ord a) => Tree a a -> [a]
toList Leaf = []
toList (Branch _ (KeyValue k v) a b) = v : (toList (a <> b))
{-# INLINABLE toList #-}
sort :: (Ord a) => [a] -> [a]
sort = toList . fromList
{-# INLINABLE sort #-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment