fork download
  1. {- # OPTIONS_GHC -package haskell98 #-}
  2.  
  3. {-# LANGUAGE Haskell98 #-}
  4.  
  5. module Main where
  6.  
  7. import Data.List
  8. import Data.Time.Clock.POSIX
  9. -- import Random
  10. -- import System.Random
  11.  
  12. data Tree a = Empty |
  13. Branch { key :: a,
  14. balance :: Int,
  15. left :: Tree a,
  16. right :: Tree a,
  17. up :: Bool
  18. --used internally to stop updating balance
  19. }
  20. deriving (Eq)
  21.  
  22. leaf :: (Ord a, Eq a) => a -> Tree a
  23. leaf x = Branch x 0 Empty Empty True
  24.  
  25. -- insert ------------------------------------
  26. treeInsert :: (Eq a, Ord a) => Tree a -> a -> Tree a
  27. treeInsert Empty x = leaf x
  28. treeInsert (Branch y b l r _) x
  29. | x < y =
  30. let nl@(Branch _ _ _ _ nlu) = treeInsert l x -- nl = new left
  31. in
  32. if nlu
  33. then if b==1
  34. then roll $ Branch y 2 nl r False
  35. else Branch y (b + 1) nl r (b /= (-1))
  36. else Branch y b nl r False
  37. | x > y =
  38. let nr@(Branch _ _ _ _ nru) = treeInsert r x -- nr = new right
  39. in
  40. if nru
  41. then if b==(-1)
  42. then roll $ Branch y (-2) l nr False
  43. else Branch y (b - 1) l nr (b /= 1)
  44. else Branch y b l nr False
  45. | otherwise = Branch x b l r False
  46.  
  47. -- rolls -------------------------------------
  48. roll :: (Eq a, Ord a) => Tree a -> Tree a
  49. -- ll roll
  50. roll (Branch y 2 (Branch ly 1 ll lr _) r _) =
  51. Branch ly 0 ll (Branch y 0 lr r False) False
  52. -- rr roll
  53. roll (Branch y (-2) l (Branch ry (-1) rl rr _) _) =
  54. Branch ry 0 (Branch y 0 l rl False) rr False
  55. -- lr rolls
  56. roll (Branch y 2 (Branch ly (-1) ll (Branch lry lrb lrl lrr _) _) r _) =
  57. case lrb of
  58. 0 -> Branch lry 0 (Branch ly 0 ll lrl False)
  59. (Branch y 0 lrr r False) False
  60. 1 -> Branch lry 0 (Branch ly 0 ll lrl False)
  61. (Branch y (-1) lrr r False) False
  62. (-1)-> Branch lry 0 (Branch ly 1 ll lrl False)
  63. (Branch y 0 lrr r False) False
  64. -- rl rolls
  65. roll (Branch y (-2) l (Branch ry 1 (Branch rly rlb rll rlr _) rr _) _) =
  66. case rlb of
  67. 0 -> Branch rly 0 (Branch y 0 l rll False)
  68. (Branch ry 0 rlr rr False) False
  69. 1 -> Branch rly 0 (Branch y 0 l rll False)
  70. (Branch ry (-1) rlr rr False) False
  71. (-1)-> Branch rly 0 (Branch y 1 l rll False)
  72. (Branch ry 0 rlr rr False) False
  73.  
  74. -- construct a tree --------------------------
  75. construct :: (Eq a, Ord a) => Tree a -> [a] -> Tree a
  76. construct = foldl' treeInsert --'
  77.  
  78. -- rands -------------------------------------
  79. rands :: Int -> Int -> Int -> Int -> [Int]
  80. rands n low high seed = take n $ randomRs (low, high) (mkStdGen seed)
  81.  
  82. -- test run
  83. main = do
  84. seed <- round `fmap` getPOSIXTime
  85. let ma = 9999999
  86. let t = construct Empty ( rands ma 1 ma seed )
  87. start <- getPOSIXTime
  88. end <- t `seq` getPOSIXTime
  89. print (end - start)
Compilation error #stdin compilation error #stdout 0s 0KB
stdin
Standard input is empty
compilation info
[1 of 1] Compiling Main             ( prog.hs, prog.o )

prog.hs:80:34: Not in scope: `randomRs'

prog.hs:80:56: Not in scope: `mkStdGen'
stdout

Standard output is empty