src/HOL/Data_Structures/Tree23_Map.thy
changeset 61534 a88e07c8d0d5
parent 61513 c0126c001b3d
child 61581 00d9682e8dd7
equal deleted inserted replaced
61532:e3984606b4b6 61534:a88e07c8d0d5
    19    if x < a2 then lookup m x else
    19    if x < a2 then lookup m x else
    20    if x = a2 then Some b2
    20    if x = a2 then Some b2
    21    else lookup r x)"
    21    else lookup r x)"
    22 
    22 
    23 fun upd :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>i" where
    23 fun upd :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>i" where
    24 "upd a b Leaf = Up\<^sub>i Leaf (a,b) Leaf" |
    24 "upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
    25 "upd a b (Node2 l xy r) =
    25 "upd x y (Node2 l ab r) =
    26    (if a < fst xy then
    26    (if x < fst ab then
    27         (case upd a b l of
    27         (case upd x y l of
    28            T\<^sub>i l' => T\<^sub>i (Node2 l' xy r)
    28            T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
    29          | Up\<^sub>i l1 q l2 => T\<^sub>i (Node3 l1 q l2 xy r))
    29          | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r))
    30     else if a = fst xy then T\<^sub>i (Node2 l (a,b) r)
    30     else if x = fst ab then T\<^sub>i (Node2 l (x,y) r)
    31     else
    31     else
    32         (case upd a b r of
    32         (case upd x y r of
    33            T\<^sub>i r' => T\<^sub>i (Node2 l xy r')
    33            T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
    34          | Up\<^sub>i r1 q r2 => T\<^sub>i (Node3 l xy r1 q r2)))" |
    34          | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
    35 "upd a b (Node3 l xy1 m xy2 r) =
    35 "upd x y (Node3 l ab1 m ab2 r) =
    36    (if a < fst xy1 then
    36    (if x < fst ab1 then
    37         (case upd a b l of
    37         (case upd x y l of
    38            T\<^sub>i l' => T\<^sub>i (Node3 l' xy1 m xy2 r)
    38            T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
    39          | Up\<^sub>i l1 q l2 => Up\<^sub>i (Node2 l1 q l2) xy1 (Node2 m xy2 r))
    39          | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r))
    40     else if a = fst xy1 then T\<^sub>i (Node3 l (a,b) m xy2 r)
    40     else if x = fst ab1 then T\<^sub>i (Node3 l (x,y) m ab2 r)
    41     else if a < fst xy2 then
    41     else if x < fst ab2 then
    42              (case upd a b m of
    42              (case upd x y m of
    43                 T\<^sub>i m' => T\<^sub>i (Node3 l xy1 m' xy2 r)
    43                 T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
    44               | Up\<^sub>i m1 q m2 => Up\<^sub>i (Node2 l xy1 m1) q (Node2 m2 xy2 r))
    44               | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r))
    45          else if a = fst xy2 then T\<^sub>i (Node3 l xy1 m (a,b) r)
    45          else if x = fst ab2 then T\<^sub>i (Node3 l ab1 m (x,y) r)
    46          else
    46          else
    47              (case upd a b r of
    47              (case upd x y r of
    48                 T\<^sub>i r' => T\<^sub>i (Node3 l xy1 m xy2 r')
    48                 T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
    49               | Up\<^sub>i r1 q r2 => Up\<^sub>i (Node2 l xy1 m) xy2 (Node2 r1 q r2)))"
    49               | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2)))"
    50 
    50 
    51 definition update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
    51 definition update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
    52 "update a b t = tree\<^sub>i(upd a b t)"
    52 "update a b t = tree\<^sub>i(upd a b t)"
    53 
    53 
    54 fun del :: "'a::linorder \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>d"
    54 fun del :: "'a::linorder \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>d"
    55 where
    55 where
    56 "del k Leaf = T\<^sub>d Leaf" |
    56 "del x Leaf = T\<^sub>d Leaf" |
    57 "del k (Node2 Leaf p Leaf) = (if k=fst p then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf p Leaf))" |
    57 "del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
    58 "del k (Node3 Leaf p Leaf q Leaf) = T\<^sub>d(if k=fst p then Node2 Leaf q Leaf
    58 "del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
    59   else if k=fst q then Node2 Leaf p Leaf else Node3 Leaf p Leaf q Leaf)" |
    59   else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
    60 "del k (Node2 l a r) = (if k<fst a then node21 (del k l) a r else
    60 "del x (Node2 l ab1 r) = (if x<fst ab1 then node21 (del x l) ab1 r else
    61   if k > fst a then node22 l a (del k r) else
    61   if x > fst ab1 then node22 l ab1 (del x r) else
    62   let (a',t) = del_min r in node22 l a' t)" |
    62   let (ab1',t) = del_min r in node22 l ab1' t)" |
    63 "del k (Node3 l a m b r) = (if k<fst a then node31 (del k l) a m b r else
    63 "del x (Node3 l ab1 m ab2 r) = (if x<fst ab1 then node31 (del x l) ab1 m ab2 r else
    64   if k = fst a then let (a',m') = del_min m in node32 l a' m' b r else
    64   if x = fst ab1 then let (ab1',m') = del_min m in node32 l ab1' m' ab2 r else
    65   if k < fst b then node32 l a (del k m) b r else
    65   if x < fst ab2 then node32 l ab1 (del x m) ab2 r else
    66   if k = fst b then let (b',r') = del_min r in node33 l a m b' r'
    66   if x = fst ab2 then let (ab2',r') = del_min r in node33 l ab1 m ab2' r'
    67   else node33 l a m b (del k r))"
    67   else node33 l ab1 m ab2 (del x r))"
    68 
    68 
    69 definition delete :: "'a::linorder \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
    69 definition delete :: "'a::linorder \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
    70 "delete k t = tree\<^sub>d(del k t)"
    70 "delete x t = tree\<^sub>d(del x t)"
    71 
    71 
    72 
    72 
    73 subsection \<open>Functional Correctness\<close>
    73 subsection \<open>Functional Correctness\<close>
    74 
    74 
    75 lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
    75 lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"