src/HOL/Data_Structures/AA_Set.thy
changeset 70755 3fb16bed5d6c
parent 69597 ff784d5a5bfb
equal deleted inserted replaced
70753:c5232e6fb10b 70755:3fb16bed5d6c
     8 imports
     8 imports
     9   Isin2
     9   Isin2
    10   Cmp
    10   Cmp
    11 begin
    11 begin
    12 
    12 
    13 type_synonym 'a aa_tree = "('a,nat) tree"
    13 type_synonym 'a aa_tree = "('a*nat) tree"
    14 
    14 
    15 definition empty :: "'a aa_tree" where
    15 definition empty :: "'a aa_tree" where
    16 "empty = Leaf"
    16 "empty = Leaf"
    17 
    17 
    18 fun lvl :: "'a aa_tree \<Rightarrow> nat" where
    18 fun lvl :: "'a aa_tree \<Rightarrow> nat" where
    19 "lvl Leaf = 0" |
    19 "lvl Leaf = 0" |
    20 "lvl (Node _ _ lv _) = lv"
    20 "lvl (Node _ (_, lv) _) = lv"
    21 
    21 
    22 fun invar :: "'a aa_tree \<Rightarrow> bool" where
    22 fun invar :: "'a aa_tree \<Rightarrow> bool" where
    23 "invar Leaf = True" |
    23 "invar Leaf = True" |
    24 "invar (Node l a h r) =
    24 "invar (Node l (a, h) r) =
    25  (invar l \<and> invar r \<and>
    25  (invar l \<and> invar r \<and>
    26   h = lvl l + 1 \<and> (h = lvl r + 1 \<or> (\<exists>lr b rr. r = Node lr b h rr \<and> h = lvl rr + 1)))"
    26   h = lvl l + 1 \<and> (h = lvl r + 1 \<or> (\<exists>lr b rr. r = Node lr (b,h) rr \<and> h = lvl rr + 1)))"
    27 
    27 
    28 fun skew :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    28 fun skew :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    29 "skew (Node (Node t1 b lvb t2) a lva t3) =
    29 "skew (Node (Node t1 (b, lvb) t2) (a, lva) t3) =
    30   (if lva = lvb then Node t1 b lvb (Node t2 a lva t3) else Node (Node t1 b lvb t2) a lva t3)" |
    30   (if lva = lvb then Node t1 (b, lvb) (Node t2 (a, lva) t3) else Node (Node t1 (b, lvb) t2) (a, lva) t3)" |
    31 "skew t = t"
    31 "skew t = t"
    32 
    32 
    33 fun split :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    33 fun split :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    34 "split (Node t1 a lva (Node t2 b lvb (Node t3 c lvc t4))) =
    34 "split (Node t1 (a, lva) (Node t2 (b, lvb) (Node t3 (c, lvc) t4))) =
    35    (if lva = lvb \<and> lvb = lvc \<comment> \<open>\<open>lva = lvc\<close> suffices\<close>
    35    (if lva = lvb \<and> lvb = lvc \<comment> \<open>\<open>lva = lvc\<close> suffices\<close>
    36     then Node (Node t1 a lva t2) b (lva+1) (Node t3 c lva t4)
    36     then Node (Node t1 (a,lva) t2) (b,lva+1) (Node t3 (c, lva) t4)
    37     else Node t1 a lva (Node t2 b lvb (Node t3 c lvc t4)))" |
    37     else Node t1 (a,lva) (Node t2 (b,lvb) (Node t3 (c,lvc) t4)))" |
    38 "split t = t"
    38 "split t = t"
    39 
    39 
    40 hide_const (open) insert
    40 hide_const (open) insert
    41 
    41 
    42 fun insert :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
    42 fun insert :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
    43 "insert x Leaf = Node Leaf x 1 Leaf" |
    43 "insert x Leaf = Node Leaf (x, 1) Leaf" |
    44 "insert x (Node t1 a lv t2) =
    44 "insert x (Node t1 (a,lv) t2) =
    45   (case cmp x a of
    45   (case cmp x a of
    46      LT \<Rightarrow> split (skew (Node (insert x t1) a lv t2)) |
    46      LT \<Rightarrow> split (skew (Node (insert x t1) (a,lv) t2)) |
    47      GT \<Rightarrow> split (skew (Node t1 a lv (insert x t2))) |
    47      GT \<Rightarrow> split (skew (Node t1 (a,lv) (insert x t2))) |
    48      EQ \<Rightarrow> Node t1 x lv t2)"
    48      EQ \<Rightarrow> Node t1 (x, lv) t2)"
    49 
    49 
    50 fun sngl :: "'a aa_tree \<Rightarrow> bool" where
    50 fun sngl :: "'a aa_tree \<Rightarrow> bool" where
    51 "sngl Leaf = False" |
    51 "sngl Leaf = False" |
    52 "sngl (Node _ _ _ Leaf) = True" |
    52 "sngl (Node _ _ Leaf) = True" |
    53 "sngl (Node _ _ lva (Node _ _ lvb _)) = (lva > lvb)"
    53 "sngl (Node _ (_, lva) (Node _ (_, lvb) _)) = (lva > lvb)"
    54 
    54 
    55 definition adjust :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    55 definition adjust :: "'a aa_tree \<Rightarrow> 'a aa_tree" where
    56 "adjust t =
    56 "adjust t =
    57  (case t of
    57  (case t of
    58   Node l x lv r \<Rightarrow>
    58   Node l (x,lv) r \<Rightarrow>
    59    (if lvl l >= lv-1 \<and> lvl r >= lv-1 then t else
    59    (if lvl l >= lv-1 \<and> lvl r >= lv-1 then t else
    60     if lvl r < lv-1 \<and> sngl l then skew (Node l x (lv-1) r) else
    60     if lvl r < lv-1 \<and> sngl l then skew (Node l (x,lv-1) r) else
    61     if lvl r < lv-1
    61     if lvl r < lv-1
    62     then case l of
    62     then case l of
    63            Node t1 a lva (Node t2 b lvb t3)
    63            Node t1 (a,lva) (Node t2 (b,lvb) t3)
    64              \<Rightarrow> Node (Node t1 a lva t2) b (lvb+1) (Node t3 x (lv-1) r) 
    64              \<Rightarrow> Node (Node t1 (a,lva) t2) (b,lvb+1) (Node t3 (x,lv-1) r) 
    65     else
    65     else
    66     if lvl r < lv then split (Node l x (lv-1) r)
    66     if lvl r < lv then split (Node l (x,lv-1) r)
    67     else
    67     else
    68       case r of
    68       case r of
    69         Node t1 b lvb t4 \<Rightarrow>
    69         Node t1 (b,lvb) t4 \<Rightarrow>
    70           (case t1 of
    70           (case t1 of
    71              Node t2 a lva t3
    71              Node t2 (a,lva) t3
    72                \<Rightarrow> Node (Node l x (lv-1) t2) a (lva+1)
    72                \<Rightarrow> Node (Node l (x,lv-1) t2) (a,lva+1)
    73                     (split (Node t3 b (if sngl t1 then lva else lva+1) t4)))))"
    73                     (split (Node t3 (b, if sngl t1 then lva else lva+1) t4)))))"
    74 
    74 
    75 text\<open>In the paper, the last case of \<^const>\<open>adjust\<close> is expressed with the help of an
    75 text\<open>In the paper, the last case of \<^const>\<open>adjust\<close> is expressed with the help of an
    76 incorrect auxiliary function \texttt{nlvl}.
    76 incorrect auxiliary function \texttt{nlvl}.
    77 
    77 
    78 Function \<open>split_max\<close> below is called \texttt{dellrg} in the paper.
    78 Function \<open>split_max\<close> below is called \texttt{dellrg} in the paper.
    79 The latter is incorrect for two reasons: \texttt{dellrg} is meant to delete the largest
    79 The latter is incorrect for two reasons: \texttt{dellrg} is meant to delete the largest
    80 element but recurses on the left instead of the right subtree; the invariant
    80 element but recurses on the left instead of the right subtree; the invariant
    81 is not restored.\<close>
    81 is not restored.\<close>
    82 
    82 
    83 fun split_max :: "'a aa_tree \<Rightarrow> 'a aa_tree * 'a" where
    83 fun split_max :: "'a aa_tree \<Rightarrow> 'a aa_tree * 'a" where
    84 "split_max (Node l a lv Leaf) = (l,a)" |
    84 "split_max (Node l (a,lv) Leaf) = (l,a)" |
    85 "split_max (Node l a lv r) = (let (r',b) = split_max r in (adjust(Node l a lv r'), b))"
    85 "split_max (Node l (a,lv) r) = (let (r',b) = split_max r in (adjust(Node l (a,lv) r'), b))"
    86 
    86 
    87 fun delete :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
    87 fun delete :: "'a::linorder \<Rightarrow> 'a aa_tree \<Rightarrow> 'a aa_tree" where
    88 "delete _ Leaf = Leaf" |
    88 "delete _ Leaf = Leaf" |
    89 "delete x (Node l a lv r) =
    89 "delete x (Node l (a,lv) r) =
    90   (case cmp x a of
    90   (case cmp x a of
    91      LT \<Rightarrow> adjust (Node (delete x l) a lv r) |
    91      LT \<Rightarrow> adjust (Node (delete x l) (a,lv) r) |
    92      GT \<Rightarrow> adjust (Node l a lv (delete x r)) |
    92      GT \<Rightarrow> adjust (Node l (a,lv) (delete x r)) |
    93      EQ \<Rightarrow> (if l = Leaf then r
    93      EQ \<Rightarrow> (if l = Leaf then r
    94             else let (l',b) = split_max l in adjust (Node l' b lv r)))"
    94             else let (l',b) = split_max l in adjust (Node l' (b,lv) r)))"
    95 
    95 
    96 fun pre_adjust where
    96 fun pre_adjust where
    97 "pre_adjust (Node l a lv r) = (invar l \<and> invar r \<and>
    97 "pre_adjust (Node l (a,lv) r) = (invar l \<and> invar r \<and>
    98     ((lv = lvl l + 1 \<and> (lv = lvl r + 1 \<or> lv = lvl r + 2 \<or> lv = lvl r \<and> sngl r)) \<or>
    98     ((lv = lvl l + 1 \<and> (lv = lvl r + 1 \<or> lv = lvl r + 2 \<or> lv = lvl r \<and> sngl r)) \<or>
    99      (lv = lvl l + 2 \<and> (lv = lvl r + 1 \<or> lv = lvl r \<and> sngl r))))"
    99      (lv = lvl l + 2 \<and> (lv = lvl r + 1 \<or> lv = lvl r \<and> sngl r))))"
   100 
   100 
   101 declare pre_adjust.simps [simp del]
   101 declare pre_adjust.simps [simp del]
   102 
   102 
   103 subsection "Auxiliary Proofs"
   103 subsection "Auxiliary Proofs"
   104 
   104 
   105 lemma split_case: "split t = (case t of
   105 lemma split_case: "split t = (case t of
   106   Node t1 x lvx (Node t2 y lvy (Node t3 z lvz t4)) \<Rightarrow>
   106   Node t1 (x,lvx) (Node t2 (y,lvy) (Node t3 (z,lvz) t4)) \<Rightarrow>
   107    (if lvx = lvy \<and> lvy = lvz
   107    (if lvx = lvy \<and> lvy = lvz
   108     then Node (Node t1 x lvx t2) y (lvx+1) (Node t3 z lvx t4)
   108     then Node (Node t1 (x,lvx) t2) (y,lvx+1) (Node t3 (z,lvx) t4)
   109     else t)
   109     else t)
   110   | t \<Rightarrow> t)"
   110   | t \<Rightarrow> t)"
   111 by(auto split: tree.split)
   111 by(auto split: tree.split)
   112 
   112 
   113 lemma skew_case: "skew t = (case t of
   113 lemma skew_case: "skew t = (case t of
   114   Node (Node t1 y lvy t2) x lvx t3 \<Rightarrow>
   114   Node (Node t1 (y,lvy) t2) (x,lvx) t3 \<Rightarrow>
   115   (if lvx = lvy then Node t1 y lvx (Node t2 x lvx t3) else t)
   115   (if lvx = lvy then Node t1 (y, lvx) (Node t2 (x,lvx) t3) else t)
   116  | t \<Rightarrow> t)"
   116  | t \<Rightarrow> t)"
   117 by(auto split: tree.split)
   117 by(auto split: tree.split)
   118 
   118 
   119 lemma lvl_0_iff: "invar t \<Longrightarrow> lvl t = 0 \<longleftrightarrow> t = Leaf"
   119 lemma lvl_0_iff: "invar t \<Longrightarrow> lvl t = 0 \<longleftrightarrow> t = Leaf"
   120 by(cases t) auto
   120 by(cases t) auto
   121 
   121 
   122 lemma lvl_Suc_iff: "lvl t = Suc n \<longleftrightarrow> (\<exists> l a r. t = Node l a (Suc n) r)"
   122 lemma lvl_Suc_iff: "lvl t = Suc n \<longleftrightarrow> (\<exists> l a r. t = Node l (a,Suc n) r)"
   123 by(cases t) auto
   123 by(cases t) auto
   124 
   124 
   125 lemma lvl_skew: "lvl (skew t) = lvl t"
   125 lemma lvl_skew: "lvl (skew t) = lvl t"
   126 by(cases t rule: skew.cases) auto
   126 by(cases t rule: skew.cases) auto
   127 
   127 
   128 lemma lvl_split: "lvl (split t) = lvl t \<or> lvl (split t) = lvl t + 1 \<and> sngl (split t)"
   128 lemma lvl_split: "lvl (split t) = lvl t \<or> lvl (split t) = lvl t + 1 \<and> sngl (split t)"
   129 by(cases t rule: split.cases) auto
   129 by(cases t rule: split.cases) auto
   130 
   130 
   131 lemma invar_2Nodes:"invar (Node l x lv (Node rl rx rlv rr)) =
   131 lemma invar_2Nodes:"invar (Node l (x,lv) (Node rl (rx, rlv) rr)) =
   132      (invar l \<and> invar \<langle>rl, rx, rlv, rr\<rangle> \<and> lv = Suc (lvl l) \<and>
   132      (invar l \<and> invar \<langle>rl, (rx, rlv), rr\<rangle> \<and> lv = Suc (lvl l) \<and>
   133      (lv = Suc rlv \<or> rlv = lv \<and> lv = Suc (lvl rr)))"
   133      (lv = Suc rlv \<or> rlv = lv \<and> lv = Suc (lvl rr)))"
   134 by simp
   134 by simp
   135 
   135 
   136 lemma invar_NodeLeaf[simp]:
   136 lemma invar_NodeLeaf[simp]:
   137   "invar (Node l x lv Leaf) = (invar l \<and> lv = Suc (lvl l) \<and> lv = Suc 0)"
   137   "invar (Node l (x,lv) Leaf) = (invar l \<and> lv = Suc (lvl l) \<and> lv = Suc 0)"
   138 by simp
   138 by simp
   139 
   139 
   140 lemma sngl_if_invar: "invar (Node l a n r) \<Longrightarrow> n = lvl r \<Longrightarrow> sngl r"
   140 lemma sngl_if_invar: "invar (Node l (a, n) r) \<Longrightarrow> n = lvl r \<Longrightarrow> sngl r"
   141 by(cases r rule: sngl.cases) clarsimp+
   141 by(cases r rule: sngl.cases) clarsimp+
   142 
   142 
   143 
   143 
   144 subsection "Invariance"
   144 subsection "Invariance"
   145 
   145 
   165   thus ?case proof cases
   165   thus ?case proof cases
   166     case LT
   166     case LT
   167     thus ?thesis using 2 by (auto simp add: skew_case split_case split: tree.splits)
   167     thus ?thesis using 2 by (auto simp add: skew_case split_case split: tree.splits)
   168   next
   168   next
   169     case GT
   169     case GT
   170     thus ?thesis using 2 proof (cases t1)
   170     thus ?thesis using 2
       
   171     proof (cases t1 rule: tree2_cases)
   171       case Node
   172       case Node
   172       thus ?thesis using 2 GT  
   173       thus ?thesis using 2 GT  
   173         apply (auto simp add: skew_case split_case split: tree.splits)
   174         apply (auto simp add: skew_case split_case split: tree.splits)
   174         by (metis less_not_refl2 lvl.simps(2) lvl_insert_aux n_not_Suc_n sngl.simps(3))+ 
   175         by (metis less_not_refl2 lvl.simps(2) lvl_insert_aux n_not_Suc_n sngl.simps(3))+ 
   175     qed (auto simp add: lvl_0_iff)
   176     qed (auto simp add: lvl_0_iff)
   181 
   182 
   182 lemma split_invar: "invar t \<Longrightarrow> split t = t"
   183 lemma split_invar: "invar t \<Longrightarrow> split t = t"
   183 by(cases t rule: split.cases) clarsimp+
   184 by(cases t rule: split.cases) clarsimp+
   184 
   185 
   185 lemma invar_NodeL:
   186 lemma invar_NodeL:
   186   "\<lbrakk> invar(Node l x n r); invar l'; lvl l' = lvl l \<rbrakk> \<Longrightarrow> invar(Node l' x n r)"
   187   "\<lbrakk> invar(Node l (x, n) r); invar l'; lvl l' = lvl l \<rbrakk> \<Longrightarrow> invar(Node l' (x, n) r)"
   187 by(auto)
   188 by(auto)
   188 
   189 
   189 lemma invar_NodeR:
   190 lemma invar_NodeR:
   190   "\<lbrakk> invar(Node l x n r); n = lvl r + 1; invar r'; lvl r' = lvl r \<rbrakk> \<Longrightarrow> invar(Node l x n r')"
   191   "\<lbrakk> invar(Node l (x, n) r); n = lvl r + 1; invar r'; lvl r' = lvl r \<rbrakk> \<Longrightarrow> invar(Node l (x, n) r')"
   191 by(auto)
   192 by(auto)
   192 
   193 
   193 lemma invar_NodeR2:
   194 lemma invar_NodeR2:
   194   "\<lbrakk> invar(Node l x n r); sngl r'; n = lvl r + 1; invar r'; lvl r' = n \<rbrakk> \<Longrightarrow> invar(Node l x n r')"
   195   "\<lbrakk> invar(Node l (x, n) r); sngl r'; n = lvl r + 1; invar r'; lvl r' = n \<rbrakk> \<Longrightarrow> invar(Node l (x, n) r')"
   195 by(cases r' rule: sngl.cases) clarsimp+
   196 by(cases r' rule: sngl.cases) clarsimp+
   196 
   197 
   197 
   198 
   198 lemma lvl_insert_incr_iff: "(lvl(insert a t) = lvl t + 1) \<longleftrightarrow>
   199 lemma lvl_insert_incr_iff: "(lvl(insert a t) = lvl t + 1) \<longleftrightarrow>
   199   (\<exists>l x r. insert a t = Node l x (lvl t + 1) r \<and> lvl l = lvl r)"
   200   (\<exists>l x r. insert a t = Node l (x, lvl t + 1) r \<and> lvl l = lvl r)"
   200 apply(cases t)
   201 apply(cases t rule: tree2_cases)
   201 apply(auto simp add: skew_case split_case split: if_splits)
   202 apply(auto simp add: skew_case split_case split: if_splits)
   202 apply(auto split: tree.splits if_splits)
   203 apply(auto split: tree.splits if_splits)
   203 done
   204 done
   204 
   205 
   205 lemma invar_insert: "invar t \<Longrightarrow> invar(insert a t)"
   206 lemma invar_insert: "invar t \<Longrightarrow> invar(insert a t)"
   206 proof(induction t)
   207 proof(induction t rule: tree2_induct)
   207   case N: (Node l x n r)
   208   case N: (Node l x n r)
   208   hence il: "invar l" and ir: "invar r" by auto
   209   hence il: "invar l" and ir: "invar r" by auto
   209   note iil = N.IH(1)[OF il]
   210   note iil = N.IH(1)[OF il]
   210   note iir = N.IH(2)[OF ir]
   211   note iir = N.IH(2)[OF ir]
   211   let ?t = "Node l x n r"
   212   let ?t = "Node l (x, n) r"
   212   have "a < x \<or> a = x \<or> x < a" by auto
   213   have "a < x \<or> a = x \<or> x < a" by auto
   213   moreover
   214   moreover
   214   have ?case if "a < x"
   215   have ?case if "a < x"
   215   proof (cases rule: lvl_insert[of a l])
   216   proof (cases rule: lvl_insert[of a l])
   216     case (Same) thus ?thesis
   217     case (Same) thus ?thesis
   217       using \<open>a<x\<close> invar_NodeL[OF N.prems iil Same]
   218       using \<open>a<x\<close> invar_NodeL[OF N.prems iil Same]
   218       by (simp add: skew_invar split_invar del: invar.simps)
   219       by (simp add: skew_invar split_invar del: invar.simps)
   219   next
   220   next
   220     case (Incr)
   221     case (Incr)
   221     then obtain t1 w t2 where ial[simp]: "insert a l = Node t1 w n t2"
   222     then obtain t1 w t2 where ial[simp]: "insert a l = Node t1 (w, n) t2"
   222       using N.prems by (auto simp: lvl_Suc_iff)
   223       using N.prems by (auto simp: lvl_Suc_iff)
   223     have l12: "lvl t1 = lvl t2"
   224     have l12: "lvl t1 = lvl t2"
   224       by (metis Incr(1) ial lvl_insert_incr_iff tree.inject)
   225       by (metis Incr(1) ial lvl_insert_incr_iff tree.inject)
   225     have "insert a ?t = split(skew(Node (insert a l) x n r))"
   226     have "insert a ?t = split(skew(Node (insert a l) (x,n) r))"
   226       by(simp add: \<open>a<x\<close>)
   227       by(simp add: \<open>a<x\<close>)
   227     also have "skew(Node (insert a l) x n r) = Node t1 w n (Node t2 x n r)"
   228     also have "skew(Node (insert a l) (x,n) r) = Node t1 (w,n) (Node t2 (x,n) r)"
   228       by(simp)
   229       by(simp)
   229     also have "invar(split \<dots>)"
   230     also have "invar(split \<dots>)"
   230     proof (cases r)
   231     proof (cases r rule: tree2_cases)
   231       case Leaf
   232       case Leaf
   232       hence "l = Leaf" using N.prems by(auto simp: lvl_0_iff)
   233       hence "l = Leaf" using N.prems by(auto simp: lvl_0_iff)
   233       thus ?thesis using Leaf ial by simp
   234       thus ?thesis using Leaf ial by simp
   234     next
   235     next
   235       case [simp]: (Node t3 y m t4)
   236       case [simp]: (Node t3 y m t4)
   247   proof -
   248   proof -
   248     from \<open>invar ?t\<close> have "n = lvl r \<or> n = lvl r + 1" by auto
   249     from \<open>invar ?t\<close> have "n = lvl r \<or> n = lvl r + 1" by auto
   249     thus ?case
   250     thus ?case
   250     proof
   251     proof
   251       assume 0: "n = lvl r"
   252       assume 0: "n = lvl r"
   252       have "insert a ?t = split(skew(Node l x n (insert a r)))"
   253       have "insert a ?t = split(skew(Node l (x, n) (insert a r)))"
   253         using \<open>a>x\<close> by(auto)
   254         using \<open>a>x\<close> by(auto)
   254       also have "skew(Node l x n (insert a r)) = Node l x n (insert a r)"
   255       also have "skew(Node l (x,n) (insert a r)) = Node l (x,n) (insert a r)"
   255         using N.prems by(simp add: skew_case split: tree.split)
   256         using N.prems by(simp add: skew_case split: tree.split)
   256       also have "invar(split \<dots>)"
   257       also have "invar(split \<dots>)"
   257       proof -
   258       proof -
   258         from lvl_insert_sngl[OF ir sngl_if_invar[OF \<open>invar ?t\<close> 0], of a]
   259         from lvl_insert_sngl[OF ir sngl_if_invar[OF \<open>invar ?t\<close> 0], of a]
   259         obtain t1 y t2 where iar: "insert a r = Node t1 y n t2"
   260         obtain t1 y t2 where iar: "insert a r = Node t1 (y,n) t2"
   260           using N.prems 0 by (auto simp: lvl_Suc_iff)
   261           using N.prems 0 by (auto simp: lvl_Suc_iff)
   261         from N.prems iar 0 iir
   262         from N.prems iar 0 iir
   262         show ?thesis by (auto simp: split_case split: tree.splits)
   263         show ?thesis by (auto simp: split_case split: tree.splits)
   263       qed
   264       qed
   264       finally show ?thesis .
   265       finally show ?thesis .
   283 qed simp
   284 qed simp
   284 
   285 
   285 
   286 
   286 subsubsection "Proofs for delete"
   287 subsubsection "Proofs for delete"
   287 
   288 
   288 lemma invarL: "ASSUMPTION(invar \<langle>l, a, lv, r\<rangle>) \<Longrightarrow> invar l"
   289 lemma invarL: "ASSUMPTION(invar \<langle>l, (a, lv), r\<rangle>) \<Longrightarrow> invar l"
   289 by(simp add: ASSUMPTION_def)
   290 by(simp add: ASSUMPTION_def)
   290 
   291 
   291 lemma invarR: "ASSUMPTION(invar \<langle>lv, l, a, r\<rangle>) \<Longrightarrow> invar r"
   292 lemma invarR: "ASSUMPTION(invar \<langle>l, (a,lv), r\<rangle>) \<Longrightarrow> invar r"
   292 by(simp add: ASSUMPTION_def)
   293 by(simp add: ASSUMPTION_def)
   293 
   294 
   294 lemma sngl_NodeI:
   295 lemma sngl_NodeI:
   295   "sngl (Node l a lv r) \<Longrightarrow> sngl (Node l' a' lv r)"
   296   "sngl (Node l (a,lv) r) \<Longrightarrow> sngl (Node l' (a', lv) r)"
   296 by(cases r) (simp_all)
   297 by(cases r rule: tree2_cases) (simp_all)
   297 
   298 
   298 
   299 
   299 declare invarL[simp] invarR[simp]
   300 declare invarL[simp] invarR[simp]
   300 
   301 
   301 lemma pre_cases:
   302 lemma pre_cases:
   302 assumes "pre_adjust (Node l x lv r)"
   303 assumes "pre_adjust (Node l (x,lv) r)"
   303 obtains
   304 obtains
   304  (tSngl) "invar l \<and> invar r \<and>
   305  (tSngl) "invar l \<and> invar r \<and>
   305     lv = Suc (lvl r) \<and> lvl l = lvl r" |
   306     lv = Suc (lvl r) \<and> lvl l = lvl r" |
   306  (tDouble) "invar l \<and> invar r \<and>
   307  (tDouble) "invar l \<and> invar r \<and>
   307     lv = lvl r \<and> Suc (lvl l) = lvl r \<and> sngl r " |
   308     lv = lvl r \<and> Suc (lvl l) = lvl r \<and> sngl r " |
   315 by auto
   316 by auto
   316 
   317 
   317 declare invar.simps(2)[simp del] invar_2Nodes[simp add]
   318 declare invar.simps(2)[simp del] invar_2Nodes[simp add]
   318 
   319 
   319 lemma invar_adjust:
   320 lemma invar_adjust:
   320   assumes pre: "pre_adjust (Node l a lv r)"
   321   assumes pre: "pre_adjust (Node l (a,lv) r)"
   321   shows  "invar(adjust (Node l a lv r))"
   322   shows  "invar(adjust (Node l (a,lv) r))"
   322 using pre proof (cases rule: pre_cases)
   323 using pre proof (cases rule: pre_cases)
   323   case (tDouble) thus ?thesis unfolding adjust_def by (cases r) (auto simp: invar.simps(2)) 
   324   case (tDouble) thus ?thesis unfolding adjust_def by (cases r) (auto simp: invar.simps(2)) 
   324 next 
   325 next 
   325   case (rDown)
   326   case (rDown)
   326   from rDown obtain llv ll la lr where l: "l = Node ll la llv lr" by (cases l) auto
   327   from rDown obtain llv ll la lr where l: "l = Node ll (la, llv) lr" by (cases l) auto
   327   from rDown show ?thesis unfolding adjust_def by (auto simp: l invar.simps(2) split: tree.splits)
   328   from rDown show ?thesis unfolding adjust_def by (auto simp: l invar.simps(2) split: tree.splits)
   328 next
   329 next
   329   case (lDown_tDouble)
   330   case (lDown_tDouble)
   330   from lDown_tDouble obtain rlv rr ra rl where r: "r = Node rl ra rlv rr" by (cases r) auto
   331   from lDown_tDouble obtain rlv rr ra rl where r: "r = Node rl (ra, rlv) rr" by (cases r) auto
   331   from lDown_tDouble and r obtain rrlv rrr rra rrl where
   332   from lDown_tDouble and r obtain rrlv rrr rra rrl where
   332     rr :"rr = Node rrr rra rrlv rrl" by (cases rr) auto
   333     rr :"rr = Node rrr (rra, rrlv) rrl" by (cases rr) auto
   333   from  lDown_tDouble show ?thesis unfolding adjust_def r rr
   334   from  lDown_tDouble show ?thesis unfolding adjust_def r rr
   334     apply (cases rl) apply (auto simp add: invar.simps(2) split!: if_split)
   335     apply (cases rl rule: tree2_cases) apply (auto simp add: invar.simps(2) split!: if_split)
   335     using lDown_tDouble by (auto simp: split_case lvl_0_iff  elim:lvl.elims split: tree.split)
   336     using lDown_tDouble by (auto simp: split_case lvl_0_iff  elim:lvl.elims split: tree.split)
   336 qed (auto simp: split_case invar.simps(2) adjust_def split: tree.splits)
   337 qed (auto simp: split_case invar.simps(2) adjust_def split: tree.splits)
   337 
   338 
   338 lemma lvl_adjust:
   339 lemma lvl_adjust:
   339   assumes "pre_adjust (Node l a lv r)"
   340   assumes "pre_adjust (Node l (a,lv) r)"
   340   shows "lv = lvl (adjust(Node l a lv r)) \<or> lv = lvl (adjust(Node l a lv r)) + 1"
   341   shows "lv = lvl (adjust(Node l (a,lv) r)) \<or> lv = lvl (adjust(Node l (a,lv) r)) + 1"
   341 using assms(1) proof(cases rule: pre_cases)
   342 using assms(1)
       
   343 proof(cases rule: pre_cases)
   342   case lDown_tSngl thus ?thesis
   344   case lDown_tSngl thus ?thesis
   343     using lvl_split[of "\<langle>l, a, lvl r, r\<rangle>"] by (auto simp: adjust_def)
   345     using lvl_split[of "\<langle>l, (a, lvl r), r\<rangle>"] by (auto simp: adjust_def)
   344 next
   346 next
   345   case lDown_tDouble thus ?thesis
   347   case lDown_tDouble thus ?thesis
   346     by (auto simp: adjust_def invar.simps(2) split: tree.split)
   348     by (auto simp: adjust_def invar.simps(2) split: tree.split)
   347 qed (auto simp: adjust_def split: tree.splits)
   349 qed (auto simp: adjust_def split: tree.splits)
   348 
   350 
   349 lemma sngl_adjust: assumes "pre_adjust (Node l a lv r)"
   351 lemma sngl_adjust: assumes "pre_adjust (Node l (a,lv) r)"
   350   "sngl \<langle>l, a, lv, r\<rangle>" "lv = lvl (adjust \<langle>l, a, lv, r\<rangle>)"
   352   "sngl \<langle>l, (a, lv), r\<rangle>" "lv = lvl (adjust \<langle>l, (a, lv), r\<rangle>)"
   351   shows "sngl (adjust \<langle>l, a, lv, r\<rangle>)" 
   353   shows "sngl (adjust \<langle>l, (a, lv), r\<rangle>)" 
   352 using assms proof (cases rule: pre_cases)
   354 using assms proof (cases rule: pre_cases)
   353   case rDown
   355   case rDown
   354   thus ?thesis using assms(2,3) unfolding adjust_def
   356   thus ?thesis using assms(2,3) unfolding adjust_def
   355     by (auto simp add: skew_case) (auto split: tree.split)
   357     by (auto simp add: skew_case) (auto split: tree.split)
   356 qed (auto simp: adjust_def skew_case split_case split: tree.split)
   358 qed (auto simp: adjust_def skew_case split_case split: tree.split)
   359   invar t' \<and>
   361   invar t' \<and>
   360   (lvl t' = lvl t \<or> lvl t' + 1 = lvl t) \<and>
   362   (lvl t' = lvl t \<or> lvl t' + 1 = lvl t) \<and>
   361   (lvl t' = lvl t \<and> sngl t \<longrightarrow> sngl t')"
   363   (lvl t' = lvl t \<and> sngl t \<longrightarrow> sngl t')"
   362 
   364 
   363 lemma pre_adj_if_postR:
   365 lemma pre_adj_if_postR:
   364   "invar\<langle>lv, l, a, r\<rangle> \<Longrightarrow> post_del r r' \<Longrightarrow> pre_adjust \<langle>lv, l, a, r'\<rangle>"
   366   "invar\<langle>lv, (l, a), r\<rangle> \<Longrightarrow> post_del r r' \<Longrightarrow> pre_adjust \<langle>lv, (l, a), r'\<rangle>"
   365 by(cases "sngl r")
   367 by(cases "sngl r")
   366   (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)
   368   (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)
   367 
   369 
   368 lemma pre_adj_if_postL:
   370 lemma pre_adj_if_postL:
   369   "invar\<langle>l, a, lv, r\<rangle> \<Longrightarrow> post_del l l' \<Longrightarrow> pre_adjust \<langle>l', b, lv, r\<rangle>"
   371   "invar\<langle>l, (a, lv), r\<rangle> \<Longrightarrow> post_del l l' \<Longrightarrow> pre_adjust \<langle>l', (b, lv), r\<rangle>"
   370 by(cases "sngl r")
   372 by(cases "sngl r")
   371   (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)
   373   (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims)
   372 
   374 
   373 lemma post_del_adjL:
   375 lemma post_del_adjL:
   374   "\<lbrakk> invar\<langle>l, a, lv, r\<rangle>; pre_adjust \<langle>l', b, lv, r\<rangle> \<rbrakk>
   376   "\<lbrakk> invar\<langle>l, (a, lv), r\<rangle>; pre_adjust \<langle>l', (b, lv), r\<rangle> \<rbrakk>
   375   \<Longrightarrow> post_del \<langle>l, a, lv, r\<rangle> (adjust \<langle>l', b, lv, r\<rangle>)"
   377   \<Longrightarrow> post_del \<langle>l, (a, lv), r\<rangle> (adjust \<langle>l', (b, lv), r\<rangle>)"
   376 unfolding post_del_def
   378 unfolding post_del_def
   377 by (metis invar_adjust lvl_adjust sngl_NodeI sngl_adjust lvl.simps(2))
   379 by (metis invar_adjust lvl_adjust sngl_NodeI sngl_adjust lvl.simps(2))
   378 
   380 
   379 lemma post_del_adjR:
   381 lemma post_del_adjR:
   380 assumes "invar\<langle>lv, l, a, r\<rangle>" "pre_adjust \<langle>lv, l, a, r'\<rangle>" "post_del r r'"
   382 assumes "invar\<langle>l, (a,lv), r\<rangle>" "pre_adjust \<langle>l, (a,lv), r'\<rangle>" "post_del r r'"
   381 shows "post_del \<langle>lv, l, a, r\<rangle> (adjust \<langle>lv, l, a, r'\<rangle>)"
   383 shows "post_del \<langle>l, (a,lv), r\<rangle> (adjust \<langle>l, (a,lv), r'\<rangle>)"
   382 proof(unfold post_del_def, safe del: disjCI)
   384 proof(unfold post_del_def, safe del: disjCI)
   383   let ?t = "\<langle>lv, l, a, r\<rangle>"
   385   let ?t = "\<langle>l, (a,lv), r\<rangle>"
   384   let ?t' = "adjust \<langle>lv, l, a, r'\<rangle>"
   386   let ?t' = "adjust \<langle>l, (a,lv), r'\<rangle>"
   385   show "invar ?t'" by(rule invar_adjust[OF assms(2)])
   387   show "invar ?t'" by(rule invar_adjust[OF assms(2)])
   386   show "lvl ?t' = lvl ?t \<or> lvl ?t' + 1 = lvl ?t"
   388   show "lvl ?t' = lvl ?t \<or> lvl ?t' + 1 = lvl ?t"
   387     using lvl_adjust[OF assms(2)] by auto
   389     using lvl_adjust[OF assms(2)] by auto
   388   show "sngl ?t'" if as: "lvl ?t' = lvl ?t" "sngl ?t"
   390   show "sngl ?t'" if as: "lvl ?t' = lvl ?t" "sngl ?t"
   389   proof -
   391   proof -
   390     have s: "sngl \<langle>lv, l, a, r'\<rangle>"
   392     have s: "sngl \<langle>l, (a,lv), r'\<rangle>"
   391     proof(cases r')
   393     proof(cases r' rule: tree2_cases)
   392       case Leaf thus ?thesis by simp
   394       case Leaf thus ?thesis by simp
   393     next
   395     next
   394       case Node thus ?thesis using as(2) assms(1,3)
   396       case Node thus ?thesis using as(2) assms(1,3)
   395       by (cases r) (auto simp: post_del_def)
   397       by (cases r rule: tree2_cases) (auto simp: post_del_def)
   396     qed
   398     qed
   397     show ?thesis using as(1) sngl_adjust[OF assms(2) s] by simp
   399     show ?thesis using as(1) sngl_adjust[OF assms(2) s] by simp
   398   qed
   400   qed
   399 qed
   401 qed
   400 
   402 
   401 declare prod.splits[split]
   403 declare prod.splits[split]
   402 
   404 
   403 theorem post_split_max:
   405 theorem post_split_max:
   404  "\<lbrakk> invar t; (t', x) = split_max t; t \<noteq> Leaf \<rbrakk> \<Longrightarrow> post_del t t'"
   406  "\<lbrakk> invar t; (t', x) = split_max t; t \<noteq> Leaf \<rbrakk> \<Longrightarrow> post_del t t'"
   405 proof (induction t arbitrary: t' rule: split_max.induct)
   407 proof (induction t arbitrary: t' rule: split_max.induct)
   406   case (2 lv l a lvr rl ra rr)
   408   case (2 l a lv rl bl rr)
   407   let ?r =  "\<langle>lvr, rl, ra, rr\<rangle>"
   409   let ?r =  "\<langle>rl, bl, rr\<rangle>"
   408   let ?t = "\<langle>lv, l, a, ?r\<rangle>"
   410   let ?t = "\<langle>l, (a, lv), ?r\<rangle>"
   409   from "2.prems"(2) obtain r' where r': "(r', x) = split_max ?r"
   411   from "2.prems"(2) obtain r' where r': "(r', x) = split_max ?r"
   410     and [simp]: "t' = adjust \<langle>lv, l, a, r'\<rangle>" by auto
   412     and [simp]: "t' = adjust \<langle>l, (a, lv), r'\<rangle>" by auto
   411   from  "2.IH"[OF _ r'] \<open>invar ?t\<close> have post: "post_del ?r r'" by simp
   413   from  "2.IH"[OF _ r'] \<open>invar ?t\<close> have post: "post_del ?r r'" by simp
   412   note preR = pre_adj_if_postR[OF \<open>invar ?t\<close> post]
   414   note preR = pre_adj_if_postR[OF \<open>invar ?t\<close> post]
   413   show ?case by (simp add: post_del_adjR[OF "2.prems"(1) preR post])
   415   show ?case by (simp add: post_del_adjR[OF "2.prems"(1) preR post])
   414 qed (auto simp: post_del_def)
   416 qed (auto simp: post_del_def)
   415 
   417 
   416 theorem post_delete: "invar t \<Longrightarrow> post_del t (delete x t)"
   418 theorem post_delete: "invar t \<Longrightarrow> post_del t (delete x t)"
   417 proof (induction t)
   419 proof (induction t rule: tree2_induct)
   418   case (Node l a lv r)
   420   case (Node l a lv r)
   419 
   421 
   420   let ?l' = "delete x l" and ?r' = "delete x r"
   422   let ?l' = "delete x l" and ?r' = "delete x r"
   421   let ?t = "Node l a lv r" let ?t' = "delete x ?t"
   423   let ?t = "Node l (a,lv) r" let ?t' = "delete x ?t"
   422 
   424 
   423   from Node.prems have inv_l: "invar l" and inv_r: "invar r" by (auto)
   425   from Node.prems have inv_l: "invar l" and inv_r: "invar r" by (auto)
   424 
   426 
   425   note post_l' = Node.IH(1)[OF inv_l]
   427   note post_l' = Node.IH(1)[OF inv_l]
   426   note preL = pre_adj_if_postL[OF Node.prems post_l']
   428   note preL = pre_adj_if_postL[OF Node.prems post_l']