(*
    $Id: sol.thy,v 1.3 2011/06/28 18:11:38 webertj Exp $
    Author: Tjark Weber
*)

header {* SNOC *}

(*<*) theory sol imports Main begin (*>*)

text {*
Define a primitive recursive function @{text snoc} that appends an element
at the \emph{right} end of a list. Do not use @{text"@"} itself.
*}

primrec snoc :: "'a list => 'a => 'a list" where
  "snoc []     a = [a]"
| "snoc (x#xs) a = x # snoc xs a"

lemma snoc_append: "snoc xs a = xs @ [a]"
  apply (induct "xs")
  apply auto
done

text {*
Prove the following theorem:
*}

theorem rev_cons: "\<forall>x. rev (x # xs) = snoc (rev xs) x"
  apply (induct "xs")
  apply (auto simp add: snoc_append)
done

text {*
Hint: you need to prove a suitable lemma first.
*}

(*<*) end (*>*)


(*  Author:     Lawrence C Paulson and Thomas M Rasmussen and Norbert Voelker
*)

section \<open>Permuted Lists\<close>

theory List_Permutation
imports Permutations
begin

text \<open>
  Note that multisets already provide the notion of permutated list and hence
  this theory mostly echoes material already logically present in theory
  \<^text>\<open>Permutations\<close>; it should be seldom needed.
\<close>

subsection \<open>An existing notion\<close>

abbreviation (input) perm :: \<open>'a list \<Rightarrow> 'a list \<Rightarrow> bool\<close>  (infixr \<open><~~>\<close> 50)
  where \<open>xs <~~> ys \<equiv> mset xs = mset ys\<close>

subsection \<open>Nontrivial conclusions\<close>

proposition perm_swap:
  \<open>xs[i := xs ! j, j := xs ! i] <~~> xs\<close>
  if \<open>i < length xs\<close> \<open>j < length xs\<close>
  using that by (simp add: mset_swap)

proposition mset_le_perm_append: "mset xs \<subseteq># mset ys \<longleftrightarrow> (\<exists>zs. xs @ zs <~~> ys)"
  by (auto simp add: mset_subset_eq_exists_conv ex_mset dest: sym)

proposition perm_set_eq: "xs <~~> ys \<Longrightarrow> set xs = set ys"
  by (rule mset_eq_setD) simp

proposition perm_distinct_iff: "xs <~~> ys \<Longrightarrow> distinct xs \<longleftrightarrow> distinct ys"
  by (rule mset_eq_imp_distinct_iff) simp

theorem eq_set_perm_remdups: "set xs = set ys \<Longrightarrow> remdups xs <~~> remdups ys"
  by (simp add: set_eq_iff_mset_remdups_eq)

proposition perm_remdups_iff_eq_set: "remdups x <~~> remdups y \<longleftrightarrow> set x = set y"
  by (simp add: set_eq_iff_mset_remdups_eq)

theorem permutation_Ex_bij:
  assumes "xs <~~> ys"
  shows "\<exists>f. bij_betw f {..<length xs} {..<length ys} \<and> (\<forall>i<length xs. xs ! i = ys ! (f i))"
proof -
  from assms have \<open>mset xs = mset ys\<close> \<open>length xs = length ys\<close>
    by (auto simp add: dest: mset_eq_length)
  from \<open>mset xs = mset ys\<close> obtain p where \<open>p permutes {..<length ys}\<close> \<open>permute_list p ys = xs\<close>
    by (rule mset_eq_permutation)
  then have \<open>bij_betw p {..<length xs} {..<length ys}\<close>
    by (simp add: \<open>length xs = length ys\<close> permutes_imp_bij)
  moreover have \<open>\<forall>i<length xs. xs ! i = ys ! (p i)\<close>
    using \<open>permute_list p ys = xs\<close> \<open>length xs = length ys\<close> \<open>p permutes {..<length ys}\<close> permute_list_nth
    by auto
  ultimately show ?thesis
    by blast
qed

proposition perm_finite: "finite {B. B <~~> A}"
  using mset_eq_finite by auto

subsection \<open>Trivial conclusions:\<close>

proposition perm_empty_imp: "[] <~~> ys \<Longrightarrow> ys = []"
  by simp

text \<open>\medskip This more general theorem is easier to understand!\<close>

proposition perm_length: "xs <~~> ys \<Longrightarrow> length xs = length ys"
  by (rule mset_eq_length) simp

proposition perm_sym: "xs <~~> ys \<Longrightarrow> ys <~~> xs"
  by simp

text \<open>We can insert the head anywhere in the list.\<close>

proposition perm_append_Cons: "a # xs @ ys <~~> xs @ a # ys"
  by simp

proposition perm_append_swap: "xs @ ys <~~> ys @ xs"
  by simp

proposition perm_append_single: "a # xs <~~> xs @ [a]"
  by simp

proposition perm_rev: "rev xs <~~> xs"
  by simp

proposition perm_append1: "xs <~~> ys \<Longrightarrow> l @ xs <~~> l @ ys"
  by simp

proposition perm_append2: "xs <~~> ys \<Longrightarrow> xs @ l <~~> ys @ l"
  by simp

proposition perm_empty [iff]: "[] <~~> xs \<longleftrightarrow> xs = []"
  by simp

proposition perm_empty2 [iff]: "xs <~~> [] \<longleftrightarrow> xs = []"
  by simp

proposition perm_sing_imp: "ys <~~> xs \<Longrightarrow> xs = [y] \<Longrightarrow> ys = [y]"
  by simp

proposition perm_sing_eq [iff]: "ys <~~> [y] \<longleftrightarrow> ys = [y]"
  by simp

proposition perm_sing_eq2 [iff]: "[y] <~~> ys \<longleftrightarrow> ys = [y]"
  by simp

proposition perm_remove: "x \<in> set ys \<Longrightarrow> ys <~~> x # remove1 x ys"
  by simp

text \<open>\medskip Congruence rule\<close>

proposition perm_remove_perm: "xs <~~> ys \<Longrightarrow> remove1 z xs <~~> remove1 z ys"
  by simp

proposition remove_hd [simp]: "remove1 z (z # xs) = xs"
  by simp

proposition cons_perm_imp_perm: "z # xs <~~> z # ys \<Longrightarrow> xs <~~> ys"
  by simp

proposition cons_perm_eq [simp]: "z#xs <~~> z#ys \<longleftrightarrow> xs <~~> ys"
  by simp

proposition append_perm_imp_perm: "zs @ xs <~~> zs @ ys \<Longrightarrow> xs <~~> ys"
  by simp

proposition perm_append1_eq [iff]: "zs @ xs <~~> zs @ ys \<longleftrightarrow> xs <~~> ys"
  by simp

proposition perm_append2_eq [iff]: "xs @ zs <~~> ys @ zs \<longleftrightarrow> xs <~~> ys"
  by simp

end


section \<open> General Extensional Mereology \<close>

(*<*)
theory GEM
  imports GMM CEM
begin (*>*)

text \<open> The theory of \emph{general extensional mereology}, also known as \emph{classical extensional
mereology} adds general mereology to extensional mereology.\footnote{For this axiomatization see
\<^cite>\<open>"varzi_parts_1996"\<close> p. 265  and \<^cite>\<open>"casati_parts_1999"\<close> p. 46.} \<close>

locale GEM = GM + EM +
  assumes sum_eq: "x \<oplus> y = (THE z. \<forall>v. O v z \<longleftrightarrow> O v x \<or> O v y)"
  assumes product_eq:
    "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
  assumes difference_eq:
    "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
  assumes complement_eq: "\<midarrow> x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
  assumes universe_eq: "u = (THE x. \<forall>y. P y x)"
  assumes fusion_eq: "\<exists>x. F x \<Longrightarrow>
    (\<sigma> x. F x) = (THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z))"
  assumes general_product_eq: "(\<pi> x. F x) = (\<sigma> x. \<forall>y. F y \<longrightarrow> P x y)"

sublocale GEM \<subseteq> GMM
proof
qed

subsection \<open> General Sums  \<close>

context GEM
begin

lemma fusion_intro:
"(\<forall>y. O y z \<longleftrightarrow> (\<exists>x. F x \<and> O y x)) \<Longrightarrow> (\<sigma> x. F x) = z"
proof -
  assume antecedent: "(\<forall>y. O y z \<longleftrightarrow> (\<exists>x. F x \<and> O y x))"
  hence "(THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z)) = z"
  proof (rule the_equality)
    fix a
    assume a: "(\<forall>y. O y a \<longleftrightarrow> (\<exists>x. F x \<and> O y x))"
    have "\<forall>x. O x a \<longleftrightarrow> O x z"
    proof
      fix b
      from antecedent have "O b z \<longleftrightarrow> (\<exists>x. F x \<and> O b x)"..
      moreover from a have "O b a \<longleftrightarrow> (\<exists>x. F x \<and> O b x)"..
      ultimately show "O b a \<longleftrightarrow> O b z" by (rule ssubst)
    qed
    with overlap_extensionality show "a = z"..
  qed
  moreover from antecedent have "O z z \<longleftrightarrow> (\<exists>x. F x \<and> O z x)"..
  hence "\<exists>x. F x \<and> O z x" using overlap_reflexivity..
  hence "\<exists>x. F x" by auto
  hence "(\<sigma> x. F x) = (THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z))"
    by (rule fusion_eq)
  ultimately show "(\<sigma> v. F v) = z" by (rule subst)
qed

lemma fusion_idempotence: "(\<sigma> x. z = x) = z"
proof -
  have "\<forall>y. O y z \<longleftrightarrow> (\<exists>x. z = x \<and> O y x)"
  proof
    fix y
    show "O y z \<longleftrightarrow> (\<exists>x. z = x \<and> O y x)"
    proof
      assume "O y z"
      with refl have "z = z \<and> O y z"..
      thus "\<exists>x. z = x \<and> O y x"..
    next
      assume "\<exists>x. z = x \<and> O y x"
      then obtain x where x: "z = x \<and> O y x"..
      hence "z = x"..
      moreover from x have "O y x"..
      ultimately show "O y z" by (rule ssubst)
    qed
  qed
  thus "(\<sigma> x. z = x) = z"
    by (rule fusion_intro)
qed

text \<open> The whole is the sum of its parts. \<close>

lemma fusion_absorption: "(\<sigma> x. P x z) = z"
proof -
  have "(\<forall>y. O y z \<longleftrightarrow> (\<exists>x. P x z \<and> O y x))"
  proof
    fix y
    show "O y z \<longleftrightarrow> (\<exists>x. P x z \<and> O y x)"
    proof
      assume "O y z"
      with part_reflexivity have "P z z \<and> O y z"..
      thus "\<exists>x. P x z \<and> O y x"..
    next
      assume "\<exists>x. P x z \<and> O y x"
      then obtain x where x: "P x z \<and> O y x"..
      hence "P x z"..
      moreover from x have "O y x"..
      ultimately show "O y z" by (rule overlap_monotonicity)
    qed
  qed
  thus "(\<sigma> x. P x z) = z"
    by (rule fusion_intro)
qed

lemma part_fusion: "P w (\<sigma> v. P v x) \<Longrightarrow> P w x"
proof -
  assume "P w (\<sigma> v. P v x)"
  with fusion_absorption show "P w x" by (rule subst)
qed

lemma fusion_character:
  "\<exists>x. F x \<Longrightarrow> (\<forall>y. O y (\<sigma> v. F v) \<longleftrightarrow> (\<exists>x. F x \<and> O y x))"
proof -
  assume "\<exists>x. F x"
  hence "\<exists>z. \<forall>y. O y z \<longleftrightarrow> (\<exists>x. F x \<and> O y x)"
    by (rule fusion)
  then obtain z where z: "\<forall>y. O y z \<longleftrightarrow> (\<exists>x. F x \<and> O y x)"..
  hence "(\<sigma> v. F v) = z " by (rule fusion_intro)
  thus "\<forall>y. O y (\<sigma> v. F v) \<longleftrightarrow> (\<exists>x. F x \<and> O y x)" using z by (rule ssubst)
qed

text \<open> The next lemma characterises fusions in terms of parthood.\footnote{See \<^cite>\<open>"pontow_note_2004"\<close> pp. 202-9.} \<close>

lemma fusion_part_character: "\<exists>x. F x \<Longrightarrow>
  (\<forall>y. P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)))"
proof -
  assume "(\<exists>x. F x)"
  hence F: "\<forall>y. O y (\<sigma> v. F v) \<longleftrightarrow> (\<exists>x. F x \<and> O y x)"
    by (rule fusion_character)
  show "\<forall>y. P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v))"
  proof
    fix y
    show "P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v))"
    proof
      assume "P y (\<sigma> v. F v)"
      show "\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)"
      proof
        fix w
        from F have w: "O w (\<sigma> v. F v) \<longleftrightarrow> (\<exists>x. F x \<and> O w x)"..
        show "P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)"
        proof
          assume "P w y"
          hence "P w (\<sigma> v. F v)" using \<open>P y (\<sigma> v. F v)\<close>
            by (rule part_transitivity)
          hence "O w (\<sigma> v. F v)" by (rule part_implies_overlap)
          with w show "\<exists>x. F x \<and> O w x"..
        qed
      qed
    next
      assume right: "\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)"
      show "P y (\<sigma> v. F v)"
      proof (rule ccontr)
        assume "\<not> P y (\<sigma> v. F v)"
        hence "\<exists>v. P v y \<and> \<not> O v (\<sigma> v. F v)"
          by (rule strong_supplementation)
        then obtain v where v: "P v y \<and> \<not> O v (\<sigma> v. F v)"..
        hence "\<not> O v (\<sigma> v. F v)"..
        from right have "P v y \<longrightarrow> (\<exists>w. F w \<and> O v w)"..
        moreover from v have "P v y"..
        ultimately have "\<exists>w. F w \<and> O v w"..
        from F have "O v (\<sigma> v. F v) \<longleftrightarrow> (\<exists>x. F x \<and> O v x)"..
        hence "O v (\<sigma> v. F v)" using \<open>\<exists>w. F w \<and> O v w\<close>..
        with \<open>\<not> O v (\<sigma> v. F v)\<close> show "False"..
      qed
    qed
  qed
qed

lemma fusion_part: "F x \<Longrightarrow> P x (\<sigma> x. F x)"
proof -
  assume "F x"
  hence "\<exists>x. F x"..
  hence "\<forall>y. P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v))"
    by (rule fusion_part_character)
  hence "P x (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w x \<longrightarrow> (\<exists>v. F v \<and> O w v))"..
  moreover have "\<forall>w. P w x \<longrightarrow> (\<exists>v. F v \<and> O w v)"
  proof
    fix w
    show "P w x \<longrightarrow> (\<exists>v. F v \<and> O w v)"
    proof
      assume "P w x"
      hence "O w x" by (rule part_implies_overlap)
      with \<open>F x\<close> have "F x \<and> O w x"..
      thus "\<exists>v. F v \<and> O w v"..
    qed
  qed
  ultimately show "P x (\<sigma> v. F v)"..
qed

lemma common_part_fusion:
  "O x y \<Longrightarrow> (\<forall>w. P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow> (P w x \<and> P w y))"
proof -
  assume "O x y"
  with overlap_eq have "\<exists>z. (P z x \<and> P z y)"..
  hence sum: "(\<forall>w. P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow>
    (\<forall>z. P z w \<longrightarrow> (\<exists>v. (P v x \<and> P v y) \<and> O z v)))"
    by (rule fusion_part_character)
  show "\<forall>w. P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow> (P w x \<and> P w y)"
  proof
    fix w
    from sum have w: "P w (\<sigma> v. (P v x \<and> P v y))
      \<longleftrightarrow> (\<forall>z. P z w \<longrightarrow> (\<exists>v. (P v x \<and> P v y) \<and> O z v))"..
    show "P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow> (P w x \<and> P w y)"
    proof
      assume "P w (\<sigma> v. (P v x \<and> P v y))"
      with w have bla:
        "(\<forall>z. P z w \<longrightarrow> (\<exists>v. (P v x \<and> P v y) \<and> O z v))"..
      show "P w x \<and> P w y"
      proof
        show "P w x"
        proof (rule ccontr)
          assume "\<not> P w x"
          hence "\<exists>z. P z w \<and> \<not> O z x"
            by (rule strong_supplementation)
          then obtain z where z: "P z w \<and> \<not> O z x"..
          hence "\<not> O z x"..
          from bla have "P z w \<longrightarrow> (\<exists>v. (P v x \<and> P v y) \<and> O z v)"..
          moreover from z have "P z w"..
          ultimately have "\<exists>v. (P v x \<and> P v y) \<and> O z v"..
          then obtain v where v: "(P v x \<and> P v y) \<and> O z v"..
          hence "P v x \<and> P v y"..
          hence "P v x"..
          moreover from v have "O z v"..
          ultimately have "O z x"
            by (rule overlap_monotonicity)
          with \<open>\<not> O z x\<close> show "False"..
        qed
        show "P w y"
        proof (rule ccontr)
          assume "\<not> P w y"
          hence "\<exists>z. P z w \<and> \<not> O z y"
            by (rule strong_supplementation)
          then obtain z where z: "P z w \<and> \<not> O z y"..
          hence "\<not> O z y"..
          from bla have "P z w \<longrightarrow> (\<exists>v. (P v x \<and> P v y) \<and> O z v)"..
          moreover from z have "P z w"..
          ultimately have "\<exists>v. (P v x \<and> P v y) \<and> O z v"..
          then obtain v where v: "(P v x \<and> P v y) \<and> O z v"..
          hence "P v x \<and> P v y"..
          hence "P v y"..
          moreover from v have "O z v"..
          ultimately have "O z y"
            by (rule overlap_monotonicity)
          with \<open>\<not> O z y\<close> show "False"..
        qed
      qed
    next
      assume "P w x \<and> P w y"
      thus "P w (\<sigma> v. (P v x \<and> P v y))"
        by (rule fusion_part)
    qed
  qed
qed

theorem product_closure:
  "O x y \<Longrightarrow> (\<exists>z. \<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y))"
proof -
  assume "O x y"
  hence "(\<forall>w. P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow> (P w x \<and> P w y))"
    by (rule common_part_fusion)
  thus "\<exists>z. \<forall>w. P w z \<longleftrightarrow> (P w x \<and> P w y)"..
qed

end

sublocale GEM \<subseteq> CEM
proof
  fix x y
  show "\<exists>z. \<forall>w. O w z = (O w x \<or> O w y)"
    using sum_closure.
  show "x \<oplus> y = (THE z. \<forall>v. O v z \<longleftrightarrow> O v x \<or> O v y)"
    using sum_eq.
  show "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
    using product_eq.
  show "O x y \<Longrightarrow> (\<exists>z. \<forall>w. P w z = (P w x \<and> P w y))"
    using product_closure.
qed

context GEM
begin

corollary "O x y \<Longrightarrow> x \<otimes> y = (\<sigma> v. P v x \<and> P v y)"
proof -
  assume "O x y"
  hence "(\<forall>w. P w (\<sigma> v. (P v x \<and> P v y)) \<longleftrightarrow> (P w x \<and> P w y))"
    by (rule common_part_fusion)
  thus "x \<otimes> y = (\<sigma> v. P v x \<and> P v y)" by (rule product_intro)
qed

lemma disjoint_fusion:
  "\<exists>w. \<not> O w x \<Longrightarrow> (\<forall>w. P w (\<sigma> z. \<not> O z x) \<longleftrightarrow> \<not> O w x)"
proof -
  assume antecedent: "\<exists>w. \<not> O w x"
  hence "\<forall>y. O y (\<sigma> v. \<not> O v x) \<longleftrightarrow> (\<exists>v. \<not> O v x \<and> O y v)"
    by (rule fusion_character)
  hence x: "O x (\<sigma> v. \<not> O v x) \<longleftrightarrow> (\<exists>v. \<not> O v x \<and> O x v)"..
  show "\<forall>w. P w (\<sigma> z. \<not> O z x) \<longleftrightarrow> \<not> O w x"
  proof
    fix y
    show "P y (\<sigma> z. \<not> O z x) \<longleftrightarrow> \<not> O y x"
    proof
      assume "P y (\<sigma> z. \<not> O z x)"
      moreover have "\<not> O x (\<sigma> z. \<not> O z x)"
      proof
        assume "O x (\<sigma> z. \<not> O z x)"
        with x have "(\<exists>v. \<not> O v x \<and> O x v)"..
        then obtain v where v: "\<not> O v x \<and> O x v"..
        hence "\<not> O v x"..
        from v have "O x v"..
        hence "O v x" by (rule overlap_symmetry)
        with \<open>\<not> O v x\<close> show "False"..
      qed
      ultimately have "\<not> O x y"
        by (rule disjoint_demonotonicity)
      thus "\<not> O y x" by (rule disjoint_symmetry)
    next
      assume "\<not> O y x"
      thus "P y (\<sigma> v. \<not> O v x)"
        by (rule fusion_part)
    qed
  qed
qed

theorem complement_closure:
  "\<exists>w. \<not> O w x \<Longrightarrow> (\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
proof -
  assume "(\<exists>w. \<not> O w x)"
  hence "\<forall>w. P w (\<sigma> z. \<not> O z x) \<longleftrightarrow> \<not> O w x"
    by (rule disjoint_fusion)
  thus "\<exists>z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x"..
qed

end

sublocale GEM \<subseteq> CEMC
proof
  fix x y
  show "\<midarrow> x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
    using complement_eq.
  show "(\<exists>w. \<not> O w x) \<Longrightarrow> (\<exists>z. \<forall>w. P w z = (\<not> O w x))"
    using complement_closure.
  show "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_eq.
  show "u = (THE x. \<forall>y. P y x)"
    using universe_eq.
qed

context GEM
begin

corollary complement_is_disjoint_fusion:
  "\<exists>w. \<not> O w x \<Longrightarrow> \<midarrow> x = (\<sigma> z. \<not> O z x)"
proof -
  assume "\<exists>w. \<not> O w x"
  hence "\<forall>w. P w (\<sigma> z. \<not> O z x) \<longleftrightarrow> \<not> O w x"
    by (rule disjoint_fusion)
  thus "\<midarrow> x = (\<sigma> z. \<not> O z x)"
    by (rule complement_intro)
qed

theorem strong_fusion: "\<exists>x. F x \<Longrightarrow>
  \<exists>x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
proof -
  assume "\<exists>x. F x"
  have "(\<forall>y. F y \<longrightarrow> P y (\<sigma> v. F v)) \<and>
     (\<forall>y. P y (\<sigma> v. F v) \<longrightarrow> (\<exists>z. F z \<and> O y z))"
  proof
    show "\<forall>y. F y \<longrightarrow> P y (\<sigma> v. F v)"
    proof
      fix y
      show "F y \<longrightarrow> P y (\<sigma> v. F v)"
      proof
        assume "F y"
        thus "P y (\<sigma> v. F v)"
          by (rule fusion_part)
      qed
    qed
  next
    have "(\<forall>y. P y (\<sigma> v. F v) \<longleftrightarrow>
      (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)))"
      using \<open>\<exists>x. F x\<close> by (rule fusion_part_character)
    hence "P (\<sigma> v. F v) (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w (\<sigma> v. F v) \<longrightarrow>
      (\<exists>v. F v \<and> O w v))"..
    thus "\<forall>w. P w (\<sigma> v. F v) \<longrightarrow> (\<exists>v. F v \<and> O w v)" using part_reflexivity..
  qed
  thus ?thesis..
qed

theorem strong_fusion_eq: "\<exists>x. F x \<Longrightarrow> (\<sigma> x. F x) =
  (THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))"
proof -
  assume "\<exists>x. F x"
  have "(THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))) = (\<sigma> x. F x)"
  proof (rule the_equality)
    show "(\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)) \<and> (\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z))"
    proof
      show "\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)"
      proof
        fix y
        show "F y \<longrightarrow> P y (\<sigma> x. F x)"
        proof
          assume "F y"
          thus "P y (\<sigma> x. F x)"
            by (rule fusion_part)
        qed
      qed
    next
      show "(\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z))"
      proof
        fix y
        show "P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z)"
        proof
          have  "\<forall>y. P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v))"
            using \<open>\<exists>x. F x\<close> by (rule fusion_part_character)
          hence "P y (\<sigma> v. F v) \<longleftrightarrow> (\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v))"..
          moreover assume "P y (\<sigma> x. F x)"
          ultimately have "\<forall>w. P w y \<longrightarrow> (\<exists>v. F v \<and> O w v)"..
          hence "P y y \<longrightarrow> (\<exists>v. F v \<and> O y v)"..
          thus "\<exists>v. F v \<and> O y v" using part_reflexivity..
        qed
      qed
    qed
  next
    fix x
    assume x: "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
    have "\<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z)"
    proof
      fix y
      show "O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z)"
      proof
        assume "O y x"
        with overlap_eq have "\<exists>v. P v y \<and> P v x"..
        then obtain v where v: "P v y \<and> P v x"..
        from x have "\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)"..
        hence "P v x \<longrightarrow> (\<exists>z. F z \<and> O v z)"..
        moreover from v have "P v x"..
        ultimately have "\<exists>z. F z \<and> O v z"..
        then obtain z where z: "F z \<and> O v z"..
        hence "F z"..
        from v have "P v y"..
        moreover from z have "O v z"..
        hence "O z v" by (rule overlap_symmetry)
        ultimately have "O z y" by (rule overlap_monotonicity)
        hence "O y z" by (rule overlap_symmetry)
        with \<open>F z\<close> have "F z \<and> O y z"..
        thus "\<exists>z. F z \<and> O y z"..
      next
        assume "\<exists>z. F z \<and> O y z"
        then obtain z where z: "F z \<and> O y z"..
        from x have "\<forall>y. F y \<longrightarrow> P y x"..
        hence "F z \<longrightarrow> P z x"..
        moreover from z have "F z"..
        ultimately have "P z x"..
        moreover from z have "O y z"..
        ultimately show "O y x"
          by (rule overlap_monotonicity)
      qed
    qed
    hence "(\<sigma> x. F x) = x"
      by (rule fusion_intro)
    thus "x = (\<sigma> x. F x)"..
  qed
  thus ?thesis..
qed

lemma strong_sum_eq: "x \<oplus> y = (THE z. (P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y))"
proof -
  have "(THE z. (P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)) = x \<oplus> y"
  proof (rule the_equality)
    show "(P x (x \<oplus> y) \<and> P y (x \<oplus> y)) \<and> (\<forall>w. P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y)"
    proof
      show "P x (x \<oplus> y) \<and> P y (x \<oplus> y)"
        proof
          show "P x (x \<oplus> y)" using first_summand_in_sum.
          show "P y (x \<oplus> y)" using second_summand_in_sum.
        qed
      show "\<forall>w. P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y"
      proof
        fix w
        show "P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y"
        proof
          assume "P w (x \<oplus> y)"
          hence "O w (x \<oplus> y)" by (rule part_implies_overlap)
          with sum_overlap show "O w x \<or> O w y"..
        qed
      qed
    qed
    fix z
    assume z: "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
    hence "P x z \<and> P y z"..
    have "\<forall>w. O w z \<longleftrightarrow> (O w x \<or> O w y)"
    proof
      fix w
      show "O w z \<longleftrightarrow> (O w x \<or> O w y)"
      proof
        assume "O w z"
        with overlap_eq have "\<exists>v. P v w \<and> P v z"..
        then obtain v where v: "P v w \<and> P v z"..
        hence "P v w"..
        from z have "\<forall>w. P w z \<longrightarrow> O w x \<or> O w y"..
        hence "P v z \<longrightarrow> O v x \<or> O v y"..
        moreover from v have "P v z"..
        ultimately have "O v x \<or> O v y"..
        thus "O w x \<or> O w y"
        proof
          assume "O v x"
          hence "O x v" by (rule overlap_symmetry)
          with \<open>P v w\<close> have "O x w" by (rule overlap_monotonicity)
          hence "O w x" by (rule overlap_symmetry)
          thus "O w x \<or> O w y"..
        next
          assume "O v y"
          hence "O y v" by (rule overlap_symmetry)
          with \<open>P v w\<close> have "O y w" by (rule overlap_monotonicity)
          hence "O w y" by (rule overlap_symmetry)
          thus "O w x \<or> O w y"..
        qed
      next
        assume "O w x \<or> O w y"
        thus "O w z"
        proof
          from \<open>P x z \<and> P y z\<close> have "P x z"..
          moreover assume "O w x"
          ultimately show "O w z"
            by (rule overlap_monotonicity)
        next
          from \<open>P x z \<and> P y z\<close> have "P y z"..
          moreover assume "O w y"
          ultimately show "O w z"
            by (rule overlap_monotonicity)
        qed
      qed
    qed
    hence "x \<oplus> y = z" by (rule sum_intro)
    thus "z = x \<oplus> y"..
  qed
  thus ?thesis..
qed

subsection \<open> General Products \<close>

lemma general_product_intro: "(\<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z)) \<Longrightarrow> (\<pi> x. F x) = x"
proof -
  assume "\<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z)"
  hence "(\<sigma> x. \<forall>y. F y \<longrightarrow> P x y) = x" by (rule fusion_intro)
  with general_product_eq show "(\<pi> x. F x) = x" by (rule ssubst)
qed

lemma general_product_idempotence: "(\<pi> z. z = x) = x"
proof -
  have "\<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. y = x \<longrightarrow> P z y) \<and> O y z)"
    by (meson overlap_eq part_reflexivity part_transitivity)
  thus "(\<pi> z. z = x) = x" by (rule general_product_intro)
qed

lemma general_product_absorption: "(\<pi> z. P x z) = x"
proof -
  have "\<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. P x y \<longrightarrow> P z y) \<and> O y z)"
    by (meson overlap_eq part_reflexivity part_transitivity)
  thus "(\<pi> z. P x z) = x" by (rule general_product_intro)
qed

lemma general_product_character: "\<exists>z. \<forall>y. F y \<longrightarrow> P z y \<Longrightarrow>
  \<forall>y. O y (\<pi> x. F x) \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z)"
proof -
  assume "(\<exists>z. \<forall>y. F y \<longrightarrow> P z y)"
  hence "(\<exists>x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z))"
    by (rule fusion)
  then obtain x where x:
    "\<forall>y. O y x \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z)"..
  hence "(\<pi> x. F x) = x" by (rule general_product_intro)
  thus "(\<forall>y. O y (\<pi> x. F x) \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z))"
    using x by (rule ssubst)
qed

corollary "\<not> (\<exists>x. F x) \<Longrightarrow> u = (\<pi> x. F x)"
proof -
  assume antecedent: "\<not> (\<exists>x. F x)"
  have "\<forall>y. P y (\<pi> x. F x)"
  proof
    fix y
    show "P y (\<pi> x. F x)"
    proof (rule ccontr)
      assume "\<not> P y (\<pi> x. F x)"
     hence "\<exists>z. P z y \<and> \<not> O z (\<pi> x. F x)" by (rule strong_supplementation)
      then obtain z where z: "P z y \<and> \<not> O z (\<pi> x. F x)"..
      hence "\<not> O z (\<pi> x. F x)"..
      from antecedent have bla: "\<forall> y. F y \<longrightarrow> P z y" by simp
      hence "\<exists> v. \<forall> y. F y \<longrightarrow> P v y"..
      hence "(\<forall>y. O y (\<pi> x. F x) \<longleftrightarrow> (\<exists>z. (\<forall>y. F y \<longrightarrow> P z y) \<and> O y z))" by (rule general_product_character)
      hence "O z (\<pi> x. F x) \<longleftrightarrow> (\<exists>v. (\<forall>y. F y \<longrightarrow> P v y) \<and> O z v)"..
      moreover from bla have  "(\<forall> y. F y \<longrightarrow> P z y) \<and> O z z"
        using overlap_reflexivity..
      hence "\<exists> v. (\<forall> y. F y \<longrightarrow> P v y) \<and> O z v"..
      ultimately have "O z (\<pi> x. F x)"..
      with \<open>\<not> O z (\<pi> x. F x)\<close> show "False"..
    qed
  qed
  thus "u = (\<pi> x. F x)"
    by (rule universe_intro)
qed

end

subsection \<open> Strong Fusion \<close>

text \<open> An alternative axiomatization of general extensional mereology adds a stronger version of the
fusion axiom to minimal mereology, with correspondingly stronger definitions of sums and general
sums.\footnote{See \<^cite>\<open>"tarski_foundations_1983"\<close> p. 25. The proofs in this section are adapted
from \<^cite>\<open>"hovda_what_2009"\<close>.} \<close>

locale GEM1 = MM +
  assumes strong_fusion: "\<exists>x. F x \<Longrightarrow> \<exists>x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
  assumes strong_sum_eq: "x \<oplus> y = (THE z. (P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y))"
  assumes product_eq:
    "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
  assumes difference_eq:
    "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
  assumes complement_eq: "\<midarrow> x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
  assumes universe_eq: "u = (THE x. \<forall>y. P y x)"
  assumes strong_fusion_eq:  "\<exists>x. F x \<Longrightarrow> (\<sigma> x. F x) = (THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))"
  assumes general_product_eq: "(\<pi> x. F x) = (\<sigma> x. \<forall>y. F y \<longrightarrow> P x y)"
begin

theorem fusion:
  "\<exists>x. \<phi> x \<Longrightarrow> (\<exists>z. \<forall>y. O y z \<longleftrightarrow> (\<exists>x. \<phi> x \<and> O y x))"
proof -
  assume "\<exists>x. \<phi> x"
  hence "\<exists>x. (\<forall>y. \<phi> y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. \<phi> z \<and> O y z))" by (rule strong_fusion)
  then obtain x where x:
    "(\<forall>y. \<phi> y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. \<phi> z \<and> O y z))"..
  have "\<forall>y. O y x \<longleftrightarrow> (\<exists>v. \<phi> v \<and> O y v)"
  proof
    fix y
    show "O y x \<longleftrightarrow> (\<exists>v. \<phi> v \<and> O y v)"
    proof
      assume "O y x"
      with overlap_eq have "\<exists>z. P z y \<and> P z x"..
      then obtain z where z: "P z y \<and> P z x"..
      hence "P z x"..
      from x have "\<forall>y. P y x \<longrightarrow> (\<exists>v. \<phi> v \<and> O y v)"..
      hence "P z x \<longrightarrow> (\<exists>v. \<phi> v \<and> O z v)"..
      hence "\<exists>v. \<phi> v \<and> O z v" using \<open>P z x\<close>..
      then obtain v where v: "\<phi> v \<and> O z v"..
      hence "O z v"..
      with overlap_eq have "\<exists>w. P w z \<and> P w v"..
      then obtain w where w: "P w z \<and> P w v"..
      hence "P w z"..
      moreover from z have "P z y"..
      ultimately have "P w y"
        by (rule part_transitivity)
      moreover from w have "P w v"..
      ultimately have "P w y \<and> P w v"..
      hence "\<exists>w. P w y \<and> P w v"..
      with overlap_eq have "O y v"..
      from v have "\<phi> v"..
      hence "\<phi> v \<and> O y v" using \<open>O y v\<close>..
      thus "\<exists>v. \<phi> v \<and> O y v"..
    next
      assume "\<exists>v. \<phi> v \<and> O y v"
      then obtain v where v: "\<phi> v \<and> O y v"..
      hence "O y v"..
      with overlap_eq have "\<exists>z. P z y \<and> P z v"..
      then obtain z where z: "P z y \<and> P z v"..
      hence "P z v"..
      from x have "\<forall>y. \<phi> y \<longrightarrow> P y x"..
      hence "\<phi> v \<longrightarrow> P v x"..
      moreover from v have "\<phi> v"..
      ultimately have "P v x"..
      with \<open>P z v\<close> have "P z x"
        by (rule part_transitivity)
      from z have "P z y"..
      thus "O y x" using \<open>P z x\<close>
        by (rule overlap_intro)
    qed
  qed
  thus "(\<exists>z. \<forall>y. O y z \<longleftrightarrow> (\<exists>x. \<phi> x \<and> O y x))"..
