src/HOL/Data_Structures/RBT.thy
author wenzelm
Wed, 04 Nov 2015 23:27:00 +0100
changeset 61578 6623c81cb15a
parent 61534 a88e07c8d0d5
child 61678 b594e9277be3
permissions -rw-r--r--
avoid ligatures;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
61224
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     1
(* Author: Tobias Nipkow *)
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     2
61469
cd82b1023932 added 2-3 trees (simpler and more complete than the version in ex/Tree23)
nipkow
parents: 61231
diff changeset
     3
section \<open>Red-Black Trees\<close>
61224
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     4
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     5
theory RBT
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     6
imports Tree2
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     7
begin
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     8
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
     9
datatype color = Red | Black
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    10
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    11
type_synonym 'a rbt = "('a,color)tree"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    12
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    13
abbreviation R where "R l a r \<equiv> Node Red l a r"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    14
abbreviation B where "B l a r \<equiv> Node Black l a r"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    15
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    16
fun bal :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    17
(* The first line is superfluous; it merely speeds up pattern compilation *)
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    18
"bal (R t1 a1 t2) a2 (R t3 a3 t4) = R (B t1 a1 t2) a2 (B t3 a3 t4)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    19
"bal (R (R t1 a1 t2) a2 t3) a3 t4 = R (B t1 a1 t2) a2 (B t3 a3 t4)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    20
"bal (R t1 a1 (R t2 a2 t3)) a3 t4 = R (B t1 a1 t2) a2 (B t3 a3 t4)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    21
"bal t1 a1 (R t2 a2 (R t3 a3 t4)) = R (B t1 a1 t2) a2 (B t3 a3 t4)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    22
"bal t1 a1 (R (R t2 a2 t3) a3 t4) = R (B t1 a1 t2) a2 (B t3 a3 t4)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    23
"bal t1 a t2 = B t1 a t2"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    24
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    25
fun red :: "'a rbt \<Rightarrow> 'a rbt" where
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    26
"red Leaf = Leaf" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    27
"red (Node _ l a r) = R l a r"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    28
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    29
fun balL :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
61534
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    30
"balL (R t1 x t2) y t3 = R (B t1 x t2) y t3" |
61224
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    31
"balL bl x (B t1 y t2) = bal bl x (R t1 y t2)" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    32
"balL bl x (R (B t1 y t2) z t3) = R (B bl x t1) y (bal t2 z (red t3))" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    33
"balL t1 x t2 = R t1 x t2"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    34
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    35
fun balR :: "'a rbt \<Rightarrow> 'a \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    36
"balR t1 x (R t2 y t3) = R t1 x (B t2 y t3)" |
61534
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    37
"balR (B t1 x t2) y t3 = bal (R t1 x t2) y t3" |
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    38
"balR (R t1 x (B t2 y t3)) z t4 = R (bal (red t1) x t2) y (B t3 z t4)" |
61224
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    39
"balR t1 x t2 = R t1 x t2"
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    40
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    41
fun combine :: "'a rbt \<Rightarrow> 'a rbt \<Rightarrow> 'a rbt" where
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    42
"combine Leaf t = t" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    43
"combine t Leaf = t" |
61534
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    44
"combine (R t1 a t2) (R t3 c t4) = (case combine t2 t3 of
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    45
    R u2 b u3 \<Rightarrow> (R (R t1 a u2) b (R u3 c t4)) |
a88e07c8d0d5 tuned names and optimized comparison order
nipkow
parents: 61469
diff changeset
    46
    t23 \<Rightarrow> R t1 a (R t23 c t4))" |
61224
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    47
"combine (B t1 a t2) (B t3 c t4) = (case combine t2 t3 of
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    48
    R t2' b t3' \<Rightarrow> R (B t1 a t2') b (B t3' c t4) |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    49
    t23 \<Rightarrow> balL t1 a (B t23 c t4))" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    50
"combine t1 (R t2 a t3) = R (combine t1 t2) a t3" |
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    51
"combine (R t1 a t2) t3 = R t1 a (combine t2 t3)" 
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    52
759b5299a9f2 added red black trees
nipkow
parents:
diff changeset
    53
end