Advertisement
Guest User

Untitled

a guest
Feb 21st, 2019
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.24 KB | None | 0 0
  1. #!/usr/bin/env stack
  2. -- stack --resolver lts-13.8 --install-ghc runghc --package criterion
  3. {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
  4. import Criterion.Main
  5. import GHC.Generics (Generic)
  6. import Control.DeepSeq
  7.  
  8. data Tree = Leaf Int | Inner Int Int Tree Tree
  9. deriving (Eq, Generic, NFData)
  10.  
  11. sum_up :: Tree -> Tree
  12. sum_up tr =
  13. case tr of
  14. Leaf n -> Leaf n
  15. Inner sum x left right ->
  16. let l = sum_up left
  17. r = sum_up right
  18. in Inner ((value l) + (value r)) x l r
  19.  
  20. set_even :: Tree -> Tree
  21. set_even tr =
  22. case tr of
  23. Leaf n -> Leaf n
  24. Inner sum x left right ->
  25. let l = set_even left
  26. r = set_even right
  27. in Inner sum (sum `mod` 2) l r
  28.  
  29. value :: Tree -> Int
  30. value tr =
  31. case tr of
  32. Leaf n -> n
  33. Inner sum x left right -> sum
  34.  
  35. generateTree :: Int -> Tree
  36. generateTree 0 = Leaf 2
  37. generateTree n = Inner 0 0 (generateTree (n - 1)) (generateTree (n - 1))
  38.  
  39. sumup_seteven :: Tree -> Int
  40. sumup_seteven tr = value $ sum_up $ set_even tr
  41.  
  42. tree_ident :: Tree -> Tree
  43. tree_ident tr = tr
  44.  
  45. main = defaultMain [
  46. let tree = generateTree 20 in
  47. bgroup "gibbon" [ bench "sumup_seteven" $ nf sumup_seteven tree
  48. , bench "ident" $ nf tree_ident tree ]
  49. ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement