(* Copyright 2021 (C) Mihails Milehins *)

section\<open>Further results related to the von Neumann hierarchy of sets\<close>
theory CZH_Sets_VNHS
  imports
    CZH_Sets_FBRelations
    CZH_Sets_Ordinals
begin

subsection\<open>Background\<close>

text\<open>
The subsection presents several further auxiliary results about the
von Neumann hierarchy of sets. The primary general reference for this section
is \<^cite>\<open>"takeuti_introduction_1971"\<close>.
\<close>

subsection\<open>Further properties of \<open>Vfrom\<close>\<close>

text\<open>Reusable patterns.\<close>

lemma Vfrom_Ord_bundle:
  assumes "A = A" and "i = i"
  shows "Vfrom A i = Vfrom A (rank i)" and "Ord (rank i)"
  by (simp_all add: Vfrom_rank_eq )

lemma Vfrom_in_bundle:
  assumes "i \<in>\<^sub>\<circ> j" and "A = A" and "B = B"
  shows "Vfrom A i = Vfrom A (rank i)"
    and "Ord (rank i)"
    and "Vfrom B j = Vfrom B (rank j)"
    and "Ord (rank j)"
    and "rank i \<in>\<^sub>\<circ> rank j"
  by (simp_all add: assms(1) Vfrom_rank_eq Ord_mem_iff_lt rank_lt)

text\<open>Elementary corollaries.\<close>

lemma Ord_Vset_in_Vset_succI[intro]:
  assumes "Ord \<alpha>"
  shows "Vset \<alpha> \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  by (simp add: Vset_succ assms)

lemma Ord_in_in_VsetI[intro]:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
  by (metis assms Ord_VsetI Ord_iff_rank rank_lt)

text\<open>Transitivity of the constant \<^const>\<open>Vfrom\<close>.\<close>

lemma Vfrom_trans[intro]:
  assumes "Transset A" and "x \<in>\<^sub>\<circ> X" and "X \<in>\<^sub>\<circ> Vfrom A i"
  shows "x \<in>\<^sub>\<circ> Vfrom A i"
  using Transset_def by (blast intro: assms Transset_Vfrom)

lemma Vset_trans[intro]:
  assumes "x \<in>\<^sub>\<circ> X" and "X \<in>\<^sub>\<circ> Vset i"
  shows "x \<in>\<^sub>\<circ> Vset i"
  by (auto intro: assms)

text\<open>Monotonicity of the constant \<^const>\<open>Vfrom\<close>.\<close>

lemma Vfrom_in_mono:
  assumes "A \<subseteq>\<^sub>\<circ> B" and "i \<in>\<^sub>\<circ> j"
  shows "Vfrom A i \<in>\<^sub>\<circ> Vfrom B j"
