chapter \<open>Basic category theory\<close>
theory Categories
imports Objects
begin

text \<open>
  The soft type of categories is parametrized over the Grothendieck universe in
  which the objects and morphisms live. This allows us to work easily with large
  categories.
\<close>

section \<open>Categories\<close>

text \<open>
  Structure types are easily implemented as set-theoretic function soft types.
  This will be more automated and have dedicated syntax in later iterations. In
  particular, we need more dependent soft type elaboration.
\<close>

abbreviation "obj \<C> \<equiv> \<C> @@ obj"
abbreviation hom ("hom\<^bsub>_\<^esub>") where "hom\<^bsub>\<C>\<^esub> A B \<equiv> \<C> @@ hom `A `B"
abbreviation id ("(id\<^bsub>_\<^esub>)") where "id\<^bsub>\<C>\<^esub> A \<equiv> \<C> @@ id `A"
abbreviation comp ("comp\<^bsub>_, _, _, _\<^esub>")
  where "comp\<^bsub>\<C>, A, B, C\<^esub> g f \<equiv> \<C> @@comp `A `B `C `g `f"

definition [typeclass]: "Category' U \<equiv>
  type (\<lambda>\<C>.
    obj \<C> : non-empty \<sqdot> Subset U \<and>

    \<C> @@ hom: obj \<C> \<rightarrow> obj \<C> \<rightarrow> U \<and>

    \<C> @@ comp \<in> \<Prod>A B C\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> B C \<rightarrow> hom\<^bsub>\<C>\<^esub> A B \<rightarrow> hom\<^bsub>\<C>\<^esub> A C) \<and>

    \<C> @@ id \<in> \<Prod>A\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> A A) \<and>

    (\<forall>A B \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B.
      (comp\<^bsub>\<C>,A,B,B\<^esub> (id\<^bsub>\<C>\<^esub> B) f = f) \<and> (comp\<^bsub>\<C>,A,A,B\<^esub> f (id\<^bsub>\<C>\<^esub> A) = f)) \<and>

    (\<forall>A B C D \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B. \<forall>g \<in> hom\<^bsub>\<C>\<^esub> B C. \<forall>h \<in> hom\<^bsub>\<C>\<^esub> C D.
      comp\<^bsub>\<C>,A,B,D\<^esub> (comp\<^bsub>\<C>,B,C,D\<^esub> h g) f =
        comp\<^bsub>\<C>,A,C,D\<^esub> h (comp\<^bsub>\<C>,A,B,C\<^esub> g f))
  )"

definition [typedef]: "Category = Category' V"

definition [typedef]: "Small_Category = Category \<bar> type (\<lambda>\<C>. obj \<C> \<in> V)"

text \<open>
  The following typeclass introduction and elimination rules should be
  automatically generated.
\<close>

lemma Category'I:
  assumes
    "obj \<C> : non-empty \<sqdot> Subset U"

    "\<C> @@ hom: obj \<C> \<rightarrow> obj \<C> \<rightarrow> U"

    "\<C> @@ comp \<in> \<Prod>A B C\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> B C \<rightarrow> hom\<^bsub>\<C>\<^esub> A B \<rightarrow> hom\<^bsub>\<C>\<^esub> A C)"

    "\<C> @@ id \<in> \<Prod>A\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> A A)"

    "\<And>A B f. \<lbrakk>A \<in> obj \<C>; B \<in> obj \<C>; f \<in> hom\<^bsub>\<C>\<^esub> A B\<rbrakk>
      \<Longrightarrow> comp\<^bsub>\<C>,A,B,B\<^esub> (id\<^bsub>\<C>\<^esub> B) f = f"

    "\<And>A B f. \<lbrakk>A \<in> obj \<C>; B \<in> obj \<C>; f \<in> hom\<^bsub>\<C>\<^esub> A B\<rbrakk>
      \<Longrightarrow> comp\<^bsub>\<C>,A,A,B\<^esub> f (id\<^bsub>\<C>\<^esub> A) = f"

    "\<And>A B C D f g h.
      \<lbrakk> A \<in> obj \<C>; B \<in> obj \<C>; C \<in> obj \<C>; D \<in> obj \<C>;
        h \<in> hom\<^bsub>\<C>\<^esub> C D; g \<in> hom\<^bsub>\<C>\<^esub> B C; f \<in> hom\<^bsub>\<C>\<^esub> A B \<rbrakk>
      \<Longrightarrow> comp\<^bsub>\<C>,A,B,D\<^esub> (comp\<^bsub>\<C>,B,C,D\<^esub> h g) f =
            comp\<^bsub>\<C>,A,C,D\<^esub> h (comp\<^bsub>\<C>,A,B,C\<^esub> g f)"
  shows
    "\<C>: Category' U"
  unfolding Category'_def
  by (intro has_typeI, (rule, rule assms)+) (fast intro: assms)+

lemma Category'D:
  shows
    "\<C> : Category' U \<Longrightarrow> obj \<C> : non-empty \<sqdot> Subset U"
  and
    "\<C>: Category' U \<Longrightarrow> \<C> @@ hom: obj \<C> \<rightarrow> obj \<C> \<rightarrow> U"
  and
    "\<C>: Category' U \<Longrightarrow>
      \<C> @@ comp \<in> \<Prod>A B C\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> B C \<rightarrow> hom\<^bsub>\<C>\<^esub> A B \<rightarrow> hom\<^bsub>\<C>\<^esub> A C)"
  and
    "\<C>: Category' U \<Longrightarrow> \<C> @@ id \<in> \<Prod>A\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> A A)"
  and
    "\<C>: Category' U \<Longrightarrow> \<forall>A B \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B.
      (comp\<^bsub>\<C>,A,B,B\<^esub> (id\<^bsub>\<C>\<^esub> B) f = f) \<and> (comp\<^bsub>\<C>,A,A,B\<^esub> f (id\<^bsub>\<C>\<^esub> A) = f)"
  and
    "\<C>: Category' U \<Longrightarrow>
      \<forall>A B C D \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B. \<forall>g \<in> hom\<^bsub>\<C>\<^esub> B C. \<forall>h \<in> hom\<^bsub>\<C>\<^esub> C D.
        comp\<^bsub>\<C>,A,B,D\<^esub> (comp\<^bsub>\<C>,B,C,D\<^esub> h g) f =
          comp\<^bsub>\<C>,A,C,D\<^esub> h (comp\<^bsub>\<C>,A,B,C\<^esub> g f)"
  unfolding Category'_def by (drule_tac [1-6] has_typeD) fast+

lemmas CategoryI = Category'I[where ?U=V, folded Category_def]
lemmas CategoryD = Category'D[where ?U=V, folded Category_def]

section \<open>Typing rules\<close>

