{-# LANGUAGE NoMonomorphismRestriction #-}
 
data Map k a  = Tip | Bin Size k a (Map k a) (Map k a)
	deriving (Eq, Show)
 
type Size     = Int
 
size :: Map k a -> Int
size t
  = case t of
      Tip             -> 0
      Bin sz _ _ _ _  -> sz
 
----------------------------------------------------------------
 
-- basic rotations
singleL, singleR :: a -> b -> Map a b -> Map a b -> Map a b
singleL k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin k2 x2 (bin k1 x1 t1 t2) t3
singleR k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin k2 x2 t1 (bin k1 x1 t2 t3)
 
doubleL, doubleR :: a -> b -> Map a b -> Map a b -> Map a b
doubleL k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin k3 x3 (bin k1 x1 t1 t2) (bin k2 x2 t3 t4)
doubleR k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin k3 x3 (bin k2 x2 t1 t2) (bin k1 x1 t3 t4)
 
----------------------------------------------------------------
 
bin :: k -> a -> Map k a -> Map k a -> Map k a
bin k x l r
  = Bin (size l + size r + 1) k x l r
 
singleton :: k -> a -> Map k a
singleton k x
  = Bin 1 k x Tip Tip
 
isBalanced :: Map k a -> Map k a -> Bool
isBalanced a b = 3 * x >= y
  where
    x = size a + 1
    y = size b + 1
 
isSingle :: Map k a -> Map k a -> Bool
isSingle a b = z < 2 * w
  where
    z = size a + 1
    w = size b + 1
 
----------------------------------------------------------------
balanceL :: k -> a -> Map k a -> Map k a -> Map k a
balanceL k x l r
  | isBalanced l r = bin k x l r
  | otherwise      = rotateL k x l r
 
balanceR :: k -> a -> Map k a -> Map k a -> Map k a
balanceR k x l r
  | isBalanced r l = bin k x l r
  | otherwise      = rotateR k x l r
 
balance :: k -> a -> Map k a -> Map k a -> Map k a
balance k x l r
  | isBalanced l r && isBalanced r l = bin k x l r
  | size l > size r                  = rotateR k x l r
  | otherwise                        = rotateL k x l r
 
----------------------------------------------------------------
 
rotateL :: a -> b -> Map a b -> Map a b -> Map a b
rotateL k x l r@(Bin _ _ _ rl rr)
  | isSingle rl rr = singleL k x l r
  | otherwise      = doubleL k x l r
 
rotateR :: a -> b -> Map a b -> Map a b -> Map a b
rotateR k x l@(Bin _ _ _ ll lr) r
  | isSingle lr ll = singleR k x l r
  | otherwise      = doubleR k x l r
 
----------------------------------------------------------------
 
join :: Ord k => k -> a -> Map k a -> Map k a -> Map k a
join kx x Tip r  = insertMin kx x r
join kx x l Tip  = insertMax kx x l
join kx x l@(Bin _ ky y ly ry) r@(Bin _ kz z lz rz)
  | bal1 && bal2 = bin kx x l r
  | bal1         = balanceL ky y ly (join kx x ry r)
  | otherwise    = balanceR kz z (join kx x l lz) rz
  where
    bal1 = isBalanced l r
    bal2 = isBalanced r l
 
merge :: Map k a -> Map k a -> Map k a
merge Tip r   = r
merge l Tip   = l
merge l@(Bin _ kx x lx rx) r@(Bin _ ky y ly ry)
  | bal1 && bal2 = glue l r
  | bal1         = balanceL kx x lx (merge rx r)
  | otherwise    = balanceR ky y (merge l ly) ry
  where
    bal1 = isBalanced l r
    bal2 = isBalanced r l
 
----------------------------------------------------------------
 
insertMax,insertMin :: k -> a -> Map k a -> Map k a
insertMax kx x t
  = case t of
      Tip -> singleton kx x
      Bin _ ky y l r
          -> balanceL ky y l (insertMax kx x r)
 
insertMin kx x t
  = case t of
      Tip -> singleton kx x
      Bin _ ky y l r
          -> balanceR ky y (insertMin kx x l) r
 
----------------------------------------------------------------
 
glue :: Map k a -> Map k a -> Map k a
glue Tip r = r
glue l Tip = l
glue l r
  | size l > size r = let ((km,m),l') = deleteFindMax l in balanceL km m l' r
  | otherwise       = let ((km,m),r') = deleteFindMin r in balanceR km m l r'
 
-- | /O(log n)/. Delete and find the minimal element.
--
-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")])
-- > deleteFindMin                                            Error: can not return the minimal element of an empty map
 
deleteFindMin :: Map k a -> ((k,a),Map k a)
deleteFindMin t
  = case t of
      Bin _ k x Tip r -> ((k,x),r)
      Bin _ k x l r   -> let (km,l') = deleteFindMin l in (km,balance k x l' r)
      Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
 
-- | /O(log n)/. Delete and find the maximal element.
--
-- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])
-- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map
 
deleteFindMax :: Map k a -> ((k,a),Map k a)
deleteFindMax t
  = case t of
      Bin _ k x l Tip -> ((k,x),l)
      Bin _ k x l r   -> let (km,r') = deleteFindMax r in (km,balance k x l r')
      Tip             -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
 
----------------------------------------------------------------
 
balanced :: Map k a -> Bool
balanced Tip             = True
balanced (Bin _ _ _ l r) = isBalanced l r && isBalanced r l && balanced l && balanced r
 
push k a = glue a $ singleton k k
 
f = unlines . map show
g = show . map balanced
 
main = putStrLn $ g $ scanl (\t n -> push n t) Tip [0..7]

ey0jIExBTkdVQUdFIE5vTW9ub21vcnBoaXNtUmVzdHJpY3Rpb24gIy19CgpkYXRhIE1hcCBrIGEgID0gVGlwIHwgQmluIFNpemUgayBhIChNYXAgayBhKSAoTWFwIGsgYSkKCWRlcml2aW5nIChFcSwgU2hvdykKCnR5cGUgU2l6ZSAgICAgPSBJbnQKCnNpemUgOjogTWFwIGsgYSAtPiBJbnQKc2l6ZSB0CiAgPSBjYXNlIHQgb2YKICAgICAgVGlwICAgICAgICAgICAgIC0+IDAKICAgICAgQmluIHN6IF8gXyBfIF8gIC0+IHN6CgotLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tCgotLSBiYXNpYyByb3RhdGlvbnMKc2luZ2xlTCwgc2luZ2xlUiA6OiBhIC0+IGIgLT4gTWFwIGEgYiAtPiBNYXAgYSBiIC0+IE1hcCBhIGIKc2luZ2xlTCBrMSB4MSB0MSAoQmluIF8gazIgeDIgdDIgdDMpICA9IGJpbiBrMiB4MiAoYmluIGsxIHgxIHQxIHQyKSB0MwpzaW5nbGVSIGsxIHgxIChCaW4gXyBrMiB4MiB0MSB0MikgdDMgID0gYmluIGsyIHgyIHQxIChiaW4gazEgeDEgdDIgdDMpCgpkb3VibGVMLCBkb3VibGVSIDo6IGEgLT4gYiAtPiBNYXAgYSBiIC0+IE1hcCBhIGIgLT4gTWFwIGEgYgpkb3VibGVMIGsxIHgxIHQxIChCaW4gXyBrMiB4MiAoQmluIF8gazMgeDMgdDIgdDMpIHQ0KSA9IGJpbiBrMyB4MyAoYmluIGsxIHgxIHQxIHQyKSAoYmluIGsyIHgyIHQzIHQ0KQpkb3VibGVSIGsxIHgxIChCaW4gXyBrMiB4MiB0MSAoQmluIF8gazMgeDMgdDIgdDMpKSB0NCA9IGJpbiBrMyB4MyAoYmluIGsyIHgyIHQxIHQyKSAoYmluIGsxIHgxIHQzIHQ0KQoKLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQoKYmluIDo6IGsgLT4gYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEgLT4gTWFwIGsgYQpiaW4gayB4IGwgcgogID0gQmluIChzaXplIGwgKyBzaXplIHIgKyAxKSBrIHggbCByCgpzaW5nbGV0b24gOjogayAtPiBhIC0+IE1hcCBrIGEKc2luZ2xldG9uIGsgeAogID0gQmluIDEgayB4IFRpcCBUaXAKCmlzQmFsYW5jZWQgOjogTWFwIGsgYSAtPiBNYXAgayBhIC0+IEJvb2wKaXNCYWxhbmNlZCBhIGIgPSAzICogeCA+PSB5CiAgd2hlcmUKICAgIHggPSBzaXplIGEgKyAxCiAgICB5ID0gc2l6ZSBiICsgMQoKaXNTaW5nbGUgOjogTWFwIGsgYSAtPiBNYXAgayBhIC0+IEJvb2wKaXNTaW5nbGUgYSBiID0geiA8IDIgKiB3CiAgd2hlcmUKICAgIHogPSBzaXplIGEgKyAxCiAgICB3ID0gc2l6ZSBiICsgMQoKLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQpiYWxhbmNlTCA6OiBrIC0+IGEgLT4gTWFwIGsgYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEKYmFsYW5jZUwgayB4IGwgcgogIHwgaXNCYWxhbmNlZCBsIHIgPSBiaW4gayB4IGwgcgogIHwgb3RoZXJ3aXNlICAgICAgPSByb3RhdGVMIGsgeCBsIHIKCmJhbGFuY2VSIDo6IGsgLT4gYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEgLT4gTWFwIGsgYQpiYWxhbmNlUiBrIHggbCByCiAgfCBpc0JhbGFuY2VkIHIgbCA9IGJpbiBrIHggbCByCiAgfCBvdGhlcndpc2UgICAgICA9IHJvdGF0ZVIgayB4IGwgcgoKYmFsYW5jZSA6OiBrIC0+IGEgLT4gTWFwIGsgYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEKYmFsYW5jZSBrIHggbCByCiAgfCBpc0JhbGFuY2VkIGwgciAmJiBpc0JhbGFuY2VkIHIgbCA9IGJpbiBrIHggbCByCiAgfCBzaXplIGwgPiBzaXplIHIgICAgICAgICAgICAgICAgICA9IHJvdGF0ZVIgayB4IGwgcgogIHwgb3RoZXJ3aXNlICAgICAgICAgICAgICAgICAgICAgICAgPSByb3RhdGVMIGsgeCBsIHIKCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0KCnJvdGF0ZUwgOjogYSAtPiBiIC0+IE1hcCBhIGIgLT4gTWFwIGEgYiAtPiBNYXAgYSBiCnJvdGF0ZUwgayB4IGwgckAoQmluIF8gXyBfIHJsIHJyKQogIHwgaXNTaW5nbGUgcmwgcnIgPSBzaW5nbGVMIGsgeCBsIHIKICB8IG90aGVyd2lzZSAgICAgID0gZG91YmxlTCBrIHggbCByCgpyb3RhdGVSIDo6IGEgLT4gYiAtPiBNYXAgYSBiIC0+IE1hcCBhIGIgLT4gTWFwIGEgYgpyb3RhdGVSIGsgeCBsQChCaW4gXyBfIF8gbGwgbHIpIHIKICB8IGlzU2luZ2xlIGxyIGxsID0gc2luZ2xlUiBrIHggbCByCiAgfCBvdGhlcndpc2UgICAgICA9IGRvdWJsZVIgayB4IGwgcgoKLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQoKam9pbiA6OiBPcmQgayA9PiBrIC0+IGEgLT4gTWFwIGsgYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEKam9pbiBreCB4IFRpcCByICA9IGluc2VydE1pbiBreCB4IHIKam9pbiBreCB4IGwgVGlwICA9IGluc2VydE1heCBreCB4IGwKam9pbiBreCB4IGxAKEJpbiBfIGt5IHkgbHkgcnkpIHJAKEJpbiBfIGt6IHogbHogcnopCiAgfCBiYWwxICYmIGJhbDIgPSBiaW4ga3ggeCBsIHIKICB8IGJhbDEgICAgICAgICA9IGJhbGFuY2VMIGt5IHkgbHkgKGpvaW4ga3ggeCByeSByKQogIHwgb3RoZXJ3aXNlICAgID0gYmFsYW5jZVIga3ogeiAoam9pbiBreCB4IGwgbHopIHJ6CiAgd2hlcmUKICAgIGJhbDEgPSBpc0JhbGFuY2VkIGwgcgogICAgYmFsMiA9IGlzQmFsYW5jZWQgciBsCgptZXJnZSA6OiBNYXAgayBhIC0+IE1hcCBrIGEgLT4gTWFwIGsgYQptZXJnZSBUaXAgciAgID0gcgptZXJnZSBsIFRpcCAgID0gbAptZXJnZSBsQChCaW4gXyBreCB4IGx4IHJ4KSByQChCaW4gXyBreSB5IGx5IHJ5KQogIHwgYmFsMSAmJiBiYWwyID0gZ2x1ZSBsIHIKICB8IGJhbDEgICAgICAgICA9IGJhbGFuY2VMIGt4IHggbHggKG1lcmdlIHJ4IHIpCiAgfCBvdGhlcndpc2UgICAgPSBiYWxhbmNlUiBreSB5IChtZXJnZSBsIGx5KSByeQogIHdoZXJlCiAgICBiYWwxID0gaXNCYWxhbmNlZCBsIHIKICAgIGJhbDIgPSBpc0JhbGFuY2VkIHIgbAoKLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQoKaW5zZXJ0TWF4LGluc2VydE1pbiA6OiBrIC0+IGEgLT4gTWFwIGsgYSAtPiBNYXAgayBhCmluc2VydE1heCBreCB4IHQKICA9IGNhc2UgdCBvZgogICAgICBUaXAgLT4gc2luZ2xldG9uIGt4IHgKICAgICAgQmluIF8ga3kgeSBsIHIKICAgICAgICAgIC0+IGJhbGFuY2VMIGt5IHkgbCAoaW5zZXJ0TWF4IGt4IHggcikKCmluc2VydE1pbiBreCB4IHQKICA9IGNhc2UgdCBvZgogICAgICBUaXAgLT4gc2luZ2xldG9uIGt4IHgKICAgICAgQmluIF8ga3kgeSBsIHIKICAgICAgICAgIC0+IGJhbGFuY2VSIGt5IHkgKGluc2VydE1pbiBreCB4IGwpIHIKCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0KCmdsdWUgOjogTWFwIGsgYSAtPiBNYXAgayBhIC0+IE1hcCBrIGEKZ2x1ZSBUaXAgciA9IHIKZ2x1ZSBsIFRpcCA9IGwKZ2x1ZSBsIHIKICB8IHNpemUgbCA+IHNpemUgciA9IGxldCAoKGttLG0pLGwnKSA9IGRlbGV0ZUZpbmRNYXggbCBpbiBiYWxhbmNlTCBrbSBtIGwnIHIKICB8IG90aGVyd2lzZSAgICAgICA9IGxldCAoKGttLG0pLHInKSA9IGRlbGV0ZUZpbmRNaW4gciBpbiBiYWxhbmNlUiBrbSBtIGwgcicKCi0tIHwgL08obG9nIG4pLy4gRGVsZXRlIGFuZCBmaW5kIHRoZSBtaW5pbWFsIGVsZW1lbnQuCi0tCi0tID4gZGVsZXRlRmluZE1pbiAoZnJvbUxpc3QgWyg1LCJhIiksICgzLCJiIiksICgxMCwiYyIpXSkgPT0gKCgzLCJiIiksIGZyb21MaXN0Wyg1LCJhIiksICgxMCwiYyIpXSkKLS0gPiBkZWxldGVGaW5kTWluICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBFcnJvcjogY2FuIG5vdCByZXR1cm4gdGhlIG1pbmltYWwgZWxlbWVudCBvZiBhbiBlbXB0eSBtYXAKCmRlbGV0ZUZpbmRNaW4gOjogTWFwIGsgYSAtPiAoKGssYSksTWFwIGsgYSkKZGVsZXRlRmluZE1pbiB0CiAgPSBjYXNlIHQgb2YKICAgICAgQmluIF8gayB4IFRpcCByIC0+ICgoayx4KSxyKQogICAgICBCaW4gXyBrIHggbCByICAgLT4gbGV0IChrbSxsJykgPSBkZWxldGVGaW5kTWluIGwgaW4gKGttLGJhbGFuY2UgayB4IGwnIHIpCiAgICAgIFRpcCAgICAgICAgICAgICAtPiAoZXJyb3IgIk1hcC5kZWxldGVGaW5kTWluOiBjYW4gbm90IHJldHVybiB0aGUgbWluaW1hbCBlbGVtZW50IG9mIGFuIGVtcHR5IG1hcCIsIFRpcCkKCi0tIHwgL08obG9nIG4pLy4gRGVsZXRlIGFuZCBmaW5kIHRoZSBtYXhpbWFsIGVsZW1lbnQuCi0tCi0tID4gZGVsZXRlRmluZE1heCAoZnJvbUxpc3QgWyg1LCJhIiksICgzLCJiIiksICgxMCwiYyIpXSkgPT0gKCgxMCwiYyIpLCBmcm9tTGlzdCBbKDMsImIiKSwgKDUsImEiKV0pCi0tID4gZGVsZXRlRmluZE1heCBlbXB0eSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgRXJyb3I6IGNhbiBub3QgcmV0dXJuIHRoZSBtYXhpbWFsIGVsZW1lbnQgb2YgYW4gZW1wdHkgbWFwCgpkZWxldGVGaW5kTWF4IDo6IE1hcCBrIGEgLT4gKChrLGEpLE1hcCBrIGEpCmRlbGV0ZUZpbmRNYXggdAogID0gY2FzZSB0IG9mCiAgICAgIEJpbiBfIGsgeCBsIFRpcCAtPiAoKGsseCksbCkKICAgICAgQmluIF8gayB4IGwgciAgIC0+IGxldCAoa20scicpID0gZGVsZXRlRmluZE1heCByIGluIChrbSxiYWxhbmNlIGsgeCBsIHInKQogICAgICBUaXAgICAgICAgICAgICAgLT4gKGVycm9yICJNYXAuZGVsZXRlRmluZE1heDogY2FuIG5vdCByZXR1cm4gdGhlIG1heGltYWwgZWxlbWVudCBvZiBhbiBlbXB0eSBtYXAiLCBUaXApCgotLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tCgpiYWxhbmNlZCA6OiBNYXAgayBhIC0+IEJvb2wKYmFsYW5jZWQgVGlwICAgICAgICAgICAgID0gVHJ1ZQpiYWxhbmNlZCAoQmluIF8gXyBfIGwgcikgPSBpc0JhbGFuY2VkIGwgciAmJiBpc0JhbGFuY2VkIHIgbCAmJiBiYWxhbmNlZCBsICYmIGJhbGFuY2VkIHIKCnB1c2ggayBhID0gZ2x1ZSBhICQgc2luZ2xldG9uIGsgawoKZiA9IHVubGluZXMgLiBtYXAgc2hvdwpnID0gc2hvdyAuIG1hcCBiYWxhbmNlZAoKbWFpbiA9IHB1dFN0ckxuICQgZyAkIHNjYW5sIChcdCBuIC0+IHB1c2ggbiB0KSBUaXAgWzAuLjdd