fork download
copy 
  1. {- # OPTIONS_GHC -package haskell98 # -}
  2.  
  3. {- # LANGUAGE Haskell98 # -}
  4.  
  5. module Main where  -- the code from stackoverflow.com/q/18182507/849891
  6.                    --   by   stackoverflow.com/users/753379/jajdoo
  7. import Data.List               -- see  stackoverflow.com/q/18278254/849891
  8. import Data.Time.Clock.POSIX   -- by  stackoverflow.com/users/849891/will-ness
  9. -- import Random               -- ___________________________
  10. import System.Random           -- works, now -- wn 2019-07-19
  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)
  90.  
  91. foldl_ = foldl'
Time limit exceeded #stdin #stdout 15s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/vEHOXV
http://stackoverflow.com/questions/18182507/haskell-optimizing-avl-tree (and previous Java entry as well)
language:
Haskell (ghc 8.4.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!