proof-
  define i' where "i' = rank i"
  define j' where "j' = rank j"
  note rank_conv =
    Vfrom_in_bundle[
      OF assms(2) HOL.refl[of A] HOL.refl[of B], folded i'_def j'_def
      ]
  show ?thesis
    unfolding rank_conv using rank_conv(4,5)
  proof induction
    case (succ j')
    from succ have "Ord (succ j')" by auto
    from succ(3) succ.hyps have "i' \<subseteq>\<^sub>\<circ> j'" by (auto simp: Ord_def Transset_def)
    from Vfrom_mono[OF \<open>Ord i'\<close> assms(1) this] show ?case
      unfolding Vfrom_succ_Ord[OF \<open>Ord j'\<close>, of B] by simp
  next
    case (Limit j')
    from Limit(3) obtain \<xi> where "i' \<in>\<^sub>\<circ> \<xi>" and "\<xi> \<in>\<^sub>\<circ> j'" by auto
    with vifunionI have "Vfrom A i' \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>j'. Vfrom B \<xi>)"
      by (auto simp: Limit.IH)
    then show "Vfrom A i' \<in>\<^sub>\<circ> Vfrom B (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>j'. \<xi>)"
      unfolding Limit_Vfrom_eq[symmetric, OF Limit(1)]
      by (simp add: SUP_vifunion[symmetric] Limit.hyps)
  qed auto
qed

lemmas Vset_in_mono = Vfrom_in_mono[OF order_refl, of _ _ 0]

lemma Vfrom_vsubset_mono:
  assumes "A \<subseteq>\<^sub>\<circ> B" and "i \<subseteq>\<^sub>\<circ> j"
  shows "Vfrom A i \<subseteq>\<^sub>\<circ> Vfrom B j"
  by (metis assms Vfrom_Ord_bundle(1,2) Vfrom_mono rank_mono)

lemmas Vset_vsubset_mono = Vfrom_vsubset_mono[OF order_refl, of _ _ 0]

lemma arg1_vsubset_Vfrom: "a \<subseteq>\<^sub>\<circ> Vfrom a i" using Vfrom by blast

lemma VPow_vsubset_Vset:
  \<comment>\<open>Based on Theorem 9.10 from \cite{takeuti_introduction_1971}\<close>
  assumes "X \<in>\<^sub>\<circ> Vset i"
  shows "VPow X \<subseteq>\<^sub>\<circ> Vset i"
proof-
  define i' where "i' = rank i"
  note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
  show ?thesis
    using rank_conv(2) assms unfolding rank_conv
  proof induction
    case (Limit \<alpha>)
    from Limit have "X \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<alpha>. Vset i)"
      by (simp add: SUP_vifunion[symmetric] Limit_Vfrom_eq)
    then have "VPow X \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>\<alpha>. Vset i)"
      by (intro vsubsetI) (metis Limit.IH vifunionE vifunionI vsubsetE)
    then show ?case
      by (simp add: SUP_vifunion[symmetric] Limit.hyps Limit_Vfrom_eq)
  qed (simp_all add: Vset_succ)
qed

lemma Vfrom_vsubset_VPow_Vfrom:
  assumes "Transset A"
  shows "Vfrom A i \<subseteq>\<^sub>\<circ> VPow (Vfrom A i)"
  using assms Transset_VPow Transset_Vfrom by (auto simp: Transset_def)

lemma arg1_vsubset_VPow_Vfrom:
  assumes "Transset A"
  shows "A \<subseteq>\<^sub>\<circ> VPow (Vfrom A i)"
  by (meson assms Vfrom_vsubset_VPow_Vfrom arg1_vsubset_Vfrom dual_order.trans)

subsection\<open>Operations closed with respect to \<^const>\<open>Vset\<close>\<close>

text\<open>Empty set.\<close>

lemma Limit_vempty_in_VsetI:
  assumes "Limit \<alpha>"
  shows "0 \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (auto simp: Limit_def)

text\<open>Subset.\<close>

lemma vsubset_in_VsetI[intro]:
  assumes "a \<subseteq>\<^sub>\<circ> A" and "A \<in>\<^sub>\<circ> Vset i"
  shows "a \<in>\<^sub>\<circ> Vset i"
  using assms by (auto dest: VPow_vsubset_Vset)

lemma Ord_vsubset_in_Vset_succI:
  assumes "Ord \<alpha>" and "A \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  shows "A \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  using assms Ord_Vset_in_Vset_succI by auto

text\<open>Power set.\<close>

lemma Limit_VPow_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "VPow A \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(1) have "Ord \<alpha>" by auto
  with assms obtain i where "A \<in>\<^sub>\<circ> Vset i" and "i \<in>\<^sub>\<circ> \<alpha>" and "Ord i"
    by (fastforce simp: Ord_in_Ord Limit_Vfrom_eq)
  have "Vset i \<in>\<^sub>\<circ> Vset \<alpha>" by (rule Vset_in_mono) (auto intro: \<open>i \<in>\<^sub>\<circ> \<alpha>\<close>)
  from VPow_vsubset_Vset[OF \<open>A \<in>\<^sub>\<circ> Vset i\<close>] this show ?thesis
    by (rule vsubset_in_VsetI)
qed

lemma VPow_in_Vset_revD:
  assumes "VPow A \<in>\<^sub>\<circ> Vset i"
  shows "A \<in>\<^sub>\<circ> Vset i"
  using assms Vset_trans by blast

lemma Ord_VPow_in_Vset_succI:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "VPow a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  using VPow_vsubset_Vset[OF assms(2)]
  by (auto intro: Ord_Vset_in_Vset_succI[OF assms(1)])

lemma Ord_VPow_in_Vset_succD:
  assumes "Ord \<alpha>" and "VPow a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (fastforce dest: Vset_succ)

text\<open>Union of elements.\<close>

lemma VUnion_in_VsetI[intro]:
  assumes "A \<in>\<^sub>\<circ> Vset i"
  shows "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset i"
proof-
  define i' where "i' = rank i"
  note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
  from rank_conv(2) assms show ?thesis
    unfolding rank_conv
  proof induction
    case (succ \<alpha>)
    show "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
      by (metis succ(1,3) VPow_iff VUnion_least Vset_trans Vset_succ)
  qed (auto simp: vrange_VLambda vimage_VLambda_vrange_rep Limit_Vfrom_eq)
qed

lemma Limit_VUnion_in_VsetD:
  assumes "Limit \<alpha>" and "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "A \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have "A \<subseteq>\<^sub>\<circ> VPow (\<Union>\<^sub>\<circ>A)" by auto
  moreover from assms have "VPow (\<Union>\<^sub>\<circ>A) \<in>\<^sub>\<circ> Vset \<alpha>" by (rule Limit_VPow_in_VsetI)
  ultimately show ?thesis using assms(1) by auto
qed

text\<open>Intersection of elements.\<close>

lemma VInter_in_VsetI[intro]:
  assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "\<Inter>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have subset: "\<Inter>\<^sub>\<circ>A \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>A" by auto
  moreover from assms have "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>" by (rule VUnion_in_VsetI)
  ultimately show ?thesis by (rule vsubset_in_VsetI)
qed

text\<open>Singleton.\<close>

lemma Limit_vsingleton_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have aa: "set {a} \<subseteq>\<^sub>\<circ> VPow a" by auto
  from assms(1) have "Ord \<alpha>" by auto
  from vsubset_in_VsetI[OF aa Limit_VPow_in_VsetI[OF assms(1)]] show ?thesis
    by (simp add: Limit_is_Ord assms(2))
qed

lemma Limit_vsingleton_in_VsetD:
  assumes "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by auto

lemma Ord_vsingleton_in_Vset_succI:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set {a} \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  using assms by (simp add: Vset_succ vsubset_vsingleton_leftI)

text\<open>Doubleton.\<close>

lemma Limit_vdoubleton_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(1) have "Ord \<alpha>" by auto
  from assms have "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)" and "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)"
    by (simp_all add: SUP_vifunion[symmetric] Limit_Vfrom_eq)
  then obtain A B
    where a: "a \<in>\<^sub>\<circ> Vset A" and "A \<in>\<^sub>\<circ> \<alpha>" and b: "b \<in>\<^sub>\<circ> Vset B" and "B \<in>\<^sub>\<circ> \<alpha>"
    by blast
  moreover with assms have "Ord A" and "Ord B" by auto
  ultimately have "A \<union>\<^sub>\<circ> B \<in>\<^sub>\<circ> \<alpha>"
    by (metis Ord_linear_le le_iff_sup sup.order_iff)
  then have "Vset (A \<union>\<^sub>\<circ> B) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: assms Limit_is_Ord Vset_in_mono)
  moreover from a b have "set {a, b} \<subseteq>\<^sub>\<circ> Vset (A \<union>\<^sub>\<circ> B)"
    by (simp add: Vfrom_sup vsubset_vdoubleton_leftI)
  ultimately show "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>" by (rule vsubset_in_VsetI[rotated 1])
qed

lemma vdoubleton_in_VsetD:
  assumes "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (auto intro!: Vset_trans[of _ \<open>set {a, b}\<close>])

lemma Ord_vdoubleton_in_Vset_succI:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set {a, b} \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  by
    (
      meson
        assms Ord_Vset_in_Vset_succI vsubset_in_VsetI vsubset_vdoubleton_leftI
    )

text\<open>Pairwise union.\<close>

lemma vunion_in_VsetI[intro]:
  assumes "a \<in>\<^sub>\<circ> Vset i" and "b \<in>\<^sub>\<circ> Vset i"
  shows "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset i"
proof-
  define i' where "i' = rank i"
  note rank_conv = Vfrom_Ord_bundle[OF refl[of 0] refl[of i], folded i'_def]
  show ?thesis
    using rank_conv(2) assms unfolding rank_conv
  proof induction
    case (Limit \<alpha>)
    from Limit have "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
      by (intro Limit_vdoubleton_in_VsetI; unfold SUP_vifunion[symmetric])
        simp_all
    then have "\<Union>\<^sub>\<circ>(set {a, b}) \<in>\<^sub>\<circ> Vset \<alpha>" by (blast intro: Limit.hyps)
    with Limit.hyps VUnion_vdoubleton have "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. Vset \<xi>)"
      by (auto simp: Limit_Vfrom_eq)
    then show "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset (\<Union>\<^sub>\<circ>\<xi>\<in>\<^sub>\<circ>\<alpha>. \<xi>)"
      by (simp add: \<open>Limit \<alpha>\<close> Limit_Vfrom_eq)
  qed (auto simp add: Vset_succ)
qed

lemma vunion_in_VsetD:
  assumes "a \<union>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (meson vsubset_in_VsetI inf_sup_ord(3,4))+

text\<open>Pairwise intersection.\<close>

lemma vintersection_in_VsetI[intro]:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<inter>\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (meson vsubset_in_VsetI inf_sup_ord(2))

text\<open>Set difference.\<close>

lemma vdiff_in_VsetI[intro]:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a -\<^sub>\<circ> b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by auto

text\<open>\<^const>\<open>vinsert\<close>.\<close>

lemma vinsert_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have ab: "vinsert a b = set {a} \<union>\<^sub>\<circ> b" by simp
  from assms(2) have "set {a} \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: Limit_vsingleton_in_VsetI assms(1))
  from this assms(1,3) show "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
    unfolding ab by blast
qed

lemma vinsert_in_Vset_succI[intro]:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "vinsert a b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  using assms by blast

lemma vinsert_in_Vset_succI'[intro]:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
  shows "vinsert a b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
proof-
  have ab: "vinsert a b = set {a} \<union>\<^sub>\<circ> b" by simp
  show ?thesis
    unfolding ab by (intro vunion_in_VsetI Ord_vsingleton_in_Vset_succI assms)
qed

lemma vinsert_in_VsetD:
  assumes "vinsert a b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms Vset_trans by blast+

lemma Limit_insert_in_VsetI:
  assumes [intro]: "Limit \<alpha>"
    and [simp]: "small x"
    and "set x \<in>\<^sub>\<circ> Vset \<alpha>"
    and [intro]: "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set (insert a x) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have ax: "set (insert a x) = vinsert a (set x)" by auto
  from assms show ?thesis unfolding ax by auto
qed

text\<open>Pair.\<close>

lemma Limit_vpair_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms Limit_vdoubleton_in_VsetI Limit_vsingleton_in_VsetI
  unfolding vpair_def
  by simp

lemma vpair_in_VsetD[intro]:
  assumes "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms unfolding vpair_def by (meson vdoubleton_in_VsetD)+

text\<open>Cartesian product.\<close>

lemma Limit_vtimes_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "A \<times>\<^sub>\<circ> B \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(1) have "Ord \<alpha>" by auto
  have "VPow (VPow (A \<union>\<^sub>\<circ> B)) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: assms Limit_VPow_in_VsetI Limit_is_Ord vunion_in_VsetI)
  from assms(1) vsubset_in_VsetI[OF vtimes_vsubset_VPowVPow this] show ?thesis
    by auto
qed

text\<open>Binary relations.\<close>

lemma (in vbrelation) vbrelation_Limit_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" and "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "r \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms vdomain_vrange_vtimes by auto

lemma
  assumes "r \<in>\<^sub>\<circ> Vset \<alpha>"
  shows vdomain_in_VsetI: "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
    and vrange_in_VsetI: "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
    and vfield_in_VsetI: "\<F>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms have "\<Union>\<^sub>\<circ>r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  with assms(1) have r: "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r) \<in>\<^sub>\<circ> Vset \<alpha>" by blast
  from r assms(1) vfield_vsubset_VUnion2 show "\<F>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  from r assms(1) vdomain_vsubset_VUnion2 vrange_vsubset_VUnion2 show
    "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>" "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
    by auto
qed

lemma (in vbrelation) vbrelation_Limit_vsubset_VsetI:
  assumes "Limit \<alpha>" and "\<D>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  shows "r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
proof(intro vsubsetI)
  fix x assume "x \<in>\<^sub>\<circ> r"
  moreover then obtain a b where x_def: "x = \<langle>a, b\<rangle>" by (elim vbrelation_vinE)
  ultimately have "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
  with assms show "x \<in>\<^sub>\<circ> Vset \<alpha>" unfolding x_def by auto
qed

lemma
  assumes "r \<in>\<^sub>\<circ> Vset \<alpha>"
  shows fdomain_in_VsetI: "\<D>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
    and frange_in_VsetI: "\<R>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
    and ffield_in_VsetI: "\<F>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms have "\<Union>\<^sub>\<circ>r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  with assms have r: "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>r)) \<in>\<^sub>\<circ> Vset \<alpha>" by blast
  from r assms(1) fdomain_vsubset_VUnion2 frange_vsubset_VUnion2 show
    "\<D>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>" "\<R>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>"
    by auto
  from r assms(1) ffield_vsubset_VUnion2 show "\<F>\<^sub>\<bullet> r \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma (in vsv) vsv_Limit_vrange_in_VsetI[intro]:
  assumes "Limit \<alpha>" and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "vfinite (\<D>\<^sub>\<circ> r)"
  shows "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms(3,1,2) vsv_axioms
proof(induction \<open>\<D>\<^sub>\<circ> r\<close> arbitrary: r rule: vfinite_induct)
  case vempty
  interpret r': vsv r by (rule vempty(4))
  from vempty(1) r'.vlrestriction_vdomain have "r = 0" by simp
  from Vset_in_mono vempty.prems(1) show ?case
    unfolding \<open>r = 0\<close> by (auto simp: Limit_def)
next
  case (vinsert x F)
  interpret r': vsv r by (rule vinsert(7))
  have RrF_Rr: "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
  have F_DrF: "F = \<D>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F)"
    unfolding vdomain_vlrestriction vinsert(4)[symmetric] by auto
  moreover note assms(1)
  moreover from RrF_Rr vinsert(6) have "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
  moreover have "vsv (r \<restriction>\<^sup>l\<^sub>\<circ> F)" by simp
  ultimately have RrF_V\<alpha>: "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<in>\<^sub>\<circ> Vset \<alpha>" by (rule vinsert(3))
  have "\<R>\<^sub>\<circ> r = vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
  proof(intro vsubset_antisym vsubsetI)
    fix b assume "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r"
    then obtain a where "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" and b_def: "b = r\<lparr>a\<rparr>" by force
    with vinsert.hyps(4) have "a = x \<or> a \<in>\<^sub>\<circ> F" by auto
    with \<open>a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r\<close> show "b \<in>\<^sub>\<circ> vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
      unfolding b_def by (blast dest: r'.vsv_vimageI1)
  next
    fix b assume "b \<in>\<^sub>\<circ> vinsert (r\<lparr>x\<rparr>) (\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F))"
    with RrF_Rr r'.vsv_axioms vinsert.hyps(4) show "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
  qed
  moreover with vinsert.prems(2) have "r\<lparr>x\<rparr> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  moreover have "\<R>\<^sub>\<circ> (r \<restriction>\<^sup>l\<^sub>\<circ> F) \<in>\<^sub>\<circ> Vset \<alpha>" by (blast intro: RrF_V\<alpha>)
  ultimately show "\<R>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: vinsert.prems(1) vinsert_in_VsetI)
qed

lemma (in vsv) vsv_Limit_vsv_in_VsetI[intro]:
  assumes "Limit \<alpha>"
    and "\<D>\<^sub>\<circ> r \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<R>\<^sub>\<circ> r \<subseteq>\<^sub>\<circ> Vset \<alpha>"
    and "vfinite (\<D>\<^sub>\<circ> r)"
  shows "r \<in>\<^sub>\<circ> Vset \<alpha>"
  by (simp add: assms vsv_Limit_vrange_in_VsetI vbrelation_Limit_in_VsetI)

lemma Limit_vcomp_in_VsetI:
  assumes "Limit \<alpha>" and "r \<in>\<^sub>\<circ> Vset \<alpha>" and "s \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "r \<circ>\<^sub>\<circ> s \<in>\<^sub>\<circ> Vset \<alpha>"
proof(rule vbrelation.vbrelation_Limit_in_VsetI; (intro assms(1))?)
  show "vbrelation (r \<circ>\<^sub>\<circ> s)" by auto
  have "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> s" by auto
  with assms(3) show "\<D>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: vdomain_in_VsetI vsubset_in_VsetI)
  have "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
  with assms(2) show "\<R>\<^sub>\<circ> (r \<circ>\<^sub>\<circ> s) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: vrange_in_VsetI vsubset_in_VsetI)
qed

text\<open>Operations on indexed families of sets.\<close>

lemma Limit_vifintersection_in_VsetI:
  assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite I"
  shows "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(2) have range: "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
  from assms(1) range assms(3) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule rel_VLambda.vsv_Limit_vrange_in_VsetI[unfolded vdomain_VLambda])
  then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: vimage_VLambda_vrange_rep)
  then show "(\<Inter>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma Limit_vifunion_in_VsetI:
  assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite I"
  shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(2) have range: "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
  from assms(1) range assms(3) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule rel_VLambda.vsv_Limit_vrange_in_VsetI[unfolded vdomain_VLambda])
  then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: vimage_VLambda_vrange_rep)
  then show "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma Limit_vifunion_in_Vset_if_VLambda_in_VsetI:
  assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(2) have "\<R>\<^sub>\<circ> (\<lambda>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: vrange_in_VsetI)
  then have "(\<lambda>i\<in>\<^sub>\<circ>I. A i) `\<^sub>\<circ> I \<in>\<^sub>\<circ> Vset \<alpha>"
    by (simp add: vimage_VLambda_vrange_rep)
  then show "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma Limit_vproduct_in_VsetI:
  assumes "Limit \<alpha>"
    and "I \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
    and "vfinite I"
  shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule Limit_vifunion_in_VsetI) (simp_all add: assms(1,3,4))
  with assms have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  with assms(1) have "VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  from vsubset_in_VsetI[OF vproduct_vsubset_VPow[of I A] this] show ?thesis
    by simp
qed

lemma Limit_vproduct_in_Vset_if_VLambda_in_VsetI:
  assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (rule Limit_vifunion_in_Vset_if_VLambda_in_VsetI)
      (simp_all add: assms)
  moreover from assms(2) have "I \<in>\<^sub>\<circ> Vset \<alpha>"
    by (metis vdomain_VLambda vdomain_in_VsetI)
  ultimately have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
    using assms by auto
  with assms(1) have "VPow (I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  from vsubset_in_VsetI[OF vproduct_vsubset_VPow[of I A] this] show ?thesis
    by simp
qed

lemma Limit_vdunion_in_Vset_if_VLambda_in_VsetI:
  assumes "Limit \<alpha>" and "VLambda I A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  interpret vsv \<open>VLambda I A\<close> by auto
  from assms have "\<D>\<^sub>\<circ> (VLambda I A) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (fastforce intro!: vdomain_in_VsetI)
  then have I: "I \<in>\<^sub>\<circ> Vset \<alpha>" by simp
  have "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (VLambda I A)))" by force
  moreover have "I \<times>\<^sub>\<circ> (\<Union>\<^sub>\<circ>(\<R>\<^sub>\<circ> (VLambda I A))) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (intro Limit_vtimes_in_VsetI assms I VUnion_in_VsetI vrange_in_VsetI)
  ultimately show "(\<Coprod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma vrange_vprojection_in_VsetI:
  assumes "Limit \<alpha>"
    and "A \<in>\<^sub>\<circ> Vset \<alpha>"
    and "\<And>f. f \<in>\<^sub>\<circ> A \<Longrightarrow> vsv f"
    and "\<And>f. f \<in>\<^sub>\<circ> A \<Longrightarrow> x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
  shows "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have "\<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))"
  proof(intro vsubsetI)
    fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (\<lambda>f\<in>\<^sub>\<circ>A. f\<lparr>x\<rparr>)"
    then obtain f where f: "f \<in>\<^sub>\<circ> A" and y_def: "y = f\<lparr>x\<rparr>" by auto
    from f have "vsv f" and "x \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> f" by (auto intro: assms(3,4))+
    with y_def have xy: "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> f" by auto
    show "y \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A))"
    proof(intro VUnionI)
      show "f \<in>\<^sub>\<circ> A" by (rule f)
      show "\<langle>x, y\<rangle> \<in>\<^sub>\<circ> f" by (rule xy)
      show "set {x, y} \<in>\<^sub>\<circ> \<langle>x, y\<rangle>" unfolding vpair_def by simp
    qed auto
  qed
  moreover from assms(1,2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>A)) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (intro VUnion_in_VsetI)
  ultimately show ?thesis by auto
qed

lemma Limit_vcpower_in_VsetI:
  assumes "Limit \<alpha>" and "n \<in>\<^sub>\<circ> Vset \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "vfinite n"
  shows "A ^\<^sub>\<times> n \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms Limit_vproduct_in_VsetI unfolding vcpower_def by auto

text\<open>Finite sets.\<close>