qed

lemma pair: "\<exists>v. (\<forall>w. (w = x \<or> w = y) \<longrightarrow> P w v) \<and> (\<forall>w. P w v \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O w z))"
proof -
  have "x = x"..
  hence "x = x \<or> x = y"..
  hence "\<exists>v. v = x \<or> v = y"..
  thus ?thesis
    by (rule strong_fusion)
qed

lemma or_id: "(v = x \<or> v = y) \<and> O w v \<Longrightarrow> O w x \<or> O w y"
proof -
  assume v: "(v = x \<or> v = y) \<and> O w v"
  hence "O w v"..
  from v have "v = x \<or> v = y"..
  thus "O w x \<or> O w y"
  proof
    assume "v = x"
    hence "O w x" using \<open>O w v\<close> by (rule subst)
    thus "O w x \<or> O w y"..
  next
    assume "v = y"
    hence "O w y" using \<open>O w v\<close> by (rule subst)
    thus "O w x \<or> O w y"..
  qed
qed

lemma strong_sum_closure:
  "\<exists>z. (P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
proof -
  from pair obtain z where z: "(\<forall>w. (w = x \<or> w = y) \<longrightarrow> P w z) \<and> (\<forall>w. P w z \<longrightarrow> (\<exists>v. (v = x \<or> v = y) \<and> O w v))"..
  have "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
  proof
    from z have allw: "\<forall>w. (w = x \<or> w = y) \<longrightarrow> P w z"..
    hence "x = x \<or> x = y \<longrightarrow> P x z"..
    moreover have "x = x \<or> x = y" using refl..
    ultimately have "P x z"..
    from allw have "y = x \<or> y = y \<longrightarrow> P y z"..
    moreover have "y = x \<or> y = y" using refl..
    ultimately have "P y z"..
    with \<open>P x z\<close> show "P x z \<and> P y z"..
  next
    show "\<forall>w. P w z \<longrightarrow> O w x \<or> O w y"
    proof
      fix w
      show "P w z \<longrightarrow> O w x \<or> O w y"
      proof
        assume "P w z"
        from z have "\<forall>w. P w z \<longrightarrow> (\<exists>v. (v = x \<or> v = y) \<and> O w v)"..
        hence "P w z \<longrightarrow> (\<exists>v. (v = x \<or> v = y) \<and> O w v)"..
        hence "\<exists>v. (v = x \<or> v = y) \<and> O w v" using \<open>P w z\<close>..
        then obtain v where v: "(v = x \<or> v = y) \<and> O w v"..
        thus "O w x \<or> O w y" by (rule or_id)
      qed
    qed
  qed
  thus ?thesis..
qed

end

sublocale GEM1 \<subseteq> GMM
proof
  fix x y \<phi>
  show "(\<exists>x. \<phi> x) \<Longrightarrow> (\<exists>z. \<forall>y. O y z \<longleftrightarrow> (\<exists>x. \<phi> x \<and> O y x))" using fusion.
qed

context GEM1
begin

lemma least_upper_bound:
  assumes sf:
    "((\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))"
  shows lub:
      "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P x z)"
proof
 from sf show "\<forall>y. F y \<longrightarrow> P y x"..
next
 show "(\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P x z)"
 proof
  fix z
  show "(\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P x z"
  proof
   assume z: "\<forall>y. F y \<longrightarrow> P y z"
   from pair obtain v where v: "(\<forall>w. (w = x \<or> w = z) \<longrightarrow> P w v) \<and> (\<forall>w. P w v \<longrightarrow> (\<exists>y. (y = x \<or> y = z) \<and> O w y))"..
   hence left: "(\<forall>w. (w = x \<or> w = z) \<longrightarrow> P w v)"..
   hence "(x = x \<or> x = z) \<longrightarrow> P x v"..
   moreover have "x = x \<or> x = z" using refl..
   ultimately have "P x v"..
   have "z = v"
   proof (rule ccontr)
    assume "z \<noteq> v"
    from left have "z = x \<or> z = z \<longrightarrow> P z v"..
    moreover have "z = x \<or> z = z" using refl..
    ultimately have "P z v"..
    hence "P z v \<and> z \<noteq> v" using \<open>z \<noteq> v\<close>..
    with nip_eq have "PP z v"..
    hence "\<exists>w. P w v \<and> \<not> O w z" by (rule weak_supplementation)
    then obtain w where w: "P w v \<and> \<not> O w z"..
    hence "P w v"..
    from v have right:
      "\<forall>w. P w v \<longrightarrow> (\<exists>y. (y = x \<or> y = z) \<and> O w y)"..
    hence "P w v \<longrightarrow> (\<exists>y. (y = x \<or> y = z) \<and> O w y)"..
    hence "\<exists>y. (y = x \<or> y = z) \<and> O w y" using \<open>P w v\<close>..
    then obtain s where s: "(s = x \<or> s = z) \<and> O w s"..
    hence "s = x \<or> s = z"..
    thus "False"
    proof
     assume "s = x"
     moreover from s have "O w s"..
     ultimately have "O w x" by (rule subst)
     with overlap_eq have "\<exists>t. P t w \<and> P t x"..
     then obtain t where t: "P t w \<and> P t x"..
     hence "P t x"..
     from sf have "(\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"..
     hence "P t x \<longrightarrow> (\<exists>z. F z \<and> O t z)"..
     hence "\<exists>z. F z \<and> O t z" using \<open>P t x\<close>..
     then obtain a where a: "F a \<and> O t a"..
     hence "F a"..
     from sf have ub: "\<forall>y. F y \<longrightarrow> P y x"..
     hence "F a \<longrightarrow> P a x"..
     hence "P a x" using \<open>F a\<close>..
     moreover from a have "O t a"..
     ultimately have "O t x"
      by (rule overlap_monotonicity)
     from t have "P t w"..
     moreover have "O z t"
     proof -
      from z have "F a \<longrightarrow> P a z"..
      moreover from a have "F a"..
      ultimately have "P a z"..
      moreover from a have "O t a"..
      ultimately have "O t z"
       by (rule overlap_monotonicity)
      thus "O z t" by (rule overlap_symmetry)
     qed
     ultimately have "O z w"
      by (rule overlap_monotonicity)
     hence "O w z" by (rule overlap_symmetry)
     from w have "\<not> O w z"..
     thus "False" using \<open>O w z\<close>..
    next
     assume "s = z"
     moreover from s have "O w s"..
     ultimately have "O w z" by (rule subst)
     from w have "\<not> O w z"..
     thus "False" using \<open>O w z\<close>..
    qed
   qed
   thus "P x z" using \<open>P x v\<close> by (rule ssubst)
  qed
 qed
qed

corollary strong_fusion_intro:  "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)) \<Longrightarrow> (\<sigma> x. F x) = x"
proof -
  assume antecedent: "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
  with least_upper_bound have lubx:
    "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P x z)".
  from antecedent have "\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)"..
  hence "P x x \<longrightarrow> (\<exists>z. F z \<and> O x z)"..
  hence "\<exists>z. F z \<and> O x z" using part_reflexivity..
  then obtain z where z: "F z \<and> O x z"..
  hence "F z"..
  hence "\<exists>z. F z"..
  hence "(\<sigma> x. F x) = (THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))" by (rule strong_fusion_eq)
  moreover have "(THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))) = x"
  proof (rule the_equality)
    show "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
      using antecedent.
  next
    fix w
    assume w:
      "(\<forall>y. F y \<longrightarrow> P y w) \<and> (\<forall>y. P y w \<longrightarrow> (\<exists>z. F z \<and> O y z))"
    with least_upper_bound have lubw:
      "(\<forall>y. F y \<longrightarrow> P y w) \<and> (\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P w z)".
    hence "(\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P w z)"..
    hence "(\<forall>y. F y \<longrightarrow> P y x) \<longrightarrow> P w x"..
    moreover from antecedent have "\<forall>y. F y \<longrightarrow> P y x"..
    ultimately have "P w x"..
    from lubx have "(\<forall>z. (\<forall>y. F y \<longrightarrow> P y z) \<longrightarrow> P x z)"..
    hence "(\<forall>y. F y \<longrightarrow> P y w) \<longrightarrow> P x w"..
    moreover from lubw have "(\<forall>y. F y \<longrightarrow> P y w)"..
    ultimately have "P x w"..
    with \<open>P w x\<close> show "w = x"
      by (rule part_antisymmetry)
  qed
  ultimately show "(\<sigma> x. F x) = x" by (rule ssubst)
qed

lemma strong_fusion_character: "\<exists>x. F x \<Longrightarrow> ((\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)) \<and> (\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z)))"
proof -
  assume "\<exists>x. F x"
  hence "(\<exists>x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))" by (rule strong_fusion)
  then obtain x where x:
    "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"..
  hence "(\<sigma> x. F x) = x" by (rule strong_fusion_intro)
  thus ?thesis using x by (rule ssubst)
qed

lemma F_in: "\<exists>x. F x \<Longrightarrow> (\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x))"
proof -
  assume "\<exists>x. F x"
  hence "((\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)) \<and> (\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z)))" by (rule strong_fusion_character)
 thus "\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)"..
qed

lemma parts_overlap_Fs:
  "\<exists>x. F x \<Longrightarrow> (\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z))"
proof -
  assume "\<exists>x. F x"
  hence "((\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x)) \<and> (\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z)))" by (rule strong_fusion_character)
  thus "(\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z))"..
qed

lemma in_strong_fusion: "P z (\<sigma> x. z = x)"
proof -
  have "\<exists>y. z = y" using refl..
  hence "\<forall>y. z = y \<longrightarrow> P y (\<sigma> x. z = x)"
    by (rule F_in)
  hence "z = z \<longrightarrow> P z (\<sigma> x. z = x)"..
  thus "P z (\<sigma> x. z = x)" using refl..
qed

lemma strong_fusion_in: "P (\<sigma> x. z = x) z"
proof -
  have "\<exists>y. z = y" using refl..
  hence sf:
    "(\<forall>y. z = y \<longrightarrow> P y (\<sigma> x. z = x)) \<and> (\<forall>y. P y (\<sigma> x. z = x) \<longrightarrow> (\<exists>v. z = v \<and> O y v))"
    by (rule strong_fusion_character)
  with least_upper_bound have lub: "(\<forall>y. z = y \<longrightarrow> P y (\<sigma> x. z = x)) \<and> (\<forall>v. (\<forall>y. z = y \<longrightarrow> P y v) \<longrightarrow> P (\<sigma> x. z = x) v)".
  hence "(\<forall>v. (\<forall>y. z = y \<longrightarrow> P y v) \<longrightarrow> P (\<sigma> x. z = x) v)"..
  hence "(\<forall>y. z = y \<longrightarrow> P y z) \<longrightarrow> P (\<sigma> x. z = x) z"..
  moreover have "(\<forall>y. z = y \<longrightarrow> P y z)"
  proof
    fix y
    show "z = y \<longrightarrow> P y z"
    proof
      assume "z = y"
      thus "P y z" using part_reflexivity by (rule subst)
    qed
  qed
  ultimately show "P (\<sigma> x. z = x) z"..
qed

lemma strong_fusion_idempotence: "(\<sigma> x. z = x) = z"
 using strong_fusion_in in_strong_fusion by (rule part_antisymmetry)

subsection \<open> Strong Sums \<close>

lemma pair_fusion: "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y) \<longrightarrow> (\<sigma> z. z = x \<or> z = y) = z"
proof
 assume z: "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
  have "(\<forall>v. v = x \<or> v = y \<longrightarrow> P v z) \<and> (\<forall>v. P v z \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O v z))"
 proof
  show "\<forall>v. v = x \<or> v = y \<longrightarrow> P v z"
  proof
   fix w
   from z have "P x z \<and> P y z"..
   show "w = x \<or> w = y \<longrightarrow> P w z"
   proof
    assume "w = x \<or> w = y"
    thus "P w z"
    proof
     assume "w = x"
     moreover from \<open>P x z \<and> P y z\<close> have "P x z"..
     ultimately show "P w z" by (rule ssubst)
    next
     assume "w = y"
     moreover from \<open>P x z \<and> P y z\<close> have "P y z"..
     ultimately show "P w z" by (rule ssubst)
    qed
   qed
  qed
  show "\<forall>v. P v z \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O v z)"
  proof
   fix v
   show "P v z \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O v z)"
   proof
    assume "P v z"
    from z have "\<forall>w. P w z \<longrightarrow> O w x \<or> O w y"..
    hence "P v z \<longrightarrow> O v x \<or> O v y"..
    hence "O v x \<or> O v y" using \<open>P v z\<close>..
    thus "\<exists>z. (z = x \<or> z = y) \<and> O v z"
    proof
     assume "O v x"
     have "x = x \<or> x = y" using refl..
     hence "(x = x \<or> x = y) \<and> O v x" using \<open>O v x\<close>..
     thus "\<exists>z. (z = x \<or> z = y) \<and> O v z"..
    next
     assume "O v y"
     have "y = x \<or> y = y" using refl..
     hence "(y = x \<or> y = y) \<and> O v y" using \<open>O v y\<close>..
     thus "\<exists>z. (z = x \<or> z = y) \<and> O v z"..
    qed
   qed
  qed
 qed
  thus "(\<sigma> z. z = x \<or> z = y) = z"
    by (rule strong_fusion_intro)
qed

corollary strong_sum_fusion: "x \<oplus> y = (\<sigma> z. z = x \<or> z = y)"
proof -
  have "(THE z. (P x z \<and> P y z) \<and>
    (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)) = (\<sigma> z. z = x \<or> z = y)"
  proof (rule the_equality)
    have "x = x \<or> x = y" using refl..
    hence exz: "\<exists>z. z = x \<or> z = y"..
    hence allw: "(\<forall>w. w = x \<or> w = y \<longrightarrow> P w (\<sigma> z. z = x \<or> z = y))"
      by (rule F_in)
    show "(P x (\<sigma> z. z = x \<or> z = y) \<and> P y (\<sigma> z. z = x \<or> z = y)) \<and>
      (\<forall>w. P w (\<sigma> z. z = x \<or> z = y) \<longrightarrow> O w x \<or> O w y)"
    proof
      show "(P x (\<sigma> z. z = x \<or> z = y) \<and> P y (\<sigma> z. z = x \<or> z = y))"
      proof
        from allw have "x = x \<or> x = y \<longrightarrow> P x (\<sigma> z. z = x \<or> z = y)"..
        thus "P x (\<sigma> z. z = x \<or> z = y)"
          using \<open>x = x \<or> x = y\<close>..
      next
        from allw have "y = x \<or> y = y \<longrightarrow> P y (\<sigma> z. z = x \<or> z = y)"..
        moreover have "y = x \<or> y = y"
          using refl..
        ultimately show "P y (\<sigma> z. z = x \<or> z = y)"..
      qed
    next
      show "\<forall>w. P w (\<sigma> z. z = x \<or> z = y) \<longrightarrow> O w x \<or> O w y"
      proof
        fix w
        show "P w (\<sigma> z. z = x \<or> z = y) \<longrightarrow> O w x \<or> O w y"
        proof
          have "\<forall>v. P v (\<sigma> z. z = x \<or> z = y) \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O v z)" using exz by (rule parts_overlap_Fs)
          hence "P w (\<sigma> z. z = x \<or> z = y) \<longrightarrow> (\<exists>z. (z = x \<or> z = y) \<and> O w z)"..
          moreover assume "P w (\<sigma> z. z = x \<or> z = y)"
          ultimately have "(\<exists>z. (z = x \<or> z = y) \<and> O w z)"..
          then obtain z where z: "(z = x \<or> z = y) \<and> O w z"..
          thus "O w x \<or> O w y" by (rule or_id)
        qed
      qed
    qed
  next
    fix z
    assume z: "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
    with pair_fusion have "(\<sigma> z. z = x \<or> z = y) = z"..
    thus "z = (\<sigma> z. z = x \<or> z = y)"..
  qed
  with strong_sum_eq show "x \<oplus> y = (\<sigma> z. z = x \<or> z = y)"
    by (rule ssubst)
qed

corollary strong_sum_intro:
  "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y) \<longrightarrow> x \<oplus> y = z"
proof
  assume z: "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
  with pair_fusion have "(\<sigma> z. z = x \<or> z = y) = z"..
  with strong_sum_fusion show "(x \<oplus> y) = z"
    by (rule ssubst)
qed

corollary strong_sum_character: "(P x (x \<oplus> y) \<and> P y (x \<oplus> y)) \<and> (\<forall>w. P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y)"
proof -
  from strong_sum_closure obtain z where z:
    "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"..
 with strong_sum_intro have "x \<oplus> y = z"..
 thus ?thesis using z by (rule ssubst)
qed

corollary summands_in: "(P x (x \<oplus> y) \<and> P y (x \<oplus> y))"
  using strong_sum_character..

corollary first_summand_in: "P x (x \<oplus> y)" using summands_in..

corollary second_summand_in: "P y (x \<oplus> y)" using summands_in..

corollary sum_part_overlap: "(\<forall>w. P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y)" using strong_sum_character..

lemma strong_sum_absorption: "y = (x \<oplus> y) \<Longrightarrow> P x y"
proof -
 assume "y = (x \<oplus> y)"
 thus "P x y" using first_summand_in by (rule ssubst)
qed

theorem strong_supplementation: "\<not> P x y \<Longrightarrow> (\<exists>z. P z x \<and> \<not> O z y)"
proof -
 assume "\<not> P x y"
 have "\<not> (\<forall>z. P z x \<longrightarrow> O z y)"
 proof
  assume z: "\<forall>z. P z x \<longrightarrow> O z y"
  have "(\<forall>v. y = v \<longrightarrow> P v (x \<oplus> y)) \<and>
    (\<forall>v. P v (x \<oplus> y) \<longrightarrow> (\<exists>z. y = z \<and> O v z))"
  proof
   show "\<forall>v. y = v \<longrightarrow> P v (x \<oplus> y)"
   proof
    fix v
    show "y = v \<longrightarrow> P v (x \<oplus> y)"
    proof
     assume "y = v"
     thus "P v (x \<oplus> y)"
       using second_summand_in by (rule subst)
    qed
   qed
   show "\<forall>v. P v (x \<oplus> y) \<longrightarrow> (\<exists>z. y = z \<and> O v z)"
   proof
    fix v
    show "P v (x \<oplus> y) \<longrightarrow> (\<exists>z. y = z \<and> O v z)"
    proof
     assume "P v (x \<oplus> y)"
     moreover from sum_part_overlap have
       "P v (x \<oplus> y) \<longrightarrow> O v x \<or> O v y"..
     ultimately have "O v x \<or> O v y" by (rule rev_mp)
     hence "O v y"
     proof
      assume "O v x"
      with overlap_eq have "\<exists>w. P w v \<and> P w x"..
      then obtain w where w: "P w v \<and> P w x"..
      from z have "P w x \<longrightarrow> O w y"..
      moreover from w have "P w x"..
      ultimately have "O w y"..
      with overlap_eq have "\<exists>t. P t w \<and> P t y"..
      then obtain t where t: "P t w \<and> P t y"..
      hence "P t w"..
      moreover from w have "P w v"..
      ultimately have "P t v"
        by (rule part_transitivity)
      moreover from t have "P t y"..
      ultimately show "O v y"
        by (rule overlap_intro)
     next
      assume "O v y"
      thus "O v y".
     qed
     with refl have "y = y \<and> O v y"..
     thus "\<exists>z. y = z \<and> O v z"..
    qed
   qed
  qed
  hence  "(\<sigma> z. y = z) = (x \<oplus> y)" by (rule strong_fusion_intro)
  with strong_fusion_idempotence have "y = x \<oplus> y" by (rule subst)
  hence "P x y" by (rule strong_sum_absorption)
  with \<open>\<not> P x y\<close> show "False"..
 qed
 thus "\<exists>z. P z x \<and> \<not> O z y" by simp
qed

lemma sum_character: "\<forall>v. O v (x \<oplus> y) \<longleftrightarrow> (O v x \<or> O v y)"
proof
  fix v
  show "O v (x \<oplus> y) \<longleftrightarrow> (O v x \<or> O v y)"
  proof
    assume "O v (x \<oplus> y)"
    with overlap_eq have "\<exists>w. P w v \<and> P w (x \<oplus> y)"..
    then obtain w where w: "P w v \<and> P w (x \<oplus> y)"..
    hence "P w v"..
    have "P w (x \<oplus> y) \<longrightarrow> O w x \<or> O w y" using sum_part_overlap..
    moreover from w have "P w (x \<oplus> y)"..
    ultimately have "O w x \<or> O w y"..
    thus "O v x \<or> O v y"
    proof
      assume "O w x"
      hence "O x w"
        by (rule overlap_symmetry)
      with \<open>P w v\<close> have "O x v"
        by (rule overlap_monotonicity)
      hence "O v x"
        by (rule overlap_symmetry)
      thus "O v x \<or> O v y"..
    next
      assume "O w y"
      hence "O y w"
        by (rule overlap_symmetry)
      with \<open>P w v\<close> have "O y v"
        by (rule overlap_monotonicity)
      hence "O v y" by (rule overlap_symmetry)
      thus "O v x \<or> O v y"..
    qed
  next
    assume "O v x \<or> O v y"
    thus "O v (x \<oplus> y)"
    proof
      assume "O v x"
      with overlap_eq have "\<exists>w. P w v \<and> P w x"..
      then obtain w where w: "P w v \<and> P w x"..
      hence "P w v"..
      moreover from w have "P w x"..
      hence "P w (x \<oplus> y)" using first_summand_in
        by (rule part_transitivity)
      ultimately show "O v (x \<oplus> y)"
        by (rule overlap_intro)
    next
      assume "O v y"
      with overlap_eq have "\<exists>w. P w v \<and> P w y"..
      then obtain w where w: "P w v \<and> P w y"..
      hence "P w v"..
      moreover from w have "P w y"..
      hence "P w (x \<oplus> y)" using second_summand_in
        by (rule part_transitivity)
      ultimately show "O v (x \<oplus> y)"
        by (rule overlap_intro)
    qed
  qed
qed

lemma sum_eq: "x \<oplus> y = (THE z. \<forall>v. O v z = (O v x \<or> O v y))"
proof -
  have "(THE z. \<forall>v. O v z \<longleftrightarrow> (O v x \<or> O v y)) = x \<oplus> y"
  proof (rule the_equality)
    show "\<forall>v. O v (x \<oplus> y) \<longleftrightarrow> (O v x \<or> O v y)" using sum_character.
  next
    fix z
    assume z: "\<forall>v. O v z \<longleftrightarrow> (O v x \<or> O v y)"
    have "(P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y)"
    proof
      show "P x z \<and> P y z"
      proof
        show "P x z"
        proof (rule ccontr)
          assume "\<not> P x z"
          hence "\<exists>v. P v x \<and> \<not> O v z"
            by (rule strong_supplementation)
          then obtain v where v: "P v x \<and> \<not> O v z"..
          hence "\<not> O v z"..
          from z have "O v z \<longleftrightarrow> (O v x \<or> O v y)"..
          moreover from v have "P v x"..
          hence "O v x" by (rule part_implies_overlap)
          hence "O v x \<or> O v y"..
          ultimately have "O v z"..
          with \<open>\<not> O v z\<close> show "False"..
        qed
      next
        show "P y z"
        proof (rule ccontr)
          assume "\<not> P y z"
          hence "\<exists>v. P v y \<and> \<not> O v z"
            by (rule strong_supplementation)
          then obtain v where v: "P v y \<and> \<not> O v z"..
          hence "\<not> O v z"..
          from z have "O v z \<longleftrightarrow> (O v x \<or> O v y)"..
          moreover from v have "P v y"..
          hence "O v y" by (rule part_implies_overlap)
          hence "O v x \<or> O v y"..
          ultimately have "O v z"..
          with \<open>\<not> O v z\<close> show "False"..
        qed
      qed
      show "\<forall>w. P w z \<longrightarrow> (O w x \<or> O w y)"
      proof
        fix w
        show "P w z \<longrightarrow> (O w x \<or> O w y)"
        proof
          from z have "O w z \<longleftrightarrow> O w x \<or> O w y"..
          moreover assume "P w z"
          hence "O w z" by (rule part_implies_overlap)
          ultimately show "O w x \<or> O w y"..
        qed
      qed
    qed
    with strong_sum_intro have "x \<oplus> y = z"..
    thus "z = x \<oplus> y"..
  qed
  thus ?thesis..
qed

theorem fusion_eq: "\<exists>x. F x \<Longrightarrow>
  (\<sigma> x. F x) = (THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z))"
proof -
  assume "\<exists>x. F x"
  hence bla: "\<forall>y. P y (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O y z)"
    by (rule parts_overlap_Fs)
  have "(THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z)) = (\<sigma> x. F x)"
  proof (rule the_equality)
    show "\<forall>y. O y (\<sigma> x. F x) \<longleftrightarrow> (\<exists>z. F z \<and> O y z)"
    proof
      fix y
      show "O y (\<sigma> x. F x) \<longleftrightarrow> (\<exists>z. F z \<and> O y z)"
      proof
        assume "O y (\<sigma> x. F x)"
        with overlap_eq have "\<exists>v. P v y \<and> P v (\<sigma> x. F x)"..
        then obtain v where v: "P v y \<and> P v (\<sigma> x. F x)"..
        hence "P v y"..
        from bla have "P v (\<sigma> x. F x) \<longrightarrow> (\<exists>z. F z \<and> O v z)"..
        moreover from v have "P v (\<sigma> x. F x)"..
        ultimately have "(\<exists>z. F z \<and> O v z)"..
        then obtain z where z: "F z \<and> O v z"..
        hence "F z"..
        moreover from z have "O v z"..
        hence "O z v" by (rule overlap_symmetry)
        with \<open>P v y\<close> have "O z y" by (rule overlap_monotonicity)
        hence "O y z" by (rule overlap_symmetry)
        ultimately have "F z \<and> O y z"..
        thus "(\<exists>z. F z \<and> O y z)"..
      next
        assume "\<exists>z. F z \<and> O y z"
        then obtain z where z: "F z \<and> O y z"..
        from\<open>\<exists>x. F x\<close> have "(\<forall>y. F y \<longrightarrow> P y (\<sigma> x. F x))"
          by (rule F_in)
        hence "F z \<longrightarrow>  P z (\<sigma> x. F x)"..
        moreover from z have "F z"..
        ultimately have "P z (\<sigma> x. F x)"..
        moreover from z have "O y z"..
        ultimately show "O y (\<sigma> x. F x)"
          by (rule overlap_monotonicity)
      qed
    qed
  next
    fix x
    assume x: "\<forall>y. O y x \<longleftrightarrow> (\<exists>v. F v \<and> O y v)"
    have "(\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z))"
    proof
      show "\<forall>y. F y \<longrightarrow> P y x"
      proof
        fix y
        show "F y \<longrightarrow> P y x"
        proof
          assume "F y"
          show "P y x"
          proof (rule ccontr)
            assume "\<not> P y x"
            hence "\<exists>z. P z y \<and> \<not> O z x"
              by (rule strong_supplementation)
            then obtain z where z: "P z y \<and> \<not> O z x"..
            hence "\<not> O z x"..
            from x have "O z x \<longleftrightarrow> (\<exists>v. F v \<and> O z v)"..
            moreover from z have "P z y"..
            hence "O z y" by (rule part_implies_overlap)
            with \<open>F y\<close> have "F y \<and> O z y"..
            hence "\<exists>y. F y \<and> O z y"..
            ultimately have "O z x"..
            with \<open>\<not> O z x\<close> show "False"..
          qed
        qed
      qed
      show "\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)"
      proof
        fix y
        show "P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)"
        proof
          from x have "O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z)"..
          moreover assume "P y x"
          hence "O y x" by (rule part_implies_overlap)
          ultimately show "\<exists>z. F z \<and> O y z"..
        qed
      qed
    qed
    hence "(\<sigma> x. F x) = x"
      by (rule strong_fusion_intro)
    thus "x = (\<sigma> x. F x)"..
  qed
  thus "(\<sigma> x. F x) = (THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z))"..
qed

end

sublocale GEM1 \<subseteq> GEM
proof
  fix x y F
  show "\<not> P x y \<Longrightarrow> \<exists>z. P z x \<and> \<not> O z y"
    using strong_supplementation.
  show "x \<oplus> y = (THE z. \<forall>v. O v z \<longleftrightarrow> (O v x \<or> O v y))"
    using sum_eq.
  show "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
    using product_eq.
  show "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_eq.
  show "\<midarrow> x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)"
    using complement_eq.
  show "u = (THE x. \<forall>y. P y x)"
    using universe_eq.
  show "\<exists>x. F x \<Longrightarrow> (\<sigma> x. F x) = (THE x. \<forall>y. O y x \<longleftrightarrow> (\<exists>z. F z \<and> O y z))" using fusion_eq.
  show "(\<pi> x. F x) = (\<sigma> x. \<forall>y. F y \<longrightarrow> P x y)"
    using general_product_eq.
qed

sublocale GEM \<subseteq> GEM1
proof
  fix x y F
  show "\<exists>x. F x \<Longrightarrow> (\<exists>x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))" using strong_fusion.
  show "\<exists>x. F x \<Longrightarrow> (\<sigma> x. F x) = (THE x. (\<forall>y. F y \<longrightarrow> P y x) \<and> (\<forall>y. P y x \<longrightarrow> (\<exists>z. F z \<and> O y z)))" using strong_fusion_eq.
  show "(\<pi> x. F x) = (\<sigma> x. \<forall>y. F y \<longrightarrow> P x y)" using general_product_eq.
  show "x \<oplus> y = (THE z. (P x z \<and> P y z) \<and> (\<forall>w. P w z \<longrightarrow> O w x \<or> O w y))" using strong_sum_eq.
  show "x \<otimes> y = (THE z. \<forall>v. P v z \<longleftrightarrow> P v x \<and> P v y)"
    using product_eq.
  show "x \<ominus> y = (THE z. \<forall>w. P w z = (P w x \<and> \<not> O w y))"
    using difference_eq.
  show "\<midarrow> x = (THE z. \<forall>w. P w z \<longleftrightarrow> \<not> O w x)" using complement_eq.
  show "u = (THE x. \<forall>y. P y x)" using universe_eq.
qed

(*<*) end (*>*)


(*  Title:      AVL Trees

    Author:     Tobias Nipkow and Cornelia Pusch,
                converted to Isar by Gerwin Klein
                contributions by Achim Brucker, Burkhart Wolff and Jan Smaus
    Maintainer: Gerwin Klein <gerwin.klein at nicta.com.au>

    see the file Changelog for a list of changes
*)

header {* AVL Trees in 2 Stages *}

theory AVL2
imports Main
begin

text {*
  This development of AVL trees leads to the same implementation
  as the monolithic one (in theorey AVL) but via an intermediate
  abstraction: AVL trees where the height is recomputed rather than
  stored in the tree. This two-stage devlopment is longer than the
  monolithic one but each individual step is simpler. It should really
  be viewed as a blueprint for the development of data structures where
  some of the fields contain redundant information (for efficiency
  reasons).
*}

subsection {* Step 1: Pure binary and AVL trees *}

text {*
  The basic formulation of AVL trees builds on pure binary trees
  and recomputes all height information whenever it is required. This
  simplifies the correctness proofs.
*}

datatype (set_of: 'a) tree\<^sub>0 = ET\<^sub>0 |  MKT\<^sub>0 'a "'a tree\<^sub>0" "'a tree\<^sub>0"

subsubsection {* Auxiliary functions *}

primrec height :: "'a tree\<^sub>0 \<Rightarrow> nat" where
  "height ET\<^sub>0 = 0"
  | "height (MKT\<^sub>0 n l r) = 1 + max (height l) (height r)"

primrec is_ord :: "('a::preorder) tree\<^sub>0 \<Rightarrow> bool" where
  "is_ord ET\<^sub>0 = True"
  | "is_ord (MKT\<^sub>0 n l r) =
     ((\<forall>n'\<in> set_of l. n' < n) \<and> (\<forall>n'\<in> set_of r. n < n') \<and> is_ord l \<and> is_ord r)"

primrec is_bal :: "'a tree\<^sub>0 \<Rightarrow> bool" where
  "is_bal ET\<^sub>0 = True"
  | "is_bal (MKT\<^sub>0 n l r) =
   ((height l = height r \<or> height l = 1+height r \<or> height r = 1+height l) \<and>
     is_bal l \<and> is_bal r)"

subsubsection {* AVL interface and simple implementation *}

primrec is_in\<^sub>0 :: "('a::preorder) \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> bool" where
  "is_in\<^sub>0 k ET\<^sub>0 = False"
  | "is_in\<^sub>0 k (MKT\<^sub>0 n l r) = (if k = n then True else
                         if k<n then (is_in\<^sub>0 k l)
                         else (is_in\<^sub>0 k r))"

primrec l_bal\<^sub>0 :: "'a \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> 'a tree\<^sub>0" where
  "l_bal\<^sub>0 n (MKT\<^sub>0 ln ll lr) r =
   (if height ll < height lr
    then case lr of ET\<^sub>0 \<Rightarrow> ET\<^sub>0 (* impossible *)
                  | MKT\<^sub>0 lrn lrl lrr \<Rightarrow> MKT\<^sub>0 lrn (MKT\<^sub>0 ln ll lrl) (MKT\<^sub>0 n lrr r)
    else MKT\<^sub>0 ln ll (MKT\<^sub>0 n lr r))"

primrec r_bal\<^sub>0 :: "'a \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> 'a tree\<^sub>0" where
  "r_bal\<^sub>0 n l (MKT\<^sub>0 rn rl rr) =
   (if height rl > height rr
    then case rl of ET\<^sub>0 \<Rightarrow> ET\<^sub>0 (* impossible *)
                  | MKT\<^sub>0 rln rll rlr \<Rightarrow> MKT\<^sub>0 rln (MKT\<^sub>0 n l rll) (MKT\<^sub>0 rn rlr rr)
    else MKT\<^sub>0 rn (MKT\<^sub>0 n l rl) rr)"

primrec insrt\<^sub>0 :: "'a::preorder \<Rightarrow> 'a tree\<^sub>0 \<Rightarrow> 'a tree\<^sub>0" where
  "insrt\<^sub>0 x ET\<^sub>0 = MKT\<^sub>0 x ET\<^sub>0 ET\<^sub>0"
  | "insrt\<^sub>0 x (MKT\<^sub>0 n l r) =
     (if x=n
      then MKT\<^sub>0 n l r
      else if x<n
           then let l' = insrt\<^sub>0 x l
                in if height l' = 2+height r
                   then l_bal\<^sub>0 n l' r
                   else MKT\<^sub>0 n l' r
           else let r' = insrt\<^sub>0 x r
                in if height r' = 2+height l
                   then r_bal\<^sub>0 n l r'
                   else MKT\<^sub>0 n l r')"

subsubsection {* Insertion maintains AVL balance *}

lemma height_l_bal:
 "height l = height r + 2
  \<Longrightarrow> height (l_bal\<^sub>0 n l r) = height r + 2 \<or>
      height (l_bal\<^sub>0 n l r)  = height r + 3"
  by (cases l) (auto split: tree\<^sub>0.split split_if_asm)

lemma height_r_bal:
 "height r = height l + 2
  \<Longrightarrow> height (r_bal\<^sub>0 n l r) = height l + 2 \<or>
      height (r_bal\<^sub>0 n l r) = height l + 3"
  by (cases r) (auto split: tree\<^sub>0.split split_if_asm)

lemma height_insrt:
 "is_bal t
  \<Longrightarrow> height (insrt\<^sub>0 x t) = height t \<or> height (insrt\<^sub>0 x t) = height t + 1"
proof (induct t)
  case ET\<^sub>0 show ?case by simp
next
  case (MKT\<^sub>0 n t1 t2) then show ?case proof (cases "x < n")
    case True show ?thesis
    proof (cases "height (insrt\<^sub>0 x t1) = height t2 + 2")
      case True with height_l_bal [of _ _ n]
      have "height (l_bal\<^sub>0 n (insrt\<^sub>0 x t1) t2) =
        height t2 + 2 \<or> height (l_bal\<^sub>0 n (insrt\<^sub>0 x t1) t2) = height t2 + 3" by simp
      with `x < n` MKT\<^sub>0 show ?thesis by auto
    next
      case False with `x < n` MKT\<^sub>0 show ?thesis by auto
    qed
  next
    case False show ?thesis
    proof (cases "height (insrt\<^sub>0 x t2) = height t1 + 2")
      case True with height_r_bal [of _ _ n]
      have "height (r_bal\<^sub>0 n t1 (insrt\<^sub>0 x t2)) = height t1 + 2 \<or>
        height (r_bal\<^sub>0 n t1 (insrt\<^sub>0 x t2)) = height t1 + 3" by simp
      with `\<not> x < n` MKT\<^sub>0 show ?thesis by auto
    next
      case False with `\<not> x < n` MKT\<^sub>0 show ?thesis by auto
    qed
  qed
qed

lemma is_bal_l_bal:
  "is_bal l \<Longrightarrow> is_bal r \<Longrightarrow> height l = height r + 2 \<Longrightarrow> is_bal (l_bal\<^sub>0 n l r)"
  by (cases l) (auto, auto split: tree\<^sub>0.split)  -- "separating the two auto's is just for speed"

lemma is_bal_r_bal:
  "is_bal l \<Longrightarrow> is_bal r \<Longrightarrow> height r = height l + 2 \<Longrightarrow> is_bal (r_bal\<^sub>0 n l r)"
  by (cases r) (auto, auto split: tree\<^sub>0.split)  -- "separating the two auto's is just for speed"

theorem is_bal_insrt:
  "is_bal t \<Longrightarrow> is_bal(insrt\<^sub>0 x t)"
proof (induct t)
  case ET\<^sub>0 show ?case by simp
next
  case (MKT\<^sub>0 n t1 t2) show ?case proof (cases "x < n")
    case True show ?thesis
    proof (cases "height (insrt\<^sub>0 x t1) = height t2 + 2")
      case True with `x < n` MKT\<^sub>0 show ?thesis
        by (simp add: is_bal_l_bal)
    next
      case False with `x < n` MKT\<^sub>0 show ?thesis
        using height_insrt [of t1 x] by auto
    qed
  next
    case False show ?thesis
    proof (cases "height (insrt\<^sub>0 x t2) = height t1 + 2")
      case True with `\<not> x < n` MKT\<^sub>0 show ?thesis
        by (simp add: is_bal_r_bal)
    next
      case False with `\<not> x < n` MKT\<^sub>0 show ?thesis
        using height_insrt [of t2 x] by auto
    qed
  qed
qed

subsubsection {* Correctness of insertion *}

lemma set_of_l_bal: "height l = height r + 2 \<Longrightarrow>
  set_of (l_bal\<^sub>0 x l r) = insert x (set_of l \<union> set_of r)"
  by (cases l) (auto split: tree\<^sub>0.splits)

lemma set_of_r_bal: "height r = height l + 2 \<Longrightarrow>
  set_of (r_bal\<^sub>0 x l r) = insert x (set_of l \<union> set_of r)"
  by (cases r) (auto split: tree\<^sub>0.splits)

theorem set_of_insrt:
  "set_of (insrt\<^sub>0 x t) = insert x (set_of t)"
  by (induct t) (auto simp add:set_of_l_bal set_of_r_bal Let_def)

subsubsection {* Correctness of lookup *}

theorem is_in_correct: "is_ord t \<Longrightarrow> is_in\<^sub>0 k t = (k : set_of t)"
  by (induct t) (auto simp add: less_le_not_le)

subsubsection {* Insertion maintains order *}

lemma is_ord_l_bal:
 "is_ord (MKT\<^sub>0 x l r) \<Longrightarrow> height l = Suc (Suc (height r)) \<Longrightarrow>
  is_ord (l_bal\<^sub>0 x l r)"
  by (cases l) (auto split: tree\<^sub>0.splits intro: order_less_trans)

lemma is_ord_r_bal:
 "is_ord (MKT\<^sub>0 x l r) \<Longrightarrow> height r = height l + 2 \<Longrightarrow>
  is_ord (r_bal\<^sub>0 x l r)"
  by (cases r) (auto split:tree\<^sub>0.splits intro: order_less_trans)

text {* If the order is linear, @{const insrt\<^sub>0} maintains the order: *}

theorem is_ord_insrt:
 "is_ord t \<Longrightarrow> is_ord (insrt\<^sub>0 (x::'a::linorder) t)"
  by (induct t) (simp_all add:is_ord_l_bal is_ord_r_bal set_of_insrt
    linorder_not_less order_neq_le_trans Let_def)

subsection {* Step 2: Binary and AVL trees with height information *}

datatype 'a tree = ET |  MKT 'a "'a tree" "'a tree" nat

subsubsection {* Auxiliary functions *}

primrec erase :: "'a tree \<Rightarrow> 'a tree\<^sub>0" where
  "erase ET = ET\<^sub>0"
  | "erase (MKT x l r h) = MKT\<^sub>0 x (erase l) (erase r)"

primrec hinv :: "'a tree \<Rightarrow> bool" where
  "hinv ET \<longleftrightarrow> True"
  | "hinv (MKT x l r h) \<longleftrightarrow> h = 1 + max (height (erase l)) (height (erase r))
                        \<and> hinv l \<and> hinv r"

definition avl :: "'a tree \<Rightarrow> bool" where
  "avl t \<longleftrightarrow> is_bal (erase t) \<and> hinv t"

subsubsection {* AVL interface and efficient implementation *}

primrec is_in :: "('a::preorder) \<Rightarrow> 'a tree \<Rightarrow> bool" where
  "is_in k ET \<longleftrightarrow> False"
  | "is_in k (MKT n l r h) \<longleftrightarrow> (if k = n then True else
                            if k < n then (is_in k l)
                            else (is_in k r))"

primrec ht :: "'a tree \<Rightarrow> nat" where
  "ht ET = 0"
  | "ht (MKT x l r h) = h"

definition mkt :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
  "mkt x l r = MKT x l r (max (ht l) (ht r) + 1)"

primrec l_bal :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
  "l_bal n (MKT ln ll lr h) r =
   (if ht ll < ht lr
    then case lr of ET \<Rightarrow> ET (* impossible *)
                  | MKT lrn lrl lrr lrh \<Rightarrow>
                    mkt lrn (mkt ln ll lrl) (mkt n lrr r)
    else mkt ln ll (mkt n lr r))"

primrec r_bal :: "'a \<Rightarrow> 'a tree \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
 "r_bal n l (MKT rn rl rr h) =
   (if ht rl > ht rr
    then case rl of ET \<Rightarrow> ET (* impossible *)
                  | MKT rln rll rlr h \<Rightarrow> mkt rln (mkt n l rll) (mkt rn rlr rr)
    else mkt rn (mkt n l rl) rr)"

primrec insrt :: "'a::preorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
  "insrt x ET = MKT x ET ET 1"
  | "insrt x (MKT n l r h) =
     (if x=n
      then MKT n l r h
      else if x<n
           then let l' = insrt x l; hl' = ht l'; hr = ht r
                in if hl' = 2+hr then l_bal n l' r
                   else MKT n l' r (1 + max hl' hr)
           else let r' = insrt x r; hl = ht l; hr' = ht r'
                in if hr' = 2+hl then r_bal n l r'
                   else MKT n l r' (1 + max hl hr'))"

subsubsection {* Correctness proof *}

text{* The auxiliary functions are implemented correctly: *}

lemma height_hinv: "hinv t \<Longrightarrow> ht t = height (erase t)"
  by (induct t) simp_all

lemma erase_mkt: "erase (mkt n l r) = MKT\<^sub>0 n (erase l) (erase r)"
  by (simp add: mkt_def)

lemma erase_l_bal:
 "hinv l \<Longrightarrow> hinv r \<Longrightarrow> height (erase l) = height(erase r) + 2 \<Longrightarrow>
  erase (l_bal n l r) = l_bal\<^sub>0 n (erase l) (erase r)"
  by (cases l) (simp_all add: height_hinv erase_mkt split: tree.split)

lemma erase_r_bal:
 "hinv l \<Longrightarrow> hinv r \<Longrightarrow> height(erase r) = height(erase l) + 2 \<Longrightarrow>
  erase (r_bal n l r) = r_bal\<^sub>0 n (erase l) (erase r)"
  by (cases r) (simp_all add: height_hinv erase_mkt split: tree.split)

text {* Function @{const insrt} maintains the invariant: *}

lemma hinv_mkt: "hinv l \<Longrightarrow> hinv r \<Longrightarrow> hinv (mkt x l r)"
  by (simp add: height_hinv mkt_def)

lemma hinv_l_bal:
 "hinv l \<Longrightarrow> hinv r \<Longrightarrow> height(erase l) = height(erase r) + 2 \<Longrightarrow>
  hinv (l_bal n l r)"
  by (cases l) (auto simp add: hinv_mkt split: tree.splits)

lemma hinv_r_bal:
 "hinv l \<Longrightarrow> hinv r \<Longrightarrow> height(erase r) = height(erase l) + 2 \<Longrightarrow>
  hinv (r_bal n l r)"
  by (cases r) (auto simp add: hinv_mkt split: tree.splits)

theorem hinv_insrt: "hinv t \<Longrightarrow> hinv (insrt x t)"
  by (induct t) (simp_all add: Let_def height_hinv hinv_l_bal hinv_r_bal)

text{* Function @{const insrt} implements @{const insrt\<^sub>0}: *}
lemma erase_insrt: "hinv t \<Longrightarrow> erase (insrt x t) = insrt\<^sub>0 x (erase t)"
  by (induct t) (simp_all add: Let_def hinv_insrt height_hinv erase_l_bal erase_r_bal)

text{* Function @{const insrt} meets its spec: *}

corollary "avl t \<Longrightarrow> set_of (erase (insrt x t)) = insert x (set_of (erase t))"
  by (simp add: avl_def erase_insrt set_of_insrt)

text{* Function @{const insrt} preserves the invariants: *}

corollary "avl t \<Longrightarrow> avl (insrt x t)"
  by (simp add: hinv_insrt avl_def erase_insrt is_bal_insrt)

corollary
  "avl t \<Longrightarrow> is_ord (erase t) \<Longrightarrow> is_ord (erase (insrt (x::'a::linorder) t))"
  by (simp add: avl_def erase_insrt is_ord_insrt)

text{* Function @{const is_in} implements @{const is_in}: *}

theorem is_in: "is_in x t = is_in\<^sub>0 x (erase t)"
  by (induct t) simp_all

text{* Function @{const is_in} meets its spec: *}

corollary "is_ord (erase t) \<Longrightarrow> is_in x t \<longleftrightarrow> x \<in> set_of (erase t)"
  by (simp add:is_in is_in_correct)

end


theory InverseNatNat imports Main HOL.Filter begin

\<comment> \<open>This theory, including the structure of many proofs and the comments
   follow closely the Coq library accompanying the paper by Charguéraud and Pottier:
   \<^url>\<open>http://gallium.inria.fr/~fpottier/dev/uf/\<close>\<close>

locale f_nat_nat =
  fixes f :: "nat\<Rightarrow>'a :: {linorder, no_top}"
  assumes strict_mono_f: "strict_mono f"
    and tends_to_inf: "filterlim f at_top at_top"

context f_nat_nat
begin

lemma tendstoinf: "\<exists>n\<^sub>0.\<forall>n\<ge>n\<^sub>0. (f n) > K"
  by (metis tends_to_inf filterlim_at_top eventually_gt_at_top eventually_at_top_linorder)

lemma mono_f: "mono f" using strict_mono_f
  by (simp add: strict_mono_mono)

lemma alphaf_existence:
  "\<exists>x. y \<le> f x"
