Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env stack
- -- stack --resolver lts-13.8 --install-ghc runghc --package criterion
- {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
- import Criterion.Main
- import GHC.Generics (Generic)
- import Control.DeepSeq
- data Tree = Leaf Int | Inner Int Int Tree Tree
- deriving (Eq, Generic, NFData)
- sum_up :: Tree -> Tree
- sum_up tr =
- case tr of
- Leaf n -> Leaf n
- Inner sum x left right ->
- let l = sum_up left
- r = sum_up right
- in Inner ((value l) + (value r)) x l r
- set_even :: Tree -> Tree
- set_even tr =
- case tr of
- Leaf n -> Leaf n
- Inner sum x left right ->
- let l = set_even left
- r = set_even right
- in Inner sum (sum `mod` 2) l r
- value :: Tree -> Int
- value tr =
- case tr of
- Leaf n -> n
- Inner sum x left right -> sum
- generateTree :: Int -> Tree
- generateTree 0 = Leaf 2
- generateTree n = Inner 0 0 (generateTree (n - 1)) (generateTree (n - 1))
- sumup_seteven :: Tree -> Int
- sumup_seteven tr = value $ sum_up $ set_even tr
- tree_ident :: Tree -> Tree
- tree_ident tr = tr
- main = defaultMain [
- let tree = generateTree 20 in
- bgroup "gibbon" [ bench "sumup_seteven" $ nf sumup_seteven tree
- , bench "ident" $ nf tree_ident tree ]
- ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement