haskell - haskell - AVL ツリーの最適化

Question

Haskell の学習の一環として、AVL ツリーを実装することにしました。今のところ、私は挿入のみを実装しています。

実装は機能しますが、9999999 個の乱数のランダム リストで見つかったランダムな Java 実装よりも 3 ～ 4 倍遅くなります。

[1..9999999]または（降順または昇順のリスト）の入力リストが与えられた場合でもほぼ同様に機能するため、問題はandロール[9999999..1]にある可能性があると思いますrllr

より速く実行する方法についてのヒントをいただければ幸いです。

はい、私はそれがちょっと醜いように見えることを知っています.

data Tree a =   Empty |
                Branch {    key     :: a,
                            balance :: Int,
                            left    :: Tree a,
                            right   :: Tree a,
                            up      :: Bool    
                          --used internally to stop updating balance
                       }
                deriving (Eq)

leaf :: (Ord a, Eq a) => a -> Tree a
leaf x = Branch x 0 Empty Empty True

-- insert ------------------------------------
treeInsert :: (Eq a, Ord a) => Tree a -> a -> Tree a
treeInsert Empty x  = leaf x
treeInsert (Branch y b l r _) x 
  | x < y =
    let nl@(Branch _ _ _ _ nlu) = treeInsert l x   -- nl = new left
    in
      if nlu
        then if b==1  
               then roll $ Branch y  2      nl r False 
               else        Branch y (b + 1) nl r (b /= (-1)) 
        else               Branch y  b      nl r False
  | x > y = 
    let nr@(Branch _ _ _ _ nru) = treeInsert r x   -- nr = new right
    in
      if nru 
        then if b==(-1) 
               then roll $ Branch y (-2)    l nr False 
               else        Branch y (b - 1) l nr (b /= 1) 
        else               Branch y  b      l nr False
  | otherwise =            Branch x  b      l r  False

-- rolls -------------------------------------
roll :: (Eq a, Ord a) => Tree a -> Tree a
-- ll roll
roll (Branch y 2 (Branch ly 1 ll lr _) r _) = 
            Branch ly  0 ll (Branch y 0 lr r False) False
-- rr roll
roll (Branch y (-2) l (Branch ry (-1) rl rr _) _) = 
            Branch ry  0 (Branch y 0 l rl False) rr False
-- lr rolls
roll (Branch y 2 (Branch ly (-1) ll (Branch lry lrb lrl lrr _) _) r _) = 
   case lrb of 
     0  ->  Branch lry 0 (Branch ly 0   ll  lrl False) 
                         (Branch y  0   lrr r   False) False
     1  ->  Branch lry 0 (Branch ly 0   ll  lrl False) 
                         (Branch y (-1) lrr r   False) False
     (-1)-> Branch lry 0 (Branch ly 1   ll  lrl False) 
                         (Branch y  0   lrr r   False) False
-- rl rolls
roll (Branch y (-2) l (Branch ry 1 (Branch rly rlb rll rlr _) rr _) _) = 
   case rlb of 
     0  ->  Branch rly 0 (Branch y  0   l   rll False) 
                         (Branch ry 0   rlr rr  False) False
     1  ->  Branch rly 0 (Branch y  0   l   rll False) 
                         (Branch ry (-1) rlr rr False) False
     (-1)-> Branch rly 0 (Branch y  1   l   rll False) 
                         (Branch ry 0   rlr rr  False) False

-- construct a tree --------------------------
construct :: (Eq a, Ord a) => Tree a -> [a] -> Tree a
construct = foldl' treeInsert

-- rands -------------------------------------
rands :: Int -> Int -> Int -> Int -> [Int]
rands n low high seed = take n $ randomRs (low, high) (mkStdGen seed)

-- test run
main = do
    seed <- round `fmap` getPOSIXTime
    let ma = 9999999
    let t = construct Empty ( rands ma 1 ma seed ) 
    start <- getPOSIXTime
    end <- t `seq` getPOSIXTime
    print (end - start)