lemma Limit_vfinite_in_VsetI:
  assumes "Limit \<alpha>" and "A \<subseteq>\<^sub>\<circ> Vset \<alpha>" and "vfinite A"
  shows "A \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms(3) obtain n where n: "n \<in>\<^sub>\<circ> \<omega>" and "n \<approx>\<^sub>\<circ> A" by clarsimp
  then obtain f where f: "v11 f" and dr: "\<D>\<^sub>\<circ> f = n" "\<R>\<^sub>\<circ> f = A" by auto
  interpret f: v11 f by (rule f)
  from n have n: "vfinite n" by auto
  show ?thesis
    by (rule f.vsv_Limit_vrange_in_VsetI[simplified dr, OF assms(1,2) n])
qed

text\<open>Ordinal numbers.\<close>

lemma Limit_omega_in_VsetI:
  assumes "Limit \<alpha>"
  shows "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from assms have "\<alpha> \<subseteq>\<^sub>\<circ> Vset \<alpha>" by force
  moreover have "\<omega> \<subseteq>\<^sub>\<circ> \<alpha>" by (simp add: assms omega_le_Limit)
  moreover have "a\<^sub>\<nat> \<in>\<^sub>\<circ> \<omega>" by simp
  ultimately show "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma Limit_succ_in_VsetI:
  assumes "Limit \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "succ a \<in>\<^sub>\<circ> Vset \<alpha>"
  by (simp add: assms succ_def vinsert_in_VsetI)

text\<open>Sequences.\<close>

lemma (in vfsequence) vfsequence_Limit_vcons_in_VsetI:
  assumes "Limit \<alpha>" and "x \<in>\<^sub>\<circ> Vset \<alpha>" and "xs \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "vcons xs x \<in>\<^sub>\<circ> Vset \<alpha>"
  unfolding vcons_def
proof(intro vinsert_in_VsetI Limit_vpair_in_VsetI assms)
  show "vcard xs \<in>\<^sub>\<circ> Vset \<alpha>"
    by (metis assms(3) vdomain_in_VsetI vfsequence_vdomain)
qed

text\<open>\<open>ftimes\<close>.\<close>

lemma Limit_ftimes_in_VsetI:
  assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>" and "B \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "A \<times>\<^sub>\<bullet> B \<in>\<^sub>\<circ> Vset \<alpha>"
    unfolding ftimes_def
proof(rule Limit_vproduct_in_VsetI)
  from assms(1) show "2\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by (meson Limit_omega_in_VsetI)
  fix i assume "i \<in>\<^sub>\<circ> 2\<^sub>\<nat>"
  with assms(2,3) show "(i = 0 ? A : B) \<in>\<^sub>\<circ> Vset \<alpha>" by simp
qed (auto simp: assms(1))

text\<open>Auxiliary results.\<close>

lemma vempty_in_Vset_succ[simp, intro]: "0 \<in>\<^sub>\<circ> Vfrom a (succ b)"
  unfolding Vfrom_succ by force

lemma Limit_vid_on_in_Vset:
  assumes "Limit \<alpha>" and "A \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "vid_on A \<in>\<^sub>\<circ> Vset \<alpha>"
  by
    (
      rule vbrelation.vbrelation_Limit_in_VsetI
        [
          OF vbrelation_vid_on assms(1) ,
          unfolded vdomain_vid_on vrange_vid_on, OF assms(2,2)
        ]
    )

lemma Ord_vpair_in_Vset_succI[intro]:
  assumes "Ord \<alpha>" and "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> Vset (succ (succ \<alpha>))"
  unfolding vpair_def
proof-
  have aab: "set {set {a}, set {a, b}} = vinsert (set {a}) (set {set {a, b}})"
    by auto
  show "set {set {a}, set {a, b}} \<in>\<^sub>\<circ> Vset (succ (succ \<alpha>))"
    unfolding aab
    by
      (
        intro
          assms
          vinsert_in_Vset_succI'
          Ord_vsingleton_in_Vset_succI
          Ord_vdoubleton_in_Vset_succI
          Ord_succ
      )
qed

lemma Limit_vifunion_vsubset_VsetI:
  assumes "Limit \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>"
proof(intro vsubsetI)
  fix x assume "x \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
  then obtain i where i: "i \<in>\<^sub>\<circ> I" and "x \<in>\<^sub>\<circ> A i" by auto
  with assms(1) assms(2)[OF i] show "x \<in>\<^sub>\<circ> Vset \<alpha>" by auto
qed

lemma Limit_vproduct_vsubset_Vset_succI:
  assumes "Limit \<alpha>" and "I \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
proof(intro vsubsetI)
  fix a assume prems: "a \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)"
  note a = vproductD[OF prems]
  interpret vsv a by (rule a(1))
  from prems have "\<R>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i)" by (rule vproduct_vrange)
  moreover have "(\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset \<alpha>" by (intro vifunion_least assms(3))
  ultimately have "\<R>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> Vset \<alpha>" by auto
  moreover from assms(2) prems have "\<D>\<^sub>\<circ> a \<subseteq>\<^sub>\<circ> Vset \<alpha>" unfolding a(2) by auto
  ultimately have "a \<subseteq>\<^sub>\<circ> Vset \<alpha>"
    by (intro assms(1) vbrelation_Limit_vsubset_VsetI)
  with assms(1) show "a \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
    by (simp add: Limit_is_Ord Ord_vsubset_in_Vset_succI)
qed

lemma Limit_vproduct_vsubset_Vset_succI':
  assumes "Limit \<alpha>" and "I \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>i. i \<in>\<^sub>\<circ> I \<Longrightarrow> A i \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>I. A i) \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
proof-
  have "A i \<subseteq>\<^sub>\<circ> Vset \<alpha>" if "i \<in>\<^sub>\<circ> I" for i
    by (simp add: Vset_trans vsubsetI assms(3) that)
  from assms(1,2) this show ?thesis by (rule Limit_vproduct_vsubset_Vset_succI)
qed

lemma (in vfsequence) vfsequence_Ord_vcons_in_Vset_succI:
  assumes "Ord \<alpha>"
    and "\<omega> \<in>\<^sub>\<circ> \<alpha>"
    and "x \<in>\<^sub>\<circ> Vset \<alpha>"
    and "xs \<in>\<^sub>\<circ> Vset (succ (succ (succ \<alpha>)))"
  shows "vcons xs x \<in>\<^sub>\<circ> Vset (succ (succ (succ \<alpha>)))"
  unfolding vcons_def
proof(intro vinsert_in_Vset_succI' Ord_succ Ord_vpair_in_Vset_succI assms)
  have "vcard xs = \<D>\<^sub>\<circ> xs" by (simp add: vfsequence_vdomain)
  from assms(1,2) vfsequence_vdomain_in_omega show "vcard xs \<in>\<^sub>\<circ> Vset \<alpha>"
    unfolding vfsequence_vdomain[symmetric]
    by (meson Ord_in_in_VsetI Vset_trans)
qed

lemma Limit_VUnion_vdomain_in_VsetI:
  assumes "Limit \<alpha>" and "Q \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  have "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
  proof(intro vsubsetI)
    fix a assume "a \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<D>\<^sub>\<circ> r)"
    then obtain r where r: "r \<in>\<^sub>\<circ> Q" and "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> r" by auto
    with assms obtain b where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
    show "a \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
    proof(intro VUnionI)
      show "r \<in>\<^sub>\<circ> Q" by (rule r)
      show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by (rule ab)
      show "set {a, b} \<in>\<^sub>\<circ> \<langle>a, b\<rangle>" unfolding vpair_def by simp
    qed auto
  qed
  moreover from assms(2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q)) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (blast dest!: VUnion_in_VsetI)
  ultimately show ?thesis using assms(1) by (auto simp: vsubset_in_VsetI)
qed

lemma Limit_VUnion_vrange_in_VsetI:
  assumes "Limit \<alpha>" and "Q \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r) \<in>\<^sub>\<circ> Vset \<alpha>"
proof-(*FIXME: duality*)
  have "(\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r) \<subseteq>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
  proof(intro vsubsetI)
    fix b assume "b \<in>\<^sub>\<circ> (\<Union>\<^sub>\<circ>r\<in>\<^sub>\<circ>Q. \<R>\<^sub>\<circ> r)"
    then obtain r where r: "r \<in>\<^sub>\<circ> Q" and "b \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> r" by auto
    with assms obtain a where ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by auto
    show "b \<in>\<^sub>\<circ> \<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q))"
    proof(intro VUnionI)
      show "r \<in>\<^sub>\<circ> Q" by (rule r)
      show "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> r" by (rule ab)
      show "set {a, b} \<in>\<^sub>\<circ> \<langle>a, b\<rangle>" unfolding vpair_def by simp
    qed auto
  qed
  moreover from assms(2) have "\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>(\<Union>\<^sub>\<circ>Q)) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (blast dest!: VUnion_in_VsetI)
  ultimately show ?thesis using assms(1) by (auto simp: vsubset_in_VsetI)
qed

subsection\<open>Axioms for \<^term>\<open>Vset \<alpha>\<close>\<close>

text\<open>
The subsection demonstrates that the axioms of ZFC except for the
Axiom Schema of Replacement hold in \<^term>\<open>Vset \<alpha>\<close> for any limit ordinal
\<^term>\<open>\<alpha>\<close> such that \<^term>\<open>\<omega> \<in>\<^sub>\<circ> \<alpha>\<close>\footnote{The presentation of the axioms is
loosely based on the statement of the axioms of ZFC in Chapters 1-11 in
\<^cite>\<open>"takeuti_introduction_1971"\<close>.}.
\<close>

locale \<Z> =
  fixes \<alpha>
  assumes Limit_\<alpha>[intro, simp]: "Limit \<alpha>"
    and omega_in_\<alpha>[intro, simp]: "\<omega> \<in>\<^sub>\<circ> \<alpha>"
begin

lemmas [intro] = \<Z>_axioms

lemma vempty_Z_def: "0 = set {x. x \<noteq> x}" by auto

lemma vempty_is_zet[intro, simp]: "0 \<in>\<^sub>\<circ> Vset \<alpha>"
  using Vset_in_mono omega_in_\<alpha> by auto

lemma Axiom_of_Extensionality:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "x = y" and "x \<in>\<^sub>\<circ> a"
  shows "y \<in>\<^sub>\<circ> a" and "x \<in>\<^sub>\<circ> Vset \<alpha>" and "y \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (simp_all add: Vset_trans)

lemma Axiom_of_Pairing:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>" and "b \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "set {a, b} \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (simp add: Limit_vdoubleton_in_VsetI)

lemma Axiom_of_Unions:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "\<Union>\<^sub>\<circ>a \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (simp add: VUnion_in_VsetI)

lemma Axiom_of_Powers:
  assumes "a \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "VPow a \<in>\<^sub>\<circ> Vset \<alpha>"
  using assms by (simp add: Limit_VPow_in_VsetI)

lemma Axiom_of_Regularity:
  assumes "a \<noteq> 0" and "a \<in>\<^sub>\<circ> Vset \<alpha>"
  obtains x where "x \<in>\<^sub>\<circ> a" and "x \<inter>\<^sub>\<circ> a = 0"
  using assms by (auto dest: trad_foundation)

lemma Axiom_of_Infinity: "\<omega> \<in>\<^sub>\<circ> Vset \<alpha>"
  using Limit_is_Ord by (auto simp: Ord_iff_rank Ord_VsetI OrdmemD)

lemma Axiom_of_Choice:
  assumes "A \<in>\<^sub>\<circ> Vset \<alpha>"
  obtains f where "f \<in>\<^sub>\<circ> Vset \<alpha>" and "\<And>x. x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x"
proof-
  define f where "f = (\<lambda>x\<in>\<^sub>\<circ>A. (SOME a. a \<in>\<^sub>\<circ> x \<or> (x = 0 \<and> a = 0)))"
  interpret vsv f unfolding f_def by auto
  have A_def: "A = \<D>\<^sub>\<circ> f" unfolding f_def by simp
  have Rf: "\<R>\<^sub>\<circ> f \<subseteq>\<^sub>\<circ> vinsert 0 (\<Union>\<^sub>\<circ>A)"
  proof(rule vsubsetI)
    fix y assume "y \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> f"
    then obtain x where "x \<in>\<^sub>\<circ> A" and "y = f\<lparr>x\<rparr>"
      unfolding A_def by (blast dest: vrange_atD)
    then have y_def: "y = (SOME a. a \<in>\<^sub>\<circ> x \<or> x = 0 \<and> a = 0)"
      unfolding f_def unfolding A_def by simp
    have "y = 0 \<or> y \<in>\<^sub>\<circ> x"
    proof(cases \<open>x = 0\<close>)
      case False then show ?thesis
        unfolding y_def by (metis (mono_tags, lifting) verit_sko_ex' vemptyE)
    qed (simp add: y_def)
    with \<open>x \<in>\<^sub>\<circ> A\<close> show "y \<in>\<^sub>\<circ> vinsert 0 (\<Union>\<^sub>\<circ>A)" by clarsimp
  qed
  from assms have "\<Union>\<^sub>\<circ>A \<in>\<^sub>\<circ> Vset \<alpha>" by (simp add: Axiom_of_Unions)
  with vempty_is_zet Limit_\<alpha> have "vinsert 0 (\<Union>\<^sub>\<circ>A) \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  with Rf have "\<R>\<^sub>\<circ> f \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  with Limit_\<alpha> assms[unfolded A_def] have "f \<in>\<^sub>\<circ> Vset \<alpha>" by auto
  moreover have "x \<in>\<^sub>\<circ> A \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x" for x
  proof-
    assume prems: "x \<in>\<^sub>\<circ> A" "x \<noteq> 0"
    then have "f\<lparr>x\<rparr> = (SOME a. a \<in>\<^sub>\<circ> x \<or> (x = 0 \<and> a = 0))"
      unfolding f_def by simp
    with prems(2) show "f\<lparr>x\<rparr> \<in>\<^sub>\<circ> x"
      by (metis (mono_tags, lifting) someI_ex vemptyE)
  qed
  ultimately show ?thesis by (simp add: that)
qed

end

text\<open>Trivial corollaries.\<close>

lemma (in \<Z>) Ord_\<alpha>: "Ord \<alpha>" by auto

lemma (in \<Z>) \<Z>_Vset_\<omega>2_vsubset_Vset: "Vset (\<omega> + \<omega>) \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  by (simp add: Vset_vsubset_mono omega2_vsubset_Limit)

lemma (in \<Z>) \<Z>_Limit_\<alpha>\<omega>: "Limit (\<alpha> + \<omega>)" by (simp add: Limit_is_Ord)

lemma (in \<Z>) \<Z>_\<alpha>_\<alpha>\<omega>: "\<alpha> \<in>\<^sub>\<circ> \<alpha> + \<omega>"
  by (simp add: Limit_is_Ord Ord_mem_iff_lt)

lemma (in \<Z>) \<Z>_\<omega>_\<alpha>\<omega>: "\<omega> \<in>\<^sub>\<circ> \<alpha> + \<omega>"
  using add_le_cancel_left0 by blast

lemma \<Z>_\<omega>\<omega>: "\<Z> (\<omega> + \<omega>)"
  using \<omega>_gt0 by (auto intro: \<Z>.intro simp: Ord_mem_iff_lt)

lemma (in \<Z>) in_omega_in_omega_plus[intro]:
  assumes "a \<in>\<^sub>\<circ> \<omega>"
  shows "a \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)"
proof-
  from assms have "a \<in>\<^sub>\<circ> Vset \<omega>" by auto
  moreover have "Vset \<omega> \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)" by (simp add: Vset_in_mono \<Z>_\<omega>_\<alpha>\<omega>)
  ultimately show "a \<in>\<^sub>\<circ> Vset (\<alpha> + \<omega>)" by auto
qed

lemma (in \<Z>) ord_of_nat_in_Vset[simp]: "a\<^sub>\<nat> \<in>\<^sub>\<circ> Vset \<alpha>" by force

text\<open>\<open>vfsequences_on\<close>.\<close>

lemma (in \<Z>) vfsequences_on_in_VsetI:
  assumes "X \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "vfsequences_on X \<in>\<^sub>\<circ> Vset \<alpha>"
proof-
  from vfsequences_on_subset_\<omega>_set have "vfsequences_on X \<subseteq>\<^sub>\<circ> VPow (\<omega> \<times>\<^sub>\<circ> X)"
    by (auto simp: less_eq_V_def)
  moreover have "VPow (\<omega> \<times>\<^sub>\<circ> X) \<in>\<^sub>\<circ> Vset \<alpha>"
    by (intro Limit_VPow_in_VsetI Limit_vtimes_in_VsetI assms Axiom_of_Infinity)
      auto
  ultimately show ?thesis by auto
qed

subsection\<open>Existence of a disjoint subset in \<^term>\<open>Vset \<alpha>\<close>\<close>

definition mk_doubleton :: "V \<Rightarrow> V \<Rightarrow> V"
  where "mk_doubleton X a = set {a, X}"

definition mk_doubleton_image :: "V \<Rightarrow> V \<Rightarrow> V"
  where "mk_doubleton_image X Y = set (mk_doubleton Y ` elts X)"

lemma inj_on_mk_doubleton: "inj_on (mk_doubleton X) (elts X)"
proof
  fix a b assume "mk_doubleton X a = mk_doubleton X b"
  then have "{a, X} = {b, X}" unfolding mk_doubleton_def by auto
  then show "a = b" by (metis doubleton_eq_iff)
qed

lemma mk_doubleton_image_vsubset_veqpoll:
  assumes "X \<subseteq>\<^sub>\<circ> Y"
  shows "mk_doubleton_image X X \<approx>\<^sub>\<circ> mk_doubleton_image X Y"
  unfolding eqpoll_def
proof(intro exI[of _ \<open>\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})\<close>] bij_betw_imageI)
  show "inj_on (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) (elts (mk_doubleton_image X X))"
    unfolding mk_doubleton_image_def
  proof(intro inj_onI)
    fix y y' assume prems:
      "y \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
      "y' \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
      "vinsert Y (y -\<^sub>\<circ> set {X}) = vinsert Y (y' -\<^sub>\<circ> set {X})"
    then obtain x x'
      where "x \<in>\<^sub>\<circ> X"
        and "x' \<in>\<^sub>\<circ> X"
        and y_def: "y = set {x, X}"
        and y'_def: "y' = set {x', X}"
      by (clarsimp simp: mk_doubleton_def)
    with assms have xX_X: "set {x, X} -\<^sub>\<circ> set {X} = set {x}"
      and x'X_X: "set {x', X} -\<^sub>\<circ> set {X} = set {x'}"
      by fastforce+
    from prems(3)[unfolded y_def y'_def] have "set {x, Y} = set {x', Y}"
      unfolding xX_X x'X_X by auto
    then have "x = x'" by (auto simp: doubleton_eq_iff)
    then show "y = y'" unfolding y_def y'_def by simp
  qed
  show
    "(\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X)) =
      (elts (mk_doubleton_image X Y))"
  proof(intro subset_antisym subsetI)
    fix z
    assume prems:
      "z \<in> (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X))"
    then obtain y
      where "y \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
        and z_def: "z = vinsert Y (y -\<^sub>\<circ> set {X})"
      unfolding mk_doubleton_image_def by auto
    then obtain x where xX: "x \<in>\<^sub>\<circ> X" and y_def: "y = set {x, X}"
      unfolding mk_doubleton_def by clarsimp
    from xX have y_X: "y -\<^sub>\<circ> set {X} = set {x}" unfolding y_def by fastforce
    from z_def have z_def': "z = set {x, Y}"
      unfolding y_X by (simp add: doubleton_eq_iff vinsert_vsingleton)
    from xX show "z \<in>\<^sub>\<circ> mk_doubleton_image X Y"
      unfolding z_def' mk_doubleton_def mk_doubleton_image_def by simp
  next
    fix z assume prems: "z \<in>\<^sub>\<circ> mk_doubleton_image X Y"
    then obtain x where xX: "x \<in>\<^sub>\<circ> X" and z_def: "z = set {x, Y}"
      unfolding mk_doubleton_def mk_doubleton_image_def by clarsimp
    from xX have xX_XX: "set {x, X} \<in>\<^sub>\<circ> set (mk_doubleton X ` elts X)"
      unfolding mk_doubleton_def by simp
    from xX have xX_X: "set {x, X} -\<^sub>\<circ> set {X} = set {x}" by fastforce
    have z_def': "z = vinsert Y (set {x, X} -\<^sub>\<circ> set {X})"
      unfolding xX_X z_def by auto
    with xX_XX show
      "z \<in> (\<lambda>A. vinsert Y (A -\<^sub>\<circ> set {X})) ` (elts (mk_doubleton_image X X))"
      unfolding z_def' mk_doubleton_image_def by simp
  qed
qed

lemma mk_doubleton_image_veqpoll:
  assumes "X \<subseteq>\<^sub>\<circ> Y"
  shows "X \<approx>\<^sub>\<circ> mk_doubleton_image X Y"
proof-
  have "X \<approx>\<^sub>\<circ> mk_doubleton_image X X"
    unfolding mk_doubleton_image_def by (auto simp: inj_on_mk_doubleton)
  also have "\<dots> \<approx> elts (mk_doubleton_image X Y)"
    by (rule mk_doubleton_image_vsubset_veqpoll[OF assms])
  finally show "X \<approx>\<^sub>\<circ> mk_doubleton_image X Y".
qed

lemma vdisjnt_mk_doubleton_image: "vdisjnt (mk_doubleton_image X Y) Y"
proof
  fix b assume prems: "b \<in>\<^sub>\<circ> Y" "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
  then obtain a where "a \<in>\<^sub>\<circ> X" and "set {a, Y} = b"
    unfolding mk_doubleton_def mk_doubleton_image_def by clarsimp
  then have "Y \<in>\<^sub>\<circ> b" by clarsimp
  with mem_not_sym show False by (simp add: prems)
qed

lemma Limit_mk_doubleton_image_vsubset_Vset:
  assumes "Limit \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "mk_doubleton_image X Y \<subseteq>\<^sub>\<circ> Vset \<alpha>"
proof(intro vsubsetI)
  fix b assume "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
  then obtain a where "b = mk_doubleton Y a" and "a \<in>\<^sub>\<circ> X"
    unfolding mk_doubleton_image_def by clarsimp
  with assms have b_def: "b = set {a, Y}" and a\<alpha>: "a \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: mk_doubleton_def)
  from this(2) assms show "b \<in>\<^sub>\<circ> Vset \<alpha>"
    unfolding b_def by (simp add: Limit_vdoubleton_in_VsetI)
qed

lemma Ord_mk_doubleton_image_vsubset_Vset_succ:
  assumes "Ord \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
  shows "mk_doubleton_image X Y \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
proof(intro vsubsetI)
  fix b assume "b \<in>\<^sub>\<circ> mk_doubleton_image X Y"
  then obtain a where "b = mk_doubleton Y a" and "a \<in>\<^sub>\<circ> X"
    unfolding mk_doubleton_image_def by clarsimp
  with assms have b_def: "b = set {a, Y}" and a\<alpha>: "a \<in>\<^sub>\<circ> Vset \<alpha>"
    by (auto simp: mk_doubleton_def)
  from this(2) assms show "b \<in>\<^sub>\<circ> Vset (succ \<alpha>)"
    unfolding b_def by (simp add: Ord_vdoubleton_in_Vset_succI)
qed

lemma Limit_ex_eqpoll_vdisjnt:
  assumes "Limit \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
  obtains Z where "X \<approx>\<^sub>\<circ> Z" and "vdisjnt Z Y" and "Z \<subseteq>\<^sub>\<circ> Vset \<alpha>"
  using assms
  by (intro that[of \<open>mk_doubleton_image X Y\<close>])
    (
      simp_all add:
        mk_doubleton_image_veqpoll
        vdisjnt_mk_doubleton_image
        Limit_mk_doubleton_image_vsubset_Vset
    )

lemma Ord_ex_eqpoll_vdisjnt:
  assumes "Ord \<alpha>" and "X \<subseteq>\<^sub>\<circ> Y" and "Y \<in>\<^sub>\<circ> Vset \<alpha>"
  obtains Z where "X \<approx>\<^sub>\<circ> Z" and "vdisjnt Z Y" and "Z \<subseteq>\<^sub>\<circ> Vset (succ \<alpha>)"
  using assms
  by (intro that[of \<open>mk_doubleton_image X Y\<close>])
    (
      simp_all add:
        mk_doubleton_image_veqpoll
        vdisjnt_mk_doubleton_image
        Ord_mk_doubleton_image_vsubset_Vset_succ
    )

text\<open>\newpage\<close>

end


(*  Title:      HOL/HOLCF/Deflation.thy
    Author:     Brian Huffman
*)

section \<open>Continuous deflations and ep-pairs\<close>

theory Deflation
  imports Cfun
begin

default_sort cpo

subsection \<open>Continuous deflations\<close>

locale deflation =
  fixes d :: "'a \<rightarrow> 'a"
  assumes idem: "\<And>x. d\<cdot>(d\<cdot>x) = d\<cdot>x"
  assumes below: "\<And>x. d\<cdot>x \<sqsubseteq> x"
begin

lemma below_ID: "d \<sqsubseteq> ID"
  by (rule cfun_belowI) (simp add: below)

text \<open>The set of fixed points is the same as the range.\<close>

lemma fixes_eq_range: "{x. d\<cdot>x = x} = range (\<lambda>x. d\<cdot>x)"
  by (auto simp add: eq_sym_conv idem)

lemma range_eq_fixes: "range (\<lambda>x. d\<cdot>x) = {x. d\<cdot>x = x}"
  by (auto simp add: eq_sym_conv idem)

text \<open>
  The pointwise ordering on deflation functions coincides with
  the subset ordering of their sets of fixed-points.
\<close>

lemma belowI:
  assumes f: "\<And>x. d\<cdot>x = x \<Longrightarrow> f\<cdot>x = x"
  shows "d \<sqsubseteq> f"
proof (rule cfun_belowI)
  fix x
  from below have "f\<cdot>(d\<cdot>x) \<sqsubseteq> f\<cdot>x"
    by (rule monofun_cfun_arg)
  also from idem have "f\<cdot>(d\<cdot>x) = d\<cdot>x"
    by (rule f)
  finally show "d\<cdot>x \<sqsubseteq> f\<cdot>x" .
qed

lemma belowD: "\<lbrakk>f \<sqsubseteq> d; f\<cdot>x = x\<rbrakk> \<Longrightarrow> d\<cdot>x = x"
proof (rule below_antisym)
  from below show "d\<cdot>x \<sqsubseteq> x" .
  assume "f \<sqsubseteq> d"
  then have "f\<cdot>x \<sqsubseteq> d\<cdot>x" by (rule monofun_cfun_fun)
  also assume "f\<cdot>x = x"
  finally show "x \<sqsubseteq> d\<cdot>x" .
qed

end

lemma deflation_strict: "deflation d \<Longrightarrow> d\<cdot>\<bottom> = \<bottom>"
  by (rule deflation.below [THEN bottomI])

lemma adm_deflation: "adm (\<lambda>d. deflation d)"
  by (simp add: deflation_def)

lemma deflation_ID: "deflation ID"
  by (simp add: deflation.intro)

lemma deflation_bottom: "deflation \<bottom>"
  by (simp add: deflation.intro)

lemma deflation_below_iff: "deflation p \<Longrightarrow> deflation q \<Longrightarrow> p \<sqsubseteq> q \<longleftrightarrow> (\<forall>x. p\<cdot>x = x \<longrightarrow> q\<cdot>x = x)"
  apply safe
   apply (simp add: deflation.belowD)
  apply (simp add: deflation.belowI)
  done

text \<open>
  The composition of two deflations is equal to
  the lesser of the two (if they are comparable).
\<close>

lemma deflation_below_comp1:
  assumes "deflation f"
  assumes "deflation g"
  shows "f \<sqsubseteq> g \<Longrightarrow> f\<cdot>(g\<cdot>x) = f\<cdot>x"
proof (rule below_antisym)
  interpret g: deflation g by fact
  from g.below show "f\<cdot>(g\<cdot>x) \<sqsubseteq> f\<cdot>x" by (rule monofun_cfun_arg)
next
  interpret f: deflation f by fact
  assume "f \<sqsubseteq> g"
  then have "f\<cdot>x \<sqsubseteq> g\<cdot>x" by (rule monofun_cfun_fun)
  then have "f\<cdot>(f\<cdot>x) \<sqsubseteq> f\<cdot>(g\<cdot>x)" by (rule monofun_cfun_arg)
  also have "f\<cdot>(f\<cdot>x) = f\<cdot>x" by (rule f.idem)
  finally show "f\<cdot>x \<sqsubseteq> f\<cdot>(g\<cdot>x)" .
qed

lemma deflation_below_comp2: "deflation f \<Longrightarrow> deflation g \<Longrightarrow> f \<sqsubseteq> g \<Longrightarrow> g\<cdot>(f\<cdot>x) = f\<cdot>x"
  by (simp only: deflation.belowD deflation.idem)

subsection \<open>Deflations with finite range\<close>

lemma finite_range_imp_finite_fixes:
  assumes "finite (range f)"
  shows "finite {x. f x = x}"
proof -
  have "{x. f x = x} \<subseteq> range f"
    by (clarify, erule subst, rule rangeI)
  from this assms show "finite {x. f x = x}"
    by (rule finite_subset)
qed

locale finite_deflation = deflation +
  assumes finite_fixes: "finite {x. d\<cdot>x = x}"
begin

lemma finite_range: "finite (range (\<lambda>x. d\<cdot>x))"
  by (simp add: range_eq_fixes finite_fixes)

lemma finite_image: "finite ((\<lambda>x. d\<cdot>x) ` A)"
  by (rule finite_subset [OF image_mono [OF subset_UNIV] finite_range])

lemma compact: "compact (d\<cdot>x)"
proof (rule compactI2)
  fix Y :: "nat \<Rightarrow> 'a"
  assume Y: "chain Y"
  have "finite_chain (\<lambda>i. d\<cdot>(Y i))"
  proof (rule finite_range_imp_finch)
    from Y show "chain (\<lambda>i. d\<cdot>(Y i))" by simp
    have "range (\<lambda>i. d\<cdot>(Y i)) \<subseteq> range (\<lambda>x. d\<cdot>x)" by auto
    then show "finite (range (\<lambda>i. d\<cdot>(Y i)))"
      using finite_range by (rule finite_subset)
  qed
  then have "\<exists>j. (\<Squnion>i. d\<cdot>(Y i)) = d\<cdot>(Y j)"
    by (simp add: finite_chain_def maxinch_is_thelub Y)
  then obtain j where j: "(\<Squnion>i. d\<cdot>(Y i)) = d\<cdot>(Y j)" ..

  assume "d\<cdot>x \<sqsubseteq> (\<Squnion>i. Y i)"
  then have "d\<cdot>(d\<cdot>x) \<sqsubseteq> d\<cdot>(\<Squnion>i. Y i)"
    by (rule monofun_cfun_arg)
  then have "d\<cdot>x \<sqsubseteq> (\<Squnion>i. d\<cdot>(Y i))"
    by (simp add: contlub_cfun_arg Y idem)
  with j have "d\<cdot>x \<sqsubseteq> d\<cdot>(Y j)" by simp
  then have "d\<cdot>x \<sqsubseteq> Y j"
    using below by (rule below_trans)
  then show "\<exists>j. d\<cdot>x \<sqsubseteq> Y j" ..
qed

end

lemma finite_deflation_intro: "deflation d \<Longrightarrow> finite {x. d\<cdot>x = x} \<Longrightarrow> finite_deflation d"
  by (intro finite_deflation.intro finite_deflation_axioms.intro)

lemma finite_deflation_imp_deflation: "finite_deflation d \<Longrightarrow> deflation d"
  by (simp add: finite_deflation_def)

lemma finite_deflation_bottom: "finite_deflation \<bottom>"
  by standard simp_all

subsection \<open>Continuous embedding-projection pairs\<close>

locale ep_pair =
  fixes e :: "'a \<rightarrow> 'b" and p :: "'b \<rightarrow> 'a"
  assumes e_inverse [simp]: "\<And>x. p\<cdot>(e\<cdot>x) = x"
  and e_p_below: "\<And>y. e\<cdot>(p\<cdot>y) \<sqsubseteq> y"
begin

lemma e_below_iff [simp]: "e\<cdot>x \<sqsubseteq> e\<cdot>y \<longleftrightarrow> x \<sqsubseteq> y"
proof
  assume "e\<cdot>x \<sqsubseteq> e\<cdot>y"
  then have "p\<cdot>(e\<cdot>x) \<sqsubseteq> p\<cdot>(e\<cdot>y)" by (rule monofun_cfun_arg)
  then show "x \<sqsubseteq> y" by simp
next
  assume "x \<sqsubseteq> y"
  then show "e\<cdot>x \<sqsubseteq> e\<cdot>y" by (rule monofun_cfun_arg)
qed

lemma e_eq_iff [simp]: "e\<cdot>x = e\<cdot>y \<longleftrightarrow> x = y"
  unfolding po_eq_conv e_below_iff ..

lemma p_eq_iff: "e\<cdot>(p\<cdot>x) = x \<Longrightarrow> e\<cdot>(p\<cdot>y) = y \<Longrightarrow> p\<cdot>x = p\<cdot>y \<longleftrightarrow> x = y"
  by (safe, erule subst, erule subst, simp)

lemma p_inverse: "(\<exists>x. y = e\<cdot>x) \<longleftrightarrow> e\<cdot>(p\<cdot>y) = y"
  by (auto, rule exI, erule sym)

lemma e_below_iff_below_p: "e\<cdot>x \<sqsubseteq> y \<longleftrightarrow> x \<sqsubseteq> p\<cdot>y"
proof
  assume "e\<cdot>x \<sqsubseteq> y"
  then have "p\<cdot>(e\<cdot>x) \<sqsubseteq> p\<cdot>y" by (rule monofun_cfun_arg)
  then show "x \<sqsubseteq> p\<cdot>y" by simp
next
  assume "x \<sqsubseteq> p\<cdot>y"
  then have "e\<cdot>x \<sqsubseteq> e\<cdot>(p\<cdot>y)" by (rule monofun_cfun_arg)
  then show "e\<cdot>x \<sqsubseteq> y" using e_p_below by (rule below_trans)
qed

lemma compact_e_rev: "compact (e\<cdot>x) \<Longrightarrow> compact x"
proof -
  assume "compact (e\<cdot>x)"
  then have "adm (\<lambda>y. e\<cdot>x \<notsqsubseteq> y)" by (rule compactD)
  then have "adm (\<lambda>y. e\<cdot>x \<notsqsubseteq> e\<cdot>y)" by (rule adm_subst [OF cont_Rep_cfun2])
  then have "adm (\<lambda>y. x \<notsqsubseteq> y)" by simp
  then show "compact x" by (rule compactI)
qed

lemma compact_e:
  assumes "compact x"
  shows "compact (e\<cdot>x)"
proof -
  from assms have "adm (\<lambda>y. x \<notsqsubseteq> y)" by (rule compactD)
  then have "adm (\<lambda>y. x \<notsqsubseteq> p\<cdot>y)" by (rule adm_subst [OF cont_Rep_cfun2])
  then have "adm (\<lambda>y. e\<cdot>x \<notsqsubseteq> y)" by (simp add: e_below_iff_below_p)
  then show "compact (e\<cdot>x)" by (rule compactI)
qed

lemma compact_e_iff: "compact (e\<cdot>x) \<longleftrightarrow> compact x"
  by (rule iffI [OF compact_e_rev compact_e])

text \<open>Deflations from ep-pairs\<close>

lemma deflation_e_p: "deflation (e oo p)"
  by (simp add: deflation.intro e_p_below)

lemma deflation_e_d_p:
  assumes "deflation d"
  shows "deflation (e oo d oo p)"
proof
  interpret deflation d by fact
  fix x :: 'b
  show "(e oo d oo p)\<cdot>((e oo d oo p)\<cdot>x) = (e oo d oo p)\<cdot>x"
    by (simp add: idem)
  show "(e oo d oo p)\<cdot>x \<sqsubseteq> x"
    by (simp add: e_below_iff_below_p below)
qed

lemma finite_deflation_e_d_p:
  assumes "finite_deflation d"
  shows "finite_deflation (e oo d oo p)"
proof
  interpret finite_deflation d by fact
  fix x :: 'b
  show "(e oo d oo p)\<cdot>((e oo d oo p)\<cdot>x) = (e oo d oo p)\<cdot>x"
    by (simp add: idem)
  show "(e oo d oo p)\<cdot>x \<sqsubseteq> x"
    by (simp add: e_below_iff_below_p below)
  have "finite ((\<lambda>x. e\<cdot>x) ` (\<lambda>x. d\<cdot>x) ` range (\<lambda>x. p\<cdot>x))"
    by (simp add: finite_image)
  then have "finite (range (\<lambda>x. (e oo d oo p)\<cdot>x))"
    by (simp add: image_image)
  then show "finite {x. (e oo d oo p)\<cdot>x = x}"
    by (rule finite_range_imp_finite_fixes)
qed

lemma deflation_p_d_e:
  assumes "deflation d"
  assumes d: "\<And>x. d\<cdot>x \<sqsubseteq> e\<cdot>(p\<cdot>x)"
  shows "deflation (p oo d oo e)"
proof -
  interpret d: deflation d by fact
  have p_d_e_below: "(p oo d oo e)\<cdot>x \<sqsubseteq> x" for x
  proof -
    have "d\<cdot>(e\<cdot>x) \<sqsubseteq> e\<cdot>x"
      by (rule d.below)
    then have "p\<cdot>(d\<cdot>(e\<cdot>x)) \<sqsubseteq> p\<cdot>(e\<cdot>x)"
      by (rule monofun_cfun_arg)
    then show ?thesis by simp
  qed
  show ?thesis
  proof
    show "(p oo d oo e)\<cdot>x \<sqsubseteq> x" for x
      by (rule p_d_e_below)
    show "(p oo d oo e)\<cdot>((p oo d oo e)\<cdot>x) = (p oo d oo e)\<cdot>x" for x
    proof (rule below_antisym)
      show "(p oo d oo e)\<cdot>((p oo d oo e)\<cdot>x) \<sqsubseteq> (p oo d oo e)\<cdot>x"
        by (rule p_d_e_below)
      have "p\<cdot>(d\<cdot>(d\<cdot>(d\<cdot>(e\<cdot>x)))) \<sqsubseteq> p\<cdot>(d\<cdot>(e\<cdot>(p\<cdot>(d\<cdot>(e\<cdot>x)))))"
        by (intro monofun_cfun_arg d)
      then have "p\<cdot>(d\<cdot>(e\<cdot>x)) \<sqsubseteq> p\<cdot>(d\<cdot>(e\<cdot>(p\<cdot>(d\<cdot>(e\<cdot>x)))))"
        by (simp only: d.idem)
      then show "(p oo d oo e)\<cdot>x \<sqsubseteq> (p oo d oo e)\<cdot>((p oo d oo e)\<cdot>x)"
        by simp
    qed
  qed
qed

lemma finite_deflation_p_d_e:
  assumes "finite_deflation d"
  assumes d: "\<And>x. d\<cdot>x \<sqsubseteq> e\<cdot>(p\<cdot>x)"
  shows "finite_deflation (p oo d oo e)"
proof -
  interpret d: finite_deflation d by fact
  show ?thesis
  proof (rule finite_deflation_intro)
    have "deflation d" ..
    then show "deflation (p oo d oo e)"
      using d by (rule deflation_p_d_e)
  next
    have "finite ((\<lambda>x. d\<cdot>x) ` range (\<lambda>x. e\<cdot>x))"
      by (rule d.finite_image)
    then have "finite ((\<lambda>x. p\<cdot>x) ` (\<lambda>x. d\<cdot>x) ` range (\<lambda>x. e\<cdot>x))"
      by (rule finite_imageI)
    then have "finite (range (\<lambda>x. (p oo d oo e)\<cdot>x))"
      by (simp add: image_image)
    then show "finite {x. (p oo d oo e)\<cdot>x = x}"
      by (rule finite_range_imp_finite_fixes)
  qed
qed

end

subsection \<open>Uniqueness of ep-pairs\<close>

lemma ep_pair_unique_e_lemma:
  assumes 1: "ep_pair e1 p"
    and 2: "ep_pair e2 p"
  shows "e1 \<sqsubseteq> e2"
proof (rule cfun_belowI)
  fix x
  have "e1\<cdot>(p\<cdot>(e2\<cdot>x)) \<sqsubseteq> e2\<cdot>x"
    by (rule ep_pair.e_p_below [OF 1])
  then show "e1\<cdot>x \<sqsubseteq> e2\<cdot>x"
    by (simp only: ep_pair.e_inverse [OF 2])
qed

lemma ep_pair_unique_e: "ep_pair e1 p \<Longrightarrow> ep_pair e2 p \<Longrightarrow> e1 = e2"
  by (fast intro: below_antisym elim: ep_pair_unique_e_lemma)

lemma ep_pair_unique_p_lemma:
  assumes 1: "ep_pair e p1"
    and 2: "ep_pair e p2"
  shows "p1 \<sqsubseteq> p2"
proof (rule cfun_belowI)
  fix x
  have "e\<cdot>(p1\<cdot>x) \<sqsubseteq> x"
    by (rule ep_pair.e_p_below [OF 1])
  then have "p2\<cdot>(e\<cdot>(p1\<cdot>x)) \<sqsubseteq> p2\<cdot>x"
    by (rule monofun_cfun_arg)
  then show "p1\<cdot>x \<sqsubseteq> p2\<cdot>x"
    by (simp only: ep_pair.e_inverse [OF 2])
qed

lemma ep_pair_unique_p: "ep_pair e p1 \<Longrightarrow> ep_pair e p2 \<Longrightarrow> p1 = p2"
  by (fast intro: below_antisym elim: ep_pair_unique_p_lemma)

subsection \<open>Composing ep-pairs\<close>

lemma ep_pair_ID_ID: "ep_pair ID ID"
  by standard simp_all

lemma ep_pair_comp:
  assumes "ep_pair e1 p1" and "ep_pair e2 p2"
  shows "ep_pair (e2 oo e1) (p1 oo p2)"
proof
  interpret ep1: ep_pair e1 p1 by fact
  interpret ep2: ep_pair e2 p2 by fact
  fix x y
  show "(p1 oo p2)\<cdot>((e2 oo e1)\<cdot>x) = x"
    by simp
  have "e1\<cdot>(p1\<cdot>(p2\<cdot>y)) \<sqsubseteq> p2\<cdot>y"
    by (rule ep1.e_p_below)
  then have "e2\<cdot>(e1\<cdot>(p1\<cdot>(p2\<cdot>y))) \<sqsubseteq> e2\<cdot>(p2\<cdot>y)"
    by (rule monofun_cfun_arg)
  also have "e2\<cdot>(p2\<cdot>y) \<sqsubseteq> y"
    by (rule ep2.e_p_below)
  finally show "(e2 oo e1)\<cdot>((p1 oo p2)\<cdot>y) \<sqsubseteq> y"
    by simp
qed

locale pcpo_ep_pair = ep_pair e p
  for e :: "'a::pcpo \<rightarrow> 'b::pcpo"
  and p :: "'b::pcpo \<rightarrow> 'a::pcpo"
begin

lemma e_strict [simp]: "e\<cdot>\<bottom> = \<bottom>"
proof -
  have "\<bottom> \<sqsubseteq> p\<cdot>\<bottom>" by (rule minimal)
  then have "e\<cdot>\<bottom> \<sqsubseteq> e\<cdot>(p\<cdot>\<bottom>)" by (rule monofun_cfun_arg)
  also have "e\<cdot>(p\<cdot>\<bottom>) \<sqsubseteq> \<bottom>" by (rule e_p_below)
  finally show "e\<cdot>\<bottom> = \<bottom>" by simp
qed

lemma e_bottom_iff [simp]: "e\<cdot>x = \<bottom> \<longleftrightarrow> x = \<bottom>"
  by (rule e_eq_iff [where y="\<bottom>", unfolded e_strict])

lemma e_defined: "x \<noteq> \<bottom> \<Longrightarrow> e\<cdot>x \<noteq> \<bottom>"
  by simp

lemma p_strict [simp]: "p\<cdot>\<bottom> = \<bottom>"
  by (rule e_inverse [where x="\<bottom>", unfolded e_strict])

lemmas stricts = e_strict p_strict

end

end


(* Authors:  Florian Haftmann and René Neumann, TU Muenchen *)

header {* Abstract priority queues *}

theory PQ
imports Main
begin

subsection {* Generic Lemmas *}

lemma tl_set:
  "distinct q \<Longrightarrow> set (tl q) = set q - {hd q}"
  by (cases q) simp_all

subsection {* Type of abstract priority queues *}

typedef ('a, 'b::linorder) pq =
  "{xs \<Colon> ('a \<times> 'b) list. distinct (map fst xs) \<and> sorted (map snd xs)}"
  morphisms alist_of Abs_pq
proof -
  have "[] \<in> ?pq" by simp
  then show ?thesis by blast
qed

lemma alist_of_Abs_pq:
  assumes "distinct (map fst xs)"
    and "sorted (map snd xs)"
  shows "alist_of (Abs_pq xs) = xs"
  by (rule Abs_pq_inverse) (simp add: assms)

lemma [code abstype]:
  "Abs_pq (alist_of q) = q"
  by (fact alist_of_inverse)

lemma distinct_fst_alist_of [simp]:
  "distinct (map fst (alist_of q))"
  using alist_of [of q] by simp

lemma distinct_alist_of [simp]:
  "distinct (alist_of q)"
  using distinct_fst_alist_of [of q] by (simp add: distinct_map)

lemma sorted_snd_alist_of [simp]:
  "sorted (map snd (alist_of q))"
  using alist_of [of q] by simp

lemma alist_of_eqI:
  "alist_of p = alist_of q \<Longrightarrow> p = q"
proof -
  assume "alist_of p = alist_of q"
  then have "Abs_pq (alist_of p) = Abs_pq (alist_of q)" by simp
  thus "p = q" by (simp add: alist_of_inverse)
qed

definition "values" :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> 'a list" ("|(_)|") where
  "values q = map fst (alist_of q)"

definition priorities :: "('a, 'b::linorder) pq \<Rightarrow> 'b list" ("\<parallel>(_)\<parallel>") where
  "priorities q = map snd (alist_of q)"

lemma values_set:
  "set |q| = fst ` set (alist_of q)"
  by (simp add: values_def)

lemma priorities_set:
  "set \<parallel>q\<parallel> = snd ` set (alist_of q)"
  by (simp add: priorities_def)

definition is_empty :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> bool" where
  "is_empty q \<longleftrightarrow> alist_of q = []"

definition priority :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> 'a \<Rightarrow> 'b option" where
  "priority q = map_of (alist_of q)"

definition min :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> 'a" where
  "min q = fst (hd (alist_of q))"

definition empty :: "('a, 'b\<Colon>linorder) pq" where
  "empty = Abs_pq []"

lemma is_empty_alist_of [dest]:
  "is_empty q \<Longrightarrow> alist_of q = []"
  by (simp add: is_empty_def)

lemma not_is_empty_alist_of [dest]:
  "\<not> is_empty q \<Longrightarrow> alist_of q \<noteq> []"
  by (simp add: is_empty_def)

lemma alist_of_empty [simp, code abstract]:
  "alist_of empty = []"
  by (simp add: empty_def Abs_pq_inverse)

lemma values_empty [simp]:
  "|empty| = []"
  by (simp add: values_def)

lemma priorities_empty [simp]:
  "\<parallel>empty\<parallel> = []"
  by (simp add: priorities_def)

lemma values_empty_nothing [simp]:
  "\<forall>k. k \<notin> set |empty|"
  by (simp add: values_def)

lemma is_empty_empty:
  "is_empty q \<longleftrightarrow> q = empty"
proof (rule iffI)
  assume "is_empty q"
  then have "alist_of q = []" by (simp add: is_empty_alist_of)
  then have "Abs_pq (alist_of q) = Abs_pq []" by simp
  then show "q = empty" by (simp add: empty_def alist_of_inverse)
qed (simp add: is_empty_def)

lemma is_empty_empty_simp [simp]:
  "is_empty empty"
by (simp add: is_empty_empty)

lemma map_snd_alist_of:
  "map (the \<circ> priority q) (values q) = map snd (alist_of q)"
  by (auto simp add: values_def priority_def)

lemma image_snd_alist_of:
  "the ` priority q ` set (values q) = snd ` set (alist_of q)"
proof -
  from map_snd_alist_of [of q]
    have "set (map (the \<circ> priority q) (values q)) = set (map snd (alist_of q))"
      by (simp only:)
  then show ?thesis by (simp add: image_comp)
qed

lemma Min_snd_alist_of:
  assumes "\<not> is_empty q"
  shows "Min (snd ` set (alist_of q)) = snd (hd (alist_of q))"
proof -
  from assms obtain ps p where q: "map snd (alist_of q) = p # ps"
    by (cases "map snd (alist_of q)") auto
  then have "hd (map snd (alist_of q)) = p" by simp
  with assms have p: "snd (hd (alist_of q)) = p" by (auto simp add: hd_map)
  have "sorted (map snd (alist_of q))" by simp
  with q have "sorted (p # ps)" by simp
  then have "\<forall>p'\<in>set ps. p' \<ge> p" by (simp add: sorted_Cons)
  then have "Min (set (p # ps)) = p" by (auto intro: Min_eqI)
  with p q have "Min (set (map snd (alist_of q))) = snd (hd (alist_of q))"
    by simp
  then show ?thesis by simp
qed

lemma priority_fst:
  assumes "xp \<in> set (alist_of q)"
  shows "priority q (fst xp) = Some (snd xp)"
  using assms by (simp add: priority_def)

lemma priority_Min:
  assumes "\<not> is_empty q"
  shows "priority q (min q) = Some (Min (the ` priority q ` set (values q)))"
  using assms
    by (auto simp add: min_def image_snd_alist_of Min_snd_alist_of priority_fst)

lemma priority_Min_priorities:
  assumes "\<not> is_empty q"
  shows "priority q (min q) = Some (Min (set \<parallel>q\<parallel>))"
  using assms
    by (simp add: priority_Min image_snd_alist_of priorities_def)

definition push :: "'a \<Rightarrow> 'b\<Colon>linorder \<Rightarrow> ('a, 'b) pq \<Rightarrow> ('a, 'b) pq" where
  "push k p q = Abs_pq (if k \<notin> set (values q)
           then insort_key snd (k, p) (alist_of q)
           else alist_of q)"

lemma Min_snd_hd:
  "q \<noteq> [] \<Longrightarrow> sorted (map snd q) \<Longrightarrow> Min (snd ` set q) = snd (hd q)"
proof (induct q)
  case (Cons x xs) then show ?case by (cases xs) (auto simp add: ord_class.min_def)
qed simp

lemma hd_construct:
  assumes "\<not> is_empty q"
  shows "hd (alist_of q) = (min q, the (priority q (min q)))"
proof -
  from assms have "the (priority q (min q)) = snd (hd (alist_of q))"
    using Min_snd_hd [of "alist_of q"]
      by (auto simp add: priority_Min_priorities priorities_def)
  then show ?thesis by (simp add: min_def)
qed

lemma not_in_first_image:
  "x \<notin> fst ` s \<Longrightarrow> (x, p) \<notin> s"
  by (auto simp add: image_def)

lemma alist_of_push [simp, code abstract]:
  "alist_of (push k p q) =
    (if k \<notin> set (values q) then insort_key snd (k, p) (alist_of q) else alist_of q)"
  using distinct_fst_alist_of [of q]
    by (auto simp add: distinct_map set_insort distinct_insort not_in_first_image
      push_def values_def sorted_insort_key intro: alist_of_Abs_pq)

lemma push_values [simp]:
  "set |push k p q| = set |q| \<union> {k}"
  by (auto simp add: values_def set_insort)

lemma push_priorities [simp]:
  "k \<notin> set |q| \<Longrightarrow> set \<parallel>push k p q\<parallel> = set \<parallel>q\<parallel> \<union> {p}"
  "k \<in> set |q| \<Longrightarrow> set \<parallel>push k p q\<parallel> = set \<parallel>q\<parallel>"
  by (auto simp add: priorities_def set_insort)

lemma not_is_empty_push [simp]:
  "\<not> is_empty (push k p q)"
  by (auto simp add: values_def is_empty_def)

lemma push_commute:
  assumes "a \<noteq> b" and "v \<noteq> w"
  shows "push w b (push v a q) = push v a (push w b q)"
  using assms by (auto intro!: alist_of_eqI insort_key_left_comm)

definition remove_min :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> ('a, 'b\<Colon>linorder) pq" where
  "remove_min q = (if is_empty q then empty else Abs_pq (tl (alist_of q)))"

lemma alift_of_remove_min_if [code abstract]:
  "alist_of (remove_min q) = (if is_empty q then [] else tl (alist_of q))"
  by (auto simp add: remove_min_def map_tl sorted_tl distinct_tl alist_of_Abs_pq)

lemma remove_min_empty [simp]:
  "is_empty q \<Longrightarrow> remove_min q = empty"
  by (simp add: remove_min_def)

lemma alist_of_remove_min [simp]:
  "\<not> is_empty q \<Longrightarrow> alist_of (remove_min q) = tl (alist_of q)"
  by (simp add: alift_of_remove_min_if)

lemma values_remove_min [simp]:
  "\<not> is_empty q \<Longrightarrow> values (remove_min q) = tl (values q)"
  by (simp add: values_def map_tl)

lemma set_alist_of_remove_min:
  "\<not> is_empty q \<Longrightarrow> set (alist_of (remove_min q)) =
    set (alist_of q) - {(min q, the (priority q (min q)))}"
  by (simp add: tl_set hd_construct)

definition pop :: "('a, 'b\<Colon>linorder) pq \<Rightarrow> ('a \<times> ('a, 'b) pq) option" where
  "pop q = (if is_empty q then None else Some (min q, remove_min q))"

lemma pop_simps [simp]:
  "is_empty q \<Longrightarrow> pop q = None"
  "\<not> is_empty q \<Longrightarrow> pop q = Some (min q, remove_min q)"
  by (simp_all add: pop_def)

hide_const (open) Abs_pq alist_of "values" priority empty is_empty push min pop

no_notation
  "PQ.values" ("|(_)|")
  and "PQ.priorities" ("\<parallel>(_)\<parallel>")

end


theory ex7_02 imports Main "~~/src/HOL/IMP/Big_Step"
begin

fun skip :: "com \<Rightarrow> bool" where
"skip SKIP = True" |
"skip (v ::= x) = False" |
"skip (c1;;c2) = (skip c1 & skip c2)" |
"skip (IF b THEN c1 ELSE c2) = (skip c1 & skip c2)" |
"skip (WHILE b DO c) = False" (* If we try to check more strictly, we also need to consider termination *)

lemma skip_has_no_action: "\<lbrakk> skip c; (c,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> s = t"
apply (induction arbitrary: s t rule: "skip.induct")
apply auto
done

theorem "skip c \<Longrightarrow> c \<sim> SKIP"
apply (induction c rule: "skip.induct")
apply auto
apply blast+
done

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2008-2023  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Finite sets and order relations\<close>

theory FinOrd_ZF imports Finite_ZF func_ZF_1 NatOrder_ZF

begin

text\<open>This theory file contains properties of finite sets related to order
  relations. Part of this is similar to what is done in \<open>Finite_ZF_1\<close>
  except that the development is based on the notion of finite powerset
  defined in \<open>Finite_ZF\<close> rather the one defined in standard
  Isabelle \<open>Finite\<close> theory.\<close>

subsection\<open>Finite vs. bounded sets\<close>

text\<open>The goal of this section is to show that finite sets are bounded and
  have maxima and minima.\<close>

text\<open>For total and transitive relations
  nonempty finite set has a maximum.\<close>

theorem fin_has_max:
  assumes A1: "r {is total on} X" and A2: "trans(r)"
  and A3: "B \<in> FinPow(X)" and A4: "B \<noteq> 0"
  shows "HasAmaximum(r,B)"
proof -
  have "0=0 \<or> HasAmaximum(r,0)" by simp
  moreover have
    "\<forall>A \<in> FinPow(X). A=0 \<or> HasAmaximum(r,A) \<longrightarrow>
    (\<forall>x\<in>X. (A \<union> {x}) = 0 \<or> HasAmaximum(r,A \<union> {x}))"
  proof -
    { fix A
      assume "A \<in> FinPow(X)"  "A = 0 \<or> HasAmaximum(r,A)"
      have "\<forall>x\<in>X. (A \<union> {x}) = 0 \<or> HasAmaximum(r,A \<union> {x})"
      proof -
	{ fix x assume "x\<in>X"
	  note \<open>A = 0 \<or> HasAmaximum(r,A)\<close>
	  moreover
	  { assume "A = 0"
	    then have "A\<union>{x} = {x}" by simp
	    from A1 have "refl(X,r)" using total_is_refl
	      by simp
	    with \<open>x\<in>X\<close> \<open>A\<union>{x} = {x}\<close> have "HasAmaximum(r,A\<union>{x})"
	      using Order_ZF_4_L8 by simp }
	  moreover
	  { assume "HasAmaximum(r,A)"
	    with A1 A2 \<open>A \<in> FinPow(X)\<close>  \<open>x\<in>X\<close>
	    have "HasAmaximum(r,A\<union>{x})"
	      using FinPow_def Order_ZF_4_L9 by simp }
	  ultimately  have "A \<union> {x} = 0 \<or> HasAmaximum(r,A \<union> {x})"
	    by auto
	} thus "\<forall>x\<in>X. (A \<union> {x}) = 0 \<or> HasAmaximum(r,A \<union> {x})"
	  by simp
      qed
    } thus ?thesis by simp
  qed
  moreover note A3
  ultimately have "B = 0 \<or>  HasAmaximum(r,B)"
    by (rule FinPow_induct)
  with A4 show "HasAmaximum(r,B)" by simp
qed

text\<open>For linearly ordered nonempty finite sets the
  maximum is in the set and indeed it is the greatest
  element of the set.\<close>

lemma linord_max_props: assumes A1: "IsLinOrder(X,r)" and
  A2: "A \<in> FinPow(X)" "A \<noteq> 0"
  shows
  "Maximum(r,A) \<in> A"
  "Maximum(r,A) \<in> X"
  "\<forall>a\<in>A. \<langle>a,Maximum(r,A)\<rangle> \<in> r"
proof -
  from A1 A2 show
    "Maximum(r,A) \<in> A" and "\<forall>a\<in>A. \<langle>a,Maximum(r,A)\<rangle> \<in> r"
    using IsLinOrder_def fin_has_max Order_ZF_4_L3
    by auto
  with A2 show "Maximum(r,A) \<in> X" using FinPow_def
    by auto
qed

text\<open>Every nonempty subset of a natural number has a maximum with expected properties.\<close>

lemma nat_max_props: assumes "n\<in>nat" "A\<subseteq>n" "A\<noteq>0"
  shows
  "Maximum(Le,A) \<in> A"
  "Maximum(Le,A) \<in> nat"
  "\<forall>k\<in>A. k \<le> Maximum(Le,A)"
proof -
  from assms(1,2) have "A \<in> FinPow(nat)"
    using nat_finpow_nat subset_finpow by blast
  with assms(3) show
    "Maximum(Le,A) \<in> A"
    "Maximum(Le,A) \<in> nat"
    using NatOrder_ZF_1_L2(4) linord_max_props(1,2) by simp_all
  from assms(3) \<open>A \<in> FinPow(nat)\<close> have "\<forall>k\<in>A. \<langle>k,Maximum(Le,A)\<rangle> \<in> Le"
    using linord_max_props NatOrder_ZF_1_L2(4) by blast
  then show  "\<forall>k\<in>A. k \<le> Maximum(Le,A)" by simp
qed

subsection\<open>Order isomorphisms of finite sets\<close>

text\<open>In this section we establish that if two linearly
  ordered finite sets have the same number of elements,
  then they are order-isomorphic and the isomorphism
  is unique. This allows us to talk about ''enumeration''
  of a linearly ordered finite set. We define the enumeration as
  the order isomorphism between the number of elements
  of the set (which is a natural number $n = \{0,1,..,n-1\}$)
  and the set.\<close>

text\<open>A really weird corner case - empty set is order isomorphic with itself.
\<close>

lemma empty_ord_iso: shows "ord_iso(0,r,0,R) \<noteq> 0"
proof -
  have "0 \<approx> 0" using eqpoll_refl by simp
  then obtain f where "f \<in> bij(0,0)"
    using eqpoll_def by blast
  then show ?thesis using ord_iso_def by auto
qed

text\<open>Even weirder than \<open>empty_ord_iso\<close>
  The order automorphism of the empty set is unique.\<close>

lemma empty_ord_iso_uniq:
  assumes "f \<in> ord_iso(0,r,0,R)"  "g \<in> ord_iso(0,r,0,R)"
  shows "f = g"
proof -
  from assms have "f : 0 \<rightarrow> 0" and "g: 0 \<rightarrow> 0"
    using ord_iso_def bij_def surj_def by auto
    moreover have "\<forall>x\<in>0. f`(x) = g`(x)" by simp
    ultimately show "f = g" by (rule func_eq)
qed

text\<open>The empty set is the only order automorphism of itself.\<close>

lemma empty_ord_iso_empty: shows "ord_iso(0,r,0,R) = {0}"
proof -
  have "0 \<in> ord_iso(0,r,0,R)"
  proof -
    have "ord_iso(0,r,0,R) \<noteq> 0" by (rule empty_ord_iso)
    then obtain f where "f \<in> ord_iso(0,r,0,R)" by auto
    then show "0 \<in> ord_iso(0,r,0,R)"
      using ord_iso_def bij_def surj_def fun_subset_prod
      by auto
  qed
  then show "ord_iso(0,r,0,R) = {0}" using empty_ord_iso_uniq
    by blast
qed

text\<open>An induction (or maybe recursion?) scheme for linearly ordered sets.
  The induction step is that we show that if the property holds
  when the set is a singleton or for a set with the maximum removed,
  then it holds for the set. The idea is that since we can build
  any finite set by adding elements on the right, then if the property
  holds for the empty set and is invariant with respect to this operation, then
  it must hold for all finite sets.\<close>

lemma fin_ord_induction:
  assumes A1: "IsLinOrder(X,r)" and A2: "P(0)" and
  A3: "\<forall>A \<in> FinPow(X). A \<noteq> 0 \<longrightarrow> (P(A - {Maximum(r,A)}) \<longrightarrow> P(A))"
  and A4: "B \<in> FinPow(X)" shows "P(B)"
proof -
  note A2
  moreover have "\<forall> A \<in> FinPow(X). A \<noteq> 0 \<longrightarrow> (\<exists>a\<in>A. P(A-{a}) \<longrightarrow> P(A))"
  proof -
    { fix A assume "A \<in>  FinPow(X)" and "A \<noteq> 0"
      with A1 A3 have "\<exists>a\<in>A. P(A-{a}) \<longrightarrow> P(A)"
	using IsLinOrder_def fin_has_max
	  IsLinOrder_def Order_ZF_4_L3
	by blast
    } thus ?thesis by simp
  qed
  moreover note A4
  ultimately show "P(B)" by (rule FinPow_ind_rem_one)
qed

text\<open>A sligltly more complicated version of \<open>fin_ord_induction\<close>
  that allows to prove properties that are not true for the empty set.\<close>

lemma fin_ord_ind:
  assumes A1: "IsLinOrder(X,r)" and A2: "\<forall>A \<in> FinPow(X).
  A = 0 \<or> (A = {Maximum(r,A)} \<or> P(A - {Maximum(r,A)}) \<longrightarrow> P(A))"
  and A3: "B \<in>  FinPow(X)" and A4: "B\<noteq>0"
  shows "P(B)"
proof -
  { fix A assume "A \<in>  FinPow(X)" and "A \<noteq> 0"
    with A1 A2 have
      "\<exists>a\<in>A. A = {a} \<or> P(A-{a}) \<longrightarrow> P(A)"
      using IsLinOrder_def fin_has_max
	IsLinOrder_def Order_ZF_4_L3
      by blast
  } then have "\<forall>A \<in> FinPow(X).
      A = 0 \<or> (\<exists>a\<in>A. A = {a} \<or> P(A-{a}) \<longrightarrow> P(A))"
    by auto
  with A3 A4 show "P(B)" using  FinPow_rem_ind
    by simp
qed

text\<open>Yet another induction scheme. We build a linearly ordered
  set by adding elements that are greater than all elements in the
  set.\<close>

lemma fin_ind_add_max:
  assumes A1: "IsLinOrder(X,r)" and A2: "P(0)" and A3: "\<forall> A \<in> FinPow(X).
  ( \<forall> x \<in> X-A. P(A) \<and> (\<forall>a\<in>A. \<langle>a,x\<rangle> \<in> r ) \<longrightarrow> P(A \<union> {x}))"
  and A4: "B \<in> FinPow(X)"
  shows "P(B)"
proof -
  note A1 A2
  moreover have
    "\<forall>C \<in> FinPow(X). C \<noteq> 0 \<longrightarrow> (P(C - {Maximum(r,C)}) \<longrightarrow> P(C))"
    proof -
      { fix C assume "C \<in> FinPow(X)" and "C \<noteq> 0"
	let ?x = "Maximum(r,C)"
	let ?A = "C - {?x}"
	assume "P(?A)"
	moreover from \<open>C \<in> FinPow(X)\<close> have "?A \<in> FinPow(X)"
	  using fin_rem_point_fin by simp
	moreover from A1 \<open>C \<in> FinPow(X)\<close> \<open>C \<noteq> 0\<close> have
	  "?x \<in> C" and "?x \<in> X - ?A" and "\<forall>a\<in>?A. \<langle>a,?x\<rangle> \<in> r"
	  using linord_max_props by auto
	moreover note A3
	ultimately have "P(?A \<union> {?x})" by auto
	moreover from \<open>?x \<in> C\<close> have "?A \<union> {?x} = C"
	  by auto
	ultimately have "P(C)" by simp
      } thus ?thesis by simp
    qed
    moreover note A4
  ultimately show "P(B)" by (rule fin_ord_induction)
qed

text\<open>The only order automorphism of a linearly ordered
  finite set is the identity.\<close>

theorem fin_ord_auto_id: assumes A1: "IsLinOrder(X,r)"
  and A2: "B \<in>  FinPow(X)" and A3: "B\<noteq>0"
  shows "ord_iso(B,r,B,r) = {id(B)}"
proof -
  note A1
  moreover
  { fix A assume "A \<in>  FinPow(X)" "A\<noteq>0"
    let ?M = "Maximum(r,A)"
    let ?A\<^sub>0 = "A - {?M}"
    assume "A = {?M} \<or> ord_iso(?A\<^sub>0,r,?A\<^sub>0,r) = {id(?A\<^sub>0)}"
    moreover
    { assume "A = {?M}"
      have "ord_iso({?M},r,{?M},r) = {id({?M})}"
	using id_ord_auto_singleton by simp
      with \<open>A = {?M}\<close> have "ord_iso(A,r,A,r) = {id(A)}"
	by simp }
    moreover
    { assume "ord_iso(?A\<^sub>0,r,?A\<^sub>0,r) = {id(?A\<^sub>0)}"
      have "ord_iso(A,r,A,r) = {id(A)}"
      proof
	show "{id(A)} \<subseteq> ord_iso(A,r,A,r)"
	  using id_ord_iso by simp
	{ fix f assume "f \<in> ord_iso(A,r,A,r)"
	  with A1 \<open>A \<in>  FinPow(X)\<close> \<open>A\<noteq>0\<close> have
	    "restrict(f,?A\<^sub>0) \<in> ord_iso(?A\<^sub>0, r, A-{f`(?M)},r)"
	    using IsLinOrder_def fin_has_max ord_iso_rem_max
	    by auto
	  with A1 \<open>A \<in>  FinPow(X)\<close> \<open>A\<noteq>0\<close> \<open>f \<in> ord_iso(A,r,A,r)\<close>
	    \<open>ord_iso(?A\<^sub>0,r,?A\<^sub>0,r) = {id(?A\<^sub>0)}\<close>
	  have "restrict(f,?A\<^sub>0) = id(?A\<^sub>0)"
	    using IsLinOrder_def fin_has_max max_auto_fixpoint
	    by auto
	  moreover from A1 \<open>f \<in> ord_iso(A,r,A,r)\<close>
	    \<open>A \<in>  FinPow(X)\<close> \<open>A\<noteq>0\<close> have
	    "f : A \<rightarrow> A" and "?M \<in> A" and "f`(?M) = ?M"
	    using ord_iso_def bij_is_fun IsLinOrder_def
	      fin_has_max Order_ZF_4_L3 max_auto_fixpoint
	    by auto
	  ultimately have "f = id(A)" using id_fixpoint_rem
	    by simp
	} then show "ord_iso(A,r,A,r) \<subseteq> {id(A)}"
	  by auto
      qed
    }
    ultimately have "ord_iso(A,r,A,r) = {id(A)}"
      by auto
  } then have "\<forall>A \<in>  FinPow(X). A = 0 \<or>
      (A = {Maximum(r,A)} \<or>
      ord_iso(A-{Maximum(r,A)},r,A-{Maximum(r,A)},r) =
      {id(A-{Maximum(r,A)})} \<longrightarrow>  ord_iso(A,r,A,r) = {id(A)})"
    by auto
  moreover note A2 A3
  ultimately show "ord_iso(B,r,B,r) = {id(B)}"
    by (rule fin_ord_ind)
qed

text\<open>Every two finite linearly ordered sets are order
  isomorphic. The statement is formulated to make the
  proof by induction on the size of the set easier,
  see \<open>fin_ord_iso_ex\<close> for an alternative formulation.
\<close>

lemma fin_order_iso:
  assumes A1: "IsLinOrder(X,r)"  "IsLinOrder(Y,R)" and
  A2: "n \<in> nat"
  shows "\<forall>A \<in> FinPow(X). \<forall>B \<in> FinPow(Y).
  A \<approx> n \<and> B \<approx> n \<longrightarrow> ord_iso(A,r,B,R) \<noteq> 0"
proof -
  note A2
  moreover have "\<forall>A \<in> FinPow(X). \<forall>B \<in> FinPow(Y).
    A \<approx> 0 \<and> B \<approx> 0 \<longrightarrow> ord_iso(A,r,B,R) \<noteq> 0"
    using eqpoll_0_is_0 empty_ord_iso by blast
  moreover have "\<forall>k \<in> nat.
    (\<forall>A \<in> FinPow(X). \<forall>B \<in> FinPow(Y).
    A \<approx> k \<and> B \<approx> k \<longrightarrow> ord_iso(A,r,B,R) \<noteq> 0) \<longrightarrow>
    (\<forall>C \<in> FinPow(X). \<forall>D \<in> FinPow(Y).
    C \<approx> succ(k) \<and> D \<approx> succ(k) \<longrightarrow> ord_iso(C,r,D,R) \<noteq> 0)"
  proof -
    { fix k assume "k \<in> nat"
      assume A3: "\<forall>A \<in> FinPow(X). \<forall>B \<in> FinPow(Y).
	A \<approx> k \<and> B \<approx> k \<longrightarrow> ord_iso(A,r,B,R) \<noteq> 0"
      have "\<forall>C \<in> FinPow(X). \<forall>D \<in> FinPow(Y).
	C \<approx> succ(k) \<and> D \<approx> succ(k) \<longrightarrow> ord_iso(C,r,D,R) \<noteq> 0"
      proof -
	{ fix C assume "C \<in> FinPow(X)"
	  fix D assume "D \<in> FinPow(Y)"
	  assume "C \<approx> succ(k)"  "D \<approx> succ(k)"
	  then have "C \<noteq> 0" and "D\<noteq> 0"
	    using eqpoll_succ_imp_not_empty by auto
	  let ?M\<^sub>C = "Maximum(r,C)"
	  let ?M\<^sub>D = "Maximum(R,D)"
	  let ?C\<^sub>0 = "C - {?M\<^sub>C}"
	  let ?D\<^sub>0 = "D - {?M\<^sub>D}"
	  from \<open>C \<in> FinPow(X)\<close> have "C \<subseteq> X"
	    using FinPow_def by simp
	  with A1 have "IsLinOrder(C,r)"
	    using ord_linear_subset by blast
	  from \<open>D \<in> FinPow(Y)\<close> have "D \<subseteq> Y"
	    using FinPow_def by simp
	  with A1 have "IsLinOrder(D,R)"
	    using ord_linear_subset by blast
	  from A1 \<open>C \<in> FinPow(X)\<close> \<open>D \<in> FinPow(Y)\<close>
	    \<open>C \<noteq> 0\<close> \<open>D\<noteq> 0\<close> have
	    "HasAmaximum(r,C)" and "HasAmaximum(R,D)"
	    using IsLinOrder_def fin_has_max
	    by auto
	  with A1 have "?M\<^sub>C \<in> C" and "?M\<^sub>D \<in> D"
	    using IsLinOrder_def Order_ZF_4_L3 by auto
	  with \<open>C \<approx> succ(k)\<close>  \<open>D \<approx> succ(k)\<close> have
	    "?C\<^sub>0  \<approx> k" and "?D\<^sub>0 \<approx> k" using Diff_sing_eqpoll by auto
	  from \<open>C \<in> FinPow(X)\<close> \<open>D \<in> FinPow(Y)\<close>
	  have "?C\<^sub>0 \<in>  FinPow(X)" and "?D\<^sub>0 \<in>  FinPow(Y)"
	    using fin_rem_point_fin by auto
	  with A3 \<open>?C\<^sub>0  \<approx> k\<close> \<open>?D\<^sub>0 \<approx> k\<close> have
	    "ord_iso(?C\<^sub>0,r,?D\<^sub>0,R) \<noteq> 0" by simp
	  with \<open>IsLinOrder(C,r)\<close>  \<open>IsLinOrder(D,R)\<close>
	    \<open>HasAmaximum(r,C)\<close> \<open>HasAmaximum(R,D)\<close>
	  have "ord_iso(C,r,D,R) \<noteq> 0"
	    by (rule rem_max_ord_iso)
	} thus ?thesis by simp
      qed
    } thus ?thesis by blast
  qed
  ultimately show ?thesis by (rule ind_on_nat)
qed

text\<open>Every two finite linearly ordered sets are order
  isomorphic.\<close>

lemma fin_ord_iso_ex:
  assumes A1: "IsLinOrder(X,r)"  "IsLinOrder(Y,R)" and
  A2: "A \<in> FinPow(X)" "B \<in> FinPow(Y)" and A3: "B \<approx> A"
  shows "ord_iso(A,r,B,R) \<noteq> 0"
proof -
  from A2 obtain n where "n \<in> nat" and "A \<approx> n"
    using finpow_decomp by auto
  from  A3 \<open>A \<approx> n\<close> have "B \<approx> n" by (rule eqpoll_trans)
  with A1 A2 \<open>A \<approx> n\<close> \<open>n \<in> nat\<close> show "ord_iso(A,r,B,R) \<noteq> 0"
    using fin_order_iso by simp
qed

text\<open>Existence and uniqueness of order isomorphism for two
  linearly ordered sets with the same number of elements.\<close>

theorem fin_ord_iso_ex_uniq:
  assumes A1: "IsLinOrder(X,r)"  "IsLinOrder(Y,R)" and
  A2: "A \<in> FinPow(X)" "B \<in> FinPow(Y)" and A3: "B \<approx> A"
  shows "\<exists>!f. f \<in> ord_iso(A,r,B,R)"
proof
  from assms show "\<exists>f. f \<in> ord_iso(A,r,B,R)"
    using fin_ord_iso_ex by blast
  fix f g
  assume A4: "f \<in> ord_iso(A,r,B,R)"  "g \<in> ord_iso(A,r,B,R)"
  then have "converse(g) \<in> ord_iso(B,R,A,r)"
    using ord_iso_sym by simp
  with \<open>f \<in> ord_iso(A,r,B,R)\<close> have
    I: "converse(g) O f \<in>  ord_iso(A,r,A,r)"
    by (rule ord_iso_trans)
  { assume "A \<noteq> 0"
    with A1 A2 I have "converse(g) O f = id(A)"
      using fin_ord_auto_id by auto
    with A4 have "f = g"
      using ord_iso_def comp_inv_id_eq_bij by auto }
  moreover
  { assume "A = 0"
    then have "A \<approx> 0" using eqpoll_0_iff
      by simp
    with A3 have "B \<approx> 0" by (rule eqpoll_trans)
    with A4 \<open>A = 0\<close> have
      "f \<in> ord_iso(0,r,0,R)" and  "g \<in> ord_iso(0,r,0,R)"
      using eqpoll_0_iff by auto
    then have "f = g" by (rule empty_ord_iso_uniq) }
  ultimately show "f = g"
    using ord_iso_def comp_inv_id_eq_bij
    by auto
qed

end