SHARE
TWEET

Untitled

a guest Feb 21st, 2019 51 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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.   ]
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top