Quellcode-Bibliothek RBT_Set.thy Sprache: Isabelle

(*  Title:      HOL/Library/RBT_Set.thy
    Author:     Ondrej Kuncar
*)

section \<open>Implementation of sets using RBT trees\<close>

theory
imports RBT Product_Lexorder
begin

(*
  Users should be aware that by including this file all code equations
  outside of List.thy using 'a list as an implementation of sets cannot be
  used for code generation. If such equations are not needed, they can be
  deleted from the code generator. Otherwise, a user has to provide their
  own equations using RBT trees.
*)

\<open>Definition of code datatype constructors\<close>

java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
where" t = x RBT. t x = Some (}java.lang.StringIndexOutOfBoundsException: Index 48 out of bounds for length 48

definition   have "Finite_Setgcd t   gcd
  where

section \<open>Lemmas\<close> show

     simpadd:.eq_fold

lemma [simp]: "x \ Some () \ x = None"
by (auto simp: not_Some_eq[THEN iffD1])

lemma Set_set_keys: "Set x = dom (RBT.lookup x)"
by (auto simp: Set_def)

lemma finite_Set [simp, intro!]: "finite (Set x)"
by (simp add: Set_set_keys)

lemma set_keys: "Set t = set(RBT.keys t)"
by (simp add [code:

subsection \<open>fold and filter\<close>

lemma finite_fold_rbt_fold_eq:
  assumes "comp_fun_commute f Gcd (Sett)= Gcd<^sub>f\<^sub>i\<^sub>n (Set t) :: nat)"
  shows "Finite_Set.fold f A (set (RBT.entries by simp
proof -
  interpretjava.lang.StringIndexOutOfBoundsException: Index 12 out of bounds for length 0
    by (fact assms simp
  have * [code
    using distinct_entries>n( t) = fold_keys t (1:a:{, linorder
  showthesis assms by auto:  comp_fun_commute *)
qed

definition fold_keys comp_fun_commute:'
  where standardsimp add ac_simps

lemma fold_keys_def_altwithfinite_fold_fold_keys _ 1t]
  "fold_keys fSetfoldlcm1( t) = fold_keys lcm t 1"
by     byblast

lemma  then  ?thesis
  assumes "comp_fun_commute f"
   (imp: Lcm_fin.)
using
proof-
  interpret comp_fun_commute f by fact
  have "java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
" set RBT. ) distinct_entries distinct_map byauto
  ultimately show ?thesis
    b java.lang.StringIndexOutOfBoundsException: Index 9 out of bounds for length 9
      comp_comp_fun_commute
qed

definition" (Sett (Lcm\<^sub>f\<^sub>i\<^sub>n (Set t) :: int)"
  "rbt_filter P by simp

lemma :
  "Setfilter (ett) P t"
  by (subst Set_filter_fold)
    (simp_all add: lemma sorted_list_set [codesorted_list_of_sett  . t"

subsection \<open>foldi and Ball\<close>

lemma Ball_Falseby (auto simp: set_keys intro)
by (induction t) auto

lemma rbt_foldi_fold_conj Least_code [code
  "RBT_Impl. Lattices_Big.Least (Set t) = (if RBT.is_empty t then Lattices_Big.Least_abort {} else Min (Set t))\
proof (induction t arbitrary: val)
     ( simp : Lattices_Big simp : empty_Set
    by  apply subst)
qed simp

lemma foldi_fold_conjRBT \<lambda>s. s = True) (\<lambda>k v s. s \<and> P k) t val = fold_keys (\<lambda>k s. s \<and> P k) t val"
unfolding

subsection \<open>foldi and Bex\<close>

lemma Greatest_code]:
by (induction t) auto

lemma rbt_foldi_fold_disj:
  "RBT_Impl.foldi (\s. s = False) (\k v s. s \ P k) t val = RBT_Impl.fold (\k v s. s \ P k) t val"
proof (induction t arbitrary: val)
  case (Branch c t1) then show ?case
    by(casesfoldjava.lang.StringIndexOutOfBoundsException: Index 95 out of bounds for length 95
qed simp

lemma foldi_fold_disj: "RBT.foldi (\s. s = False) (\k v s. s \ P k) t val = fold_keys (\k s. s \ P k) t val"
unfolding including.liftingby  (rule rbt_foldi_fold_disj

subsection     apply autoauto

subsubsection \<open>concrete\<close>

text

definition[]:
  where "\

paragraph \<open>minimum\<close>

definition rbt_min
  where " [code]:

lemma\java.lang.StringIndexOutOfBoundsException: Index 67 out of bounds for length 67
  ( simp less_imp_le

lemma left_le_key: "rbt_sorted
( simp:rbt_less_prop less_imp_le

lemma fold_min_triv:
  fixes k :: "_ :: linorder"
  shows "(\x\set xs. k \ x) \ List.fold min xs k = k"
by ( fact.can_select_iff_is_singleton

lemma rbt_min_simps
  "is_rbtdeclare [codedrop:
by (auto intro

fun rbt_min_opt where
  "rbt_min_opt (Branch c RBT_Impl.Empty k v rtred\
" (Branch Branch llc lk lvlrt)k ) = (Branch lc llclklvlrt)java.lang.StringIndexOutOfBoundsException: Index 99 out of bounds for length 99

lemma rbt_min_opt_Branch:
  "]]
by (cases t1) auto

lemma rbt_min_opt_induct [case_names (open RBT_Set RBT_SetCoset
  fixes t :: "('a :: linorder, unit) RBT_Impl.rbt"
  assumes "P rbt.Empty"
  assumes
  assumes "\color t1 a b t2. P t1 \ P t2 \ t1 \ rbt.Empty \ P (Branch color t1 a b t2)"
  shows "P t"
  using assms
proof (induct t)
  case Empty
  then show ?case by simp
next
  case (Branch x1 t1 x3 x4 t2)
  then show ?case by (cases

lemma rbt_min_opt_in_set:
  fixes t :: " Max( t)=
  assumes "t \ rbt.Empty"
  shows rbt_min_opt\<in> set (RBT_Impl.keys t)"
using by (inductionrule.induct) ()

lemma rbt_min_opt_is_min:
  fixes t :: "' : linorder,unit RBT_Impl.rbt"
  assumes "proof-
  assumes "t \ rbt.Empty"
  shows "\y. y \ set (RBT_Impl.keys t) \ y \ rbt_min_opt t"
using assms
proofinductionrule)
  case empty
  then show ?   finite_fold1_fold1_keys[OF folded]
next
  case left_empty
then showcaseby( intro key_le_right simp: rbt_sorted.)
next
  case (left_non_empty c     by ( add: r_max_alt_def [symmetric)java.lang.StringIndexOutOfBoundsException: Index 65 out of bounds for length 65
n  "y = k |" \<in> set (RBT_Impl.keys t1)" | "y \<in> set (RBT_Impl.keys t2)"
    byauto
  then show ?case
  proof cases
    case 1
    with left_non_empty( add:sup_max Sup_fin_def)
      by (auto simp
next
    case 2
    with  fixes:"' : linorder }, unit) rbt"
      by (auto simp   "Sup (Set t)= (f RBT. t then bot else r_max_opt t)"
  next
    case proof
    have " "comp_fun_commute :: '\ 'a \ 'a)"
      using left_non_empty ( add)
    moreover have have "t \ RBT.empty \ Finite_Set.fold max bot (Set t) = fold1_keys max t"
      using left_non_empty y by (simp add: key_le_right)
    ultimately show ?thesis
      usingleft_non_emptyby ( add: rbt_min_opt_Branch
  qed
qed]

lemma rbt_min_eq_rbt_min_opt:
  assumes "t \ RBT_Impl.Empty" java.lang.StringIndexOutOfBoundsException: Index 9 out of bounds for length 9
   "is_rbtt
  shows "rbt_min t = rbt_min_opt t"
proof -
  from have" (RBT_Impl. t) tl (RBT_Impl. t) =RBT_Implkeyst cases )
  with assms show ?thesis
    by (simp add: rbt_min_def ( simp: Lattices_Big simp: empty_Set
      Min [symmetric Min_eqIrbt_min_opt_in_set)
qed

paragraph \<open>maximum\<close>

definition rbt_max :: "('a::linorder, unit) RBT_Impl.rbt \ 'a"
  where

lemma fold_max_trivjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  fixes k: " : linorder"
  shows "(\x\set xs. x \ k) \ List.fold max xs k = k"
by (induct xs) (auto add max_def

lemma fold_max_rev_eq:
  fixes xs auto addLattices_Big simpflip)
  assumes "xs \ []"
fold  (tl) (hd) = Listfold (tlrev)) (hdrev xs)"
  using assms byusing

lemma :
  assumes "is_rbt (Branch c lt k v RBT_Impl.Empty)"
  shows "rbt_max (Branchjava.lang.StringIndexOutOfBoundsException: Index 25 out of bounds for length 0
proof -
  \<open>Option.these A = the ` Set.filter (Not \<circ> Option.is_none) A\<close>
    using assms by (auto fact.these_eq
  then show ?thesis [code
qed

fun rbt_max_opt where
  "rbt_max_opt Branch cltkv.Empty) = k java.lang.StringIndexOutOfBoundsException: Range [54, 55) out of bounds for length 54
  "rbt_max_opt(Branchcltkv(Branch rlc rk rv rrt)) =rbt_max_opt( rc rlc rk rv )"

lemma rbt_max_opt_Branch:
  \<open>Set.can_select P A = is_singleton (Set.filter P A)\<close>
by ( t2)auto

lemma rbt_max_opt_induct [case_names empty right_empty right_non_empty]:
  fixes t :: java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
bt.Emptyjava.lang.NullPointerException
  assumes "java.lang.StringIndexOutOfBoundsException: Range [0, 85) out of bounds for length 46
  assumes "java.lang.StringIndexOutOfBoundsException: Range [0, 106) out of bounds for length 57
  shows " pred_of_set
  using assms
proof (induct t)
  case Empty
  then show? by simp
next
  case (Branch x1 t1 x3 x4 t2)]
  then show
qed

lemma rbt_max_opt_in_set:
  fixes t :: "('a :: linorder, unit)java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  assumes "t \ rbt.Empty"
  shows "rbt_max_opt t \ set (RBT_Impl.keys t)"
using assms by (induction t rule: rbt_max_opt.induct) (auto)

lemma rbt_max_opt_is_max:
  fixes t :: "('a :: linorder, unit) RBT_Impl.rbt"
  assumes "rbt_sorted t"
  assumes "t \ rbt.Empty"
  shows "\y. y \ set (RBT_Impl.keys t) \ y \ rbt_max_opt t"
using assms
proof (induction t rule: rbt_max_opt_induct)
  case empty
  then show ?case by simp
next
  case right_empty
  then show ?case by (auto intro: left_le_key simp del: rbt_sorted.simps)
next
  case (right_non_empty c t1 k v t2 y)
  then consider "y = k" | "y \ set (RBT_Impl.keys t2)" | "y \ set (RBT_Impl.keys t1)"
    by auto
  then show ?case
  proof cases
    case 1
    with right_non_empty show ?thesis
      by (auto simp add: rbt_max_opt_Branch intro: key_le_right rbt_max_opt_in_set)
  next
    case 2
    with right_non_empty show ?thesis
      by (auto simp add: rbt_max_opt_Branch)
  next
    case y: 3
    have "rbt_max_opt t2 \ k"
      using right_non_empty by (simp add: key_le_right rbt_max_opt_in_set)
    moreover have "y \ k"
      using right_non_empty y by (simp add: left_le_key)
    ultimately show ?thesis
      using right_non_empty by (simp add: rbt_max_opt_Branch)
  qed
qed

lemma rbt_max_eq_rbt_max_opt:
  assumes "t \ RBT_Impl.Empty"
  assumes "is_rbt t"
  shows "rbt_max t = rbt_max_opt t"
proof -
  from assms have "hd (RBT_Impl.keys t) # tl (RBT_Impl.keys t) = RBT_Impl.keys t" by (cases t) simp_all
  with assms show ?thesis
    by (simp add: rbt_max_def rbt_fold1_keys_def rbt_max_opt_is_max
      Max.set_eq_fold [symmetric] Max_eqI rbt_max_opt_in_set)
qed

subsubsection \<open>abstract\<close>

context includes rbt.lifting begin
lift_definition fold1_keys :: "('a \ 'a \ 'a) \ ('a::linorder, 'b) rbt \ 'a"
  is rbt_fold1_keys .

lemma fold1_keys_def_alt:
  "fold1_keys f t = List.fold f (tl (RBT.keys t)) (hd (RBT.keys t))"
  by transfer (simp add: rbt_fold1_keys_def)

lemma finite_fold1_fold1_keys:
  assumes "semilattice f"
  assumes "\ RBT.is_empty t"
  shows "semilattice_set.F f (Set t) = fold1_keys f t"
proof -
  from \<open>semilattice f\<close> interpret semilattice_set f by (rule semilattice_set.intro)
  show ?thesis using assms
    by (auto simp: fold1_keys_def_alt set_keys fold_def_alt non_empty_keys set_eq_fold [symmetric])
qed

paragraph \<open>minimum\<close>

lift_definition r_min :: "('a :: linorder, unit) rbt \ 'a" is rbt_min .

lift_definition r_min_opt :: "('a :: linorder, unit) rbt \ 'a" is rbt_min_opt .

lemma r_min_alt_def: "r_min t = fold1_keys min t"
by transfer (simp add: rbt_min_def)

lemma r_min_eq_r_min_opt:
  assumes "\ (RBT.is_empty t)"
  shows "r_min t = r_min_opt t"
using assms unfolding is_empty_empty by transfer (auto intro: rbt_min_eq_rbt_min_opt)

lemma fold_keys_min_top_eq:
  fixes t :: "('a::{linorder,bounded_lattice_top}, unit) rbt"
  assumes "\ (RBT.is_empty t)"
  shows "fold_keys min t top = fold1_keys min t"
proof -
  have *: "\t. RBT_Impl.keys t \ [] \ List.fold min (RBT_Impl.keys t) top =
      List.fold min (hd (RBT_Impl.keys t) # tl (RBT_Impl.keys t)) top"
    by (simp add: hd_Cons_tl[symmetric])
  have **: "List.fold min (x # xs) top = List.fold min xs x" for x :: 'a and xs
    by (simp add: inf_min[symmetric])
  show ?thesis
    using assms
    unfolding fold_keys_def_alt fold1_keys_def_alt is_empty_empty
    apply transfer
    apply (case_tac t)
     apply simp
    apply (subst *)
     apply simp
    apply (subst **)
    apply simp
    done
qed

paragraph \<open>maximum\<close>

lift_definition r_max :: "('a :: linorder, unit) rbt \ 'a" is rbt_max .

lift_definition r_max_opt :: "('a :: linorder, unit) rbt \ 'a" is rbt_max_opt .

lemma r_max_alt_def: "r_max t = fold1_keys max t"
by transfer (simp add: rbt_max_def)

lemma r_max_eq_r_max_opt:
  assumes "\ (RBT.is_empty t)"
  shows "r_max t = r_max_opt t"
using assms unfolding is_empty_empty by transfer (auto intro: rbt_max_eq_rbt_max_opt)

lemma fold_keys_max_bot_eq:
  fixes t :: "('a::{linorder,bounded_lattice_bot}, unit) rbt"
  assumes "\ (RBT.is_empty t)"
  shows "fold_keys max t bot = fold1_keys max t"
proof -
  have *: "\t. RBT_Impl.keys t \ [] \ List.fold max (RBT_Impl.keys t) bot =
      List.fold max (hd(RBT_Impl.keys t) # tl(RBT_Impl.keys t)) bot"
    by (simp add: hd_Cons_tl[symmetric])
  have **: "List.fold max (x # xs) bot = List.fold max xs x" for x :: 'a and xs
    by (simp add: sup_max[symmetric])
  show ?thesis
    using assms
    unfolding fold_keys_def_alt fold1_keys_def_alt is_empty_empty
    apply transfer
    apply (case_tac t)
     apply simp
    apply (subst *)
     apply simp
    apply (subst **)
    apply simp
    done
qed

end

section \<open>Code equations\<close>

code_datatype Set Coset

declare list.set[code] (* needed? *)

lemma empty_Set [code]:
  "Set.empty = Set RBT.empty"
by (auto simp: Set_def)

lemma UNIV_Coset [code]:
  "UNIV = Coset RBT.empty"
by (auto simp: Set_def)

lemma is_empty_Set [code]:
  "Set.is_empty (Set t) = RBT.is_empty t"
  using non_empty_keys [of t] by (auto simp add: set_keys)

lemma compl_code [code]:
  "- Set xs = Coset xs"
  "- Coset xs = Set xs"
by (simp_all add: Set_def)

lemma member_code [code]:
  "x \ (Set t) = (RBT.lookup t x = Some ())"
  "x \ (Coset t) = (RBT.lookup t x = None)"
by (simp_all add: Set_def)

lemma insert_code [code]:
  "Set.insert x (Set t) = Set (RBT.insert x () t)"
  "Set.insert x (Coset t) = Coset (RBT.delete x t)"
by (auto simp: Set_def)

lemma remove_code [code]:
  "Set.remove x (Set t) = Set (RBT.delete x t)"
  "Set.remove x (Coset t) = Coset (RBT.insert x () t)"
by (auto simp: Set_def)

lemma inter_Set [code]:
  "A \ Set t = rbt_filter (\k. k \ A) t"
by (simp flip: Set_filter_rbt_filter add: inter_Set_filter)

lemma union_Set_Set [code]:
  "Set t1 \ Set t2 = Set (RBT.union t1 t2)"
by (auto simp add: lookup_union map_add_Some_iff Set_def)

lemma union_Set [code]:
  "Set t \ A = fold_keys Set.insert t A"
proof -
  interpret comp_fun_idem Set.insert
    by (fact comp_fun_idem_insert)
  from finite_fold_fold_keys[OF comp_fun_commute_axioms]
  show ?thesis by (auto simp add: union_fold_insert)
qed

lemma minus_Set [code]:
  "A - Set t = fold_keys Set.remove t A"
proof -
  interpret comp_fun_idem Set.remove
    by (fact comp_fun_idem_remove)
  from finite_fold_fold_keys[OF comp_fun_commute_axioms]
  show ?thesis by (auto simp add: minus_fold_remove)
qed

lemma inter_Coset_Coset [code]:
  "Coset t1 \ Coset t2 = Coset (RBT.union t1 t2)"
by (auto simp add: lookup_union map_add_Some_iff Set_def)

lemma inter_Coset [code]:
  "A \ Coset t = fold_keys Set.remove t A"
by (simp add: Diff_eq [symmetric] minus_Set)

lemma union_Coset [code]:
  "Coset t \ A = - rbt_filter (\k. k \ A) t"
proof -
  have *: "\A B. (-A \ B) = -(-B \ A)" by blast
  show ?thesis by (simp del: boolean_algebra_class.compl_inf add: * inter_Set)
qed

lemma minus_Coset [code]:
  "A - Coset t = rbt_filter (\k. k \ A) t"
by (simp add: inter_Set[simplified Int_commute])

lemma filter_Set [code]:
  "Set.filter P (Set t) = rbt_filter P t"
  by (fact Set_filter_rbt_filter)

lemma image_Set [code]:
  "image f (Set t) = fold_keys (\k A. Set.insert (f k) A) t {}"
proof -
  have "comp_fun_commute (\k. Set.insert (f k))"
    by standard auto
  then show ?thesis
    by (auto simp add: image_fold_insert intro!: finite_fold_fold_keys)
qed

lemma Ball_Set [code]:
  "Ball (Set t) P \ RBT.foldi (\s. s = True) (\k v s. s \ P k) t True"
proof -
  have "comp_fun_commute (\k s. s \ P k)"
    by standard auto
  then show ?thesis
    by (simp add: foldi_fold_conj[symmetric] Ball_fold finite_fold_fold_keys)
qed

lemma Bex_Set [code]:
  "Bex (Set t) P \ RBT.foldi (\s. s = False) (\k v s. s \ P k) t False"
proof -
  have "comp_fun_commute (\k s. s \ P k)"
    by standard auto
  then show ?thesis
    by (simp add: foldi_fold_disj[symmetric] Bex_fold finite_fold_fold_keys)
qed

lemma subset_code [code]:
  "Set t \ B \ (\x\Set t. x \ B)"
  "A \ Coset t \ (\y\Set t. y \ A)"
by auto

lemma subset_Coset_empty_Set_empty [code]:
  "Coset t1 \ Set t2 \ (case (RBT.impl_of t1, RBT.impl_of t2) of
    (rbt.Empty, rbt.Empty) \<Rightarrow> False |
    (_, _) \<Rightarrow> Code.abort (STR ''non_empty_trees'') (\<lambda>_. Coset t1 \<le> Set t2))"
proof -
  have *: "\t. RBT.impl_of t = rbt.Empty \ t = RBT rbt.Empty"
    by (subst(asm) RBT_inverse[symmetric]) (auto simp: impl_of_inject)
  have **: "eq_onp is_rbt rbt.Empty rbt.Empty" unfolding eq_onp_def by simp
  show ?thesis
    by (auto simp: Set_def lookup.abs_eq[OF **] dest!: * split: rbt.split)
qed

text \<open>A frequent case -- avoid intermediate sets\<close>
lemma [code_unfold]:
  "Set t1 \ Set t2 \ RBT.foldi (\s. s = True) (\k v s. s \ k \ Set t2) t1 True"
by (simp add: subset_code Ball_Set)

lemma card_Set [code]:
  "card (Set t) = fold_keys (\_ n. n + 1) t 0"
  by (auto simp add: card.eq_fold intro: finite_fold_fold_keys comp_fun_commute_const)

lemma sum_Set [code]:
  "sum f (Set xs) = fold_keys (plus \ f) xs 0"
proof -
  have "comp_fun_commute (\x. (+) (f x))"
    by standard (auto simp: ac_simps)
  then show ?thesis
    by (auto simp add: sum.eq_fold finite_fold_fold_keys o_def)
qed

lemma prod_Set [code]:
  "prod f (Set xs) = fold_keys (times \ f) xs 1"
proof -
  have "comp_fun_commute (\x. (*) (f x))"
    by standard (auto simp: ac_simps)
  then show ?thesis
    by (auto simp add: prod.eq_fold finite_fold_fold_keys o_def)
qed

lemma the_elem_set [code]:
  fixes t :: "('a :: linorder, unit) rbt"
  shows "the_elem (Set t) = (case RBT.impl_of t of
    (Branch RBT_Impl.B RBT_Impl.Empty x () RBT_Impl.Empty) \<Rightarrow> x
    | _ \<Rightarrow> Code.abort (STR ''not_a_singleton_tree'') (\<lambda>_. the_elem (Set t)))"
proof -
  {
    fix x :: "'a :: linorder"
    let ?t = "Branch RBT_Impl.B RBT_Impl.Empty x () RBT_Impl.Empty"
    have *:"?t \ {t. is_rbt t}" unfolding is_rbt_def by auto
    then have **:"eq_onp is_rbt ?t ?t" unfolding eq_onp_def by auto

    have "RBT.impl_of t = ?t \ the_elem (Set t) = x"
      by (subst(asm) RBT_inverse[symmetric, OF *])
        (auto simp: Set_def the_elem_def lookup.abs_eq[OF **] impl_of_inject)
  }
  then show ?thesis
    by(auto split: rbt.split unit.split color.split)
qed

lemma Pow_Set [code]: "Pow (Set t) = fold_keys (\x A. A \ Set.insert x ` A) t {{}}"
  by (simp add: Pow_fold finite_fold_fold_keys[OF comp_fun_commute_Pow_fold])

lemma product_Set [code]:
  "Product_Type.product (Set t1) (Set t2) =
    fold_keys (\<lambda>x A. fold_keys (\<lambda>y. Set.insert (x, y)) t2 A) t1 {}"
proof -
  have *: "comp_fun_commute (\y. Set.insert (x, y))" for x
    by standard auto
  show ?thesis using finite_fold_fold_keys[OF comp_fun_commute_product_fold, of "Set t2" "{}" "t1"]
    by (simp add: product_fold Product_Type.product_def finite_fold_fold_keys[OF *])
qed

lemma Id_on_Set [code]: "Id_on (Set t) = fold_keys (\x. Set.insert (x, x)) t {}"
proof -
  have "comp_fun_commute (\x. Set.insert (x, x))"
    by standard auto
  then show ?thesis
    by (auto simp add: Id_on_fold intro!: finite_fold_fold_keys)
qed

lemma Image_Set [code]:
  "(Set t) `` S = fold_keys (\(x,y) A. if x \ S then Set.insert y A else A) t {}"
by (auto simp add: Image_fold finite_fold_fold_keys[OF comp_fun_commute_Image_fold])

lemma trancl_set_ntrancl [code]:
  "trancl (Set t) = ntrancl (card (Set t) - 1) (Set t)"
by (simp add: finite_trancl_ntranl)

lemma relcomp_Set[code]:
  "(Set t1) O (Set t2) = fold_keys
    (\<lambda>(x,y) A. fold_keys (\<lambda>(w,z) A'. if y = w then Set.insert (x,z) A' else A') t2 A) t1 {}"
proof -
  interpret comp_fun_idem Set.insert
    by (fact comp_fun_idem_insert)
  have *: "\x y. comp_fun_commute (\(w, z) A'. if y = w then Set.insert (x, z) A' else A')"
    by standard (auto simp add: fun_eq_iff)
  show ?thesis
    using finite_fold_fold_keys[OF comp_fun_commute_relcomp_fold, of "Set t2" "{}" t1]
    by (simp add: relcomp_fold finite_fold_fold_keys[OF *])
qed

lemma wf_set: "wf (Set t) = acyclic (Set t)"
  by (simp add: wf_iff_acyclic_if_finite)

lemma wf_code_set[code]: "wf_code (Set t) = acyclic (Set t)"
  unfolding wf_code_def using wf_set .

lemma Min_fin_set_fold [code]:
  "Min (Set t) =
  (if RBT.is_empty t
   then Code.abort (STR ''not_non_empty_tree'') (\<lambda>_. Min (Set t))
   else r_min_opt t)"
proof -
  have *: "semilattice (min :: 'a \ 'a \ 'a)" ..
  with finite_fold1_fold1_keys [OF *, folded Min_def]
  show ?thesis
    by (simp add: r_min_alt_def r_min_eq_r_min_opt [symmetric])
qed

lemma Inf_fin_set_fold [code]:
  "Inf_fin (Set t) = Min (Set t)"
by (simp add: inf_min Inf_fin_def Min_def)

lemma Inf_Set_fold:
  fixes t :: "('a :: {linorder, complete_lattice}, unit) rbt"
  shows "Inf (Set t) = (if RBT.is_empty t then top else r_min_opt t)"
proof -
  have "comp_fun_commute (min :: 'a \ 'a \ 'a)"
    by standard (simp add: fun_eq_iff ac_simps)
  then have "t \ RBT.empty \ Finite_Set.fold min top (Set t) = fold1_keys min t"
    by (simp add: finite_fold_fold_keys fold_keys_min_top_eq)
  then show ?thesis
    by (auto simp add: Inf_fold_inf inf_min empty_Set[symmetric]
      r_min_eq_r_min_opt[symmetric] r_min_alt_def)
qed

lemma Max_fin_set_fold [code]:
  "Max (Set t) =
  (if RBT.is_empty t
   then Code.abort (STR ''not_non_empty_tree'') (\<lambda>_. Max (Set t))
   else r_max_opt t)"
proof -
  have *: "semilattice (max :: 'a \ 'a \ 'a)" ..
  with finite_fold1_fold1_keys [OF *, folded Max_def]
  show ?thesis
    by (simp add: r_max_alt_def r_max_eq_r_max_opt [symmetric])
qed

lemma Sup_fin_set_fold [code]:
  "Sup_fin (Set t) = Max (Set t)"
by (simp add: sup_max Sup_fin_def Max_def)

lemma Sup_Set_fold:
  fixes t :: "('a :: {linorder, complete_lattice}, unit) rbt"
  shows "Sup (Set t) = (if RBT.is_empty t then bot else r_max_opt t)"
proof -
  have "comp_fun_commute (max :: 'a \ 'a \ 'a)"
    by standard (simp add: fun_eq_iff ac_simps)
  then have "t \ RBT.empty \ Finite_Set.fold max bot (Set t) = fold1_keys max t"
    by (simp add: finite_fold_fold_keys fold_keys_max_bot_eq)
  then show ?thesis
    by (auto simp add: Sup_fold_sup sup_max empty_Set[symmetric]
      r_max_eq_r_max_opt[symmetric] r_max_alt_def)
qed

context
begin

qualified definition Inf' :: "'a :: {linorder, complete_lattice} set \<Rightarrow> 'a"
  where [code_abbrev]: "Inf' = Inf"

lemma Inf'_Set_fold [code]:
  "Inf' (Set t) = (if RBT.is_empty t then top else r_min_opt t)"
  by (simp add: Inf'_def Inf_Set_fold)

qualified definition Sup' :: "'a :: {linorder, complete_lattice} set \<Rightarrow> 'a"
  where [code_abbrev]: "Sup' = Sup"

lemma Sup'_Set_fold [code]:
  "Sup' (Set t) = (if RBT.is_empty t then bot else r_max_opt t)"
  by (simp add: Sup'_def Sup_Set_fold)

end

lemma [code]:
  "Gcd\<^sub>f\<^sub>i\<^sub>n (Set t) = fold_keys gcd t (0::'a::{semiring_gcd, linorder})"
proof -
  have "comp_fun_commute (gcd :: 'a \ _)"
    by standard (simp add: fun_eq_iff ac_simps)
  with finite_fold_fold_keys [of _ 0 t]
  have "Finite_Set.fold gcd 0 (Set t) = fold_keys gcd t 0"
    by blast
  then show ?thesis
    by (simp add: Gcd_fin.eq_fold)
qed

lemma [code]:
  "Gcd (Set t) = (Gcd\<^sub>f\<^sub>i\<^sub>n (Set t) :: nat)"
  by simp

lemma [code]:
  "Gcd (Set t) = (Gcd\<^sub>f\<^sub>i\<^sub>n (Set t) :: int)"
  by simp

lemma [code]:
  "Lcm\<^sub>f\<^sub>i\<^sub>n (Set t) = fold_keys lcm t (1::'a::{semiring_gcd, linorder})"
proof -
  have "comp_fun_commute (lcm :: 'a \ _)"
    by standard (simp add: fun_eq_iff ac_simps)
  with finite_fold_fold_keys [of _ 1 t]
  have "Finite_Set.fold lcm 1 (Set t) = fold_keys lcm t 1"
    by blast
  then show ?thesis
    by (simp add: Lcm_fin.eq_fold)
qed

lemma [code]:
  "Lcm (Set t) = (Lcm\<^sub>f\<^sub>i\<^sub>n (Set t) :: nat)"
  by simp

lemma [code]:
  "Lcm (Set t) = (Lcm\<^sub>f\<^sub>i\<^sub>n (Set t) :: int)"
  by simp

lemma sorted_list_set [code]: "sorted_list_of_set (Set t) = RBT.keys t"
  by (auto simp add: set_keys intro: sorted_distinct_set_unique)

lemma Least_code [code]:
  \<open>Lattices_Big.Least (Set t) = (if RBT.is_empty t then Lattices_Big.Least_abort {} else Min (Set t))\<close>
  apply (auto simp add: Lattices_Big.Least_abort_def simp flip: empty_Set)
  apply (subst Least_Min)
  using is_empty_Set
    apply auto
  done

lemma Greatest_code [code]:
  \<open>Lattices_Big.Greatest (Set t) = (if RBT.is_empty t then Lattices_Big.Greatest_abort {} else Max (Set t))\<close>
  apply (auto simp add: Lattices_Big.Greatest_abort_def simp flip: empty_Set)
  apply (subst Greatest_Max)
  using is_empty_Set
    apply auto
  done

lemma [code]:
  \<open>Option.these A = the ` Set.filter (Not \<circ> Option.is_none) A\<close>
  by (fact Option.these_eq)

lemma [code]:
  \<open>Option.image_filter f A = Option.these (image f A)\<close>
  by (fact Option.image_filter_eq)

lemma [code]:
  \<open>Set.can_select P A = is_singleton (Set.filter P A)\<close>
  by (fact Set.can_select_iff_is_singleton)

declare [[code drop:
  \<open>Inf :: _ \<Rightarrow> 'a set\<close>
  \<open>Sup :: _ \<Rightarrow> 'a set\<close>
  \<open>Inf :: _ \<Rightarrow> 'a Predicate.pred\<close>
  \<open>Sup :: _ \<Rightarrow> 'a Predicate.pred\<close>
  pred_of_set
  Wellfounded.acc
]]

hide_const (open) RBT_Set.Set RBT_Set.Coset

end

quality98%

¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.16Bemerkung: ¤

*Bot Zugriff

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.