lemma [type]:
  "obj: Category' U \<Rightarrow> non-empty \<sqdot> Subset U"
  by (rule type_intro) (fact Category'D(1))

lemma [type]:
  "hom: (\<C>: Category' U) \<Rightarrow> Element (obj \<C>) \<Rightarrow> Element (obj \<C>) \<Rightarrow> Element U"
  by (rule type_intro) (auto dest: Category'D(2))

lemma [type]:
  "comp: (\<C>: Category' U) \<Rightarrow>
    (A: Element (obj \<C>)) \<Rightarrow> (B: Element (obj \<C>)) \<Rightarrow> (C: Element (obj \<C>)) \<Rightarrow>
    Element (hom\<^bsub>\<C>\<^esub> B C) \<Rightarrow> Element (hom\<^bsub>\<C>\<^esub> A B) \<Rightarrow> Element (hom\<^bsub>\<C>\<^esub> A C)"
  by (rule type_intro, drule Category'D(3), unfold_types) (rule FunctionE)+
  (*Don't want to have to write "rule FunctionE" all the time!*)

lemma [type]:
  "id: (\<C>: Category' U) \<Rightarrow> (A: Element (obj \<C>)) \<Rightarrow> Element (hom\<^bsub>\<C>\<^esub> A A)"
  by (rule type_intro, drule Category'D(4)) discharge_types

section \<open>The category of sets\<close>

abbreviation (input) "Set_obj  \<equiv> V"
abbreviation (input) "Set_hom  \<equiv> \<lambda>A B \<in> V. A \<rightarrow> B"
abbreviation (input) "Set_id   \<equiv> \<lambda>A \<in> V. \<lambda>x \<in> A. x"
abbreviation (input) "Set_comp \<equiv> \<lambda>A B C \<in> V. \<lambda>g \<in> B \<rightarrow> C. \<lambda>f \<in> A \<rightarrow> B. (g \<circ> f)"

definition Set_cat ("\<S>et") where
  "\<S>et = object {
    \<langle>@obj, Set_obj\<rangle>,
    \<langle>@hom, Set_hom\<rangle>,
    \<langle>@comp, Set_comp\<rangle>,
    \<langle>@id, Set_id\<rangle>
  }"

(*These should be generated theorems*)

\<comment> \<open>TODO Kevin: How come id_type needs to be inserted here?\<close>
lemma Set_cat_type [type]: "\<S>et: Category"
  by (rule type_intro, insert id_type, unfold_types) auto

section \<open>Functors and natural transformations\<close>

abbreviation obj_map ("_\<^bsub>obj\<^esub>")
  where "\<F>\<^bsub>obj\<^esub> A \<equiv> \<F> @@ obj_map `A"

abbreviation hom_map ("_\<^bsub>hom _ _\<^esub>") where
  "\<F>\<^bsub>hom A B\<^esub> f \<equiv> \<F> @@ hom_map `A `B `f"

(*Future work: auto-elaboration would make definitions like these more convenient:*)
definition "Functor \<C> \<D> \<equiv>
  type (\<lambda>\<F>.
    \<F> @@ obj_map \<in> obj \<C> \<rightarrow> obj \<D> \<and>

    \<F> @@ hom_map \<in>
      \<Prod>A B\<in> obj \<C>. (hom\<^bsub>\<C>\<^esub> A B \<rightarrow> hom\<^bsub>\<D>\<^esub> (\<F>\<^bsub>obj\<^esub> A) (\<F>\<^bsub>obj\<^esub> B)) \<and>

    (\<forall>A \<in> obj \<C>. (\<F>\<^bsub>hom A A\<^esub> (id\<^bsub>\<C>\<^esub> A)) = id\<^bsub>\<D>\<^esub> (\<F>\<^bsub>obj\<^esub> A)) \<and>

    (\<forall>A B C \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B. \<forall>g \<in> hom\<^bsub>\<C>\<^esub> B C.
      (\<F>\<^bsub>hom (\<F>\<^bsub>obj\<^esub> A) (\<F>\<^bsub>obj\<^esub> C)\<^esub> (comp\<^bsub>\<C>,A,B,C\<^esub> g f)) =
        comp\<^bsub>\<D>,(\<F>\<^bsub>obj\<^esub> A),(\<F>\<^bsub>obj\<^esub> B),(\<F>\<^bsub>obj\<^esub> C)\<^esub> (\<F>\<^bsub>hom B C\<^esub> g) (\<F>\<^bsub>hom A B\<^esub> f))
  )"

definition "Nat_Trans \<C> \<D> \<F> \<G> \<equiv>
  type (\<lambda>\<eta>.
    \<F>: Functor \<C> \<D> \<and>
    \<G>: Functor \<C> \<D> \<and>

    \<eta> \<in> \<Prod>A\<in> obj \<C>. (hom\<^bsub>\<D>\<^esub> (\<F>\<^bsub>obj\<^esub>A) (\<G>\<^bsub>obj\<^esub>A)) \<and>

    (\<forall>A B \<in> obj \<C>. \<forall>f \<in> hom\<^bsub>\<C>\<^esub> A B.
      comp\<^bsub>\<D>, \<F>\<^bsub>obj\<^esub>A, \<G>\<^bsub>obj\<^esub>A, \<G>\<^bsub>obj\<^esub>B\<^esub>
        (\<G>\<^bsub>hom (\<G>\<^bsub>obj\<^esub>A) (\<G>\<^bsub>obj\<^esub>B)\<^esub> f)
        (\<eta> `A) =
      comp\<^bsub>\<D>, \<F>\<^bsub>obj\<^esub>A, \<F>\<^bsub>obj\<^esub>B, \<G>\<^bsub>obj\<^esub>B\<^esub>
        (\<eta> `B)
        (\<F>\<^bsub>hom (\<F>\<^bsub>obj\<^esub>A) (\<F>\<^bsub>obj\<^esub>B)\<^esub> f))
  )" \<comment>\<open>This last condition is the commutative square \<open>\<G>f \<circ> \<eta>\<^sub>A = \<eta>\<^sub>B \<circ> \<F>f\<close>\<close>

section \<open>Constructions on categories\<close>

subsection \<open>Product categories\<close>

definition "Product_Cat_obj \<C> \<D> \<equiv> obj \<C> \<times> obj \<D>"

definition "Product_Cat_hom \<C> \<D> \<equiv>
  \<lambda>\<langle>C1, D1\<rangle> \<langle>C2, D2\<rangle>\<in> obj \<C> \<times> obj \<D>. (hom\<^bsub>\<C>\<^esub> C1 C2 \<times> hom\<^bsub>\<D>\<^esub> D1 D2)"

definition "Product_Cat_id \<C> \<D> \<equiv>
  \<lambda>\<langle>C, D\<rangle>\<in> obj \<C> \<times> obj \<D>. \<langle>id\<^bsub>\<C>\<^esub> C, id\<^bsub>\<D>\<^esub> D\<rangle>"

definition "Product_Cat_comp \<C> \<D> \<equiv>
  \<lambda>\<langle>C1, D1\<rangle> \<langle>C2, D2\<rangle> \<langle>C3, D3\<rangle>\<in> Product_Cat_obj \<C> \<D>.
    \<lambda>\<langle>f2, g2\<rangle>\<in> hom\<^bsub>\<C>\<^esub> C2 C3 \<times> hom\<^bsub>\<D>\<^esub> D2 D3.
    \<lambda>\<langle>f1, g1\<rangle>\<in> hom\<^bsub>\<C>\<^esub> C1 C2 \<times> hom\<^bsub>\<D>\<^esub> D1 D2.
      \<langle>comp\<^bsub>\<C>,C1,C2,C3\<^esub> f2 f1, comp\<^bsub>\<D>,D1,D2,D3\<^esub> g2 g1\<rangle>"

definition "Product_Cat \<C> \<D> = object {
  \<langle>@obj, Product_Cat_obj \<C> \<D>\<rangle>,
  \<langle>@hom, Product_Cat_hom \<C> \<D>\<rangle>,
  \<langle>@comp, Product_Cat_comp \<C> \<D>\<rangle>,
  \<langle>@id, Product_Cat_id \<C> \<D>\<rangle>}"

lemma Product_Cat_fields [simp]:
  shows Product_Cat_obj: "(Product_Cat \<C> \<D>) @@ obj = Product_Cat_obj \<C> \<D>"
    and Product_Cat_hom: "(Product_Cat \<C> \<D>) @@ hom = Product_Cat_hom \<C> \<D>"
    and Product_Cat_comp: "(Product_Cat \<C> \<D>) @@ comp = Product_Cat_comp \<C> \<D>"
    and Product_Cat_id: "(Product_Cat \<C> \<D>) @@ id = Product_Cat_id \<C> \<D>"
  unfolding Product_Cat_def by simp_all

lemma Product_Cat_type [derive]:
  assumes
    "\<C>: Category' (univ U)"
    "\<D>: Category' (univ U)"
  shows
    "Product_Cat \<C> \<D>: Category' (univ U)"
proof (rule type_intro, simp_all only: Product_Cat_fields)
  show
    "Product_Cat_obj \<C> \<D>: non-empty \<sqdot> subset (univ U)"
    using Category'D(1)[OF assms(1)] Category'D(1)[OF assms(2)]
    by (auto simp: Product_Cat_obj_def)

  show
    "Product_Cat_hom \<C> \<D> \<in>
      Product_Cat_obj \<C> \<D> \<rightarrow> Product_Cat_obj \<C> \<D> \<rightarrow> univ U"
    by (auto simp: Product_Cat_obj_def Product_Cat_hom_def)

  show
    "Product_Cat_comp \<C> \<D> \<in>
      \<Prod>A B C\<in> Product_Cat_obj \<C> \<D>.
        (Product_Cat_hom \<C> \<D> `B `C \<rightarrow>
          Product_Cat_hom \<C> \<D> `A `B \<rightarrow> Product_Cat_hom \<C> \<D> `A `C)"
    unfolding Product_Cat_obj_def Product_Cat_hom_def Product_Cat_comp_def
    by (auto intro!: split_FunctionI simp only: beta_split)

  show
    "Product_Cat_id \<C> \<D> \<in>
      \<Prod>A\<in> Product_Cat_obj \<C> \<D>. (Product_Cat_hom \<C> \<D> `A `A)"
    unfolding Product_Cat_id_def Product_Cat_obj_def Product_Cat_hom_def
    using Category'D(4)[OF assms(1)] Category'D(4)[OF assms(2)]
    by force

  fix A B f assume assms1:
    "A \<in> Product_Cat_obj \<C> \<D>"
    "B \<in> Product_Cat_obj \<C> \<D>"
    "f \<in> Product_Cat_hom \<C> \<D> `A `B"

  show
    "Product_Cat_comp \<C> \<D> `A `B `B `(Product_Cat_id \<C> \<D> `B) `f = f"
    using
      Category'D(5)[OF assms(1)] Category'D(5)[OF assms(2)] assms1
    unfolding
      Product_Cat_obj_def Product_Cat_hom_def Product_Cat_comp_def Product_Cat_id_def
    by (fastforce simp only: beta_split)

  show
    "Product_Cat_comp \<C> \<D> `A `A `B `f `(Product_Cat_id \<C> \<D> `A) = f"
    using
      Category'D(5)[OF assms(1)] Category'D(5)[OF assms(2)] assms1
    unfolding
      Product_Cat_obj_def Product_Cat_hom_def Product_Cat_comp_def Product_Cat_id_def
    by (fastforce simp only: beta_split)

  fix C D h g assume assms2:
    "C \<in> Product_Cat_obj \<C> \<D>"
    "D \<in> Product_Cat_obj \<C> \<D>"
    "h \<in> Product_Cat_hom \<C> \<D> `C `D"
    "g \<in> Product_Cat_hom \<C> \<D> `B `C"

  show
    "Product_Cat_comp \<C> \<D> `A `B `D `(Product_Cat_comp \<C> \<D> `B `C `D `h `g) `f =
       Product_Cat_comp \<C> \<D> `A `C `D `h `(Product_Cat_comp \<C> \<D> `A `B `C `g `f)"
    using
      Category'D(6)[OF assms(1), rule_format]
      Category'D(6)[OF assms(2), rule_format]
      assms1 assms2
    unfolding
      Product_Cat_obj_def Product_Cat_hom_def Product_Cat_comp_def Product_Cat_id_def
    by (auto simp only: beta_split)
qed

end


(*by Ammer*)
theory VEBT_Uniqueness imports VEBT_InsertCorrectness VEBT_Succ VEBT_Pred VEBT_DeleteCorrectness
begin

context VEBT_internal begin

section \<open>Uniqueness Property of valid Trees\<close>
text \<open>Two valid van Emde Boas trees having equal degree number and representing the same integer set are equal.\<close>

theorem uniquetree: "invar_vebt t n \<Longrightarrow> invar_vebt s n \<Longrightarrow> set_vebt' t = set_vebt' s \<Longrightarrow> s = t"
proof(induction t n arbitrary: s rule: invar_vebt.induct)
  case (1 a b)
  then show ?case
    apply(cases "vebt_member t 0")
     apply(cases "vebt_member t 1")
      apply(cases "vebt_member t 1")
       apply (smt (z3) "1.prems"(1) "1.prems"(2) VEBT_Member.vebt_member.simps(1) One_nat_def deg_1_Leafy deg_not_0 less_not_refl mem_Collect_eq set_vebt'_def) +
    done
next
  case (2 treeList n summary m deg)
  from 2(9) obtain treeList' summary' where sprop:"s = Node None deg treeList' summary' \<and> deg = n+m
                \<and> length treeList' =2^m \<and> invar_vebt summary' m \<and> (\<forall> t \<in> set treeList'. invar_vebt t n) \<and>
               (\<nexists>i. both_member_options summary' i)"
    apply(cases)
    using "2.hyps"(3) "2.hyps"(4) one_is_add apply force
    apply (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2)
    apply (metis "2.hyps"(3) "2.hyps"(4) One_nat_def add_self_div_2 div_greater_zero_iff even_Suc_div_two not_numeral_le_zero odd_add order.not_eq_order_implies_strict plus_1_eq_Suc zero_le_one zero_neq_one)
    apply (metis "2.prems"(1) "2.prems"(2) VEBT_Member.vebt_member.simps(2) Suc_1 add_leD1 add_self_div_2 both_member_options_def deg_not_0 div_greater_zero_iff empty_Collect_eq membermima.simps(4) nat_le_iff_add plus_1_eq_Suc set_vebt'_def valid_member_both_member_options)
    apply (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2 div2_Suc_Suc even_Suc_div_two odd_add one_is_add plus_1_eq_Suc zero_neq_one)
    done
  from 2(9) have aa:"\<forall> t \<in> set treeList'. invar_vebt t n"   using sprop by simp
  have ac:"deg \<ge> 2"
    by (metis "2.hyps"(3) add_self_div_2 deg_not_0 div_greater_zero_iff sprop)
  hence ab:"\<forall> t \<in> set treeList. set_vebt' t = {}"
    by (metis "2.hyps"(6) empty_Collect_eq min_Null_member not_min_Null_member set_vebt'_def)
  hence ac:"length treeList' =length treeList"
    by (simp add: "2.hyps"(2) sprop)
  hence membercongy:"i < 2^m \<Longrightarrow> vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x" for i x
  proof-
    assume "i < 2^m"
    show "vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x"
    proof
      show "vebt_member (treeList ! i) x \<Longrightarrow> vebt_member (treeList' ! i) x"
        by (metis "2.hyps"(6) \<open>i < 2 ^ m\<close> ac min_Null_member not_min_Null_member nth_mem sprop)
      show "vebt_member (treeList' ! i) x \<Longrightarrow> vebt_member (treeList ! i) x"
      proof-
        assume "vebt_member (treeList' ! i) x"
        hence "both_member_options (treeList' ! i) x"
          by (metis \<open>i < 2 ^ m\<close> both_member_options_equiv_member nth_mem sprop)
        hence "membermima (treeList' ! i) x \<or> naive_member (treeList' ! i) x" unfolding both_member_options_def by auto
        moreover have "membermima (treeList' ! i) x \<Longrightarrow> membermima s (2^m*i+x)"
          using membermima.simps(5)[of "deg-1" treeList' summary' "(2^m*i+x)"] sprop ac
          apply auto
          apply (metis One_nat_def Suc_diff_1 \<open>membermima (Node None (Suc (deg - 1)) treeList' summary') (2 ^ m * i + x) = (let pos = high (2 ^ m * i + x) (Suc (deg - 1) div 2) in if pos < length treeList' then membermima (treeList' ! pos) (low (2 ^ m * i + x) (Suc (deg - 1) div 2)) else False)\<close> add.commute deg_not_0 neq0_conv not_add_less1)
          by (smt (z3) "2.hyps"(3) Nat.add_0_right Suc_pred \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> add_gr_0 add_self_div_2 deg_not_0 div_less div_mult_self4 high_def low_inv member_bound mult.commute nth_mem power_not_zero zero_neq_numeral)
        moreover have "naive_member (treeList' ! i) x \<Longrightarrow> naive_member s (2^m*i+x)"
          using naive_member.simps(3)[of None "deg-1" treeList' summary' "(2^m*i+x)" ] sprop ac
          apply auto
          apply (metis One_nat_def Suc_pred' \<open>naive_member (Node None (Suc (deg - 1)) treeList' summary') (2 ^ m * i + x) = (let pos = high (2 ^ m * i + x) (Suc (deg - 1) div 2) in if pos < length treeList' then naive_member (treeList' ! pos) (low (2 ^ m * i + x) (Suc (deg - 1) div 2)) else False)\<close> add_gr_0 deg_not_0)
          by (smt (z3) "2.hyps"(3) Nat.add_0_right Suc_pred \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> add_gr_0 add_self_div_2 deg_not_0 div_less div_mult_self4 high_def low_inv member_bound mult.commute nth_mem power_not_zero zero_neq_numeral)
        ultimately have "both_member_options s (2^m*i +x)" unfolding both_member_options_def by auto
        hence False
          using "2.prems"(1) VEBT_Member.vebt_member.simps(2) sprop valid_member_both_member_options by blast
        then show ?thesis by simp
      qed
    qed
  qed
  hence ad:"i<2^m \<Longrightarrow> set_vebt' (treeList' ! i ) = {}" for i
  proof-
    assume assm:"i < 2^m"
    show "set_vebt' (treeList' ! i ) = {}"
    proof(rule ccontr)
      assume "set_vebt' (treeList' ! i ) \<noteq> {}"
      then obtain y where "vebt_member (treeList' ! i) y"
        using set_vebt'_def by fastforce
      thus False
        using ab ac assm membercongy sprop set_vebt'_def by force
    qed
  qed
  hence ae:"i< 2^m \<Longrightarrow> treeList' ! i = treeList ! i"  for i
    by (simp add: "2.IH"(1) "2.hyps"(2) ab sprop)
  then show ?case
    by (metis "2.IH"(2) "2.hyps"(1) "2.hyps"(5) ac both_member_options_equiv_member empty_Collect_eq list_eq_iff_nth_eq sprop set_vebt'_def)
next
  case (3 treeList n summary m deg)
  from 3(9) obtain treeList' summary' where sprop:"s = Node None deg treeList' summary' \<and> deg = n+m
                        \<and> length treeList' =2^m \<and> invar_vebt summary' m \<and> (\<forall> t \<in> set treeList'. invar_vebt t n) \<and>
                       (\<nexists>i. both_member_options summary' i)"
    apply(cases)
    apply (metis "3.IH"(1) "3.hyps"(2) "3.hyps"(3) "3.hyps"(4) One_nat_def Suc_1 not_one_le_zero one_is_add set_n_deg_not_0 zero_neq_numeral)
    apply (metis "3.hyps"(3) "3.hyps"(4) add_self_div_2 div2_Suc_Suc even_Suc_div_two odd_add plus_1_eq_Suc)
    apply (metis "3.hyps"(3) "3.hyps"(4) Suc_inject add_Suc_right add_self_div_2)
    apply (metis "3.hyps"(3) "3.hyps"(4) add_Suc_right add_self_div_2 even_Suc_div_two le_add2 le_less_Suc_eq odd_add order.strict_iff_order plus_1_eq_Suc)
    apply (metis "3.prems"(1) "3.prems"(2) VEBT_Member.vebt_member.simps(2) Suc_pred' both_member_options_def deg_not_0 mem_Collect_eq membermima.simps(4) set_vebt'_def valid_member_both_member_options)
    done
  have ac:"deg \<ge> 2"
    by (metis "3.hyps"(3) One_nat_def add_le_mono le_add1 numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0 sprop)
  hence ab:"\<forall> t \<in> set treeList. set_vebt' t = {}"
    by (metis "3.hyps"(6) empty_Collect_eq min_Null_member not_min_Null_member set_vebt'_def)
  hence ac:"length treeList' =length treeList"
    by (simp add: "3.hyps"(2) sprop)
  hence membercongy:"i < 2^m \<Longrightarrow> vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x" for i x
  proof-
    assume "i < 2^m"
    show "vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x"
    proof
      show "vebt_member (treeList ! i) x \<Longrightarrow> vebt_member (treeList' ! i) x"
        by (metis "3.hyps"(6) \<open>i < 2 ^ m\<close> ac min_Null_member not_min_Null_member nth_mem sprop)
      show "vebt_member (treeList' ! i) x \<Longrightarrow> vebt_member (treeList ! i) x"
      proof-
        assume "vebt_member (treeList' ! i) x"
        hence "both_member_options (treeList' ! i) x"
          by (metis \<open>i < 2 ^ m\<close> both_member_options_equiv_member nth_mem sprop)
        hence "membermima (treeList' ! i) x \<or> naive_member (treeList' ! i) x"
          unfolding both_member_options_def by auto
        moreover have "membermima (treeList' ! i) x \<Longrightarrow> membermima s (2^n*i+x)"
          using membermima.simps(5)[of "deg-1" treeList' summary' "(2^n*i+x)"] sprop ac
          by (smt (z3) "3.hyps"(3) "3.prems"(1) Nat.add_diff_assoc Suc_pred \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> add_diff_cancel_left' add_self_div_2 deg_not_0 even_Suc high_inv le_add1 low_inv member_bound mult.commute mult_2 nth_mem odd_two_times_div_two_nat plus_1_eq_Suc)
        moreover have "naive_member (treeList' ! i) x \<Longrightarrow> naive_member s (2^n*i+x)"
          using naive_member.simps(3)[of None "deg-1" treeList' summary' "(2^n*i+x)" ] sprop ac
          by (smt (z3) "3.hyps"(3) "3.prems"(1) Nat.add_0_right Nat.add_diff_assoc Suc_pred \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> add_self_div_2 deg_not_0 div_less div_mult_self4 even_Suc_div_two high_def le_add1 low_inv member_bound mult.commute nth_mem odd_add plus_1_eq_Suc power_not_zero zero_neq_numeral)
        ultimately have "both_member_options s (2^n*i +x)" unfolding both_member_options_def
          by auto
        hence False
          using "3.prems"(1) VEBT_Member.vebt_member.simps(2) sprop valid_member_both_member_options
          by blast
        then show ?thesis by simp
      qed
    qed
  qed
  hence ad:"i<2^m \<Longrightarrow> set_vebt' (treeList' ! i ) = {}" for i
  proof-
    assume assm:"i < 2^m"
    show "set_vebt' (treeList' ! i ) = {}"
    proof(rule ccontr)
      assume "set_vebt' (treeList' ! i ) \<noteq> {}"
      then obtain y where "vebt_member (treeList' ! i) y"
        using set_vebt'_def by fastforce
      thus False
        using ab ac assm membercongy sprop set_vebt'_def by force
    qed
  qed
  hence ae:"i< 2^m \<Longrightarrow> treeList' ! i = treeList ! i"  for i
    by (simp add: "3.IH"(1) "3.hyps"(2) ab sprop)
  then show ?case
    by (metis "3.IH"(2) "3.hyps"(1) "3.hyps"(5) Collect_empty_eq ac both_member_options_equiv_member list_eq_iff_nth_eq sprop set_vebt'_def)
next
  case (4 treeList n summary m deg mi ma)
  note case4= this
  hence "set_vebt' (Node (Some (mi, ma)) deg treeList summary) = set_vebt' s" by simp
  hence a0:"deg \<ge> 2" using 4
    by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
  hence aa:"{mi, ma} \<subseteq> set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
    apply auto using vebt_member.simps(5)[of mi ma "deg -2" treeList summary mi]
    apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
    using vebt_member.simps(5)[of mi ma "deg -2" treeList summary ma]
    apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
    done
  from 4(12) obtain treeList' summary' info where sprop1:"s = Node info deg treeList' summary' \<and> deg = n+m
                       \<and> length treeList' =2^m \<and> invar_vebt summary' m \<and> (\<forall> t \<in> set treeList'. invar_vebt t n) "
    apply cases
    using "4.hyps"(3) "4.hyps"(4) one_is_add apply force
    apply (metis "4.hyps"(3) "4.hyps"(4) add_self_div_2)
    apply (metis "4.hyps"(3) "4.hyps"(4) even_Suc odd_add)
    apply (metis "4.hyps"(3) "4.hyps"(4) add_self_div_2)
    apply (metis "4.hyps"(3) "4.hyps"(4) even_Suc odd_add)
    done
  have  ac:"invar_vebt t h \<Longrightarrow> invar_vebt k h \<Longrightarrow> set_vebt' t = set_vebt' k \<Longrightarrow> vebt_mint t = vebt_mint k" for t k h
  proof-
    assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
    have "\<not> vebt_mint t = vebt_mint k \<Longrightarrow> False"
    proof-
      assume "vebt_mint t \<noteq> vebt_mint k"
      then obtain a b where abdef:"vebt_mint t = None \<and> vebt_mint k = Some b \<or>
                            vebt_mint t = Some a \<and> vebt_mint k = None \<or>
                            a < b \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k \<or>
                            b < a \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k"
        by (metis linorder_neqE_nat option.exhaust)
      show False
        apply(cases "vebt_mint t = None \<and> vebt_mint k = Some b")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        apply(cases "   vebt_mint t = Some a \<and> vebt_mint k = None")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        apply (cases "a < b \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> abdef assms(1) assms(2) assms(3) mint_corr mint_sound)
        done
    qed
    thus "vebt_mint t = vebt_mint k" by auto
  qed
  have  ad:"invar_vebt t h \<Longrightarrow> invar_vebt k h \<Longrightarrow> set_vebt' t = set_vebt' k \<Longrightarrow> vebt_maxt t = vebt_maxt k" for t k h
  proof-
    assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
    have "\<not> vebt_maxt t = vebt_maxt k \<Longrightarrow> False"
    proof-
      assume "vebt_maxt t \<noteq> vebt_maxt k"
      then obtain a b where abdef:"vebt_maxt t = None \<and> vebt_maxt k = Some b \<or>
                            vebt_maxt t = Some a \<and> vebt_maxt k = None \<or>
                            a < b \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k \<or>
                            b < a \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k"
        by (metis linorder_neqE_nat option.exhaust)
      show False apply(cases "vebt_maxt t = None \<and> vebt_maxt k = Some b")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        apply(cases "   vebt_maxt t = Some a \<and> vebt_maxt k = None")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        apply (cases "a < b \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        by (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> abdef assms(1) assms(2) assms(3) maxt_corr maxt_sound)
    qed
    thus "vebt_maxt t = vebt_maxt k" by auto
  qed
  have infsplit: "info = Some (mi ,ma)" using 4(12)
  proof cases
    case (1 a b)
    then show ?thesis
      using sprop1 by blast
  next
    case (2 treeList n summary m)
    then show ?thesis
      by (metis "4.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
  next
    case (3 treeList n summary m)
    then show ?thesis
      by (metis "4.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
  next
    case (4 treeList' n' summary' m' mi' ma')
    have "vebt_mint s = Some mi'"
      by (simp add: "4"(1))
    hence "mi' = mi"
      by (smt (verit, ccfv_threshold) "4.hyps"(7) "4.prems"(1) "4.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
    have "vebt_maxt s = Some ma'"
      by (simp add: "4"(1))
    hence "ma' < ma \<Longrightarrow> ma\<notin> set_vebt' s"
      by (meson "4.prems"(1) leD max_in_set_def maxt_corr)
    moreover have "ma < ma' \<Longrightarrow> ma' \<notin> set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
      by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
    ultimately have "ma'=ma"
      by (metis \<open>vebt_maxt s = Some ma'\<close> aa case4(12) case4(13) insert_subset max_in_set_def maxt_corr not_less_iff_gr_or_eq)
    then show ?thesis
      using "4"(1) \<open>mi' = mi\<close> sprop1 by force
  next
    case (5 treeList n summary m mi' ma')
    have "vebt_mint s = Some mi'"
      by (simp add: "5"(1))
    hence "mi' = mi"
      by (smt (verit, ccfv_threshold) "4.hyps"(7) "4.prems"(1) "4.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
    have "vebt_maxt s = Some ma'"
      by (simp add: "5"(1))
    hence "ma' < ma \<Longrightarrow> ma\<notin> set_vebt' s"
      by (meson "4.prems"(1) leD max_in_set_def maxt_corr)
    moreover have "ma < ma' \<Longrightarrow> ma' \<notin> set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
      by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
    ultimately have "ma'=ma"
      by (metis "5"(5) "5"(6) case4(5) case4(6) even_Suc odd_add)
    then show ?thesis
      using "5"(1) \<open>mi' = mi\<close> sprop1 by force
  qed
  from 4(12) have acd:"mi \<noteq> ma \<longrightarrow>
    (\<forall>i<2 ^ m.
        (high ma n = i \<longrightarrow> both_member_options (treeList' ! i) (low ma n)) \<and>
        (\<forall>x. high x n = i \<and> both_member_options (treeList' ! i) (low x n) \<longrightarrow> mi < x \<and> x \<le> ma))"
    apply cases using sprop1 apply simp
    using sprop1 infsplit apply simp
    using sprop1 infsplit apply simp
    apply (metis VEBT.inject(1) add_self_div_2 case4(5) infsplit option.inject prod.inject sprop1)
    by (metis case4(5) case4(6) even_Suc odd_add)
  hence "length treeList' = 2^m"
    using sprop1 by fastforce
  hence aca:"length treeList' =length treeList" using "4.hyps"(2)
    by (simp add: "4.hyps"(2) sprop1)
  from 4(12) have sumtreelistcong: " \<forall>i<2 ^ m. (\<exists>x. both_member_options (treeList' ! i) x) = both_member_options summary' i"
    apply cases
    using a0 apply linarith
    apply (metis VEBT.inject(1) nth_mem sprop1)
    using infsplit sprop1 apply force
    apply (metis VEBT.inject(1) sprop1)
    using sprop1 by auto
  hence membercongy:"i < 2^m \<Longrightarrow> vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x" for i x
  proof-
    assume "i < 2^m"
    show "vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x"
    proof
      show "vebt_member (treeList ! i) x \<Longrightarrow> vebt_member (treeList' ! i) x"
      proof-
        assume "vebt_member (treeList ! i) x"
        hence aaa:"both_member_options (treeList ! i) x"
          by (metis \<open>i < 2 ^ m\<close> both_member_options_equiv_member case4(1) case4(4) nth_mem)
        have "x < 2^n"
          by (metis \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList ! i) x\<close> case4(1) case4(4) member_bound nth_mem)
        hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)"
          using both_member_options_from_chilf_to_complete_tree
            [of " (2^n*i+x)" deg treeList mi ma summary] aaa high_inv[of x n i]
          by (smt (z3) VEBT_Member.vebt_member.simps(5) Suc_diff_Suc Suc_leD \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList ! i) x\<close> a0 add_self_div_2 case4(11) case4(4) case4(5) case4(8) le_add_diff_inverse le_less_Suc_eq le_neq_implies_less low_inv mult.commute nat_1_add_1 not_less_iff_gr_or_eq nth_mem plus_1_eq_Suc sprop1)
        have "mi <  (2^n*i+x) \<and>  (2^n*i+x) \<le> ma" using vebt_mint.simps(3)[of mi ma deg treeList summary]
          by (metis \<open>i < 2 ^ m\<close> \<open>x < 2 ^ n\<close> aaa case4(11) case4(4) case4(8) high_inv low_inv mult.commute nth_mem)
        moreover have "both_member_options s (2^m*i +x)"
          using \<open>vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)\<close> both_member_options_equiv_member case4(12) case4(13) case4(5) set_vebt'_def by auto
        hence "both_member_options (treeList' ! i) x"
          by (smt (z3) \<open>i < 2 ^ m\<close>  acd \<open>x < 2 ^ n\<close> a0 add_leD1 add_self_div_2 both_member_options_from_complete_tree_to_child calculation case4(5) high_inv infsplit low_inv mult.commute nat_neq_iff numeral_2_eq_2 plus_1_eq_Suc sprop1)
        then show ?thesis
          by (metis \<open>i < 2 ^ m\<close> nth_mem sprop1 valid_member_both_member_options)
      qed
      show "vebt_member (treeList' ! i) x \<Longrightarrow> vebt_member (treeList ! i) x"
      proof-
        assume "vebt_member (treeList' ! i) x"
        hence "vebt_member s (2^n*i +x)" using sprop1 both_member_options_from_chilf_to_complete_tree
            [of "(2^n*i +x)" deg treeList' mi ma summary']
          by (smt (z3) Nat.add_0_right \<open>i < 2 ^ m\<close> a0 add_leD1 add_self_div_2 both_member_options_equiv_member case4(12) case4(5) div_less div_mult_self4 high_def infsplit low_inv member_bound mult.commute nat_1_add_1 nth_mem power_not_zero zero_neq_numeral)
        hence "mi < (2^n*i +x) \<and> (2^n*i +x) \<le> ma "
          using vebt_mint.simps(3)[of mi ma deg treeList' summary'] vebt_maxt.simps(3)[of mi ma deg treeList' summary']
          by (metis \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> acd both_member_options_equiv_member case4(12) high_inv infsplit low_inv member_bound mi_eq_ma_no_ch mult.commute nth_mem sprop1)
        moreover have "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^m*i +x)"
          by (metis \<open>vebt_member s (2 ^ n * i + x)\<close> add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree calculation case4(1) case4(13) case4(5) maxbmo vebt_maxt.simps(3) mem_Collect_eq member_inv nat_neq_iff nth_mem one_add_one set_vebt'_def)
        hence "both_member_options (treeList ! i) x"
          using both_member_options_from_complete_tree_to_child[of deg mi ma treeList summary "(2^n*i +x)"]
          by (smt (z3) Nat.add_0_right Suc_leD \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> a0 add_self_div_2 calculation case4(11) case4(5) div_less div_mult_self4 high_def low_inv member_bound mult.commute nat_1_add_1 nat_neq_iff nth_mem plus_1_eq_Suc power_not_zero sprop1 zero_neq_numeral)
        then show ?thesis
          by (metis \<open>i < 2 ^ m\<close> aca case4(1) nth_mem sprop1 valid_member_both_member_options)
      qed
    qed
  qed
  hence setcongy: "i < 2^m \<Longrightarrow> set_vebt' (treeList ! i) = set_vebt' (treeList' ! i)" for i unfolding set_vebt'_def by presburger
  hence treecongy: "i < 2^m \<Longrightarrow> treeList ! i = treeList' ! i" for i
    by (metis case4(1) case4(4) nth_mem sprop1)
  hence "treeList = treeList'"
    by (metis aca case4(4) nth_equalityI)
  have "vebt_member summary x \<longleftrightarrow> vebt_member summary' x" for x
    by (metis \<open>treeList = treeList'\<close> both_member_options_equiv_member case4(3) case4(7) member_bound sprop1 sumtreelistcong)
  hence "set_vebt' summary = set_vebt' summary'" unfolding set_vebt'_def by auto
  hence "summary = summary'"
    using case4(2) sprop1 by blast
  then show ?case
    using \<open>treeList = treeList'\<close> infsplit sprop1 by fastforce
next
  case (5 treeList n summary m deg mi ma)
  note case4= this
  hence "set_vebt' (Node (Some (mi, ma)) deg treeList summary) = set_vebt' s" by simp
  hence a0:"deg \<ge> 2" using 5
    by (metis Suc_leI add_le_mono diff_Suc_1 less_add_same_cancel1 not_add_less1 not_less_iff_gr_or_eq numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0)
  hence aa:"{mi, ma} \<subseteq> set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
    apply auto using vebt_member.simps(5)[of mi ma "deg -2" treeList summary mi]
    apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
    using vebt_member.simps(5)[of mi ma "deg -2" treeList summary ma]
    apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
    done
  from 5(12) obtain treeList' summary' info where sprop1:"s = Node info deg treeList' summary' \<and> deg = n+m
                  \<and> length treeList' =2^m \<and> invar_vebt summary' m \<and> (\<forall> t \<in> set treeList'. invar_vebt t n) "
    apply cases
    using a0 apply linarith
    apply (metis case4(5) case4(6) even_Suc odd_add add_self_div_2)
    apply (metis Suc_inject add_Suc_right add_self_div_2 case4(5) case4(6))
    apply (metis case4(5) case4(6) even_Suc odd_add)
    apply (metis Suc_inject add_Suc_right add_self_div_2 case4(5) case4(6))
    done
  have  ac:"invar_vebt t h \<Longrightarrow> invar_vebt k h \<Longrightarrow> set_vebt' t = set_vebt' k \<Longrightarrow> vebt_mint t = vebt_mint k" for t k h
  proof-
    assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
    have "\<not> vebt_mint t = vebt_mint k \<Longrightarrow> False"
    proof-
      assume "vebt_mint t \<noteq> vebt_mint k"
      then obtain a b where abdef:"vebt_mint t = None \<and> vebt_mint k = Some b \<or>
                            vebt_mint t = Some a \<and> vebt_mint k = None \<or>
                            a < b \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k \<or>
                            b < a \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k"
        by (metis linorder_neqE_nat option.exhaust)
      show False apply(cases "vebt_mint t = None \<and> vebt_mint k = Some b")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        apply(cases "   vebt_mint t = Some a \<and> vebt_mint k = None")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        apply (cases "a < b \<and> Some a = vebt_mint t \<and> Some b = vebt_mint k")
        apply (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> assms(1) assms(2) assms(3) mint_corr mint_sound)
        by (metis \<open>vebt_mint t \<noteq> vebt_mint k\<close> abdef assms(1) assms(2) assms(3) mint_corr mint_sound)
    qed
    thus "vebt_mint t = vebt_mint k" by auto
  qed
  have  ad:"invar_vebt t h \<Longrightarrow> invar_vebt k h \<Longrightarrow> set_vebt' t = set_vebt' k \<Longrightarrow> vebt_maxt t = vebt_maxt k" for t k h
  proof-
    assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
    have "\<not> vebt_maxt t = vebt_maxt k \<Longrightarrow> False"
    proof-
      assume "vebt_maxt t \<noteq> vebt_maxt k"
      then obtain a b where abdef:"vebt_maxt t = None \<and> vebt_maxt k = Some b \<or>
                            vebt_maxt t = Some a \<and> vebt_maxt k = None \<or>
                            a < b \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k \<or>
                            b < a \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k"
        by (metis linorder_neqE_nat option.exhaust)
      show False
        apply(cases "vebt_maxt t = None \<and> vebt_maxt k = Some b")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        apply(cases "   vebt_maxt t = Some a \<and> vebt_maxt k = None")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        apply (cases "a < b \<and> Some a = vebt_maxt t \<and> Some b = vebt_maxt k")
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        apply (metis \<open>vebt_maxt t \<noteq> vebt_maxt k\<close> abdef assms(1) assms(2) assms(3) maxt_corr maxt_sound)
        done
    qed
    thus "vebt_maxt t = vebt_maxt k" by auto
  qed
  have infsplit: "info = Some (mi ,ma)" using 5(12)
  proof cases
    case (1 a b)
    then show ?thesis
      using sprop1 by blast
  next
    case (2 treeList n summary m)
    then show ?thesis
      by (metis "5.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
  next
    case (3 treeList n summary m)
    then show ?thesis
      by (metis "5.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
  next
    case (4 treeList' n' summary' m' mi' ma')
    have "vebt_mint s = Some mi'"
      by (simp add: "4"(1))
    hence "mi' = mi"
      by (smt (verit, ccfv_threshold) "5.hyps"(7) "5.prems"(1) "5.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
    have "vebt_maxt s = Some ma'"
      by (simp add: "4"(1))
    hence "ma' < ma \<Longrightarrow> ma\<notin> set_vebt' s"
      by (meson "5.prems"(1) leD max_in_set_def maxt_corr)
    moreover have "ma < ma' \<Longrightarrow> ma' \<notin> set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
      by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
    ultimately have "ma'=ma"
      by (metis \<open>vebt_maxt s = Some ma'\<close> aa case4(12) case4(13) insert_subset max_in_set_def maxt_corr not_less_iff_gr_or_eq)
    then show ?thesis
      using "4"(1) \<open>mi' = mi\<close> sprop1 by force
  next
    case (5 treeList' n' summary' m' mi' ma')
    have "vebt_mint s = Some mi'"
      by (simp add: "5"(1))
    hence "mi' = mi"
      by (smt (verit, ccfv_threshold) "5.hyps"(7) "5.prems"(1) "5.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
    have "vebt_maxt s = Some ma'"
      by (simp add: "5"(1))
    hence "ma' < ma \<Longrightarrow> ma\<notin> set_vebt' s"
      by (meson "5.prems"(1) leD max_in_set_def maxt_corr)
    moreover have "ma < ma' \<Longrightarrow> ma' \<notin> set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
      by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
    ultimately have "ma'=ma" using case4(13) 5
      by (metis \<open>vebt_maxt s = Some ma'\<close> aa both_member_options_equiv_member case4(12) insert_subset maxbmo mem_Collect_eq not_less_iff_gr_or_eq set_vebt'_def)
    then show ?thesis
      using "5"(1) \<open>mi' = mi\<close> sprop1 by force
  qed
  from 5(12) have acd:"mi \<noteq> ma \<longrightarrow>
    (\<forall>i<2 ^ m.
        (high ma n = i \<longrightarrow> both_member_options (treeList' ! i) (low ma n)) \<and>
        (\<forall>x. high x n = i \<and> both_member_options (treeList' ! i) (low x n) \<longrightarrow> mi < x \<and> x \<le> ma))"
    apply cases using sprop1 apply simp
    using sprop1 infsplit apply simp
    using sprop1 infsplit apply simp
    apply (metis case4(5) even_Suc odd_add sprop1)
    apply (smt (z3) Suc_inject VEBT.inject(1) add_Suc_right add_self_div_2 case4(5) infsplit option.inject prod.inject sprop1)
    done
  hence "length treeList' = 2^m"
    using sprop1 by fastforce
  hence aca:"length treeList' =length treeList" using "5.hyps"(2)
    by (simp add: "5.hyps"(2) sprop1)
  from 5(12) have sumtreelistcong: " \<forall>i<2 ^ m. (\<exists>x. both_member_options (treeList' ! i) x) = both_member_options summary' i"
    apply cases
    using a0 apply linarith
    apply (metis VEBT.inject(1) nth_mem sprop1)
    using infsplit sprop1 apply force
    apply (metis VEBT.inject(1) sprop1)
    using sprop1 apply auto
    done
  hence membercongy:"i < 2^m \<Longrightarrow> vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x" for i x
  proof-
    assume "i < 2^m"
    show "vebt_member (treeList! i) x \<longleftrightarrow> vebt_member (treeList' ! i) x"
    proof
      show "vebt_member (treeList ! i) x \<Longrightarrow> vebt_member (treeList' ! i) x"
      proof-
        assume "vebt_member (treeList ! i) x"
        hence aaa:"both_member_options (treeList ! i) x"
          by (metis \<open>i < 2 ^ m\<close> both_member_options_equiv_member case4(1) case4(4) nth_mem)
        have "x < 2^n"
          by (metis \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList ! i) x\<close> case4(1) case4(4) member_bound nth_mem)
        hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)"
          using both_member_options_from_chilf_to_complete_tree
            [of " (2^n*i+x)" deg treeList mi ma summary] aaa high_inv[of x n i]
            \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList ! i) x\<close> low_inv[of x n i]
          by (simp add: case4(4) case4(5) mult.commute sprop1)
        hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)" using
            valid_member_both_member_options[of "(Node (Some (mi, ma)) deg treeList summary)" deg "2^n*i+x"]
            invar_vebt.intros(5)[of treeList n summary m deg mi ma]  case4 by fastforce
        hence "mi <  (2^n*i+x) \<and>  (2^n*i+x) \<le> ma" using vebt_mint.simps(3)[of mi ma deg treeList summary]
          by (metis \<open>i < 2 ^ m\<close> \<open>x < 2 ^ n\<close> aaa case4(11) case4(4) case4(8) high_inv low_inv mult.commute nth_mem)
        moreover have "both_member_options s (2^n*i +x)"
          using \<open>vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)\<close> both_member_options_equiv_member case4(12) case4(13) case4(5) set_vebt'_def by auto
        have acffs:"both_member_options (treeList' ! (high ma n)) (low ma n)"
          using acd calculation case4(10) high_bound_aux sprop1 verit_comp_simplify1(3) by blast
        hence "both_member_options (treeList' ! i) x"
          using both_member_options_from_complete_tree_to_child[of deg mi ma treeList' summary' "2^n*i+x"]
            low_inv[of x n i] high_inv[of x n i]
          by (smt (z3) Nat.add_0_right \<open>vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)\<close> \<open>x < 2 ^ n\<close> a0 add_Suc_right add_leD1 both_member_options_equiv_member calculation case4(12) case4(13) case4(5) diff_Suc_1 div_less div_mult_self4 infsplit le_add_diff_inverse2 mem_Collect_eq mult.commute mult_2 nat_1_add_1 nat_neq_iff one_less_numeral_iff semiring_norm(76) sprop1 set_vebt'_def zero_neq_numeral)
        then show "vebt_member (treeList' ! i) x"
          by (metis \<open>i < 2 ^ m\<close> nth_mem sprop1 valid_member_both_member_options)
      qed
      show "vebt_member (treeList' ! i) x \<Longrightarrow> vebt_member (treeList ! i) x"
      proof-
        assume "vebt_member (treeList' ! i) x"
        hence "vebt_member s (2^n*i +x)" using sprop1 both_member_options_from_chilf_to_complete_tree
            [of "(2^n*i +x)" deg treeList' mi ma summary']
          by (smt (z3) Nat.add_0_right Suc_leD \<open>i < 2 ^ m\<close> a0 add_Suc_right both_member_options_equiv_member case4(12) case4(5) diff_Suc_1 div_less div_mult_self4 even_Suc high_def infsplit low_inv member_bound mult.commute mult_2_right nat_1_add_1 nth_mem odd_add odd_two_times_div_two_nat plus_1_eq_Suc power_not_zero zero_neq_numeral)
        hence "mi < (2^n*i +x) \<and> (2^n*i +x) \<le> ma "
          using vebt_mint.simps(3)[of mi ma deg treeList' summary'] vebt_maxt.simps(3)[of mi ma deg treeList' summary']
          by (metis \<open>i < 2 ^ m\<close> \<open>vebt_member (treeList' ! i) x\<close> acd both_member_options_equiv_member case4(12) high_inv infsplit low_inv member_bound mi_eq_ma_no_ch mult.commute nth_mem sprop1)
        moreover have "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*i +x)"
          by (metis \<open>vebt_member s (2 ^ n * i + x)\<close> add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree calculation case4(1) case4(13) case4(5) maxbmo vebt_maxt.simps(3) mem_Collect_eq member_inv nat_neq_iff nth_mem one_add_one set_vebt'_def)
        have "invar_vebt (treeList' ! i) n"
          by (simp add: \<open>i < 2 ^ m\<close> sprop1)
        hence "x < 2^n"
          using \<open>vebt_member (treeList' ! i) x\<close> member_bound by auto
        hence "both_member_options (treeList ! i) x"
          using both_member_options_from_complete_tree_to_child[of deg mi ma treeList summary "(2^n*i +x)"]
            low_inv[of x n i] high_inv[of x n i]
          by (smt (z3) Nat.add_0_right Suc_leD \<open>both_member_options (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)\<close> \<open>i < 2 ^ m\<close> a0 add_Suc_right calculation case4(11) case4(5) div_less div_mult_self4 mult.commute mult_2 nat_1_add_1 nat_neq_iff one_less_numeral_iff plus_1_eq_Suc semiring_norm(76) sprop1 zero_neq_numeral)
        then show ?thesis
          by (metis \<open>i < 2 ^ m\<close> aca case4(1) nth_mem sprop1 valid_member_both_member_options)
      qed
    qed
  qed
  hence setcongy: "i < 2^m \<Longrightarrow> set_vebt' (treeList ! i) = set_vebt' (treeList' ! i)" for i unfolding set_vebt'_def by presburger
  hence treecongy: "i < 2^m \<Longrightarrow> treeList ! i = treeList' ! i" for i
    by (metis case4(1) case4(4) nth_mem sprop1)
  hence "treeList = treeList'"
    by (metis aca case4(4) nth_equalityI)
  have "vebt_member summary x \<longleftrightarrow> vebt_member summary' x" for x
    by (metis \<open>treeList = treeList'\<close> both_member_options_equiv_member case4(3) case4(7) member_bound sprop1 sumtreelistcong)
  hence "set_vebt' summary = set_vebt' summary'" unfolding set_vebt'_def by auto
  hence "summary = summary'"
    using case4(2) sprop1 by blast
  then show ?case
    using \<open>treeList = treeList'\<close> infsplit sprop1 by fastforce
qed

corollary "invar_vebt t n \<Longrightarrow> set_vebt' t = {} \<Longrightarrow> t = vebt_buildup n"
  by (metis buildup_gives_empty buildup_gives_valid deg_not_0 uniquetree)

corollary unique_tree: "invar_vebt t n \<Longrightarrow> invar_vebt s n \<Longrightarrow> set_vebt t = set_vebt s \<Longrightarrow> s = t"
  by (simp add: set_vebt_set_vebt'_valid uniquetree)

corollary "invar_vebt t n \<Longrightarrow> set_vebt t = {} \<Longrightarrow> t = vebt_buildup n"
  by (metis buildup_gives_empty buildup_gives_valid deg_not_0 uniquetree  set_vebt_set_vebt'_valid)

text \<open>All valid trees can be generated by $vebt-insertion$ chains on an empty tree with same degree parameter:\<close>

inductive perInsTrans::"VEBT \<Rightarrow> VEBT \<Rightarrow> bool" where
  "perInsTrans t t"|
  "(t = vebt_insert s x) \<Longrightarrow> perInsTrans t u \<Longrightarrow> perInsTrans s u"

lemma perIT_concat:" perInsTrans s t \<Longrightarrow> perInsTrans t u \<Longrightarrow> perInsTrans s u"
  by (induction s t rule: perInsTrans.induct) (simp add: perInsTrans.intros)+

lemma assumes "invar_vebt t n " shows
  "perInsTrans (vebt_buildup n) t"
proof-
  have "finite A \<Longrightarrow>invar_vebt s n \<Longrightarrow>set_vebt' s = B \<Longrightarrow> B\<subseteq> A \<Longrightarrow> perInsTrans (vebt_buildup n) s" for s A B
  proof (induction "card B" arbitrary: s B)
    case 0
    then show ?case
      by (metis buildup_gives_empty buildup_gives_valid card_eq_0_iff deg_not_0 perInsTrans.intros(1) set_vebt_finite uniquetree)
  next
    case (Suc car)
    hence "finite B"
      by (meson rev_finite_subset)
    obtain x b where "B = insert x b \<and> x \<notin> b"
      by (metis Suc.hyps(2) card_Suc_eq)
    have "set_vebt' (vebt_delete s x) = b"
      using Suc.prems(2) Suc.prems(3) \<open>B = insert x b \<and> x \<notin> b\<close> delete_correct' by auto
    moreover hence "perInsTrans (vebt_buildup n) (vebt_delete s x)"
      by (metis Suc.hyps(1) Suc.hyps(2) Suc.prems(1) Suc.prems(2) Suc.prems(4) \<open>B = insert x b \<and> x \<notin> b\<close> \<open>finite B\<close> card_insert_disjoint delete_pres_valid finite_insert nat.inject subset_insertI subset_trans)
    hence "set_vebt' (vebt_insert (vebt_delete s x) x) = set_vebt' s"
      by (metis Diff_insert_absorb Suc.prems(2) Suc.prems(3) Un_insert_right \<open>B = insert x b \<and> x \<notin> b\<close> boolean_algebra_cancel.sup0 delete_pres_valid delete_correct' insertI1 insert_corr mem_Collect_eq member_bound set_vebt'_def)
    have "invar_vebt (vebt_insert (vebt_delete s x) x) n"
      by (metis Suc.prems(2) Suc.prems(3) \<open>B = insert x b \<and> x \<notin> b\<close> delete_pres_valid insertI1 mem_Collect_eq member_bound set_vebt'_def valid_pres_insert)
    moreover hence "vebt_insert (vebt_delete s x) x = s"
      using Suc.prems(2) \<open>set_vebt' (VEBT_Insert.vebt_insert (vebt_delete s x) x) = set_vebt' s\<close> uniquetree by force
    ultimately show ?case
      by (metis \<open>perInsTrans (vebt_buildup n) (vebt_delete s x)\<close> perIT_concat perInsTrans.intros(1) perInsTrans.intros(2))
  qed
  then show ?thesis
    by (meson assms equalityD1 set_vebt_finite)
qed

end
end


section \<open>Result\<close>

theory Result imports Soundness Completeness begin

theorem prover_soundness_completeness:
  fixes A B :: \<open>fm list\<close>
  defines \<open>t \<equiv> prover (A, B)\<close>
  shows \<open>tfinite t \<and> wf t \<longleftrightarrow> (\<forall>(E :: _ \<Rightarrow> tm) F G. sc (E, F, G) (A, B))\<close>
  using assms prover_soundness prover_completeness unfolding prover_def by fastforce

corollary
  fixes p :: fm
  defines \<open>t \<equiv> prover ([], [p])\<close>
  shows \<open>tfinite t \<and> wf t \<longleftrightarrow> (\<forall>(E :: _ \<Rightarrow> tm) F G. \<lbrakk>E, F, G\<rbrakk> p)\<close>
  using assms prover_soundness_completeness by simp

end


(*
  Goal verification framework
    - Temporal Logic
*)
\<comment> \<open>This theory specifies a temporal logic for proving properties of agents.\<close>

theory Gvf_Temporal_Logic imports Gvf_Agent_Specification begin

section \<open>Syntax\<close>

datatype 'a \<Phi>\<^sub>T =
  F (\<open>\<bottom>\<^sub>T\<close>) |
  Atom 'a |
  Negation \<open>'a \<Phi>\<^sub>T\<close> (\<open>\<not>\<^sub>T\<close>) |
  Implication \<open>'a \<Phi>\<^sub>T\<close> \<open>'a \<Phi>\<^sub>T\<close> (infixr \<open>\<longrightarrow>\<^sub>T\<close> 60) |
  Disjunction \<open>'a \<Phi>\<^sub>T\<close> \<open>'a \<Phi>\<^sub>T\<close> (infixl \<open>\<or>\<^sub>T\<close> 70) |
  Conjunction \<open>'a \<Phi>\<^sub>T\<close> \<open>'a \<Phi>\<^sub>T\<close> (infixl \<open>\<and>\<^sub>T\<close> 80) |
  init |
  until \<open>'a \<Phi>\<^sub>T\<close> \<open>'a \<Phi>\<^sub>T\<close> (infix \<open>until\<close> 55)

\<comment> \<open>The type for temporal logic (mental state) formulas including enabledness.\<close>
type_synonym \<Phi>\<^sub>T\<^sub>M = \<open>Atom\<^sub>M \<Phi>\<^sub>T\<close>

abbreviation \<open>B\<^sub>T \<Phi> \<equiv> Atom (Bl \<Phi>)\<close>
abbreviation \<open>G\<^sub>T \<Phi> \<equiv> Atom (Gl \<Phi>)\<close>

\<comment> \<open>A number of other well known temporal operators can be defined in terms of the operator until.\<close>

\<comment> \<open>Operator: always\<close>
definition always :: \<open>'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T\<close> (\<open>\<box>\<close>) where
  \<open>\<box>\<phi> \<equiv> \<phi> until \<bottom>\<^sub>T\<close>

definition eventuality :: \<open>'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T\<close> (\<open>\<diamondop>\<close>) where
  \<open>\<diamondop>\<phi> \<equiv> \<not>\<^sub>T (\<box> (\<not>\<^sub>T\<phi>))\<close>

\<comment> \<open>Operator: unless\<close>
definition unless :: \<open>'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T\<close> (infix \<open>unless\<close> 55) where
  \<open>\<phi> unless \<psi> \<equiv> \<phi> \<longrightarrow>\<^sub>T (\<phi> until \<psi>)\<close>

fun to_\<Phi>\<^sub>T :: \<open>'a \<Phi>\<^sub>P \<Rightarrow> 'a \<Phi>\<^sub>T\<close> (\<open>_\<^sup>T\<close> [100]) where
  \<open>(\<Phi>\<^sub>P.Atom x)\<^sup>T = Atom x\<close> |
  \<open>\<^bold>\<bottom>\<^sup>T = \<bottom>\<^sub>T\<close> |
  \<open>(\<^bold>\<not> p)\<^sup>T = (\<not>\<^sub>T (p\<^sup>T))\<close> |
  \<open>(p \<^bold>\<longrightarrow> q)\<^sup>T = (p\<^sup>T \<longrightarrow>\<^sub>T q\<^sup>T)\<close> |
  \<open>(p \<^bold>\<or> q)\<^sup>T = (p\<^sup>T \<or>\<^sub>T q\<^sup>T)\<close> |
  \<open>(p \<^bold>\<and> q)\<^sup>T = (p\<^sup>T \<and>\<^sub>T q\<^sup>T)\<close>

section \<open>Semantics\<close>

context single_agent_program begin

fun semantics\<^sub>T :: \<open>trace \<Rightarrow> nat \<Rightarrow> \<Phi>\<^sub>T\<^sub>M \<Rightarrow> bool\<close> (\<open>_, _ \<Turnstile>\<^sub>T\<close> [50]) where
  \<open>s, i \<Turnstile>\<^sub>T \<bottom>\<^sub>T = False\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (Atom x) = ((\<Phi>\<^sub>P.Atom x)\<^bold>[s i\<^bold>]\<^sub>M)\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (\<not>\<^sub>T p) = (\<not> (s, i \<Turnstile>\<^sub>T p))\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (p \<longrightarrow>\<^sub>T q) = ((s, i \<Turnstile>\<^sub>T p) \<longrightarrow> (s, i \<Turnstile>\<^sub>T q))\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (p \<or>\<^sub>T q) = ((s, i \<Turnstile>\<^sub>T p) \<or> (s, i \<Turnstile>\<^sub>T q))\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (p \<and>\<^sub>T q) = ((s, i \<Turnstile>\<^sub>T p) \<and> (s, i \<Turnstile>\<^sub>T q))\<close> |
  \<open>s, i \<Turnstile>\<^sub>T init = (i = 0)\<close> |
  \<open>s, i \<Turnstile>\<^sub>T (\<phi> until \<psi>) = ((\<exists> j \<ge> i. s, j \<Turnstile>\<^sub>T \<psi> \<and> (\<forall>k \<ge> i. j > k \<longrightarrow> s, k \<Turnstile>\<^sub>T \<phi>)) \<or> (\<forall>k \<ge> i. s, k \<Turnstile>\<^sub>T \<phi>))\<close>

lemma sem\<^sub>T\<^sub>M_equiv: \<open>(\<forall>M. semantics\<^sub>M M p) \<longleftrightarrow> (\<forall>s i. (p\<^bold>[s i\<^bold>]\<^sub>M))\<close>
  using st_nth.simps(1) by metis

lemma sem\<^sub>T\<^sub>M_equiv2: \<open>s, i \<Turnstile>\<^sub>T (p\<^sup>T) \<longleftrightarrow> (p\<^bold>[s i\<^bold>]\<^sub>M)\<close>
  by (induct p) auto

lemma \<open>(\<forall>M. semantics\<^sub>M M p) \<longleftrightarrow> (\<forall>s i. s, i \<Turnstile>\<^sub>T (p\<^sup>T))\<close> using sem\<^sub>T\<^sub>M_equiv sem\<^sub>T\<^sub>M_equiv2 by simp

abbreviation semantics_trace\<^sub>T\<^sub>M :: \<open>trace set \<Rightarrow> \<Phi>\<^sub>T\<^sub>M \<Rightarrow> bool\<close> (infix \<open>\<Turnstile>\<^sub>T#\<close> 50) where
  \<open>S \<Turnstile>\<^sub>T# \<phi> \<equiv> \<forall>s\<in>S. \<forall>i. (s, i \<Turnstile>\<^sub>T \<phi>)\<close>

section \<open>Relations between Hoare Logic and Temporal Logic\<close>

subsection \<open>Unless\<close>

\<comment> \<open>Theorem 4.15\<close>
theorem unless_ht: \<open>(\<forall>b \<in> \<Pi>. (\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<phi> \<^bold>\<or> \<psi> \<^bold>})) \<longleftrightarrow> Agent \<Turnstile>\<^sub>T# \<phi>\<^sup>T unless \<psi>\<^sup>T\<close>
proof
  assume *: \<open>\<forall>b \<in> \<Pi>. (\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<phi> \<^bold>\<or> \<psi> \<^bold>})\<close>
  show \<open>Agent \<Turnstile>\<^sub>T# \<phi>\<^sup>T unless \<psi>\<^sup>T\<close> (is \<open>Agent \<Turnstile>\<^sub>T# ?\<phi> unless ?\<psi>\<close>)
  proof (rule ccontr)
    assume \<open>\<not> Agent \<Turnstile>\<^sub>T# ?\<phi> unless ?\<psi>\<close>
    then obtain s i where \<open>\<not> (s, i \<Turnstile>\<^sub>T (?\<phi> unless ?\<psi>))\<close> \<open>s \<in> Agent\<close> by auto
    then have \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> \<open>\<not> (s, i \<Turnstile>\<^sub>T (?\<phi> until ?\<psi>))\<close> unfolding unless_def by simp_all
    then have \<open>\<not>(\<exists> j \<ge> i. s, j \<Turnstile>\<^sub>T ?\<psi>) \<and> (\<exists>k \<ge> i. s, k \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<phi>)) \<or> (\<exists> j > i. s, j \<Turnstile>\<^sub>T ?\<psi>) \<and> (\<forall> j > i. s, j \<Turnstile>\<^sub>T ?\<psi> \<longrightarrow> \<not>(\<forall>k \<ge> i. j > k \<longrightarrow> s, k \<Turnstile>\<^sub>T ?\<phi>))\<close> by auto
    then show False
    proof
      assume a: \<open>\<not> (\<exists>j\<ge>i. s, j \<Turnstile>\<^sub>T ?\<psi>) \<and> (\<exists>k\<ge>i. s, k \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<phi>))\<close>
      let ?P = \<open>\<lambda>x. x \<ge> i \<and> s, x \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<phi>)\<close>
      have \<open>\<not> ?P 0\<close> using \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> by fastforce
      moreover obtain n where \<open>?P n\<close> using a by auto
      ultimately have \<open>\<exists>k\<le>n. (\<forall>i<k. \<not> ?P i) \<and> ?P k\<close> using ex_least_nat_le[where P=\<open>?P\<close>] by simp
      then obtain k where Pk: \<open>k \<le> n \<and> (\<forall>i<k. \<not> ?P i) \<and> ?P k\<close> by auto
      moreover from this have \<open>k > i\<close> using \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> by fastforce
      ultimately have \<open>\<not> ?P (k - 1)\<close> by simp
      with \<open>k > i\<close> have \<open>s, k - 1 \<Turnstile>\<^sub>T (?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close> using a by simp
      then have \<open>st_nth s (k - 1) \<Turnstile>\<^sub>M \<phi> \<^bold>\<and> \<^bold>\<not> \<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
      moreover have \<open>?P k\<close> using Pk by simp
      then have \<open>s, k \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close> using a \<open>k > i\<close> by simp
      then have \<open>st_nth s k \<Turnstile>\<^sub>M \<^bold>\<not> \<phi> \<^bold>\<and> \<^bold>\<not> \<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
      moreover obtain b where \<open>(fst b, snd b) = act_nth s (k - 1)\<close> by simp
      moreover from this have \<open>b \<in> \<Pi>\<close> using \<open>s \<in> Agent\<close> trace_in_\<Pi> unfolding Agent_def by simp
      with * have \<open>\<forall> s \<in> Agent. \<forall>i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s (i+1)\<^bold>]\<^sub>M)\<close>
        using semantics\<^sub>H.simps(2) by blast
      then have \<open>((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s (k-1)\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s (k-1)) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s ((k-1)+1)\<^bold>]\<^sub>M)\<close>
        using \<open>s \<in> Agent\<close> by simp
      with \<open>k > i\<close> have \<open>((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s (k-1)\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s (k-1)) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s k\<^bold>]\<^sub>M)\<close>
        by simp
      ultimately show False by simp
    next
      assume a: \<open>(\<exists> j > i. s, j \<Turnstile>\<^sub>T ?\<psi>) \<and> (\<forall> j > i. s, j \<Turnstile>\<^sub>T ?\<psi> \<longrightarrow> \<not>(\<forall>k \<ge> i. j > k \<longrightarrow> s, k \<Turnstile>\<^sub>T ?\<phi>))\<close>
      let ?P = \<open>\<lambda>x. x > i \<and> s, x \<Turnstile>\<^sub>T ?\<psi>\<close>
      have \<open>\<not> ?P 0\<close> by simp
      moreover obtain n where \<open>?P n\<close> using a by auto
      ultimately have \<open>\<exists>k\<le>n. (\<forall>i<k. \<not> ?P i) \<and> ?P k\<close> using ex_least_nat_le[where P=\<open>?P\<close>] by simp
      then obtain k where Pk: \<open>k \<le> n \<and> (\<forall>i<k. \<not> ?P i) \<and> ?P k\<close> by auto
      let ?P' = \<open>\<lambda>x. i < x \<and> x < k \<and> \<not> s, x \<Turnstile>\<^sub>T ?\<phi>\<close>
      have \<open>\<not> ?P' 0\<close> by simp
      moreover obtain n' where \<open>?P' n'\<close> using Pk \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> le_neq_trans a by blast
      ultimately have \<open>\<exists>j\<le>n'. (\<forall>i<j. \<not> ?P' i) \<and> ?P' j\<close> using ex_least_nat_le[where P=\<open>?P'\<close>] by simp
      then obtain j where Pj: \<open>j \<le> n' \<and> (\<forall>i<j. \<not> ?P' i) \<and> ?P' j\<close> by auto
      then have \<open>\<not> ?P' (j - 1)\<close> by simp
      moreover have \<open>j - 1 < k\<close> using Pj by auto
      ultimately have \<open>s, j - 1 \<Turnstile>\<^sub>T ?\<phi>\<close>
      proof (cases \<open>i < j - 1\<close>)
        case False
        then have \<open>i = j - 1\<close> using Pj by auto
        with \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> show ?thesis by simp
      qed simp
      moreover have \<open>\<not> ?P (j - 1)\<close> using Pk \<open>j - 1 < k\<close> by blast
      then have \<open>s, j - 1 \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<psi>)\<close>
      proof (cases \<open>i < j - 1\<close>)
        case False
        then have \<open>i = j - 1\<close> using Pj by auto
        with \<open>\<not> s, i \<Turnstile>\<^sub>T (?\<phi> until ?\<psi>)\<close> show ?thesis by fastforce
      qed simp
      ultimately have \<open>s, j - 1 \<Turnstile>\<^sub>T (?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close> by simp
      then have \<open>st_nth s (j - 1) \<Turnstile>\<^sub>M \<phi> \<^bold>\<and> \<^bold>\<not> \<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
      moreover
      {
        have \<open>\<not> s, j \<Turnstile>\<^sub>T ?\<phi>\<close> using Pj by simp
        moreover have \<open>j < k\<close> using Pj by simp
        then have \<open>\<not> ?P j\<close> using Pk by simp
        then have \<open>\<not> s, j \<Turnstile>\<^sub>T ?\<psi>\<close> using Pj by simp
        ultimately have \<open>s, j \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close> by simp
        then have \<open>st_nth s j \<Turnstile>\<^sub>M \<^bold>\<not> \<phi> \<^bold>\<and> \<^bold>\<not> \<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
      }
      moreover obtain b where \<open>(fst b, snd b) = act_nth s (j - 1)\<close> by simp
      moreover from this have \<open>b \<in> \<Pi>\<close> using \<open>s \<in> Agent\<close> trace_in_\<Pi> unfolding Agent_def by simp
      with * have \<open>\<forall> s \<in> Agent. \<forall>i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s (i+1)\<^bold>]\<^sub>M)\<close>
        using semantics\<^sub>H.simps(2) by blast
      then have \<open>((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s (j-1)\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s (j-1)) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s ((j-1)+1)\<^bold>]\<^sub>M)\<close>
        using \<open>s \<in> Agent\<close> by simp
      with Pj have \<open>((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s (j-1)\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s (j-1)) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s j\<^bold>]\<^sub>M)\<close>
        by simp
      ultimately show False by simp
    qed
  qed
next
  assume \<open>Agent \<Turnstile>\<^sub>T# \<phi>\<^sup>T unless \<psi>\<^sup>T\<close> (is \<open>Agent \<Turnstile>\<^sub>T# ?\<phi> unless ?\<psi>\<close>)
  show \<open>\<forall>b \<in> \<Pi>. (\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<phi> \<^bold>\<or> \<psi> \<^bold>})\<close>
  proof
    fix b
    assume \<open>b \<in> \<Pi>\<close>
    show \<open>\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<phi> \<^bold>\<or> \<psi> \<^bold>}\<close>
    proof -
      have \<open>\<forall> s \<in> Agent. \<forall>i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s (i+1)\<^bold>]\<^sub>M)\<close>
      proof
        fix s
        assume \<open>s \<in> Agent\<close>
        show \<open>\<forall>i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s (i+1)\<^bold>]\<^sub>M)\<close>
        proof
          fix i
          show \<open>((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> ((\<phi> \<^bold>\<or> \<psi>)\<^bold>[s (i+1)\<^bold>]\<^sub>M)\<close>
          proof (cases \<open>st_nth s i \<Turnstile>\<^sub>M \<phi>\<close>)
            case True
            then have \<open>s, i \<Turnstile>\<^sub>T ?\<phi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
            with \<open>Agent \<Turnstile>\<^sub>T# ?\<phi> unless ?\<psi>\<close> have \<open>s, i \<Turnstile>\<^sub>T (?\<phi> until ?\<psi>)\<close> using \<open>s \<in> Agent\<close> unfolding unless_def by simp
            then have \<open>(\<exists> j \<ge> i. (s, j \<Turnstile>\<^sub>T ?\<psi>) \<and> (\<forall>k \<ge> i. j > k \<longrightarrow> (s, k \<Turnstile>\<^sub>T ?\<phi>))) \<or> (\<forall>k \<ge> i. (s, k \<Turnstile>\<^sub>T ?\<phi>))\<close> by simp
            then obtain j where *: \<open>(j \<ge> i \<and> s, j \<Turnstile>\<^sub>T ?\<psi> \<and> (\<forall>k \<ge> i. j > k \<longrightarrow> s, k \<Turnstile>\<^sub>T ?\<phi>)) \<or> s, i + 1 \<Turnstile>\<^sub>T ?\<phi>\<close> by auto
            then show ?thesis
            proof (cases \<open>j > i + 1\<close>)
              case True
              with * have \<open>s, (i + 1) \<Turnstile>\<^sub>T ?\<phi>\<close> by auto
              then have \<open>st_nth s (i + 1) \<Turnstile>\<^sub>M \<phi> \<^bold>\<or> \<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
              then show ?thesis by simp
            next
              case False
              with * have **: \<open>s, i \<Turnstile>\<^sub>T ?\<psi> \<or> s, i + 1 \<Turnstile>\<^sub>T ?\<psi> \<or> s, i + 1 \<Turnstile>\<^sub>T ?\<phi>\<close>
                by (metis discrete order.not_eq_order_implies_strict)
              then show ?thesis
              proof (cases \<open>st_nth s i \<Turnstile>\<^sub>M \<psi>\<close>)
                case False
                then have \<open>\<not> s, i \<Turnstile>\<^sub>T ?\<psi>\<close> by (simp add: sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M)
                with ** have \<open>s, i + 1 \<Turnstile>\<^sub>T ?\<psi> \<or> s, i + 1 \<Turnstile>\<^sub>T ?\<phi>\<close> by simp
                then show ?thesis using sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M by auto
              qed simp
            qed
          qed simp
        qed
      qed
      then show ?thesis using semantics\<^sub>H.simps(2) by blast
    qed
  qed
qed

subsection \<open>Ensures\<close>

definition ensures :: \<open>'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T \<Rightarrow> 'a \<Phi>\<^sub>T\<close> (infix \<open>ensures\<close> 55) where
  \<open>\<phi> ensures \<psi> \<equiv> (\<phi> unless \<psi>) \<and>\<^sub>T (\<phi> \<longrightarrow>\<^sub>T \<diamondop>\<psi>)\<close>

\<comment> \<open>Theorem 4.16\<close>
theorem ex_ensures:
  assumes \<open>\<forall>b \<in> \<Pi>. (\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<phi> \<^bold>\<or> \<psi> \<^bold>})\<close>
      and \<open>\<exists>b \<in> \<Pi>. (\<Turnstile>\<^sub>H \<^bold>{ \<phi> \<^bold>\<and> \<^bold>\<not> \<psi> \<^bold>} ((fst b) \<triangleright> do (snd b)) \<^bold>{ \<psi> \<^bold>})\<close>
    shows \<open>Agent \<Turnstile>\<^sub>T# \<phi>\<^sup>T ensures \<psi>\<^sup>T\<close> (is \<open>Agent \<Turnstile>\<^sub>T# ?\<phi> ensures ?\<psi>\<close>)
proof
  fix s
  assume \<open>s \<in> Agent\<close>
  show \<open>\<forall>i. s, i \<Turnstile>\<^sub>T (?\<phi> ensures ?\<psi>)\<close>
  proof
    fix i
    have \<open>\<forall>i. s, i \<Turnstile>\<^sub>T (?\<phi> unless ?\<psi>)\<close> using assms(1) \<open>s \<in> Agent\<close> unless_ht by simp
    moreover have \<open>s, i \<Turnstile>\<^sub>T (?\<phi> \<longrightarrow>\<^sub>T \<diamondop> ?\<psi>)\<close>
    proof -
      have \<open>fair_trace s\<close> using \<open>s \<in> Agent\<close> unfolding Agent_def by simp
      show ?thesis
      proof (rule ccontr)
        assume negev: \<open>\<not> s, i \<Turnstile>\<^sub>T (?\<phi> \<longrightarrow>\<^sub>T \<diamondop> ?\<psi>)\<close>
        then have \<open>s, i \<Turnstile>\<^sub>T (?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>) \<and> (\<forall>j > i. s, j \<Turnstile>\<^sub>T (\<not>\<^sub>T ?\<psi>))\<close>
          unfolding eventuality_def always_def by simp
        with negev \<open>\<forall>i. s, i \<Turnstile>\<^sub>T (?\<phi> unless ?\<psi>)\<close> have \<open>\<forall>j > i. s, j \<Turnstile>\<^sub>T (?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close>
          unfolding unless_def always_def eventuality_def by auto
        moreover
        {
          from assms(2) obtain b where \<open>b \<in> \<Pi> \<and> (\<forall>i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s i\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s i) \<longrightarrow> (\<psi>\<^bold>[s (i+1)\<^bold>]\<^sub>M))\<close>
            using \<open>s \<in> Agent\<close> by fastforce
          then have \<open>b \<in> \<Pi> \<and> (\<forall>j > i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s j\<^bold>]\<^sub>M) \<and> ((fst b) \<triangleright> do (snd b)) = (act_nth s j) \<longrightarrow> (\<psi>\<^bold>[s (j+1)\<^bold>]\<^sub>M))\<close>
            by auto
          moreover from this have \<open>\<exists>j > i. ((fst b) \<triangleright> do (snd b)) = (act_nth s j)\<close>
            using \<open>fair_trace s\<close> unfolding fair_trace_def by fastforce
          ultimately have \<open>\<exists>j > i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s j\<^bold>]\<^sub>M) \<longrightarrow> (\<psi>\<^bold>[s (j+1)\<^bold>]\<^sub>M)\<close> by auto
          moreover from \<open>\<forall>j > i. s, j \<Turnstile>\<^sub>T (?\<phi> \<and>\<^sub>T \<not>\<^sub>T ?\<psi>)\<close> have \<open>\<forall>j > i. ((\<phi> \<^bold>\<and> \<^bold>\<not> \<psi>)\<^bold>[s j\<^bold>]\<^sub>M)\<close>
            using sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M by simp
          ultimately have \<open>\<exists>j > i. (\<psi>\<^bold>[s (j+1)\<^bold>]\<^sub>M)\<close> by auto
        }
        ultimately show False using sem\<^sub>T\<^sub>M_equiv2 transfer_semantics\<^sub>M by auto
      qed
    qed
    ultimately show \<open>s, i \<Turnstile>\<^sub>T (?\<phi> ensures ?\<psi>)\<close> by (simp add: ensures_def)
  qed
qed

subsection \<open>Leads to operator\<close>

fun disL:: \<open>'a \<Phi>\<^sub>T list \<Rightarrow> 'a \<Phi>\<^sub>T\<close> where
  \<open>disL [] = \<bottom>\<^sub>T\<close> |
  \<open>disL [\<phi>] = \<phi>\<close> |
  \<open>disL (\<phi> # \<phi>\<^sub>L) = \<phi> \<or>\<^sub>T disL \<phi>\<^sub>L\<close>

inductive leads_to :: \<open>\<Phi>\<^sub>T\<^sub>M \<Rightarrow> \<Phi>\<^sub>T\<^sub>M \<Rightarrow> bool\<close> (infix \<open>\<mapsto>\<close> 55) where
  ensures: \<open>\<forall>s \<in> Agent. \<forall>i. s, i \<Turnstile>\<^sub>T (\<phi> ensures \<psi>) \<Longrightarrow> \<phi> \<mapsto> \<psi>\<close> |
  imp: \<open>\<phi> \<mapsto> \<chi> \<Longrightarrow> \<chi> \<mapsto> \<psi> \<Longrightarrow> \<phi> \<mapsto> \<psi>\<close> |
  disj: \<open>\<forall>\<phi> \<in> set \<phi>\<^sub>L. \<phi> \<mapsto> \<psi> \<Longrightarrow> disL \<phi>\<^sub>L \<mapsto> \<psi>\<close>

\<comment> \<open>Lemma 4.18\<close>
lemma leads_to_temp: \<open>\<phi> \<mapsto> \<psi> \<Longrightarrow> \<forall>s \<in> Agent. \<forall>i. s, i \<Turnstile>\<^sub>T (\<phi> \<longrightarrow>\<^sub>T \<diamondop>\<psi>)\<close>
proof (induct rule: leads_to.inducts)
  case (ensures \<phi> \<psi>)
  then show ?case unfolding ensures_def always_def eventuality_def by simp
next
  case (imp \<phi> \<chi> \<psi>)
  show ?case
  proof
    fix s
    assume \<open>s \<in> Agent\<close>
    show \<open>\<forall>i. s, i \<Turnstile>\<^sub>T (\<phi> \<longrightarrow>\<^sub>T \<diamondop>\<psi>)\<close>
    proof
      fix i
      have \<open>s, i \<Turnstile>\<^sub>T \<phi> \<longrightarrow> s, i \<Turnstile>\<^sub>T (\<diamondop> \<psi>)\<close>
      proof
        assume \<open>s, i \<Turnstile>\<^sub>T \<phi>\<close>
        with \<open>s \<in> Agent\<close> have \<open>s, i \<Turnstile>\<^sub>T (\<diamondop> \<chi>)\<close> using imp(2) by simp
        then obtain j where \<open>j \<ge> i\<close> \<open>s, j \<Turnstile>\<^sub>T \<chi>\<close> unfolding eventuality_def always_def by auto
        with \<open>s \<in> Agent\<close> have \<open>s, j \<Turnstile>\<^sub>T (\<diamondop> \<psi>)\<close> using imp(4) by simp
        then obtain k where \<open>k \<ge> j\<close> \<open>s, k \<Turnstile>\<^sub>T \<psi>\<close> unfolding eventuality_def always_def by auto
        with \<open>j \<ge> i\<close> show \<open>s, i \<Turnstile>\<^sub>T (\<diamondop> \<psi>)\<close>
          using order.trans unfolding eventuality_def always_def by auto
      qed
      then show \<open>s, i \<Turnstile>\<^sub>T (\<phi> \<longrightarrow>\<^sub>T \<diamondop> \<psi>)\<close> by simp
    qed
  qed
next
  case (disj \<phi>\<^sub>L \<psi>)
  then show ?case
  proof (induct \<phi>\<^sub>L)
    case (Cons a \<phi>\<^sub>L)
    show ?case
    proof
      fix s
      assume \<open>s \<in> Agent\<close>
      show \<open>\<forall>i. s, i \<Turnstile>\<^sub>T (disL (a # \<phi>\<^sub>L) \<longrightarrow>\<^sub>T \<diamondop> \<psi>)\<close>
      proof
        fix i
        from Cons have
          \<open>s, i \<Turnstile>\<^sub>T (disL \<phi>\<^sub>L \<longrightarrow>\<^sub>T \<diamondop> \<psi>)\<close>
          \<open>s, i \<Turnstile>\<^sub>T (a \<longrightarrow>\<^sub>T \<diamondop> \<psi>)\<close>
          using \<open>s \<in> Agent\<close> by simp_all
        then show \<open>s, i \<Turnstile>\<^sub>T (disL (a # \<phi>\<^sub>L) \<longrightarrow>\<^sub>T \<diamondop> \<psi>)\<close>
          by (metis disL.simps(2,3) list.exhaust semantics\<^sub>T.simps(4,5))
      qed
    qed
  qed simp
qed

end
end