proof -
  obtain n\<^sub>0 where "\<forall>n\<ge>n\<^sub>0. y < f n" using tendstoinf[of y] by blast
  hence "y \<le> f n\<^sub>0" by fastforce
  thus ?thesis by blast
qed

lemma betaf_bound: "\<exists>x.\<forall>y\<^sub>0. f y\<^sub>0 \<le> y \<longrightarrow> y\<^sub>0 \<le> x"
  using strict_mono_less_eq[OF strict_mono_f]
  by (meson order_trans alphaf_existence)

(* -------------------------------------------------------------------------- *)
\<comment>\<open> Because @{term f} tends towards infinity, for every y, there exists a least
   @{term x} such that @{term "f x"} is at least @{term y}.
   We refer to it as @{term "\<alpha>\<^sub>f y"}. \<close>
(* -------------------------------------------------------------------------- *)

definition \<alpha>\<^sub>f where "\<alpha>\<^sub>f y \<equiv> Least (\<lambda>x. y \<le> f x)"

\<comment> \<open>By definition, @{term "\<alpha>\<^sub>f y"} is the least x such that @{term "y \<le> f x"} holds.
   Because @{term f} is monotonic, this property holds for all @{term x} above @{term "\<alpha>\<^sub>f y"}.
   Thus, @{term "y \<le> f x"} is equivalent to @{term "\<alpha>\<^sub>f y \<le> x"}. In that sense, @{term \<alpha>\<^sub>f}
   is an inverse of @{term f}. \<close>

lemma \<alpha>\<^sub>f_spec_direct: assumes "\<alpha>\<^sub>f y \<le> x" shows "y \<le> f x"
proof -
  have "y \<le> f (\<alpha>\<^sub>f y)" using alphaf_existence[of y] unfolding \<alpha>\<^sub>f_def using LeastI by fast
  also have  "\<dots> \<le> f x" using mono_f assms unfolding \<alpha>\<^sub>f_def mono_def by blast
  finally show ?thesis .
qed

lemma \<alpha>\<^sub>f_spec_direct_contrapositive: assumes "f x < y" shows "x < \<alpha>\<^sub>f y"
proof (rule classical)
  assume assm2: "\<not> x < \<alpha>\<^sub>f y"
  hence "\<alpha>\<^sub>f y \<le> x" by simp
  thus "x < \<alpha>\<^sub>f y" using \<alpha>\<^sub>f_spec_direct[of y x] assms
    using not_le by blast
qed

lemma \<alpha>\<^sub>f_spec_reciprocal: assumes "y \<le> f x" shows "\<alpha>\<^sub>f y \<le> x"
 using alphaf_existence[of y] assms Least_le unfolding \<alpha>\<^sub>f_def by fast

lemma \<alpha>\<^sub>f_spec_reciprocal_contrapositive: assumes "x < \<alpha>\<^sub>f y" shows "f x < y"
proof (rule classical)
  assume assm2: "\<not> f x < y"
  hence "y \<le> f x"
    using not_le by blast
  thus "f x < y" using \<alpha>\<^sub>f_spec_reciprocal[of y x] assms by linarith
qed

lemma \<alpha>\<^sub>f_spec: "(\<alpha>\<^sub>f y \<le> x) = (y \<le> f x)"
  using \<alpha>\<^sub>f_spec_reciprocal f_nat_nat.\<alpha>\<^sub>f_spec_direct f_nat_nat_axioms by blast

lemma f_\<alpha>\<^sub>f: "y \<le> f (\<alpha>\<^sub>f y)"
  by (simp add: \<alpha>\<^sub>f_spec_direct)

lemma \<alpha>\<^sub>f_f: "\<alpha>\<^sub>f (f x) \<le> x"
  using \<alpha>\<^sub>f_spec_reciprocal by auto

lemma \<alpha>\<^sub>f_f_exact: "\<alpha>\<^sub>f (f x) = x"
  by (meson \<alpha>\<^sub>f_f dual_order.antisym f_\<alpha>\<^sub>f strict_mono_f strict_mono_less_eq)

lemma \<alpha>\<^sub>f_mono: "mono \<alpha>\<^sub>f"
  using \<alpha>\<^sub>f_spec_reciprocal f_\<alpha>\<^sub>f le_trans unfolding mono_def
  by (meson order_trans)

(* -------------------------------------------------------------------------- *)
\<comment> \<open> Almost symmetrically, if @{term "f 0 \<le> y"} holds, then there exists a largest
     @{term x} such that @{term "f x"} is bounded by @{term y}.
     We refer to it as @{term "\<beta>\<^sub>f y"}. Because @{term f} is monotonic,
     this property holds for all @{term x}  below @{term "\<beta>\<^sub>f y"}. Thus,
   @{term "f x \<le> y"} is equivalent to @{term "x \<le> \<beta>\<^sub>f y"}.
     In that sense, @{term \<beta>\<^sub>f} is an inverse of @{term f}.\<close>
(* -------------------------------------------------------------------------- *)

definition \<beta>\<^sub>f where "\<beta>\<^sub>f y = Greatest (\<lambda>x. f x \<le> y)"

lemma \<beta>\<^sub>f_spec_direct: assumes "f 0 \<le> y" "x \<le> \<beta>\<^sub>f y" shows "f x \<le> y"
proof -
  have "f x \<le> f (\<beta>\<^sub>f y)" using mono_f assms unfolding mono_def \<beta>\<^sub>f_def by blast
  also have "\<dots> \<le> y" using mono_f assms  unfolding mono_def  \<beta>\<^sub>f_def
    by (metis GreatestI_ex_nat betaf_bound)
  finally show ?thesis .
qed

lemma \<beta>\<^sub>f_spec_direct_contrapositive: assumes "f 0 \<le> y" "y < f x" shows "\<beta>\<^sub>f y < x"
proof (rule classical)
  assume assm2: "\<not> \<beta>\<^sub>f y < x"
  hence "x \<le> \<beta>\<^sub>f y" by simp
  thus "\<beta>\<^sub>f y < x" using  \<beta>\<^sub>f_spec_direct[OF assms(1) \<open>x \<le> \<beta>\<^sub>f y\<close>] assms
    using not_le by blast
qed

lemma \<beta>\<^sub>f_spec_direct_contrapositive_le: assumes "f 0 \<le> y" "y < f (Suc x)" shows "\<beta>\<^sub>f y \<le> x"
proof -
  have "\<beta>\<^sub>f y < Suc x" using \<beta>\<^sub>f_spec_direct_contrapositive[OF assms(1) assms(2)] .
  thus ?thesis by simp
qed

lemma \<beta>\<^sub>f_spec_reciprocal: assumes "f x \<le> y"  shows "x \<le> \<beta>\<^sub>f y"
  using assms mono_f Greatest_le_nat betaf_bound unfolding mono_def \<beta>\<^sub>f_def
  by presburger

lemma \<beta>\<^sub>f_spec_reciprocal_contrapositive: assumes "\<beta>\<^sub>f y < x" shows "y < f x"
proof (rule classical)
  assume assm2: "\<not> y < f x"
  hence "f x \<le> y" by simp
  thus "y < f x" using \<beta>\<^sub>f_spec_reciprocal[OF \<open>f x \<le> y\<close>] assms by linarith
qed

lemma \<beta>\<^sub>f_spec: assumes "f 0 \<le> y" shows "(x \<le> \<beta>\<^sub>f y) = (f x \<le> y)"
  using \<beta>\<^sub>f_spec_direct \<beta>\<^sub>f_spec_reciprocal assms by blast

lemma f_\<beta>\<^sub>f: assumes "f 0 \<le> y" shows "f (\<beta>\<^sub>f y) \<le> y"
  by (simp add: \<beta>\<^sub>f_spec_direct assms)

lemma \<beta>\<^sub>f_f: "x \<le> \<beta>\<^sub>f (f x)"
  by (simp add: \<beta>\<^sub>f_spec_reciprocal)

lemma \<beta>\<^sub>f_f_exact: "x = \<beta>\<^sub>f (f x)"
  by (meson \<beta>\<^sub>f_f f_\<beta>\<^sub>f le0 order_class.order.antisym strict_mono_f strict_mono_less_eq)

(*mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)*)
lemma \<beta>\<^sub>f_mono: "\<forall>x y. (f 0 \<le> x \<and> x \<le> y) \<longrightarrow> \<beta>\<^sub>f x \<le> \<beta>\<^sub>f y"
  using \<beta>\<^sub>f_spec_reciprocal f_\<beta>\<^sub>f by force

(* -------------------------------------------------------------------------- *)
section\<open> Relationship between \<alpha>_f and \<beta>_f \<close>
(* -------------------------------------------------------------------------- *)

\<comment>\<open> Because @{term f} is strictly monotonic, for a fixed @{term y}, there is at most one
   point @{term x} where @{term "f x = y"} holds. This implies that, if @{term "\<beta>\<^sub>f y"} is
   defined, then @{term "\<beta>\<^sub>f y"} is less than or equal to @{term "\<alpha>\<^sub>f y"}. \<close>

lemma \<beta>\<^sub>f_le_\<alpha>\<^sub>f: assumes "f 0 \<le> y" shows "\<beta>\<^sub>f y \<le> \<alpha>\<^sub>f y"
  using mono_f strict_mono_f assms
  by (metis \<alpha>\<^sub>f_spec_direct \<beta>\<^sub>f_spec_direct dual_order.antisym le_cases strict_mono_eq)

lemma \<beta>\<^sub>f_le_\<alpha>\<^sub>f_equality: assumes "f x = y" shows "\<alpha>\<^sub>f y = x" "\<beta>\<^sub>f y = \<alpha>\<^sub>f y"
proof -
  have 1: "\<alpha>\<^sub>f y = x" using \<alpha>\<^sub>f_f_exact assms by auto
  have 2: "\<beta>\<^sub>f y = x" using \<beta>\<^sub>f_f_exact assms by auto
  show "\<alpha>\<^sub>f y = x" using 1 2 by fast
  show "\<beta>\<^sub>f y = \<alpha>\<^sub>f y" using 1 2 by presburger
qed

lemma \<beta>\<^sub>f_le_\<alpha>\<^sub>f_equality_converse: assumes "f 0 \<le> y" "\<beta>\<^sub>f y = \<alpha>\<^sub>f y" "\<alpha>\<^sub>f y = x" shows "f x = y"
  using assms dual_order.antisym f_\<alpha>\<^sub>f f_\<beta>\<^sub>f by fastforce

lemma \<beta>\<^sub>f_\<alpha>\<^sub>f_differ_by_at_most_one:
  "\<alpha>\<^sub>f y \<le> Suc (\<beta>\<^sub>f y)"
  using Suc_n_not_le_n \<alpha>\<^sub>f_spec \<beta>\<^sub>f_spec_reciprocal nat_le_linear
  by (meson le_cases)

lemma \<alpha>\<^sub>f_lt_\<beta>\<^sub>f: assumes "f 0 \<le> y" "y < z" shows "\<beta>\<^sub>f y < \<alpha>\<^sub>f z"
  using \<beta>\<^sub>f_spec_direct_contrapositive assms f_\<alpha>\<^sub>f less_le_trans by blast

lemma \<beta>\<^sub>f_tends_to_infinity:
  "filterlim \<beta>\<^sub>f at_top at_top"
  apply (subst filterlim_iff)
  apply (subst eventually_sequentially)
  using \<beta>\<^sub>f_spec_reciprocal eventually_sequentially
  by (meson eventually_at_top_linorder)

lemma \<alpha>\<^sub>f_tends_to_infinity:
  "filterlim \<alpha>\<^sub>f at_top at_top"
proof -
  note sg1 = \<alpha>\<^sub>f_mono[THEN monoD]
  show ?thesis
    by (metis eventually_at_top_linorder f_nat_nat.\<alpha>\<^sub>f_f_exact
          f_nat_nat_axioms filterlim_at_top sg1)
qed

lemma strict_mono_sequence_partition:
  assumes "x \<ge> f 0"
  shows "\<exists>k. x \<in> {f k..<f (Suc k)}"
  using assms \<beta>\<^sub>f_spec_reciprocal_contrapositive f_\<beta>\<^sub>f by auto

end
end