src/HOL/Data_Structures/AVL_Set_Code.thy
changeset 71818 986d5abbe77c
parent 71816 489c907b9e05
equal deleted inserted replaced
71817:e8e0313881b9 71818:986d5abbe77c
    11   Isin2
    11   Isin2
    12 begin
    12 begin
    13 
    13 
    14 subsection \<open>Code\<close>
    14 subsection \<open>Code\<close>
    15 
    15 
    16 type_synonym 'a avl_tree = "('a*nat) tree"
    16 type_synonym 'a tree_ht = "('a*nat) tree"
    17 
    17 
    18 definition empty :: "'a avl_tree" where
    18 definition empty :: "'a tree_ht" where
    19 "empty = Leaf"
    19 "empty = Leaf"
    20 
    20 
    21 fun ht :: "'a avl_tree \<Rightarrow> nat" where
    21 fun ht :: "'a tree_ht \<Rightarrow> nat" where
    22 "ht Leaf = 0" |
    22 "ht Leaf = 0" |
    23 "ht (Node l (a,n) r) = n"
    23 "ht (Node l (a,n) r) = n"
    24 
    24 
    25 definition node :: "'a avl_tree \<Rightarrow> 'a \<Rightarrow> 'a avl_tree \<Rightarrow> 'a avl_tree" where
    25 definition node :: "'a tree_ht \<Rightarrow> 'a \<Rightarrow> 'a tree_ht \<Rightarrow> 'a tree_ht" where
    26 "node l a r = Node l (a, max (ht l) (ht r) + 1) r"
    26 "node l a r = Node l (a, max (ht l) (ht r) + 1) r"
    27 
    27 
    28 definition balL :: "'a avl_tree \<Rightarrow> 'a \<Rightarrow> 'a avl_tree \<Rightarrow> 'a avl_tree" where
    28 definition balL :: "'a tree_ht \<Rightarrow> 'a \<Rightarrow> 'a tree_ht \<Rightarrow> 'a tree_ht" where
    29 "balL AB c C =
    29 "balL AB c C =
    30   (if ht AB = ht C + 2 then
    30   (if ht AB = ht C + 2 then
    31      case AB of 
    31      case AB of 
    32        Node A (a, _) B \<Rightarrow>
    32        Node A (a, _) B \<Rightarrow>
    33          if ht A \<ge> ht B then node A a (node B c C)
    33          if ht A \<ge> ht B then node A a (node B c C)
    34          else
    34          else
    35            case B of
    35            case B of
    36              Node B\<^sub>1 (b, _) B\<^sub>2 \<Rightarrow> node (node A a B\<^sub>1) b (node B\<^sub>2 c C)
    36              Node B\<^sub>1 (b, _) B\<^sub>2 \<Rightarrow> node (node A a B\<^sub>1) b (node B\<^sub>2 c C)
    37    else node AB c C)"
    37    else node AB c C)"
    38 
    38 
    39 definition balR :: "'a avl_tree \<Rightarrow> 'a \<Rightarrow> 'a avl_tree \<Rightarrow> 'a avl_tree" where
    39 definition balR :: "'a tree_ht \<Rightarrow> 'a \<Rightarrow> 'a tree_ht \<Rightarrow> 'a tree_ht" where
    40 "balR A a BC =
    40 "balR A a BC =
    41    (if ht BC = ht A + 2 then
    41    (if ht BC = ht A + 2 then
    42       case BC of
    42       case BC of
    43         Node B (c, _) C \<Rightarrow>
    43         Node B (c, _) C \<Rightarrow>
    44           if ht B \<le> ht C then node (node A a B) c C
    44           if ht B \<le> ht C then node (node A a B) c C
    45           else
    45           else
    46             case B of
    46             case B of
    47               Node B\<^sub>1 (b, _) B\<^sub>2 \<Rightarrow> node (node A a B\<^sub>1) b (node B\<^sub>2 c C)
    47               Node B\<^sub>1 (b, _) B\<^sub>2 \<Rightarrow> node (node A a B\<^sub>1) b (node B\<^sub>2 c C)
    48   else node A a BC)"
    48   else node A a BC)"
    49 
    49 
    50 fun insert :: "'a::linorder \<Rightarrow> 'a avl_tree \<Rightarrow> 'a avl_tree" where
    50 fun insert :: "'a::linorder \<Rightarrow> 'a tree_ht \<Rightarrow> 'a tree_ht" where
    51 "insert x Leaf = Node Leaf (x, 1) Leaf" |
    51 "insert x Leaf = Node Leaf (x, 1) Leaf" |
    52 "insert x (Node l (a, n) r) = (case cmp x a of
    52 "insert x (Node l (a, n) r) = (case cmp x a of
    53    EQ \<Rightarrow> Node l (a, n) r |
    53    EQ \<Rightarrow> Node l (a, n) r |
    54    LT \<Rightarrow> balL (insert x l) a r |
    54    LT \<Rightarrow> balL (insert x l) a r |
    55    GT \<Rightarrow> balR l a (insert x r))"
    55    GT \<Rightarrow> balR l a (insert x r))"
    56 
    56 
    57 fun split_max :: "'a avl_tree \<Rightarrow> 'a avl_tree * 'a" where
    57 fun split_max :: "'a tree_ht \<Rightarrow> 'a tree_ht * 'a" where
    58 "split_max (Node l (a, _) r) =
    58 "split_max (Node l (a, _) r) =
    59   (if r = Leaf then (l,a) else let (r',a') = split_max r in (balL l a r', a'))"
    59   (if r = Leaf then (l,a) else let (r',a') = split_max r in (balL l a r', a'))"
    60 
    60 
    61 lemmas split_max_induct = split_max.induct[case_names Node Leaf]
    61 lemmas split_max_induct = split_max.induct[case_names Node Leaf]
    62 
    62 
    63 fun delete :: "'a::linorder \<Rightarrow> 'a avl_tree \<Rightarrow> 'a avl_tree" where
    63 fun delete :: "'a::linorder \<Rightarrow> 'a tree_ht \<Rightarrow> 'a tree_ht" where
    64 "delete _ Leaf = Leaf" |
    64 "delete _ Leaf = Leaf" |
    65 "delete x (Node l (a, n) r) =
    65 "delete x (Node l (a, n) r) =
    66   (case cmp x a of
    66   (case cmp x a of
    67      EQ \<Rightarrow> if l = Leaf then r
    67      EQ \<Rightarrow> if l = Leaf then r
    68            else let (l', a') = split_max l in balR l' a' r |
    68            else let (l', a') = split_max l in balR l' a' r |