diff --git a/src/HOL/Analysis/Abstract_Metric_Spaces.thy b/src/HOL/Analysis/Abstract_Metric_Spaces.thy
new file mode 100644
--- /dev/null
+++ b/src/HOL/Analysis/Abstract_Metric_Spaces.thy
@@ -0,0 +1,2634 @@
+section \<open>Abstract Metric Spaces\<close>
+
+theory Abstract_Metric_Spaces
+  imports Elementary_Metric_Spaces Abstract_Limits Abstract_Topological_Spaces
+begin
+
+(*Avoid a clash with the existing metric_space locale (from the type class)*)
+locale Metric_space =
+  fixes M :: "'a set" and d :: "'a \<Rightarrow> 'a \<Rightarrow> real"
+  assumes nonneg [simp]: "\<And>x y. 0 \<le> d x y"
+  assumes commute: "\<And>x y. d x y = d y x"
+  assumes zero [simp]: "\<And>x y. \<lbrakk>x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> d x y = 0 \<longleftrightarrow> x=y"
+  assumes triangle: "\<And>x y z. \<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d x y + d y z"
+
+text \<open>Link with the type class version\<close>
+interpretation Met_TC: Metric_space UNIV dist
+  by (simp add: dist_commute dist_triangle Metric_space.intro)
+
+context Metric_space
+begin
+
+lemma subspace: "M' \<subseteq> M \<Longrightarrow> Metric_space M' d"
+  by (simp add: commute in_mono Metric_space.intro triangle)
+
+lemma abs_mdist [simp] : "\<bar>d x y\<bar> = d x y"
+  by simp
+
+lemma mdist_pos_less: "\<lbrakk>x \<noteq> y; x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> 0 < d x y"
+  by (metis less_eq_real_def nonneg zero)
+
+lemma mdist_zero [simp]: "x \<in> M \<Longrightarrow> d x x = 0"
+  by simp
+
+lemma mdist_pos_eq [simp]: "\<lbrakk>x \<in> M; y \<in> M\<rbrakk> \<Longrightarrow> 0 < d x y \<longleftrightarrow> x \<noteq> y"
+  using mdist_pos_less zero by fastforce
+
+lemma triangle': "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d x y + d z y"
+  by (simp add: commute triangle)
+
+lemma triangle'': "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> d x z \<le> d y x + d y z"
+  by (simp add: commute triangle)
+
+lemma mdist_reverse_triangle: "\<lbrakk>x \<in> M; y \<in> M; z \<in> M\<rbrakk> \<Longrightarrow> \<bar>d x y - d y z\<bar> \<le> d x z"
+  by (smt (verit) commute triangle)
+
+text\<open> Open and closed balls                                                                \<close>
+
+definition mball where "mball x r \<equiv> {y. x \<in> M \<and> y \<in> M \<and> d x y < r}"
+definition mcball where "mcball x r \<equiv> {y. x \<in> M \<and> y \<in> M \<and> d x y \<le> r}"
+
+lemma in_mball [simp]: "y \<in> mball x r \<longleftrightarrow> x \<in> M \<and> y \<in> M \<and> d x y < r"
+  by (simp add: local.Metric_space_axioms Metric_space.mball_def)
+
+lemma centre_in_mball_iff [iff]: "x \<in> mball x r \<longleftrightarrow> x \<in> M \<and> 0 < r"
+  using in_mball mdist_zero by force
+
+lemma mball_subset_mspace: "mball x r \<subseteq> M"
+  by auto
+
+lemma mball_eq_empty: "mball x r = {} \<longleftrightarrow> (x \<notin> M) \<or> r \<le> 0"
+  by (smt (verit, best) Collect_empty_eq centre_in_mball_iff mball_def nonneg)
+
+lemma mball_subset: "\<lbrakk>d x y + a \<le> b; y \<in> M\<rbrakk> \<Longrightarrow> mball x a \<subseteq> mball y b"
+  by (smt (verit) commute in_mball subsetI triangle)
+
+lemma disjoint_mball: "r + r' \<le> d x x' \<Longrightarrow> disjnt (mball x r) (mball x' r')"
+  by (smt (verit) commute disjnt_iff in_mball triangle)
+
+lemma mball_subset_concentric: "r \<le> s \<Longrightarrow> mball x r \<subseteq> mball x s"
+  by auto
+
+lemma in_mcball [simp]: "y \<in> mcball x r \<longleftrightarrow> x \<in> M \<and> y \<in> M \<and> d x y \<le> r"
+  by (simp add: local.Metric_space_axioms Metric_space.mcball_def)
+
+lemma centre_in_mcball_iff [iff]: "x \<in> mcball x r \<longleftrightarrow> x \<in> M \<and> 0 \<le> r"
+  using mdist_zero by force
+
+lemma mcball_eq_empty: "mcball x r = {} \<longleftrightarrow> (x \<notin> M) \<or> r < 0"
+  by (smt (verit, best) Collect_empty_eq centre_in_mcball_iff empty_iff mcball_def nonneg)
+
+lemma mcball_subset_mspace: "mcball x r \<subseteq> M"
+  by auto
+
+lemma mball_subset_mcball: "mball x r \<subseteq> mcball x r"
+  by auto
+
+lemma mcball_subset: "\<lbrakk>d x y + a \<le> b; y \<in> M\<rbrakk> \<Longrightarrow> mcball x a \<subseteq> mcball y b"
+  by (smt (verit) in_mcball mdist_reverse_triangle subsetI)
+
+lemma mcball_subset_concentric: "r \<le> s \<Longrightarrow> mcball x r \<subseteq> mcball x s"
+  by force
+
+lemma mcball_subset_mball: "\<lbrakk>d x y + a < b; y \<in> M\<rbrakk> \<Longrightarrow> mcball x a \<subseteq> mball y b"
+  by (smt (verit) commute in_mball in_mcball subsetI triangle)
+
+lemma mcball_subset_mball_concentric: "a < b \<Longrightarrow> mcball x a \<subseteq> mball x b"
+  by force
+
+end
+
+
+
+subsection \<open>Metric topology                                                           \<close>
+
+context Metric_space
+begin
+
+definition mopen where 
+  "mopen U \<equiv> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r>0. mball x r \<subseteq> U))"
+
+definition mtopology :: "'a topology" where 
+  "mtopology \<equiv> topology mopen"
+
+lemma is_topology_metric_topology [iff]: "istopology mopen"
+proof -
+  have "\<And>S T. \<lbrakk>mopen S; mopen T\<rbrakk> \<Longrightarrow> mopen (S \<inter> T)"
+    by (smt (verit, del_insts) Int_iff in_mball mopen_def subset_eq)
+  moreover have "\<And>\<K>. (\<forall>K\<in>\<K>. mopen K) \<longrightarrow> mopen (\<Union>\<K>)"
+    using mopen_def by fastforce
+  ultimately show ?thesis
+    by (simp add: istopology_def)
+qed
+
+lemma openin_mtopology: "openin mtopology U \<longleftrightarrow> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r>0. mball x r \<subseteq> U))"
+  by (simp add: mopen_def mtopology_def)
+
+lemma topspace_mtopology [simp]: "topspace mtopology = M"
+  by (meson order.refl mball_subset_mspace openin_mtopology openin_subset openin_topspace subset_antisym zero_less_one)
+
+lemma subtopology_mspace [simp]: "subtopology mtopology M = mtopology"
+  by (metis subtopology_topspace topspace_mtopology)
+
+lemma open_in_mspace [iff]: "openin mtopology M"
+  by (metis openin_topspace topspace_mtopology)
+
+lemma closedin_mspace [iff]: "closedin mtopology M"
+  by (metis closedin_topspace topspace_mtopology)
+
+lemma openin_mball [iff]: "openin mtopology (mball x r)"
+proof -
+  have "\<And>y. \<lbrakk>x \<in> M; d x y < r\<rbrakk> \<Longrightarrow> \<exists>s>0. mball y s \<subseteq> mball x r"
+    by (metis add_diff_cancel_left' add_diff_eq commute less_add_same_cancel1 mball_subset order_refl)
+  then show ?thesis
+    by (auto simp: openin_mtopology)
+qed
+
+lemma mcball_eq_cball [simp]: "Met_TC.mcball = cball"
+  by force
+
+lemma mball_eq_ball [simp]: "Met_TC.mball = ball"
+  by force
+
+lemma mopen_eq_open [simp]: "Met_TC.mopen = open"
+  by (force simp: open_contains_ball Met_TC.mopen_def)
+
+lemma limitin_iff_tendsto [iff]: "limitin Met_TC.mtopology \<sigma> x F = tendsto \<sigma> x F"
+  by (simp add: Met_TC.mtopology_def)
+
+lemma mtopology_is_euclideanreal [simp]: "Met_TC.mtopology = euclideanreal"
+  by (simp add: Met_TC.mtopology_def)
+
+(*
+lemma metric_injective_image:
+   "\<And>f m s.
+        f ` s \<subseteq> M \<and>
+        (\<forall>x y. x \<in> s \<and> y \<in> s \<and> f x = f y \<Longrightarrow> x = y)
+        \<Longrightarrow> (mspace(metric(s,\<lambda>(x,y). d (f x) (f y))) = s) \<and>
+            (d(metric(s,\<lambda>(x,y). d (f x) (f y))) =
+             \<lambda>(x,y). d (f x) (f y))"
+oops
+  REWRITE_TAC[\<subseteq>; FORALL_IN_IMAGE; INJECTIVE_ON_ALT] THEN
+  REPEAT GEN_TAC THEN STRIP_TAC THEN
+  REWRITE_TAC[mspace; d; GSYM PAIR_EQ] THEN
+  REWRITE_TAC[GSYM(CONJUNCT2 metric_tybij); is_metric_space] THEN
+  REWRITE_TAC[GSYM mspace; GSYM d] THEN
+  ASM_SIMP_TAC[MDIST_POS_LE; MDIST_TRIANGLE; MDIST_0] THEN
+  ASM_MESON_TAC[MDIST_SYM]);;
+*)
+
+lemma mtopology_base:
+   "mtopology = topology(arbitrary union_of (\<lambda>U. \<exists>x \<in> M. \<exists>r>0. U = mball x r))"
+proof -
+  have "\<And>S. \<exists>x r. x \<in> M \<and> 0 < r \<and> S = mball x r \<Longrightarrow> openin mtopology S"
+    using openin_mball by blast
+  moreover have "\<And>U x. \<lbrakk>openin mtopology U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>B. (\<exists>x r. x \<in> M \<and> 0 < r \<and> B = mball x r) \<and> x \<in> B \<and> B \<subseteq> U"
+    by (metis centre_in_mball_iff in_mono openin_mtopology)
+  ultimately show ?thesis
+    by (smt (verit) topology_base_unique)
+qed
+
+lemma closedin_metric:
+   "closedin mtopology C \<longleftrightarrow> C \<subseteq> M \<and> (\<forall>x. x \<in> M - C \<longrightarrow> (\<exists>r>0. disjnt C (mball x r)))"  (is "?lhs = ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    unfolding closedin_def openin_mtopology
+    by (metis Diff_disjoint disjnt_def disjnt_subset2 topspace_mtopology)
+  show "?rhs \<Longrightarrow> ?lhs"
+    unfolding closedin_def openin_mtopology disjnt_def
+    by (metis Diff_subset Diff_triv Int_Diff Int_commute inf.absorb_iff2 mball_subset_mspace topspace_mtopology)
+qed
+
+lemma closedin_mcball [iff]: "closedin mtopology (mcball x r)"
+proof -
+  have "\<exists>ra>0. disjnt (mcball x r) (mball y ra)" if "x \<notin> M" for y
+    by (metis disjnt_empty1 gt_ex mcball_eq_empty that)
+  moreover have "disjnt (mcball x r) (mball y (d x y - r))" if "y \<in> M" "d x y > r" for y
+    using that disjnt_iff in_mball in_mcball mdist_reverse_triangle by force
+  ultimately show ?thesis
+    using closedin_metric mcball_subset_mspace by fastforce
+qed
+
+lemma mball_iff_mcball: "(\<exists>r>0. mball x r \<subseteq> U) = (\<exists>r>0. mcball x r \<subseteq> U)"
+  by (meson dense mball_subset_mcball mcball_subset_mball_concentric order_trans)
+
+lemma openin_mtopology_mcball:
+  "openin mtopology U \<longleftrightarrow> U \<subseteq> M \<and> (\<forall>x. x \<in> U \<longrightarrow> (\<exists>r. 0 < r \<and> mcball x r \<subseteq> U))"
+  using mball_iff_mcball openin_mtopology by presburger
+
+lemma metric_derived_set_of:
+  "mtopology derived_set_of S = {x \<in> M. \<forall>r>0. \<exists>y\<in>S. y\<noteq>x \<and> y \<in> mball x r}" (is "?lhs=?rhs")
+proof
+  show "?lhs \<subseteq> ?rhs"
+    unfolding openin_mtopology derived_set_of_def 
+    by clarsimp (metis in_mball openin_mball openin_mtopology zero)
+  show "?rhs \<subseteq> ?lhs"
+    unfolding openin_mtopology derived_set_of_def 
+    by clarify (metis subsetD topspace_mtopology)
+qed
+
+lemma metric_closure_of:
+   "mtopology closure_of S = {x \<in> M. \<forall>r>0. \<exists>y \<in> S. y \<in> mball x r}"
+proof -
+  have "\<And>x r. \<lbrakk>0 < r; x \<in> mtopology closure_of S\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. y \<in> mball x r"
+    by (metis centre_in_mball_iff in_closure_of openin_mball topspace_mtopology)
+  moreover have "\<And>x T. \<lbrakk>x \<in> M; \<forall>r>0. \<exists>y\<in>S. y \<in> mball x r\<rbrakk> \<Longrightarrow> x \<in> mtopology closure_of S"
+    by (smt (verit) in_closure_of in_mball openin_mtopology subsetD topspace_mtopology)
+  ultimately show ?thesis
+    by (auto simp: in_closure_of)
+qed
+
+lemma metric_closure_of_alt:
+  "mtopology closure_of S = {x \<in> M. \<forall>r>0. \<exists>y \<in> S. y \<in> mcball x r}"
+proof -
+  have "\<And>x r. \<lbrakk>\<forall>r>0. x \<in> M \<and> (\<exists>y\<in>S. y \<in> mcball x r); 0 < r\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. y \<in> M \<and> d x y < r"
+    by (meson dense in_mcball le_less_trans)
+  then show ?thesis
+    by (fastforce simp: metric_closure_of in_closure_of)
+qed
+
+lemma metric_interior_of:
+   "mtopology interior_of S = {x \<in> M. \<exists>\<epsilon>>0. mball x \<epsilon> \<subseteq> S}" (is "?lhs=?rhs")
+proof
+  show "?lhs \<subseteq> ?rhs"
+    using interior_of_maximal_eq openin_mtopology by fastforce
+  show "?rhs \<subseteq> ?lhs"
+    using interior_of_def openin_mball by fastforce
+qed
+
+lemma metric_interior_of_alt:
+   "mtopology interior_of S = {x \<in> M. \<exists>\<epsilon>>0. mcball x \<epsilon> \<subseteq> S}"
+  by (fastforce simp: mball_iff_mcball metric_interior_of)
+
+lemma in_interior_of_mball:
+   "x \<in> mtopology interior_of S \<longleftrightarrow> x \<in> M \<and> (\<exists>\<epsilon>>0. mball x \<epsilon> \<subseteq> S)"
+  using metric_interior_of by force
+
+lemma in_interior_of_mcball:
+   "x \<in> mtopology interior_of S \<longleftrightarrow> x \<in> M \<and> (\<exists>\<epsilon>>0. mcball x \<epsilon> \<subseteq> S)"
+  using metric_interior_of_alt by force
+
+lemma Hausdorff_space_mtopology: "Hausdorff_space mtopology"
+  unfolding Hausdorff_space_def
+proof clarify
+  fix x y
+  assume x: "x \<in> topspace mtopology" and y: "y \<in> topspace mtopology" and "x \<noteq> y"
+  then have gt0: "d x y / 2 > 0"
+    by auto
+  have "disjnt (mball x (d x y / 2)) (mball y (d x y / 2))"
+    by (simp add: disjoint_mball)
+  then show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
+    by (metis centre_in_mball_iff gt0 openin_mball topspace_mtopology x y)
+qed
+
+
+
+subsection\<open>Bounded sets\<close>
+
+definition mbounded where "mbounded S \<longleftrightarrow> (\<exists>x B. S \<subseteq> mcball x B)"
+
+lemma mbounded_pos: "mbounded S \<longleftrightarrow> (\<exists>x B. 0 < B \<and> S \<subseteq> mcball x B)"
+proof -
+  have "\<exists>x' r'. 0 < r' \<and> S \<subseteq> mcball x' r'" if "S \<subseteq> mcball x r" for x r
+    by (metis gt_ex less_eq_real_def linorder_not_le mcball_subset_concentric order_trans that)
+  then show ?thesis
+    by (auto simp: mbounded_def)
+qed
+
+lemma mbounded_alt:
+  "mbounded S \<longleftrightarrow> S \<subseteq> M \<and> (\<exists>B. \<forall>x \<in> S. \<forall>y \<in> S. d x y \<le> B)"
+proof -
+  have "\<And>x B. S \<subseteq> mcball x B \<Longrightarrow> \<forall>x\<in>S. \<forall>y\<in>S. d x y \<le> 2 * B"
+    by (smt (verit, best) commute in_mcball subsetD triangle)
+  then show ?thesis
+    apply (auto simp: mbounded_def subset_iff)
+     apply blast+
+    done
+qed
+
+
+lemma mbounded_alt_pos:
+  "mbounded S \<longleftrightarrow> S \<subseteq> M \<and> (\<exists>B>0. \<forall>x \<in> S. \<forall>y \<in> S. d x y \<le> B)"
+  by (smt (verit, del_insts) gt_ex mbounded_alt)
+
+lemma mbounded_subset: "\<lbrakk>mbounded T; S \<subseteq> T\<rbrakk> \<Longrightarrow> mbounded S"
+  by (meson mbounded_def order_trans)
+
+lemma mbounded_subset_mspace: "mbounded S \<Longrightarrow> S \<subseteq> M"
+  by (simp add: mbounded_alt)
+
+lemma mbounded:
+   "mbounded S \<longleftrightarrow> S = {} \<or> (\<forall>x \<in> S. x \<in> M) \<and> (\<exists>y B. y \<in> M \<and> (\<forall>x \<in> S. d y x \<le> B))"
+  by (meson all_not_in_conv in_mcball mbounded_def subset_iff)
+
+lemma mbounded_empty [iff]: "mbounded {}"
+  by (simp add: mbounded)
+
+lemma mbounded_mcball: "mbounded (mcball x r)"
+  using mbounded_def by auto
+
+lemma mbounded_mball [iff]: "mbounded (mball x r)"
+  by (meson mball_subset_mcball mbounded_def)
+
+lemma mbounded_insert: "mbounded (insert a S) \<longleftrightarrow> a \<in> M \<and> mbounded S"
+proof -
+  have "\<And>y B. \<lbrakk>y \<in> M; \<forall>x\<in>S. d y x \<le> B\<rbrakk>
+           \<Longrightarrow> \<exists>y. y \<in> M \<and> (\<exists>B \<ge> d y a. \<forall>x\<in>S. d y x \<le> B)"
+    by (metis order.trans nle_le)
+  then show ?thesis
+    by (auto simp: mbounded)
+qed
+
+lemma mbounded_Int: "mbounded S \<Longrightarrow> mbounded (S \<inter> T)"
+  by (meson inf_le1 mbounded_subset)
+
+lemma mbounded_Un: "mbounded (S \<union> T) \<longleftrightarrow> mbounded S \<and> mbounded T" (is "?lhs=?rhs")
+proof
+  assume R: ?rhs
+  show ?lhs
+  proof (cases "S={} \<or> T={}")
+    case True then show ?thesis
+      using R by auto
+  next
+    case False
+    obtain x y B C where "S \<subseteq> mcball x B" "T \<subseteq> mcball y C" "B > 0" "C > 0" "x \<in> M" "y \<in> M"
+      using R mbounded_pos
+      by (metis False mcball_eq_empty subset_empty)
+    then have "S \<union> T \<subseteq> mcball x (B + C + d x y)"
+      by (smt (verit) commute dual_order.trans le_supI mcball_subset mdist_pos_eq)
+    then show ?thesis
+      using mbounded_def by blast
+  qed
+next
+  show "?lhs \<Longrightarrow> ?rhs"
+    using mbounded_def by auto
+qed
+
+lemma mbounded_Union:
+  "\<lbrakk>finite \<F>; \<And>X. X \<in> \<F> \<Longrightarrow> mbounded X\<rbrakk> \<Longrightarrow> mbounded (\<Union>\<F>)"
+  by (induction \<F> rule: finite_induct) (auto simp: mbounded_Un)
+
+lemma mbounded_closure_of:
+   "mbounded S \<Longrightarrow> mbounded (mtopology closure_of S)"
+  by (meson closedin_mcball closure_of_minimal mbounded_def)
+
+lemma mbounded_closure_of_eq:
+   "S \<subseteq> M \<Longrightarrow> (mbounded (mtopology closure_of S) \<longleftrightarrow> mbounded S)"
+  by (metis closure_of_subset mbounded_closure_of mbounded_subset topspace_mtopology)
+
+
+lemma maxdist_thm:
+  assumes "mbounded S"
+      and "x \<in> S"
+      and "y \<in> S"
+    shows  "d x y = (SUP z\<in>S. \<bar>d x z - d z y\<bar>)"
+proof -
+  have "\<bar>d x z - d z y\<bar> \<le> d x y" if "z \<in> S" for z
+    by (metis all_not_in_conv assms mbounded mdist_reverse_triangle that) 
+  moreover have "d x y \<le> r"
+    if "\<And>z. z \<in> S \<Longrightarrow> \<bar>d x z - d z y\<bar> \<le> r" for r :: real
+    using that assms mbounded_subset_mspace mdist_zero by fastforce
+  ultimately show ?thesis
+    by (intro cSup_eq [symmetric]) auto
+qed
+
+
+lemma metric_eq_thm: "\<lbrakk>S \<subseteq> M; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> (x = y) = (\<forall>z\<in>S. d x z = d y z)"
+  by (metis commute  subset_iff zero)
+
+lemma compactin_imp_mbounded:
+  assumes "compactin mtopology S"
+  shows "mbounded S"
+proof -
+  have "S \<subseteq> M"
+    and com: "\<And>\<U>. \<lbrakk>\<forall>U\<in>\<U>. openin mtopology U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
+    using assms by (auto simp: compactin_def mbounded_def)
+  show ?thesis
+  proof (cases "S = {}")
+    case False
+    with \<open>S \<subseteq> M\<close> obtain a where "a \<in> S" "a \<in> M"
+      by blast
+    with \<open>S \<subseteq> M\<close> gt_ex have "S \<subseteq> \<Union>(range (mball a))"
+      by force
+    moreover have "\<forall>U \<in> range (mball a). openin mtopology U"
+      by (simp add: openin_mball)
+    ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> range (mball a)" "S \<subseteq> \<Union>\<F>"
+      by (meson com)
+  then show ?thesis
+      using mbounded_Union mbounded_subset by fastforce
+  qed auto
+qed
+
+end
+
+
+subsection\<open>Subspace of a metric space\<close>
+
+locale submetric = Metric_space + 
+  fixes A
+  assumes subset: "A \<subseteq> M"
+
+sublocale submetric \<subseteq> sub: Metric_space A d
+  by (simp add: subset subspace)
+
+context submetric
+begin 
+
+lemma mball_submetric_eq: "sub.mball a r = (if a \<in> A then A \<inter> mball a r else {})"
+and mcball_submetric_eq: "sub.mcball a r = (if a \<in> A then A \<inter> mcball a r else {})"
+  using subset by force+
+
+lemma mtopology_submetric: "sub.mtopology = subtopology mtopology A"
+  unfolding topology_eq
+proof (intro allI iffI)
+  fix S
+  assume "openin sub.mtopology S"
+  then have "\<exists>T. openin (subtopology mtopology A) T \<and> x \<in> T \<and> T \<subseteq> S" if "x \<in> S" for x
+    by (metis mball_submetric_eq openin_mball openin_subtopology_Int2 sub.centre_in_mball_iff sub.openin_mtopology subsetD that)
+  then show "openin (subtopology mtopology A) S"
+    by (meson openin_subopen)
+next
+  fix S
+  assume "openin (subtopology mtopology A) S"
+  then obtain T where "openin mtopology T" "S = T \<inter> A"
+    by (meson openin_subtopology)
+  then have "mopen T"
+    by (simp add: mopen_def openin_mtopology)
+  then have "sub.mopen (T \<inter> A)"
+    unfolding sub.mopen_def mopen_def
+    by (metis inf.coboundedI2 mball_submetric_eq Int_iff \<open>S = T \<inter> A\<close> inf.bounded_iff subsetI)
+  then show "openin sub.mtopology S"
+    using \<open>S = T \<inter> A\<close> sub.mopen_def sub.openin_mtopology by force
+qed
+
+lemma mbounded_submetric: "sub.mbounded T \<longleftrightarrow> mbounded T \<and> T \<subseteq> A"
+  by (meson mbounded_alt sub.mbounded_alt subset subset_trans)
+
+end
+
+lemma (in Metric_space) submetric_empty [iff]: "submetric M d {}"
+  by (simp add: Metric_space_axioms submetric.intro submetric_axioms_def)
+
+
+subsection\<open>The discrete metric\<close>
+
+locale discrete_metric =
+  fixes M :: "'a set"
+
+definition (in discrete_metric) dd :: "'a \<Rightarrow> 'a \<Rightarrow> real"
+  where "dd \<equiv> \<lambda>x y::'a. if x=y then 0 else 1"
+
+lemma metric_M_dd: "Metric_space M discrete_metric.dd"
+  by (simp add: discrete_metric.dd_def Metric_space.intro)
+
+sublocale discrete_metric \<subseteq> disc: Metric_space M dd
+  by (simp add: metric_M_dd)
+
+
+lemma (in discrete_metric) mopen_singleton:
+  assumes "x \<in> M" shows "disc.mopen {x}"
+proof -
+  have "disc.mball x (1/2) \<subseteq> {x}"
+    by (smt (verit) dd_def disc.in_mball less_divide_eq_1_pos singleton_iff subsetI)
+  with assms show ?thesis
+    using disc.mopen_def half_gt_zero_iff zero_less_one by blast
+qed
+
+lemma (in discrete_metric) mtopology_discrete_metric:
+   "disc.mtopology = discrete_topology M"
+proof -
+  have "\<And>x. x \<in> M \<Longrightarrow> openin disc.mtopology {x}"
+    by (simp add: disc.mtopology_def mopen_singleton)
+  then show ?thesis
+    by (metis disc.topspace_mtopology discrete_topology_unique)
+qed
+
+lemma (in discrete_metric) discrete_ultrametric:
+   "dd x z \<le> max (dd x y) (dd y z)"
+  by (simp add: dd_def)
+
+
+lemma (in discrete_metric) dd_le1: "dd x y \<le> 1"
+  by (simp add: dd_def)
+
+lemma (in discrete_metric) mbounded_discrete_metric: "disc.mbounded S \<longleftrightarrow> S \<subseteq> M"
+  by (meson dd_le1 disc.mbounded_alt)
+
+
+
+subsection\<open>Metrizable spaces\<close>
+
+definition metrizable_space where
+  "metrizable_space X \<equiv> \<exists>M d. Metric_space M d \<and> X = Metric_space.mtopology M d"
+
+lemma (in Metric_space) metrizable_space_mtopology: "metrizable_space mtopology"
+  using local.Metric_space_axioms metrizable_space_def by blast
+
+lemma openin_mtopology_eq_open [simp]: "openin Met_TC.mtopology = open"
+  by (simp add: Met_TC.mtopology_def)
+
+lemma closedin_mtopology_eq_closed [simp]: "closedin Met_TC.mtopology = closed"
+proof -
+  have "(euclidean::'a topology) = Met_TC.mtopology"
+    by (simp add: Met_TC.mtopology_def)
+  then show ?thesis
+    using closed_closedin by fastforce
+qed
+
+lemma compactin_mtopology_eq_compact [simp]: "compactin Met_TC.mtopology = compact"
+  by (simp add: compactin_def compact_eq_Heine_Borel fun_eq_iff) meson
+
+lemma metrizable_space_discrete_topology:
+   "metrizable_space(discrete_topology U)"
+  by (metis discrete_metric.mtopology_discrete_metric metric_M_dd metrizable_space_def)
+
+lemma metrizable_space_subtopology:
+  assumes "metrizable_space X"
+  shows "metrizable_space(subtopology X S)"
+proof -
+  obtain M d where "Metric_space M d" and X: "X = Metric_space.mtopology M d"
+    using assms metrizable_space_def by blast
+  then interpret submetric M d "M \<inter> S"
+    by (simp add: submetric.intro submetric_axioms_def)
+  show ?thesis
+    unfolding metrizable_space_def
+    by (metis X mtopology_submetric sub.Metric_space_axioms subtopology_restrict topspace_mtopology)
+qed
+
+lemma homeomorphic_metrizable_space_aux:
+  assumes "X homeomorphic_space Y" "metrizable_space X"
+  shows "metrizable_space Y"
+proof -
+  obtain M d where "Metric_space M d" and X: "X = Metric_space.mtopology M d"
+    using assms by (auto simp: metrizable_space_def)
+  then interpret m: Metric_space M d 
+    by simp
+  obtain f g where hmf: "homeomorphic_map X Y f" and hmg: "homeomorphic_map Y X g"
+    and fg: "(\<forall>x \<in> M. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
+    using assms X homeomorphic_maps_map homeomorphic_space_def by fastforce
+  define d' where "d' x y \<equiv> d (g x) (g y)" for x y
+  interpret m': Metric_space "topspace Y" "d'"
+    unfolding d'_def
+  proof
+    show "(d (g x) (g y) = 0) = (x = y)" if "x \<in> topspace Y" "y \<in> topspace Y" for x y
+      by (metis fg X hmg homeomorphic_imp_surjective_map imageI m.topspace_mtopology m.zero that)
+    show "d (g x) (g z) \<le> d (g x) (g y) + d (g y) (g z)"
+      if "x \<in> topspace Y" and "y \<in> topspace Y" and "z \<in> topspace Y" for x y z
+      by (metis X that hmg homeomorphic_eq_everything_map imageI m.topspace_mtopology m.triangle)
+  qed (auto simp: m.nonneg m.commute)
+  have "Y = Metric_space.mtopology (topspace Y) d'"
+    unfolding topology_eq
+  proof (intro allI)
+    fix S
+    have "openin m'.mtopology S" if S: "S \<subseteq> topspace Y" and "openin X (g ` S)"
+      unfolding m'.openin_mtopology
+    proof (intro conjI that strip)
+      fix y
+      assume "y \<in> S"
+      then obtain r where "r>0" and r: "m.mball (g y) r \<subseteq> g ` S" 
+        using X \<open>openin X (g ` S)\<close> m.openin_mtopology using \<open>y \<in> S\<close> by auto
+      then have "g ` m'.mball y r \<subseteq> m.mball (g y) r"
+        using X d'_def hmg homeomorphic_imp_surjective_map by fastforce
+      with S fg have "m'.mball y r \<subseteq> S"
+        by (smt (verit, del_insts) image_iff m'.in_mball r subset_iff)
+      then show "\<exists>r>0. m'.mball y r \<subseteq> S"
+        using \<open>0 < r\<close> by blast 
+    qed
+    moreover have "openin X (g ` S)" if ope': "openin m'.mtopology S"
+    proof -
+      have "\<exists>r>0. m.mball (g y) r \<subseteq> g ` S" if "y \<in> S" for y
+      proof -
+        have y: "y \<in> topspace Y"
+          using m'.openin_mtopology ope' that by blast
+        obtain r where "r > 0" and r: "m'.mball y r \<subseteq> S"
+          using ope' by (meson \<open>y \<in> S\<close> m'.openin_mtopology)
+        moreover have "\<And>x. \<lbrakk>x \<in> M; d (g y) x < r\<rbrakk> \<Longrightarrow> \<exists>u. u \<in> topspace Y \<and> d' y u < r \<and> x = g u"
+          using fg X d'_def hmf homeomorphic_imp_surjective_map by fastforce
+        ultimately have "m.mball (g y) r \<subseteq> g ` m'.mball y r"
+          using y by (force simp: m'.openin_mtopology)
+        then show ?thesis
+          using \<open>0 < r\<close> r by blast
+      qed
+      then show ?thesis
+        using X hmg homeomorphic_imp_surjective_map m.openin_mtopology ope' openin_subset by fastforce
+    qed
+    ultimately have "(S \<subseteq> topspace Y \<and> openin X (g ` S)) = openin m'.mtopology S"
+      using m'.topspace_mtopology openin_subset by blast
+    then show "openin Y S = openin m'.mtopology S"
+      by (simp add: m'.mopen_def homeomorphic_map_openness_eq [OF hmg])
+  qed
+  then show ?thesis
+    using m'.metrizable_space_mtopology by force
+qed
+
+lemma homeomorphic_metrizable_space:
+  assumes "X homeomorphic_space Y"
+  shows "metrizable_space X \<longleftrightarrow> metrizable_space Y"
+  using assms homeomorphic_metrizable_space_aux homeomorphic_space_sym by metis
+
+lemma metrizable_space_retraction_map_image:
+   "retraction_map X Y r \<and> metrizable_space X
+        \<Longrightarrow> metrizable_space Y"
+  using hereditary_imp_retractive_property metrizable_space_subtopology homeomorphic_metrizable_space
+  by blast
+
+
+lemma metrizable_imp_Hausdorff_space:
+   "metrizable_space X \<Longrightarrow> Hausdorff_space X"
+  by (metis Metric_space.Hausdorff_space_mtopology metrizable_space_def)
+
+(**
+lemma metrizable_imp_kc_space:
+   "metrizable_space X \<Longrightarrow> kc_space X"
+oops
+  MESON_TAC[METRIZABLE_IMP_HAUSDORFF_SPACE; HAUSDORFF_IMP_KC_SPACE]);;
+
+lemma kc_space_mtopology:
+   "kc_space mtopology"
+oops
+  REWRITE_TAC[GSYM FORALL_METRIZABLE_SPACE; METRIZABLE_IMP_KC_SPACE]);;
+**)
+
+lemma metrizable_imp_t1_space:
+   "metrizable_space X \<Longrightarrow> t1_space X"
+  by (simp add: Hausdorff_imp_t1_space metrizable_imp_Hausdorff_space)
+
+lemma closed_imp_gdelta_in:
+  assumes X: "metrizable_space X" and S: "closedin X S"
+  shows "gdelta_in X S"
+proof -
+  obtain M d where "Metric_space M d" and Xeq: "X = Metric_space.mtopology M d"
+    using X metrizable_space_def by blast
+  then interpret M: Metric_space M d
+    by blast
+  have "S \<subseteq> M"
+    using M.closedin_metric \<open>X = M.mtopology\<close> S by blast
+  show ?thesis
+  proof (cases "S = {}")
+    case True
+    then show ?thesis
+      by simp
+  next
+    case False
+    have "\<exists>y\<in>S. d x y < inverse (1 + real n)" if "x \<in> S" for x n
+      using \<open>S \<subseteq> M\<close> M.mdist_zero [of x] that by force
+    moreover
+    have "x \<in> S" if "x \<in> M" and \<section>: "\<And>n. \<exists>y\<in>S. d x y < inverse(Suc n)" for x
+    proof -
+      have *: "\<exists>y\<in>S. d x y < \<epsilon>" if "\<epsilon> > 0" for \<epsilon>
+        by (metis \<section> that not0_implies_Suc order_less_le order_less_le_trans real_arch_inverse)
+      have "closedin M.mtopology S"
+        using S by (simp add: Xeq)
+      then show ?thesis
+        apply (simp add: M.closedin_metric)
+        by (metis * \<open>x \<in> M\<close> M.in_mball disjnt_insert1 insert_absorb subsetD)
+    qed
+    ultimately have Seq: "S = \<Inter>(range (\<lambda>n. {x\<in>M. \<exists>y\<in>S. d x y < inverse(Suc n)}))"
+      using \<open>S \<subseteq> M\<close> by force
+    have "openin M.mtopology {xa \<in> M. \<exists>y\<in>S. d xa y < inverse (1 + real n)}" for n
+    proof (clarsimp simp: M.openin_mtopology)
+      fix x y
+      assume "x \<in> M" "y \<in> S" and dxy: "d x y < inverse (1 + real n)"
+      then have "\<And>z. \<lbrakk>z \<in> M; d x z < inverse (1 + real n) - d x y\<rbrakk> \<Longrightarrow> \<exists>y\<in>S. d z y < inverse (1 + real n)"
+        by (smt (verit) M.commute M.triangle \<open>S \<subseteq> M\<close> in_mono)
+      with dxy show "\<exists>r>0. M.mball x r \<subseteq> {z \<in> M. \<exists>y\<in>S. d z y < inverse (1 + real n)}"
+        by (rule_tac x="inverse(Suc n) - d x y" in exI) auto
+    qed
+    then show ?thesis
+      apply (subst Seq)
+      apply (force simp: Xeq intro: gdelta_in_Inter open_imp_gdelta_in)
+      done
+  qed
+qed
+
+lemma open_imp_fsigma_in:
+   "\<lbrakk>metrizable_space X; openin X S\<rbrakk> \<Longrightarrow> fsigma_in X S"
+  by (meson closed_imp_gdelta_in fsigma_in_gdelta_in openin_closedin openin_subset)
+
+(*NEEDS first_countable
+lemma first_countable_mtopology:
+   "first_countable mtopology"
+oops
+  GEN_TAC THEN REWRITE_TAC[first_countable; TOPSPACE_MTOPOLOGY] THEN
+  X_GEN_TAC `x::A` THEN DISCH_TAC THEN
+  EXISTS_TAC `{ mball m (x::A,r) | rational r \<and> 0 < r}` THEN
+  REWRITE_TAC[FORALL_IN_GSPEC; OPEN_IN_MBALL; EXISTS_IN_GSPEC] THEN
+  ONCE_REWRITE_TAC[SET_RULE
+   `{f x | S x \<and> Q x} = f ` {x \<in> S. Q x}`] THEN
+  SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL; COUNTABLE_RESTRICT] THEN
+  REWRITE_TAC[OPEN_IN_MTOPOLOGY] THEN
+  X_GEN_TAC `U::A=>bool` THEN STRIP_TAC THEN
+  FIRST_X_ASSUM(MP_TAC \<circ> SPEC `x::A`) THEN
+  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+  X_GEN_TAC `r::real` THEN STRIP_TAC THEN FIRST_ASSUM
+   (MP_TAC \<circ> SPEC `r::real` \<circ> MATCH_MP RATIONAL_APPROXIMATION_BELOW) THEN
+  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q::real` THEN
+  REWRITE_TAC[REAL_SUB_REFL] THEN STRIP_TAC THEN
+  ASM_SIMP_TAC[CENTRE_IN_MBALL] THEN
+  TRANS_TAC SUBSET_TRANS `mball m (x::A,r)` THEN
+  ASM_SIMP_TAC[MBALL_SUBSET_CONCENTRIC; REAL_LT_IMP_LE]);;
+
+lemma metrizable_imp_first_countable:
+   "metrizable_space X \<Longrightarrow> first_countable X"
+oops
+  REWRITE_TAC[FORALL_METRIZABLE_SPACE; FIRST_COUNTABLE_MTOPOLOGY]);;
+*)
+
+lemma mball_eq_ball [simp]: "Met_TC.mball = ball"
+  by force
+
+lemma mopen_eq_open [simp]: "Met_TC.mopen = open"
+  by (force simp: open_contains_ball Met_TC.mopen_def)
+
+lemma metrizable_space_euclidean:
+  "metrizable_space (euclidean :: 'a::metric_space topology)"
+  unfolding metrizable_space_def
+  by (metis Met_TC.Metric_space_axioms Met_TC.mtopology_def mopen_eq_open)
+
+lemma (in Metric_space) regular_space_mtopology:
+   "regular_space mtopology"
+unfolding regular_space_def
+proof clarify
+  fix C a
+  assume C: "closedin mtopology C" and a: "a \<in> topspace mtopology" and "a \<notin> C"
+  have "openin mtopology (topspace mtopology - C)"
+    by (simp add: C openin_diff)
+  then obtain r where "r>0" and r: "mball a r \<subseteq> topspace mtopology - C"
+    unfolding openin_mtopology using \<open>a \<notin> C\<close> a by auto
+  show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V"
+  proof (intro exI conjI)
+    show "a \<in> mball a (r/2)"
+      using \<open>0 < r\<close> a by force
+    show "C \<subseteq> topspace mtopology - mcball a (r/2)"
+      using C \<open>0 < r\<close> r by (fastforce simp: closedin_metric)
+  qed (auto simp: openin_mball closedin_mcball openin_diff disjnt_iff)
+qed
+
+lemma metrizable_imp_regular_space:
+   "metrizable_space X \<Longrightarrow> regular_space X"
+  by (metis Metric_space.regular_space_mtopology metrizable_space_def)
+
+lemma regular_space_euclidean:
+ "regular_space (euclidean :: 'a::metric_space topology)"
+  by (simp add: metrizable_imp_regular_space metrizable_space_euclidean)
+
+
+subsection\<open>Limits at a point in a topological space\<close>
+
+lemma (in Metric_space) eventually_atin_metric:
+   "eventually P (atin mtopology a) \<longleftrightarrow>
+        (a \<in> M \<longrightarrow> (\<exists>\<delta>>0. \<forall>x. x \<in> M \<and> 0 < d x a \<and> d x a < \<delta> \<longrightarrow> P x))"  (is "?lhs=?rhs")
+proof (cases "a \<in> M")
+  case True
+  show ?thesis
+  proof
+    assume L: ?lhs 
+    with True obtain U where "openin mtopology U" "a \<in> U" and U: "\<forall>x\<in>U - {a}. P x"
+      by (auto simp: eventually_atin)
+    then obtain r where "r>0" and "mball a r \<subseteq> U"
+      by (meson openin_mtopology)
+    with U show ?rhs
+      by (smt (verit, ccfv_SIG) commute in_mball insert_Diff_single insert_iff subset_iff)
+  next
+    assume ?rhs 
+    then obtain \<delta> where "\<delta>>0" and \<delta>: "\<forall>x. x \<in> M \<and> 0 < d x a \<and> d x a < \<delta> \<longrightarrow> P x"
+      using True by blast
+    then have "\<forall>x \<in> mball a \<delta> - {a}. P x"
+      by (simp add: commute)
+    then show ?lhs
+      unfolding eventually_atin openin_mtopology
+      by (metis True \<open>0 < \<delta>\<close> centre_in_mball_iff openin_mball openin_mtopology) 
+  qed
+qed auto
+
+subsection \<open>Normal spaces and metric spaces\<close>
+
+lemma (in Metric_space) normal_space_mtopology:
+   "normal_space mtopology"
+  unfolding normal_space_def
+proof clarify
+  fix S T
+  assume "closedin mtopology S"
+  then have "\<And>x. x \<in> M - S \<Longrightarrow> (\<exists>r>0. mball x r \<subseteq> M - S)"
+    by (simp add: closedin_def openin_mtopology)
+  then obtain \<delta> where d0: "\<And>x. x \<in> M - S \<Longrightarrow> \<delta> x > 0 \<and> mball x (\<delta> x) \<subseteq> M - S"
+    by metis
+  assume "closedin mtopology T"
+  then have "\<And>x. x \<in> M - T \<Longrightarrow> (\<exists>r>0. mball x r \<subseteq> M - T)"
+    by (simp add: closedin_def openin_mtopology)
+  then obtain \<epsilon> where e: "\<And>x. x \<in> M - T \<Longrightarrow> \<epsilon> x > 0 \<and> mball x (\<epsilon> x) \<subseteq> M - T"
+    by metis
+  assume "disjnt S T"
+  have "S \<subseteq> M" "T \<subseteq> M"
+    using \<open>closedin mtopology S\<close> \<open>closedin mtopology T\<close> closedin_metric by blast+
+  have \<delta>: "\<And>x. x \<in> T \<Longrightarrow> \<delta> x > 0 \<and> mball x (\<delta> x) \<subseteq> M - S"
+    by (meson DiffI \<open>T \<subseteq> M\<close> \<open>disjnt S T\<close> d0 disjnt_iff subsetD)
+  have \<epsilon>: "\<And>x. x \<in> S \<Longrightarrow> \<epsilon> x > 0 \<and> mball x (\<epsilon> x) \<subseteq> M - T"
+    by (meson Diff_iff \<open>S \<subseteq> M\<close> \<open>disjnt S T\<close> disjnt_iff e subsetD)
+  show "\<exists>U V. openin mtopology U \<and> openin mtopology V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
+  proof (intro exI conjI)
+    show "openin mtopology (\<Union>x\<in>S. mball x (\<epsilon> x / 2))" "openin mtopology (\<Union>x\<in>T. mball x (\<delta> x / 2))"
+      by force+
+    show "S \<subseteq> (\<Union>x\<in>S. mball x (\<epsilon> x / 2))"
+      using \<epsilon> \<open>S \<subseteq> M\<close> by force
+    show "T \<subseteq> (\<Union>x\<in>T. mball x (\<delta> x / 2))"
+      using \<delta> \<open>T \<subseteq> M\<close> by force
+    show "disjnt (\<Union>x\<in>S. mball x (\<epsilon> x / 2)) (\<Union>x\<in>T. mball x (\<delta> x / 2))"
+      using \<epsilon> \<delta> 
+      apply (clarsimp simp: disjnt_iff subset_iff)
+      by (smt (verit, ccfv_SIG) field_sum_of_halves triangle')
+  qed 
+qed
+
+lemma metrizable_imp_normal_space:
+   "metrizable_space X \<Longrightarrow> normal_space X"
+  by (metis Metric_space.normal_space_mtopology metrizable_space_def)
+
+subsection\<open>Topological limitin in metric spaces\<close>
+
+
+lemma (in Metric_space) limitin_mspace:
+   "limitin mtopology f l F \<Longrightarrow> l \<in> M"
+  using limitin_topspace by fastforce
+
+lemma (in Metric_space) limitin_metric_unique:
+   "\<lbrakk>limitin mtopology f l1 F; limitin mtopology f l2 F; F \<noteq> bot\<rbrakk> \<Longrightarrow> l1 = l2"
+  by (meson Hausdorff_space_mtopology limitin_Hausdorff_unique)
+
+lemma (in Metric_space) limitin_metric:
+   "limitin mtopology f l F \<longleftrightarrow> l \<in> M \<and> (\<forall>\<epsilon>>0. eventually (\<lambda>x. f x \<in> M \<and> d (f x) l < \<epsilon>) F)"  
+   (is "?lhs=?rhs")
+proof
+  assume L: ?lhs
+  show ?rhs
+    unfolding limitin_def
+  proof (intro conjI strip)
+    show "l \<in> M"
+      using L limitin_mspace by blast
+    fix \<epsilon>::real
+    assume "\<epsilon>>0"
+    then have "\<forall>\<^sub>F x in F. f x \<in> mball l \<epsilon>"
+      using L openin_mball by (fastforce simp: limitin_def)
+    then show "\<forall>\<^sub>F x in F. f x \<in> M \<and> d (f x) l < \<epsilon>"
+      using commute eventually_mono by fastforce
+  qed
+next
+  assume R: ?rhs 
+  then show ?lhs
+    by (force simp: limitin_def commute openin_mtopology subset_eq elim: eventually_mono)
+qed
+
+lemma (in Metric_space) limit_metric_sequentially:
+   "limitin mtopology f l sequentially \<longleftrightarrow>
+     l \<in> M \<and> (\<forall>\<epsilon>>0. \<exists>N. \<forall>n\<ge>N. f n \<in> M \<and> d (f n) l < \<epsilon>)"
+  by (auto simp: limitin_metric eventually_sequentially)
+
+lemma (in submetric) limitin_submetric_iff:
+   "limitin sub.mtopology f l F \<longleftrightarrow>
+     l \<in> A \<and> eventually (\<lambda>x. f x \<in> A) F \<and> limitin mtopology f l F" (is "?lhs=?rhs")
+  by (simp add: limitin_subtopology mtopology_submetric)
+
+lemma (in Metric_space) metric_closedin_iff_sequentially_closed:
+   "closedin mtopology S \<longleftrightarrow>
+    S \<subseteq> M \<and> (\<forall>\<sigma> l. range \<sigma> \<subseteq> S \<and> limitin mtopology \<sigma> l sequentially \<longrightarrow> l \<in> S)" (is "?lhs=?rhs")
+proof
+  assume ?lhs then show ?rhs
+    by (force simp: closedin_metric limitin_closedin range_subsetD)
+next
+  assume R: ?rhs
+  show ?lhs
+    unfolding closedin_metric
+  proof (intro conjI strip)
+    show "S \<subseteq> M"
+      using R by blast
+    fix x
+    assume "x \<in> M - S"
+    have False if "\<forall>r>0. \<exists>y. y \<in> M \<and> y \<in> S \<and> d x y < r"
+    proof -
+      have "\<forall>n. \<exists>y. y \<in> M \<and> y \<in> S \<and> d x y < inverse(Suc n)"
+        using that by auto
+      then obtain \<sigma> where \<sigma>: "\<And>n. \<sigma> n \<in> M \<and> \<sigma> n \<in> S \<and> d x (\<sigma> n) < inverse(Suc n)"
+        by metis
+      then have "range \<sigma> \<subseteq> M"
+        by blast
+      have "\<exists>N. \<forall>n\<ge>N. d x (\<sigma> n) < \<epsilon>" if "\<epsilon>>0" for \<epsilon>
+      proof -
+        have "real (Suc (nat \<lceil>inverse \<epsilon>\<rceil>)) \<ge> inverse \<epsilon>"
+          by linarith
+        then have "\<forall>n \<ge> nat \<lceil>inverse \<epsilon>\<rceil>. d x (\<sigma> n) < \<epsilon>"
+          by (metis \<sigma> inverse_inverse_eq inverse_le_imp_le nat_ceiling_le_eq nle_le not_less_eq_eq order.strict_trans2 that)
+        then show ?thesis ..
+      qed
+      with \<sigma> have "limitin mtopology \<sigma> x sequentially"
+        using \<open>x \<in> M - S\<close> commute limit_metric_sequentially by auto
+      then show ?thesis
+        by (metis R DiffD2 \<sigma> image_subset_iff \<open>x \<in> M - S\<close>)
+    qed
+    then show "\<exists>r>0. disjnt S (mball x r)"
+      by (meson disjnt_iff in_mball)
+  qed
+qed
+
+lemma (in Metric_space) limit_atin_metric:
+   "limitin X f y (atin mtopology x) \<longleftrightarrow>
+      y \<in> topspace X \<and>
+      (x \<in> M
+       \<longrightarrow> (\<forall>V. openin X V \<and> y \<in> V
+               \<longrightarrow> (\<exists>\<delta>>0.  \<forall>x'. x' \<in> M \<and> 0 < d x' x \<and> d x' x < \<delta> \<longrightarrow> f x' \<in> V)))"
+  by (force simp: limitin_def eventually_atin_metric)
+
+lemma (in Metric_space) limitin_metric_dist_null:
+   "limitin mtopology f l F \<longleftrightarrow> l \<in> M \<and> eventually (\<lambda>x. f x \<in> M) F \<and> ((\<lambda>x. d (f x) l) \<longlongrightarrow> 0) F"
+  by (simp add: limitin_metric tendsto_iff eventually_conj_iff all_conj_distrib imp_conjR gt_ex)
+
+
+subsection\<open>Cauchy sequences and complete metric spaces\<close>
+
+context Metric_space
+begin
+
+definition MCauchy :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
+  where "MCauchy \<sigma> \<equiv> range \<sigma> \<subseteq> M \<and> (\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>)"
+
+definition mcomplete
+  where "mcomplete \<equiv> (\<forall>\<sigma>. MCauchy \<sigma> \<longrightarrow> (\<exists>x. limitin mtopology \<sigma> x sequentially))"
+
+lemma mcomplete_empty [iff]: "Metric_space.mcomplete {} d"
+  by (simp add: Metric_space.MCauchy_def Metric_space.mcomplete_def subspace)
+
+lemma MCauchy_imp_MCauchy_suffix: "MCauchy \<sigma> \<Longrightarrow> MCauchy (\<sigma> \<circ> (+)n)"
+  unfolding MCauchy_def image_subset_iff comp_apply
+  by (metis UNIV_I add.commute trans_le_add1) 
+
+lemma mcomplete:
+   "mcomplete \<longleftrightarrow>
+    (\<forall>\<sigma>. (\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M) \<and>
+     (\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>) \<longrightarrow>
+     (\<exists>x. limitin mtopology \<sigma> x sequentially))" (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+  proof clarify
+    fix \<sigma>
+    assume "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M"
+      and \<sigma>: "\<forall>\<epsilon>>0. \<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
+    then obtain N where "\<And>n. n\<ge>N \<Longrightarrow> \<sigma> n \<in> M"
+      by (auto simp: eventually_sequentially)
+    with \<sigma> have "MCauchy (\<sigma> \<circ> (+)N)"
+      unfolding MCauchy_def image_subset_iff comp_apply by (meson le_add1 trans_le_add2)
+    then obtain x where "limitin mtopology (\<sigma> \<circ> (+)N) x sequentially"
+      using L MCauchy_imp_MCauchy_suffix mcomplete_def by blast
+    then have "limitin mtopology \<sigma> x sequentially"
+      unfolding o_def by (auto simp: add.commute limitin_sequentially_offset_rev)
+    then show "\<exists>x. limitin mtopology \<sigma> x sequentially" ..
+  qed
+qed (simp add: mcomplete_def MCauchy_def image_subset_iff)
+
+lemma mcomplete_empty_mspace: "M = {} \<Longrightarrow> mcomplete"
+  using MCauchy_def mcomplete_def by blast
+
+lemma MCauchy_const [simp]: "MCauchy (\<lambda>n. a) \<longleftrightarrow> a \<in> M"
+  using MCauchy_def mdist_zero by auto
+
+lemma convergent_imp_MCauchy:
+  assumes "range \<sigma> \<subseteq> M" and lim: "limitin mtopology \<sigma> l sequentially"
+  shows "MCauchy \<sigma>"
+  unfolding MCauchy_def image_subset_iff
+proof (intro conjI strip)
+  fix \<epsilon>::real
+  assume "\<epsilon> > 0"
+  then have "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>/2"
+    using half_gt_zero lim limitin_metric by blast
+  then obtain N where "\<And>n. n\<ge>N \<Longrightarrow> \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>/2"
+    by (force simp: eventually_sequentially)
+  then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
+    by (smt (verit) Metric_space.limitin_mspace Metric_space.mdist_reverse_triangle Metric_space_axioms field_sum_of_halves lim)
+qed (use assms in blast)
+
+
+lemma mcomplete_alt:
+   "mcomplete \<longleftrightarrow> (\<forall>\<sigma>. MCauchy \<sigma> \<longleftrightarrow> range \<sigma> \<subseteq> M \<and> (\<exists>x. limitin mtopology \<sigma> x sequentially))"
+  using MCauchy_def convergent_imp_MCauchy mcomplete_def by blast
+
+lemma MCauchy_subsequence:
+  assumes "strict_mono r" "MCauchy \<sigma>"
+  shows "MCauchy (\<sigma> \<circ> r)"
+proof -
+  have "d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>"
+    if "N \<le> n" "N \<le> n'" "strict_mono r" "\<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
+    for \<epsilon> N n n'
+    using that by (meson le_trans strict_mono_imp_increasing)
+  moreover have "range (\<lambda>x. \<sigma> (r x)) \<subseteq> M"
+    using MCauchy_def assms by blast
+  ultimately show ?thesis
+    using assms by (simp add: MCauchy_def) metis
+qed
+
+lemma MCauchy_offset:
+  assumes cau: "MCauchy (\<sigma> \<circ> (+)k)" and \<sigma>: "\<And>n. n < k \<Longrightarrow> \<sigma> n \<in> M" 
+  shows "MCauchy \<sigma>"
+  unfolding MCauchy_def image_subset_iff
+proof (intro conjI strip)
+  fix n
+  show "\<sigma> n \<in> M"
+    using assms
+    unfolding MCauchy_def image_subset_iff
+    by (metis UNIV_I comp_apply le_iff_add linorder_not_le)
+next
+  fix \<epsilon> :: real
+  assume "\<epsilon> > 0"
+  obtain N where "\<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d ((\<sigma> \<circ> (+)k) n) ((\<sigma> \<circ> (+)k) n') < \<epsilon>"
+    using cau \<open>\<epsilon> > 0\<close> by (fastforce simp: MCauchy_def)
+  then show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>"
+    unfolding o_def
+    apply (rule_tac x="k+N" in exI)
+    by (smt (verit, del_insts) add.assoc le_add1 less_eqE)
+qed
+
+lemma MCauchy_convergent_subsequence:
+  assumes cau: "MCauchy \<sigma>" and "strict_mono r" 
+     and lim: "limitin mtopology (\<sigma> \<circ> r) a sequentially"
+  shows "limitin mtopology \<sigma> a sequentially"
+  unfolding limitin_metric
+proof (intro conjI strip)
+  show "a \<in> M"
+    by (meson assms limitin_mspace)
+  fix \<epsilon> :: real
+  assume "\<epsilon> > 0"
+  then obtain N1 where N1: "\<And>n n'. \<lbrakk>n\<ge>N1; n'\<ge>N1\<rbrakk> \<Longrightarrow> d (\<sigma> n) (\<sigma> n') < \<epsilon>/2"
+    using cau unfolding MCauchy_def by (meson half_gt_zero)
+  obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) a < \<epsilon>/2"
+    by (metis (no_types, lifting) lim \<open>\<epsilon> > 0\<close> half_gt_zero limit_metric_sequentially)
+  have "\<sigma> n \<in> M \<and> d (\<sigma> n) a < \<epsilon>" if "n \<ge> max N1 N2" for n
+  proof (intro conjI)
+    show "\<sigma> n \<in> M"
+      using MCauchy_def cau by blast
+    have "N1 \<le> r n"
+      by (meson \<open>strict_mono r\<close> le_trans max.cobounded1 strict_mono_imp_increasing that)
+    then show "d (\<sigma> n) a < \<epsilon>"
+      using N1[of n "r n"] N2[of n] \<open>\<sigma> n \<in> M\<close> \<open>a \<in> M\<close> triangle that by fastforce
+  qed
+  then show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) a < \<epsilon>"
+    using eventually_sequentially by blast
+qed
+
+lemma MCauchy_interleaving_gen:
+  "MCauchy (\<lambda>n. if even n then x(n div 2) else y(n div 2)) \<longleftrightarrow>
+    (MCauchy x \<and> MCauchy y \<and> (\<lambda>n. d (x n) (y n)) \<longlonglongrightarrow> 0)" (is "?lhs=?rhs")
+proof
+  assume L: ?lhs
+  have evens: "strict_mono (\<lambda>n::nat. 2 * n)" and odds: "strict_mono (\<lambda>n::nat. Suc (2 * n))"
+    by (auto simp: strict_mono_def)
+  show ?rhs
+  proof (intro conjI)
+    show "MCauchy x" "MCauchy y"
+      using MCauchy_subsequence [OF evens L] MCauchy_subsequence [OF odds L] by (auto simp: o_def)
+    show "(\<lambda>n. d (x n) (y n)) \<longlonglongrightarrow> 0"
+      unfolding LIMSEQ_iff
+    proof (intro strip)
+      fix \<epsilon> :: real
+      assume "\<epsilon> > 0"
+      then obtain N where N: 
+        "\<And>n n'. \<lbrakk>n\<ge>N; n'\<ge>N\<rbrakk> \<Longrightarrow> d (if even n then x (n div 2) else y (n div 2))
+                                   (if even n' then x (n' div 2) else y (n' div 2))  < \<epsilon>"
+        using L MCauchy_def by fastforce
+      have "d (x n) (y n) < \<epsilon>" if "n\<ge>N" for n
+        using N [of "2*n" "Suc(2*n)"] that by auto
+      then show "\<exists>N. \<forall>n\<ge>N. norm (d (x n) (y n) - 0) < \<epsilon>"
+        by auto
+    qed
+  qed
+next
+  assume R: ?rhs
+  show ?lhs
+    unfolding MCauchy_def
+  proof (intro conjI strip)
+    show "range (\<lambda>n. if even n then x (n div 2) else y (n div 2)) \<subseteq> M"
+      using R by (auto simp: MCauchy_def)
+    fix \<epsilon> :: real
+    assume "\<epsilon> > 0"
+    obtain Nx where Nx: "\<And>n n'. \<lbrakk>n\<ge>Nx; n'\<ge>Nx\<rbrakk> \<Longrightarrow> d (x n) (x n')  < \<epsilon>/2"
+      by (meson half_gt_zero MCauchy_def R \<open>\<epsilon> > 0\<close>)
+    obtain Ny where Ny: "\<And>n n'. \<lbrakk>n\<ge>Ny; n'\<ge>Ny\<rbrakk> \<Longrightarrow> d (y n) (y n')  < \<epsilon>/2"
+      by (meson half_gt_zero MCauchy_def R \<open>\<epsilon> > 0\<close>)
+    obtain Nxy where Nxy: "\<And>n. n\<ge>Nxy \<Longrightarrow> d (x n) (y n) < \<epsilon>/2"
+      using R \<open>\<epsilon> > 0\<close> half_gt_zero unfolding LIMSEQ_iff
+      by (metis abs_mdist diff_zero real_norm_def)
+    define N where "N \<equiv> 2 * Max{Nx,Ny,Nxy}"
+    show "\<exists>N. \<forall>n n'. N \<le> n \<longrightarrow> N \<le> n' \<longrightarrow> d (if even n then x (n div 2) else y (n div 2)) (if even n' then x (n' div 2) else y (n' div 2)) < \<epsilon>"
+    proof (intro exI strip)
+      fix n n'
+      assume "N \<le> n" and "N \<le> n'"
+      then have "n div 2 \<ge> Nx" "n div 2 \<ge> Ny" "n div 2 \<ge> Nxy" "n' div 2 \<ge> Nx" "n' div 2 \<ge> Ny" 
+        by (auto simp: N_def)
+      then have dxyn: "d (x (n div 2)) (y (n div 2)) < \<epsilon>/2" 
+            and dxnn': "d (x (n div 2)) (x (n' div 2)) < \<epsilon>/2"
+            and dynn': "d (y (n div 2)) (y (n' div 2)) < \<epsilon>/2"
+        using Nx Ny Nxy by blast+
+      have inM: "x (n div 2) \<in> M" "x (n' div 2) \<in> M""y (n div 2) \<in> M" "y (n' div 2) \<in> M"
+        using Metric_space.MCauchy_def Metric_space_axioms R by blast+
+      show "d (if even n then x (n div 2) else y (n div 2)) (if even n' then x (n' div 2) else y (n' div 2)) < \<epsilon>"
+      proof (cases "even n")
+        case nt: True
+        show ?thesis
+        proof (cases "even n'")
+          case True
+          with \<open>\<epsilon> > 0\<close> nt dxnn' show ?thesis by auto
+        next
+          case False
+          with nt dxyn dynn' inM triangle show ?thesis
+            by fastforce
+        qed
+      next
+        case nf: False
+        show ?thesis 
+        proof (cases "even n'")
+          case True
+          then show ?thesis
+            by (smt (verit) \<open>\<epsilon> > 0\<close> dxyn dxnn' triangle commute inM field_sum_of_halves)
+        next
+          case False
+          with \<open>\<epsilon> > 0\<close> nf dynn' show ?thesis by auto
+        qed
+      qed
+    qed
+  qed
+qed
+
+lemma MCauchy_interleaving:
+   "MCauchy (\<lambda>n. if even n then \<sigma>(n div 2) else a) \<longleftrightarrow>
+    range \<sigma> \<subseteq> M \<and> limitin mtopology \<sigma> a sequentially"  (is "?lhs=?rhs")
+proof -
+  have "?lhs \<longleftrightarrow> (MCauchy \<sigma> \<and> a \<in> M \<and> (\<lambda>n. d (\<sigma> n) a) \<longlonglongrightarrow> 0)"
+    by (simp add: MCauchy_interleaving_gen [where y = "\<lambda>n. a"])
+  also have "... = ?rhs"
+    by (metis MCauchy_def always_eventually convergent_imp_MCauchy limitin_metric_dist_null range_subsetD)
+  finally show ?thesis .
+qed
+
+lemma mcomplete_nest:
+   "mcomplete \<longleftrightarrow>
+      (\<forall>C::nat \<Rightarrow>'a set. (\<forall>n. closedin mtopology (C n)) \<and>
+          (\<forall>n. C n \<noteq> {}) \<and> decseq C \<and> (\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>)
+          \<longrightarrow> \<Inter> (range C) \<noteq> {})" (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+    unfolding imp_conjL
+  proof (intro strip)
+    fix C :: "nat \<Rightarrow> 'a set"
+    assume clo: "\<forall>n. closedin mtopology (C n)"
+      and ne: "\<forall>n. C n \<noteq> ({}::'a set)"
+      and dec: "decseq C"
+      and cover [rule_format]: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
+    obtain \<sigma> where \<sigma>: "\<And>n. \<sigma> n \<in> C n"
+      by (meson ne empty_iff set_eq_iff)
+    have "MCauchy \<sigma>"
+      unfolding MCauchy_def
+    proof (intro conjI strip)
+      show "range \<sigma> \<subseteq> M"
+        using \<sigma> clo metric_closedin_iff_sequentially_closed by auto 
+      fix \<epsilon> :: real
+      assume "\<epsilon> > 0"
+      then obtain N a where N: "C N \<subseteq> mcball a (\<epsilon>/3)"
+        using cover by fastforce
+      have "d (\<sigma> m) (\<sigma> n) < \<epsilon>" if "N \<le> m" "N \<le> n" for m n
+      proof -
+        have "d a (\<sigma> m) \<le> \<epsilon>/3" "d a (\<sigma> n) \<le> \<epsilon>/3"
+          using dec N \<sigma> that by (fastforce simp: decseq_def)+
+        then have "d (\<sigma> m) (\<sigma> n) \<le> \<epsilon>/3 + \<epsilon>/3"
+          using triangle \<sigma> commute dec decseq_def subsetD that N
+          by (smt (verit, ccfv_threshold) in_mcball)
+        also have "... < \<epsilon>"
+          using \<open>\<epsilon> > 0\<close> by auto
+        finally show ?thesis .
+      qed
+      then show "\<exists>N. \<forall>m n. N \<le> m \<longrightarrow> N \<le> n \<longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>"
+        by blast
+    qed
+    then obtain x where x: "limitin mtopology \<sigma> x sequentially"
+      using L mcomplete_def by blast
+    have "x \<in> C n" for n
+    proof (rule limitin_closedin [OF x])
+      show "closedin mtopology (C n)"
+        by (simp add: clo)
+      show "\<forall>\<^sub>F x in sequentially. \<sigma> x \<in> C n"
+        by (metis \<sigma> dec decseq_def eventually_sequentiallyI subsetD)
+    qed auto
+    then show "\<Inter> (range C) \<noteq> {}"
+      by blast
+qed
+next
+  assume R: ?rhs  
+  show ?lhs
+    unfolding mcomplete_def
+  proof (intro strip)
+    fix \<sigma>
+    assume "MCauchy \<sigma>"
+    then have "range \<sigma> \<subseteq> M"
+      using MCauchy_def by blast
+    define C where "C \<equiv> \<lambda>n. mtopology closure_of (\<sigma> ` {n..})"
+    have "\<forall>n. closedin mtopology (C n)" 
+      by (auto simp: C_def)
+    moreover
+    have ne: "\<And>n. C n \<noteq> {}"
+      using \<open>MCauchy \<sigma>\<close> by (auto simp: C_def MCauchy_def disjnt_iff closure_of_eq_empty_gen)
+    moreover
+    have dec: "decseq C"
+      unfolding monotone_on_def
+    proof (intro strip)
+      fix m n::nat
+      assume "m \<le> n"
+      then have "{n..} \<subseteq> {m..}"
+        by auto
+      then show "C n \<subseteq> C m"
+        unfolding C_def by (meson closure_of_mono image_mono)
+    qed
+    moreover
+    have C: "\<exists>N u. C N \<subseteq> mcball u \<epsilon>" if "\<epsilon>>0" for \<epsilon>
+    proof -
+      obtain N where "\<And>m n. N \<le> m \<and> N \<le> n \<Longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>"
+        by (meson MCauchy_def \<open>0 < \<epsilon>\<close> \<open>MCauchy \<sigma>\<close>)
+      then have "\<sigma> ` {N..} \<subseteq> mcball (\<sigma> N) \<epsilon>"
+        using MCauchy_def \<open>MCauchy \<sigma>\<close> by (force simp: less_eq_real_def)
+      then have "C N \<subseteq> mcball (\<sigma> N) \<epsilon>"
+        by (simp add: C_def closure_of_minimal)
+      then show ?thesis
+        by blast
+    qed
+    ultimately obtain l where x: "l \<in> \<Inter> (range C)"
+      by (metis R ex_in_conv)
+    then have *: "\<And>\<epsilon> N. 0 < \<epsilon> \<Longrightarrow> \<exists>n'. N \<le> n' \<and> l \<in> M \<and> \<sigma> n' \<in> M \<and> d l (\<sigma> n') < \<epsilon>"
+      by (force simp: C_def metric_closure_of)
+    then have "l \<in> M"
+      using gt_ex by blast
+    show "\<exists>l. limitin mtopology \<sigma> l sequentially"
+      unfolding limitin_metric
+    proof (intro conjI strip exI)
+      show "l \<in> M"
+        using \<open>\<forall>n. closedin mtopology (C n)\<close> closedin_subset x by fastforce
+      fix \<epsilon>::real
+      assume "\<epsilon> > 0"
+      obtain N where N: "\<And>m n. N \<le> m \<and> N \<le> n \<Longrightarrow> d (\<sigma> m) (\<sigma> n) < \<epsilon>/2"
+        by (meson MCauchy_def \<open>0 < \<epsilon>\<close> \<open>MCauchy \<sigma>\<close> half_gt_zero)
+      with * [of "\<epsilon>/2" N]
+      have "\<forall>n\<ge>N. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>"
+        by (smt (verit) \<open>range \<sigma> \<subseteq> M\<close> commute field_sum_of_halves range_subsetD triangle)
+      then show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> M \<and> d (\<sigma> n) l < \<epsilon>"
+        using eventually_sequentially by blast
+    qed
+  qed
+qed
+
+
+lemma mcomplete_nest_sing:
+   "mcomplete \<longleftrightarrow>
+    (\<forall>C. (\<forall>n. closedin mtopology (C n)) \<and>
+          (\<forall>n. C n \<noteq> {}) \<and> decseq C \<and> (\<forall>e>0. \<exists>n a. C n \<subseteq> mcball a e)
+         \<longrightarrow> (\<exists>l. l \<in> M \<and> \<Inter> (range C) = {l}))"
+proof -
+  have *: False
+    if clo: "\<forall>n. closedin mtopology (C n)"
+      and cover: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
+      and no_sing: "\<And>y. y \<in> M \<Longrightarrow> \<Inter> (range C) \<noteq> {y}"
+      and l: "\<forall>n. l \<in> C n"
+    for C :: "nat \<Rightarrow> 'a set" and l
+  proof -
+    have inM: "\<And>x. x \<in> \<Inter> (range C) \<Longrightarrow> x \<in> M"
+      using closedin_metric clo by fastforce
+    then have "l \<in> M"
+      by (simp add: l)
+    have False if l': "l' \<in> \<Inter> (range C)" and "l' \<noteq> l" for l'
+    proof -
+      have "l' \<in> M"
+        using inM l' by blast
+      obtain n a where na: "C n \<subseteq> mcball a (d l l' / 3)"
+        using inM \<open>l \<in> M\<close> l' \<open>l' \<noteq> l\<close> cover by force
+      then have "d a l \<le> (d l l' / 3)" "d a l' \<le> (d l l' / 3)" "a \<in> M"
+        using l l' na in_mcball by auto
+      then have "d l l' \<le> (d l l' / 3) + (d l l' / 3)"
+        using \<open>l \<in> M\<close> \<open>l' \<in> M\<close> mdist_reverse_triangle by fastforce
+      then show False
+        using nonneg [of l l'] \<open>l' \<noteq> l\<close> \<open>l \<in> M\<close> \<open>l' \<in> M\<close> zero by force
+    qed
+    then show False
+      by (metis l \<open>l \<in> M\<close> no_sing INT_I empty_iff insertI1 is_singletonE is_singletonI')
+  qed
+  show ?thesis
+    unfolding mcomplete_nest imp_conjL 
+    apply (intro all_cong1 imp_cong refl)
+    using * 
+    by (smt (verit) Inter_iff ex_in_conv range_constant range_eqI)
+qed
+
+lemma mcomplete_fip:
+   "mcomplete \<longleftrightarrow>
+    (\<forall>\<C>. (\<forall>C \<in> \<C>. closedin mtopology C) \<and>
+         (\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {})
+        \<longrightarrow> \<Inter> \<C> \<noteq> {})" 
+   (is "?lhs = ?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+    unfolding mcomplete_nest_sing imp_conjL
+  proof (intro strip)
+    fix \<C> :: "'a set set"
+    assume clo: "\<forall>C\<in>\<C>. closedin mtopology C"
+      and cover: "\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e"
+      and fip: "\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}"
+    then have "\<forall>n. \<exists>C. C \<in> \<C> \<and> (\<exists>a. C \<subseteq> mcball a (inverse (Suc n)))"
+      by simp
+    then obtain C where C: "\<And>n. C n \<in> \<C>" 
+          and coverC: "\<And>n. \<exists>a. C n \<subseteq> mcball a (inverse (Suc n))"
+      by metis
+    define D where "D \<equiv> \<lambda>n. \<Inter> (C ` {..n})"
+    have cloD: "closedin mtopology (D n)" for n
+      unfolding D_def using clo C by blast
+    have neD: "D n \<noteq> {}" for n
+      using fip C by (simp add: D_def image_subset_iff)
+    have decD: "decseq D"
+      by (force simp: D_def decseq_def)
+    have coverD: "\<exists>n a. D n \<subseteq> mcball a \<epsilon>" if " \<epsilon> >0" for \<epsilon>
+    proof -
+      obtain n where "inverse (Suc n) < \<epsilon>"
+        using \<open>0 < \<epsilon>\<close> reals_Archimedean by blast
+      then obtain a where "C n \<subseteq> mcball a \<epsilon>"
+        by (meson coverC less_eq_real_def mcball_subset_concentric order_trans)
+      then show ?thesis
+        unfolding D_def by blast
+    qed
+    have *: "a \<in> \<Inter>\<C>" if a: "\<Inter> (range D) = {a}" and "a \<in> M" for a
+    proof -
+      have aC: "a \<in> C n" for n
+        using that by (auto simp: D_def)
+      have eqa: "\<And>u. (\<forall>n. u \<in> C n) \<Longrightarrow> a = u"
+        using that by (auto simp: D_def)
+      have "a \<in> T" if "T \<in> \<C>" for T
+      proof -
+        have cloT: "closedin mtopology (T \<inter> D n)" for n
+          using clo cloD that by blast
+        have "\<Inter> (insert T (C ` {..n})) \<noteq> {}" for n
+          using that C by (intro fip [rule_format]) auto
+        then have neT: "T \<inter> D n \<noteq> {}" for n
+          by (simp add: D_def)
+        have decT: "decseq (\<lambda>n. T \<inter> D n)"
+          by (force simp: D_def decseq_def)
+        have coverT: "\<exists>n a. T \<inter> D n \<subseteq> mcball a \<epsilon>" if " \<epsilon> >0" for \<epsilon>
+          by (meson coverD le_infI2 that)
+        show ?thesis
+          using L [unfolded mcomplete_nest_sing, rule_format, of "\<lambda>n. T \<inter> D n"] a
+          by (force simp: cloT neT decT coverT)
+      qed
+      then show ?thesis by auto
+    qed
+    show "\<Inter> \<C> \<noteq> {}"
+      by (metis L cloD neD decD coverD * empty_iff mcomplete_nest_sing)
+  qed
+next
+  assume R [rule_format]: ?rhs
+  show ?lhs
+    unfolding mcomplete_nest imp_conjL
+  proof (intro strip)
+    fix C :: "nat \<Rightarrow> 'a set"
+    assume clo: "\<forall>n. closedin mtopology (C n)"
+      and ne: "\<forall>n. C n \<noteq> {}"
+      and dec: "decseq C"
+      and cover: "\<forall>\<epsilon>>0. \<exists>n a. C n \<subseteq> mcball a \<epsilon>"
+    have "\<Inter>(C ` N) \<noteq> {}" if "finite N" for N
+    proof -
+      obtain k where "N \<subseteq> {..k}"
+        using \<open>finite N\<close> finite_nat_iff_bounded_le by auto
+      with dec have "C k \<subseteq> \<Inter>(C ` N)" by (auto simp: decseq_def)
+      then show ?thesis
+        using ne by force
+    qed
+    with clo cover R [of "range C"] show "\<Inter> (range C) \<noteq> {}"
+      by (metis (no_types, opaque_lifting) finite_subset_image image_iff UNIV_I)
+  qed
+qed
+
+
+lemma mcomplete_fip_sing:
+   "mcomplete \<longleftrightarrow>
+    (\<forall>\<C>. (\<forall>C\<in>\<C>. closedin mtopology C) \<and>
+     (\<forall>e>0. \<exists>c a. c \<in> \<C> \<and> c \<subseteq> mcball a e) \<and>
+     (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}) \<longrightarrow>
+     (\<exists>l. l \<in> M \<and> \<Inter> \<C> = {l}))"
+   (is "?lhs = ?rhs")
+proof
+  have *: "l \<in> M" "\<Inter> \<C> = {l}"
+    if clo: "Ball \<C> (closedin mtopology)"
+      and cover: "\<forall>e>0. \<exists>C a. C \<in> \<C> \<and> C \<subseteq> mcball a e"
+      and fin: "\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<C> \<longrightarrow> \<Inter> \<F> \<noteq> {}"
+      and l: "l \<in> \<Inter> \<C>"
+    for \<C> :: "'a set set" and l
+  proof -
+    show "l \<in> M"
+      by (meson Inf_lower2 clo cover gt_ex metric_closedin_iff_sequentially_closed subsetD that(4))
+    show  "\<Inter> \<C> = {l}"
+    proof (cases "\<C> = {}")
+      case True
+      then show ?thesis
+        using cover mbounded_pos by auto
+    next
+      case False
+      have CM: "\<And>a. a \<in> \<Inter>\<C> \<Longrightarrow> a \<in> M"
+        using False clo closedin_subset by fastforce
+      have "l' \<notin> \<Inter> \<C>" if "l' \<noteq> l" for l'
+      proof 
+        assume l': "l' \<in> \<Inter> \<C>"
+        with CM have "l' \<in> M" by blast
+        with that \<open>l \<in> M\<close> have gt0: "0 < d l l'"
+          by simp
+        then obtain C a where "C \<in> \<C>" and C: "C \<subseteq> mcball a (d l l' / 3)"
+          using cover [rule_format, of "d l l' / 3"] by auto
+        then have "d a l \<le> (d l l' / 3)" "d a l' \<le> (d l l' / 3)" "a \<in> M"
+          using l l' in_mcball by auto
+        then have "d l l' \<le> (d l l' / 3) + (d l l' / 3)"
+          using \<open>l \<in> M\<close> \<open>l' \<in> M\<close> mdist_reverse_triangle by fastforce
+        with gt0 show False by auto
+      qed
+      then show ?thesis
+        using l by fastforce
+    qed
+  qed
+  assume L: ?lhs
+  with * show ?rhs
+    unfolding mcomplete_fip imp_conjL ex_in_conv [symmetric]
+    by (elim all_forward imp_forward2 asm_rl) (blast intro:  elim: )
+next
+  assume ?rhs then show ?lhs
+    unfolding mcomplete_fip by (force elim!: all_forward)
+qed
+
+end
+
+lemma MCauchy_iff_Cauchy [iff]: "Met_TC.MCauchy = Cauchy"
+  by (force simp: Cauchy_def Met_TC.MCauchy_def)
+
+lemma mcomplete_iff_complete [iff]:
+  "Met_TC.mcomplete (Pure.type ::'a::metric_space itself) \<longleftrightarrow> complete (UNIV::'a set)"
+  by (auto simp: Met_TC.mcomplete_def complete_def)
+
+lemma euclidean_metric: "Met_TC.mcomplete (Pure.type ::'a::euclidean_space itself)"
+  using complete_UNIV mcomplete_iff_complete by blast
+
+context submetric
+begin 
+
+lemma MCauchy_submetric:
+   "sub.MCauchy \<sigma> \<longleftrightarrow> range \<sigma> \<subseteq> A \<and> MCauchy \<sigma>"
+  using MCauchy_def sub.MCauchy_def subset by force
+
+lemma closedin_mcomplete_imp_mcomplete:
+  assumes clo: "closedin mtopology A" and "mcomplete"
+  shows "sub.mcomplete"
+  unfolding sub.mcomplete_def
+proof (intro strip)
+  fix \<sigma>
+  assume "sub.MCauchy \<sigma>"
+  then have \<sigma>: "MCauchy \<sigma>" "range \<sigma> \<subseteq> A"
+    using MCauchy_submetric by blast+
+  then obtain x where x: "limitin mtopology \<sigma> x sequentially"
+    using \<open>mcomplete\<close> unfolding mcomplete_def by blast
+  then have "x \<in> A"
+    using \<sigma> clo metric_closedin_iff_sequentially_closed by force
+  with \<sigma> x show "\<exists>x. limitin sub.mtopology \<sigma> x sequentially"
+    using limitin_submetric_iff range_subsetD by fastforce
+qed
+
+
+lemma sequentially_closedin_mcomplete_imp_mcomplete:
+  assumes "mcomplete" and "\<And>\<sigma> l. range \<sigma> \<subseteq> A \<and> limitin mtopology \<sigma> l sequentially \<Longrightarrow> l \<in> A"
+  shows "sub.mcomplete"
+  using assms closedin_mcomplete_imp_mcomplete metric_closedin_iff_sequentially_closed subset by blast
+
+end
+
+
+context Metric_space
+begin
+
+lemma mcomplete_Un:
+  assumes A: "submetric M d A" "Metric_space.mcomplete A d" 
+      and B: "submetric M d B" "Metric_space.mcomplete B d"
+  shows   "submetric M d (A \<union> B)" "Metric_space.mcomplete (A \<union> B) d" 
+proof -
+  show "submetric M d (A \<union> B)"
+    by (meson assms le_sup_iff submetric_axioms_def submetric_def) 
+  then interpret MAB: Metric_space "A \<union> B" d
+    by (meson submetric.subset subspace)
+  interpret MA: Metric_space A d
+    by (meson A submetric.subset subspace)
+  interpret MB: Metric_space B d
+    by (meson B submetric.subset subspace)
+  show "Metric_space.mcomplete (A \<union> B) d"
+    unfolding MAB.mcomplete_def
+  proof (intro strip)
+    fix \<sigma>
+    assume "MAB.MCauchy \<sigma>"
+    then have "range \<sigma> \<subseteq> A \<union> B"
+      using MAB.MCauchy_def by blast
+    then have "UNIV \<subseteq> \<sigma> -` A \<union> \<sigma> -` B"
+      by blast
+    then consider "infinite (\<sigma> -` A)" | "infinite (\<sigma> -` B)"
+      using finite_subset by auto
+    then show "\<exists>x. limitin MAB.mtopology \<sigma> x sequentially"
+    proof cases
+      case 1
+      then obtain r where "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` A"
+        using infinite_enumerate by blast 
+      then have "MA.MCauchy (\<sigma> \<circ> r)"
+        using MA.MCauchy_def MAB.MCauchy_def MAB.MCauchy_subsequence \<open>MAB.MCauchy \<sigma>\<close> by auto
+      with A obtain x where "limitin MA.mtopology (\<sigma> \<circ> r) x sequentially"
+        using MA.mcomplete_def by blast
+      then have "limitin MAB.mtopology (\<sigma> \<circ> r) x sequentially"
+        by (metis MA.limit_metric_sequentially MAB.limit_metric_sequentially UnCI)
+      then show ?thesis
+        using MAB.MCauchy_convergent_subsequence \<open>MAB.MCauchy \<sigma>\<close> \<open>strict_mono r\<close> by blast
+    next
+      case 2
+      then obtain r where "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` B"
+        using infinite_enumerate by blast 
+      then have "MB.MCauchy (\<sigma> \<circ> r)"
+        using MB.MCauchy_def MAB.MCauchy_def MAB.MCauchy_subsequence \<open>MAB.MCauchy \<sigma>\<close> by auto
+      with B obtain x where "limitin MB.mtopology (\<sigma> \<circ> r) x sequentially"
+        using MB.mcomplete_def by blast
+      then have "limitin MAB.mtopology (\<sigma> \<circ> r) x sequentially"
+        by (metis MB.limit_metric_sequentially MAB.limit_metric_sequentially UnCI)
+      then show ?thesis
+        using MAB.MCauchy_convergent_subsequence \<open>MAB.MCauchy \<sigma>\<close> \<open>strict_mono r\<close> by blast
+    qed
+  qed
+qed
+
+lemma mcomplete_Union:
+  assumes "finite \<S>"
+    and "\<And>A. A \<in> \<S> \<Longrightarrow> submetric M d A" "\<And>A. A \<in> \<S> \<Longrightarrow> Metric_space.mcomplete A d"
+  shows   "submetric M d (\<Union>\<S>)" "Metric_space.mcomplete (\<Union>\<S>) d" 
+  using assms
+  by (induction rule: finite_induct) (auto simp: mcomplete_Un)
+
+lemma mcomplete_Inter:
+  assumes "finite \<S>" "\<S> \<noteq> {}"
+    and sub: "\<And>A. A \<in> \<S> \<Longrightarrow> submetric M d A" 
+    and comp: "\<And>A. A \<in> \<S> \<Longrightarrow> Metric_space.mcomplete A d"
+  shows "submetric M d (\<Inter>\<S>)" "Metric_space.mcomplete (\<Inter>\<S>) d"
+proof -
+  show "submetric M d (\<Inter>\<S>)"
+    using assms unfolding submetric_def submetric_axioms_def
+    by (metis Inter_lower equals0I inf.orderE le_inf_iff) 
+  then interpret MS: submetric M d "\<Inter>\<S>" 
+    by (meson submetric.subset subspace)
+  show "Metric_space.mcomplete (\<Inter>\<S>) d"
+    unfolding MS.sub.mcomplete_def
+  proof (intro strip)
+    fix \<sigma>
+    assume "MS.sub.MCauchy \<sigma>"
+    then have "range \<sigma> \<subseteq> \<Inter>\<S>"
+      using MS.MCauchy_submetric by blast
+    obtain A where "A \<in> \<S>" and A: "Metric_space.mcomplete A d"
+      using assms by blast
+    then have "range \<sigma> \<subseteq> A"
+      using \<open>range \<sigma> \<subseteq> \<Inter>\<S>\<close> by blast
+    interpret SA: submetric M d A
+      by (meson \<open>A \<in> \<S>\<close> sub submetric.subset subspace)
+    have "MCauchy \<sigma>"
+      using MS.MCauchy_submetric \<open>MS.sub.MCauchy \<sigma>\<close> by blast
+    then obtain x where x: "limitin SA.sub.mtopology \<sigma> x sequentially"
+      by (metis A SA.sub.MCauchy_def SA.sub.mcomplete_alt MCauchy_def \<open>range \<sigma> \<subseteq> A\<close>)
+    show "\<exists>x. limitin MS.sub.mtopology \<sigma> x sequentially"
+      apply (rule_tac x="x" in exI)
+      unfolding MS.limitin_submetric_iff
+    proof (intro conjI)
+      show "x \<in> \<Inter> \<S>"
+      proof clarsimp
+        fix U
+        assume "U \<in> \<S>"
+        interpret SU: submetric M d U 
+          by (meson \<open>U \<in> \<S>\<close> sub submetric.subset subspace)
+        have "range \<sigma> \<subseteq> U"
+          using \<open>U \<in> \<S>\<close> \<open>range \<sigma> \<subseteq> \<Inter> \<S>\<close> by blast
+        moreover have "Metric_space.mcomplete U d"
+          by (simp add: \<open>U \<in> \<S>\<close> comp)
+        ultimately obtain x' where x': "limitin SU.sub.mtopology \<sigma> x' sequentially"
+          using MCauchy_def SU.sub.MCauchy_def SU.sub.mcomplete_alt \<open>MCauchy \<sigma>\<close> by meson 
+        have "x' = x"
+        proof (intro limitin_metric_unique)
+          show "limitin mtopology \<sigma> x' sequentially"
+            by (meson SU.submetric_axioms submetric.limitin_submetric_iff x')
+          show "limitin mtopology \<sigma> x sequentially"
+            by (meson SA.submetric_axioms submetric.limitin_submetric_iff x)
+        qed auto
+        then show "x \<in> U"
+          using SU.sub.limitin_mspace x' by blast
+      qed
+      show "\<forall>\<^sub>F n in sequentially. \<sigma> n \<in> \<Inter>\<S>"
+        by (meson \<open>range \<sigma> \<subseteq> \<Inter> \<S>\<close> always_eventually range_subsetD)
+      show "limitin mtopology \<sigma> x sequentially"
+        by (meson SA.submetric_axioms submetric.limitin_submetric_iff x)
+    qed
+  qed
+qed
+
+
+lemma mcomplete_Int:
+  assumes A: "submetric M d A" "Metric_space.mcomplete A d" 
+      and B: "submetric M d B" "Metric_space.mcomplete B d"
+    shows   "submetric M d (A \<inter> B)" "Metric_space.mcomplete (A \<inter> B) d"
+  using mcomplete_Inter [of "{A,B}"] assms by force+
+
+subsection\<open>Totally bounded subsets of metric spaces\<close>
+
+definition mtotally_bounded 
+  where "mtotally_bounded S \<equiv> \<forall>\<epsilon>>0. \<exists>K. finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+
+lemma mtotally_bounded_empty [iff]: "mtotally_bounded {}"
+by (simp add: mtotally_bounded_def)
+
+lemma finite_imp_mtotally_bounded:
+   "\<lbrakk>finite S; S \<subseteq> M\<rbrakk> \<Longrightarrow> mtotally_bounded S"
+  by (auto simp: mtotally_bounded_def)
+
+lemma mtotally_bounded_imp_subset: "mtotally_bounded S \<Longrightarrow> S \<subseteq> M"
+  by (force simp: mtotally_bounded_def intro!: zero_less_one)
+
+lemma mtotally_bounded_sing [simp]:
+   "mtotally_bounded {x} \<longleftrightarrow> x \<in> M"
+  by (meson empty_subsetI finite.simps finite_imp_mtotally_bounded insert_subset mtotally_bounded_imp_subset)
+
+lemma mtotally_bounded_Un:
+  assumes  "mtotally_bounded S" "mtotally_bounded T"
+  shows "mtotally_bounded (S \<union> T)"
+proof -
+  have "\<exists>K. finite K \<and> K \<subseteq> S \<union> T \<and> S \<union> T \<subseteq> (\<Union>x\<in>K. mball x e)"
+    if  "e>0" and K: "finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x e)"
+      and L: "finite L \<and> L \<subseteq> T \<and> T \<subseteq> (\<Union>x\<in>L. mball x e)" for K L e
+    using that by (rule_tac x="K \<union> L" in exI) auto
+  with assms show ?thesis
+    unfolding mtotally_bounded_def by presburger
+qed
+ 
+lemma mtotally_bounded_Union:
+  assumes "finite f" "\<And>S. S \<in> f \<Longrightarrow> mtotally_bounded S"
+  shows "mtotally_bounded (\<Union>f)"
+  using assms by (induction f) (auto simp: mtotally_bounded_Un)
+
+lemma mtotally_bounded_imp_mbounded:
+  assumes "mtotally_bounded S"
+  shows "mbounded S"
+proof -
+  obtain K where "finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x 1)" 
+    using assms by (force simp: mtotally_bounded_def)
+  then show ?thesis
+    by (smt (verit) finite_imageI image_iff mbounded_Union mbounded_mball mbounded_subset)
+qed
+
+
+lemma mtotally_bounded_sequentially:
+  "mtotally_bounded S \<longleftrightarrow>
+    S \<subseteq> M \<and> (\<forall>\<sigma>::nat \<Rightarrow> 'a. range \<sigma> \<subseteq> S \<longrightarrow> (\<exists>r. strict_mono r \<and> MCauchy (\<sigma> \<circ> r)))"
+  (is "_ \<longleftrightarrow> _ \<and> ?rhs")
+proof (cases "S \<subseteq> M")
+  case True
+  show ?thesis
+  proof -
+    { fix \<sigma> :: "nat \<Rightarrow> 'a"                                                            
+      assume L: "mtotally_bounded S" and \<sigma>: "range \<sigma> \<subseteq> S"
+      have "\<exists>j > i. d (\<sigma> i) (\<sigma> j) < 3*\<epsilon>/2 \<and> infinite (\<sigma> -` mball (\<sigma> j) (\<epsilon>/2))"
+        if inf: "infinite (\<sigma> -` mball (\<sigma> i) \<epsilon>)" and "\<epsilon> > 0" for i \<epsilon>
+      proof -
+        obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x (\<epsilon>/4))"
+          by (metis L mtotally_bounded_def \<open>\<epsilon> > 0\<close> zero_less_divide_iff zero_less_numeral)
+        then have K_imp_ex: "\<And>y. y \<in> S \<Longrightarrow> \<exists>x\<in>K. d x y < \<epsilon>/4"
+          by fastforce
+        have False if "\<forall>x\<in>K. d x (\<sigma> i) < \<epsilon> + \<epsilon>/4 \<longrightarrow> finite (\<sigma> -` mball x (\<epsilon>/4))"
+        proof -
+          have "\<exists>w. w \<in> K \<and> d w (\<sigma> i) < 5 * \<epsilon>/4 \<and> d w (\<sigma> j) < \<epsilon>/4"
+            if "d (\<sigma> i) (\<sigma> j) < \<epsilon>" for j
+          proof -
+            obtain w where w: "d w (\<sigma> j) < \<epsilon>/4" "w \<in> K"
+              using K_imp_ex \<sigma> by blast
+            then have "d w (\<sigma> i) < \<epsilon> + \<epsilon>/4"
+              by (smt (verit, ccfv_SIG) True \<open>K \<subseteq> S\<close> \<sigma> rangeI subset_eq that triangle')
+            with w show ?thesis
+              using in_mball by auto
+          qed
+          then have "(\<sigma> -` mball (\<sigma> i) \<epsilon>) \<subseteq> (\<Union>x\<in>K. if d x (\<sigma> i) < \<epsilon> + \<epsilon>/4 then \<sigma> -` mball x (\<epsilon>/4) else {})"
+            using True \<open>K \<subseteq> S\<close> by force
+          then show False
+            using finite_subset inf \<open>finite K\<close> that by fastforce
+        qed
+        then obtain x where "x \<in> K" and dxi: "d x (\<sigma> i) < \<epsilon> + \<epsilon>/4" and infx: "infinite (\<sigma> -` mball x (\<epsilon>/4))"
+          by blast
+        then obtain j where "j \<in> (\<sigma> -` mball x (\<epsilon>/4)) - {..i}"
+          using bounded_nat_set_is_finite by (meson Diff_infinite_finite finite_atMost)
+        then have "j > i" and dxj: "d x (\<sigma> j) < \<epsilon>/4" 
+          by auto
+        have "(\<sigma> -` mball x (\<epsilon>/4)) \<subseteq> (\<sigma> -` mball y (\<epsilon>/2))" if "d x y < \<epsilon>/4" "y \<in> M" for y
+          using that by (simp add: mball_subset Metric_space_axioms vimage_mono)
+        then have infj: "infinite (\<sigma> -` mball (\<sigma> j) (\<epsilon>/2))"
+          by (meson True \<open>d x (\<sigma> j) < \<epsilon>/4\<close> \<sigma> in_mono infx rangeI finite_subset)
+        have "\<sigma> i \<in> M" "\<sigma> j \<in> M" "x \<in> M"  
+          using True \<open>K \<subseteq> S\<close> \<open>x \<in> K\<close> \<sigma> by force+
+        then have "d (\<sigma> i) (\<sigma> j) \<le> d x (\<sigma> i) + d x (\<sigma> j)"
+          using triangle'' by blast
+        also have "\<dots> < 3*\<epsilon>/2"
+          using dxi dxj by auto
+        finally have "d (\<sigma> i) (\<sigma> j) < 3*\<epsilon>/2" .
+        with \<open>i < j\<close> infj show ?thesis by blast
+      qed
+      then obtain nxt where nxt: "\<And>i \<epsilon>. \<lbrakk>\<epsilon> > 0; infinite (\<sigma> -` mball (\<sigma> i) \<epsilon>)\<rbrakk> \<Longrightarrow> 
+                 nxt i \<epsilon> > i \<and> d (\<sigma> i) (\<sigma> (nxt i \<epsilon>)) < 3*\<epsilon>/2 \<and> infinite (\<sigma> -` mball (\<sigma> (nxt i \<epsilon>)) (\<epsilon>/2))"
+        by metis
+      have "mbounded S"
+        using L by (simp add: mtotally_bounded_imp_mbounded)
+      then obtain B where B: "\<forall>y \<in> S. d (\<sigma> 0) y \<le> B" and "B > 0"
+        by (meson \<sigma> mbounded_alt_pos range_subsetD)
+      define eps where "eps \<equiv> \<lambda>n. (B+1) / 2^n"
+      have [simp]: "eps (Suc n) = eps n / 2" "eps n > 0" for n
+        using \<open>B > 0\<close> by (auto simp: eps_def)
+      have "UNIV \<subseteq> \<sigma> -` mball (\<sigma> 0) (B+1)"
+        using B True \<sigma> unfolding image_iff subset_iff
+        by (smt (verit, best) UNIV_I in_mball vimageI)
+      then have inf0: "infinite (\<sigma> -` mball (\<sigma> 0) (eps 0))"
+        using finite_subset by (auto simp: eps_def)
+      define r where "r \<equiv> rec_nat 0 (\<lambda>n rec. nxt rec (eps n))"
+      have [simp]: "r 0 = 0" "r (Suc n) = nxt (r n) (eps n)" for n
+        by (auto simp: r_def)
+      have \<sigma>rM[simp]: "\<sigma> (r n) \<in> M" for n
+        using True \<sigma> by blast
+      have inf: "infinite (\<sigma> -` mball (\<sigma> (r n)) (eps n))" for n
+      proof (induction n)
+        case 0 then show ?case  
+          by (simp add: inf0)
+      next
+        case (Suc n) then show ?case
+          using nxt [of "eps n" "r n"] by simp
+      qed
+      then have "r (Suc n) > r n" for n
+        by (simp add: nxt)
+      then have "strict_mono r"
+        by (simp add: strict_mono_Suc_iff)
+      have d_less: "d (\<sigma> (r n)) (\<sigma> (r (Suc n))) < 3 * eps n / 2" for n
+        using nxt [OF _ inf] by simp
+      have eps_plus: "eps (k + n) = eps n * (1/2)^k" for k n
+        by (simp add: eps_def power_add field_simps)
+      have *: "d (\<sigma> (r n)) (\<sigma> (r (k + n))) < 3 * eps n" for n k
+      proof -
+        have "d (\<sigma> (r n)) (\<sigma> (r (k+n))) \<le> 3/2 * eps n * (\<Sum>i<k. (1/2)^i)"
+        proof (induction k)
+          case 0 then show ?case 
+            by simp
+        next
+          case (Suc k)
+          have "d (\<sigma> (r n)) (\<sigma> (r (Suc k + n))) \<le> d (\<sigma> (r n)) (\<sigma> (r (k + n))) + d (\<sigma> (r (k + n))) (\<sigma> (r (Suc (k + n))))"
+            by (metis \<sigma>rM add.commute add_Suc_right triangle)
+          with d_less[of "k+n"] Suc show ?case
+            by (simp add: algebra_simps eps_plus)
+        qed
+        also have "\<dots> < 3/2 * eps n * 2"
+          using geometric_sum [of "1/2::real" k] by simp
+        finally show ?thesis by simp
+      qed
+      have "\<exists>N. \<forall>n\<ge>N. \<forall>n'\<ge>N. d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>" if "\<epsilon> > 0" for \<epsilon>
+      proof -
+        define N where "N \<equiv> nat \<lceil>(log 2 (6*(B+1) / \<epsilon>))\<rceil>"
+        have \<section>: "b \<le> 2 ^ nat \<lceil>log 2 b\<rceil>" for b
+          by (smt (verit) less_log_of_power real_nat_ceiling_ge)
+        have N: "6 * eps N \<le> \<epsilon>"
+          using \<section> [of "(6*(B+1) / \<epsilon>)"] that by (auto simp: N_def eps_def field_simps)
+        have "d (\<sigma> (r N)) (\<sigma> (r n)) < 3 * eps N" if "n \<ge> N" for n
+          by (metis * add.commute nat_le_iff_add that)
+        then have "\<forall>n\<ge>N. \<forall>n'\<ge>N. d (\<sigma> (r n)) (\<sigma> (r n')) < 3 * eps N + 3 * eps N"
+          by (smt (verit, best) \<sigma>rM triangle'')
+        with N show ?thesis
+          by fastforce
+      qed
+      then have "MCauchy (\<sigma> \<circ> r)"
+        unfolding MCauchy_def using True \<sigma> by auto
+      then have "\<exists>r. strict_mono r \<and> MCauchy (\<sigma> \<circ> r)"
+        using \<open>strict_mono r\<close> by blast      
+    }
+    moreover
+    { assume R: ?rhs
+      have "mtotally_bounded S"
+        unfolding mtotally_bounded_def
+      proof (intro strip)
+        fix \<epsilon> :: real
+        assume "\<epsilon> > 0"
+        have False if \<section>: "\<And>K. \<lbrakk>finite K; K \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>s\<in>S. s \<notin> (\<Union>x\<in>K. mball x \<epsilon>)"
+        proof -
+          obtain f where f: "\<And>K. \<lbrakk>finite K; K \<subseteq> S\<rbrakk> \<Longrightarrow> f K \<in> S \<and> f K \<notin> (\<Union>x\<in>K. mball x \<epsilon>)"
+            using \<section> by metis
+          define \<sigma> where "\<sigma> \<equiv> wfrec less_than (\<lambda>seq n. f (seq ` {..<n}))"
+          have \<sigma>_eq: "\<sigma> n = f (\<sigma> ` {..<n})" for n
+            by (simp add: cut_apply def_wfrec [OF \<sigma>_def])
+          have [simp]: "\<sigma> n \<in> S" for n
+            using wf_less_than
+          proof (induction n rule: wf_induct_rule)
+            case (less n) with f show ?case
+              by (auto simp: \<sigma>_eq [of n])
+          qed
+          then have "range \<sigma> \<subseteq> S" by blast
+          have \<sigma>: "p < n \<Longrightarrow> \<epsilon> \<le> d (\<sigma> p) (\<sigma> n)" for n p
+            using f[of "\<sigma> ` {..<n}"] True by (fastforce simp: \<sigma>_eq [of n] Ball_def)
+          then obtain r where "strict_mono r" "MCauchy (\<sigma> \<circ> r)"
+            by (meson R \<open>range \<sigma> \<subseteq> S\<close>)
+          with \<open>0 < \<epsilon>\<close> obtain N 
+            where N: "\<And>n n'. \<lbrakk>n\<ge>N; n'\<ge>N\<rbrakk> \<Longrightarrow> d (\<sigma> (r n)) (\<sigma> (r n')) < \<epsilon>"
+            by (force simp: MCauchy_def)
+          show ?thesis
+            using N [of N "Suc (r N)"] \<open>strict_mono r\<close>
+            by (smt (verit) Suc_le_eq \<sigma> le_SucI order_refl strict_mono_imp_increasing)
+        qed
+        then show "\<exists>K. finite K \<and> K \<subseteq> S \<and> S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+          by blast
+      qed
+    }
+    ultimately show ?thesis 
+      using True by blast
+  qed
+qed (use mtotally_bounded_imp_subset in auto)
+
+
+lemma mtotally_bounded_subset:
+   "\<lbrakk>mtotally_bounded S; T \<subseteq> S\<rbrakk> \<Longrightarrow> mtotally_bounded T"
+  by (meson mtotally_bounded_sequentially order_trans) 
+
+lemma mtotally_bounded_submetric:
+  assumes "mtotally_bounded S" "S \<subseteq> T" "T \<subseteq> M"
+  shows "Metric_space.mtotally_bounded T d S"
+proof -
+  interpret submetric M d T
+    by (simp add: Metric_space_axioms assms submetric.intro submetric_axioms.intro)
+  show ?thesis
+    using assms
+    unfolding sub.mtotally_bounded_def mtotally_bounded_def
+    by (force simp: subset_iff elim!: all_forward ex_forward)
+qed
+
+lemma mtotally_bounded_absolute:
+   "mtotally_bounded S \<longleftrightarrow> S \<subseteq> M \<and> Metric_space.mtotally_bounded S d S "
+proof -
+  have "mtotally_bounded S" if "S \<subseteq> M" "Metric_space.mtotally_bounded S d S"
+  proof -
+    interpret submetric M d S
+      by (simp add: Metric_space_axioms submetric_axioms.intro submetric_def \<open>S \<subseteq> M\<close>)
+    show ?thesis
+      using that
+      by (metis MCauchy_submetric Metric_space.mtotally_bounded_sequentially Metric_space_axioms subspace)
+  qed
+  moreover have "mtotally_bounded S \<Longrightarrow> Metric_space.mtotally_bounded S d S"
+    by (simp add: mtotally_bounded_imp_subset mtotally_bounded_submetric)
+  ultimately show ?thesis
+    using mtotally_bounded_imp_subset by blast
+qed
+
+lemma mtotally_bounded_closure_of:
+  assumes "mtotally_bounded S"
+  shows "mtotally_bounded (mtopology closure_of S)"
+proof -
+  have "S \<subseteq> M"
+    by (simp add: assms mtotally_bounded_imp_subset)
+  have "mtotally_bounded(mtopology closure_of S)"
+    unfolding mtotally_bounded_def
+  proof (intro strip)
+    fix \<epsilon>::real
+    assume "\<epsilon> > 0"
+    then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x (\<epsilon>/2))"
+      by (metis assms mtotally_bounded_def half_gt_zero)
+    have "mtopology closure_of S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+      unfolding metric_closure_of
+    proof clarsimp
+      fix x
+      assume "x \<in> M" and x: "\<forall>r>0. \<exists>y\<in>S. y \<in> M \<and> d x y < r"
+      then obtain y where "y \<in> S" and y: "d x y < \<epsilon>/2"
+        using \<open>0 < \<epsilon>\<close> half_gt_zero by blast
+      then obtain x' where "x' \<in> K" "y \<in> mball x' (\<epsilon>/2)"
+        using K by auto
+      then have "d x' x < \<epsilon>/2 + \<epsilon>/2"
+        using triangle y \<open>x \<in> M\<close> commute by fastforce
+      then show "\<exists>x'\<in>K. x' \<in> M \<and> d x' x < \<epsilon>"
+        using \<open>K \<subseteq> S\<close> \<open>S \<subseteq> M\<close> \<open>x' \<in> K\<close> by force
+    qed
+    then show "\<exists>K. finite K \<and> K \<subseteq> mtopology closure_of S \<and> mtopology closure_of S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+      using closure_of_subset_Int  \<open>K \<subseteq> S\<close> \<open>finite K\<close> K by fastforce
+  qed
+  then show ?thesis
+    by (simp add: assms inf.absorb2 mtotally_bounded_imp_subset)
+qed
+
+lemma mtotally_bounded_closure_of_eq:
+   "S \<subseteq> M \<Longrightarrow> mtotally_bounded (mtopology closure_of S) \<longleftrightarrow> mtotally_bounded S"
+  by (metis closure_of_subset mtotally_bounded_closure_of mtotally_bounded_subset topspace_mtopology)
+
+lemma mtotally_bounded_cauchy_sequence:
+  assumes "MCauchy \<sigma>"
+  shows "mtotally_bounded (range \<sigma>)"
+  unfolding MCauchy_def mtotally_bounded_def
+proof (intro strip)
+  fix \<epsilon>::real
+  assume "\<epsilon> > 0"
+  then obtain N where "\<And>n. N \<le> n \<Longrightarrow> d (\<sigma> N) (\<sigma> n) < \<epsilon>"
+    using assms by (force simp: MCauchy_def)
+  then have "\<And>m. \<exists>n\<le>N. \<sigma> n \<in> M \<and> \<sigma> m \<in> M \<and> d (\<sigma> n) (\<sigma> m) < \<epsilon>"
+    by (metis MCauchy_def assms mdist_zero nle_le range_subsetD)
+  then
+  show "\<exists>K. finite K \<and> K \<subseteq> range \<sigma> \<and> range \<sigma> \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+    by (rule_tac x="\<sigma> ` {0..N}" in exI) force
+qed
+
+lemma MCauchy_imp_mbounded:
+   "MCauchy \<sigma> \<Longrightarrow> mbounded (range \<sigma>)"
+  by (simp add: mtotally_bounded_cauchy_sequence mtotally_bounded_imp_mbounded)
+
+subsection\<open>Compactness in metric spaces\<close>
+
+lemma Bolzano_Weierstrass_property:
+  assumes "S \<subseteq> U" "S \<subseteq> M"
+  shows
+   "(\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
+         \<longrightarrow> (\<exists>l r. l \<in> U \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)) \<longleftrightarrow>
+    (\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> U \<inter> mtopology derived_set_of T \<noteq> {})"  (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+  proof clarify
+    fix T
+    assume "T \<subseteq> S" and "infinite T"
+      and T: "U \<inter> mtopology derived_set_of T = {}"
+    then obtain \<sigma> :: "nat\<Rightarrow>'a" where "inj \<sigma>" "range \<sigma> \<subseteq> T"
+      by (meson infinite_countable_subset)
+    with L obtain l r where "l \<in> U" "strict_mono r" 
+           and lr: "limitin mtopology (\<sigma> \<circ> r) l sequentially"
+      by (meson \<open>T \<subseteq> S\<close> subset_trans)
+    then obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "\<And>y. y \<in> T \<Longrightarrow> y = l \<or> \<not> d l y < \<epsilon>"
+      using T \<open>T \<subseteq> S\<close> \<open>S \<subseteq> M\<close> 
+      by (force simp: metric_derived_set_of limitin_metric disjoint_iff)
+    with lr have "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>"
+      by (auto simp: limitin_metric)
+    then obtain N where N: "d (\<sigma> (r N)) l < \<epsilon>" "d (\<sigma> (r (Suc N))) l < \<epsilon>"
+      using less_le_not_le by (auto simp: eventually_sequentially)
+    moreover have "\<sigma> (r N) \<noteq> l \<or> \<sigma> (r (Suc N)) \<noteq> l"
+      by (meson \<open>inj \<sigma>\<close> \<open>strict_mono r\<close> injD n_not_Suc_n strict_mono_eq)
+    ultimately
+    show False
+       using \<epsilon> \<open>range \<sigma> \<subseteq> T\<close> commute by fastforce
+  qed
+next
+  assume R: ?rhs 
+  show ?lhs
+  proof (intro strip)
+    fix \<sigma> :: "nat \<Rightarrow> 'a"
+    assume "range \<sigma> \<subseteq> S"
+    show "\<exists>l r. l \<in> U \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
+    proof (cases "finite (range \<sigma>)")
+      case True
+      then obtain m where "infinite (\<sigma> -` {\<sigma> m})"
+        by (metis image_iff inf_img_fin_dom nat_not_finite)
+      then obtain r where [iff]: "strict_mono r" and r: "\<And>n::nat. r n \<in> \<sigma> -` {\<sigma> m}"
+        using infinite_enumerate by blast 
+      have [iff]: "\<sigma> m \<in> U" "\<sigma> m \<in> M"
+        using \<open>range \<sigma> \<subseteq> S\<close> assms by blast+
+      show ?thesis
+      proof (intro conjI exI)
+        show "limitin mtopology (\<sigma> \<circ> r) (\<sigma> m) sequentially"
+          using r by (simp add: limitin_metric)
+      qed auto
+    next
+      case False
+      then obtain l where "l \<in> U" and l: "l \<in> mtopology derived_set_of (range \<sigma>)"
+        by (meson R \<open>range \<sigma> \<subseteq> S\<close> disjoint_iff)
+      then obtain g where g: "\<And>\<epsilon>. \<epsilon>>0 \<Longrightarrow> \<sigma> (g \<epsilon>) \<noteq> l \<and> d l (\<sigma> (g \<epsilon>)) < \<epsilon>"
+        by (simp add: metric_derived_set_of) metis
+      have "range \<sigma> \<subseteq> M"
+        using \<open>range \<sigma> \<subseteq> S\<close> assms by auto
+      have "l \<in> M"
+        using l metric_derived_set_of by auto
+      define E where  \<comment>\<open>a construction to ensure monotonicity\<close>
+        "E \<equiv> \<lambda>rec n. insert (inverse (Suc n)) ((\<lambda>i. d l (\<sigma> i)) ` (\<Union>k<n. {0..rec k})) - {0}"
+      define r where "r \<equiv> wfrec less_than (\<lambda>rec n. g (Min (E rec n)))"
+      have "(\<Union>k<n. {0..cut r less_than n k}) = (\<Union>k<n. {0..r k})" for n
+        by (auto simp: cut_apply)
+      then have r_eq: "r n = g (Min (E r n))" for n
+        by (metis E_def def_wfrec [OF r_def] wf_less_than)
+      have dl_pos[simp]: "d l (\<sigma> (r n)) > 0" for n
+        using wf_less_than
+      proof (induction n rule: wf_induct_rule)
+        case (less n) 
+        then have *: "Min (E r n) > 0"
+          using \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: E_def image_subset_iff)
+        show ?case
+          using g [OF *] r_eq [of n]
+          by (metis \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> mdist_pos_less range_subsetD)
+      qed
+      then have non_l: "\<sigma> (r n) \<noteq> l" for n
+        using \<open>range \<sigma> \<subseteq> M\<close> mdist_pos_eq by blast
+      have Min_pos: "Min (E r n) > 0" for n
+        using dl_pos \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: E_def image_subset_iff)
+      have d_small: "d (\<sigma>(r n)) l < inverse(Suc n)" for n
+      proof -
+        have "d (\<sigma>(r n)) l < Min (E r n)"
+          by (simp add: \<open>0 < Min (E r n)\<close> commute g r_eq) 
+        also have "... \<le> inverse(Suc n)"
+          by (simp add: E_def)
+        finally show ?thesis .
+      qed
+      have d_lt_d: "d l (\<sigma> (r n)) < d l (\<sigma> i)" if \<section>: "p < n" "i \<le> r p" "\<sigma> i \<noteq> l" for i p n
+      proof -
+        have 1: "d l (\<sigma> i) \<in> E r n"
+          using \<section> \<open>l \<in> M\<close> \<open>range \<sigma> \<subseteq> M\<close> 
+          by (force simp: E_def image_subset_iff image_iff)
+        have "d l (\<sigma> (g (Min (E r n)))) < Min (E r n)"
+          by (rule conjunct2 [OF g [OF Min_pos]])
+        also have "Min (E r n) \<le> d l (\<sigma> i)"
+          using 1 unfolding E_def by (force intro!: Min.coboundedI)
+        finally show ?thesis
+          by (simp add: r_eq) 
+      qed
+      have r: "r p < r n" if "p < n" for p n
+        using d_lt_d [OF that] non_l by (meson linorder_not_le order_less_irrefl) 
+      show ?thesis
+      proof (intro exI conjI)
+        show "strict_mono r"
+          by (simp add: r strict_monoI)
+        show "limitin mtopology (\<sigma> \<circ> r) l sequentially"
+          unfolding limitin_metric
+        proof (intro conjI strip \<open>l \<in> M\<close>)
+          fix \<epsilon> :: real
+          assume "\<epsilon> > 0"
+          then have "\<forall>\<^sub>F n in sequentially. inverse(Suc n) < \<epsilon>"
+            using Archimedean_eventually_inverse by auto
+          then show "\<forall>\<^sub>F n in sequentially. (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) l < \<epsilon>"
+            by (smt (verit) \<open>range \<sigma> \<subseteq> M\<close> commute comp_apply d_small eventually_mono range_subsetD)
+        qed
+      qed (use \<open>l \<in> U\<close> in auto)
+    qed
+  qed
+qed
+
+subsubsection \<open>More on Bolzano Weierstrass\<close>
+
+lemma Bolzano_Weierstrass_A: 
+  assumes "compactin mtopology S" "T \<subseteq> S" "infinite T"
+  shows "S \<inter> mtopology derived_set_of T \<noteq> {}"
+  by (simp add: assms compactin_imp_Bolzano_Weierstrass)
+
+lemma Bolzano_Weierstrass_B:
+  fixes \<sigma> :: "nat \<Rightarrow> 'a"
+  assumes "S \<subseteq> M" "range \<sigma> \<subseteq> S"
+    and "\<And>T. \<lbrakk>T \<subseteq> S \<and> infinite T\<rbrakk> \<Longrightarrow> S \<inter> mtopology derived_set_of T \<noteq> {}"
+  shows "\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
+  using Bolzano_Weierstrass_property assms by blast
+
+lemma Bolzano_Weierstrass_C:
+  assumes "S \<subseteq> M"
+  assumes "\<And>\<sigma>:: nat \<Rightarrow> 'a. range \<sigma> \<subseteq> S \<Longrightarrow>
+                (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)"
+  shows "mtotally_bounded S"
+  unfolding mtotally_bounded_sequentially
+  by (metis convergent_imp_MCauchy assms image_comp image_mono subset_UNIV subset_trans)
+
+lemma Bolzano_Weierstrass_D:
+  assumes "S \<subseteq> M" "S \<subseteq> \<Union>\<C>" and opeU: "\<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U"
+  assumes \<section>: "(\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
+         \<longrightarrow> (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially))"
+  shows "\<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
+proof (rule ccontr)
+  assume "\<not> (\<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U)"
+  then have "\<forall>n. \<exists>x\<in>S. \<forall>U\<in>\<C>. \<not> mball x (inverse (Suc n)) \<subseteq> U"
+    by simp
+  then obtain \<sigma> where "\<And>n. \<sigma> n \<in> S" 
+       and \<sigma>: "\<And>n U. U \<in> \<C> \<Longrightarrow> \<not> mball (\<sigma> n) (inverse (Suc n)) \<subseteq> U"
+    by metis
+  then obtain l r where "l \<in> S" "strict_mono r" 
+         and lr: "limitin mtopology (\<sigma> \<circ> r) l sequentially"
+    by (meson \<section> image_subsetI)
+  with \<open>S \<subseteq> \<Union>\<C>\<close> obtain B where "l \<in> B" "B \<in> \<C>"
+    by auto
+  then obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "\<And>z. \<lbrakk>z \<in> M; d z l < \<epsilon>\<rbrakk> \<Longrightarrow> z \<in> B"
+    by (metis opeU [OF \<open>B \<in> \<C>\<close>] commute in_mball openin_mtopology subset_iff)
+  then have "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>/2"
+    using lr half_gt_zero unfolding limitin_metric o_def by blast
+  moreover have "\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>/2"
+    using Archimedean_eventually_inverse \<open>0 < \<epsilon>\<close> half_gt_zero by blast
+  ultimately obtain n where n: "d (\<sigma> (r n)) l < \<epsilon>/2" "inverse (real (Suc n)) < \<epsilon>/2"
+    by (smt (verit, del_insts) eventually_sequentially le_add1 le_add2)
+  have "x \<in> B" if "d (\<sigma> (r n)) x < inverse (Suc(r n))" "x \<in> M" for x
+  proof -
+    have rle: "inverse (real (Suc (r n))) \<le> inverse (real (Suc n))"
+      using \<open>strict_mono r\<close> strict_mono_imp_increasing by auto
+    have "d x l \<le> d (\<sigma> (r n)) x + d (\<sigma> (r n)) l"
+      using that by (metis triangle \<open>\<And>n. \<sigma> n \<in> S\<close> \<open>l \<in> S\<close> \<open>S \<subseteq> M\<close> commute subsetD)
+    also have "... < \<epsilon>"
+      using that n rle by linarith
+    finally show ?thesis
+      by (simp add: \<epsilon> that)
+  qed
+  then show False
+    using \<sigma> [of B "r n"] by (simp add: \<open>B \<in> \<C>\<close> subset_iff)
+qed
+
+
+lemma Bolzano_Weierstrass_E:
+  assumes "mtotally_bounded S" "S \<subseteq> M"
+  and S: "\<And>\<C>. \<lbrakk>\<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U; S \<subseteq> \<Union>\<C>\<rbrakk> \<Longrightarrow> \<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
+  shows "compactin mtopology S"
+proof (clarsimp simp: compactin_def assms)
+  fix \<U> :: "'a set set"
+  assume \<U>: "\<forall>x\<in>\<U>. openin mtopology x" and "S \<subseteq> \<Union>\<U>"
+  then obtain \<epsilon> where "\<epsilon>>0" and \<epsilon>: "\<And>x. x \<in> S \<Longrightarrow> \<exists>U \<in> \<U>. mball x \<epsilon> \<subseteq> U"
+    by (metis S)
+  then obtain f where f: "\<And>x. x \<in> S \<Longrightarrow> f x \<in> \<U> \<and> mball x \<epsilon> \<subseteq> f x"
+    by metis
+  then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>x\<in>K. mball x \<epsilon>)"
+    by (metis \<open>0 < \<epsilon>\<close> \<open>mtotally_bounded S\<close> mtotally_bounded_def)
+  show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
+  proof (intro conjI exI)
+    show "finite (f ` K)"
+      by (simp add: \<open>finite K\<close>)
+    show "f ` K \<subseteq> \<U>"
+      using \<open>K \<subseteq> S\<close> f by blast
+    show "S \<subseteq> \<Union>(f ` K)"
+      using K \<open>K \<subseteq> S\<close> by (force dest: f)
+  qed
+qed
+
+
+lemma compactin_eq_Bolzano_Weierstrass:
+  "compactin mtopology S \<longleftrightarrow>
+   S \<subseteq> M \<and> (\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> S \<inter> mtopology derived_set_of T \<noteq> {})"
+  using Bolzano_Weierstrass_C Bolzano_Weierstrass_D Bolzano_Weierstrass_E
+  by (smt (verit, del_insts) Bolzano_Weierstrass_property compactin_imp_Bolzano_Weierstrass compactin_subspace subset_refl topspace_mtopology)
+
+lemma compactin_sequentially:
+  shows "compactin mtopology S \<longleftrightarrow>
+        S \<subseteq> M \<and>
+        ((\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> S
+         \<longrightarrow> (\<exists>l r. l \<in> S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially)))"
+  by (metis Bolzano_Weierstrass_property compactin_eq_Bolzano_Weierstrass subset_refl)
+
+lemma compactin_imp_mtotally_bounded: 
+  "compactin mtopology S \<Longrightarrow> mtotally_bounded S"
+  by (simp add: Bolzano_Weierstrass_C compactin_sequentially)
+
+lemma lebesgue_number:
+    "\<lbrakk>compactin mtopology S; S \<subseteq> \<Union>\<C>; \<And>U. U \<in> \<C> \<Longrightarrow> openin mtopology U\<rbrakk>
+    \<Longrightarrow> \<exists>\<epsilon>>0. \<forall>x \<in> S. \<exists>U \<in> \<C>. mball x \<epsilon> \<subseteq> U"
+  by (simp add: Bolzano_Weierstrass_D compactin_sequentially)
+
+lemma compact_space_sequentially:
+   "compact_space mtopology \<longleftrightarrow>
+    (\<forall>\<sigma>::nat\<Rightarrow>'a. range \<sigma> \<subseteq> M
+         \<longrightarrow> (\<exists>l r. l \<in> M \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially))"
+  by (simp add: compact_space_def compactin_sequentially)
+
+lemma compact_space_eq_Bolzano_Weierstrass:
+   "compact_space mtopology \<longleftrightarrow>
+    (\<forall>S. S \<subseteq> M \<and> infinite S \<longrightarrow> mtopology derived_set_of S \<noteq> {})"
+  using Int_absorb1 [OF derived_set_of_subset_topspace [of mtopology]]
+  by (force simp: compact_space_def compactin_eq_Bolzano_Weierstrass)
+
+lemma compact_space_nest:
+   "compact_space mtopology \<longleftrightarrow>
+    (\<forall>C. (\<forall>n::nat. closedin mtopology (C n)) \<and> (\<forall>n. C n \<noteq> {}) \<and> decseq C \<longrightarrow> \<Inter>(range C) \<noteq> {})"
+   (is "?lhs=?rhs")
+proof
+  assume L: ?lhs
+  show ?rhs
+  proof clarify
+    fix C :: "nat \<Rightarrow> 'a set"
+    assume "\<forall>n. closedin mtopology (C n)"
+      and "\<forall>n. C n \<noteq> {}"
+      and "decseq C"
+      and "\<Inter> (range C) = {}"
+    then obtain K where K: "finite K" "\<Inter>(C ` K) = {}"
+      by (metis L compact_space_imp_nest)
+    then obtain k where "K \<subseteq> {..k}"
+      using finite_nat_iff_bounded_le by auto
+    then have "C k \<subseteq> \<Inter>(C ` K)"
+      using \<open>decseq C\<close> by (auto simp:decseq_def)
+    then show False
+      by (simp add: K \<open>\<forall>n. C n \<noteq> {}\<close>)
+  qed
+next
+  assume R [rule_format]: ?rhs
+  show ?lhs
+    unfolding compact_space_sequentially
+  proof (intro strip)
+    fix \<sigma> :: "nat \<Rightarrow> 'a"
+    assume \<sigma>: "range \<sigma> \<subseteq> M"
+    have "mtopology closure_of \<sigma> ` {n..} \<noteq> {}" for n
+      using \<open>range \<sigma> \<subseteq> M\<close> by (auto simp: closure_of_eq_empty image_subset_iff)
+    moreover have "decseq (\<lambda>n. mtopology closure_of \<sigma> ` {n..})"
+      using closure_of_mono image_mono by (smt (verit) atLeast_subset_iff decseq_def) 
+    ultimately obtain l where l: "\<And>n. l \<in> mtopology closure_of \<sigma> ` {n..}"
+      using R [of "\<lambda>n. mtopology closure_of (\<sigma> ` {n..})"] by auto
+    then have "l \<in> M" and "\<And>n. \<forall>r>0. \<exists>k\<ge>n. \<sigma> k \<in> M \<and> d l (\<sigma> k) < r"
+      using metric_closure_of by fastforce+
+    then obtain f where f: "\<And>n r. r>0 \<Longrightarrow> f n r \<ge> n \<and> \<sigma> (f n r) \<in> M \<and> d l (\<sigma> (f n r)) < r"
+      by metis
+    define r where "r = rec_nat (f 0 1) (\<lambda>n rec. (f (Suc rec) (inverse (Suc (Suc n)))))"
+    have r: "d l (\<sigma>(r n)) < inverse(Suc n)" for n
+      by (induction n) (auto simp: rec_nat_0_imp [OF r_def] rec_nat_Suc_imp [OF r_def] f)
+    have "r n < r(Suc n)" for n
+      by (simp add: Suc_le_lessD f r_def)
+    then have "strict_mono r"
+      by (simp add: strict_mono_Suc_iff)
+    moreover have "limitin mtopology (\<sigma> \<circ> r) l sequentially"
+      proof (clarsimp simp: limitin_metric \<open>l \<in> M\<close>)
+        fix \<epsilon> :: real
+        assume "\<epsilon> > 0"
+        then have "(\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>)"
+          using Archimedean_eventually_inverse by blast
+        then show "\<forall>\<^sub>F n in sequentially. \<sigma> (r n) \<in> M \<and> d (\<sigma> (r n)) l < \<epsilon>"
+          by eventually_elim (metis commute \<open>range \<sigma> \<subseteq> M\<close>  order_less_trans r range_subsetD)
+      qed
+    ultimately show "\<exists>l r. l \<in> M \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
+      using \<open>l \<in> M\<close> by blast
+  qed
+qed
+
+
+lemma (in discrete_metric) mcomplete_discrete_metric: "disc.mcomplete"
+proof (clarsimp simp: disc.mcomplete_def)
+  fix \<sigma> :: "nat \<Rightarrow> 'a"
+  assume "disc.MCauchy \<sigma>"
+  then obtain N where "\<And>n. N \<le> n \<Longrightarrow> \<sigma> N = \<sigma> n"
+    unfolding disc.MCauchy_def by (metis dd_def dual_order.refl order_less_irrefl zero_less_one)
+  moreover have "range \<sigma> \<subseteq> M"
+    using \<open>disc.MCauchy \<sigma>\<close> disc.MCauchy_def by blast
+  ultimately have "limitin disc.mtopology \<sigma> (\<sigma> N) sequentially"
+    by (metis disc.limit_metric_sequentially disc.zero range_subsetD)
+  then show "\<exists>x. limitin disc.mtopology \<sigma> x sequentially" ..
+qed
+
+lemma compact_space_imp_mcomplete: "compact_space mtopology \<Longrightarrow> mcomplete"
+  by (simp add: compact_space_nest mcomplete_nest)
+
+lemma (in submetric) compactin_imp_mcomplete:
+   "compactin mtopology A \<Longrightarrow> sub.mcomplete"
+  by (simp add: compactin_subspace mtopology_submetric sub.compact_space_imp_mcomplete)
+
+lemma (in submetric) mcomplete_imp_closedin:
+  assumes "sub.mcomplete"
+  shows "closedin mtopology A"
+proof -
+  have "l \<in> A"
+    if "range \<sigma> \<subseteq> A" and l: "limitin mtopology \<sigma> l sequentially"
+    for \<sigma> :: "nat \<Rightarrow> 'a" and l
+  proof -
+    have "sub.MCauchy \<sigma>"
+      using convergent_imp_MCauchy subset that by (force simp: MCauchy_submetric)
+    then have "limitin sub.mtopology \<sigma> l sequentially"
+      using assms unfolding sub.mcomplete_def
+      using l limitin_metric_unique limitin_submetric_iff trivial_limit_sequentially by blast
+    then show ?thesis
+      using limitin_submetric_iff by blast
+  qed
+  then show ?thesis
+    using metric_closedin_iff_sequentially_closed subset by auto
+qed
+
+lemma (in submetric) closedin_eq_mcomplete:
+   "mcomplete \<Longrightarrow> (closedin mtopology A \<longleftrightarrow> sub.mcomplete)"
+  using closedin_mcomplete_imp_mcomplete mcomplete_imp_closedin by blast
+
+lemma compact_space_eq_mcomplete_mtotally_bounded:
+   "compact_space mtopology \<longleftrightarrow> mcomplete \<and> mtotally_bounded M"
+  by (meson Bolzano_Weierstrass_C compact_space_imp_mcomplete compact_space_sequentially limitin_mspace 
+            mcomplete_alt mtotally_bounded_sequentially subset_refl)
+
+
+lemma compact_closure_of_imp_mtotally_bounded:
+   "\<lbrakk>compactin mtopology (mtopology closure_of S); S \<subseteq> M\<rbrakk>
+      \<Longrightarrow> mtotally_bounded S"
+  using compactin_imp_mtotally_bounded mtotally_bounded_closure_of_eq by blast
+
+lemma mtotally_bounded_eq_compact_closure_of:
+  assumes "mcomplete"
+  shows "mtotally_bounded S \<longleftrightarrow> S \<subseteq> M \<and> compactin mtopology (mtopology closure_of S)"
+  (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+    unfolding compactin_subspace
+  proof (intro conjI)
+    show "S \<subseteq> M"
+      using L by (simp add: mtotally_bounded_imp_subset)
+    show "mtopology closure_of S \<subseteq> topspace mtopology"
+      by (simp add: \<open>S \<subseteq> M\<close> closure_of_minimal)
+    then have MSM: "mtopology closure_of S \<subseteq> M"
+      by auto
+    interpret S: submetric M d "mtopology closure_of S"
+    proof qed (use MSM in auto)
+    have "S.sub.mtotally_bounded (mtopology closure_of S)"
+      using L mtotally_bounded_absolute mtotally_bounded_closure_of by blast
+    then
+    show "compact_space (subtopology mtopology (mtopology closure_of S))"
+      using S.closedin_mcomplete_imp_mcomplete S.mtopology_submetric S.sub.compact_space_eq_mcomplete_mtotally_bounded assms by force
+  qed
+qed (auto simp: compact_closure_of_imp_mtotally_bounded)
+
+
+
+lemma compact_closure_of_eq_Bolzano_Weierstrass:
+   "compactin mtopology (mtopology closure_of S) \<longleftrightarrow>
+    (\<forall>T. infinite T \<and> T \<subseteq> S \<and> T \<subseteq> M \<longrightarrow> mtopology derived_set_of T \<noteq> {})"  (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+  proof (intro strip)
+    fix T
+    assume T: "infinite T \<and> T \<subseteq> S \<and> T \<subseteq> M"
+    show "mtopology derived_set_of T \<noteq> {}"
+    proof (intro compact_closure_of_imp_Bolzano_Weierstrass)
+      show "compactin mtopology (mtopology closure_of S)"
+        by (simp add: L)
+    qed (use T in auto)
+  qed
+next
+  have "compactin mtopology (mtopology closure_of S)"
+    if \<section>: "\<And>T. \<lbrakk>infinite T; T \<subseteq> S\<rbrakk> \<Longrightarrow> mtopology derived_set_of T \<noteq> {}" and "S \<subseteq> M" for S
+    unfolding compactin_sequentially
+  proof (intro conjI strip)
+    show MSM: "mtopology closure_of S \<subseteq> M"
+      using closure_of_subset_topspace by fastforce
+    fix \<sigma> :: "nat \<Rightarrow> 'a"
+    assume \<sigma>: "range \<sigma> \<subseteq> mtopology closure_of S"
+    then have "\<exists>y \<in> S. d (\<sigma> n) y < inverse(Suc n)" for n
+      by (simp add: metric_closure_of image_subset_iff) (metis inverse_Suc of_nat_Suc)
+    then obtain \<tau> where \<tau>: "\<And>n. \<tau> n \<in> S \<and> d (\<sigma> n) (\<tau> n) < inverse(Suc n)"
+      by metis
+    then have "range \<tau> \<subseteq> S"
+      by blast
+    moreover
+    have *: "\<forall>T. T \<subseteq> S \<and> infinite T \<longrightarrow> mtopology closure_of S \<inter> mtopology derived_set_of T \<noteq> {}"
+      using "\<section>"(1) derived_set_of_mono derived_set_of_subset_closure_of by fastforce
+    moreover have "S \<subseteq> mtopology closure_of S"
+      by (simp add: \<open>S \<subseteq> M\<close> closure_of_subset)
+    ultimately obtain l r where lr:
+      "l \<in> mtopology closure_of S" "strict_mono r" "limitin mtopology (\<tau> \<circ> r) l sequentially"
+      using Bolzano_Weierstrass_property \<open>S \<subseteq> M\<close> by metis
+    then have "l \<in> M"
+      using limitin_mspace by blast
+    have dr_less: "d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < inverse(Suc n)" for n
+    proof -
+      have "d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < inverse(Suc (r n))"
+        using \<tau> by auto
+      also have "... \<le> inverse(Suc n)"
+        using lr strict_mono_imp_increasing by auto
+      finally show ?thesis .
+    qed
+    have "limitin mtopology (\<sigma> \<circ> r) l sequentially"
+      unfolding limitin_metric
+    proof (intro conjI strip)
+      show "l \<in> M"
+        using limitin_mspace lr by blast
+      fix \<epsilon> :: real
+      assume "\<epsilon> > 0"
+      then have "\<forall>\<^sub>F n in sequentially. (\<tau> \<circ> r) n \<in> M \<and> d ((\<tau> \<circ> r) n) l < \<epsilon>/2"
+        using lr half_gt_zero limitin_metric by blast 
+      moreover have "\<forall>\<^sub>F n in sequentially. inverse (real (Suc n)) < \<epsilon>/2"
+        using Archimedean_eventually_inverse \<open>0 < \<epsilon>\<close> half_gt_zero by blast
+      then have "\<forall>\<^sub>F n in sequentially. d ((\<sigma> \<circ> r) n) ((\<tau> \<circ> r) n) < \<epsilon>/2"
+        by eventually_elim (smt (verit, del_insts) dr_less)
+      ultimately have "\<forall>\<^sub>F n in sequentially. d ((\<sigma> \<circ> r) n) l < \<epsilon>/2 + \<epsilon>/2"
+        by eventually_elim (smt (verit) triangle \<open>l \<in> M\<close> MSM \<sigma> comp_apply order_trans range_subsetD)      
+      then show "\<forall>\<^sub>F n in sequentially. (\<sigma> \<circ> r) n \<in> M \<and> d ((\<sigma> \<circ> r) n) l < \<epsilon>"
+        apply eventually_elim
+        using \<open>mtopology closure_of S \<subseteq> M\<close> \<sigma> by auto
+    qed
+    with lr show "\<exists>l r. l \<in> mtopology closure_of S \<and> strict_mono r \<and> limitin mtopology (\<sigma> \<circ> r) l sequentially"
+      by blast
+  qed
+  then show "?rhs \<Longrightarrow> ?lhs"
+    by (metis Int_subset_iff closure_of_restrict inf_le1 topspace_mtopology)
+qed
+
+end
+
+lemma (in discrete_metric) mtotally_bounded_discrete_metric:
+   "disc.mtotally_bounded S \<longleftrightarrow> finite S \<and> S \<subseteq> M" (is "?lhs=?rhs")
+proof
+  assume L: ?lhs 
+  show ?rhs
+  proof
+    show "finite S"
+      by (metis (no_types) L closure_of_subset_Int compactin_discrete_topology disc.mtotally_bounded_eq_compact_closure_of
+          disc.topspace_mtopology discrete_metric.mcomplete_discrete_metric inf.absorb_iff2 mtopology_discrete_metric finite_subset)
+    show "S \<subseteq> M"
+      by (simp add: L disc.mtotally_bounded_imp_subset)
+  qed
+qed (simp add: disc.finite_imp_mtotally_bounded)
+
+
+context Metric_space
+begin
+
+lemma derived_set_of_infinite_openin_metric:
+   "mtopology derived_set_of S =
+    {x \<in> M. \<forall>U. x \<in> U \<and> openin mtopology U \<longrightarrow> infinite(S \<inter> U)}"
+  by (simp add: derived_set_of_infinite_openin Hausdorff_space_mtopology)
+
+lemma derived_set_of_infinite_1: 
+  assumes "infinite (S \<inter> mball x \<epsilon>)" 
+  shows "infinite (S \<inter> mcball x \<epsilon>)"
+  by (meson Int_mono assms finite_subset mball_subset_mcball subset_refl)
+
+lemma derived_set_of_infinite_2:
+  assumes "openin mtopology U" "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> infinite (S \<inter> mcball x \<epsilon>)" and "x \<in> U"
+  shows "infinite (S \<inter> U)"
+  by (metis assms openin_mtopology_mcball finite_Int inf.absorb_iff2 inf_assoc)
+
+lemma derived_set_of_infinite_mball:
+  "mtopology derived_set_of S = {x \<in> M. \<forall>e>0. infinite(S \<inter> mball x e)}"
+  unfolding derived_set_of_infinite_openin_metric
+  by (meson centre_in_mball_iff openin_mball derived_set_of_infinite_1 derived_set_of_infinite_2)
+
+lemma derived_set_of_infinite_mcball:
+  "mtopology derived_set_of S = {x \<in> M. \<forall>e>0. infinite(S \<inter> mcball x e)}"
+  unfolding derived_set_of_infinite_openin_metric
+  by (meson centre_in_mball_iff openin_mball derived_set_of_infinite_1 derived_set_of_infinite_2)
+
+end
+
+subsection\<open>Continuous functions on metric spaces\<close>
+
+context Metric_space
+begin
+
+lemma continuous_map_to_metric:
+   "continuous_map X mtopology f \<longleftrightarrow>
+    (\<forall>x \<in> topspace X. \<forall>\<epsilon>>0. \<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. f y \<in> mball (f x) \<epsilon>))"
+   (is "?lhs=?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    unfolding continuous_map_eq_topcontinuous_at topcontinuous_at_def
+    by (metis centre_in_mball_iff openin_mball topspace_mtopology)
+next
+  assume R: ?rhs
+  then have "\<forall>x\<in>topspace X. f x \<in> M"
+    by (meson gt_ex in_mball)
+  moreover 
+  have "\<And>x V. \<lbrakk>x \<in> topspace X; openin mtopology V; f x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. f y \<in> V)"
+    unfolding openin_mtopology by (metis Int_iff R inf.orderE)
+  ultimately
+  show ?lhs
+    by (simp add: continuous_map_eq_topcontinuous_at topcontinuous_at_def)
+qed 
+
+lemma continuous_map_from_metric:
+   "continuous_map mtopology X f \<longleftrightarrow>
+    f ` M \<subseteq> topspace X \<and>
+    (\<forall>a \<in> M. \<forall>U. openin X U \<and> f a \<in> U \<longrightarrow> (\<exists>r>0. \<forall>x. x \<in> M \<and> d a x < r \<longrightarrow> f x \<in> U))"
+proof (cases "f ` M \<subseteq> topspace X")
+  case True
+  then show ?thesis
+    by (fastforce simp: continuous_map openin_mtopology subset_eq)
+next
+  case False
+  then show ?thesis
+    by (simp add: continuous_map_eq_image_closure_subset_gen)
+qed
+
+text \<open>An abstract formulation, since the limits do not have to be sequential\<close>
+lemma continuous_map_uniform_limit:
+  assumes contf: "\<forall>\<^sub>F \<xi> in F. continuous_map X mtopology (f \<xi>)"
+    and dfg: "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F \<xi> in F. \<forall>x \<in> topspace X. g x \<in> M \<and> d (f \<xi> x) (g x) < \<epsilon>"
+    and nontriv: "\<not> trivial_limit F"
+  shows "continuous_map X mtopology g"
+  unfolding continuous_map_to_metric
+proof (intro strip)
+  fix x and \<epsilon>::real
+  assume "x \<in> topspace X" and "\<epsilon> > 0"
+  then obtain \<xi> where k: "continuous_map X mtopology (f \<xi>)" 
+    and gM: "\<forall>x \<in> topspace X. g x \<in> M" 
+    and third: "\<forall>x \<in> topspace X. d (f \<xi> x) (g x) < \<epsilon>/3"
+    using eventually_conj [OF contf] contf dfg [of "\<epsilon>/3"] eventually_happens' [OF nontriv]
+    by (smt (verit, ccfv_SIG) zero_less_divide_iff)
+  then obtain U where U: "openin X U" "x \<in> U" and Uthird: "\<forall>y\<in>U. d (f \<xi> y) (f \<xi> x) < \<epsilon>/3"
+    unfolding continuous_map_to_metric
+    by (metis \<open>0 < \<epsilon>\<close> \<open>x \<in> topspace X\<close> commute divide_pos_pos in_mball zero_less_numeral)
+  have f_inM: "f \<xi> y \<in> M" if "y\<in>U" for y
+    using U k openin_subset that by (fastforce simp: continuous_map_def)
+  have "d (g y) (g x) < \<epsilon>" if "y\<in>U" for y
+  proof -
+    have "g y \<in> M"
+      using U gM openin_subset that by blast
+    have "d (g y) (g x) \<le> d (g y) (f \<xi> x) + d (f \<xi> x) (g x)"
+      by (simp add: U \<open>g y \<in> M\<close> \<open>x \<in> topspace X\<close> f_inM gM triangle)
+    also have "\<dots> \<le> d (g y) (f \<xi> y) + d (f \<xi> y) (f \<xi> x) + d (f \<xi> x) (g x)"
+      by (simp add: U \<open>g y \<in> M\<close> commute f_inM that triangle')
+    also have "\<dots> < \<epsilon>/3 + \<epsilon>/3 + \<epsilon>/3"
+      by (smt (verit) U(1) Uthird \<open>x \<in> topspace X\<close> commute openin_subset subsetD that third)
+    finally show ?thesis by simp
+  qed
+  with U gM show "\<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y\<in>U. g y \<in> mball (g x) \<epsilon>)"
+    by (metis commute in_mball in_mono openin_subset)
+qed
+
+
+lemma continuous_map_uniform_limit_alt:
+  assumes contf: "\<forall>\<^sub>F \<xi> in F. continuous_map X mtopology (f \<xi>)"
+    and gim: "g ` (topspace X) \<subseteq> M"
+    and dfg: "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F \<xi> in F. \<forall>x \<in> topspace X. d (f \<xi> x) (g x) < \<epsilon>"
+    and nontriv: "\<not> trivial_limit F"
+  shows "continuous_map X mtopology g"
+proof (rule continuous_map_uniform_limit [OF contf])
+  fix \<epsilon> :: real
+  assume "\<epsilon> > 0"
+  with gim dfg show "\<forall>\<^sub>F \<xi> in F. \<forall>x\<in>topspace X. g x \<in> M \<and> d (f \<xi> x) (g x) < \<epsilon>"
+    by (simp add: image_subset_iff)
+qed (use nontriv in auto)
+
+
+lemma continuous_map_uniformly_Cauchy_limit:
+  assumes "mcomplete"
+  assumes contf: "\<forall>\<^sub>F n in sequentially. continuous_map X mtopology (f n)"
+    and Cauchy': "\<And>\<epsilon>. \<epsilon> > 0 \<Longrightarrow> \<exists>N. \<forall>m n x. N \<le> m \<longrightarrow> N \<le> n \<longrightarrow> x \<in> topspace X \<longrightarrow> d (f m x) (f n x) < \<epsilon>"
+  obtains g where
+    "continuous_map X mtopology g"
+    "\<And>\<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>topspace X. d (f n x) (g x) < \<epsilon>"
+proof -
+  have "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>l. limitin mtopology (\<lambda>n. f n x) l sequentially"
+    using \<open>mcomplete\<close> [unfolded mcomplete, rule_format] assms
+    by (smt (verit) contf continuous_map_def eventually_mono topspace_mtopology)
+  then obtain g where g: "\<And>x. x \<in> topspace X \<Longrightarrow> limitin mtopology (\<lambda>n. f n x) (g x) sequentially"
+    by metis
+  show thesis
+  proof
+    show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>topspace X. d (f n x) (g x) < \<epsilon>"
+      if "\<epsilon> > 0" for \<epsilon> :: real
+    proof -
+      obtain N where N: "\<And>m n x. \<lbrakk>N \<le> m; N \<le> n; x \<in> topspace X\<rbrakk> \<Longrightarrow> d (f m x) (f n x) < \<epsilon>/2"
+        by (meson Cauchy' \<open>0 < \<epsilon>\<close> half_gt_zero)
+      obtain P where P: "\<And>n x. \<lbrakk>n \<ge> P; x \<in> topspace X\<rbrakk> \<Longrightarrow> f n x \<in> M"
+        using contf by (auto simp: eventually_sequentially continuous_map_def)
+      show ?thesis
+      proof (intro eventually_sequentiallyI strip)
+        fix n x
+        assume "max N P \<le> n" and x: "x \<in> topspace X"
+        obtain L where "g x \<in> M" and L: "\<forall>n\<ge>L. f n x \<in> M \<and> d (f n x) (g x) < \<epsilon>/2"
+          using g [OF x] \<open>\<epsilon> > 0\<close> unfolding limitin_metric
+          by (metis (no_types, lifting) eventually_sequentially half_gt_zero)
+        define n' where "n' \<equiv> Max{L,N,P}"
+        have L': "\<forall>m \<ge> n'. f m x \<in> M \<and> d (f m x) (g x) < \<epsilon>/2"
+          using L by (simp add: n'_def)
+        moreover
+        have "d (f n x) (f n' x) < \<epsilon>/2"
+          using N [of n n' x] \<open>max N P \<le> n\<close> n'_def x by fastforce
+        ultimately have "d (f n x) (g x) < \<epsilon>/2 + \<epsilon>/2"
+          by (smt (verit, ccfv_SIG) P \<open>g x \<in> M\<close> \<open>max N P \<le> n\<close> le_refl max.bounded_iff mdist_zero triangle' x)
+        then show "d (f n x) (g x) < \<epsilon>" by simp
+      qed
+    qed
+    then show "continuous_map X mtopology g"
+      by (smt (verit, del_insts) eventually_mono g limitin_mspace trivial_limit_sequentially continuous_map_uniform_limit [OF contf])
+  qed
+qed
+
+lemma metric_continuous_map:
+  assumes "Metric_space M' d'"
+  shows
+   "continuous_map mtopology (Metric_space.mtopology M' d') f \<longleftrightarrow>
+    f ` M \<subseteq> M' \<and> (\<forall>a \<in> M. \<forall>\<epsilon>>0. \<exists>\<delta>>0.  (\<forall>x. x \<in> M \<and> d a x < \<delta> \<longrightarrow> d' (f a) (f x) < \<epsilon>))"
+   (is "?lhs = ?rhs")
+proof -
+  interpret M': Metric_space M' d'
+    by (simp add: assms)
+  show ?thesis
+  proof
+    assume L: ?lhs
+    show ?rhs
+    proof (intro conjI strip)
+      show "f ` M \<subseteq> M'"
+        using L by (auto simp: continuous_map_def)
+      fix a and \<epsilon> :: real
+      assume "a \<in> M" and "\<epsilon> > 0"
+      then have "openin mtopology {x \<in> M. f x \<in> M'.mball (f a) \<epsilon>}" "f a \<in> M'"
+        using L unfolding continuous_map_def by fastforce+
+      then obtain \<delta> where "\<delta> > 0" "mball a \<delta> \<subseteq> {x \<in> M. f x \<in> M' \<and> d' (f a) (f x) < \<epsilon>}"
+        using \<open>0 < \<epsilon>\<close> \<open>a \<in> M\<close> openin_mtopology by auto
+      then show "\<exists>\<delta>>0. \<forall>x. x \<in> M \<and> d a x < \<delta> \<longrightarrow> d' (f a) (f x) < \<epsilon>"
+        using \<open>a \<in> M\<close> in_mball by blast
+    qed
+  next
+    assume R: ?rhs    
+    show ?lhs
+      unfolding continuous_map_def
+    proof (intro conjI strip)
+      fix U
+      assume "openin M'.mtopology U"
+      then show "openin mtopology {x \<in> topspace mtopology. f x \<in> U}"
+        apply (simp add: continuous_map_def openin_mtopology M'.openin_mtopology subset_iff)
+        by (metis R image_subset_iff)
+    qed (use R in auto)
+  qed
+qed
+
+end (*Metric_space*)
+
+end
+
diff --git a/src/HOL/Analysis/Abstract_Topological_Spaces.thy b/src/HOL/Analysis/Abstract_Topological_Spaces.thy
--- a/src/HOL/Analysis/Abstract_Topological_Spaces.thy
+++ b/src/HOL/Analysis/Abstract_Topological_Spaces.thy
@@ -1,4437 +1,5309 @@
 (*  Author:     L C Paulson, University of Cambridge [ported from HOL Light] *)
 
 section \<open>Various Forms of Topological Spaces\<close>
 
 theory Abstract_Topological_Spaces
   imports Lindelof_Spaces Locally Sum_Topology FSigma
 begin
 
 
 subsection\<open>Connected topological spaces\<close>
 
 lemma connected_space_eq_frontier_eq_empty:
    "connected_space X \<longleftrightarrow> (\<forall>S. S \<subseteq> topspace X \<and> X frontier_of S = {} \<longrightarrow> S = {} \<or> S = topspace X)"
   by (meson clopenin_eq_frontier_of connected_space_clopen_in)
 
 lemma connected_space_frontier_eq_empty:
    "connected_space X \<and> S \<subseteq> topspace X
         \<Longrightarrow> (X frontier_of S = {} \<longleftrightarrow> S = {} \<or> S = topspace X)"
   by (meson connected_space_eq_frontier_eq_empty frontier_of_empty frontier_of_topspace)
 
 lemma connectedin_eq_subset_separated_union:
    "connectedin X C \<longleftrightarrow>
         C \<subseteq> topspace X \<and> (\<forall>S T. separatedin X S T \<and> C \<subseteq> S \<union> T \<longrightarrow> C \<subseteq> S \<or> C \<subseteq> T)" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
   using connectedin_subset_topspace connectedin_subset_separated_union by blast
 next
   assume ?rhs
   then show ?lhs
   by (metis closure_of_subset connectedin_separation dual_order.eq_iff inf.orderE separatedin_def sup.boundedE)
 qed
 
 
 lemma connectedin_clopen_cases:
    "\<lbrakk>connectedin X C; closedin X T; openin X T\<rbrakk> \<Longrightarrow> C \<subseteq> T \<or> disjnt C T"
   by (metis Diff_eq_empty_iff Int_empty_right clopenin_eq_frontier_of connectedin_Int_frontier_of disjnt_def)
 
 lemma connected_space_quotient_map_image:
    "\<lbrakk>quotient_map X X' q; connected_space X\<rbrakk> \<Longrightarrow> connected_space X'"
   by (metis connectedin_continuous_map_image connectedin_topspace quotient_imp_continuous_map quotient_imp_surjective_map)
 
 lemma connected_space_retraction_map_image:
    "\<lbrakk>retraction_map X X' r; connected_space X\<rbrakk> \<Longrightarrow> connected_space X'"
   using connected_space_quotient_map_image retraction_imp_quotient_map by blast
 
 lemma connectedin_imp_perfect_gen:
   assumes X: "t1_space X" and S: "connectedin X S" and nontriv: "\<nexists>a. S = {a}"
   shows "S \<subseteq> X derived_set_of S"
 unfolding derived_set_of_def
 proof (intro subsetI CollectI conjI strip)
   show XS: "x \<in> topspace X" if "x \<in> S" for x
     using that S connectedin by fastforce 
   show "\<exists>y. y \<noteq> x \<and> y \<in> S \<and> y \<in> T"
     if "x \<in> S" and "x \<in> T \<and> openin X T" for x T
   proof -
     have opeXx: "openin X (topspace X - {x})"
       by (meson X openin_topspace t1_space_openin_delete_alt)
     moreover
     have "S \<subseteq> T \<union> (topspace X - {x})"
       using XS that(2) by auto
     moreover have "(topspace X - {x}) \<inter> S \<noteq> {}"
       by (metis Diff_triv S connectedin double_diff empty_subsetI inf_commute insert_subsetI nontriv that(1))
     ultimately show ?thesis
       using that connectedinD [OF S, of T "topspace X - {x}"]
       by blast
   qed
 qed
 
 lemma connectedin_imp_perfect:
   "\<lbrakk>Hausdorff_space X; connectedin X S; \<nexists>a. S = {a}\<rbrakk> \<Longrightarrow> S \<subseteq> X derived_set_of S"
   by (simp add: Hausdorff_imp_t1_space connectedin_imp_perfect_gen)
 
 
 
 subsection\<open>The notion of "separated between" (complement of "connected between)"\<close>
 
 definition separated_between 
   where "separated_between X S T \<equiv>
         \<exists>U V. openin X U \<and> openin X V \<and> U \<union> V = topspace X \<and> disjnt U V \<and> S \<subseteq> U \<and> T \<subseteq> V"
 
 lemma separated_between_alt:
    "separated_between X S T \<longleftrightarrow>
         (\<exists>U V. closedin X U \<and> closedin X V \<and> U \<union> V = topspace X \<and> disjnt U V \<and> S \<subseteq> U \<and> T \<subseteq> V)"
   unfolding separated_between_def
   by (metis separatedin_open_sets separation_closedin_Un_gen subtopology_topspace 
             separatedin_closed_sets separation_openin_Un_gen)
 
 lemma separated_between:
    "separated_between X S T \<longleftrightarrow>
         (\<exists>U. closedin X U \<and> openin X U \<and> S \<subseteq> U \<and> T \<subseteq> topspace X - U)"
   unfolding separated_between_def closedin_def disjnt_def
   by (smt (verit, del_insts) Diff_cancel Diff_disjoint Diff_partition Un_Diff Un_Diff_Int openin_subset)
 
 lemma separated_between_mono:
    "\<lbrakk>separated_between X S T; S' \<subseteq> S; T' \<subseteq> T\<rbrakk> \<Longrightarrow> separated_between X S' T'"
   by (meson order.trans separated_between)
 
 lemma separated_between_refl:
    "separated_between X S S \<longleftrightarrow> S = {}"
   unfolding separated_between_def
   by (metis Un_empty_right disjnt_def disjnt_empty2 disjnt_subset2 disjnt_sym le_iff_inf openin_empty openin_topspace)
 
 lemma separated_between_sym:
    "separated_between X S T \<longleftrightarrow> separated_between X T S"
   by (metis disjnt_sym separated_between_alt sup_commute)
 
 lemma separated_between_imp_subset:
    "separated_between X S T \<Longrightarrow> S \<subseteq> topspace X \<and> T \<subseteq> topspace X"
   by (metis le_supI1 le_supI2 separated_between_def)
 
 lemma separated_between_empty: 
   "(separated_between X {} S \<longleftrightarrow> S \<subseteq> topspace X) \<and> (separated_between X S {} \<longleftrightarrow> S \<subseteq> topspace X)"
   by (metis Diff_empty bot.extremum closedin_empty openin_empty separated_between separated_between_imp_subset separated_between_sym)
 
 
 lemma separated_between_Un: 
   "separated_between X S (T \<union> U) \<longleftrightarrow> separated_between X S T \<and> separated_between X S U"
   by (auto simp: separated_between)
 
 lemma separated_between_Un': 
   "separated_between X (S \<union> T) U \<longleftrightarrow> separated_between X S U \<and> separated_between X T U"
   by (simp add: separated_between_Un separated_between_sym)
 
 lemma separated_between_imp_disjoint:
    "separated_between X S T \<Longrightarrow> disjnt S T"
   by (meson disjnt_iff separated_between_def subsetD)
 
 lemma separated_between_imp_separatedin:
    "separated_between X S T \<Longrightarrow> separatedin X S T"
   by (meson separated_between_def separatedin_mono separatedin_open_sets)
 
 lemma separated_between_full:
   assumes "S \<union> T = topspace X"
   shows "separated_between X S T \<longleftrightarrow> disjnt S T \<and> closedin X S \<and> openin X S \<and> closedin X T \<and> openin X T"
 proof -
   have "separated_between X S T \<longrightarrow> separatedin X S T"
     by (simp add: separated_between_imp_separatedin)
   then show ?thesis
     unfolding separated_between_def
     by (metis assms separation_closedin_Un_gen separation_openin_Un_gen subset_refl subtopology_topspace)
 qed
 
 lemma separated_between_eq_separatedin:
    "S \<union> T = topspace X \<Longrightarrow> (separated_between X S T \<longleftrightarrow> separatedin X S T)"
   by (simp add: separated_between_full separatedin_full)
 
 lemma separated_between_pointwise_left:
   assumes "compactin X S"
   shows "separated_between X S T \<longleftrightarrow>
          (S = {} \<longrightarrow> T \<subseteq> topspace X) \<and> (\<forall>x \<in> S. separated_between X {x} T)"  (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     using separated_between_imp_subset separated_between_mono by fastforce
 next
   assume R: ?rhs
   then have "T \<subseteq> topspace X"
     by (meson equals0I separated_between_imp_subset)
   show ?lhs
   proof -
     obtain U where U: "\<forall>x \<in> S. openin X (U x)"
       "\<forall>x \<in> S. \<exists>V. openin X V \<and> U x \<union> V = topspace X \<and> disjnt (U x) V \<and> {x} \<subseteq> U x \<and> T \<subseteq> V"
       using R unfolding separated_between_def by metis
     then have "S \<subseteq> \<Union>(U ` S)"
       by blast
     then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> (\<Union>i\<in>K. U i)"
       using assms U unfolding compactin_def by (smt (verit) finite_subset_image imageE)
     show ?thesis
       unfolding separated_between
     proof (intro conjI exI)
       have "\<And>x. x \<in> K \<Longrightarrow> closedin X (U x)"
         by (smt (verit) \<open>K \<subseteq> S\<close> Diff_cancel U(2) Un_Diff Un_Diff_Int disjnt_def openin_closedin_eq subsetD)
       then show "closedin X (\<Union> (U ` K))"
         by (metis (mono_tags, lifting) \<open>finite K\<close> closedin_Union finite_imageI image_iff)
       show "openin X (\<Union> (U ` K))"
         using U(1) \<open>K \<subseteq> S\<close> by blast
       show "S \<subseteq> \<Union> (U ` K)"
         by (simp add: K)
       have "\<And>x i. \<lbrakk>x \<in> T; i \<in> K; x \<in> U i\<rbrakk> \<Longrightarrow> False"
         by (meson U(2) \<open>K \<subseteq> S\<close> disjnt_iff subsetD)
       then show "T \<subseteq> topspace X - \<Union> (U ` K)"
         using \<open>T \<subseteq> topspace X\<close> by auto
     qed
   qed
 qed
 
 lemma separated_between_pointwise_right:
    "compactin X T
         \<Longrightarrow> separated_between X S T \<longleftrightarrow> (T = {} \<longrightarrow> S \<subseteq> topspace X) \<and> (\<forall>y \<in> T. separated_between X S {y})"
   by (meson separated_between_pointwise_left separated_between_sym)
 
 lemma separated_between_closure_of:
   "S \<subseteq> topspace X \<Longrightarrow> separated_between X (X closure_of S) T \<longleftrightarrow> separated_between X S T"
   by (meson closure_of_minimal_eq separated_between_alt)
 
 
 lemma separated_between_closure_of':
  "T \<subseteq> topspace X \<Longrightarrow> separated_between X S (X closure_of T) \<longleftrightarrow> separated_between X S T"
   by (meson separated_between_closure_of separated_between_sym)
 
 lemma separated_between_closure_of_eq:
  "separated_between X S T \<longleftrightarrow> S \<subseteq> topspace X \<and> separated_between X (X closure_of S) T"
   by (metis separated_between_closure_of separated_between_imp_subset)
 
 lemma separated_between_closure_of_eq':
  "separated_between X S T \<longleftrightarrow> T \<subseteq> topspace X \<and> separated_between X S (X closure_of T)"
   by (metis separated_between_closure_of' separated_between_imp_subset)
 
 lemma separated_between_frontier_of_eq':
   "separated_between X S T \<longleftrightarrow>
    T \<subseteq> topspace X \<and> disjnt S T \<and> separated_between X S (X frontier_of T)" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis interior_of_union_frontier_of separated_between_Un separated_between_closure_of_eq' 
         separated_between_imp_disjoint)
 next
   assume R: ?rhs
   then obtain U where U: "closedin X U" "openin X U" "S \<subseteq> U" "X closure_of T - X interior_of T \<subseteq> topspace X - U"
     by (metis frontier_of_def separated_between)
   show ?lhs
   proof (rule separated_between_mono [of _ S "X closure_of T"])
     have "separated_between X S T"
       unfolding separated_between
     proof (intro conjI exI)
       show "S \<subseteq> U - T" "T \<subseteq> topspace X - (U - T)"
         using R U(3) by (force simp: disjnt_iff)+
       have "T \<subseteq> X closure_of T"
         by (simp add: R closure_of_subset)
       then have *: "U - T = U - X interior_of T"
         using U(4) interior_of_subset by fastforce
       then show "closedin X (U - T)"
         by (simp add: U(1) closedin_diff)
       have "U \<inter> X frontier_of T = {}"
         using U(4) frontier_of_def by fastforce
       then show "openin X (U - T)"
         by (metis * Diff_Un U(2) Un_Diff_Int Un_Int_eq(1) closedin_closure_of interior_of_union_frontier_of openin_diff sup_bot_right)
     qed
     then show "separated_between X S (X closure_of T)"
       by (simp add: R separated_between_closure_of')
   qed (auto simp: R closure_of_subset)
 qed
 
 lemma separated_between_frontier_of_eq:
   "separated_between X S T \<longleftrightarrow> S \<subseteq> topspace X \<and> disjnt S T \<and> separated_between X (X frontier_of S) T"
   by (metis disjnt_sym separated_between_frontier_of_eq' separated_between_sym)
 
 lemma separated_between_frontier_of:
   "\<lbrakk>S \<subseteq> topspace X; disjnt S T\<rbrakk>
    \<Longrightarrow> (separated_between X (X frontier_of S) T \<longleftrightarrow> separated_between X S T)"
   using separated_between_frontier_of_eq by blast
 
 lemma separated_between_frontier_of':
  "\<lbrakk>T \<subseteq> topspace X; disjnt S T\<rbrakk>
    \<Longrightarrow> (separated_between X S (X frontier_of T) \<longleftrightarrow> separated_between X S T)"
   using separated_between_frontier_of_eq' by auto
 
 lemma connected_space_separated_between:
   "connected_space X \<longleftrightarrow> (\<forall>S T. separated_between X S T \<longrightarrow> S = {} \<or> T = {})" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis Diff_cancel connected_space_clopen_in separated_between subset_empty)
 next
   assume ?rhs then show ?lhs
     by (meson connected_space_eq_not_separated separated_between_eq_separatedin)
 qed
 
 lemma connected_space_imp_separated_between_trivial:
    "connected_space X
         \<Longrightarrow> (separated_between X S T \<longleftrightarrow> S = {} \<and> T \<subseteq> topspace X \<or> S \<subseteq> topspace X \<and> T = {})"
   by (metis connected_space_separated_between separated_between_empty)
 
 
 subsection\<open>Connected components\<close>
 
 lemma connected_component_of_subtopology_eq:
    "connected_component_of (subtopology X U) a = connected_component_of X a \<longleftrightarrow>
     connected_component_of_set X a \<subseteq> U"
   by (force simp: connected_component_of_set connectedin_subtopology connected_component_of_def fun_eq_iff subset_iff)
 
 lemma connected_components_of_subtopology:
   assumes "C \<in> connected_components_of X" "C \<subseteq> U"
   shows "C \<in> connected_components_of (subtopology X U)"
 proof -
   obtain a where a: "connected_component_of_set X a \<subseteq> U" and "a \<in> topspace X"
              and Ceq: "C = connected_component_of_set X a"
     using assms by (force simp: connected_components_of_def)
   then have "a \<in> U"
     by (simp add: connected_component_of_refl in_mono)
   then have "connected_component_of_set X a = connected_component_of_set (subtopology X U) a"
     by (metis a connected_component_of_subtopology_eq)
   then show ?thesis
     by (simp add: Ceq \<open>a \<in> U\<close> \<open>a \<in> topspace X\<close> connected_component_in_connected_components_of)
 qed
 
 thm connected_space_iff_components_eq
 
 lemma open_in_finite_connected_components:
   assumes "finite(connected_components_of X)" "C \<in> connected_components_of X"
   shows "openin X C"
 proof -
   have "closedin X (topspace X - C)"
     by (metis DiffD1 assms closedin_Union closedin_connected_components_of complement_connected_components_of_Union finite_Diff)
   then show ?thesis
     by (simp add: assms connected_components_of_subset openin_closedin)
 qed
 thm connected_component_of_eq_overlap
 
 lemma connected_components_of_disjoint:
   assumes "C \<in> connected_components_of X" "C' \<in> connected_components_of X"
     shows "(disjnt C C' \<longleftrightarrow> (C \<noteq> C'))"
 proof -
   have "C \<noteq> {}"
     using nonempty_connected_components_of assms by blast
   with assms show ?thesis
     by (metis disjnt_self_iff_empty pairwiseD pairwise_disjoint_connected_components_of)
 qed
 
 lemma connected_components_of_overlap:
    "\<lbrakk>C \<in> connected_components_of X; C' \<in> connected_components_of X\<rbrakk> \<Longrightarrow> C \<inter> C' \<noteq> {} \<longleftrightarrow> C = C'"
   by (meson connected_components_of_disjoint disjnt_def)
 
 lemma pairwise_separated_connected_components_of:
    "pairwise (separatedin X) (connected_components_of X)"
   by (simp add: closedin_connected_components_of connected_components_of_disjoint pairwiseI separatedin_closed_sets)
 
 lemma finite_connected_components_of_finite:
    "finite(topspace X) \<Longrightarrow> finite(connected_components_of X)"
   by (simp add: Union_connected_components_of finite_UnionD)
 
 lemma connected_component_of_unique:
    "\<lbrakk>x \<in> C; connectedin X C; \<And>C'. x \<in> C' \<and> connectedin X C' \<Longrightarrow> C' \<subseteq> C\<rbrakk>
         \<Longrightarrow> connected_component_of_set X x = C"
   by (meson connected_component_of_maximal connectedin_connected_component_of subsetD subset_antisym)
 
 lemma closedin_connected_component_of_subtopology:
    "\<lbrakk>C \<in> connected_components_of (subtopology X s); X closure_of C \<subseteq> s\<rbrakk> \<Longrightarrow> closedin X C"
   by (metis closedin_Int_closure_of closedin_connected_components_of closure_of_eq inf.absorb_iff2)
 
 lemma connected_component_of_discrete_topology:
    "connected_component_of_set (discrete_topology U) x = (if x \<in> U then {x} else {})"
   by (simp add: locally_path_connected_space_discrete_topology flip: path_component_eq_connected_component_of)
 
 lemma connected_components_of_discrete_topology:
    "connected_components_of (discrete_topology U) = (\<lambda>x. {x}) ` U"
   by (simp add: connected_component_of_discrete_topology connected_components_of_def)
 
 lemma connected_component_of_continuous_image:
    "\<lbrakk>continuous_map X Y f; connected_component_of X x y\<rbrakk>
         \<Longrightarrow> connected_component_of Y (f x) (f y)"
   by (meson connected_component_of_def connectedin_continuous_map_image image_eqI)
 
 lemma homeomorphic_map_connected_component_of:
   assumes "homeomorphic_map X Y f" and x: "x \<in> topspace X"
   shows "connected_component_of_set Y (f x) = f ` (connected_component_of_set X x)"
 proof -
   obtain g where g: "continuous_map X Y f"
     "continuous_map Y X g " "\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x" 
     "\<And>y. y \<in> topspace Y \<Longrightarrow> f (g y) = y"
     using assms(1) homeomorphic_map_maps homeomorphic_maps_def by fastforce
   show ?thesis
     using connected_component_in_topspace [of Y] x g
           connected_component_of_continuous_image [of X Y f]
           connected_component_of_continuous_image [of Y X g]
     by force
 qed
 
 lemma homeomorphic_map_connected_components_of:
   assumes "homeomorphic_map X Y f"
   shows "connected_components_of Y = (image f) ` (connected_components_of X)"
 proof -
   have "topspace Y = f ` topspace X"
     by (metis assms homeomorphic_imp_surjective_map)
   with homeomorphic_map_connected_component_of [OF assms] show ?thesis
     by (auto simp: connected_components_of_def image_iff)
 qed
 
 lemma connected_component_of_pair:
    "connected_component_of_set (prod_topology X Y) (x,y) =
         connected_component_of_set X x \<times> connected_component_of_set Y y"
 proof (cases "x \<in> topspace X \<and> y \<in> topspace Y")
   case True
   show ?thesis
   proof (rule connected_component_of_unique)
     show "(x, y) \<in> connected_component_of_set X x \<times> connected_component_of_set Y y"
       using True by (simp add: connected_component_of_refl)
     show "connectedin (prod_topology X Y) (connected_component_of_set X x \<times> connected_component_of_set Y y)"
       by (metis connectedin_Times connectedin_connected_component_of)
     show "C \<subseteq> connected_component_of_set X x \<times> connected_component_of_set Y y"
       if "(x, y) \<in> C \<and> connectedin (prod_topology X Y) C" for C 
       using that unfolding connected_component_of_def
       apply clarsimp
       by (metis (no_types) connectedin_continuous_map_image continuous_map_fst continuous_map_snd fst_conv imageI snd_conv)
   qed
 next
   case False then show ?thesis
     by (metis Sigma_empty1 Sigma_empty2 connected_component_of_eq_empty mem_Sigma_iff topspace_prod_topology)
 qed
 
 lemma connected_components_of_prod_topology:
   "connected_components_of (prod_topology X Y) =
     {C \<times> D |C D. C \<in> connected_components_of X \<and> D \<in> connected_components_of Y}" (is "?lhs=?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     apply (clarsimp simp: connected_components_of_def)
     by (metis (no_types) connected_component_of_pair imageI)
 next
   show "?rhs \<subseteq> ?lhs"
     using connected_component_of_pair
     by (fastforce simp: connected_components_of_def)
 qed
 
 
 lemma connected_component_of_product_topology:
    "connected_component_of_set (product_topology X I) x =
     (if x \<in> extensional I then PiE I (\<lambda>i. connected_component_of_set (X i) (x i)) else {})"
     (is "?lhs = If _ ?R _")    
 proof (cases "x \<in> topspace(product_topology X I)")
   case True
   have "?lhs = (\<Pi>\<^sub>E i\<in>I. connected_component_of_set (X i) (x i))"
     if xX: "\<And>i. i\<in>I \<Longrightarrow> x i \<in> topspace (X i)" and ext: "x \<in> extensional I"
   proof (rule connected_component_of_unique)
     show "x \<in> ?R"
       by (simp add: PiE_iff connected_component_of_refl local.ext xX)
     show "connectedin (product_topology X I) ?R"
       by (simp add: connectedin_PiE connectedin_connected_component_of)
     show "C \<subseteq> ?R"
       if "x \<in> C \<and> connectedin (product_topology X I) C" for C 
     proof -
       have "C \<subseteq> extensional I"
         using PiE_def connectedin_subset_topspace that by fastforce
       have "\<And>y. y \<in> C \<Longrightarrow> y \<in> (\<Pi> i\<in>I. connected_component_of_set (X i) (x i))"
         apply (simp add: connected_component_of_def Pi_def)
         by (metis connectedin_continuous_map_image continuous_map_product_projection imageI that)
       then show ?thesis
         using PiE_def \<open>C \<subseteq> extensional I\<close> by fastforce
     qed
   qed
   with True show ?thesis
     by (simp add: PiE_iff)
 next
   case False
   then show ?thesis
     apply (simp add: PiE_iff)
     by (smt (verit) Collect_empty_eq False PiE_eq_empty_iff PiE_iff connected_component_of_eq_empty)
 qed
 
 
 lemma connected_components_of_product_topology:
    "connected_components_of (product_topology X I) =
     {PiE I B |B. \<forall>i \<in> I. B i \<in> connected_components_of(X i)}"  (is "?lhs=?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (auto simp: connected_components_of_def connected_component_of_product_topology PiE_iff)
   show "?rhs \<subseteq> ?lhs"
   proof
     fix F
     assume "F \<in> ?rhs"
     then obtain B where Feq: "F = Pi\<^sub>E I B" and
       "\<forall>i\<in>I. \<exists>x\<in>topspace (X i). B i = connected_component_of_set (X i) x"
       by (force simp: connected_components_of_def connected_component_of_product_topology image_iff)
     then obtain f where
       f: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> topspace (X i) \<and> B i = connected_component_of_set (X i) (f i)"
       by metis
     then have "(\<lambda>i\<in>I. f i) \<in> ((\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> extensional I)"
       by simp
     with f show "F \<in> ?lhs"
       unfolding Feq connected_components_of_def connected_component_of_product_topology image_iff
       by (smt (verit, del_insts) PiE_cong restrict_PiE_iff restrict_apply' restrict_extensional topspace_product_topology)
   qed
 qed
 
 
 subsection \<open>Monotone maps (in the general topological sense)\<close>
 
 
 definition monotone_map 
   where "monotone_map X Y f ==
         f ` (topspace X) \<subseteq> topspace Y \<and>
         (\<forall>y \<in> topspace Y. connectedin X {x \<in> topspace X. f x = y})"
 
 lemma monotone_map:
   "monotone_map X Y f \<longleftrightarrow>
    f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>y. connectedin X {x \<in> topspace X. f x = y})"
   apply (simp add: monotone_map_def)
   by (metis (mono_tags, lifting) connectedin_empty [of X] Collect_empty_eq image_subset_iff) 
 
 
 lemma monotone_map_in_subtopology:
    "monotone_map X (subtopology Y S) f \<longleftrightarrow> monotone_map X Y f \<and> f ` (topspace X) \<subseteq> S"
   by (smt (verit, del_insts) le_inf_iff monotone_map topspace_subtopology)
 
 lemma monotone_map_from_subtopology:
   assumes "monotone_map X Y f" 
     "\<And>x y. x \<in> topspace X \<and> y \<in> topspace X \<and> x \<in> S \<and> f x = f y \<Longrightarrow> y \<in> S"
   shows "monotone_map (subtopology X S) Y f"
   using assms
   unfolding monotone_map_def connectedin_subtopology
   by (smt (verit, del_insts) Collect_cong Collect_empty_eq IntE IntI connectedin_empty image_subset_iff mem_Collect_eq subsetI topspace_subtopology)
 
 lemma monotone_map_restriction:
   "monotone_map X Y f \<and> {x \<in> topspace X. f x \<in> v} = u
         \<Longrightarrow> monotone_map (subtopology X u) (subtopology Y v) f"
   by (smt (verit, best) IntI Int_Collect image_subset_iff mem_Collect_eq monotone_map monotone_map_from_subtopology topspace_subtopology)
 
 lemma injective_imp_monotone_map:
   assumes "f ` topspace X \<subseteq> topspace Y"  "inj_on f (topspace X)"
   shows "monotone_map X Y f"
   unfolding monotone_map_def
 proof (intro conjI assms strip)
   fix y
   assume "y \<in> topspace Y"
   then have "{x \<in> topspace X. f x = y} = {} \<or> (\<exists>a \<in> topspace X. {x \<in> topspace X. f x = y} = {a})"
     using assms(2) unfolding inj_on_def by blast
   then show "connectedin X {x \<in> topspace X. f x = y}"
     by (metis (no_types, lifting) connectedin_empty connectedin_sing)
 qed
 
 lemma embedding_imp_monotone_map:
    "embedding_map X Y f \<Longrightarrow> monotone_map X Y f"
   by (metis (no_types) embedding_map_def homeomorphic_eq_everything_map inf.absorb_iff2 injective_imp_monotone_map topspace_subtopology)
 
 lemma section_imp_monotone_map:
    "section_map X Y f \<Longrightarrow> monotone_map X Y f"
   by (simp add: embedding_imp_monotone_map section_imp_embedding_map)
 
 lemma homeomorphic_imp_monotone_map:
    "homeomorphic_map X Y f \<Longrightarrow> monotone_map X Y f"
   by (meson section_and_retraction_eq_homeomorphic_map section_imp_monotone_map)
 
 proposition connected_space_monotone_quotient_map_preimage:
   assumes f: "monotone_map X Y f" "quotient_map X Y f" and "connected_space Y"
   shows "connected_space X"
 proof (rule ccontr)
   assume "\<not> connected_space X"
   then obtain U V where "openin X U" "openin X V" "U \<inter> V = {}"
     "U \<noteq> {}" "V \<noteq> {}" and topUV: "topspace X \<subseteq> U \<union> V"
     by (auto simp: connected_space_def)
   then have UVsub: "U \<subseteq> topspace X" "V \<subseteq> topspace X"
     by (auto simp: openin_subset)
   have "\<not> connected_space Y"
     unfolding connected_space_def not_not
   proof (intro exI conjI)
     show "topspace Y \<subseteq> f`U \<union> f`V"
       by (metis f(2) image_Un quotient_imp_surjective_map subset_Un_eq topUV)
     show "f`U \<noteq> {}"
       by (simp add: \<open>U \<noteq> {}\<close>)
     show "(f`V) \<noteq> {}"
       by (simp add: \<open>V \<noteq> {}\<close>)
     have *: "y \<notin> f ` V" if "y \<in> f ` U" for y
     proof -
       have \<section>: "connectedin X {x \<in> topspace X. f x = y}"
         using f(1) monotone_map by fastforce
       show ?thesis
         using connectedinD [OF \<section> \<open>openin X U\<close> \<open>openin X V\<close>] UVsub topUV \<open>U \<inter> V = {}\<close> that
         by (force simp: disjoint_iff)
     qed
     then show "f`U \<inter> f`V = {}"
       by blast
     show "openin Y (f`U)"
       using f \<open>openin X U\<close> topUV * unfolding quotient_map_saturated_open by force
     show "openin Y (f`V)"
       using f \<open>openin X V\<close> topUV * unfolding quotient_map_saturated_open by force
   qed
   then show False
     by (simp add: assms)
 qed
 
 lemma connectedin_monotone_quotient_map_preimage:
   assumes "monotone_map X Y f" "quotient_map X Y f" "connectedin Y C" "openin Y C \<or> closedin Y C"
   shows "connectedin X {x \<in> topspace X. f x \<in> C}"
 proof -
   have "connected_space (subtopology X {x \<in> topspace X. f x \<in> C})"
   proof -
     have "connected_space (subtopology Y C)"
       using \<open>connectedin Y C\<close> connectedin_def by blast
     moreover have "quotient_map (subtopology X {a \<in> topspace X. f a \<in> C}) (subtopology Y C) f"
       by (simp add: assms quotient_map_restriction)
     ultimately show ?thesis
       using \<open>monotone_map X Y f\<close> connected_space_monotone_quotient_map_preimage monotone_map_restriction by blast
   qed
   then show ?thesis
     by (simp add: connectedin_def)
 qed
 
 lemma monotone_open_map:
   assumes "continuous_map X Y f" "open_map X Y f" and fim: "f ` (topspace X) = topspace Y"
   shows "monotone_map X Y f \<longleftrightarrow> (\<forall>C. connectedin Y C \<longrightarrow> connectedin X {x \<in> topspace X. f x \<in> C})"
          (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
     unfolding connectedin_def
   proof (intro strip conjI)
     fix C
     assume C: "C \<subseteq> topspace Y \<and> connected_space (subtopology Y C)"
     show "connected_space (subtopology X {x \<in> topspace X. f x \<in> C})"
     proof (rule connected_space_monotone_quotient_map_preimage)
       show "monotone_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
         by (simp add: L monotone_map_restriction)
       show "quotient_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
       proof (rule continuous_open_imp_quotient_map)
         show "continuous_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
           using assms continuous_map_from_subtopology continuous_map_in_subtopology by fastforce
       qed (use open_map_restriction assms in fastforce)+
     qed (simp add: C)
   qed auto
 next
   assume ?rhs 
   then have "\<forall>y. connectedin Y {y} \<longrightarrow> connectedin X {x \<in> topspace X. f x = y}"
     by (smt (verit) Collect_cong singletonD singletonI)
   then show ?lhs
     by (simp add: fim monotone_map_def)
 qed
 
 lemma monotone_closed_map:
   assumes "continuous_map X Y f" "closed_map X Y f" and fim: "f ` (topspace X) = topspace Y"
   shows "monotone_map X Y f \<longleftrightarrow> (\<forall>C. connectedin Y C \<longrightarrow> connectedin X {x \<in> topspace X. f x \<in> C})" 
          (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
     unfolding connectedin_def
   proof (intro strip conjI)
     fix C
     assume C: "C \<subseteq> topspace Y \<and> connected_space (subtopology Y C)"
     show "connected_space (subtopology X {x \<in> topspace X. f x \<in> C})"
     proof (rule connected_space_monotone_quotient_map_preimage)
       show "monotone_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
         by (simp add: L monotone_map_restriction)
       show "quotient_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
       proof (rule continuous_closed_imp_quotient_map)
         show "continuous_map (subtopology X {x \<in> topspace X. f x \<in> C}) (subtopology Y C) f"
           using assms continuous_map_from_subtopology continuous_map_in_subtopology by fastforce
       qed (use closed_map_restriction assms in fastforce)+
     qed (simp add: C)
   qed auto
 next
   assume ?rhs 
   then have "\<forall>y. connectedin Y {y} \<longrightarrow> connectedin X {x \<in> topspace X. f x = y}"
     by (smt (verit) Collect_cong singletonD singletonI)
   then show ?lhs
     by (simp add: fim monotone_map_def)
 qed
 
 subsection\<open>Other countability properties\<close>
 
 definition second_countable
   where "second_countable X \<equiv>
          \<exists>\<B>. countable \<B> \<and> (\<forall>V \<in> \<B>. openin X V) \<and>
              (\<forall>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U))"
 
 definition first_countable
   where "first_countable X \<equiv>
         \<forall>x \<in> topspace X.
          \<exists>\<B>. countable \<B> \<and> (\<forall>V \<in> \<B>. openin X V) \<and>
              (\<forall>U. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U))"
 
 definition separable_space
   where "separable_space X \<equiv>
         \<exists>C. countable C \<and> C \<subseteq> topspace X \<and> X closure_of C = topspace X"
 
 lemma second_countable:
    "second_countable X \<longleftrightarrow>
         (\<exists>\<B>. countable \<B> \<and> openin X = arbitrary union_of (\<lambda>x. x \<in> \<B>))"
   by (smt (verit) openin_topology_base_unique second_countable_def)
 
 lemma second_countable_subtopology:
   assumes "second_countable X"
   shows "second_countable (subtopology X S)"
 proof -
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     "\<And>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms by (auto simp: second_countable_def)
   show ?thesis
     unfolding second_countable_def
   proof (intro exI conjI)
     show "\<forall>V\<in>((\<inter>)S) ` \<B>. openin (subtopology X S) V"
       using openin_subtopology_Int2 \<B> by blast
     show "\<forall>U x. openin (subtopology X S) U \<and> x \<in> U \<longrightarrow> (\<exists>V\<in>((\<inter>)S) ` \<B>. x \<in> V \<and> V \<subseteq> U)"
       using \<B> unfolding openin_subtopology
       by (smt (verit, del_insts) IntI image_iff inf_commute inf_le1 subset_iff)
   qed (use \<B> in auto)
 qed
 
 
 lemma second_countable_discrete_topology:
    "second_countable(discrete_topology U) \<longleftrightarrow> countable U" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> V \<subseteq> U"
     "\<And>W x. W \<subseteq> U \<and> x \<in> W \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> W)"
     by (auto simp: second_countable_def)
   then have "{x} \<in> \<B>" if "x \<in> U" for x
     by (metis empty_subsetI insertCI insert_subset subset_antisym that)
   then show ?rhs
     by (smt (verit) countable_subset image_subsetI \<open>countable \<B>\<close> countable_image_inj_on [OF _ inj_singleton])
 next
   assume ?rhs 
   then show ?lhs
     unfolding second_countable_def
     by (rule_tac x="(\<lambda>x. {x}) ` U" in exI) auto
 qed
 
 lemma second_countable_open_map_image:
   assumes "continuous_map X Y f" "open_map X Y f" 
    and fim: "f ` (topspace X) = topspace Y" and "second_countable X"
  shows "second_countable Y"
 proof -
   have openXYf: "\<And>U. openin X U \<longrightarrow> openin Y (f ` U)"
     using assms by (auto simp: open_map_def)
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     and *: "\<And>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms by (auto simp: second_countable_def)
   show ?thesis
     unfolding second_countable_def
   proof (intro exI conjI strip)
     fix V y
     assume V: "openin Y V \<and> y \<in> V"
     then obtain x where "x \<in> topspace X" and x: "f x = y"
       by (metis fim image_iff openin_subset subsetD)
 
     then obtain W where "W\<in>\<B>" "x \<in> W" "W \<subseteq> {x \<in> topspace X. f x \<in> V}"
       using * [of "{x \<in> topspace X. f x \<in> V}" x] V assms openin_continuous_map_preimage 
       by force
     then show "\<exists>W \<in> (image f) ` \<B>. y \<in> W \<and> W \<subseteq> V"
       using x by auto
   qed (use \<B> openXYf in auto)
 qed
 
 lemma homeomorphic_space_second_countability:
    "X homeomorphic_space Y \<Longrightarrow> (second_countable X \<longleftrightarrow> second_countable Y)"
   by (meson homeomorphic_eq_everything_map homeomorphic_space homeomorphic_space_sym second_countable_open_map_image)
 
 lemma second_countable_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; second_countable X\<rbrakk> \<Longrightarrow> second_countable Y"
   using hereditary_imp_retractive_property homeomorphic_space_second_countability second_countable_subtopology by blast
 
 lemma second_countable_imp_first_countable:
    "second_countable X \<Longrightarrow> first_countable X"
   by (metis first_countable_def second_countable_def)
 
 lemma first_countable_subtopology:
   assumes "first_countable X"
   shows "first_countable (subtopology X S)"
   unfolding first_countable_def
 proof
   fix x
   assume "x \<in> topspace (subtopology X S)"
   then obtain \<B> where "countable \<B>" and \<B>: "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     "\<And>U. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms first_countable_def by force
   show "\<exists>\<B>. countable \<B> \<and> (\<forall>V\<in>\<B>. openin (subtopology X S) V) \<and> (\<forall>U. openin (subtopology X S) U \<and> x \<in> U \<longrightarrow> (\<exists>V\<in>\<B>. x \<in> V \<and> V \<subseteq> U))"
   proof (intro exI conjI strip)
     show "countable (((\<inter>)S) ` \<B>)"
       using \<open>countable \<B>\<close> by blast
     show "openin (subtopology X S) V" if "V \<in> ((\<inter>)S) ` \<B>" for V
       using \<B> openin_subtopology_Int2 that by fastforce
     show "\<exists>V\<in>((\<inter>)S) ` \<B>. x \<in> V \<and> V \<subseteq> U"
       if "openin (subtopology X S) U \<and> x \<in> U" for U 
       using that \<B>(2) by (clarsimp simp: openin_subtopology) (meson le_infI2)
   qed
 qed
 
 lemma first_countable_discrete_topology:
    "first_countable (discrete_topology U)"
   unfolding first_countable_def topspace_discrete_topology openin_discrete_topology
 proof
   fix x assume "x \<in> U"
   show "\<exists>\<B>. countable \<B> \<and> (\<forall>V\<in>\<B>. V \<subseteq> U) \<and> (\<forall>Ua. Ua \<subseteq> U \<and> x \<in> Ua \<longrightarrow> (\<exists>V\<in>\<B>. x \<in> V \<and> V \<subseteq> Ua))"
     using \<open>x \<in> U\<close> by (rule_tac x="{{x}}" in exI) auto
 qed
 
 lemma first_countable_open_map_image:
   assumes "continuous_map X Y f" "open_map X Y f" 
    and fim: "f ` (topspace X) = topspace Y" and "first_countable X"
  shows "first_countable Y"
   unfolding first_countable_def
 proof
   fix y
   assume "y \<in> topspace Y"
   have openXYf: "\<And>U. openin X U \<longrightarrow> openin Y (f ` U)"
     using assms by (auto simp: open_map_def)
   then obtain x where x: "x \<in> topspace X" "f x = y"
     by (metis \<open>y \<in> topspace Y\<close> fim imageE)
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     and *: "\<And>U. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms x first_countable_def by force
   show "\<exists>\<B>. countable \<B> \<and>
               (\<forall>V\<in>\<B>. openin Y V) \<and> (\<forall>U. openin Y U \<and> y \<in> U \<longrightarrow> (\<exists>V\<in>\<B>. y \<in> V \<and> V \<subseteq> U))"
   proof (intro exI conjI strip)
     fix V assume "openin Y V \<and> y \<in> V"
     then have "\<exists>W\<in>\<B>. x \<in> W \<and> W \<subseteq> {x \<in> topspace X. f x \<in> V}"
       using * [of "{x \<in> topspace X. f x \<in> V}"] assms openin_continuous_map_preimage x 
       by fastforce
     then show "\<exists>V' \<in> (image f) ` \<B>. y \<in> V' \<and> V' \<subseteq> V"
       using image_mono x by auto 
   qed (use \<B> openXYf in force)+
 qed
 
 lemma homeomorphic_space_first_countability:
   "X homeomorphic_space Y \<Longrightarrow> first_countable X \<longleftrightarrow> first_countable Y"
   by (meson first_countable_open_map_image homeomorphic_eq_everything_map homeomorphic_space homeomorphic_space_sym)
 
 lemma first_countable_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; first_countable X\<rbrakk> \<Longrightarrow> first_countable Y"
   using first_countable_subtopology hereditary_imp_retractive_property homeomorphic_space_first_countability by blast
 
 lemma separable_space_open_subset:
   assumes "separable_space X" "openin X S"
   shows "separable_space (subtopology X S)"
 proof -
   obtain C where C: "countable C" "C \<subseteq> topspace X" "X closure_of C = topspace X"
     by (meson assms separable_space_def)
   then have "\<And>x T. \<lbrakk>x \<in> topspace X; x \<in> T; openin (subtopology X S) T\<rbrakk>
            \<Longrightarrow> \<exists>y. y \<in> S \<and> y \<in> C \<and> y \<in> T"
     by (smt (verit) \<open>openin X S\<close> in_closure_of openin_open_subtopology subsetD)
   with C \<open>openin X S\<close> show ?thesis
     unfolding separable_space_def
     by (rule_tac x="S \<inter> C" in exI) (force simp: in_closure_of)
 qed
 
 lemma separable_space_continuous_map_image:
   assumes "separable_space X" "continuous_map X Y f" 
     and fim: "f ` (topspace X) = topspace Y"
   shows "separable_space Y"
 proof -
   have cont: "\<And>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S"
     by (simp add: assms continuous_map_image_closure_subset)
   obtain C where C: "countable C" "C \<subseteq> topspace X" "X closure_of C = topspace X"
     by (meson assms separable_space_def)
   then show ?thesis
     unfolding separable_space_def
     by (metis cont fim closure_of_subset_topspace countable_image image_mono subset_antisym)
 qed
 
 lemma separable_space_quotient_map_image:
   "\<lbrakk>quotient_map X Y q; separable_space X\<rbrakk> \<Longrightarrow> separable_space Y"
   by (meson quotient_imp_continuous_map quotient_imp_surjective_map separable_space_continuous_map_image)
 
 lemma separable_space_retraction_map_image:
   "\<lbrakk>retraction_map X Y r; separable_space X\<rbrakk> \<Longrightarrow> separable_space Y"
   using retraction_imp_quotient_map separable_space_quotient_map_image by blast
 
 lemma homeomorphic_separable_space:
   "X homeomorphic_space Y \<Longrightarrow> (separable_space X \<longleftrightarrow> separable_space Y)"
   by (meson homeomorphic_eq_everything_map homeomorphic_maps_map homeomorphic_space_def separable_space_continuous_map_image)
 
 lemma separable_space_discrete_topology:
    "separable_space(discrete_topology U) \<longleftrightarrow> countable U"
   by (metis countable_Int2 discrete_topology_closure_of dual_order.refl inf.orderE separable_space_def topspace_discrete_topology)
 
 lemma second_countable_imp_separable_space:
   assumes "second_countable X"
   shows "separable_space X"
 proof -
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     and *: "\<And>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms by (auto simp: second_countable_def)
   obtain c where c: "\<And>V. \<lbrakk>V \<in> \<B>; V \<noteq> {}\<rbrakk> \<Longrightarrow> c V \<in> V"
     by (metis all_not_in_conv)
   then have **: "\<And>x. x \<in> topspace X \<Longrightarrow> x \<in> X closure_of c ` (\<B> - {{}})"
     using * by (force simp: closure_of_def)
   show ?thesis
     unfolding separable_space_def
   proof (intro exI conjI)
     show "countable (c ` (\<B>-{{}}))"
       using \<B>(1) by blast
     show "(c ` (\<B>-{{}})) \<subseteq> topspace X"
       using \<B>(2) c openin_subset by fastforce
     show "X closure_of (c ` (\<B>-{{}})) = topspace X"
       by (meson ** closure_of_subset_topspace subsetI subset_antisym)
   qed
 qed
 
 lemma second_countable_imp_Lindelof_space:
   assumes "second_countable X"
   shows "Lindelof_space X"
 unfolding Lindelof_space_def
 proof clarify
   fix \<U>
   assume "\<forall>U \<in> \<U>. openin X U" and UU: "\<Union>\<U> = topspace X"
   obtain \<B> where \<B>: "countable \<B>" "\<And>V. V \<in> \<B> \<Longrightarrow> openin X V"
     and *: "\<And>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V \<in> \<B>. x \<in> V \<and> V \<subseteq> U)"
     using assms by (auto simp: second_countable_def)
   define \<B>' where "\<B>' = {B \<in> \<B>. \<exists>U. U \<in> \<U> \<and> B \<subseteq> U}"
   have \<B>': "countable \<B>'" "\<Union>\<B>' = \<Union>\<U>"
     using \<B> using "*" \<open>\<forall>U\<in>\<U>. openin X U\<close> by (fastforce simp: \<B>'_def)+
   have "\<And>b. \<exists>U. b \<in> \<B>' \<longrightarrow> U \<in> \<U> \<and> b \<subseteq> U" 
     by (simp add: \<B>'_def)
   then obtain G where G: "\<And>b. b \<in> \<B>' \<longrightarrow> G b \<in> \<U> \<and> b \<subseteq> G b" 
     by metis
   with \<B>' UU show "\<exists>\<V>. countable \<V> \<and> \<V> \<subseteq> \<U> \<and> \<Union>\<V> = topspace X"
     by (rule_tac x="G ` \<B>'" in exI) fastforce
 qed
 
 subsection \<open>Neigbourhood bases EXTRAS\<close>
 (* Neigbourhood bases (useful for "local" properties of various kind).       *)
 
 lemma openin_topology_neighbourhood_base_unique:
    "openin X = arbitrary union_of P \<longleftrightarrow>
         (\<forall>u. P u \<longrightarrow> openin X u) \<and> neighbourhood_base_of P X"
   by (smt (verit, best) open_neighbourhood_base_of openin_topology_base_unique)
 
 lemma neighbourhood_base_at_topology_base:
    "        openin X = arbitrary union_of b
         \<Longrightarrow> (neighbourhood_base_at x P X \<longleftrightarrow>
              (\<forall>w. b w \<and> x \<in> w \<longrightarrow> (\<exists>u v. openin X u \<and> P v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)))"
   apply (simp add: neighbourhood_base_at_def)
   by (smt (verit, del_insts) openin_topology_base_unique subset_trans)
 
 lemma neighbourhood_base_of_unlocalized:
   assumes "\<And>S t. P S \<and> openin X t \<and> (t \<noteq> {}) \<and> t \<subseteq> S \<Longrightarrow> P t"
   shows "neighbourhood_base_of P X \<longleftrightarrow>
          (\<forall>x \<in> topspace X. \<exists>u v. openin X u \<and> P v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> topspace X)"
   apply (simp add: neighbourhood_base_of_def)
   by (smt (verit, ccfv_SIG) assms empty_iff neighbourhood_base_at_unlocalized)
 
 lemma neighbourhood_base_at_discrete_topology:
    "neighbourhood_base_at x P (discrete_topology u) \<longleftrightarrow> x \<in> u \<Longrightarrow> P {x}"
   apply (simp add: neighbourhood_base_at_def)
   by (smt (verit) empty_iff empty_subsetI insert_subset singletonI subsetD subset_singletonD)
 
 lemma neighbourhood_base_of_discrete_topology:
    "neighbourhood_base_of P (discrete_topology u) \<longleftrightarrow> (\<forall>x \<in> u. P {x})"
   apply (simp add: neighbourhood_base_of_def)
   using neighbourhood_base_at_discrete_topology[of _ P u]
   by (metis empty_subsetI insert_subset neighbourhood_base_at_def openin_discrete_topology singletonI)
 
 lemma second_countable_neighbourhood_base_alt:
   "second_countable X \<longleftrightarrow> 
   (\<exists>\<B>. countable \<B> \<and> (\<forall>V \<in> \<B>. openin X V) \<and> neighbourhood_base_of (\<lambda>A. A\<in>\<B>) X)"
   by (metis (full_types) openin_topology_neighbourhood_base_unique second_countable)
 
 lemma first_countable_neighbourhood_base_alt:
    "first_countable X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<exists>\<B>. countable \<B> \<and> (\<forall>V \<in> \<B>. openin X V) \<and> neighbourhood_base_at x (\<lambda>V. V \<in> \<B>) X)"
   unfolding first_countable_def
   apply (intro ball_cong refl ex_cong conj_cong)
   by (metis (mono_tags, lifting) open_neighbourhood_base_at)
 
 lemma second_countable_neighbourhood_base:
    "second_countable X \<longleftrightarrow>
         (\<exists>\<B>. countable \<B> \<and> neighbourhood_base_of (\<lambda>V. V \<in> \<B>) X)" (is "?lhs=?rhs")
 proof
   assume ?lhs 
   then show ?rhs
     using second_countable_neighbourhood_base_alt by blast
 next
   assume ?rhs 
   then obtain \<B> where "countable \<B>"
     and \<B>: "\<And>W x. openin X W \<and> x \<in> W \<longrightarrow> (\<exists>U. openin X U \<and> (\<exists>V. V \<in> \<B> \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W))"
     by (metis neighbourhood_base_of)
   then show ?lhs
     unfolding second_countable_neighbourhood_base_alt neighbourhood_base_of
     apply (rule_tac x="(\<lambda>u. X interior_of u) ` \<B>" in exI)
     by (smt (verit, best) interior_of_eq interior_of_mono countable_image image_iff openin_interior_of)
 qed
 
 lemma first_countable_neighbourhood_base:
    "first_countable X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<exists>\<B>. countable \<B> \<and> neighbourhood_base_at x (\<lambda>V. V \<in> \<B>) X)" (is "?lhs=?rhs")
 proof
   assume ?lhs 
   then show ?rhs
     by (metis first_countable_neighbourhood_base_alt)
 next
   assume R: ?rhs 
   show ?lhs
     unfolding first_countable_neighbourhood_base_alt
   proof
     fix x
     assume "x \<in> topspace X"
     with R obtain \<B> where "countable \<B>" and \<B>: "neighbourhood_base_at x (\<lambda>V. V \<in> \<B>) X"
       by blast
     then
     show "\<exists>\<B>. countable \<B> \<and> Ball \<B> (openin X) \<and> neighbourhood_base_at x (\<lambda>V. V \<in> \<B>) X"
       unfolding neighbourhood_base_at_def
       apply (rule_tac x="(\<lambda>u. X interior_of u) ` \<B>" in exI)
       by (smt (verit, best) countable_image image_iff interior_of_eq interior_of_mono openin_interior_of)
   qed
 qed
 
 
 subsection\<open>$T_0$ spaces and the Kolmogorov quotient\<close>
 
 definition t0_space where
   "t0_space X \<equiv>
      \<forall>x \<in> topspace X. \<forall>y \<in> topspace X. x \<noteq> y \<longrightarrow> (\<exists>U. openin X U \<and> (x \<notin> U \<longleftrightarrow> y \<in> U))"
 
 lemma t0_space_expansive:
    "\<lbrakk>topspace Y = topspace X; \<And>U. openin X U \<Longrightarrow> openin Y U\<rbrakk> \<Longrightarrow> t0_space X \<Longrightarrow> t0_space Y"
   by (metis t0_space_def)
 
 lemma t1_imp_t0_space: "t1_space X \<Longrightarrow> t0_space X"
   by (metis t0_space_def t1_space_def)
 
 lemma t1_eq_symmetric_t0_space_alt:
    "t1_space X \<longleftrightarrow>
       t0_space X \<and>
       (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. x \<in> X closure_of {y} \<longleftrightarrow> y \<in> X closure_of {x})"
   apply (simp add: t0_space_def t1_space_def closure_of_def)
   by (smt (verit, best) openin_topspace)
 
 lemma t1_eq_symmetric_t0_space:
   "t1_space X \<longleftrightarrow> t0_space X \<and> (\<forall>x y. x \<in> X closure_of {y} \<longleftrightarrow> y \<in> X closure_of {x})"
   by (auto simp: t1_eq_symmetric_t0_space_alt in_closure_of)
 
 lemma Hausdorff_imp_t0_space:
    "Hausdorff_space X \<Longrightarrow> t0_space X"
   by (simp add: Hausdorff_imp_t1_space t1_imp_t0_space)
 
 lemma t0_space:
    "t0_space X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. x \<noteq> y \<longrightarrow> (\<exists>C. closedin X C \<and> (x \<notin> C \<longleftrightarrow> y \<in> C)))"
   unfolding t0_space_def by (metis Diff_iff closedin_def openin_closedin_eq)
 
 lemma homeomorphic_t0_space:
   assumes "X homeomorphic_space Y"
   shows "t0_space X \<longleftrightarrow> t0_space Y"
 proof -
   obtain f where f: "homeomorphic_map X Y f" and F: "inj_on f (topspace X)" and "topspace Y = f ` topspace X"
     by (metis assms homeomorphic_imp_injective_map homeomorphic_imp_surjective_map homeomorphic_space)
   with inj_on_image_mem_iff [OF F] 
   show ?thesis
     apply (simp add: t0_space_def homeomorphic_eq_everything_map continuous_map_def open_map_def inj_on_def)
     by (smt (verit)  mem_Collect_eq openin_subset)
 qed
 
 lemma t0_space_closure_of_sing:
    "t0_space X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. X closure_of {x} = X closure_of {y} \<longrightarrow> x = y)"
   by (simp add: t0_space_def closure_of_def set_eq_iff) (smt (verit))
 
 lemma t0_space_discrete_topology: "t0_space (discrete_topology S)"
   by (simp add: Hausdorff_imp_t0_space)
 
 lemma t0_space_subtopology: "t0_space X \<Longrightarrow> t0_space (subtopology X U)"
   by (simp add: t0_space_def openin_subtopology) (metis Int_iff)
 
 lemma t0_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; t0_space X\<rbrakk> \<Longrightarrow> t0_space Y"
   using hereditary_imp_retractive_property homeomorphic_t0_space t0_space_subtopology by blast
 
 lemma XY: "{x}\<times>{y} = {(x,y)}"
   by simp
 
 lemma t0_space_prod_topologyI: "\<lbrakk>t0_space X; t0_space Y\<rbrakk> \<Longrightarrow> t0_space (prod_topology X Y)"
   by (simp add: t0_space_closure_of_sing closure_of_Times closure_of_eq_empty_gen times_eq_iff flip: XY insert_Times_insert)
 
 
 lemma t0_space_prod_topology_iff:
    "t0_space (prod_topology X Y) \<longleftrightarrow> topspace (prod_topology X Y) = {} \<or> t0_space X \<and> t0_space Y" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis Sigma_empty1 Sigma_empty2 retraction_map_fst retraction_map_snd t0_space_retraction_map_image topspace_prod_topology)
 qed (metis empty_iff t0_space_def t0_space_prod_topologyI)
 
 proposition t0_space_product_topology:
    "t0_space (product_topology X I) \<longleftrightarrow>
         topspace(product_topology X I) = {} \<or> (\<forall>i \<in> I. t0_space (X i))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson retraction_map_product_projection t0_space_retraction_map_image)
 next
   assume R: ?rhs 
   show ?lhs
   proof (cases "topspace(product_topology X I) = {}")
     case True
     then show ?thesis
       by (simp add: t0_space_def)
   next
     case False
     show ?thesis
       unfolding t0_space
     proof (intro strip)
       fix x y
       assume x: "x \<in> topspace (product_topology X I)"
         and y: "y \<in> topspace (product_topology X I)"
         and "x \<noteq> y"
       then obtain i where "i \<in> I" "x i \<noteq> y i"
         by (metis PiE_ext topspace_product_topology)
       then have "t0_space (X i)"
         using False R by blast
       then obtain U where "closedin (X i) U" "(x i \<notin> U \<longleftrightarrow> y i \<in> U)"
         by (metis t0_space PiE_mem \<open>i \<in> I\<close> \<open>x i \<noteq> y i\<close> topspace_product_topology x y)
       with \<open>i \<in> I\<close> x y show "\<exists>U. closedin (product_topology X I) U \<and> (x \<notin> U) = (y \<in> U)"
         by (rule_tac x="PiE I (\<lambda>j. if j = i then U else topspace(X j))" in exI)
           (simp add: closedin_product_topology PiE_iff)
     qed
   qed
 qed
 
 
 subsection \<open>Kolmogorov quotients\<close>
 
 definition Kolmogorov_quotient 
   where "Kolmogorov_quotient X \<equiv> \<lambda>x. @y. \<forall>U. openin X U \<longrightarrow> (y \<in> U \<longleftrightarrow> x \<in> U)"
 
 lemma Kolmogorov_quotient_in_open:
    "openin X U \<Longrightarrow> (Kolmogorov_quotient X x \<in> U \<longleftrightarrow> x \<in> U)"
   by (smt (verit, ccfv_SIG) Kolmogorov_quotient_def someI_ex)
 
 lemma Kolmogorov_quotient_in_topspace:
    "Kolmogorov_quotient X x \<in> topspace X \<longleftrightarrow> x \<in> topspace X"
   by (simp add: Kolmogorov_quotient_in_open)
 
 lemma Kolmogorov_quotient_in_closed:
   "closedin X C \<Longrightarrow> (Kolmogorov_quotient X x \<in> C \<longleftrightarrow> x \<in> C)"
   unfolding closedin_def
   by (meson DiffD2 DiffI Kolmogorov_quotient_in_open Kolmogorov_quotient_in_topspace in_mono)
  
 lemma continuous_map_Kolmogorov_quotient:
    "continuous_map X X (Kolmogorov_quotient X)"
   using Kolmogorov_quotient_in_open openin_subopen openin_subset 
     by (fastforce simp: continuous_map_def Kolmogorov_quotient_in_topspace)
 
 lemma open_map_Kolmogorov_quotient_explicit:
    "openin X U \<Longrightarrow> Kolmogorov_quotient X ` U = Kolmogorov_quotient X ` topspace X \<inter> U"
   using Kolmogorov_quotient_in_open openin_subset by fastforce
 
 
 lemma open_map_Kolmogorov_quotient_gen:
    "open_map (subtopology X S) (subtopology X (image (Kolmogorov_quotient X) S)) (Kolmogorov_quotient X)"
 proof (clarsimp simp: open_map_def openin_subtopology_alt image_iff)
   fix U
   assume "openin X U"
   then have "Kolmogorov_quotient X ` (S \<inter> U) = Kolmogorov_quotient X ` S \<inter> U"
     using Kolmogorov_quotient_in_open [of X U] by auto
   then show "\<exists>V. openin X V \<and> Kolmogorov_quotient X ` (S \<inter> U) = Kolmogorov_quotient X ` S \<inter> V"
     using \<open>openin X U\<close> by blast
 qed
 
 lemma open_map_Kolmogorov_quotient:
    "open_map X (subtopology X (Kolmogorov_quotient X ` topspace X))
      (Kolmogorov_quotient X)"
   by (metis open_map_Kolmogorov_quotient_gen subtopology_topspace)
 
 lemma closed_map_Kolmogorov_quotient_explicit:
    "closedin X U \<Longrightarrow> Kolmogorov_quotient X ` U = Kolmogorov_quotient X ` topspace X \<inter> U"
   using closedin_subset by (fastforce simp: Kolmogorov_quotient_in_closed)
 
 lemma closed_map_Kolmogorov_quotient_gen:
    "closed_map (subtopology X S) (subtopology X (Kolmogorov_quotient X ` S))
      (Kolmogorov_quotient X)"
   using Kolmogorov_quotient_in_closed by (force simp: closed_map_def closedin_subtopology_alt image_iff)
 
 lemma closed_map_Kolmogorov_quotient:
    "closed_map X (subtopology X (Kolmogorov_quotient X ` topspace X))
      (Kolmogorov_quotient X)"
   by (metis closed_map_Kolmogorov_quotient_gen subtopology_topspace)
 
 lemma quotient_map_Kolmogorov_quotient_gen:
   "quotient_map (subtopology X S) (subtopology X (Kolmogorov_quotient X ` S)) (Kolmogorov_quotient X)"
 proof (intro continuous_open_imp_quotient_map)
   show "continuous_map (subtopology X S) (subtopology X (Kolmogorov_quotient X ` S)) (Kolmogorov_quotient X)"
     by (simp add: continuous_map_Kolmogorov_quotient continuous_map_from_subtopology continuous_map_in_subtopology image_mono)
   show "open_map (subtopology X S) (subtopology X (Kolmogorov_quotient X ` S)) (Kolmogorov_quotient X)"
     using open_map_Kolmogorov_quotient_gen by blast
   show "Kolmogorov_quotient X ` topspace (subtopology X S) = topspace (subtopology X (Kolmogorov_quotient X ` S))"
     by (force simp: Kolmogorov_quotient_in_open)
 qed
 
 lemma quotient_map_Kolmogorov_quotient:
    "quotient_map X (subtopology X (Kolmogorov_quotient X ` topspace X)) (Kolmogorov_quotient X)"
   by (metis quotient_map_Kolmogorov_quotient_gen subtopology_topspace)
 
 lemma Kolmogorov_quotient_eq:
    "Kolmogorov_quotient X x = Kolmogorov_quotient X y \<longleftrightarrow>
     (\<forall>U. openin X U \<longrightarrow> (x \<in> U \<longleftrightarrow> y \<in> U))" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis Kolmogorov_quotient_in_open)
 next
   assume ?rhs then show ?lhs
     by (simp add: Kolmogorov_quotient_def)
 qed
 
 lemma Kolmogorov_quotient_eq_alt:
    "Kolmogorov_quotient X x = Kolmogorov_quotient X y \<longleftrightarrow>
     (\<forall>U. closedin X U \<longrightarrow> (x \<in> U \<longleftrightarrow> y \<in> U))" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis Kolmogorov_quotient_in_closed)
 next
   assume ?rhs then show ?lhs
     by (smt (verit) Diff_iff Kolmogorov_quotient_eq closedin_topspace in_mono openin_closedin_eq)
 qed
 
 lemma Kolmogorov_quotient_continuous_map:
   assumes "continuous_map X Y f" "t0_space Y" and x: "x \<in> topspace X"
   shows "f (Kolmogorov_quotient X x) = f x"
   using assms unfolding continuous_map_def t0_space_def
   by (smt (verit, ccfv_SIG) Kolmogorov_quotient_in_open Kolmogorov_quotient_in_topspace x mem_Collect_eq)
 
 lemma t0_space_Kolmogorov_quotient:
   "t0_space (subtopology X (Kolmogorov_quotient X ` topspace X))"
   apply (clarsimp simp: t0_space_def )
   by (smt (verit, best) Kolmogorov_quotient_eq imageE image_eqI open_map_Kolmogorov_quotient open_map_def)
 
 lemma Kolmogorov_quotient_id:
    "t0_space X \<Longrightarrow> x \<in> topspace X \<Longrightarrow> Kolmogorov_quotient X x = x"
   by (metis Kolmogorov_quotient_in_open Kolmogorov_quotient_in_topspace t0_space_def)
 
 lemma Kolmogorov_quotient_idemp:
    "Kolmogorov_quotient X (Kolmogorov_quotient X x) = Kolmogorov_quotient X x"
   by (simp add: Kolmogorov_quotient_eq Kolmogorov_quotient_in_open)
 
 lemma retraction_maps_Kolmogorov_quotient:
    "retraction_maps X
      (subtopology X (Kolmogorov_quotient X ` topspace X))
      (Kolmogorov_quotient X) id"
   unfolding retraction_maps_def continuous_map_in_subtopology
   using Kolmogorov_quotient_idemp continuous_map_Kolmogorov_quotient by force
 
 lemma retraction_map_Kolmogorov_quotient:
    "retraction_map X
      (subtopology X (Kolmogorov_quotient X ` topspace X))
      (Kolmogorov_quotient X)"
   using retraction_map_def retraction_maps_Kolmogorov_quotient by blast
 
 lemma retract_of_space_Kolmogorov_quotient_image:
    "Kolmogorov_quotient X ` topspace X retract_of_space X"
 proof -
   have "continuous_map X X (Kolmogorov_quotient X)"
     by (simp add: continuous_map_Kolmogorov_quotient)
   then have "Kolmogorov_quotient X ` topspace X \<subseteq> topspace X"
     by (simp add: continuous_map_image_subset_topspace)
   then show ?thesis
     by (meson retract_of_space_retraction_maps retraction_maps_Kolmogorov_quotient)
 qed
 
 lemma Kolmogorov_quotient_lift_exists:
   assumes "S \<subseteq> topspace X" "t0_space Y" and f: "continuous_map (subtopology X S) Y f"
   obtains g where "continuous_map (subtopology X (image (Kolmogorov_quotient X) S)) Y g"
               "\<And>x. x \<in> S \<Longrightarrow> g(Kolmogorov_quotient X x) = f x"
 proof -
   have "\<And>x y. \<lbrakk>x \<in> S; y \<in> S; Kolmogorov_quotient X x = Kolmogorov_quotient X y\<rbrakk>
             \<Longrightarrow> f x = f y"
     using assms
     apply (simp add: Kolmogorov_quotient_eq t0_space_def continuous_map_def Int_absorb1 openin_subtopology)
     by (smt (verit, del_insts) Int_iff mem_Collect_eq)
   then obtain g where g: "continuous_map (subtopology X (Kolmogorov_quotient X ` S)) Y g"
     "g ` (topspace X \<inter> Kolmogorov_quotient X ` S) = f ` S"
     "\<And>x. x \<in> S \<Longrightarrow> g (Kolmogorov_quotient X x) = f x"
     using quotient_map_lift_exists [OF quotient_map_Kolmogorov_quotient_gen [of X S] f]
     by (metis assms(1) topspace_subtopology topspace_subtopology_subset) 
   show ?thesis
     proof qed (use g in auto)
 qed
 
 subsection\<open>Closed diagonals and graphs\<close>
 
 lemma Hausdorff_space_closedin_diagonal:
   "Hausdorff_space X \<longleftrightarrow>
         closedin (prod_topology X X) ((\<lambda>x. (x,x)) ` topspace X)"
 proof -
   have \<section>: "((\<lambda>x. (x, x)) ` topspace X) \<subseteq> topspace X \<times> topspace X"
     by auto
   show ?thesis
     apply (simp add: closedin_def openin_prod_topology_alt Hausdorff_space_def disjnt_iff \<section>)
     apply (intro all_cong1 imp_cong ex_cong1 conj_cong refl)
     by (force dest!: openin_subset)+
 qed
 
 lemma closed_map_diag_eq:
    "closed_map X (prod_topology X X) (\<lambda>x. (x,x)) \<longleftrightarrow> Hausdorff_space X"
 proof -
   have "section_map X (prod_topology X X) (\<lambda>x. (x, x))"
     unfolding section_map_def retraction_maps_def
     by (smt (verit) continuous_map_fst continuous_map_of_fst continuous_map_on_empty continuous_map_pairwise fst_conv fst_diag_fst snd_diag_fst)
   then have "embedding_map X (prod_topology X X) (\<lambda>x. (x, x))"
     by (rule section_imp_embedding_map)
   then show ?thesis
     using Hausdorff_space_closedin_diagonal embedding_imp_closed_map_eq by blast
 qed
 
+lemma proper_map_diag_eq [simp]:
+   "proper_map X (prod_topology X X) (\<lambda>x. (x,x)) \<longleftrightarrow> Hausdorff_space X"
+  by (simp add: closed_map_diag_eq inj_on_convol_ident injective_imp_proper_eq_closed_map)
+  
 lemma closedin_continuous_maps_eq:
   assumes "Hausdorff_space Y" and f: "continuous_map X Y f" and g: "continuous_map X Y g"
   shows "closedin X {x \<in> topspace X. f x = g x}"
 proof -
   have \<section>:"{x \<in> topspace X. f x = g x} = {x \<in> topspace X. (f x,g x) \<in> ((\<lambda>y.(y,y)) ` topspace Y)}"
     using f continuous_map_image_subset_topspace by fastforce
   show ?thesis
     unfolding \<section>
   proof (intro closedin_continuous_map_preimage)
     show "continuous_map X (prod_topology Y Y) (\<lambda>x. (f x, g x))"
       by (simp add: continuous_map_pairedI f g)
     show "closedin (prod_topology Y Y) ((\<lambda>y. (y, y)) ` topspace Y)"
       using Hausdorff_space_closedin_diagonal assms by blast
   qed
 qed
 
 lemma retract_of_space_imp_closedin:
   assumes "Hausdorff_space X" and S: "S retract_of_space X"
   shows "closedin X S"
 proof -
   obtain r where r: "continuous_map X (subtopology X S) r" "\<forall>x\<in>S. r x = x"
     using assms by (meson retract_of_space_def)
   then have \<section>: "S = {x \<in> topspace X. r x = x}"
     using S retract_of_space_imp_subset by (force simp: continuous_map_def)
   show ?thesis
     unfolding \<section> 
     using r continuous_map_into_fulltopology assms
     by (force intro: closedin_continuous_maps_eq)
 qed
 
 lemma homeomorphic_maps_graph:
    "homeomorphic_maps X (subtopology (prod_topology X Y) ((\<lambda>x. (x, f x)) ` (topspace X)))
          (\<lambda>x. (x, f x)) fst  \<longleftrightarrow>  continuous_map X Y f" 
    (is "?lhs=?rhs")
 proof
   assume ?lhs
   then 
   have h: "homeomorphic_map X (subtopology (prod_topology X Y) ((\<lambda>x. (x, f x)) ` topspace X)) (\<lambda>x. (x, f x))"
     by (auto simp: homeomorphic_maps_map)
   have "f = snd \<circ> (\<lambda>x. (x, f x))"
     by force
   then show ?rhs
     by (metis (no_types, lifting) h continuous_map_in_subtopology continuous_map_snd_of homeomorphic_eq_everything_map)
 next
   assume ?rhs
   then show ?lhs
     unfolding homeomorphic_maps_def
     by (smt (verit, ccfv_threshold) continuous_map_eq continuous_map_subtopology_fst embedding_map_def embedding_map_graph homeomorphic_eq_everything_map  image_cong image_iff prod.collapse prod.inject)
 qed
 
 
 subsection \<open> KC spaces, those where all compact sets are closed.\<close>
 
 definition kc_space 
   where "kc_space X \<equiv> \<forall>S. compactin X S \<longrightarrow> closedin X S"
 
 lemma kc_space_euclidean: "kc_space (euclidean :: 'a::metric_space topology)"
   by (simp add: compact_imp_closed kc_space_def)
   
 lemma kc_space_expansive:
    "\<lbrakk>kc_space X; topspace Y = topspace X; \<And>U. openin X U \<Longrightarrow> openin Y U\<rbrakk>
       \<Longrightarrow> kc_space Y"
   by (meson compactin_contractive kc_space_def topology_finer_closedin)
 
 lemma compactin_imp_closedin_gen:
    "\<lbrakk>kc_space X; compactin X S\<rbrakk> \<Longrightarrow> closedin X S"
   using kc_space_def by blast
 
 lemma Hausdorff_imp_kc_space: "Hausdorff_space X \<Longrightarrow> kc_space X"
   by (simp add: compactin_imp_closedin kc_space_def)
 
 lemma kc_imp_t1_space: "kc_space X \<Longrightarrow> t1_space X"
   by (simp add: finite_imp_compactin kc_space_def t1_space_closedin_finite)
 
 lemma kc_space_subtopology:
    "kc_space X \<Longrightarrow> kc_space(subtopology X S)"
   by (metis closedin_Int_closure_of closure_of_eq compactin_subtopology inf.absorb2 kc_space_def)
 
 lemma kc_space_discrete_topology:
    "kc_space(discrete_topology U)"
   using Hausdorff_space_discrete_topology compactin_imp_closedin kc_space_def by blast
 
 lemma kc_space_continuous_injective_map_preimage:
   assumes "kc_space Y" "continuous_map X Y f" and injf: "inj_on f (topspace X)"
   shows "kc_space X"
   unfolding kc_space_def
 proof (intro strip)
   fix S
   assume S: "compactin X S"
   have "S = {x \<in> topspace X. f x \<in> f ` S}"
     using S compactin_subset_topspace inj_onD [OF injf] by blast
   with assms S show "closedin X S"
     by (metis (no_types, lifting) Collect_cong closedin_continuous_map_preimage compactin_imp_closedin_gen image_compactin)
 qed
 
 lemma kc_space_retraction_map_image:
   assumes "retraction_map X Y r" "kc_space X"
   shows "kc_space Y"
 proof -
   obtain s where s: "continuous_map X Y r" "continuous_map Y X s" "\<And>x. x \<in> topspace Y \<Longrightarrow> r (s x) = x"
     using assms by (force simp: retraction_map_def retraction_maps_def)
   then have inj: "inj_on s (topspace Y)"
     by (metis inj_on_def)
   show ?thesis
     unfolding kc_space_def
   proof (intro strip)
     fix S
     assume S: "compactin Y S"
     have "S = {x \<in> topspace Y. s x \<in> s ` S}"
       using S compactin_subset_topspace inj_onD [OF inj] by blast
     with assms S show "closedin Y S"
       by (meson compactin_imp_closedin_gen inj kc_space_continuous_injective_map_preimage s(2))
   qed
 qed
 
 lemma homeomorphic_kc_space:
    "X homeomorphic_space Y \<Longrightarrow> kc_space X \<longleftrightarrow> kc_space Y"
   by (meson homeomorphic_eq_everything_map homeomorphic_space homeomorphic_space_sym kc_space_continuous_injective_map_preimage)
 
 lemma compact_kc_eq_maximal_compact_space:
   assumes "compact_space X"
   shows "kc_space X \<longleftrightarrow>
          (\<forall>Y. topspace Y = topspace X \<and> (\<forall>S. openin X S \<longrightarrow> openin Y S) \<and> compact_space Y \<longrightarrow> Y = X)" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis closedin_compact_space compactin_contractive kc_space_def topology_eq topology_finer_closedin)    
 next
   assume R: ?rhs
   show ?lhs
     unfolding kc_space_def
   proof (intro strip)
     fix S
     assume S: "compactin X S"
     define Y where 
       "Y \<equiv> topology (arbitrary union_of (finite intersection_of (\<lambda>A. A = topspace X - S \<or> openin X A)
                            relative_to (topspace X)))"
     have "topspace Y = topspace X"
       by (auto simp: Y_def)
     have "openin X T \<longrightarrow> openin Y T" for T
       by (simp add: Y_def arbitrary_union_of_inc finite_intersection_of_inc openin_subbase openin_subset relative_to_subset)
     have "compact_space Y"
     proof (rule Alexander_subbase_alt)
       show "\<exists>\<F>'. finite \<F>' \<and> \<F>' \<subseteq> \<C> \<and> topspace X \<subseteq> \<Union> \<F>'" 
         if \<C>: "\<C> \<subseteq> insert (topspace X - S) (Collect (openin X))" and sub: "topspace X \<subseteq> \<Union>\<C>" for \<C>
       proof -
         consider "\<C> \<subseteq> Collect (openin X)" | \<V> where "\<C> = insert (topspace X - S) \<V>" "\<V> \<subseteq> Collect (openin X)"
           using \<C> by (metis insert_Diff subset_insert_iff)
         then show ?thesis
         proof cases
           case 1
           then show ?thesis
             by (metis assms compact_space_alt mem_Collect_eq subsetD that(2))
         next
           case 2
           then have "S \<subseteq> \<Union>\<V>"
             using S sub compactin_subset_topspace by blast
           with 2 obtain \<F> where "finite \<F> \<and> \<F> \<subseteq> \<V> \<and> S \<subseteq> \<Union>\<F>"
             using S unfolding compactin_def by (metis Ball_Collect)
           with 2 show ?thesis
             by (rule_tac x="insert (topspace X - S) \<F>" in exI) blast
         qed
       qed
     qed (auto simp: Y_def)
     have "Y = X"
       using R \<open>\<And>S. openin X S \<longrightarrow> openin Y S\<close> \<open>compact_space Y\<close> \<open>topspace Y = topspace X\<close> by blast
     moreover have "openin Y (topspace X - S)"
       by (simp add: Y_def arbitrary_union_of_inc finite_intersection_of_inc openin_subbase relative_to_subset)
     ultimately show "closedin X S"
       unfolding closedin_def using S compactin_subset_topspace by blast
   qed
 qed
 
 lemma continuous_imp_closed_map_gen:
    "\<lbrakk>compact_space X; kc_space Y; continuous_map X Y f\<rbrakk> \<Longrightarrow> closed_map X Y f"
   by (meson closed_map_def closedin_compact_space compactin_imp_closedin_gen image_compactin)
 
 lemma kc_space_compact_subtopologies:
   "kc_space X \<longleftrightarrow> (\<forall>K. compactin X K \<longrightarrow> kc_space(subtopology X K))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: kc_space_def closedin_closed_subtopology compactin_subtopology)
 next
   assume R: ?rhs
   show ?lhs
     unfolding kc_space_def
   proof (intro strip)
     fix K
     assume K: "compactin X K"
     then have "K \<subseteq> topspace X"
       by (simp add: compactin_subset_topspace)
     moreover have "X closure_of K \<subseteq> K"
     proof
       fix x
       assume x: "x \<in> X closure_of K"
       have "kc_space (subtopology X K)"
         by (simp add: R \<open>compactin X K\<close>)
       have "compactin X (insert x K)"
         by (metis K x compactin_Un compactin_sing in_closure_of insert_is_Un)
       then show "x \<in> K"
         by (metis R x K Int_insert_left_if1 closedin_Int_closure_of compact_imp_compactin_subtopology 
             insertCI kc_space_def subset_insertI)
     qed
     ultimately show "closedin X K"
       using closure_of_subset_eq by blast
   qed
 qed
 
 lemma kc_space_compact_prod_topology:
   assumes "compact_space X"
   shows "kc_space(prod_topology X X) \<longleftrightarrow> Hausdorff_space X" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
     unfolding closed_map_diag_eq [symmetric]
   proof (intro continuous_imp_closed_map_gen)
     show "continuous_map X (prod_topology X X) (\<lambda>x. (x, x))"
       by (intro continuous_intros)
   qed (use L assms in auto)
 next
   assume ?rhs then show ?lhs
     by (simp add: Hausdorff_imp_kc_space Hausdorff_space_prod_topology)
 qed
 
 lemma kc_space_prod_topology:
    "kc_space(prod_topology X X) \<longleftrightarrow> (\<forall>K. compactin X K \<longrightarrow> Hausdorff_space(subtopology X K))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis compactin_subspace kc_space_compact_prod_topology kc_space_subtopology subtopology_Times)
 next
   assume R: ?rhs  
   have "kc_space (subtopology (prod_topology X X) L)" if "compactin (prod_topology X X) L" for L 
   proof -
     define K where "K \<equiv> fst ` L \<union> snd ` L"
     have "L \<subseteq> K \<times> K"
       by (force simp: K_def)
     have "compactin X K"
       by (metis K_def compactin_Un continuous_map_fst continuous_map_snd image_compactin that)
     then have "Hausdorff_space (subtopology X K)"
       by (simp add: R)
     then have "kc_space (prod_topology (subtopology X K) (subtopology X K))"
       by (simp add: \<open>compactin X K\<close> compact_space_subtopology kc_space_compact_prod_topology)
     then have "kc_space (subtopology (prod_topology (subtopology X K) (subtopology X K)) L)"
       using kc_space_subtopology by blast
     then show ?thesis
       using \<open>L \<subseteq> K \<times> K\<close> subtopology_Times subtopology_subtopology
       by (metis (no_types, lifting) Sigma_cong inf.absorb_iff2)
   qed
   then show ?lhs
     using kc_space_compact_subtopologies by blast
 qed
 
 lemma kc_space_prod_topology_alt:
    "kc_space(prod_topology X X) \<longleftrightarrow>
         kc_space X \<and>
         (\<forall>K. compactin X K \<longrightarrow> Hausdorff_space(subtopology X K))"
   using Hausdorff_imp_kc_space kc_space_compact_subtopologies kc_space_prod_topology by blast
 
 proposition kc_space_prod_topology_left:
   assumes X: "kc_space X" and Y: "Hausdorff_space Y"
   shows "kc_space (prod_topology X Y)"
   unfolding kc_space_def
 proof (intro strip)
   fix K
   assume K: "compactin (prod_topology X Y) K"
   then have "K \<subseteq> topspace X \<times> topspace Y"
     using compactin_subset_topspace topspace_prod_topology by blast
   moreover have "\<exists>T. openin (prod_topology X Y) T \<and> (a,b) \<in> T \<and> T \<subseteq> (topspace X \<times> topspace Y) - K"
     if ab: "(a,b) \<in> (topspace X \<times> topspace Y) - K" for a b
   proof - 
     have "compactin Y {b}"
       using that by force
     moreover 
     have "compactin Y {y \<in> topspace Y. (a,y) \<in> K}"
     proof -
       have "compactin (prod_topology X Y) (K \<inter> {a} \<times> topspace Y)"
         using that compact_Int_closedin [OF K]
         by (simp add: X closedin_prod_Times_iff compactin_imp_closedin_gen)
       moreover have "subtopology (prod_topology X Y) (K \<inter> {a} \<times> topspace Y)  homeomorphic_space 
                      subtopology Y {y \<in> topspace Y. (a, y) \<in> K}"
         unfolding homeomorphic_space_def homeomorphic_maps_def
         using that
         apply (rule_tac x="snd" in exI)
         apply (rule_tac x="Pair a" in exI)
         by (force simp: continuous_map_in_subtopology continuous_map_from_subtopology continuous_map_subtopology_snd continuous_map_paired)
       ultimately show ?thesis
         by (simp add: compactin_subspace homeomorphic_compact_space) 
     qed
     moreover have "disjnt {b} {y \<in> topspace Y. (a,y) \<in> K}"
       using ab by force
     ultimately obtain V U where VU: "openin Y V" "openin Y U" "{b} \<subseteq> V" "{y \<in> topspace Y. (a,y) \<in> K} \<subseteq> U" "disjnt V U"
       using Hausdorff_space_compact_separation [OF Y] by blast
     define V' where "V' \<equiv> topspace Y - U"
     have W: "closedin Y V'" "{y \<in> topspace Y. (a,y) \<in> K} \<subseteq> topspace Y - V'" "disjnt V (topspace Y - V')"
       using VU by (auto simp: V'_def disjnt_iff)
     with VU obtain "V \<subseteq> topspace Y" "V' \<subseteq> topspace Y"
       by (meson closedin_subset openin_closedin_eq)
     then obtain "b \<in> V" "disjnt {y \<in> topspace Y. (a,y) \<in> K} V'" "V \<subseteq> V'"
       using VU unfolding disjnt_iff V'_def by force
     define C where "C \<equiv> image fst (K \<inter> {z \<in> topspace(prod_topology X Y). snd z \<in> V'})"
     have "closedin (prod_topology X Y) {z \<in> topspace (prod_topology X Y). snd z \<in> V'}"
         using closedin_continuous_map_preimage \<open>closedin Y V'\<close> continuous_map_snd by blast
     then have "compactin X C"
       unfolding C_def by (meson K compact_Int_closedin continuous_map_fst image_compactin)
     then have "closedin X C"
       using assms by (auto simp: kc_space_def)
     show ?thesis
     proof (intro exI conjI)
       show "openin (prod_topology X Y) ((topspace X - C) \<times> V)"
         by (simp add: VU \<open>closedin X C\<close> openin_diff openin_prod_Times_iff)
       have "a \<notin> C"
         using VU by (auto simp: C_def V'_def)
       then show "(a, b) \<in> (topspace X - C) \<times> V"
         using \<open>a \<notin> C\<close> \<open>b \<in> V\<close> that by blast
       show "(topspace X - C) \<times> V \<subseteq> topspace X \<times> topspace Y - K"
         using \<open>V \<subseteq> V'\<close> \<open>V \<subseteq> topspace Y\<close> 
         apply (simp add: C_def )
         by (smt (verit, ccfv_threshold) DiffE DiffI IntI SigmaE SigmaI image_eqI mem_Collect_eq prod.sel(1) snd_conv subset_iff)
     qed
   qed
   ultimately show "closedin (prod_topology X Y) K"
     by (metis surj_pair closedin_def openin_subopen topspace_prod_topology)
 qed
 
 lemma kc_space_prod_topology_right:
    "\<lbrakk>Hausdorff_space X; kc_space Y\<rbrakk> \<Longrightarrow> kc_space (prod_topology X Y)"
   using kc_space_prod_topology_left homeomorphic_kc_space homeomorphic_space_prod_topology_swap by blast
 
+subsection \<open>Technical results about proper maps, perfect maps, etc\<close>
+
+lemma compact_imp_proper_map_gen:
+  assumes Y: "\<And>S. \<lbrakk>S \<subseteq> topspace Y; \<And>K. compactin Y K \<Longrightarrow> compactin Y (S \<inter> K)\<rbrakk>
+               \<Longrightarrow> closedin Y S"
+    and fim: "f ` (topspace X) \<subseteq> topspace Y"
+    and f: "continuous_map X Y f \<or> kc_space X"
+    and YX: "\<And>K. compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}"
+  shows "proper_map X Y f"
+  unfolding proper_map_alt closed_map_def
+proof (intro conjI strip)
+  fix C
+  assume C: "closedin X C"
+  show "closedin Y (f ` C)"
+  proof (intro Y)
+    show "f ` C \<subseteq> topspace Y"
+      using C closedin_subset fim by blast
+    fix K
+    assume K: "compactin Y K"
+    define A where "A \<equiv> {x \<in> topspace X. f x \<in> K}"
+    have eq: "f ` C \<inter> K = f ` ({x \<in> topspace X. f x \<in> K} \<inter> C)"
+      using C closedin_subset by auto
+    show "compactin Y (f ` C \<inter> K)"
+      unfolding eq
+    proof (rule image_compactin)
+      show "compactin (subtopology X A) ({x \<in> topspace X. f x \<in> K} \<inter> C)"
+      proof (rule closedin_compact_space)
+        show "compact_space (subtopology X A)"
+          by (simp add: A_def K YX compact_space_subtopology)
+        show "closedin (subtopology X A) ({x \<in> topspace X. f x \<in> K} \<inter> C)"
+          using A_def C closedin_subtopology by blast
+      qed
+      have "continuous_map (subtopology X A) (subtopology Y K) f" if "kc_space X"
+        unfolding continuous_map_closedin
+      proof (intro conjI strip)
+        show "f x \<in> topspace (subtopology Y K)"
+          if "x \<in> topspace (subtopology X A)" for x
+          using that A_def K compactin_subset_topspace by auto
+      next
+        fix C
+        assume C: "closedin (subtopology Y K) C"
+        show "closedin (subtopology X A) {x \<in> topspace (subtopology X A). f x \<in> C}"
+        proof (rule compactin_imp_closedin_gen)
+          show "kc_space (subtopology X A)"
+            by (simp add: kc_space_subtopology that)
+          have [simp]: "{x \<in> topspace X. f x \<in> K \<and> f x \<in> C} = {x \<in> topspace X. f x \<in> C}"
+            using C closedin_imp_subset by auto
+          have "compactin (subtopology Y K) C"
+            by (simp add: C K closedin_compact_space compact_space_subtopology)
+          then have "compactin X {x \<in> topspace X. x \<in> A \<and> f x \<in> C}"
+            by (auto simp: A_def compactin_subtopology dest: YX)
+          then show "compactin (subtopology X A) {x \<in> topspace (subtopology X A). f x \<in> C}"
+            by (auto simp add: compactin_subtopology)
+        qed
+      qed
+      with f show "continuous_map (subtopology X A) Y f"
+        using continuous_map_from_subtopology continuous_map_in_subtopology by blast
+    qed
+  qed
+qed (simp add: YX)
+
+lemma tube_lemma_left:
+  assumes W: "openin (prod_topology X Y) W" and C: "compactin X C" 
+    and y: "y \<in> topspace Y" and subW: "C \<times> {y} \<subseteq> W"
+  shows "\<exists>U V. openin X U \<and> openin Y V \<and> C \<subseteq> U \<and> y \<in> V \<and> U \<times> V \<subseteq> W"
+proof (cases "C = {}")
+  case True
+  with y show ?thesis by auto
+next
+  case False
+  have "\<exists>U V. openin X U \<and> openin Y V \<and> x \<in> U \<and> y \<in> V \<and> U \<times> V \<subseteq> W" 
+    if "x \<in> C" for x
+    using W openin_prod_topology_alt subW subsetD that by fastforce
+  then obtain U V where UV: "\<And>x. x \<in> C \<Longrightarrow> openin X (U x) \<and> openin Y (V x) \<and> x \<in> U x \<and> y \<in> V x \<and> U x \<times> V x \<subseteq> W" 
+    by metis
+  then obtain D where D: "finite D" "D \<subseteq> C" "C \<subseteq> \<Union> (U ` D)"
+    using compactinD [OF C, of "U`C"]
+    by (smt (verit) UN_I finite_subset_image imageE subsetI)
+  show ?thesis
+  proof (intro exI conjI)
+    show "openin X (\<Union> (U ` D))" "openin Y (\<Inter> (V ` D))"
+      using D False UV by blast+
+    show "y \<in> \<Inter> (V ` D)" "C \<subseteq> \<Union> (U ` D)" "\<Union>(U ` D) \<times> \<Inter>(V ` D) \<subseteq> W"
+      using D UV by force+
+  qed
+qed
+
+lemma Wallace_theorem_prod_topology:
+  assumes "compactin X K" "compactin Y L" 
+    and W: "openin (prod_topology X Y) W" and subW: "K \<times> L \<subseteq> W"
+  obtains U V where "openin X U" "openin Y V" "K \<subseteq> U" "L \<subseteq> V" "U \<times> V \<subseteq> W"
+proof -
+  have "\<And>y. y \<in> L \<Longrightarrow> \<exists>U V. openin X U \<and> openin Y V \<and> K \<subseteq> U \<and> y \<in> V \<and> U \<times> V \<subseteq> W"
+  proof (intro tube_lemma_left assms)
+    fix y assume "y \<in> L"
+    show "y \<in> topspace Y"
+      using assms \<open>y \<in> L\<close> compactin_subset_topspace by blast 
+    show "K \<times> {y} \<subseteq> W"
+      using \<open>y \<in> L\<close> subW by force
+  qed
+  then obtain U V where UV: 
+         "\<And>y. y \<in> L \<Longrightarrow> openin X (U y) \<and> openin Y (V y) \<and> K \<subseteq> U y \<and> y \<in> V y \<and> U y \<times> V y \<subseteq> W"
+    by metis
+  then obtain M where "finite M" "M \<subseteq> L" and M: "L \<subseteq> \<Union> (V ` M)"
+    using \<open>compactin Y L\<close> unfolding compactin_def
+    by (smt (verit) UN_iff finite_subset_image imageE subset_iff)
+  show thesis
+  proof (cases "M={}")
+    case True
+    with M have "L={}"
+      by blast
+    then show ?thesis
+      using \<open>compactin X K\<close> compactin_subset_topspace that by fastforce
+  next
+    case False
+    show ?thesis
+    proof
+      show "openin X (\<Inter>(U`M))"
+        using False UV \<open>M \<subseteq> L\<close> \<open>finite M\<close> by blast
+      show "openin Y (\<Union>(V`M))"
+        using UV \<open>M \<subseteq> L\<close> by blast
+      show "K \<subseteq> \<Inter>(U`M)"
+        by (meson INF_greatest UV \<open>M \<subseteq> L\<close> subsetD)
+      show "L \<subseteq> \<Union>(V`M)"
+        by (simp add: M)
+      show "\<Inter>(U`M) \<times> \<Union>(V`M) \<subseteq> W"
+        using UV \<open>M \<subseteq> L\<close> by fastforce
+    qed   
+  qed
+qed
+
+lemma proper_map_prod:
+   "proper_map (prod_topology X Y) (prod_topology X' Y') (\<lambda>(x,y). (f x, g y)) \<longleftrightarrow>
+    topspace(prod_topology X Y) = {} \<or> proper_map X X' f \<and> proper_map Y Y' g"
+   (is "?lhs \<longleftrightarrow> _ \<or> ?rhs")
+proof (cases "topspace(prod_topology X Y) = {}")
+  case True
+  then show ?thesis
+    by (simp add: proper_map_on_empty)
+next
+  case False
+  then have ne: "topspace X \<noteq> {}" "topspace Y \<noteq> {}"
+    by auto
+  define h where "h \<equiv> \<lambda>(x,y). (f x, g y)"
+  have "proper_map X X' f" "proper_map Y Y' g" if ?lhs
+  proof -
+    have cm: "closed_map X X' f" "closed_map Y Y' g"
+      using that False closed_map_prod proper_imp_closed_map by blast+
+    show "proper_map X X' f"
+    proof (clarsimp simp add: proper_map_def cm)
+      fix y
+      assume y: "y \<in> topspace X'"
+      obtain z where z: "z \<in> topspace Y"
+        using ne by blast
+      then have eq: "{x \<in> topspace X. f x = y} =
+                     fst ` {u \<in> topspace X \<times> topspace Y. h u = (y,g z)}"
+        by (force simp: h_def)
+      show "compactin X {x \<in> topspace X. f x = y}"
+        unfolding eq
+      proof (intro image_compactin)
+        have "g z \<in> topspace Y'"
+          by (meson closed_map_def closedin_subset closedin_topspace cm image_subset_iff z)
+        with y show "compactin (prod_topology X Y) {u \<in> topspace X \<times> topspace Y. (h u) = (y, g z)}"
+          using that by (simp add: h_def proper_map_def)
+        show "continuous_map (prod_topology X Y) X fst"
+          by (simp add: continuous_map_fst)
+      qed
+    qed
+    show "proper_map Y Y' g"
+    proof (clarsimp simp add: proper_map_def cm)
+      fix y
+      assume y: "y \<in> topspace Y'"
+      obtain z where z: "z \<in> topspace X"
+        using ne by blast
+      then have eq: "{x \<in> topspace Y. g x = y} =
+                     snd ` {u \<in> topspace X \<times> topspace Y. h u = (f z,y)}"
+        by (force simp: h_def)
+      show "compactin Y {x \<in> topspace Y. g x = y}"
+        unfolding eq
+      proof (intro image_compactin)
+        have "f z \<in> topspace X'"
+          by (meson closed_map_def closedin_subset closedin_topspace cm image_subset_iff z)
+        with y show "compactin (prod_topology X Y) {u \<in> topspace X \<times> topspace Y. (h u) = (f z, y)}"
+          using that by (simp add: proper_map_def h_def)
+        show "continuous_map (prod_topology X Y) Y snd"
+          by (simp add: continuous_map_snd)
+      qed
+    qed
+  qed
+  moreover
+  { assume R: ?rhs
+    then have fgim: "f ` topspace X \<subseteq> topspace X'" "g ` topspace Y \<subseteq> topspace Y'" 
+          and cm: "closed_map X X' f" "closed_map Y Y' g"
+      by (auto simp: proper_map_def closed_map_imp_subset_topspace)
+    have "closed_map (prod_topology X Y) (prod_topology X' Y') h"
+      unfolding closed_map_fibre_neighbourhood imp_conjL
+    proof (intro conjI strip)
+      show "h ` topspace (prod_topology X Y) \<subseteq> topspace (prod_topology X' Y')"
+        unfolding h_def using fgim by auto
+      fix W w
+      assume W: "openin (prod_topology X Y) W"
+        and w: "w \<in> topspace (prod_topology X' Y')"
+        and subW: "{x \<in> topspace (prod_topology X Y). h x = w} \<subseteq> W"
+      then obtain x' y' where weq: "w = (x',y')" "x' \<in> topspace X'" "y' \<in> topspace Y'"
+        by auto
+      have eq: "{u \<in> topspace X \<times> topspace Y. h u = (x',y')} = {x \<in> topspace X. f x = x'} \<times> {y \<in> topspace Y. g y = y'}"
+        by (auto simp: h_def)
+      obtain U V where "openin X U" "openin Y V" "U \<times> V \<subseteq> W"
+        and U: "{x \<in> topspace X. f x = x'} \<subseteq> U" 
+        and V: "{x \<in> topspace Y. g x = y'} \<subseteq> V" 
+      proof (rule Wallace_theorem_prod_topology)
+        show "compactin X {x \<in> topspace X. f x = x'}" "compactin Y {x \<in> topspace Y. g x = y'}"
+          using R weq unfolding proper_map_def closed_map_fibre_neighbourhood by fastforce+
+        show "{x \<in> topspace X. f x = x'} \<times> {x \<in> topspace Y. g x = y'} \<subseteq> W"
+          using weq subW by (auto simp: h_def)
+      qed (use W in auto)
+      obtain U' where "openin X' U'" "x' \<in> U'" and U': "{x \<in> topspace X. f x \<in> U'} \<subseteq> U"
+        using cm U \<open>openin X U\<close> weq unfolding closed_map_fibre_neighbourhood by meson
+      obtain V' where "openin Y' V'" "y' \<in> V'" and V': "{x \<in> topspace Y. g x \<in> V'} \<subseteq> V"
+        using cm V \<open>openin Y V\<close> weq unfolding closed_map_fibre_neighbourhood by meson
+      show "\<exists>V. openin (prod_topology X' Y') V \<and> w \<in> V \<and> {x \<in> topspace (prod_topology X Y). h x \<in> V} \<subseteq> W"
+      proof (intro conjI exI)
+        show "openin (prod_topology X' Y') (U' \<times> V')"
+          by (simp add: \<open>openin X' U'\<close> \<open>openin Y' V'\<close> openin_prod_Times_iff)
+        show "w \<in> U' \<times> V'"
+          using \<open>x' \<in> U'\<close> \<open>y' \<in> V'\<close> weq by blast
+        show "{x \<in> topspace (prod_topology X Y). h x \<in> U' \<times> V'} \<subseteq> W"
+          using \<open>U \<times> V \<subseteq> W\<close> U' V' h_def by auto
+      qed
+    qed
+    moreover
+    have "compactin (prod_topology X Y) {u \<in> topspace X \<times> topspace Y. h u = (w, z)}"
+      if "w \<in> topspace X'" and "z \<in> topspace Y'" for w z
+    proof -
+      have eq: "{u \<in> topspace X \<times> topspace Y. h u = (w,z)} =
+                {u \<in> topspace X. f u = w} \<times> {y. y \<in> topspace Y \<and> g y = z}"
+        by (auto simp: h_def)
+      show ?thesis
+        using R that by (simp add: eq compactin_Times proper_map_def)
+    qed
+    ultimately have ?lhs
+      by (auto simp: h_def proper_map_def) 
+  }
+  ultimately show ?thesis using False by metis
+qed
+
+lemma proper_map_paired:
+  assumes "Hausdorff_space X \<and> proper_map X Y f \<and> proper_map X Z g \<or>
+        Hausdorff_space Y \<and> continuous_map X Y f \<and> proper_map X Z g \<or>
+        Hausdorff_space Z \<and> proper_map X Y f \<and> continuous_map X Z g"
+  shows "proper_map X (prod_topology Y Z) (\<lambda>x. (f x,g x))"
+  using assms
+proof (elim disjE conjE)
+  assume \<section>: "Hausdorff_space X" "proper_map X Y f" "proper_map X Z g"
+  have eq: "(\<lambda>x. (f x, g x)) = (\<lambda>(x, y). (f x, g y)) \<circ> (\<lambda>x. (x, x))"
+    by auto
+  show "proper_map X (prod_topology Y Z) (\<lambda>x. (f x, g x))"
+    unfolding eq
+  proof (rule proper_map_compose)
+    show "proper_map X (prod_topology X X) (\<lambda>x. (x,x))"
+      by (simp add: \<section>)
+    show "proper_map (prod_topology X X) (prod_topology Y Z) (\<lambda>(x,y). (f x, g y))"
+      by (simp add: \<section> proper_map_prod)
+  qed
+next
+  assume \<section>: "Hausdorff_space Y" "continuous_map X Y f" "proper_map X Z g"
+  have eq: "(\<lambda>x. (f x, g x)) = (\<lambda>(x,y). (x,g y)) \<circ> (\<lambda>x. (f x,x))"
+    by auto
+  show "proper_map X (prod_topology Y Z) (\<lambda>x. (f x, g x))"
+    unfolding eq
+  proof (rule proper_map_compose)
+    show "proper_map X (prod_topology Y X) (\<lambda>x. (f x,x))"
+      by (simp add: \<section> proper_map_paired_continuous_map_left)
+    show "proper_map (prod_topology Y X) (prod_topology Y Z) (\<lambda>(x,y). (x,g y))"
+      by (simp add: \<section> proper_map_prod proper_map_id [unfolded id_def])
+  qed
+next
+  assume \<section>: "Hausdorff_space Z" "proper_map X Y f" "continuous_map X Z g"
+  have eq: "(\<lambda>x. (f x, g x)) = (\<lambda>(x,y). (f x,y)) \<circ> (\<lambda>x. (x,g x))"
+    by auto
+  show "proper_map X (prod_topology Y Z) (\<lambda>x. (f x, g x))"
+    unfolding eq
+  proof (rule proper_map_compose)
+    show "proper_map X (prod_topology X Z) (\<lambda>x. (x, g x))"
+      using \<section> proper_map_paired_continuous_map_right by auto
+    show "proper_map (prod_topology X Z) (prod_topology Y Z) (\<lambda>(x,y). (f x,y))"
+      by (simp add: \<section> proper_map_prod proper_map_id [unfolded id_def])
+  qed
+qed
+
+lemma proper_map_pairwise:
+  assumes
+    "Hausdorff_space X \<and> proper_map X Y (fst \<circ> f) \<and> proper_map X Z (snd \<circ> f) \<or>
+     Hausdorff_space Y \<and> continuous_map X Y (fst \<circ> f) \<and> proper_map X Z (snd \<circ> f) \<or>
+     Hausdorff_space Z \<and> proper_map X Y (fst \<circ> f) \<and> continuous_map X Z (snd \<circ> f)"
+  shows "proper_map X (prod_topology Y Z) f"
+  using proper_map_paired [OF assms] by (simp add: o_def)
+
+lemma proper_map_from_composition_right:
+  assumes "Hausdorff_space Y" "proper_map X Z (g \<circ> f)" and "continuous_map X Y f"
+    and contg: "continuous_map Y Z g"
+  shows "proper_map X Y f"
+proof -
+  define YZ where "YZ \<equiv> subtopology (prod_topology Y Z) ((\<lambda>x. (x, g x)) ` topspace Y)"
+  have "proper_map X Y (fst \<circ> (\<lambda>x. (f x, (g \<circ> f) x)))"
+  proof (rule proper_map_compose)
+    have [simp]: "x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y" for x
+      by (meson assms(3) continuous_map_def)
+    show "proper_map X YZ (\<lambda>x. (f x, (g \<circ> f) x))"
+      unfolding YZ_def
+      using assms
+      by (force intro!: proper_map_into_subtopology proper_map_paired simp: o_def image_iff)+
+    show "proper_map YZ Y fst"
+      using contg 
+      by (simp flip: homeomorphic_maps_graph add: YZ_def homeomorphic_maps_map homeomorphic_imp_proper_map)
+  qed
+  moreover have "fst \<circ> (\<lambda>x. (f x, (g \<circ> f) x)) = f"
+    by auto
+  ultimately show ?thesis
+    by auto
+qed
+
+lemma perfect_map_from_composition_right:
+   "\<lbrakk>Hausdorff_space Y; perfect_map X Z (g \<circ> f);
+     continuous_map X Y f; continuous_map Y Z g; f ` topspace X = topspace Y\<rbrakk>
+    \<Longrightarrow> perfect_map X Y f"
+  by (meson perfect_map_def proper_map_from_composition_right)
+
+lemma perfect_map_from_composition_right_inj:
+   "\<lbrakk>perfect_map X Z (g \<circ> f); f ` topspace X = topspace Y;
+     continuous_map X Y f; continuous_map Y Z g; inj_on g (topspace Y)\<rbrakk>
+    \<Longrightarrow> perfect_map X Y f"
+  by (meson continuous_map_image_subset_topspace perfect_map_def proper_map_from_composition_right_inj)
+
 
 subsection \<open>Regular spaces\<close>
 
 text \<open>Regular spaces are *not* a priori assumed to be Hausdorff or $T_1$\<close>
 
 definition regular_space 
   where "regular_space X \<equiv>
         \<forall>C a. closedin X C \<and> a \<in> topspace X - C
                 \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V)"
 
 lemma homeomorphic_regular_space_aux:
   assumes hom: "X homeomorphic_space Y" and X: "regular_space X"
   shows "regular_space Y"
 proof -
   obtain f g where hmf: "homeomorphic_map X Y f" and hmg: "homeomorphic_map Y X g"
     and fg: "(\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
     using assms X homeomorphic_maps_map homeomorphic_space_def by fastforce
   show ?thesis
     unfolding regular_space_def
   proof clarify
     fix C a
     assume Y: "closedin Y C" "a \<in> topspace Y" and "a \<notin> C"
     then obtain "closedin X (g ` C)" "g a \<in> topspace X" "g a \<notin> g ` C"
       using \<open>closedin Y C\<close> hmg homeomorphic_map_closedness_eq
       by (smt (verit, ccfv_SIG) fg homeomorphic_imp_surjective_map image_iff in_mono) 
     then obtain S T where ST: "openin X S" "openin X T" "g a \<in> S" "g`C \<subseteq> T" "disjnt S T"
       using X unfolding regular_space_def by (metis DiffI)
     then have "openin Y (f`S)" "openin Y (f`T)"
       by (meson hmf homeomorphic_map_openness_eq)+
     moreover have "a \<in> f`S \<and> C \<subseteq> f`T"
       using ST by (smt (verit, best) Y closedin_subset fg image_eqI subset_iff)   
     moreover have "disjnt (f`S) (f`T)"
       using ST by (smt (verit, ccfv_SIG) disjnt_iff fg image_iff openin_subset subsetD)
     ultimately show "\<exists>U V. openin Y U \<and> openin Y V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V"
       by metis
   qed
 qed
 
 lemma homeomorphic_regular_space:
    "X homeomorphic_space Y
         \<Longrightarrow> (regular_space X \<longleftrightarrow> regular_space Y)"
   by (meson homeomorphic_regular_space_aux homeomorphic_space_sym)
 
 lemma regular_space:
    "regular_space X \<longleftrightarrow>
         (\<forall>C a. closedin X C \<and> a \<in> topspace X - C
               \<longrightarrow> (\<exists>U. openin X U \<and> a \<in> U \<and> disjnt C (X closure_of U)))"
   unfolding regular_space_def
 proof (intro all_cong1 imp_cong refl ex_cong1)
   fix C a U
   assume C: "closedin X C \<and> a \<in> topspace X - C"
   show "(\<exists>V. openin X U \<and> openin X V \<and> a \<in> U \<and> C \<subseteq> V \<and> disjnt U V)  
     \<longleftrightarrow> (openin X U \<and> a \<in> U \<and> disjnt C (X closure_of U))" (is "?lhs=?rhs")
   proof
     assume ?lhs
     then show ?rhs
       by (smt (verit, best) disjnt_iff in_closure_of subsetD)
   next
     assume R: ?rhs
     then have "disjnt U (topspace X - X closure_of U)"
       by (meson DiffD2 closure_of_subset disjnt_iff openin_subset subsetD)
     moreover have "C \<subseteq> topspace X - X closure_of U"
       by (meson C DiffI R closedin_subset disjnt_iff subset_eq)
     ultimately show ?lhs
       using R by (rule_tac x="topspace X - X closure_of U" in exI) auto
     qed
 qed
 
 lemma neighbourhood_base_of_closedin:
   "neighbourhood_base_of (closedin X) X \<longleftrightarrow> regular_space X" (is "?lhs=?rhs")
 proof -
   have "?lhs \<longleftrightarrow> (\<forall>W x. openin X W \<and> x \<in> W \<longrightarrow>
                   (\<exists>U. openin X U \<and> (\<exists>V. closedin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W)))"
     by (simp add: neighbourhood_base_of)
   also have "\<dots> \<longleftrightarrow> (\<forall>W x. closedin X W \<and> x \<in> topspace X - W \<longrightarrow>
                      (\<exists>U. openin X U \<and> (\<exists>V. closedin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> topspace X - W)))"
     by (smt (verit) Diff_Diff_Int closedin_def inf.absorb_iff2 openin_closedin_eq)
   also have "\<dots> \<longleftrightarrow> ?rhs"
   proof -
     have \<section>: "(\<exists>V. closedin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> topspace X - W) 
          \<longleftrightarrow> (\<exists>V. openin X V \<and> x \<in> U \<and> W \<subseteq> V \<and> disjnt U V)" (is "?lhs=?rhs")
       if "openin X U"  "closedin X W" "x \<in> topspace X" "x \<notin> W" for W U x
     proof
       assume ?lhs with \<open>closedin X W\<close> show ?rhs
         unfolding closedin_def by (smt (verit) Diff_mono disjnt_Diff1 double_diff subset_eq)
     next
       assume ?rhs with \<open>openin X U\<close> show ?lhs
         unfolding openin_closedin_eq disjnt_def
         by (smt (verit) Diff_Diff_Int Diff_disjoint Diff_eq_empty_iff Int_Diff inf.orderE)
     qed
     show ?thesis
       unfolding regular_space_def
       by (intro all_cong1 ex_cong1 imp_cong refl) (metis \<section> DiffE)
   qed
   finally show ?thesis .
 qed
 
 lemma regular_space_discrete_topology:
    "regular_space (discrete_topology S)"
   using neighbourhood_base_of_closedin neighbourhood_base_of_discrete_topology by fastforce
 
 lemma regular_space_subtopology:
  "regular_space X \<Longrightarrow> regular_space (subtopology X S)"
   unfolding regular_space_def openin_subtopology_alt closedin_subtopology_alt disjnt_iff
   by clarsimp (smt (verit, best) inf.orderE inf_le1 le_inf_iff)
 
 
 lemma regular_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; regular_space X\<rbrakk> \<Longrightarrow> regular_space Y"
   using hereditary_imp_retractive_property homeomorphic_regular_space regular_space_subtopology by blast
 
 lemma regular_t0_imp_Hausdorff_space:
    "\<lbrakk>regular_space X; t0_space X\<rbrakk> \<Longrightarrow> Hausdorff_space X"
   apply (clarsimp simp: regular_space_def t0_space Hausdorff_space_def)
   by (metis disjnt_sym subsetD)
 
 lemma regular_t0_eq_Hausdorff_space:
    "regular_space X \<Longrightarrow> (t0_space X \<longleftrightarrow> Hausdorff_space X)"
   using Hausdorff_imp_t0_space regular_t0_imp_Hausdorff_space by blast
 
 lemma regular_t1_imp_Hausdorff_space:
    "\<lbrakk>regular_space X; t1_space X\<rbrakk> \<Longrightarrow> Hausdorff_space X"
   by (simp add: regular_t0_imp_Hausdorff_space t1_imp_t0_space)
 
 lemma regular_t1_eq_Hausdorff_space:
    "regular_space X \<Longrightarrow> t1_space X \<longleftrightarrow> Hausdorff_space X"
   using regular_t0_imp_Hausdorff_space t1_imp_t0_space t1_or_Hausdorff_space by blast
 
 lemma compact_Hausdorff_imp_regular_space:
   assumes "compact_space X" "Hausdorff_space X"
   shows "regular_space X"
   unfolding regular_space_def
 proof clarify
   fix S a
   assume "closedin X S" and "a \<in> topspace X" and "a \<notin> S"
   then show "\<exists>U V. openin X U \<and> openin X V \<and> a \<in> U \<and> S \<subseteq> V \<and> disjnt U V"
     using assms unfolding Hausdorff_space_compact_sets
     by (metis closedin_compact_space compactin_sing disjnt_empty1 insert_subset disjnt_insert1)
 qed
 
 lemma regular_space_topspace_empty: "topspace X = {} \<Longrightarrow> regular_space X"
   by (simp add: Hausdorff_space_topspace_empty compact_Hausdorff_imp_regular_space compact_space_topspace_empty)
 
 lemma neighbourhood_base_of_closed_Hausdorff_space:
    "regular_space X \<and> Hausdorff_space X \<longleftrightarrow>
     neighbourhood_base_of (\<lambda>C. closedin X C \<and> Hausdorff_space(subtopology X C)) X" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (simp add: Hausdorff_space_subtopology neighbourhood_base_of_closedin)
 next
   assume ?rhs then show ?lhs
   by (metis (mono_tags, lifting) Hausdorff_space_closed_neighbourhood neighbourhood_base_of neighbourhood_base_of_closedin openin_topspace)
 qed
 
 lemma locally_compact_imp_kc_eq_Hausdorff_space:
    "neighbourhood_base_of (compactin X) X \<Longrightarrow> kc_space X \<longleftrightarrow> Hausdorff_space X"
   by (metis Hausdorff_imp_kc_space kc_imp_t1_space kc_space_def neighbourhood_base_of_closedin neighbourhood_base_of_mono regular_t1_imp_Hausdorff_space)
 
 lemma regular_space_compact_closed_separation:
   assumes X: "regular_space X"
       and S: "compactin X S"
       and T: "closedin X T"
       and "disjnt S T"
     shows "\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
 proof (cases "S={}")
   case True
   then show ?thesis
     by (meson T closedin_def disjnt_empty1 empty_subsetI openin_empty openin_topspace)
 next
   case False
   then have "\<exists>U V. x \<in> S \<longrightarrow> openin X U \<and> openin X V \<and> x \<in> U \<and> T \<subseteq> V \<and> disjnt U V" for x
     using assms unfolding regular_space_def
     by (smt (verit) Diff_iff compactin_subset_topspace disjnt_iff subsetD)
   then obtain U V where UV: "\<And>x. x \<in> S \<Longrightarrow> openin X (U x) \<and> openin X (V x) \<and> x \<in> (U x) \<and> T \<subseteq> (V x) \<and> disjnt (U x) (V x)" 
     by metis
   then obtain \<F> where "finite \<F>" "\<F> \<subseteq> U ` S" "S \<subseteq> \<Union> \<F>"
     using S unfolding compactin_def by (smt (verit) UN_iff image_iff subsetI)
   then obtain K where "finite K" "K \<subseteq> S" and K: "S \<subseteq> \<Union>(U ` K)"
     by (metis finite_subset_image)
   show ?thesis 
   proof (intro exI conjI)
     show "openin X (\<Union>(U ` K))"
       using \<open>K \<subseteq> S\<close> UV by blast
     show "openin X (\<Inter>(V ` K))"
       using False K UV \<open>K \<subseteq> S\<close> \<open>finite K\<close> by blast
     show "S \<subseteq> \<Union>(U ` K)"
       by (simp add: K)
     show "T \<subseteq> \<Inter>(V ` K)"
       using UV \<open>K \<subseteq> S\<close> by blast
     show "disjnt (\<Union>(U ` K)) (\<Inter>(V ` K))"
       by (smt (verit) Inter_iff UN_E UV \<open>K \<subseteq> S\<close> disjnt_iff image_eqI subset_iff)
   qed
 qed
 
 lemma regular_space_compact_closed_sets:
    "regular_space X \<longleftrightarrow>
         (\<forall>S T. compactin X S \<and> closedin X T \<and> disjnt S T
            \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V))" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     using regular_space_compact_closed_separation by fastforce
 next
   assume R: ?rhs
   show ?lhs
     unfolding regular_space
   proof clarify
     fix S x
     assume "closedin X S" and "x \<in> topspace X" and "x \<notin> S"
     then obtain U V where "openin X U \<and> openin X V \<and> {x} \<subseteq> U \<and> S \<subseteq> V \<and> disjnt U V"
       by (metis R compactin_sing disjnt_empty1 disjnt_insert1)
     then show "\<exists>U. openin X U \<and> x \<in> U \<and> disjnt S (X closure_of U)"
       by (smt (verit, best) disjnt_iff in_closure_of insert_subset subsetD)
   qed
 qed
 
 
 lemma regular_space_prod_topology:
    "regular_space (prod_topology X Y) \<longleftrightarrow>
         topspace X = {} \<or> topspace Y = {} \<or> regular_space X \<and> regular_space Y" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis regular_space_retraction_map_image retraction_map_fst retraction_map_snd)
 next
   assume R: ?rhs  
   show ?lhs
   proof (cases "topspace X = {} \<or> topspace Y = {}")
     case True
     then show ?thesis
       by (simp add: regular_space_topspace_empty)
   next
     case False
     then have "regular_space X" "regular_space Y"
       using R by auto
     show ?thesis
       unfolding neighbourhood_base_of_closedin [symmetric] neighbourhood_base_of
     proof clarify
       fix W x y
       assume W: "openin (prod_topology X Y) W" and "(x,y) \<in> W"
       then obtain U V where U: "openin X U" "x \<in> U" and V: "openin Y V" "y \<in> V" 
         and "U \<times> V \<subseteq> W"
         by (metis openin_prod_topology_alt)
       obtain D1 C1 where 1: "openin X D1" "closedin X C1" "x \<in> D1" "D1 \<subseteq> C1" "C1 \<subseteq> U"
         by (metis \<open>regular_space X\<close> U neighbourhood_base_of neighbourhood_base_of_closedin)
       obtain D2 C2 where 2: "openin Y D2" "closedin Y C2" "y \<in> D2" "D2 \<subseteq> C2" "C2 \<subseteq> V"
         by (metis \<open>regular_space Y\<close> V neighbourhood_base_of neighbourhood_base_of_closedin)
       show "\<exists>U V. openin (prod_topology X Y) U \<and> closedin (prod_topology X Y) V \<and>
                   (x,y) \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
       proof (intro conjI exI)
         show "openin (prod_topology X Y) (D1 \<times> D2)"
           by (simp add: 1 2 openin_prod_Times_iff)
         show "closedin (prod_topology X Y) (C1 \<times> C2)"
           by (simp add: 1 2 closedin_prod_Times_iff)
       qed (use 1 2 \<open>U \<times> V \<subseteq> W\<close> in auto)
     qed
   qed
 qed
 
 lemma regular_space_product_topology:
    "regular_space (product_topology X I) \<longleftrightarrow>
     topspace (product_topology X I) = {} \<or> (\<forall>i \<in> I. regular_space (X i))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson regular_space_retraction_map_image retraction_map_product_projection)
 next
   assume R: ?rhs  
   show ?lhs
   proof (cases "topspace(product_topology X I) = {}")
     case True
     then show ?thesis
       by (simp add: regular_space_topspace_empty)
   next
     case False
     then obtain x where x: "x \<in> topspace (product_topology X I)"
       by blast
     define \<F> where "\<F> \<equiv> {Pi\<^sub>E I U |U. finite {i \<in> I. U i \<noteq> topspace (X i)}
                         \<and> (\<forall>i\<in>I. openin (X i) (U i))}"
     have oo: "openin (product_topology X I) = arbitrary union_of (\<lambda>W. W \<in> \<F>)"
       by (simp add: \<F>_def openin_product_topology product_topology_base_alt)
     have "\<exists>U V. openin (product_topology X I) U \<and> closedin (product_topology X I) V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> Pi\<^sub>E I W"
       if fin: "finite {i \<in> I. W i \<noteq> topspace (X i)}" 
         and opeW: "\<And>k. k \<in> I \<Longrightarrow> openin (X k) (W k)" and x: "x \<in> PiE I W" for W x
     proof -
       have "\<And>i. i \<in> I \<Longrightarrow> \<exists>U V. openin (X i) U \<and> closedin (X i) V \<and> x i \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W i"
         by (metis False PiE_iff R neighbourhood_base_of neighbourhood_base_of_closedin opeW x)
       then obtain U C where UC: 
         "\<And>i. i \<in> I \<Longrightarrow> openin (X i) (U i) \<and> closedin (X i) (C i) \<and> x i \<in> U i \<and> U i \<subseteq> C i \<and> C i \<subseteq> W i"
         by metis
       define PI where "PI \<equiv> \<lambda>V. PiE I (\<lambda>i. if W i = topspace(X i) then topspace(X i) else V i)"
       show ?thesis
       proof (intro conjI exI)
         have "\<forall>i\<in>I. W i \<noteq> topspace (X i) \<longrightarrow> openin (X i) (U i)"
           using UC by force
         with fin show "openin (product_topology X I) (PI U)"
           by (simp add: Collect_mono_iff PI_def openin_PiE_gen rev_finite_subset)
         show "closedin (product_topology X I) (PI C)"
           by (simp add: UC closedin_product_topology PI_def)
         show "x \<in> PI U"
           using UC x by (fastforce simp: PI_def)
         show "PI U \<subseteq> PI C"
           by (smt (verit) UC Orderings.order_eq_iff PiE_mono PI_def)
         show "PI C \<subseteq> Pi\<^sub>E I W"
           by (simp add: UC PI_def subset_PiE)
       qed
     qed
     then have "neighbourhood_base_of (closedin (product_topology X I)) (product_topology X I)"
       unfolding neighbourhood_base_of_topology_base [OF oo] by (force simp: \<F>_def)
     then show ?thesis
       by (simp add: neighbourhood_base_of_closedin)
   qed
 qed
 
 lemma closed_map_paired_gen_aux:
   assumes "regular_space Y" and f: "closed_map Z X f" and g: "closed_map Z Y g"
     and clo: "\<And>y. y \<in> topspace X \<Longrightarrow> closedin Z {x \<in> topspace Z. f x = y}"
     and contg: "continuous_map Z Y g"
   shows "closed_map Z (prod_topology X Y) (\<lambda>x. (f x, g x))"
   unfolding closed_map_def
 proof (intro strip)
   fix C assume "closedin Z C"
   then have "C \<subseteq> topspace Z"
     by (simp add: closedin_subset)
   have "f ` topspace Z \<subseteq> topspace X" "g ` topspace Z \<subseteq> topspace Y"
     by (simp_all add: assms closed_map_imp_subset_topspace)
   show "closedin (prod_topology X Y) ((\<lambda>x. (f x, g x)) ` C)"
     unfolding closedin_def topspace_prod_topology
   proof (intro conjI)
     have "closedin Y (g ` C)"
       using \<open>closedin Z C\<close> assms(3) closed_map_def by blast
     with assms show "(\<lambda>x. (f x, g x)) ` C \<subseteq> topspace X \<times> topspace Y"
       using \<open>C \<subseteq> topspace Z\<close> \<open>f ` topspace Z \<subseteq> topspace X\<close> continuous_map_closedin subsetD by fastforce
     have *: "\<exists>T. openin (prod_topology X Y) T \<and> (y1,y2) \<in> T \<and> T \<subseteq> topspace X \<times> topspace Y - (\<lambda>x. (f x, g x)) ` C"
       if "(y1,y2) \<notin> (\<lambda>x. (f x, g x)) ` C" and y1: "y1 \<in> topspace X" and y2: "y2 \<in> topspace Y"
       for y1 y2
     proof -
       define A where "A \<equiv> topspace Z - (C \<inter> {x \<in> topspace Z. f x = y1})"
       have A: "openin Z A" "{x \<in> topspace Z. g x = y2} \<subseteq> A"
         using that \<open>closedin Z C\<close> clo that(2) by (auto simp: A_def)
       obtain V0 where "openin Y V0 \<and> y2 \<in> V0" and UA: "{x \<in> topspace Z. g x \<in> V0} \<subseteq> A"
         using g A y2 unfolding closed_map_fibre_neighbourhood by blast
       then obtain V V' where VV: "openin Y V \<and> closedin Y V' \<and> y2 \<in> V \<and> V \<subseteq> V'" and "V' \<subseteq> V0"
         by (metis (no_types, lifting) \<open>regular_space Y\<close> neighbourhood_base_of neighbourhood_base_of_closedin)
       with UA have subA: "{x \<in> topspace Z. g x \<in> V'} \<subseteq> A"
         by blast
       show ?thesis
       proof -
         define B where "B \<equiv> topspace Z - (C \<inter> {x \<in> topspace Z. g x \<in> V'})"
         have "openin Z B"
           using VV \<open>closedin Z C\<close> contg by (fastforce simp: B_def continuous_map_closedin)
         have "{x \<in> topspace Z. f x = y1} \<subseteq> B"
           using A_def subA by (auto simp: A_def B_def)
         then obtain U where "openin X U" "y1 \<in> U" and subB: "{x \<in> topspace Z. f x \<in> U} \<subseteq> B"
           using \<open>openin Z B\<close> y1 f unfolding closed_map_fibre_neighbourhood by meson
         show ?thesis
         proof (intro conjI exI)
           show "openin (prod_topology X Y) (U \<times> V)"
             by (metis VV \<open>openin X U\<close> openin_prod_Times_iff)
           show "(y1, y2) \<in> U \<times> V"
             by (simp add: VV \<open>y1 \<in> U\<close>)
           show "U \<times> V \<subseteq> topspace X \<times> topspace Y - (\<lambda>x. (f x, g x)) ` C"
             using VV \<open>C \<subseteq> topspace Z\<close> \<open>openin X U\<close> subB
             by (force simp: image_iff B_def subset_iff dest: openin_subset)
         qed
       qed
     qed
     then show "openin (prod_topology X Y) (topspace X \<times> topspace Y - (\<lambda>x. (f x, g x)) ` C)"
       by (smt (verit, ccfv_threshold) Diff_iff SigmaE openin_subopen)
   qed
 qed
 
 
 lemma closed_map_paired_gen:
   assumes f: "closed_map Z X f" and g: "closed_map Z Y g"
   and D: "(regular_space X \<and> continuous_map Z X f \<and> (\<forall>z \<in> topspace Y. closedin Z {x \<in> topspace Z. g x = z})
          \<or> regular_space Y \<and> continuous_map Z Y g \<and> (\<forall>y \<in> topspace X. closedin Z {x \<in> topspace Z. f x = y}))"
          (is "?RSX \<or> ?RSY")
        shows "closed_map Z (prod_topology X Y) (\<lambda>x. (f x, g x))"
   using D
 proof
   assume RSX: ?RSX
   have eq: "(\<lambda>x. (f x, g x)) = (\<lambda>(x,y). (y,x)) \<circ> (\<lambda>x. (g x, f x))"
     by auto
   show ?thesis
     unfolding eq
   proof (rule closed_map_compose)
     show "closed_map Z (prod_topology Y X) (\<lambda>x. (g x, f x))"
       using RSX closed_map_paired_gen_aux f g by fastforce
     show "closed_map (prod_topology Y X) (prod_topology X Y) (\<lambda>(x, y). (y, x))"
       using homeomorphic_imp_closed_map homeomorphic_map_swap by blast
   qed
 qed (blast intro: assms closed_map_paired_gen_aux)
 
 lemma closed_map_paired:
   assumes "closed_map Z X f" and contf: "continuous_map Z X f"
           "closed_map Z Y g" and contg: "continuous_map Z Y g"
   and D: "t1_space X \<and> regular_space Y \<or> regular_space X \<and> t1_space Y"
   shows "closed_map Z (prod_topology X Y) (\<lambda>x. (f x, g x))"
 proof (rule closed_map_paired_gen)
   show "regular_space X \<and> continuous_map Z X f \<and> (\<forall>z\<in>topspace Y. closedin Z {x \<in> topspace Z. g x = z}) \<or> regular_space Y \<and> continuous_map Z Y g \<and> (\<forall>y\<in>topspace X. closedin Z {x \<in> topspace Z. f x = y})"
     using D contf contg
     by (smt (verit, del_insts) Collect_cong closedin_continuous_map_preimage t1_space_closedin_singleton singleton_iff)
 qed (use assms in auto)
 
 lemma closed_map_pairwise:
   assumes  "closed_map Z X (fst \<circ> f)" "continuous_map Z X (fst \<circ> f)"
     "closed_map Z Y (snd \<circ> f)" "continuous_map Z Y (snd \<circ> f)"
     "t1_space X \<and> regular_space Y \<or> regular_space X \<and> t1_space Y"
   shows "closed_map Z (prod_topology X Y) f"
 proof -
   have "closed_map Z (prod_topology X Y) (\<lambda>a. ((fst \<circ> f) a, (snd \<circ> f) a))"
     using assms closed_map_paired by blast
   then show ?thesis
     by auto
 qed
 
+lemma continuous_imp_proper_map:
+   "\<lbrakk>compact_space X; kc_space Y; continuous_map X Y f\<rbrakk> \<Longrightarrow> proper_map X Y f"
+  by (simp add: continuous_closed_imp_proper_map continuous_imp_closed_map_gen kc_imp_t1_space)
+
 
 lemma tube_lemma_right:
   assumes W: "openin (prod_topology X Y) W" and C: "compactin Y C" 
     and x: "x \<in> topspace X" and subW: "{x} \<times> C \<subseteq> W"
   shows "\<exists>U V. openin X U \<and> openin Y V \<and> x \<in> U \<and> C \<subseteq> V \<and> U \<times> V \<subseteq> W"
 proof (cases "C = {}")
   case True
   with x show ?thesis by auto
 next
   case False
   have "\<exists>U V. openin X U \<and> openin Y V \<and> x \<in> U \<and> y \<in> V \<and> U \<times> V \<subseteq> W" 
     if "y \<in> C" for y
     using W openin_prod_topology_alt subW subsetD that by fastforce
   then obtain U V where UV: "\<And>y. y \<in> C \<Longrightarrow> openin X (U y) \<and> openin Y (V y) \<and> x \<in> U y \<and> y \<in> V y \<and> U y \<times> V y \<subseteq> W" 
     by metis
   then obtain D where D: "finite D" "D \<subseteq> C" "C \<subseteq> \<Union> (V ` D)"
     using compactinD [OF C, of "V`C"]
     by (smt (verit) UN_I finite_subset_image imageE subsetI)
   show ?thesis
   proof (intro exI conjI)
     show "openin X (\<Inter> (U ` D))" "openin Y (\<Union> (V ` D))"
       using D False UV by blast+
     show "x \<in> \<Inter> (U ` D)" "C \<subseteq> \<Union> (V ` D)" "\<Inter> (U ` D) \<times> \<Union> (V ` D) \<subseteq> W"
       using D UV by force+
   qed
 qed
 
 
 lemma closed_map_fst:
   assumes "compact_space Y"
   shows "closed_map (prod_topology X Y) X fst"
 proof -
   have *: "{x \<in> topspace X \<times> topspace Y. fst x \<in> U} = U \<times> topspace Y"
     if "U \<subseteq> topspace X" for U
     using that by force
   have **: "\<And>U y. \<lbrakk>openin (prod_topology X Y) U; y \<in> topspace X;
             {x \<in> topspace X \<times> topspace Y. fst x = y} \<subseteq> U\<rbrakk>
            \<Longrightarrow> \<exists>V. openin X V \<and> y \<in> V \<and> V \<times> topspace Y \<subseteq> U"
-    using tube_lemma_right[of X Y _ "topspace Y"] assms compact_space_def
-    by force
+    using tube_lemma_right[of X Y _ "topspace Y"] assms by (fastforce simp: compact_space_def)
   show ?thesis
     unfolding closed_map_fibre_neighbourhood
     by (force simp: * openin_subset cong: conj_cong intro: **)
 qed
 
 lemma closed_map_snd:
   assumes "compact_space X"
   shows "closed_map (prod_topology X Y) Y snd"
 proof -
   have "snd = fst o prod.swap"
     by force
   moreover have "closed_map (prod_topology X Y) Y (fst o prod.swap)"
   proof (rule closed_map_compose)
     show "closed_map (prod_topology X Y) (prod_topology Y X) prod.swap"
       by (metis (no_types, lifting) homeomorphic_imp_closed_map homeomorphic_map_eq homeomorphic_map_swap prod.swap_def split_beta)
     show "closed_map (prod_topology Y X) Y fst"
       by (simp add: closed_map_fst assms)
   qed
   ultimately show ?thesis
     by metis
 qed
 
 lemma closed_map_paired_closed_map_right:
    "\<lbrakk>closed_map X Y f; regular_space X;
      \<And>y. y \<in> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x = y}\<rbrakk>
     \<Longrightarrow> closed_map X (prod_topology X Y) (\<lambda>x. (x, f x))"
   by (rule closed_map_paired_gen [OF closed_map_id, unfolded id_def]) auto
 
 lemma closed_map_paired_closed_map_left:
   assumes "closed_map X Y f"  "regular_space X"
     "\<And>y. y \<in> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x = y}"
   shows "closed_map X (prod_topology Y X) (\<lambda>x. (f x, x))"
 proof -
   have eq: "(\<lambda>x. (f x, x)) = (\<lambda>(x,y). (y,x)) \<circ> (\<lambda>x. (x, f x))"
     by auto
   show ?thesis
     unfolding eq
   proof (rule closed_map_compose)
     show "closed_map X (prod_topology X Y) (\<lambda>x. (x, f x))"
       by (simp add: assms closed_map_paired_closed_map_right)
     show "closed_map (prod_topology X Y) (prod_topology Y X) (\<lambda>(x, y). (y, x))"
       using homeomorphic_imp_closed_map homeomorphic_map_swap by blast
   qed
 qed
 
 lemma closed_map_imp_closed_graph:
   assumes "closed_map X Y f" "regular_space X"
           "\<And>y. y \<in> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x = y}"
   shows "closedin (prod_topology X Y) ((\<lambda>x. (x, f x)) ` topspace X)"
   using assms closed_map_def closed_map_paired_closed_map_right by blast
 
 lemma proper_map_paired_closed_map_right:
   assumes "closed_map X Y f" "regular_space X"
     "\<And>y. y \<in> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x = y}"
   shows "proper_map X (prod_topology X Y) (\<lambda>x. (x, f x))"
   by (simp add: assms closed_injective_imp_proper_map inj_on_def closed_map_paired_closed_map_right)
 
 lemma proper_map_paired_closed_map_left:
   assumes "closed_map X Y f" "regular_space X"
     "\<And>y. y \<in> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x = y}"
   shows "proper_map X (prod_topology Y X) (\<lambda>x. (f x, x))"
   by (simp add: assms closed_injective_imp_proper_map inj_on_def closed_map_paired_closed_map_left)
 
 proposition regular_space_continuous_proper_map_image:
   assumes "regular_space X" and contf: "continuous_map X Y f" and pmapf: "proper_map X Y f"
     and fim: "f ` (topspace X) = topspace Y"
   shows "regular_space Y"
   unfolding regular_space_def
 proof clarify
   fix C y
   assume "closedin Y C" and "y \<in> topspace Y" and "y \<notin> C"
   have "closed_map X Y f" "(\<forall>y \<in> topspace Y. compactin X {x \<in> topspace X. f x = y})"
     using pmapf proper_map_def by force+
   moreover have "closedin X {z \<in> topspace X. f z \<in> C}"
     using \<open>closedin Y C\<close> contf continuous_map_closedin by fastforce
   moreover have "disjnt {z \<in> topspace X. f z = y} {z \<in> topspace X. f z \<in> C}"
     using \<open>y \<notin> C\<close> disjnt_iff by blast
   ultimately
   obtain U V where UV: "openin X U" "openin X V" "{z \<in> topspace X. f z = y} \<subseteq> U" "{z \<in> topspace X. f z \<in> C} \<subseteq> V"
                   and dUV: "disjnt U V"
     using \<open>y \<in> topspace Y\<close> \<open>regular_space X\<close> unfolding regular_space_compact_closed_sets
     by meson
 
   have *: "\<And>U T. openin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U \<longrightarrow>
          (\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U)"
    using \<open>closed_map X Y f\<close> unfolding closed_map_preimage_neighbourhood by blast
   obtain V1 where V1: "openin Y V1 \<and> y \<in> V1" and sub1: "{x \<in> topspace X. f x \<in> V1} \<subseteq> U"
     using * [of U "{y}"] UV \<open>y \<in> topspace Y\<close> by auto
   moreover
   obtain V2 where "openin Y V2 \<and> C \<subseteq> V2" and sub2: "{x \<in> topspace X. f x \<in> V2} \<subseteq> V"
     by (smt (verit, ccfv_SIG) * UV \<open>closedin Y C\<close> closedin_subset mem_Collect_eq subset_iff)
   moreover have "disjnt V1 V2"
   proof -
     have "\<And>x. \<lbrakk>\<forall>x. x \<in> U \<longrightarrow> x \<notin> V; x \<in> V1; x \<in> V2\<rbrakk> \<Longrightarrow> False"
       by (smt (verit) V1 fim image_iff mem_Collect_eq openin_subset sub1 sub2 subsetD)
     with dUV show ?thesis by (auto simp: disjnt_iff)
   qed
   ultimately show "\<exists>U V. openin Y U \<and> openin Y V \<and> y \<in> U \<and> C \<subseteq> V \<and> disjnt U V"
     by meson
 qed
 
 lemma regular_space_perfect_map_image:
    "\<lbrakk>regular_space X; perfect_map X Y f\<rbrakk> \<Longrightarrow> regular_space Y"
   by (meson perfect_map_def regular_space_continuous_proper_map_image)
 
 proposition regular_space_perfect_map_image_eq:
   assumes "Hausdorff_space X" and perf: "perfect_map X Y f"
   shows "regular_space X \<longleftrightarrow> regular_space Y" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     using perf regular_space_perfect_map_image by blast
 next
   assume R: ?rhs  
   have "continuous_map X Y f" "proper_map X Y f" and fim: "f ` (topspace X) = topspace Y"
     using perf by (auto simp: perfect_map_def)
   then have "closed_map X Y f" and preYf: "(\<forall>y \<in> topspace Y. compactin X {x \<in> topspace X. f x = y})"
     by (simp_all add: proper_map_def)
   show ?lhs
     unfolding regular_space_def
   proof clarify
     fix C x
     assume "closedin X C" and "x \<in> topspace X" and "x \<notin> C"
     obtain U1 U2 where "openin X U1" "openin X U2" "{x} \<subseteq> U1" and "disjnt U1 U2"
       and subV: "C \<inter> {z \<in> topspace X. f z = f x} \<subseteq> U2"
     proof (rule Hausdorff_space_compact_separation [of X "{x}" "C \<inter> {z \<in> topspace X. f z = f x}", OF \<open>Hausdorff_space X\<close>])
       show "compactin X {x}"
         by (simp add: \<open>x \<in> topspace X\<close>)
       show "compactin X (C \<inter> {z \<in> topspace X. f z = f x})"
         using \<open>closedin X C\<close> fim \<open>x \<in> topspace X\<close> closed_Int_compactin preYf by fastforce
       show "disjnt {x} (C \<inter> {z \<in> topspace X. f z = f x})"
         using \<open>x \<notin> C\<close> by force
     qed
     have "closedin Y (f ` (C - U2))"
       using \<open>closed_map X Y f\<close> \<open>closedin X C\<close> \<open>openin X U2\<close> closed_map_def by blast
     moreover
     have "f x \<in> topspace Y - f ` (C - U2)"
       using \<open>closedin X C\<close> \<open>continuous_map X Y f\<close> \<open>x \<in> topspace X\<close> closedin_subset continuous_map_def subV by fastforce
     ultimately
     obtain V1 V2 where VV: "openin Y V1" "openin Y V2" "f x \<in> V1" 
                 and subV2: "f ` (C - U2) \<subseteq> V2" and "disjnt V1 V2"
       by (meson R regular_space_def)
     show "\<exists>U U'. openin X U \<and> openin X U' \<and> x \<in> U \<and> C \<subseteq> U' \<and> disjnt U U'"
     proof (intro exI conjI)
       show "openin X (U1 \<inter> {x \<in> topspace X. f x \<in> V1})"
         using VV(1) \<open>continuous_map X Y f\<close> \<open>openin X U1\<close> continuous_map by fastforce
       show "openin X (U2 \<union> {x \<in> topspace X. f x \<in> V2})"
         using VV(2) \<open>continuous_map X Y f\<close> \<open>openin X U2\<close> continuous_map by fastforce
       show "x \<in> U1 \<inter> {x \<in> topspace X. f x \<in> V1}"
         using VV(3) \<open>x \<in> topspace X\<close> \<open>{x} \<subseteq> U1\<close> by auto
       show "C \<subseteq> U2 \<union> {x \<in> topspace X. f x \<in> V2}"
         using \<open>closedin X C\<close> closedin_subset subV2 by auto
       show "disjnt (U1 \<inter> {x \<in> topspace X. f x \<in> V1}) (U2 \<union> {x \<in> topspace X. f x \<in> V2})"
         using \<open>disjnt U1 U2\<close> \<open>disjnt V1 V2\<close> by (auto simp: disjnt_iff)
     qed
   qed
 qed
 
 
 
 subsection\<open>Locally compact spaces\<close>
 
 definition locally_compact_space 
   where "locally_compact_space X \<equiv>
     \<forall>x \<in> topspace X. \<exists>U K. openin X U \<and> compactin X K \<and> x \<in> U \<and> U \<subseteq> K"
 
 lemma homeomorphic_locally_compact_spaceD:
   assumes X: "locally_compact_space X" and "X homeomorphic_space Y"
   shows "locally_compact_space Y"
 proof -
   obtain f where hmf: "homeomorphic_map X Y f"
     using assms homeomorphic_space by blast
   then have eq: "topspace Y = f ` (topspace X)"
     by (simp add: homeomorphic_imp_surjective_map)
   have "\<exists>V K. openin Y V \<and> compactin Y K \<and> f x \<in> V \<and> V \<subseteq> K"
     if "x \<in> topspace X" "openin X U" "compactin X K" "x \<in> U" "U \<subseteq> K" for x U K
     using that 
     by (meson hmf homeomorphic_map_compactness_eq homeomorphic_map_openness_eq image_mono image_eqI)
   with X show ?thesis
     by (smt (verit) eq image_iff locally_compact_space_def)
 qed
 
 lemma homeomorphic_locally_compact_space:
   assumes "X homeomorphic_space Y"
   shows "locally_compact_space X \<longleftrightarrow> locally_compact_space Y"
   by (meson assms homeomorphic_locally_compact_spaceD homeomorphic_space_sym)
 
 lemma locally_compact_space_retraction_map_image:
   assumes "retraction_map X Y r" and X: "locally_compact_space X"
   shows "locally_compact_space Y"
 proof -
   obtain s where s: "retraction_maps X Y r s"
     using assms retraction_map_def by blast
   obtain T where "T retract_of_space X" and Teq: "T = s ` topspace Y"
     using retraction_maps_section_image1 s by blast
   then obtain r where r: "continuous_map X (subtopology X T) r" "\<forall>x\<in>T. r x = x"
     by (meson retract_of_space_def)
   have "locally_compact_space (subtopology X T)"
     unfolding locally_compact_space_def openin_subtopology_alt
   proof clarsimp
     fix x
     assume "x \<in> topspace X" "x \<in> T"
     obtain U K where UK: "openin X U \<and> compactin X K \<and> x \<in> U \<and> U \<subseteq> K"
       by (meson X \<open>x \<in> topspace X\<close> locally_compact_space_def)
     then have "compactin (subtopology X T) (r ` K) \<and> T \<inter> U \<subseteq> r ` K"
       by (smt (verit) IntD1 image_compactin image_iff inf_le2 r subset_iff)
     then show "\<exists>U. openin X U \<and> (\<exists>K. compactin (subtopology X T) K \<and> x \<in> U \<and> T \<inter> U \<subseteq> K)"
       using UK by auto
   qed
   with Teq show ?thesis
     using homeomorphic_locally_compact_space retraction_maps_section_image2 s by blast
 qed
 
 lemma compact_imp_locally_compact_space:
    "compact_space X \<Longrightarrow> locally_compact_space X"
   using compact_space_def locally_compact_space_def by blast
 
 lemma neighbourhood_base_imp_locally_compact_space:
    "neighbourhood_base_of (compactin X) X \<Longrightarrow> locally_compact_space X"
   by (metis locally_compact_space_def neighbourhood_base_of openin_topspace)
 
 lemma locally_compact_imp_neighbourhood_base:
   assumes loc: "locally_compact_space X" and reg: "regular_space X"
   shows "neighbourhood_base_of (compactin X) X"
   unfolding neighbourhood_base_of
 proof clarify
   fix W x
   assume "openin X W" and "x \<in> W"
   then obtain U K where "openin X U" "compactin X K" "x \<in> U" "U \<subseteq> K"
     by (metis loc locally_compact_space_def openin_subset subsetD)
   moreover have "openin X (U \<inter> W) \<and> x \<in> U \<inter> W"
     using \<open>openin X W\<close> \<open>x \<in> W\<close> \<open>openin X U\<close> \<open>x \<in> U\<close> by blast
   then have "\<exists>u' v. openin X u' \<and> closedin X v \<and> x \<in> u' \<and> u' \<subseteq> v \<and> v \<subseteq> U \<and> v \<subseteq> W"
     using reg
     by (metis le_infE neighbourhood_base_of neighbourhood_base_of_closedin)
   then show "\<exists>U V. openin X U \<and> compactin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
     by (meson \<open>U \<subseteq> K\<close> \<open>compactin X K\<close> closed_compactin subset_trans)
 qed
 
 lemma Hausdorff_regular: "\<lbrakk>Hausdorff_space X; neighbourhood_base_of (compactin X) X\<rbrakk> \<Longrightarrow> regular_space X"
   by (metis compactin_imp_closedin neighbourhood_base_of_closedin neighbourhood_base_of_mono)
 
 lemma locally_compact_Hausdorff_imp_regular_space: 
   assumes loc: "locally_compact_space X" and "Hausdorff_space X"
   shows "regular_space X"
   unfolding neighbourhood_base_of_closedin [symmetric] neighbourhood_base_of
 proof clarify
   fix W x
   assume "openin X W" and "x \<in> W"
   then have "x \<in> topspace X"
     using openin_subset by blast 
   then obtain U K where "openin X U" "compactin X K" and UK: "x \<in> U" "U \<subseteq> K"
     by (meson loc locally_compact_space_def)
   with \<open>Hausdorff_space X\<close> have "regular_space (subtopology X K)"
     using Hausdorff_space_subtopology compact_Hausdorff_imp_regular_space compact_space_subtopology by blast
   then have "\<exists>U' V'. openin (subtopology X K) U' \<and> closedin (subtopology X K) V' \<and> x \<in> U' \<and> U' \<subseteq> V' \<and> V' \<subseteq> K \<inter> W"
     unfolding neighbourhood_base_of_closedin [symmetric] neighbourhood_base_of
     by (meson IntI \<open>U \<subseteq> K\<close> \<open>openin X W\<close> \<open>x \<in> U\<close> \<open>x \<in> W\<close> openin_subtopology_Int2 subsetD)
   then obtain V C where "openin X V" "closedin X C" and VC: "x \<in> K \<inter> V" "K \<inter> V \<subseteq> K \<inter> C" "K \<inter> C \<subseteq> K \<inter> W"
     by (metis Int_commute closedin_subtopology openin_subtopology)
   show "\<exists>U V. openin X U \<and> closedin X V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
   proof (intro conjI exI)
     show "openin X (U \<inter> V)"
       using \<open>openin X U\<close> \<open>openin X V\<close> by blast
     show "closedin X (K \<inter> C)"
       using \<open>closedin X C\<close> \<open>compactin X K\<close> compactin_imp_closedin \<open>Hausdorff_space X\<close> by blast
   qed (use UK VC in auto)
 qed
 
 lemma locally_compact_space_neighbourhood_base:
   "Hausdorff_space X \<or> regular_space X
         \<Longrightarrow> locally_compact_space X \<longleftrightarrow> neighbourhood_base_of (compactin X) X"
   by (metis locally_compact_imp_neighbourhood_base locally_compact_Hausdorff_imp_regular_space 
             neighbourhood_base_imp_locally_compact_space)
 
 lemma locally_compact_Hausdorff_or_regular:
    "locally_compact_space X \<and> (Hausdorff_space X \<or> regular_space X) \<longleftrightarrow> locally_compact_space X \<and> regular_space X"
   using locally_compact_Hausdorff_imp_regular_space by blast
 
 lemma locally_compact_space_compact_closedin:
   assumes  "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow>
          (\<forall>x \<in> topspace X. \<exists>U K. openin X U \<and> compactin X K \<and> closedin X K \<and> x \<in> U \<and> U \<subseteq> K)"
   using locally_compact_Hausdorff_or_regular unfolding locally_compact_space_def
   by (metis assms closed_compactin inf.absorb_iff2 le_infE neighbourhood_base_of neighbourhood_base_of_closedin)
 
 lemma locally_compact_space_compact_closure_of:
   assumes "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow>
          (\<forall>x \<in> topspace X. \<exists>U. openin X U \<and> compactin X (X closure_of U) \<and> x \<in> U)" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis assms closed_compactin closedin_closure_of closure_of_eq closure_of_mono locally_compact_space_compact_closedin)
 next
   assume ?rhs then show ?lhs
     by (meson closure_of_subset locally_compact_space_def openin_subset)
 qed
 
 lemma locally_compact_space_neighbourhood_base_closedin:
   assumes "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow> neighbourhood_base_of (\<lambda>C. compactin X C \<and> closedin X C) X" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then have "regular_space X"
     using assms locally_compact_Hausdorff_imp_regular_space by blast
   with L have "neighbourhood_base_of (compactin X) X"
    by (simp add: locally_compact_imp_neighbourhood_base)
   with \<open>regular_space X\<close> show ?rhs
     by (smt (verit, ccfv_threshold) closed_compactin neighbourhood_base_of subset_trans neighbourhood_base_of_closedin)
 next
   assume ?rhs then show ?lhs
     using neighbourhood_base_imp_locally_compact_space neighbourhood_base_of_mono by blast
 qed
 
 lemma locally_compact_space_neighbourhood_base_closure_of:
   assumes "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow> neighbourhood_base_of (\<lambda>T. compactin X (X closure_of T)) X" 
          (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then have "regular_space X"
     using assms locally_compact_Hausdorff_imp_regular_space by blast
   with L have "neighbourhood_base_of (\<lambda>A. compactin X A \<and> closedin X A) X"
     using locally_compact_space_neighbourhood_base_closedin by blast
   then show ?rhs
     by (simp add: closure_of_closedin neighbourhood_base_of_mono)
 next
   assume ?rhs then show ?lhs
     unfolding locally_compact_space_def neighbourhood_base_of
     by (meson closure_of_subset openin_topspace subset_trans)
 qed
 
 lemma locally_compact_space_neighbourhood_base_open_closure_of:
   assumes "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow> 
              neighbourhood_base_of (\<lambda>U. openin X U \<and> compactin X (X closure_of U)) X"
          (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then have "regular_space X"
     using assms locally_compact_Hausdorff_imp_regular_space by blast
   then have "neighbourhood_base_of (\<lambda>T. compactin X (X closure_of T)) X"
     using L locally_compact_space_neighbourhood_base_closure_of by auto
   with L show ?rhs
     unfolding neighbourhood_base_of
     by (meson closed_compactin closure_of_closure_of closure_of_eq closure_of_mono subset_trans)
 next
   assume ?rhs then show ?lhs
     unfolding locally_compact_space_def neighbourhood_base_of
     by (meson closure_of_subset openin_topspace subset_trans)
 qed
 
 lemma locally_compact_space_compact_closed_compact:
   assumes "Hausdorff_space X \<or> regular_space X"
   shows "locally_compact_space X \<longleftrightarrow>
          (\<forall>K. compactin X K
               \<longrightarrow> (\<exists>U L. openin X U \<and> compactin X L \<and> closedin X L \<and> K \<subseteq> U \<and> U \<subseteq> L))"
          (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then obtain U L where UL: "\<forall>x \<in> topspace X. openin X (U x) \<and> compactin X (L x) \<and> closedin X (L x) \<and> x \<in> U x \<and> U x \<subseteq> L x"
     unfolding locally_compact_space_compact_closedin [OF assms]
     by metis
   show ?rhs
   proof clarify
     fix K
     assume "compactin X K"
     then have "K \<subseteq> topspace X"
       by (simp add: compactin_subset_topspace)
     then have *: "(\<forall>U\<in>U ` K. openin X U) \<and> K \<subseteq> \<Union> (U ` K)"
       using UL by blast
     with \<open>compactin X K\<close> obtain KF where KF: "finite KF" "KF \<subseteq> K" "K \<subseteq> \<Union>(U ` KF)"
       by (metis compactinD finite_subset_image)
     show "\<exists>U L. openin X U \<and> compactin X L \<and> closedin X L \<and> K \<subseteq> U \<and> U \<subseteq> L"
     proof (intro conjI exI)
       show "openin X (\<Union> (U ` KF))"
         using "*" \<open>KF \<subseteq> K\<close> by fastforce
       show "compactin X (\<Union> (L ` KF))"
         by (smt (verit) UL \<open>K \<subseteq> topspace X\<close> KF compactin_Union finite_imageI imageE subset_iff)
       show "closedin X (\<Union> (L ` KF))"
         by (smt (verit) UL \<open>K \<subseteq> topspace X\<close> KF closedin_Union finite_imageI imageE subsetD)
     qed (use UL \<open>K \<subseteq> topspace X\<close> KF in auto)
   qed
 next
   assume ?rhs then show ?lhs
     by (metis compactin_sing insert_subset locally_compact_space_def)
 qed
 
 lemma locally_compact_regular_space_neighbourhood_base:
    "locally_compact_space X \<and> regular_space X \<longleftrightarrow>
         neighbourhood_base_of (\<lambda>C. compactin X C \<and> closedin X C) X"
   using locally_compact_space_neighbourhood_base_closedin neighbourhood_base_of_closedin neighbourhood_base_of_mono by blast
 
 lemma locally_compact_kc_space:
    "neighbourhood_base_of (compactin X) X \<and> kc_space X \<longleftrightarrow>
         locally_compact_space X \<and> Hausdorff_space X"
   using Hausdorff_imp_kc_space locally_compact_imp_kc_eq_Hausdorff_space locally_compact_space_neighbourhood_base by blast
 
 lemma locally_compact_kc_space_alt:
    "neighbourhood_base_of (compactin X) X \<and> kc_space X \<longleftrightarrow>
         locally_compact_space X \<and> Hausdorff_space X \<and> regular_space X"
   using Hausdorff_regular locally_compact_kc_space by blast
 
 lemma locally_compact_kc_imp_regular_space:
    "\<lbrakk>neighbourhood_base_of (compactin X) X; kc_space X\<rbrakk> \<Longrightarrow> regular_space X"
   using Hausdorff_regular locally_compact_imp_kc_eq_Hausdorff_space by blast
 
 lemma kc_locally_compact_space:
    "kc_space X
     \<Longrightarrow> neighbourhood_base_of (compactin X) X \<longleftrightarrow> locally_compact_space X \<and> Hausdorff_space X \<and> regular_space X"
   using Hausdorff_regular locally_compact_kc_space by blast
 
 lemma locally_compact_space_closed_subset:
   assumes loc: "locally_compact_space X" and "closedin X S"
   shows "locally_compact_space (subtopology X S)"
 proof (clarsimp simp: locally_compact_space_def)
   fix x assume x: "x \<in> topspace X" "x \<in> S"
   then obtain U K where UK: "openin X U \<and> compactin X K \<and> x \<in> U \<and> U \<subseteq> K"
     by (meson loc locally_compact_space_def)
   show "\<exists>U. openin (subtopology X S) U \<and> 
             (\<exists>K. compactin (subtopology X S) K \<and> x \<in> U \<and> U \<subseteq> K)"
   proof (intro conjI exI)
     show "openin (subtopology X S) (S \<inter> U)"
       by (simp add: UK openin_subtopology_Int2)
     show "compactin (subtopology X S) (S \<inter> K)"
       by (simp add: UK assms(2) closed_Int_compactin compactin_subtopology)
   qed (use UK x in auto)
 qed
 
 lemma locally_compact_space_open_subset:
-  assumes reg: "regular_space X" and loc: "locally_compact_space X" and "openin X S"
+  assumes X: "Hausdorff_space X \<or> regular_space X" and loc: "locally_compact_space X" and "openin X S"
   shows "locally_compact_space (subtopology X S)"
 proof (clarsimp simp: locally_compact_space_def)
   fix x assume x: "x \<in> topspace X" "x \<in> S"
   then obtain U K where UK: "openin X U" "compactin X K" "x \<in> U" "U \<subseteq> K"
     by (meson loc locally_compact_space_def)
-  have "openin X (U \<inter> S)"
+  moreover have reg: "regular_space X"
+    using X loc locally_compact_Hausdorff_imp_regular_space by blast
+  moreover have "openin X (U \<inter> S)"
     by (simp add: UK \<open>openin X S\<close> openin_Int)
-  with UK reg x obtain V C 
+  ultimately obtain V C 
       where VC: "openin X V" "closedin X C" "x \<in> V" "V \<subseteq> C" "C \<subseteq> U" "C \<subseteq> S"
-    by (metis IntI le_inf_iff neighbourhood_base_of neighbourhood_base_of_closedin)
+    by (metis \<open>x \<in> S\<close> IntI le_inf_iff neighbourhood_base_of neighbourhood_base_of_closedin)
   show "\<exists>U. openin (subtopology X S) U \<and> 
             (\<exists>K. compactin (subtopology X S) K \<and> x \<in> U \<and> U \<subseteq> K)"
   proof (intro conjI exI)
     show "openin (subtopology X S) V"
       using VC by (meson \<open>openin X S\<close> openin_open_subtopology order_trans)
     show "compactin (subtopology X S) (C \<inter> K)"
       using UK VC closed_Int_compactin compactin_subtopology by fastforce
   qed (use UK VC x in auto)
 qed
 
 lemma locally_compact_space_discrete_topology:
    "locally_compact_space (discrete_topology U)"
   by (simp add: neighbourhood_base_imp_locally_compact_space neighbourhood_base_of_discrete_topology)
 
 lemma locally_compact_space_continuous_open_map_image:
   "\<lbrakk>continuous_map X X' f; open_map X X' f;
     f ` topspace X = topspace X'; locally_compact_space X\<rbrakk> \<Longrightarrow> locally_compact_space X'"
 unfolding locally_compact_space_def open_map_def
   by (smt (verit, ccfv_SIG) image_compactin image_iff image_mono)
 
 lemma locally_compact_subspace_openin_closure_of:
   assumes "Hausdorff_space X" and S: "S \<subseteq> topspace X" 
     and loc: "locally_compact_space (subtopology X S)"
   shows "openin (subtopology X (X closure_of S)) S"
   unfolding openin_subopen [where S=S]
 proof clarify
   fix a assume "a \<in> S"
   then obtain T K where *: "openin X T" "compactin X K" "K \<subseteq> S" "a \<in> S" "a \<in> T" "S \<inter> T \<subseteq> K"
     using loc unfolding locally_compact_space_def
   by (metis IntE S compactin_subtopology inf_commute openin_subtopology topspace_subtopology_subset)
   have "T \<inter> X closure_of S \<subseteq> X closure_of (T \<inter> S)"
     by (simp add: "*"(1) openin_Int_closure_of_subset)
   also have "... \<subseteq> S"
     using * \<open>Hausdorff_space X\<close> by (metis closure_of_minimal compactin_imp_closedin order.trans inf_commute)
   finally have "T \<inter> X closure_of S \<subseteq> T \<inter> S" by simp 
   then have "openin (subtopology X (X closure_of S)) (T \<inter> S)"
     unfolding openin_subtopology using \<open>openin X T\<close> S closure_of_subset by fastforce
   with * show "\<exists>T. openin (subtopology X (X closure_of S)) T \<and> a \<in> T \<and> T \<subseteq> S"
     by blast
 qed
 
 lemma locally_compact_subspace_closed_Int_openin:
    "\<lbrakk>Hausdorff_space X \<and> S \<subseteq> topspace X \<and> locally_compact_space(subtopology X S)\<rbrakk>
         \<Longrightarrow> \<exists>C U. closedin X C \<and> openin X U \<and> C \<inter> U = S"
   by (metis closedin_closure_of inf_commute locally_compact_subspace_openin_closure_of openin_subtopology)
 
 lemma locally_compact_subspace_open_in_closure_of_eq:
   assumes "Hausdorff_space X" and loc: "locally_compact_space X"
   shows "openin (subtopology X (X closure_of S)) S \<longleftrightarrow> S \<subseteq> topspace X \<and> locally_compact_space(subtopology X S)" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then obtain "S \<subseteq> topspace X" "regular_space X"
     using assms locally_compact_Hausdorff_imp_regular_space openin_subset by fastforce 
   then have "locally_compact_space (subtopology (subtopology X (X closure_of S)) S)"
     by (simp add: L loc locally_compact_space_closed_subset locally_compact_space_open_subset regular_space_subtopology)
   then show ?rhs
     by (metis L inf.orderE inf_commute le_inf_iff openin_subset subtopology_subtopology topspace_subtopology)
 next
   assume ?rhs then show ?lhs
     using  assms locally_compact_subspace_openin_closure_of by blast
 qed
 
 lemma locally_compact_subspace_closed_Int_openin_eq:
   assumes "Hausdorff_space X" and loc: "locally_compact_space X"
   shows "(\<exists>C U. closedin X C \<and> openin X U \<and> C \<inter> U = S) \<longleftrightarrow> S \<subseteq> topspace X \<and> locally_compact_space(subtopology X S)" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then obtain C U where "closedin X C" "openin X U" and Seq: "S = C \<inter> U"
     by blast
   then have "C \<subseteq> topspace X"
     by (simp add: closedin_subset)
   have "locally_compact_space (subtopology (subtopology X C) (topspace (subtopology X C) \<inter> U))"
-    proof (rule locally_compact_space_open_subset)
-  show "regular_space (subtopology X C)"
-    by (simp add: \<open>Hausdorff_space X\<close> loc locally_compact_Hausdorff_imp_regular_space regular_space_subtopology)
-  show "locally_compact_space (subtopology X C)"
-    by (simp add: \<open>closedin X C\<close> loc locally_compact_space_closed_subset)
-  show "openin (subtopology X C) (topspace (subtopology X C) \<inter> U)"
-    by (simp add: \<open>openin X U\<close> Int_left_commute inf_commute openin_Int openin_subtopology_Int2)
-qed
-    then show ?rhs
-      by (metis Seq \<open>C \<subseteq> topspace X\<close> inf.coboundedI1 subtopology_subtopology subtopology_topspace)
+  proof (rule locally_compact_space_open_subset)
+    show "locally_compact_space (subtopology X C)"
+      by (simp add: \<open>closedin X C\<close> loc locally_compact_space_closed_subset)
+    show "openin (subtopology X C) (topspace (subtopology X C) \<inter> U)"
+      by (simp add: \<open>openin X U\<close> Int_left_commute inf_commute openin_Int openin_subtopology_Int2)
+  qed (simp add: Hausdorff_space_subtopology \<open>Hausdorff_space X\<close>)
+  then show ?rhs
+    by (metis Seq \<open>C \<subseteq> topspace X\<close> inf.coboundedI1 subtopology_subtopology subtopology_topspace)
 next
   assume ?rhs then show ?lhs
-  using assms locally_compact_subspace_closed_Int_openin by blast
+    using assms locally_compact_subspace_closed_Int_openin by blast
 qed
 
 lemma dense_locally_compact_openin_Hausdorff_space:
    "\<lbrakk>Hausdorff_space X; S \<subseteq> topspace X; X closure_of S = topspace X;
      locally_compact_space (subtopology X S)\<rbrakk> \<Longrightarrow> openin X S"
   by (metis locally_compact_subspace_openin_closure_of subtopology_topspace)
 
 lemma locally_compact_space_prod_topology:
   "locally_compact_space (prod_topology X Y) \<longleftrightarrow>
         topspace (prod_topology X Y) = {} \<or>
         locally_compact_space X \<and> locally_compact_space Y" (is "?lhs=?rhs")
 proof (cases "topspace (prod_topology X Y) = {}")
   case True
   then show ?thesis
     unfolding locally_compact_space_def by blast
 next
   case False
   then obtain w z where wz: "w \<in> topspace X" "z \<in> topspace Y"
     by auto
   show ?thesis 
   proof
     assume L: ?lhs then show ?rhs
       by (metis wz empty_iff locally_compact_space_retraction_map_image retraction_map_fst retraction_map_snd)
   next
     assume R: ?rhs 
     show ?lhs
       unfolding locally_compact_space_def
     proof clarsimp
       fix x y
       assume "x \<in> topspace X" and "y \<in> topspace Y"
       obtain U C where "openin X U" "compactin X C" "x \<in> U" "U \<subseteq> C"
         by (meson False R \<open>x \<in> topspace X\<close> locally_compact_space_def)
       obtain V D where "openin Y V" "compactin Y D" "y \<in> V" "V \<subseteq> D"
         by (meson False R \<open>y \<in> topspace Y\<close> locally_compact_space_def)
       show "\<exists>U. openin (prod_topology X Y) U \<and> (\<exists>K. compactin (prod_topology X Y) K \<and> (x, y) \<in> U \<and> U \<subseteq> K)"
       proof (intro exI conjI)
         show "openin (prod_topology X Y) (U \<times> V)"
           by (simp add: \<open>openin X U\<close> \<open>openin Y V\<close> openin_prod_Times_iff)
         show "compactin (prod_topology X Y) (C \<times> D)"
           by (simp add: \<open>compactin X C\<close> \<open>compactin Y D\<close> compactin_Times)
         show "(x, y) \<in> U \<times> V"
           by (simp add: \<open>x \<in> U\<close> \<open>y \<in> V\<close>)
         show "U \<times> V \<subseteq> C \<times> D"
           by (simp add: Sigma_mono \<open>U \<subseteq> C\<close> \<open>V \<subseteq> D\<close>)
       qed
     qed
   qed
 qed
 
 lemma locally_compact_space_product_topology:
    "locally_compact_space(product_topology X I) \<longleftrightarrow>
         topspace(product_topology X I) = {} \<or>
         finite {i \<in> I. \<not> compact_space(X i)} \<and> (\<forall>i \<in> I. locally_compact_space(X i))" (is "?lhs=?rhs")
 proof (cases "topspace (product_topology X I) = {}")
   case True
   then show ?thesis
     by (simp add: locally_compact_space_def)
 next
   case False
   show ?thesis 
   proof
     assume L: ?lhs
     obtain z where z: "z \<in> topspace (product_topology X I)"
       using False by auto
     with L z obtain U C where "openin (product_topology X I) U" "compactin (product_topology X I) C" "z \<in> U" "U \<subseteq> C"
       by (meson locally_compact_space_def)
     then obtain V where finV: "finite {i \<in> I. V i \<noteq> topspace (X i)}" and "\<forall>i \<in> I. openin (X i) (V i)" 
                     and "z \<in> PiE I V" "PiE I V \<subseteq> U"
       by (auto simp: openin_product_topology_alt)
     have "compact_space (X i)" if "i \<in> I" "V i = topspace (X i)" for i
     proof -
       have "compactin (X i) ((\<lambda>x. x i) ` C)"
         using \<open>compactin (product_topology X I) C\<close> image_compactin
         by (metis continuous_map_product_projection \<open>i \<in> I\<close>)
       moreover have "V i \<subseteq> (\<lambda>x. x i) ` C"
       proof -
         have "V i \<subseteq> (\<lambda>x. x i) ` Pi\<^sub>E I V"
           by (metis \<open>z \<in> Pi\<^sub>E I V\<close> empty_iff image_projection_PiE order_refl \<open>i \<in> I\<close>)
         also have "\<dots> \<subseteq> (\<lambda>x. x i) ` C"
           using \<open>U \<subseteq> C\<close> \<open>Pi\<^sub>E I V \<subseteq> U\<close> by blast
         finally show ?thesis .
       qed
       ultimately show ?thesis
         by (metis closed_compactin closedin_topspace compact_space_def that(2))
     qed
     with finV have "finite {i \<in> I. \<not> compact_space (X i)}"
       by (metis (mono_tags, lifting) mem_Collect_eq finite_subset subsetI)
     moreover have "locally_compact_space (X i)" if "i \<in> I" for i
       by (meson False L locally_compact_space_retraction_map_image retraction_map_product_projection that)
     ultimately show ?rhs by metis
   next
     assume R: ?rhs 
     show ?lhs
       unfolding locally_compact_space_def
     proof clarsimp
       fix z
       assume z: "z \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
       have "\<exists>U C. openin (X i) U \<and> compactin (X i) C \<and> z i \<in> U \<and> U \<subseteq> C \<and>
                     (compact_space(X i) \<longrightarrow> U = topspace(X i) \<and> C = topspace(X i))" 
         if "i \<in> I" for i
         using that R z unfolding locally_compact_space_def compact_space_def
         by (metis (no_types, lifting) False PiE_mem openin_topspace set_eq_subset)
       then obtain U C where UC: "\<And>i. i \<in> I \<Longrightarrow> 
              openin (X i) (U i) \<and> compactin (X i) (C i) \<and> z i \<in> U i \<and> U i \<subseteq> C i \<and>
                     (compact_space(X i) \<longrightarrow> U i = topspace(X i) \<and> C i = topspace(X i))"
         by metis
       show "\<exists>U. openin (product_topology X I) U \<and> (\<exists>K. compactin (product_topology X I) K \<and> z \<in> U \<and> U \<subseteq> K)"
       proof (intro exI conjI)
         show "openin (product_topology X I) (Pi\<^sub>E I U)"
         by (smt (verit) Collect_cong False R UC compactin_subspace openin_PiE_gen subset_antisym subtopology_topspace)
         show "compactin (product_topology X I) (Pi\<^sub>E I C)"
           by (simp add: UC compactin_PiE)
       qed (use UC z in blast)+
     qed
   qed
 qed
 
 lemma locally_compact_space_sum_topology:
    "locally_compact_space (sum_topology X I) \<longleftrightarrow> (\<forall>i \<in> I. locally_compact_space (X i))" (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis closed_map_component_injection embedding_map_imp_homeomorphic_space embedding_map_component_injection
         embedding_imp_closed_map_eq homeomorphic_locally_compact_space locally_compact_space_closed_subset)
 next
   assume R: ?rhs
   show ?lhs
     unfolding locally_compact_space_def
   proof clarsimp
     fix i y
     assume "i \<in> I" and y: "y \<in> topspace (X i)"
     then obtain U K where UK: "openin (X i) U" "compactin (X i) K" "y \<in> U" "U \<subseteq> K"
       using R by (fastforce simp: locally_compact_space_def)
     then show "\<exists>U. openin (sum_topology X I) U \<and> (\<exists>K. compactin (sum_topology X I) K \<and> (i, y) \<in> U \<and> U \<subseteq> K)"
       by (metis \<open>i \<in> I\<close> continuous_map_component_injection image_compactin image_mono 
           imageI open_map_component_injection open_map_def)
   qed
 qed
 
 proposition quotient_map_prod_right:
   assumes loc: "locally_compact_space Z" 
     and reg: "Hausdorff_space Z \<or> regular_space Z" 
     and f: "quotient_map X Y f"
   shows "quotient_map (prod_topology Z X) (prod_topology Z Y) (\<lambda>(x,y). (x,f y))"
 proof -
   define h where "h \<equiv> (\<lambda>(x::'a,y). (x,f y))"
   have "continuous_map (prod_topology Z X) Y (f o snd)"
     by (simp add: continuous_map_of_snd f quotient_imp_continuous_map)
   then have cmh: "continuous_map (prod_topology Z X) (prod_topology Z Y) h"
     by (simp add: h_def continuous_map_paired split_def continuous_map_fst o_def)
   have fim: "f ` topspace X = topspace Y"
     by (simp add: f quotient_imp_surjective_map)
   moreover
   have "openin (prod_topology Z X) {u \<in> topspace Z \<times> topspace X. h u \<in> W}
    \<longleftrightarrow> openin (prod_topology Z Y) W"   (is "?lhs=?rhs")
     if W: "W \<subseteq> topspace Z \<times> topspace Y" for W
   proof
     define S where "S \<equiv> {u \<in> topspace Z \<times> topspace X. h u \<in> W}"
     assume ?lhs 
     then have L: "openin (prod_topology Z X) S"
       using S_def by blast
     have "\<exists>T. openin (prod_topology Z Y) T \<and> (x0, z0) \<in> T \<and> T \<subseteq> W"
       if \<section>: "(x0,z0) \<in> W" for x0 z0 
     proof -
       have x0: "x0 \<in> topspace Z"
         using W that by blast
       obtain y0 where y0: "y0 \<in> topspace X" "f y0 = z0"
         by (metis W fim imageE insert_absorb insert_subset mem_Sigma_iff \<section>)
       then have "(x0, y0) \<in> S"
         by (simp add: S_def h_def that x0)
       have "continuous_map Z (prod_topology Z X) (\<lambda>x. (x, y0))"
         by (simp add: continuous_map_paired y0)
       with openin_continuous_map_preimage [OF _ L] 
       have ope_ZS: "openin Z {x \<in> topspace Z. (x,y0) \<in> S}"
         by blast
       obtain U U' where "openin Z U" "compactin Z U'" "closedin Z U'" 
         "x0 \<in> U"  "U \<subseteq> U'" "U' \<subseteq> {x \<in> topspace Z. (x,y0) \<in> S}"
         using loc ope_ZS x0 \<open>(x0, y0) \<in> S\<close>
         by (force simp: locally_compact_space_neighbourhood_base_closedin [OF reg] 
             neighbourhood_base_of)
       then have D: "U' \<times> {y0} \<subseteq> S"
         by (auto simp: )
       define V where "V \<equiv> {z \<in> topspace Y. U' \<times> {y \<in> topspace X. f y = z} \<subseteq> S}"
       have "z0 \<in> V"
         using D y0 Int_Collect fim by (fastforce simp: h_def V_def S_def)
       have "openin X {x \<in> topspace X. f x \<in> V} \<Longrightarrow> openin Y V"
         using f unfolding V_def quotient_map_def subset_iff
         by (smt (verit, del_insts) Collect_cong mem_Collect_eq)
       moreover have "openin X {x \<in> topspace X. f x \<in> V}"
       proof -
         let ?Z = "subtopology Z U'"
         have *: "{x \<in> topspace X. f x \<in> V} = topspace X - snd ` (U' \<times> topspace X - S)"
           by (force simp: V_def S_def h_def simp flip: fim)
         have "compact_space ?Z"
           using \<open>compactin Z U'\<close> compactin_subspace by auto
         moreover have "closedin (prod_topology ?Z X) (U' \<times> topspace X - S)"
           by (simp add: L \<open>closedin Z U'\<close> closedin_closed_subtopology closedin_diff closedin_prod_Times_iff 
               prod_topology_subtopology(1))
         ultimately show ?thesis
           using "*" closed_map_snd closed_map_def by fastforce
       qed
       ultimately have "openin Y V"
         by metis
       show ?thesis
       proof (intro conjI exI)
         show "openin (prod_topology Z Y) (U \<times> V)"
           by (simp add: openin_prod_Times_iff \<open>openin Z U\<close> \<open>openin Y V\<close>)
         show "(x0, z0) \<in> U \<times> V"
           by (simp add: \<open>x0 \<in> U\<close> \<open>z0 \<in> V\<close>)
         show "U \<times> V \<subseteq> W"
           using \<open>U \<subseteq> U'\<close> by (force simp: V_def S_def h_def simp flip: fim)
       qed
     qed
     with openin_subopen show ?rhs by force
   next
     assume ?rhs then show ?lhs
       using openin_continuous_map_preimage cmh by fastforce
   qed
   ultimately show ?thesis
     by (fastforce simp: image_iff quotient_map_def h_def)
 qed
 
 lemma quotient_map_prod_left:
   assumes loc: "locally_compact_space Z" 
     and reg: "Hausdorff_space Z \<or> regular_space Z" 
     and f: "quotient_map X Y f"
   shows "quotient_map (prod_topology X Z) (prod_topology Y Z) (\<lambda>(x,y). (f x,y))"
 proof -
   have "(\<lambda>(x,y). (f x,y)) = prod.swap \<circ> (\<lambda>(x,y). (x,f y)) \<circ> prod.swap"
     by force
   then
   show ?thesis
     apply (rule ssubst)
   proof (intro quotient_map_compose)
     show "quotient_map (prod_topology X Z) (prod_topology Z X) prod.swap"
       "quotient_map (prod_topology Z Y) (prod_topology Y Z) prod.swap"
       using homeomorphic_map_def homeomorphic_map_swap quotient_map_eq by fastforce+
     show "quotient_map (prod_topology Z X) (prod_topology Z Y) (\<lambda>(x, y). (x, f y))"
       by (simp add: f loc quotient_map_prod_right reg)
   qed
 qed
 
 lemma locally_compact_space_perfect_map_preimage:
   assumes "locally_compact_space X'" and f: "perfect_map X X' f"
   shows "locally_compact_space X"
   unfolding locally_compact_space_def
 proof (intro strip)
   fix x
   assume x: "x \<in> topspace X"
   then obtain U K where "openin X' U" "compactin X' K" "f x \<in> U" "U \<subseteq> K"
     using assms unfolding locally_compact_space_def perfect_map_def
     by (metis (no_types, lifting) continuous_map_closedin)
   show "\<exists>U K. openin X U \<and> compactin X K \<and> x \<in> U \<and> U \<subseteq> K"
   proof (intro exI conjI)
     have "continuous_map X X' f"
       using f perfect_map_def by blast
     then show "openin X {x \<in> topspace X. f x \<in> U}"
       by (simp add: \<open>openin X' U\<close> continuous_map)
     show "compactin X {x \<in> topspace X. f x \<in> K}"
       using \<open>compactin X' K\<close> f perfect_imp_proper_map proper_map_alt by blast
   qed (use x \<open>f x \<in> U\<close> \<open>U \<subseteq> K\<close> in auto)
 qed
 
 
 subsection\<open>Special characterizations of classes of functions into and out of R\<close>
 
 lemma monotone_map_into_euclideanreal_alt:
   assumes "continuous_map X euclideanreal f" 
   shows "(\<forall>k. is_interval k \<longrightarrow> connectedin X {x \<in> topspace X. f x \<in> k}) \<longleftrightarrow>
          connected_space X \<and> monotone_map X euclideanreal f"  (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof
     show "connected_space X"
       using L connected_space_subconnected by blast
     have "connectedin X {x \<in> topspace X. f x \<in> {y}}" for y
       by (metis L is_interval_1 nle_le singletonD)
     then show "monotone_map X euclideanreal f"
       by (simp add: monotone_map)
   qed
 next
   assume R: ?rhs 
   then
   have *: False 
       if "a < b" "closedin X U" "closedin X V" "U \<noteq> {}" "V \<noteq> {}" "disjnt U V"
          and UV: "{x \<in> topspace X. f x \<in> {a..b}} = U \<union> V" 
          and dis: "disjnt U {x \<in> topspace X. f x = b}" "disjnt V {x \<in> topspace X. f x = a}" 
        for a b U V
   proof -
     define E1 where "E1 \<equiv> U \<union> {x \<in> topspace X. f x \<in> {c. c \<le> a}}"
     define E2 where "E2 \<equiv> V \<union> {x \<in> topspace X. f x \<in> {c. b \<le> c}}"
     have "closedin X {x \<in> topspace X. f x \<le> a}" "closedin X {x \<in> topspace X. b \<le> f x}"
       using assms continuous_map_upper_lower_semicontinuous_le by blast+
     then have "closedin X E1" "closedin X E2"
       unfolding E1_def E2_def using that by auto
     moreover
     have "E1 \<inter> E2 = {}"
       unfolding E1_def E2_def using \<open>a<b\<close> \<open>disjnt U V\<close> dis UV
       by (simp add: disjnt_def set_eq_iff) (smt (verit))
     have "topspace X \<subseteq> E1 \<union> E2"
       unfolding E1_def E2_def using UV by fastforce
     have "E1 = {} \<or> E2 = {}"
       using R connected_space_closedin
       using \<open>E1 \<inter> E2 = {}\<close> \<open>closedin X E1\<close> \<open>closedin X E2\<close> \<open>topspace X \<subseteq> E1 \<union> E2\<close> by blast
     then show False
       using E1_def E2_def \<open>U \<noteq> {}\<close> \<open>V \<noteq> {}\<close> by fastforce
   qed
   show ?lhs
   proof (intro strip)
     fix K :: "real set"
     assume "is_interval K"
     have False
       if "a \<in> K" "b \<in> K" and clo: "closedin X U" "closedin X V" 
          and UV: "{x. x \<in> topspace X \<and> f x \<in> K} \<subseteq> U \<union> V"
                  "U \<inter> V \<inter> {x. x \<in> topspace X \<and> f x \<in> K} = {}" 
          and nondis: "\<not> disjnt U {x. x \<in> topspace X \<and> f x = a}"
                      "\<not> disjnt V {x. x \<in> topspace X \<and> f x = b}" 
      for a b U V
     proof -
       have "\<forall>y. connectedin X {x. x \<in> topspace X \<and> f x = y}"
         using R monotone_map by fastforce
       then have **: False if "p \<in> U \<and> q \<in> V \<and> f p = f q \<and> f q \<in> K" for p q
         unfolding connectedin_closedin
         using \<open>a \<in> K\<close> \<open>b \<in> K\<close> UV clo that 
         by (smt (verit, ccfv_threshold) closedin_subset disjoint_iff mem_Collect_eq subset_iff)
       consider "a < b" | "a = b" | "b < a"
         by linarith
       then show ?thesis
       proof cases
         case 1
         define W where "W \<equiv> {x \<in> topspace X. f x \<in> {a..b}}"
         have "closedin X W"
           unfolding W_def
           by (metis (no_types) assms closed_real_atLeastAtMost closed_closedin continuous_map_closedin)
         show ?thesis
         proof (rule * [OF 1 , of "U \<inter> W" "V \<inter> W"])
           show "closedin X (U \<inter> W)" "closedin X (V \<inter> W)"
             using \<open>closedin X W\<close> clo by auto
           show "U \<inter> W \<noteq> {}" "V \<inter> W \<noteq> {}"
             using nondis 1 by (auto simp: disjnt_iff W_def)
           show "disjnt (U \<inter> W) (V \<inter> W)"
             using \<open>is_interval K\<close> unfolding is_interval_1 disjnt_iff W_def
             by (metis (mono_tags, lifting) \<open>a \<in> K\<close> \<open>b \<in> K\<close> ** Int_Collect atLeastAtMost_iff)
           have "\<And>x. \<lbrakk>x \<in> topspace X; a \<le> f x; f x \<le> b\<rbrakk> \<Longrightarrow> x \<in> U \<or> x \<in> V"
             using \<open>a \<in> K\<close> \<open>b \<in> K\<close> \<open>is_interval K\<close> UV unfolding is_interval_1 disjnt_iff
             by blast
           then show "{x \<in> topspace X. f x \<in> {a..b}} = U \<inter> W \<union> V \<inter> W"
             by (auto simp: W_def)
           show "disjnt (U \<inter> W) {x \<in> topspace X. f x = b}" "disjnt (V \<inter> W) {x \<in> topspace X. f x = a}"
             using ** \<open>a \<in> K\<close> \<open>b \<in> K\<close> nondis by (force simp: disjnt_iff)+
         qed
       next
         case 2
         then show ?thesis
           using ** nondis \<open>b \<in> K\<close> by (force simp add: disjnt_iff)
       next
         case 3
         define W where "W \<equiv> {x \<in> topspace X. f x \<in> {b..a}}"
         have "closedin X W"
           unfolding W_def
           by (metis (no_types) assms closed_real_atLeastAtMost closed_closedin continuous_map_closedin)
         show ?thesis
         proof (rule * [OF 3, of "V \<inter> W" "U \<inter> W"])
           show "closedin X (U \<inter> W)" "closedin X (V \<inter> W)"
             using \<open>closedin X W\<close> clo by auto
           show "U \<inter> W \<noteq> {}" "V \<inter> W \<noteq> {}"
             using nondis 3 by (auto simp: disjnt_iff W_def)
           show "disjnt (V \<inter> W) (U \<inter> W)"
             using \<open>is_interval K\<close> unfolding is_interval_1 disjnt_iff W_def
             by (metis (mono_tags, lifting) \<open>a \<in> K\<close> \<open>b \<in> K\<close> ** Int_Collect atLeastAtMost_iff)
           have "\<And>x. \<lbrakk>x \<in> topspace X; b \<le> f x; f x \<le> a\<rbrakk> \<Longrightarrow> x \<in> U \<or> x \<in> V"
             using \<open>a \<in> K\<close> \<open>b \<in> K\<close> \<open>is_interval K\<close> UV unfolding is_interval_1 disjnt_iff
             by blast
           then show "{x \<in> topspace X. f x \<in> {b..a}} = V \<inter> W \<union> U \<inter> W"
             by (auto simp: W_def)
           show "disjnt (V \<inter> W) {x \<in> topspace X. f x = a}" "disjnt (U \<inter> W) {x \<in> topspace X. f x = b}"
             using ** \<open>a \<in> K\<close> \<open>b \<in> K\<close> nondis by (force simp: disjnt_iff)+
         qed      
       qed
     qed
     then show "connectedin X {x \<in> topspace X. f x \<in> K}"
       unfolding connectedin_closedin disjnt_iff by blast
   qed
 qed
 
 lemma monotone_map_into_euclideanreal:
    "\<lbrakk>connected_space X; continuous_map X euclideanreal f\<rbrakk>
     \<Longrightarrow> monotone_map X euclideanreal f \<longleftrightarrow>
         (\<forall>k. is_interval k \<longrightarrow> connectedin X {x \<in> topspace X. f x \<in> k})"
   by (simp add: monotone_map_into_euclideanreal_alt)
 
 lemma monotone_map_euclideanreal_alt:
    "(\<forall>I::real set. is_interval I \<longrightarrow> is_interval {x::real. x \<in> S \<and> f x \<in> I}) \<longleftrightarrow>
     is_interval S \<and> (mono_on S f \<or> antimono_on S f)" (is "?lhs=?rhs")
 proof
   assume L [rule_format]: ?lhs 
   show ?rhs
   proof
     show "is_interval S"
       using L is_interval_1 by auto
     have False if "a \<in> S" "b \<in> S" "c \<in> S" "a<b" "b<c" and d: "f a < f b \<and> f c < f b \<or> f a > f b \<and> f c > f b" for a b c
       using d
     proof
       assume "f a < f b \<and> f c < f b"
       then show False
         using L [of "{y.  y < f b}"] unfolding is_interval_1
         by (smt (verit, best) mem_Collect_eq that)
     next
       assume "f b < f a \<and> f b < f c"
       then show False
         using L [of "{y.  y > f b}"] unfolding is_interval_1
         by (smt (verit, best) mem_Collect_eq that)
     qed
     then show "mono_on S f \<or> monotone_on S (\<le>) (\<ge>) f"
       unfolding monotone_on_def by (smt (verit))
   qed
 next
   assume ?rhs then show ?lhs
     unfolding is_interval_1 monotone_on_def by simp meson
 qed
 
 
 lemma monotone_map_euclideanreal:
   fixes S :: "real set"
   shows
    "\<lbrakk>is_interval S; continuous_on S f\<rbrakk> \<Longrightarrow> 
     monotone_map (top_of_set S) euclideanreal f \<longleftrightarrow> (mono_on S f \<or> monotone_on S (\<le>) (\<ge>) f)"
   using monotone_map_euclideanreal_alt 
   by (simp add: monotone_map_into_euclideanreal connectedin_subtopology is_interval_connected_1)
 
 lemma injective_eq_monotone_map:
   fixes f :: "real \<Rightarrow> real"
   assumes "is_interval S" "continuous_on S f"
   shows "inj_on f S \<longleftrightarrow> strict_mono_on S f \<or> strict_antimono_on S f"
   by (metis assms injective_imp_monotone_map monotone_map_euclideanreal strict_antimono_iff_antimono 
         strict_mono_iff_mono top_greatest topspace_euclidean topspace_euclidean_subtopology)
 
 
 subsection\<open>Normal spaces including Urysohn's lemma and the Tietze extension theorem\<close>
 
 definition normal_space 
   where "normal_space X \<equiv>
         \<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T 
               \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V)"
 
 lemma normal_space_retraction_map_image:
   assumes r: "retraction_map X Y r" and X: "normal_space X"
   shows "normal_space Y"
   unfolding normal_space_def
 proof clarify
   fix S T
   assume "closedin Y S" and "closedin Y T" and "disjnt S T"
   obtain r' where r': "retraction_maps X Y r r'"
     using r retraction_map_def by blast
   have "closedin X {x \<in> topspace X. r x \<in> S}" "closedin X {x \<in> topspace X. r x \<in> T}"
     using closedin_continuous_map_preimage \<open>closedin Y S\<close> \<open>closedin Y T\<close> r'
     by (auto simp: retraction_maps_def)
   moreover
   have "disjnt {x \<in> topspace X. r x \<in> S} {x \<in> topspace X. r x \<in> T}"
     using \<open>disjnt S T\<close> by (auto simp: disjnt_def)
   ultimately
   obtain U V where UV: "openin X U \<and> openin X V \<and> {x \<in> topspace X. r x \<in> S} \<subseteq> U \<and> {x \<in> topspace X. r x \<in> T} \<subseteq> V" "disjnt U V"
     by (meson X normal_space_def)
   show "\<exists>U V. openin Y U \<and> openin Y V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
   proof (intro exI conjI)
     show "openin Y {x \<in> topspace Y. r' x \<in> U}" "openin Y {x \<in> topspace Y. r' x \<in> V}"
       using openin_continuous_map_preimage UV r'
       by (auto simp: retraction_maps_def)
     show "S \<subseteq> {x \<in> topspace Y. r' x \<in> U}" "T \<subseteq> {x \<in> topspace Y. r' x \<in> V}"
       using openin_continuous_map_preimage UV r' \<open>closedin Y S\<close> \<open>closedin Y T\<close> 
       by (auto simp add: closedin_def continuous_map_closedin retraction_maps_def subset_iff)
     show "disjnt {x \<in> topspace Y. r' x \<in> U} {x \<in> topspace Y. r' x \<in> V}"
       using \<open>disjnt U V\<close> by (auto simp: disjnt_def)
   qed
 qed
 
 lemma homeomorphic_normal_space:
    "X homeomorphic_space Y \<Longrightarrow> normal_space X \<longleftrightarrow> normal_space Y"
   unfolding homeomorphic_space_def
   by (meson homeomorphic_imp_retraction_maps homeomorphic_maps_sym normal_space_retraction_map_image retraction_map_def)
 
 lemma normal_space:
   "normal_space X \<longleftrightarrow>
     (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
           \<longrightarrow> (\<exists>U. openin X U \<and> S \<subseteq> U \<and> disjnt T (X closure_of U)))"
 proof -
   have "(\<exists>V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V) \<longleftrightarrow> openin X U \<and> S \<subseteq> U \<and> disjnt T (X closure_of U)"
     (is "?lhs=?rhs")
     if "closedin X S" "closedin X T" "disjnt S T" for S T U
   proof
     show "?lhs \<Longrightarrow> ?rhs"
       by (smt (verit, best) disjnt_iff in_closure_of subsetD)
     assume R: ?rhs
     then have "(U \<union> S) \<inter> (topspace X - X closure_of U) = {}"
       by (metis Diff_eq_empty_iff Int_Diff Int_Un_eq(4) closure_of_subset inf.orderE openin_subset)
     moreover have "T \<subseteq> topspace X - X closure_of U"
       by (meson DiffI R closedin_subset disjnt_iff subsetD subsetI that(2))
     ultimately show ?lhs
       by (metis R closedin_closure_of closedin_def disjnt_def sup.orderE)
   qed
   then show ?thesis
     unfolding normal_space_def by meson
 qed
 
 lemma normal_space_alt:
    "normal_space X \<longleftrightarrow>
     (\<forall>S U. closedin X S \<and> openin X U \<and> S \<subseteq> U \<longrightarrow> (\<exists>V. openin X V \<and> S \<subseteq> V \<and> X closure_of V \<subseteq> U))"
 proof -
   have "\<exists>V. openin X V \<and> S \<subseteq> V \<and> X closure_of V \<subseteq> U"
     if "\<And>T. closedin X T \<longrightarrow> disjnt S T \<longrightarrow> (\<exists>U. openin X U \<and> S \<subseteq> U \<and> disjnt T (X closure_of U))"
        "closedin X S" "openin X U" "S \<subseteq> U"
     for S U
     using that 
     by (smt (verit) Diff_eq_empty_iff Int_Diff closure_of_subset_topspace disjnt_def inf.orderE inf_commute openin_closedin_eq)
   moreover have "\<exists>U. openin X U \<and> S \<subseteq> U \<and> disjnt T (X closure_of U)"
     if "\<And>U. openin X U \<and> S \<subseteq> U \<longrightarrow> (\<exists>V. openin X V \<and> S \<subseteq> V \<and> X closure_of V \<subseteq> U)"
       and "closedin X S" "closedin X T" "disjnt S T"
     for S T
     using that   
     by (smt (verit) Diff_Diff_Int Diff_eq_empty_iff Int_Diff closedin_def disjnt_def inf.absorb_iff2 inf.orderE)
   ultimately show ?thesis
     by (fastforce simp: normal_space)
 qed
 
 lemma normal_space_closures:
    "normal_space X \<longleftrightarrow>
     (\<forall>S T. S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and>
               disjnt (X closure_of S) (X closure_of T)
               \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V))" 
    (is "?lhs=?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (meson closedin_closure_of closure_of_subset normal_space_def order.trans)
   show "?rhs \<Longrightarrow> ?lhs"
     by (metis closedin_subset closure_of_eq normal_space_def)
 qed
 
 lemma normal_space_disjoint_closures:
    "normal_space X \<longleftrightarrow>
     (\<forall>S T. closedin X S \<and> closedin X T \<and> disjnt S T
           \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and>
                     disjnt (X closure_of U) (X closure_of V)))"
    (is "?lhs=?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (metis closedin_closure_of normal_space)
   show "?rhs \<Longrightarrow> ?lhs"
     by (smt (verit) closure_of_subset disjnt_iff normal_space openin_subset subset_eq)
 qed
 
 lemma normal_space_dual:
    "normal_space X \<longleftrightarrow>
     (\<forall>U V. openin X U \<longrightarrow> openin X V \<and> U \<union> V = topspace X
           \<longrightarrow> (\<exists>S T. closedin X S \<and> closedin X T \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> S \<union> T = topspace X))"
    (is "_ = ?rhs")
 proof -
   have "normal_space X \<longleftrightarrow>
         (\<forall>U V. closedin X U \<longrightarrow> closedin X V \<longrightarrow> disjnt U V \<longrightarrow>
               (\<exists>S T. \<not> (openin X S \<and> openin X T \<longrightarrow>
                          \<not> (U \<subseteq> S \<and> V \<subseteq> T \<and> disjnt S T))))"
     unfolding normal_space_def by meson
   also have "... \<longleftrightarrow> (\<forall>U V. openin X U \<longrightarrow> openin X V \<and> disjnt (topspace X - U) (topspace X - V) \<longrightarrow>
               (\<exists>S T. \<not> (openin X S \<and> openin X T \<longrightarrow>
                          \<not> (topspace X - U \<subseteq> S \<and> topspace X - V \<subseteq> T \<and> disjnt S T))))"
     by (auto simp: all_closedin)
   also have "... \<longleftrightarrow> ?rhs"
   proof -
     have *: "disjnt (topspace X - U) (topspace X - V) \<longleftrightarrow> U \<union> V = topspace X"
       if "U \<subseteq> topspace X" "V \<subseteq> topspace X" for U V
       using that by (auto simp: disjnt_iff)
     show ?thesis
       using ex_closedin *
       apply (simp add: ex_closedin * [OF openin_subset openin_subset] cong: conj_cong)
       apply (intro all_cong1 ex_cong1 imp_cong refl)
       by (smt (verit, best) "*" Diff_Diff_Int Diff_subset Diff_subset_conv inf.orderE inf_commute openin_subset sup_commute)
   qed
   finally show ?thesis .
 qed
 
 
 lemma normal_t1_imp_Hausdorff_space:
   assumes "normal_space X" "t1_space X"
   shows "Hausdorff_space X"
   unfolding Hausdorff_space_def
 proof clarify
   fix x y
   assume xy: "x \<in> topspace X" "y \<in> topspace X" "x \<noteq> y"
   then have "disjnt {x} {y}"
     by (auto simp: disjnt_iff)
   then show "\<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
     using assms xy closedin_t1_singleton normal_space_def
     by (metis singletonI subsetD)
 qed
 
 lemma normal_t1_eq_Hausdorff_space:
    "normal_space X \<Longrightarrow> t1_space X \<longleftrightarrow> Hausdorff_space X"
   using normal_t1_imp_Hausdorff_space t1_or_Hausdorff_space by blast
 
 lemma normal_t1_imp_regular_space:
    "\<lbrakk>normal_space X; t1_space X\<rbrakk> \<Longrightarrow> regular_space X"
   by (metis compactin_imp_closedin normal_space_def normal_t1_eq_Hausdorff_space regular_space_compact_closed_sets)
 
 lemma compact_Hausdorff_or_regular_imp_normal_space:
    "\<lbrakk>compact_space X; Hausdorff_space X \<or> regular_space X\<rbrakk>
         \<Longrightarrow> normal_space X"
   by (metis Hausdorff_space_compact_sets closedin_compact_space normal_space_def regular_space_compact_closed_sets)
 
 lemma normal_space_discrete_topology:
    "normal_space(discrete_topology U)"
   by (metis discrete_topology_closure_of inf_le2 normal_space_alt)
 
 lemma normal_space_fsigmas:
   "normal_space X \<longleftrightarrow>
     (\<forall>S T. fsigma_in X S \<and> fsigma_in X T \<and> separatedin X S T
            \<longrightarrow> (\<exists>U B. openin X U \<and> openin X B \<and> S \<subseteq> U \<and> T \<subseteq> B \<and> disjnt U B))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof clarify
     fix S T
     assume "fsigma_in X S" 
     then obtain C where C: "\<And>n. closedin X (C n)" "\<And>n. C n \<subseteq> C (Suc n)" "\<Union> (range C) = S"
       by (meson fsigma_in_ascending)
     assume "fsigma_in X T" 
     then obtain D where D: "\<And>n. closedin X (D n)" "\<And>n. D n \<subseteq> D (Suc n)" "\<Union> (range D) = T"
       by (meson fsigma_in_ascending)
     assume "separatedin X S T"
     have "\<And>n. disjnt (D n) (X closure_of S)"
       by (metis D(3) \<open>separatedin X S T\<close> disjnt_Union1 disjnt_def rangeI separatedin_def)
     then have "\<And>n. \<exists>V V'. openin X V \<and> openin X V' \<and> D n \<subseteq> V \<and> X closure_of S \<subseteq> V' \<and> disjnt V V'"
       by (metis D(1) L closedin_closure_of normal_space_def)
     then obtain V V' where V: "\<And>n. openin X (V n)" and "\<And>n. openin X (V' n)" "\<And>n. disjnt (V n) (V' n)"
           and DV:  "\<And>n. D n \<subseteq> V n" 
           and subV': "\<And>n. X closure_of S \<subseteq> V' n"
       by metis
     then have VV: "V' n \<inter> X closure_of V n = {}" for n
       using openin_Int_closure_of_eq_empty [of X "V' n" "V n"] by (simp add: Int_commute disjnt_def)
     have "\<And>n. disjnt (C n) (X closure_of T)"
       by (metis C(3) \<open>separatedin X S T\<close> disjnt_Union1 disjnt_def rangeI separatedin_def)
     then have "\<And>n. \<exists>U U'. openin X U \<and> openin X U' \<and> C n \<subseteq> U \<and> X closure_of T \<subseteq> U' \<and> disjnt U U'"
       by (metis C(1) L closedin_closure_of normal_space_def)
     then obtain U U' where U: "\<And>n. openin X (U n)" and "\<And>n. openin X (U' n)" "\<And>n. disjnt (U n) (U' n)"
           and CU:  "\<And>n. C n \<subseteq> U n" 
           and subU': "\<And>n. X closure_of T \<subseteq> U' n"
       by metis
     then have UU: "U' n \<inter> X closure_of U n = {}" for n
       using openin_Int_closure_of_eq_empty [of X "U' n" "U n"] by (simp add: Int_commute disjnt_def)
     show "\<exists>U B. openin X U \<and> openin X B \<and> S \<subseteq> U \<and> T \<subseteq> B \<and> disjnt U B"
     proof (intro conjI exI)
       have "\<And>S n. closedin X (\<Union>m\<le>n. X closure_of V m)"
         by (force intro: closedin_Union)
       then show "openin X (\<Union>n. U n - (\<Union>m\<le>n. X closure_of V m))"
         using U by blast
       have "\<And>S n. closedin X (\<Union>m\<le>n. X closure_of U m)"
         by (force intro: closedin_Union)
       then show "openin X (\<Union>n. V n - (\<Union>m\<le>n. X closure_of U m))"
         using V by blast
       have "S \<subseteq> topspace X"
         by (simp add: \<open>fsigma_in X S\<close> fsigma_in_subset)
       then show "S \<subseteq> (\<Union>n. U n - (\<Union>m\<le>n. X closure_of V m))"
         apply (clarsimp simp: Ball_def)
         by (metis VV C(3) CU IntI UN_E closure_of_subset empty_iff subV' subsetD)
       have "T \<subseteq> topspace X"
         by (simp add: \<open>fsigma_in X T\<close> fsigma_in_subset)
       then show "T \<subseteq> (\<Union>n. V n - (\<Union>m\<le>n. X closure_of U m))"
         apply (clarsimp simp: Ball_def)
         by (metis UU D(3) DV IntI UN_E closure_of_subset empty_iff subU' subsetD)
       have "\<And>x m n. \<lbrakk>x \<in> U n; x \<in> V m; \<forall>k\<le>m. x \<notin> X closure_of U k\<rbrakk> \<Longrightarrow> \<exists>k\<le>n. x \<in> X closure_of V k"
         by (meson U V closure_of_subset nat_le_linear openin_subset subsetD)
       then show "disjnt (\<Union>n. U n - (\<Union>m\<le>n. X closure_of V m)) (\<Union>n. V n - (\<Union>m\<le>n. X closure_of U m))"
         by (force simp: disjnt_iff)
     qed
   qed
 next
   show "?rhs \<Longrightarrow> ?lhs"
     by (simp add: closed_imp_fsigma_in normal_space_def separatedin_closed_sets)
 qed
 
 lemma normal_space_fsigma_subtopology:
   assumes "normal_space X" "fsigma_in X S"
   shows "normal_space (subtopology X S)"
   unfolding normal_space_fsigmas
 proof clarify
   fix T U
   assume "fsigma_in (subtopology X S) T"
       and "fsigma_in (subtopology X S) U"
       and TU: "separatedin (subtopology X S) T U"
   then obtain A B where "openin X A \<and> openin X B \<and> T \<subseteq> A \<and> U \<subseteq> B \<and> disjnt A B"
     by (metis assms fsigma_in_fsigma_subtopology normal_space_fsigmas separatedin_subtopology)
   then
   show "\<exists>A B. openin (subtopology X S) A \<and> openin (subtopology X S) B \<and> T \<subseteq> A \<and>
    U \<subseteq> B \<and> disjnt A B"
     using TU
     by (force simp add: separatedin_subtopology openin_subtopology_alt disjnt_iff)
 qed
 
 lemma normal_space_closed_subtopology:
   assumes "normal_space X" "closedin X S"
   shows "normal_space (subtopology X S)"
   by (simp add: assms closed_imp_fsigma_in normal_space_fsigma_subtopology)
 
 lemma normal_space_continuous_closed_map_image:
   assumes "normal_space X" and contf: "continuous_map X Y f" 
     and clof: "closed_map X Y f"  and fim: "f ` topspace X = topspace Y"
 shows "normal_space Y"
   unfolding normal_space_def
 proof clarify
   fix S T
   assume "closedin Y S" and "closedin Y T" and "disjnt S T"
   have "closedin X {x \<in> topspace X. f x \<in> S}" "closedin X {x \<in> topspace X. f x \<in> T}"
     using \<open>closedin Y S\<close> \<open>closedin Y T\<close> closedin_continuous_map_preimage contf by auto
   moreover
   have "disjnt {x \<in> topspace X. f x \<in> S} {x \<in> topspace X. f x \<in> T}"
     using \<open>disjnt S T\<close> by (auto simp: disjnt_iff)
   ultimately
   obtain U V where "closedin X U" "closedin X V" 
     and subXU: "{x \<in> topspace X. f x \<in> S} \<subseteq> topspace X - U" 
     and subXV: "{x \<in> topspace X. f x \<in> T} \<subseteq> topspace X - V" 
     and dis: "disjnt (topspace X - U) (topspace X -V)"
     using \<open>normal_space X\<close> by (force simp add: normal_space_def ex_openin)
   have "closedin Y (f ` U)" "closedin Y (f ` V)"
     using \<open>closedin X U\<close> \<open>closedin X V\<close> clof closed_map_def by blast+
   moreover have "S \<subseteq> topspace Y - f ` U"
     using \<open>closedin Y S\<close> \<open>closedin X U\<close> subXU by (force dest: closedin_subset)
   moreover have "T \<subseteq> topspace Y - f ` V"
     using \<open>closedin Y T\<close> \<open>closedin X V\<close> subXV by (force dest: closedin_subset)
   moreover have "disjnt (topspace Y - f ` U) (topspace Y - f ` V)"
     using fim dis by (force simp add: disjnt_iff)
   ultimately show "\<exists>U V. openin Y U \<and> openin Y V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V"
     by (force simp add: ex_openin)
 qed
 
 
 subsection \<open>Hereditary topological properties\<close>
 
 definition hereditarily 
   where "hereditarily P X \<equiv>
         \<forall>S. S \<subseteq> topspace X \<longrightarrow> P(subtopology X S)"
 
 lemma hereditarily:
    "hereditarily P X \<longleftrightarrow> (\<forall>S. P(subtopology X S))"
   by (metis Int_lower1 hereditarily_def subtopology_restrict)
 
 lemma hereditarily_mono:
    "\<lbrakk>hereditarily P X; \<And>x. P x \<Longrightarrow> Q x\<rbrakk> \<Longrightarrow> hereditarily Q X"
   by (simp add: hereditarily)
 
 lemma hereditarily_inc:
    "hereditarily P X \<Longrightarrow> P X"
   by (metis hereditarily subtopology_topspace)
 
 lemma hereditarily_subtopology:
    "hereditarily P X \<Longrightarrow> hereditarily P (subtopology X S)"
   by (simp add: hereditarily subtopology_subtopology)
 
 lemma hereditarily_normal_space_continuous_closed_map_image:
   assumes X: "hereditarily normal_space X" and contf: "continuous_map X Y f" 
     and clof: "closed_map X Y f"  and fim: "f ` (topspace X) = topspace Y" 
   shows "hereditarily normal_space Y"
   unfolding hereditarily_def
 proof (intro strip)
   fix T
   assume "T \<subseteq> topspace Y"
   then have nx: "normal_space (subtopology X {x \<in> topspace X. f x \<in> T})"
     by (meson X hereditarily)
   moreover have "continuous_map (subtopology X {x \<in> topspace X. f x \<in> T}) (subtopology Y T) f"
     by (simp add: contf continuous_map_from_subtopology continuous_map_in_subtopology image_subset_iff)
   moreover have "closed_map (subtopology X {x \<in> topspace X. f x \<in> T}) (subtopology Y T) f"
     by (simp add: clof closed_map_restriction)
   ultimately show "normal_space (subtopology Y T)"
     using fim normal_space_continuous_closed_map_image by fastforce
 qed
 
 lemma homeomorphic_hereditarily_normal_space:
    "X homeomorphic_space Y
       \<Longrightarrow> (hereditarily normal_space X \<longleftrightarrow> hereditarily normal_space Y)"
   by (meson hereditarily_normal_space_continuous_closed_map_image homeomorphic_eq_everything_map 
       homeomorphic_space homeomorphic_space_sym)
 
 lemma hereditarily_normal_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; hereditarily normal_space X\<rbrakk> \<Longrightarrow> hereditarily normal_space Y"
   by (smt (verit) hereditarily_subtopology hereditary_imp_retractive_property homeomorphic_hereditarily_normal_space)
 
 subsection\<open>Limits in a topological space\<close>
 
 lemma limitin_const_iff:
   assumes "t1_space X" "\<not> trivial_limit F"
   shows "limitin X (\<lambda>k. a) l F \<longleftrightarrow> l \<in> topspace X \<and> a = l"  (is "?lhs=?rhs")
 proof
   assume ?lhs then show ?rhs
     using assms unfolding limitin_def t1_space_def by (metis eventually_const openin_topspace)
 next
   assume ?rhs then show ?lhs
     using assms by (auto simp: limitin_def t1_space_def)
 qed
 
 lemma compactin_sequence_with_limit:
   assumes lim: "limitin X \<sigma> l sequentially" and "S \<subseteq> range \<sigma>" and SX: "S \<subseteq> topspace X"
   shows "compactin X (insert l S)"
 unfolding compactin_def
 proof (intro conjI strip)
   show "insert l S \<subseteq> topspace X"
     by (meson SX insert_subset lim limitin_topspace)
   fix \<U>
   assume \<section>: "Ball \<U> (openin X) \<and> insert l S \<subseteq> \<Union> \<U>"
   have "\<exists>V. finite V \<and> V \<subseteq> \<U> \<and> (\<exists>t \<in> V. l \<in> t) \<and> S \<subseteq> \<Union> V"
     if *: "\<forall>x \<in> S. \<exists>T \<in> \<U>. x \<in> T" and "T \<in> \<U>" "l \<in> T" for T
   proof -
     obtain V where V: "\<And>x. x \<in> S \<Longrightarrow> V x \<in> \<U> \<and> x \<in> V x"
       using * by metis
     obtain N where N: "\<And>n. N \<le> n \<Longrightarrow> \<sigma> n \<in> T"
       by (meson "\<section>" \<open>T \<in> \<U>\<close> \<open>l \<in> T\<close> lim limitin_sequentially)
     show ?thesis
     proof (intro conjI exI)
       have "x \<in> T"
         if "x \<in> S" and "\<forall>A. (\<forall>x \<in> S. (\<forall>n\<le>N. x \<noteq> \<sigma> n) \<or> A \<noteq> V x) \<or> x \<notin> A" for x 
         by (metis (no_types) N V that assms(2) imageE nle_le subsetD)
       then show "S \<subseteq> \<Union> (insert T (V ` (S \<inter> \<sigma> ` {0..N})))"
         by force
     qed (use V that in auto)
   qed
   then show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> insert l S \<subseteq> \<Union> \<F>"
     by (smt (verit, best) Union_iff \<section> insert_subset subsetD)
 qed
 
 lemma limitin_Hausdorff_unique:
   assumes "limitin X f l1 F" "limitin X f l2 F" "\<not> trivial_limit F" "Hausdorff_space X"
   shows "l1 = l2"
 proof (rule ccontr)
   assume "l1 \<noteq> l2"
   with assms obtain U V where "openin X U" "openin X V" "l1 \<in> U" "l2 \<in> V" "disjnt U V"
     by (metis Hausdorff_space_def limitin_topspace)
   then have "eventually (\<lambda>x. f x \<in> U) F" "eventually (\<lambda>x. f x \<in> V) F"
     using assms by (fastforce simp: limitin_def)+
   then have "\<exists>x. f x \<in> U \<and> f x \<in> V"
     using assms eventually_elim2 filter_eq_iff by fastforce
   with assms \<open>disjnt U V\<close> show False
     by (meson disjnt_iff)
 qed
 
 lemma limitin_kc_unique:
   assumes "kc_space X" and lim1: "limitin X f l1 sequentially" and lim2: "limitin X f l2 sequentially"
   shows "l1 = l2"
 proof (rule ccontr)
   assume "l1 \<noteq> l2"
   define A where "A \<equiv> insert l1 (range f - {l2})"
   have "l1 \<in> topspace X"
     using lim1 limitin_def by fastforce
   moreover have "compactin X (insert l1 (topspace X \<inter> (range f - {l2})))"
     by (meson Diff_subset compactin_sequence_with_limit inf_le1 inf_le2 lim1 subset_trans)
   ultimately have "compactin X (topspace X \<inter> A)"
     by (simp add: A_def)
   then have OXA: "openin X (topspace X - A)"
     by (metis Diff_Diff_Int Diff_subset \<open>kc_space X\<close> kc_space_def openin_closedin_eq)
   have "l2 \<in> topspace X - A"
     using \<open>l1 \<noteq> l2\<close> A_def lim2 limitin_topspace by fastforce
   then have "\<forall>\<^sub>F x in sequentially. f x = l2"
     using limitinD [OF lim2 OXA] by (auto simp: A_def eventually_conj_iff)
   then show False
     using limitin_transform_eventually [OF _ lim1] 
           limitin_const_iff [OF kc_imp_t1_space trivial_limit_sequentially]
     using \<open>l1 \<noteq> l2\<close> \<open>kc_space X\<close> by fastforce
 qed
 
 lemma limitin_closedin:
   assumes lim: "limitin X f l F" 
     and "closedin X S" and ev: "eventually (\<lambda>x. f x \<in> S) F" "\<not> trivial_limit F"
   shows "l \<in> S"
 proof (rule ccontr)
   assume "l \<notin> S"
   have "\<forall>\<^sub>F x in F. f x \<in> topspace X - S"
     by (metis Diff_iff \<open>l \<notin> S\<close> \<open>closedin X S\<close> closedin_def lim limitin_def)
   with ev eventually_elim2 trivial_limit_def show False
     by force
 qed
 
 subsection\<open>Quasi-components\<close>
 
 definition quasi_component_of :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   where
   "quasi_component_of X x y \<equiv>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         (\<forall>T. closedin X T \<and> openin X T \<longrightarrow> (x \<in> T \<longleftrightarrow> y \<in> T))"
 
 abbreviation "quasi_component_of_set S x \<equiv> Collect (quasi_component_of S x)"
 
 definition quasi_components_of :: "'a topology \<Rightarrow> ('a set) set"
   where
   "quasi_components_of X = quasi_component_of_set X ` topspace X"
 
 lemma quasi_component_in_topspace:
    "quasi_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (simp add: quasi_component_of_def)
 
 lemma quasi_component_of_refl [simp]:
    "quasi_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   by (simp add: quasi_component_of_def)
 
 lemma quasi_component_of_sym:
    "quasi_component_of X x y \<longleftrightarrow> quasi_component_of X y x"
   by (meson quasi_component_of_def)
 
 lemma quasi_component_of_trans:
    "\<lbrakk>quasi_component_of X x y; quasi_component_of X y z\<rbrakk> \<Longrightarrow> quasi_component_of X x z"
   by (simp add: quasi_component_of_def)
 
 lemma quasi_component_of_subset_topspace:
    "quasi_component_of_set X x \<subseteq> topspace X"
   using quasi_component_of_def by fastforce
 
 lemma quasi_component_of_eq_empty:
    "quasi_component_of_set X x = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using quasi_component_of_def by fastforce
 
 lemma quasi_component_of:
    "quasi_component_of X x y \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> closedin X T \<and> openin X T \<longrightarrow> y \<in> T)"
-  unfolding quasi_component_of_def by blast
+  unfolding quasi_component_of_def by (metis Diff_iff closedin_def openin_closedin_eq) 
 
 lemma quasi_component_of_alt:
   "quasi_component_of X x y \<longleftrightarrow>
       x \<in> topspace X \<and> y \<in> topspace X \<and>
       \<not> (\<exists>U V. openin X U \<and> openin X V \<and> U \<union> V = topspace X \<and> disjnt U V \<and> x \<in> U \<and> y \<in> V)" 
   (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding quasi_component_of_def
     by (metis disjnt_iff separatedin_full separatedin_open_sets)
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding quasi_component_of_def
     by (metis Diff_disjoint Diff_iff Un_Diff_cancel closedin_def disjnt_def inf_commute sup.orderE sup_commute)
 qed
 
 lemma quasi_component_of_separated:
    "quasi_component_of X x y \<longleftrightarrow>
      x \<in> topspace X \<and> y \<in> topspace X \<and>
      \<not> (\<exists>U V. separatedin X U V \<and> U \<union> V = topspace X \<and> x \<in> U \<and> y \<in> V)"
   by (meson quasi_component_of_alt separatedin_full separatedin_open_sets)
 
 lemma quasi_component_of_subtopology:
   "quasi_component_of (subtopology X s) x y \<Longrightarrow> quasi_component_of X x y"
   unfolding quasi_component_of_def
   by (simp add: closedin_subtopology) (metis Int_iff inf_commute openin_subtopology_Int2)
 
 lemma quasi_component_of_mono:
    "quasi_component_of (subtopology X S) x y \<and> S \<subseteq> T
         \<Longrightarrow> quasi_component_of (subtopology X T) x y"
   by (metis inf.absorb_iff2 quasi_component_of_subtopology subtopology_subtopology)
 
 lemma quasi_component_of_equiv:
    "quasi_component_of X x y \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> quasi_component_of X x = quasi_component_of X y"
   using quasi_component_of_def by fastforce
 
 lemma quasi_component_of_disjoint [simp]:
    "disjnt (quasi_component_of_set X x) (quasi_component_of_set X y) \<longleftrightarrow> \<not> (quasi_component_of X x y)"
   by (metis disjnt_iff quasi_component_of_equiv mem_Collect_eq)
 
 lemma quasi_component_of_eq:
    "quasi_component_of X x = quasi_component_of X y \<longleftrightarrow>
     (x \<notin> topspace X \<and> y \<notin> topspace X) 
   \<or> x \<in> topspace X \<and> y \<in> topspace X \<and> quasi_component_of X x y"
   by (metis Collect_empty_eq_bot quasi_component_of_eq_empty quasi_component_of_equiv)
 
 lemma topspace_imp_quasi_components_of:
   assumes "x \<in> topspace X"
   obtains C where "C \<in> quasi_components_of X" "x \<in> C"
   by (metis assms imageI mem_Collect_eq quasi_component_of_refl quasi_components_of_def)
 
 lemma Union_quasi_components_of: "\<Union> (quasi_components_of X) = topspace X"
   by (auto simp: quasi_components_of_def quasi_component_of_def)
 
 lemma pairwise_disjoint_quasi_components_of:
    "pairwise disjnt (quasi_components_of X)"
   by (auto simp: quasi_components_of_def quasi_component_of_def disjoint_def)
 
 lemma complement_quasi_components_of_Union:
   assumes "C \<in> quasi_components_of X"
   shows "topspace X - C = \<Union> (quasi_components_of X - {C})"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using Union_quasi_components_of by fastforce
   show "?rhs \<subseteq> ?lhs"
     using assms
     using quasi_component_of_equiv by (fastforce simp add: quasi_components_of_def image_iff subset_iff)
 qed
 
 lemma nonempty_quasi_components_of:
    "C \<in> quasi_components_of X \<Longrightarrow> C \<noteq> {}"
   by (metis imageE quasi_component_of_eq_empty quasi_components_of_def)
 
 lemma quasi_components_of_subset:
    "C \<in> quasi_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   using Union_quasi_components_of by force
 
 lemma quasi_component_in_quasi_components_of:
    "quasi_component_of_set X a \<in> quasi_components_of X \<longleftrightarrow> a \<in> topspace X"
   by (metis (no_types, lifting) image_iff quasi_component_of_eq_empty quasi_components_of_def)
 
 lemma quasi_components_of_eq_empty [simp]:
    "quasi_components_of X = {} \<longleftrightarrow> topspace X = {}"
   by (simp add: quasi_components_of_def)
 
 lemma quasi_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> quasi_components_of X = {}"
   by simp
 
 lemma quasi_component_of_set:
    "quasi_component_of_set X x =
         (if x \<in> topspace X
         then \<Inter> {t. closedin X t \<and> openin X t \<and> x \<in> t}
         else {})"
   by (auto simp: quasi_component_of)
 
 lemma closedin_quasi_component_of: "closedin X (quasi_component_of_set X x)"
   by (auto simp: quasi_component_of_set)
 
 lemma closedin_quasi_components_of:
    "C \<in> quasi_components_of X \<Longrightarrow> closedin X C"
   by (auto simp: quasi_components_of_def closedin_quasi_component_of)
 
 lemma openin_finite_quasi_components:
   "\<lbrakk>finite(quasi_components_of X); C \<in> quasi_components_of X\<rbrakk> \<Longrightarrow> openin X C"
   apply (simp add:openin_closedin_eq quasi_components_of_subset complement_quasi_components_of_Union)
   by (meson DiffD1 closedin_Union closedin_quasi_components_of finite_Diff)
 
 lemma quasi_component_of_eq_overlap:
    "quasi_component_of X x = quasi_component_of X y \<longleftrightarrow>
       (x \<notin> topspace X \<and> y \<notin> topspace X) \<or>
       \<not> (quasi_component_of_set X x \<inter> quasi_component_of_set X y = {})"
   using quasi_component_of_equiv by fastforce
 
 lemma quasi_component_of_nonoverlap:
    "quasi_component_of_set X x \<inter> quasi_component_of_set X y = {} \<longleftrightarrow>
      (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
      \<not> (quasi_component_of X x = quasi_component_of X y)"
   by (metis inf.idem quasi_component_of_eq_empty quasi_component_of_eq_overlap)
 
 lemma quasi_component_of_overlap:
    "\<not> (quasi_component_of_set X x \<inter> quasi_component_of_set X y = {}) \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> quasi_component_of X x = quasi_component_of X y"
   by (meson quasi_component_of_nonoverlap)
 
 lemma quasi_components_of_disjoint:
    "\<lbrakk>C \<in> quasi_components_of X; D \<in> quasi_components_of X\<rbrakk> \<Longrightarrow> disjnt C D \<longleftrightarrow> C \<noteq> D"
   by (metis disjnt_self_iff_empty nonempty_quasi_components_of pairwiseD pairwise_disjoint_quasi_components_of)
 
 lemma quasi_components_of_overlap:
    "\<lbrakk>C \<in> quasi_components_of X; D \<in> quasi_components_of X\<rbrakk> \<Longrightarrow> \<not> (C \<inter> D = {}) \<longleftrightarrow> C = D"
   by (metis disjnt_def quasi_components_of_disjoint)
 
 lemma pairwise_separated_quasi_components_of:
    "pairwise (separatedin X) (quasi_components_of X)"
   by (metis closedin_quasi_components_of pairwise_def pairwise_disjoint_quasi_components_of separatedin_closed_sets)
 
 lemma finite_quasi_components_of_finite:
    "finite(topspace X) \<Longrightarrow> finite(quasi_components_of X)"
   by (simp add: Union_quasi_components_of finite_UnionD)
 
 lemma connected_imp_quasi_component_of:
   assumes "connected_component_of X x y"
   shows "quasi_component_of X x y"
 proof -
   have "x \<in> topspace X" "y \<in> topspace X"
     by (meson assms connected_component_of_equiv)+
   with assms show ?thesis
     apply (clarsimp simp add: quasi_component_of connected_component_of_def)
     by (meson connectedin_clopen_cases disjnt_iff subsetD)
 qed
 
 lemma connected_component_subset_quasi_component_of:
    "connected_component_of_set X x \<subseteq> quasi_component_of_set X x"
   using connected_imp_quasi_component_of by force
 
 lemma quasi_component_as_connected_component_Union:
    "quasi_component_of_set X x =
     \<Union> (connected_component_of_set X ` quasi_component_of_set X x)" 
     (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using connected_component_of_refl quasi_component_of by fastforce
   show "?rhs \<subseteq> ?lhs"
     apply (rule SUP_least)
     by (simp add: connected_component_subset_quasi_component_of quasi_component_of_equiv)
 qed
 
 lemma quasi_components_as_connected_components_Union:
   assumes "C \<in> quasi_components_of X"
   obtains \<T> where "\<T> \<subseteq> connected_components_of X" "\<Union>\<T> = C"
 proof -
   obtain x where "x \<in> topspace X" and Ceq: "C = quasi_component_of_set X x"
     by (metis assms imageE quasi_components_of_def)
   define \<T> where "\<T> \<equiv> connected_component_of_set X ` quasi_component_of_set X x"
   show thesis
   proof
     show "\<T> \<subseteq> connected_components_of X"
       by (simp add: \<T>_def connected_components_of_def image_mono quasi_component_of_subset_topspace)
     show "\<Union>\<T> = C"
       by (metis \<T>_def Ceq quasi_component_as_connected_component_Union)
   qed
 qed
 
 lemma path_imp_quasi_component_of:
    "path_component_of X x y \<Longrightarrow> quasi_component_of X x y"
   by (simp add: connected_imp_quasi_component_of path_imp_connected_component_of)
 
 lemma path_component_subset_quasi_component_of:
    "path_component_of_set X x \<subseteq> quasi_component_of_set X x"
   by (simp add: Collect_mono path_imp_quasi_component_of)
 
 lemma connected_space_iff_quasi_component:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. quasi_component_of X x y)"
   unfolding connected_space_clopen_in closedin_def quasi_component_of
   by blast
 
 lemma connected_space_imp_quasi_component_of:
    " \<lbrakk>connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk> \<Longrightarrow> quasi_component_of X a b"
   by (simp add: connected_space_iff_quasi_component)
 
 lemma connected_space_quasi_component_set:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. quasi_component_of_set X x = topspace X)"
   by (metis Ball_Collect connected_space_iff_quasi_component quasi_component_of_subset_topspace subset_antisym)
 
 lemma connected_space_iff_quasi_components_eq:
   "connected_space X \<longleftrightarrow>
     (\<forall>C \<in> quasi_components_of X. \<forall>D \<in> quasi_components_of X. C = D)"
   apply (simp add: quasi_components_of_def)
   by (metis connected_space_iff_quasi_component mem_Collect_eq quasi_component_of_equiv)
 
 lemma quasi_components_of_subset_sing:
    "quasi_components_of X \<subseteq> {S} \<longleftrightarrow> connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "quasi_components_of X = {}")
   case True
   then show ?thesis
     by (simp add: connected_space_topspace_empty subset_singleton_iff)
 next
   case False
   then show ?thesis
     apply (simp add: connected_space_iff_quasi_components_eq subset_iff Ball_def)
     by (metis quasi_components_of_subset subsetI subset_antisym subset_empty topspace_imp_quasi_components_of)
 qed
 
 lemma connected_space_iff_quasi_components_subset_sing:
    "connected_space X \<longleftrightarrow> (\<exists>a. quasi_components_of X \<subseteq> {a})"
   by (simp add: quasi_components_of_subset_sing)
 
 lemma quasi_components_of_eq_singleton:
    "quasi_components_of X = {S} \<longleftrightarrow>
         connected_space X \<and> \<not> (topspace X = {}) \<and> S = topspace X"
   by (metis ccpo_Sup_singleton insert_not_empty quasi_components_of_subset_sing subset_singleton_iff)
 
 lemma quasi_components_of_connected_space:
    "connected_space X
         \<Longrightarrow> quasi_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: quasi_components_of_eq_singleton)
 
 lemma separated_between_singletons:
    "separated_between X {x} {y} \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> \<not> (quasi_component_of X x y)"
 proof (cases "x \<in> topspace X \<and> y \<in> topspace X")
   case True
   then show ?thesis
     by (auto simp add: separated_between_def quasi_component_of_alt)
 qed (use separated_between_imp_subset in blast)
 
 lemma quasi_component_nonseparated:
    "quasi_component_of X x y \<longleftrightarrow> x \<in> topspace X \<and> y \<in> topspace X \<and> \<not> (separated_between X {x} {y})"
   by (metis quasi_component_of_equiv separated_between_singletons)
 
 lemma separated_between_quasi_component_pointwise_left:
   assumes "C \<in> quasi_components_of X"
   shows "separated_between X C S \<longleftrightarrow> (\<exists>x \<in> C. separated_between X {x} S)"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     using assms quasi_components_of_disjoint separated_between_mono by fastforce
 next
   assume ?rhs
   then obtain y where "separated_between X {y} S" and "y \<in> C"
     by metis
   with assms show ?lhs
     by (force simp add: separated_between quasi_components_of_def quasi_component_of_def)
 qed
 
 lemma separated_between_quasi_component_pointwise_right:
    "C \<in> quasi_components_of X \<Longrightarrow> separated_between X S C \<longleftrightarrow> (\<exists>x \<in> C. separated_between X S {x})"
   by (simp add: separated_between_quasi_component_pointwise_left separated_between_sym)
 
 lemma separated_between_quasi_component_point:
   assumes "C \<in> quasi_components_of X"
   shows "separated_between X C {x} \<longleftrightarrow> x \<in> topspace X - C" (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (meson DiffI disjnt_insert2 insert_subset separated_between_imp_disjoint separated_between_imp_subset)
 next
   assume ?rhs
   with assms show ?lhs
     unfolding quasi_components_of_def image_iff Diff_iff separated_between_quasi_component_pointwise_left [OF assms]
     by (metis mem_Collect_eq quasi_component_of_refl separated_between_singletons)
 qed
 
 lemma separated_between_point_quasi_component:
    "C \<in> quasi_components_of X \<Longrightarrow> separated_between X {x} C \<longleftrightarrow> x \<in> topspace X - C"
   by (simp add: separated_between_quasi_component_point separated_between_sym)
 
 lemma separated_between_quasi_component_compact:
    "\<lbrakk>C \<in> quasi_components_of X; compactin X K\<rbrakk> \<Longrightarrow> (separated_between X C K \<longleftrightarrow> disjnt C K)"
   unfolding disjnt_iff
   using compactin_subset_topspace quasi_components_of_subset separated_between_pointwise_right separated_between_quasi_component_point by fastforce
 
 lemma separated_between_compact_quasi_component:
    "\<lbrakk>compactin X K; C \<in> quasi_components_of X\<rbrakk> \<Longrightarrow> separated_between X K C \<longleftrightarrow> disjnt K C"
   using disjnt_sym separated_between_quasi_component_compact separated_between_sym by blast
 
 lemma separated_between_quasi_components:
   assumes C: "C \<in> quasi_components_of X" and D: "D \<in> quasi_components_of X"
   shows "separated_between X C D \<longleftrightarrow> disjnt C D"   (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (simp add: separated_between_imp_disjoint)
 next
   assume ?rhs
   obtain x y where x: "C = quasi_component_of_set X x" and "x \<in> C"
                and y: "D = quasi_component_of_set X y" and "y \<in> D"
     using assms by (auto simp: quasi_components_of_def)
   then have "separated_between X {x} {y}"
     using \<open>disjnt C D\<close> separated_between_singletons by fastforce
   with \<open>x \<in> C\<close> \<open>y \<in> D\<close> show ?lhs
     by (auto simp: assms separated_between_quasi_component_pointwise_left separated_between_quasi_component_pointwise_right)
 qed
 
 lemma quasi_eq_connected_component_of_eq:
    "quasi_component_of X x = connected_component_of X x \<longleftrightarrow>
     connectedin X (quasi_component_of_set X x)"  (is "?lhs = ?rhs")
 proof (cases "x \<in> topspace X")
   case True
   show ?thesis
   proof
     show "?lhs \<Longrightarrow> ?rhs"
       by (simp add: connectedin_connected_component_of)
   next
     assume ?rhs
     then have "\<And>y. quasi_component_of X x y = connected_component_of X x y"
       by (metis connected_component_of_def connected_imp_quasi_component_of mem_Collect_eq quasi_component_of_equiv)
     then show ?lhs
       by force
   qed
 next
   case False
   then show ?thesis
     by (metis Collect_empty_eq_bot connected_component_of_eq_empty connectedin_empty quasi_component_of_eq_empty)
 qed
 
 lemma connected_quasi_component_of:
   assumes "C \<in> quasi_components_of X"
   shows "C \<in> connected_components_of X \<longleftrightarrow> connectedin X C"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     using assms
     by (simp add: connectedin_connected_components_of)
 next
   assume ?rhs
   with assms show ?lhs
     unfolding quasi_components_of_def connected_components_of_def image_iff
     by (metis quasi_eq_connected_component_of_eq)
 qed
 
 lemma quasi_component_of_clopen_cases:
    "\<lbrakk>C \<in> quasi_components_of X; closedin X T; openin X T\<rbrakk> \<Longrightarrow> C \<subseteq> T \<or> disjnt C T"
   by (smt (verit) disjnt_iff image_iff mem_Collect_eq quasi_component_of_def quasi_components_of_def subset_iff)
 
 lemma quasi_components_of_set:
   assumes "C \<in> quasi_components_of X"
   shows "\<Inter> {T. closedin X T \<and> openin X T \<and> C \<subseteq> T} = C"  (is "?lhs = ?rhs")
 proof
   have "x \<in> C" if "x \<in> \<Inter> {T. closedin X T \<and> openin X T \<and> C \<subseteq> T}" for x
   proof (rule ccontr)
     assume "x \<notin> C"
     have "x \<in> topspace X"
       using assms quasi_components_of_subset that by force
     then have "separated_between X C {x}"
       by (simp add: \<open>x \<notin> C\<close> assms separated_between_quasi_component_point)
     with that show False
       by (auto simp: separated_between)
   qed
   then show "?lhs \<subseteq> ?rhs"
     by auto
 qed blast
 
 lemma open_quasi_eq_connected_components_of:
   assumes "openin X C"
   shows "C \<in> quasi_components_of X \<longleftrightarrow> C \<in> connected_components_of X"  (is "?lhs = ?rhs")
 proof (cases "closedin X C")
   case True
   show ?thesis
   proof
     assume L: ?lhs
     have "T = {} \<or> T = topspace X \<inter> C"
       if "openin (subtopology X C) T" "closedin (subtopology X C) T" for T
     proof -
       have "C \<subseteq> T \<or> disjnt C T"
         by (meson L True assms closedin_trans_full openin_trans_full quasi_component_of_clopen_cases that)
       with that show ?thesis
         by (metis Int_absorb2 True closedin_imp_subset closure_of_subset_eq disjnt_def inf_absorb2)
     qed
     with L assms show "?rhs"
       by (simp add: connected_quasi_component_of connected_space_clopen_in connectedin_def openin_subset)
   next
     assume ?rhs
     then obtain x where "x \<in> topspace X" and x: "C = connected_component_of_set X x"
       by (metis connected_components_of_def imageE)
     have "C = quasi_component_of_set X x"
       using True assms connected_component_of_refl connected_imp_quasi_component_of quasi_component_of_def x by fastforce
     then show ?lhs
       using \<open>x \<in> topspace X\<close> quasi_components_of_def by fastforce
   qed
 next
   case False
   then show ?thesis
     using closedin_connected_components_of closedin_quasi_components_of by blast
 qed
 
 lemma quasi_component_of_continuous_image:
   assumes f:  "continuous_map X Y f" and qc: "quasi_component_of X x y"
   shows "quasi_component_of Y (f x) (f y)"
   unfolding quasi_component_of_def
 proof (intro strip conjI)
   show "f x \<in> topspace Y" "f y \<in> topspace Y"
     using assms by (simp_all add: continuous_map_def quasi_component_of_def)
   fix T
   assume "closedin Y T \<and> openin Y T"
   with assms show "(f x \<in> T) = (f y \<in> T)"
     by (smt (verit) continuous_map_closedin continuous_map_def mem_Collect_eq quasi_component_of_def)
 qed
 
 lemma quasi_component_of_discrete_topology:
    "quasi_component_of_set (discrete_topology U) x = (if x \<in> U then {x} else {})"
 proof -
   have "quasi_component_of_set (discrete_topology U) y = {y}" if "y \<in> U" for y
     using that
     apply (simp add: set_eq_iff quasi_component_of_def)
     by (metis Set.set_insert insertE subset_insertI)
   then show ?thesis
     by (simp add: quasi_component_of)
 qed
 
 lemma quasi_components_of_discrete_topology:
    "quasi_components_of (discrete_topology U) = (\<lambda>x. {x}) ` U"
   by (auto simp add: quasi_components_of_def quasi_component_of_discrete_topology)
 
 lemma homeomorphic_map_quasi_component_of:
   assumes hmf: "homeomorphic_map X Y f" and "x \<in> topspace X"
   shows "quasi_component_of_set Y (f x) = f ` (quasi_component_of_set X x)"
 proof -
   obtain g where hmg: "homeomorphic_map Y X g"
     and contf: "continuous_map X Y f" and contg: "continuous_map Y X g"
     and fg: "(\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
     by (smt (verit, best) hmf homeomorphic_map_maps homeomorphic_maps_def)
   show ?thesis
   proof
     show "quasi_component_of_set Y (f x) \<subseteq> f ` quasi_component_of_set X x"
       using quasi_component_of_continuous_image [OF contg]
          \<open>x \<in> topspace X\<close> fg image_iff quasi_component_of_subset_topspace by fastforce
     show "f ` quasi_component_of_set X x \<subseteq> quasi_component_of_set Y (f x)"
       using quasi_component_of_continuous_image [OF contf] by blast
   qed
 qed
 
 
 lemma homeomorphic_map_quasi_components_of:
   assumes "homeomorphic_map X Y f"
   shows "quasi_components_of Y = image (image f) (quasi_components_of X)"
   using assms
 proof -
   have "\<exists>x\<in>topspace X. quasi_component_of_set Y y = f ` quasi_component_of_set X x"
     if "y \<in> topspace Y" for y 
     by (metis that assms homeomorphic_imp_surjective_map homeomorphic_map_quasi_component_of image_iff)
   moreover have "\<exists>x\<in>topspace Y. f ` quasi_component_of_set X u = quasi_component_of_set Y x"
     if  "u \<in> topspace X" for u
     by (metis that assms homeomorphic_imp_surjective_map homeomorphic_map_quasi_component_of imageI)
   ultimately show ?thesis
     by (auto simp: quasi_components_of_def image_iff)
 qed
 
 lemma openin_quasi_component_of_locally_connected_space:
   assumes "locally_connected_space X"
   shows "openin X (quasi_component_of_set X x)"
 proof -
   have *: "openin X (connected_component_of_set X x)"
     by (simp add: assms openin_connected_component_of_locally_connected_space)
   moreover have "connected_component_of_set X x = quasi_component_of_set X x"
     using * closedin_connected_component_of connected_component_of_refl connected_imp_quasi_component_of
             quasi_component_of_def by fastforce
   ultimately show ?thesis
     by simp
 qed
 
 lemma openin_quasi_components_of_locally_connected_space:
    "locally_connected_space X \<and> c \<in> quasi_components_of X
         \<Longrightarrow> openin X c"
   by (smt (verit, best) image_iff openin_quasi_component_of_locally_connected_space quasi_components_of_def)
 
 lemma quasi_eq_connected_components_of_alt:
   "quasi_components_of X = connected_components_of X \<longleftrightarrow> (\<forall>C \<in> quasi_components_of X. connectedin X C)"
   (is "?lhs = ?rhs")
 proof
   assume R: ?rhs
   moreover have "connected_components_of X \<subseteq> quasi_components_of X"
     using R unfolding quasi_components_of_def connected_components_of_def
     by (force simp flip: quasi_eq_connected_component_of_eq)
   ultimately show ?lhs
     using connected_quasi_component_of by blast
 qed (use connected_quasi_component_of in blast)
   
 lemma connected_subset_quasi_components_of_pointwise:
    "connected_components_of X \<subseteq> quasi_components_of X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. quasi_component_of X x = connected_component_of X x)"
   (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   have "connectedin X (quasi_component_of_set X x)" if "x \<in> topspace X" for x
   proof -
     have "\<exists>y\<in>topspace X. connected_component_of_set X x = quasi_component_of_set X y"
       using L that by (force simp: quasi_components_of_def connected_components_of_def image_subset_iff)
     then show ?thesis
       by (metis connected_component_of_equiv connectedin_connected_component_of mem_Collect_eq quasi_component_of_eq)
   qed
   then show ?rhs
     by (simp add: quasi_eq_connected_component_of_eq)
 qed (simp add: connected_components_of_def quasi_components_of_def)
 
 lemma quasi_subset_connected_components_of_pointwise:
    "quasi_components_of X \<subseteq> connected_components_of X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. quasi_component_of X x = connected_component_of X x)"
   by (simp add: connected_quasi_component_of image_subset_iff quasi_components_of_def quasi_eq_connected_component_of_eq)
 
 lemma quasi_eq_connected_components_of_pointwise:
    "quasi_components_of X = connected_components_of X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. quasi_component_of X x = connected_component_of X x)"
   using connected_subset_quasi_components_of_pointwise quasi_subset_connected_components_of_pointwise by fastforce
 
 lemma quasi_eq_connected_components_of_pointwise_alt:
    "quasi_components_of X = connected_components_of X \<longleftrightarrow>
     (\<forall>x. quasi_component_of X x = connected_component_of X x)"
   unfolding quasi_eq_connected_components_of_pointwise
   by (metis connectedin_empty quasi_component_of_eq_empty quasi_eq_connected_component_of_eq)
 
 lemma quasi_eq_connected_components_of_inclusion:
    "quasi_components_of X = connected_components_of X \<longleftrightarrow>
         connected_components_of X \<subseteq> quasi_components_of X \<or>
         quasi_components_of X \<subseteq> connected_components_of X"
   by (simp add: connected_subset_quasi_components_of_pointwise dual_order.eq_iff quasi_subset_connected_components_of_pointwise)
 
 
 lemma quasi_eq_connected_components_of:
   "finite(connected_components_of X) \<or>
       finite(quasi_components_of X) \<or>
       locally_connected_space X \<or>
       compact_space X \<and> (Hausdorff_space X \<or> regular_space X \<or> normal_space X)
       \<Longrightarrow> quasi_components_of X = connected_components_of X"
 proof (elim disjE)
   show "quasi_components_of X = connected_components_of X"
     if "finite (connected_components_of X)"
     unfolding quasi_eq_connected_components_of_inclusion
     using that open_in_finite_connected_components open_quasi_eq_connected_components_of by blast
   show "quasi_components_of X = connected_components_of X"
     if "finite (quasi_components_of X)"
     unfolding quasi_eq_connected_components_of_inclusion
     using that open_quasi_eq_connected_components_of openin_finite_quasi_components by blast 
   show "quasi_components_of X = connected_components_of X"
     if "locally_connected_space X"
     unfolding quasi_eq_connected_components_of_inclusion
     using that open_quasi_eq_connected_components_of openin_quasi_components_of_locally_connected_space by auto 
   show "quasi_components_of X = connected_components_of X"
     if "compact_space X \<and> (Hausdorff_space X \<or> regular_space X \<or> normal_space X)"
   proof -
     show ?thesis
       unfolding quasi_eq_connected_components_of_alt
     proof (intro strip)
       fix C
       assume C: "C \<in> quasi_components_of X"
       then have cloC: "closedin X C"
         by (simp add: closedin_quasi_components_of)
       have "normal_space X"
         using that compact_Hausdorff_or_regular_imp_normal_space by blast
       show "connectedin X C"
       proof (clarsimp simp add: connectedin_def connected_space_closedin_eq closedin_closed_subtopology cloC closedin_subset [OF cloC])
         fix S T
         assume "S \<subseteq> C" and "closedin X S" and "S \<inter> T = {}" and SUT: "S \<union> T = topspace X \<inter> C"
           and T: "T \<subseteq> C" "T \<noteq> {}" and "closedin X T" 
         with \<open>normal_space X\<close> obtain U V where UV: "openin X U" "openin X V" "S \<subseteq> U" "T \<subseteq> V" "disjnt U V"
           by (meson disjnt_def normal_space_def)
         moreover have "compactin X (topspace X - (U \<union> V))"
           using UV that by (intro closedin_compact_space closedin_diff openin_Un) auto
         ultimately have "separated_between X C (topspace X - (U \<union> V)) \<longleftrightarrow> disjnt C (topspace X - (U \<union> V))"
           by (simp add: \<open>C \<in> quasi_components_of X\<close> separated_between_quasi_component_compact)
         moreover have "disjnt C (topspace X - (U \<union> V))"
           using UV SUT disjnt_def by fastforce
         ultimately have "separated_between X C (topspace X - (U \<union> V))"
           by simp
         then obtain A B where "openin X A" "openin X B" "A \<union> B = topspace X" "disjnt A B" "C \<subseteq> A" 
                         and subB: "topspace X - (U \<union> V) \<subseteq> B"
           by (meson separated_between_def)
         have "B \<union> U = topspace X - (A \<inter> V)"
         proof
           show "B \<union> U \<subseteq> topspace X - A \<inter> V"
             using \<open>openin X U\<close> \<open>disjnt U V\<close> \<open>disjnt A B\<close> \<open>openin X B\<close> disjnt_iff openin_closedin_eq by fastforce
           show "topspace X - A \<inter> V \<subseteq> B \<union> U"
             using \<open>A \<union> B = topspace X\<close> subB by fastforce
         qed
         then have "closedin X (B \<union> U)"
           using \<open>openin X V\<close> \<open>openin X A\<close> by auto
         then have "C \<subseteq> B \<union> U \<or> disjnt C (B \<union> U)"
           using quasi_component_of_clopen_cases [OF C] \<open>openin X U\<close> \<open>openin X B\<close> by blast
         with UV show "S = {}"
           by (metis UnE \<open>C \<subseteq> A\<close> \<open>S \<subseteq> C\<close> T \<open>disjnt A B\<close> all_not_in_conv disjnt_Un2 disjnt_iff subset_eq)
       qed
     qed
   qed
 qed
 
 
 lemma quasi_eq_connected_component_of:
    "finite(connected_components_of X) \<or>
       finite(quasi_components_of X) \<or>
       locally_connected_space X \<or>
       compact_space X \<and> (Hausdorff_space X \<or> regular_space X \<or> normal_space X)
       \<Longrightarrow> quasi_component_of X x = connected_component_of X x"
   by (metis quasi_eq_connected_components_of quasi_eq_connected_components_of_pointwise_alt)
 
 
 subsection\<open>Additional quasicomponent and continuum properties like Boundary Bumping\<close>
 
 lemma cut_wire_fence_theorem_gen:
   assumes "compact_space X" and X: "Hausdorff_space X \<or> regular_space X \<or> normal_space X"
     and S: "compactin X S" and T: "closedin X T"
     and dis: "\<And>C. connectedin X C \<Longrightarrow> disjnt C S \<or> disjnt C T"
   shows "separated_between X S T"
   proof -
   have "x \<in> topspace X" if "x \<in> S" and "T = {}" for x
     using that S compactin_subset_topspace by auto
   moreover have "separated_between X {x} {y}" if "x \<in> S" and "y \<in> T" for x y
   proof (cases "x \<in> topspace X \<and> y \<in> topspace X")
     case True
     then have "\<not> connected_component_of X x y"
       by (meson dis connected_component_of_def disjnt_iff that)
     with True X \<open>compact_space X\<close> show ?thesis
       by (metis quasi_component_nonseparated quasi_eq_connected_component_of)
   next
     case False
     then show ?thesis
       using S T compactin_subset_topspace closedin_subset that by blast
   qed
   ultimately show ?thesis
     using assms
     by (simp add: separated_between_pointwise_left separated_between_pointwise_right 
               closedin_compact_space closedin_subset)
 qed
 
 lemma cut_wire_fence_theorem:
    "\<lbrakk>compact_space X; Hausdorff_space X; closedin X S; closedin X T;
      \<And>C. connectedin X C \<Longrightarrow> disjnt C S \<or> disjnt C T\<rbrakk>
         \<Longrightarrow> separated_between X S T"
   by (simp add: closedin_compact_space cut_wire_fence_theorem_gen)
 
 lemma separated_between_from_closed_subtopology:
   assumes XC: "separated_between (subtopology X C) S (X frontier_of C)" 
     and ST: "separated_between (subtopology X C) S T"
   shows "separated_between X S T"
 proof -
   obtain U where clo: "closedin (subtopology X C) U" and ope: "openin (subtopology X C) U" 
              and "S \<subseteq> U" and sub: "X frontier_of C \<union> T \<subseteq> topspace (subtopology X C) - U"
     by (meson assms separated_between separated_between_Un)
   then have "X frontier_of C \<union> T \<subseteq> topspace X \<inter> C - U"
     by auto
   have "closedin X (topspace X \<inter> C)"
     by (metis XC frontier_of_restrict frontier_of_subset_eq inf_le1 separated_between_imp_subset topspace_subtopology)
   then have "closedin X U"
     by (metis clo closedin_closed_subtopology subtopology_restrict)
   moreover have "openin (subtopology X C) U \<longleftrightarrow> openin X U \<and> U \<subseteq> C"
     using disjnt_iff sub by (force intro!: openin_subset_topspace_eq)
   with ope have "openin X U"
     by blast
   moreover have "T \<subseteq> topspace X - U"
     using ope openin_closedin_eq sub by auto
   ultimately show ?thesis
     using \<open>S \<subseteq> U\<close> separated_between by blast
 qed
 
 lemma separated_between_from_closed_subtopology_frontier:
    "separated_between (subtopology X T) S (X frontier_of T)
         \<Longrightarrow> separated_between X S (X frontier_of T)"
   using separated_between_from_closed_subtopology by blast
 
 lemma separated_between_from_frontier_of_closed_subtopology:
   assumes "separated_between (subtopology X T) S (X frontier_of T)"
   shows "separated_between X S (topspace X - T)"
 proof -
   have "disjnt S (topspace X - T)"
     using assms disjnt_iff separated_between_imp_subset by fastforce
   then show ?thesis
     by (metis Diff_subset assms frontier_of_complement separated_between_from_closed_subtopology separated_between_frontier_of_eq')
 qed
 
 lemma separated_between_compact_connected_component:
   assumes "locally_compact_space X" "Hausdorff_space X" 
     and C: "C \<in> connected_components_of X" 
     and "compactin X C" "closedin X T" "disjnt C T"
   shows "separated_between X C T"
 proof -
   have Csub: "C \<subseteq> topspace X"
     by (simp add: assms(4) compactin_subset_topspace)
   have "Hausdorff_space (subtopology X (topspace X - T))"
     using Hausdorff_space_subtopology assms(2) by blast
   moreover have "compactin (subtopology X (topspace X - T)) C"
     using assms Csub by (metis Diff_Int_distrib Diff_empty compact_imp_compactin_subtopology disjnt_def le_iff_inf)
   moreover have "locally_compact_space (subtopology X (topspace X - T))"
     by (meson assms closedin_def locally_compact_Hausdorff_imp_regular_space locally_compact_space_open_subset)
   ultimately
   obtain N L where "openin X N" "compactin X L" "closedin X L" "C \<subseteq> N" "N \<subseteq> L" 
     and Lsub: "L \<subseteq> topspace X - T"
     using \<open>Hausdorff_space X\<close> \<open>closedin X T\<close>
     apply (simp add: locally_compact_space_compact_closed_compact compactin_subtopology)
     by (meson closedin_def compactin_imp_closedin  openin_trans_full)
   then have disC: "disjnt C (topspace X - L)"
     by (meson DiffD2 disjnt_iff subset_iff)
   have "separated_between (subtopology X L) C (X frontier_of L)"
   proof (rule cut_wire_fence_theorem)
     show "compact_space (subtopology X L)"
       by (simp add: \<open>compactin X L\<close> compact_space_subtopology)
     show "Hausdorff_space (subtopology X L)"
       by (simp add: Hausdorff_space_subtopology \<open>Hausdorff_space X\<close>)
     show "closedin (subtopology X L) C"
       by (meson \<open>C \<subseteq> N\<close> \<open>N \<subseteq> L\<close> \<open>Hausdorff_space X\<close> \<open>compactin X C\<close> closedin_subset_topspace compactin_imp_closedin subset_trans)
     show "closedin (subtopology X L) (X frontier_of L)"
       by (simp add: \<open>closedin X L\<close> closedin_frontier_of closedin_subset_topspace frontier_of_subset_closedin)
     show "disjnt D C \<or> disjnt D (X frontier_of L)"
       if "connectedin (subtopology X L) D" for D 
     proof (rule ccontr)
       assume "\<not> (disjnt D C \<or> disjnt D (X frontier_of L))"
       moreover have "connectedin X D"
         using connectedin_subtopology that by blast
       ultimately show False
         using that connected_components_of_maximal [of C X D] C
         apply (simp add: disjnt_iff)
         by (metis Diff_eq_empty_iff \<open>C \<subseteq> N\<close> \<open>N \<subseteq> L\<close> \<open>openin X N\<close> disjoint_iff frontier_of_openin_straddle_Int(2) subsetD)
     qed
   qed
   then have "separated_between X (X frontier_of C) (topspace X - L)"
     using separated_between_from_frontier_of_closed_subtopology separated_between_frontier_of_eq by blast
   with \<open>closedin X T\<close>  
     separated_between_frontier_of [OF Csub disC] 
   show ?thesis
     unfolding separated_between by (smt (verit) Diff_iff Lsub closedin_subset subset_iff)
 qed
 
 lemma wilder_locally_compact_component_thm:
   assumes "locally_compact_space X" "Hausdorff_space X" 
     and "C \<in> connected_components_of X" "compactin X C" "openin X W" "C \<subseteq> W"
   obtains U V where "openin X U" "openin X V" "disjnt U V" "U \<union> V = topspace X" "C \<subseteq> U" "U \<subseteq> W"
 proof -
   have "closedin X (topspace X - W)"
     using \<open>openin X W\<close> by blast
   moreover have "disjnt C (topspace X - W)"
     using \<open>C \<subseteq> W\<close> disjnt_def by fastforce
   ultimately have "separated_between X C (topspace X - W)"
     using separated_between_compact_connected_component assms by blast
   then show thesis
     by (smt (verit, del_insts) DiffI disjnt_iff openin_subset separated_between_def subset_iff that)
 qed
 
 lemma compact_quasi_eq_connected_components_of:
   assumes "locally_compact_space X" "Hausdorff_space X" "compactin X C"
   shows "C \<in> quasi_components_of X \<longleftrightarrow> C \<in> connected_components_of X"
 proof -
   have "compactin X (connected_component_of_set X x)" 
     if "x \<in> topspace X" "compactin X (quasi_component_of_set X x)" for x
   proof (rule closed_compactin)
     show "compactin X (quasi_component_of_set X x)"
       by (simp add: that)
     show "connected_component_of_set X x \<subseteq> quasi_component_of_set X x"
       by (simp add: connected_component_subset_quasi_component_of)
     show "closedin X (connected_component_of_set X x)"
       by (simp add: closedin_connected_component_of)
   qed
   moreover have "connected_component_of X x = quasi_component_of X x"
     if \<section>: "x \<in> topspace X" "compactin X (connected_component_of_set X x)" for x
   proof -
     have "\<And>y. connected_component_of X x y \<Longrightarrow> quasi_component_of X x y"
       by (simp add: connected_imp_quasi_component_of)
     moreover have False if non: "\<not> connected_component_of X x y" and quasi: "quasi_component_of X x y" for y
     proof -
       have "y \<in> topspace X"
         by (meson quasi_component_of_equiv that)
       then have "closedin X {y}"
         by (simp add: \<open>Hausdorff_space X\<close> compactin_imp_closedin)
       moreover have "disjnt (connected_component_of_set X x) {y}"
         by (simp add: non)
       moreover have "\<not> separated_between X (connected_component_of_set X x) {y}"
         using \<section> quasi separated_between_pointwise_left 
         by (fastforce simp: quasi_component_nonseparated connected_component_of_refl)
       ultimately show False
         using assms by (metis \<section> connected_component_in_connected_components_of separated_between_compact_connected_component)
     qed
     ultimately show ?thesis
       by blast
   qed
   ultimately show ?thesis
     using \<open>compactin X C\<close> unfolding connected_components_of_def image_iff quasi_components_of_def by metis
 qed
 
 
 lemma boundary_bumping_theorem_closed_gen:
   assumes "connected_space X" "locally_compact_space X" "Hausdorff_space X" "closedin X S" 
     "S \<noteq> topspace X" and C: "compactin X C" "C \<in> connected_components_of (subtopology X S)"
   shows "C \<inter> X frontier_of S \<noteq> {}"
 proof 
   assume \<section>: "C \<inter> X frontier_of S = {}"
   consider "C \<noteq> {}" "X frontier_of S \<subseteq> topspace X" | "C \<subseteq> topspace X" "S = {}"
     using C by (metis frontier_of_subset_topspace nonempty_connected_components_of)
   then show False
   proof cases
     case 1
     have "separated_between (subtopology X S) C (X frontier_of S)"
     proof (rule separated_between_compact_connected_component)
       show "compactin (subtopology X S) C"
         using C compact_imp_compactin_subtopology connected_components_of_subset by fastforce
       show "closedin (subtopology X S) (X frontier_of S)"
         by (simp add: \<open>closedin X S\<close> closedin_frontier_of closedin_subset_topspace frontier_of_subset_closedin)
       show "disjnt C (X frontier_of S)"
         using \<section> by (simp add: disjnt_def)
     qed (use assms Hausdorff_space_subtopology locally_compact_space_closed_subset in auto)
     then have "separated_between X C (X frontier_of S)"
       using separated_between_from_closed_subtopology by auto
     then have "X frontier_of S = {}"
       using \<open>C \<noteq> {}\<close> \<open>connected_space X\<close> connected_space_separated_between by blast
     moreover have "C \<subseteq> S"
       using C connected_components_of_subset by fastforce
     ultimately show False
       using 1 assms by (metis closedin_subset connected_space_eq_frontier_eq_empty subset_empty)
   next
     case 2
     then show False
       using C connected_components_of_eq_empty by fastforce
   qed
 qed
 
 lemma boundary_bumping_theorem_closed:
   assumes "connected_space X" "compact_space X" "Hausdorff_space X" "closedin X S" 
           "S \<noteq> topspace X" "C \<in> connected_components_of(subtopology X S)"
   shows "C \<inter> X frontier_of S \<noteq> {}"
   by (meson assms boundary_bumping_theorem_closed_gen closedin_compact_space closedin_connected_components_of
             closedin_trans_full compact_imp_locally_compact_space)
 
 
 lemma intermediate_continuum_exists:
   assumes "connected_space X" "locally_compact_space X" "Hausdorff_space X" 
     and C: "compactin X C" "connectedin X C" "C \<noteq> {}" "C \<noteq> topspace X"
     and U: "openin X U" "C \<subseteq> U"
   obtains D where "compactin X D" "connectedin X D" "C \<subset> D" "D \<subset> U"
 proof -
   have "C \<subseteq> topspace X"
     by (simp add: C compactin_subset_topspace)
   with C obtain a where a: "a \<in> topspace X" "a \<notin> C"
     by blast
   moreover have "compactin (subtopology X (U - {a})) C"
     by (simp add: C U a compact_imp_compactin_subtopology subset_Diff_insert)
   moreover have "Hausdorff_space (subtopology X (U - {a}))"
     using Hausdorff_space_subtopology assms(3) by blast
   moreover
   have "locally_compact_space (subtopology X (U - {a}))"
     by (rule locally_compact_space_open_subset)
        (auto simp: locally_compact_Hausdorff_imp_regular_space open_in_Hausdorff_delete assms)
   ultimately obtain V K where V: "openin X V" "a \<notin> V" "V \<subseteq> U" and K: "compactin X K" "a \<notin> K" "K \<subseteq> U" 
     and cloK: "closedin (subtopology X (U - {a})) K" and "C \<subseteq> V" "V \<subseteq> K"
     using locally_compact_space_compact_closed_compact [of "subtopology X (U - {a})"] assms
     by (smt (verit, del_insts) Diff_empty compactin_subtopology open_in_Hausdorff_delete openin_open_subtopology subset_Diff_insert)
   then obtain D where D: "D \<in> connected_components_of (subtopology X K)" and "C \<subseteq> D"
     using C by (metis bot.extremum_unique connectedin_subtopology order.trans exists_connected_component_of_superset subtopology_topspace)
   show thesis
   proof
     have cloD: "closedin (subtopology X K) D"
       by (simp add: D closedin_connected_components_of)
     then have XKD: "compactin (subtopology X K) D"
       by (simp add: K closedin_compact_space compact_space_subtopology)
     then show "compactin X D"
       using compactin_subtopology_imp_compact by blast
     show "connectedin X D"
       using D connectedin_connected_components_of connectedin_subtopology by blast
     have "K \<noteq> topspace X"
       using K a by blast
     moreover have "V \<subseteq> X interior_of K"
       by (simp add: \<open>openin X V\<close> \<open>V \<subseteq> K\<close> interior_of_maximal)
     ultimately have "C \<noteq> D"
       using boundary_bumping_theorem_closed_gen [of X K C] D \<open>C \<subseteq> V\<close> 
       by (auto simp add: assms K compactin_imp_closedin frontier_of_def)
     then show "C \<subset> D"
       using \<open>C \<subseteq> D\<close> by blast
     have "D \<subseteq> U"
       using K(3) \<open>closedin (subtopology X K) D\<close> closedin_imp_subset by blast
     moreover have "D \<noteq> U"
       using K XKD \<open>C \<subset> D\<close> assms
       by (metis \<open>K \<noteq> topspace X\<close> cloD closedin_imp_subset compactin_imp_closedin connected_space_clopen_in
                 inf_bot_left inf_le2 subset_antisym)
     ultimately
     show "D \<subset> U" by blast
   qed
 qed
 
 lemma boundary_bumping_theorem_gen:
   assumes X: "connected_space X" "locally_compact_space X" "Hausdorff_space X" 
    and "S \<subset> topspace X" and C: "C \<in> connected_components_of(subtopology X S)" 
    and compC: "compactin X (X closure_of C)"
  shows "X frontier_of C \<inter> X frontier_of S \<noteq> {}"
 proof -
   have Csub: "C \<subseteq> topspace X" "C \<subseteq> S" and "connectedin X C"
     using C connectedin_connected_components_of connectedin_subset_topspace connectedin_subtopology
     by fastforce+
   have "C \<noteq> {}"
     using C nonempty_connected_components_of by blast
   obtain "X interior_of C \<subseteq> X interior_of S" "X closure_of C \<subseteq> X closure_of S"
     by (simp add: Csub closure_of_mono interior_of_mono)
   moreover have False if "X closure_of C \<subseteq> X interior_of S"
   proof -
     have "X closure_of C = C"
       by (meson C closedin_connected_component_of_subtopology closure_of_eq interior_of_subset order_trans that)
     with that have "C \<subseteq> X interior_of S"
       by simp
     then obtain D where  "compactin X D" and "connectedin X D" and "C \<subset> D" and "D \<subset> X interior_of S"
       using intermediate_continuum_exists assms  \<open>X closure_of C = C\<close> compC Csub
       by (metis \<open>C \<noteq> {}\<close> \<open>connectedin X C\<close> openin_interior_of psubsetE)
     then have "D \<subseteq> C"
       by (metis C \<open>C \<noteq> {}\<close> connected_components_of_maximal connectedin_subtopology disjnt_def inf.orderE interior_of_subset order_trans psubsetE)
     then show False
       using \<open>C \<subset> D\<close> by blast
   qed
   ultimately show ?thesis
     by (smt (verit, ccfv_SIG) DiffI disjoint_iff_not_equal frontier_of_def subset_eq)
 qed
 
 lemma boundary_bumping_theorem:
    "\<lbrakk>connected_space X; compact_space X; Hausdorff_space X; S \<subset> topspace X; 
      C \<in> connected_components_of(subtopology X S)\<rbrakk>
     \<Longrightarrow> X frontier_of C \<inter> X frontier_of S \<noteq> {}"
   by (simp add: boundary_bumping_theorem_gen closedin_compact_space compact_imp_locally_compact_space)
 
+subsection \<open>Compactly generated spaces (k-spaces)\<close>
+
+text \<open>These don't have to be Hausdorff\<close>
+
+definition k_space where
+  "k_space X \<equiv>
+    \<forall>S. S \<subseteq> topspace X \<longrightarrow> 
+        (closedin X S \<longleftrightarrow> (\<forall>K. compactin X K \<longrightarrow> closedin (subtopology X K) (K \<inter> S)))"
+
+lemma k_space:
+   "k_space X \<longleftrightarrow>
+    (\<forall>S. S \<subseteq> topspace X \<and>
+         (\<forall>K. compactin X K \<longrightarrow> closedin (subtopology X K) (K \<inter> S)) \<longrightarrow> closedin X S)"
+  by (metis closedin_subtopology inf_commute k_space_def)
+
+lemma k_space_open:
+   "k_space X \<longleftrightarrow>
+    (\<forall>S. S \<subseteq> topspace X \<and>
+         (\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> S)) \<longrightarrow> openin X S)"
+proof -
+  have "openin X S"
+    if "k_space X" "S \<subseteq> topspace X"
+      and "\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> S)" for S
+    using that unfolding k_space openin_closedin_eq
+    by (metis Diff_Int_distrib2 Diff_subset inf_commute topspace_subtopology)
+  moreover have "k_space X"
+    if "\<forall>S. S \<subseteq> topspace X \<and> (\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> S)) \<longrightarrow> openin X S"
+    unfolding k_space openin_closedin_eq
+    by (simp add: Diff_Int_distrib closedin_def inf_commute that)
+  ultimately show ?thesis
+    by blast
+qed
+
+lemma k_space_alt:
+   "k_space X \<longleftrightarrow>
+    (\<forall>S. S \<subseteq> topspace X
+        \<longrightarrow> (openin X S \<longleftrightarrow> (\<forall>K. compactin X K \<longrightarrow> openin (subtopology X K) (K \<inter> S))))"
+  by (meson k_space_open openin_subtopology_Int2)
+
+lemma k_space_quotient_map_image:
+  assumes q: "quotient_map X Y q" and X: "k_space X"
+  shows "k_space Y"
+  unfolding k_space
+proof clarify
+  fix S
+  assume "S \<subseteq> topspace Y" and S: "\<forall>K. compactin Y K \<longrightarrow> closedin (subtopology Y K) (K \<inter> S)"
+  then have iff: "closedin X {x \<in> topspace X. q x \<in> S} \<longleftrightarrow> closedin Y S"
+    using q quotient_map_closedin by fastforce
+  have "closedin (subtopology X K) (K \<inter> {x \<in> topspace X. q x \<in> S})" if "compactin X K" for K
+  proof -
+    have "{x \<in> topspace X. q x \<in> q ` K} \<inter> K = K"
+      using compactin_subset_topspace that by blast
+    then have *: "subtopology X K = subtopology (subtopology X {x \<in> topspace X. q x \<in> q ` K}) K"
+      by (simp add: subtopology_subtopology)
+    have **: "K \<inter> {x \<in> topspace X. q x \<in> S} =
+              K \<inter> {x \<in> topspace (subtopology X {x \<in> topspace X. q x \<in> q ` K}). q x \<in> q ` K \<inter> S}"
+      by auto
+    have "K \<subseteq> topspace X"
+      by (simp add: compactin_subset_topspace that)
+    show ?thesis
+      unfolding * **
+    proof (intro closedin_continuous_map_preimage closedin_subtopology_Int_closed)
+      show "continuous_map (subtopology X {x \<in> topspace X. q x \<in> q ` K}) (subtopology Y (q ` K)) q"
+        by (auto simp add: continuous_map_in_subtopology continuous_map_from_subtopology q quotient_imp_continuous_map)
+      show "closedin (subtopology Y (q ` K)) (q ` K \<inter> S)"
+        by (meson S image_compactin q quotient_imp_continuous_map that)
+    qed
+  qed
+  then have "closedin X {x \<in> topspace X. q x \<in> S}"
+    by (metis (no_types, lifting) X k_space mem_Collect_eq subsetI)
+  with iff show "closedin Y S" by simp
+qed
+
+lemma k_space_retraction_map_image:
+   "\<lbrakk>retraction_map X Y r; k_space X\<rbrakk> \<Longrightarrow> k_space Y"
+  using k_space_quotient_map_image retraction_imp_quotient_map by blast
+
+lemma homeomorphic_k_space:
+   "X homeomorphic_space Y \<Longrightarrow> k_space X \<longleftrightarrow> k_space Y"
+  by (meson homeomorphic_map_def homeomorphic_space homeomorphic_space_sym k_space_quotient_map_image)
+
+lemma k_space_perfect_map_image:
+   "\<lbrakk>k_space X; perfect_map X Y f\<rbrakk> \<Longrightarrow> k_space Y"
+  using k_space_quotient_map_image perfect_imp_quotient_map by blast
+
+lemma locally_compact_imp_k_space:
+  assumes "locally_compact_space X"
+  shows "k_space X"
+  unfolding k_space
+proof clarify
+  fix S
+  assume "S \<subseteq> topspace X" and S: "\<forall>K. compactin X K \<longrightarrow> closedin (subtopology X K) (K \<inter> S)"
+  have False if non: "\<not> (X closure_of S \<subseteq> S)"
+  proof -
+    obtain x where "x \<in> X closure_of S" "x \<notin> S"
+      using non by blast
+    then have "x \<in> topspace X"
+      by (simp add: in_closure_of)
+    then obtain K U where "openin X U" "compactin X K" "x \<in> U" "U \<subseteq> K"
+      by (meson assms locally_compact_space_def)
+    then show False
+      using \<open>x \<in> X closure_of S\<close>  openin_Int_closure_of_eq [OF \<open>openin X U\<close>]
+      by (smt (verit, ccfv_threshold) Int_iff S \<open>x \<notin> S\<close> closedin_Int_closure_of inf.orderE inf_assoc)
+  qed
+  then show "closedin X S"
+    using S \<open>S \<subseteq> topspace X\<close> closure_of_subset_eq by blast
+qed
+
+lemma compact_imp_k_space:
+   "compact_space X \<Longrightarrow> k_space X"
+  by (simp add: compact_imp_locally_compact_space locally_compact_imp_k_space)
+
+lemma k_space_discrete_topology: "k_space(discrete_topology U)"
+  by (simp add: k_space_open)
+
+lemma k_space_closed_subtopology:
+  assumes "k_space X" "closedin X C"
+  shows "k_space (subtopology X C)"
+unfolding k_space compactin_subtopology
+proof clarsimp
+  fix S
+  assume Ssub: "S \<subseteq> topspace X" "S \<subseteq> C"
+      and S: "\<forall>K. compactin X K \<and> K \<subseteq> C \<longrightarrow> closedin (subtopology (subtopology X C) K) (K \<inter> S)"
+  have "closedin (subtopology X K) (K \<inter> S)" if "compactin X K" for K
+  proof -
+    have "closedin (subtopology (subtopology X C) (K \<inter> C)) ((K \<inter> C) \<inter> S)"
+      by (simp add: S \<open>closedin X C\<close> compact_Int_closedin that)
+    then show ?thesis
+      using \<open>closedin X C\<close> Ssub by (auto simp add: closedin_subtopology)
+  qed
+  then show "closedin (subtopology X C) S"
+    by (metis Ssub \<open>k_space X\<close> closedin_subset_topspace k_space_def)
+qed
+
+lemma k_space_subtopology:
+  assumes 1: "\<And>T. \<lbrakk>T \<subseteq> topspace X; T \<subseteq> S;
+                   \<And>K. compactin X K \<Longrightarrow> closedin (subtopology X (K \<inter> S)) (K \<inter> T)\<rbrakk> \<Longrightarrow> closedin (subtopology X S) T"
+  assumes 2: "\<And>K. compactin X K \<Longrightarrow> k_space(subtopology X (K \<inter> S))"
+  shows "k_space (subtopology X S)"
+  unfolding k_space
+proof (intro conjI strip)
+  fix U
+  assume \<section>: "U \<subseteq> topspace (subtopology X S) \<and> (\<forall>K. compactin (subtopology X S) K \<longrightarrow> closedin (subtopology (subtopology X S) K) (K \<inter> U))"
+  have "closedin (subtopology X (K \<inter> S)) (K \<inter> U)" if "compactin X K" for K
+  proof -
+    have "K \<inter> U \<subseteq> topspace (subtopology X (K \<inter> S))"
+      using "\<section>" by auto
+    moreover
+    have "\<And>K'. compactin (subtopology X (K \<inter> S)) K' \<Longrightarrow> closedin (subtopology (subtopology X (K \<inter> S)) K') (K' \<inter> K \<inter> U)"
+      by (metis "\<section>" compactin_subtopology inf.orderE inf_commute subtopology_subtopology)
+    ultimately show ?thesis
+      by (metis (no_types, opaque_lifting) "2" inf.assoc k_space_def that)
+  qed
+  then show "closedin (subtopology X S) U"
+    using "1" \<section> by auto
+qed
+
+lemma k_space_subtopology_open:
+  assumes 1: "\<And>T. \<lbrakk>T \<subseteq> topspace X; T \<subseteq> S;
+                    \<And>K. compactin X K \<Longrightarrow> openin (subtopology X (K \<inter> S)) (K \<inter> T)\<rbrakk> \<Longrightarrow> openin (subtopology X S) T"
+  assumes 2: "\<And>K. compactin X K \<Longrightarrow> k_space(subtopology X (K \<inter> S))"
+  shows "k_space (subtopology X S)"
+  unfolding k_space_open
+proof (intro conjI strip)
+  fix U
+  assume \<section>: "U \<subseteq> topspace (subtopology X S) \<and> (\<forall>K. compactin (subtopology X S) K \<longrightarrow> openin (subtopology (subtopology X S) K) (K \<inter> U))"
+  have "openin (subtopology X (K \<inter> S)) (K \<inter> U)" if "compactin X K" for K
+  proof -
+    have "K \<inter> U \<subseteq> topspace (subtopology X (K \<inter> S))"
+      using "\<section>" by auto
+    moreover
+    have "\<And>K'. compactin (subtopology X (K \<inter> S)) K' \<Longrightarrow> openin (subtopology (subtopology X (K \<inter> S)) K') (K' \<inter> K \<inter> U)"
+      by (metis "\<section>" compactin_subtopology inf.orderE inf_commute subtopology_subtopology)
+    ultimately show ?thesis
+      by (metis (no_types, opaque_lifting) "2" inf.assoc k_space_open that)
+  qed
+  then show "openin (subtopology X S) U"
+    using "1" \<section> by auto
+qed
+
+
+lemma k_space_open_subtopology_aux:
+  assumes "kc_space X" "compact_space X" "openin X V"
+  shows "k_space (subtopology X V)"
+proof (clarsimp simp: k_space subtopology_subtopology compactin_subtopology Int_absorb1)
+  fix S
+  assume "S \<subseteq> topspace X"
+    and "S \<subseteq> V"
+    and S: "\<forall>K. compactin X K \<and> K \<subseteq> V \<longrightarrow> closedin (subtopology X K) (K \<inter> S)"
+  then have "V \<subseteq> topspace X"
+    using assms openin_subset by blast
+  have "S = V \<inter> ((topspace X - V) \<union> S)"
+    using \<open>S \<subseteq> V\<close> by auto
+  moreover have "closedin (subtopology X V) (V \<inter> ((topspace X - V) \<union> S))"
+  proof (intro closedin_subtopology_Int_closed compactin_imp_closedin_gen \<open>kc_space X\<close>)
+    show "compactin X (topspace X - V \<union> S)"
+      unfolding compactin_def
+    proof (intro conjI strip)
+      show "topspace X - V \<union> S \<subseteq> topspace X"
+        by (simp add: \<open>S \<subseteq> topspace X\<close>)
+      fix \<U>
+      assume \<U>: "Ball \<U> (openin X) \<and> topspace X - V \<union> S \<subseteq> \<Union>\<U>"
+      moreover
+      have "compactin X (topspace X - V)"
+        using assms closedin_compact_space by blast
+      ultimately obtain \<G> where "finite \<G>" "\<G> \<subseteq> \<U>" and \<G>: "topspace X - V \<subseteq> \<Union>\<G>"
+        unfolding compactin_def using \<open>V \<subseteq> topspace X\<close> by (metis le_sup_iff)
+      then have "topspace X - \<Union>\<G> \<subseteq> V"
+        by blast
+      then have "closedin (subtopology X (topspace X - \<Union>\<G>)) ((topspace X - \<Union>\<G>) \<inter> S)"
+        by (meson S \<U> \<open>\<G> \<subseteq> \<U>\<close> \<open>compact_space X\<close> closedin_compact_space openin_Union openin_closedin_eq subset_iff)
+      then have "compactin X ((topspace X - \<Union>\<G>) \<inter> S)"
+        by (meson \<U> \<open>\<G> \<subseteq> \<U>\<close>\<open>compact_space X\<close> closedin_compact_space closedin_trans_full openin_Union openin_closedin_eq subset_iff)
+      then obtain \<H> where "finite \<H>" "\<H> \<subseteq> \<U>" "(topspace X - \<Union>\<G>) \<inter> S \<subseteq> \<Union>\<H>"
+        unfolding compactin_def by (smt (verit, best) \<U> inf_le2 subset_trans sup.boundedE)
+      with \<G> have "topspace X - V \<union> S \<subseteq> \<Union>(\<G> \<union> \<H>)"
+        using \<open>S \<subseteq> topspace X\<close> by auto
+      then show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace X - V \<union> S \<subseteq> \<Union>\<F>"
+        by (metis \<open>\<G> \<subseteq> \<U>\<close> \<open>\<H> \<subseteq> \<U>\<close> \<open>finite \<G>\<close> \<open>finite \<H>\<close> finite_Un le_sup_iff)
+    qed
+  qed
+  ultimately show "closedin (subtopology X V) S"
+    by metis
+qed
+
+
+lemma k_space_open_subtopology:
+  assumes X: "kc_space X \<or> Hausdorff_space X \<or> regular_space X" and "k_space X" "openin X S"
+  shows "k_space(subtopology X S)"
+proof (rule k_space_subtopology_open)
+  fix T
+  assume "T \<subseteq> topspace X"
+    and "T \<subseteq> S"
+    and T: "\<And>K. compactin X K \<Longrightarrow> openin (subtopology X (K \<inter> S)) (K \<inter> T)"
+  have "openin (subtopology X K) (K \<inter> T)" if "compactin X K" for K
+    by (smt (verit, ccfv_threshold) T assms(3) inf_assoc inf_commute openin_Int openin_subtopology that)
+  then show "openin (subtopology X S) T"
+    by (metis \<open>T \<subseteq> S\<close> \<open>T \<subseteq> topspace X\<close> assms(2) k_space_alt subset_openin_subtopology)
+next
+  fix K
+  assume "compactin X K"
+  then have KS: "openin (subtopology X K) (K \<inter> S)"
+    by (simp add: \<open>openin X S\<close> openin_subtopology_Int2)
+  have XK: "compact_space (subtopology X K)"
+    by (simp add: \<open>compactin X K\<close> compact_space_subtopology)
+  show "k_space (subtopology X (K \<inter> S))"
+    using X
+  proof (rule disjE)
+    assume "kc_space X"
+    then show "k_space (subtopology X (K \<inter> S))"
+      using k_space_open_subtopology_aux [of "subtopology X K" "K \<inter> S"]
+      by (simp add: KS XK kc_space_subtopology subtopology_subtopology)
+  next
+    assume "Hausdorff_space X \<or> regular_space X"
+    then have "locally_compact_space (subtopology (subtopology X K) (K \<inter> S))"
+      using locally_compact_space_open_subset Hausdorff_space_subtopology KS XK 
+        compact_imp_locally_compact_space regular_space_subtopology by blast
+    then show "k_space (subtopology X (K \<inter> S))"
+      by (simp add: locally_compact_imp_k_space subtopology_subtopology)
+  qed
+qed
+
+lemma k_kc_space_subtopology:
+   "\<lbrakk>k_space X; kc_space X; openin X S \<or> closedin X S\<rbrakk> \<Longrightarrow> k_space(subtopology X S) \<and> kc_space(subtopology X S)"
+  by (metis k_space_closed_subtopology k_space_open_subtopology kc_space_subtopology)
+
+
+lemma k_space_as_quotient_explicit:
+  "k_space X \<longleftrightarrow> quotient_map (sum_topology (subtopology X) {K. compactin X K}) X snd"
+proof -
+  have [simp]: "{x \<in> topspace X. x \<in> K \<and> x \<in> U} = K \<inter> U" if "U \<subseteq> topspace X" for K U
+    using that by blast
+  show "?thesis"
+    apply (simp add: quotient_map_def openin_sum_topology snd_image_Sigma k_space_alt)
+    by (smt (verit, del_insts) Union_iff compactin_sing inf.orderE mem_Collect_eq singletonI subsetI)
+qed
+
+lemma k_space_as_quotient:
+  fixes X :: "'a topology"
+  shows "k_space X \<longleftrightarrow> (\<exists>q. \<exists>Y:: ('a set * 'a) topology. locally_compact_space Y \<and> quotient_map Y X q)" 
+         (is "?lhs=?rhs")
+proof
+  show "k_space X" if ?rhs
+    using that k_space_quotient_map_image locally_compact_imp_k_space by blast 
+next
+  assume "k_space X"
+  show ?rhs
+  proof (intro exI conjI)
+    show "locally_compact_space (sum_topology (subtopology X) {K. compactin X K})"
+      by (simp add: compact_imp_locally_compact_space compact_space_subtopology locally_compact_space_sum_topology)
+    show "quotient_map (sum_topology (subtopology X) {K. compactin X K}) X snd"
+      using \<open>k_space X\<close> k_space_as_quotient_explicit by blast
+  qed
+qed
+
+lemma k_space_prod_topology_left:
+  assumes X: "locally_compact_space X" "Hausdorff_space X \<or> regular_space X" and "k_space Y"
+  shows "k_space (prod_topology X Y)"
+proof -
+  obtain q and Z :: "('b set * 'b) topology" where "locally_compact_space Z" and q: "quotient_map Z Y q"
+    using \<open>k_space Y\<close> k_space_as_quotient by blast
+  then show ?thesis
+    using quotient_map_prod_right [OF X q] X k_space_quotient_map_image locally_compact_imp_k_space 
+          locally_compact_space_prod_topology by blast
+qed
+
+text \<open>Essentially the same proof\<close>
+lemma k_space_prod_topology_right:
+  assumes "k_space X" and Y: "locally_compact_space Y" "Hausdorff_space Y \<or> regular_space Y"
+  shows "k_space (prod_topology X Y)"
+proof -
+  obtain q and Z :: "('a set * 'a) topology" where "locally_compact_space Z" and q: "quotient_map Z X q"
+    using \<open>k_space X\<close> k_space_as_quotient by blast
+  then show ?thesis
+    using quotient_map_prod_left [OF Y q] using Y k_space_quotient_map_image locally_compact_imp_k_space 
+          locally_compact_space_prod_topology by blast
+qed
+
+
+lemma continuous_map_from_k_space:
+  assumes "k_space X" and f: "\<And>K. compactin X K \<Longrightarrow> continuous_map(subtopology X K) Y f"
+  shows "continuous_map X Y f"
+proof -
+  have "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
+    by (metis compactin_absolute compactin_sing f image_compactin image_empty image_insert)
+  moreover have "closedin X {x \<in> topspace X. f x \<in> C}" if "closedin Y C" for C
+  proof -
+    have "{x \<in> topspace X. f x \<in> C} \<subseteq> topspace X"
+      by fastforce
+    moreover 
+    have eq: "K \<inter> {x \<in> topspace X. f x \<in> C} = {x. x \<in> topspace(subtopology X K) \<and> f x \<in> (f ` K \<inter> C)}" for K
+      by auto
+    have "closedin (subtopology X K) (K \<inter> {x \<in> topspace X. f x \<in> C})" if "compactin X K" for K
+      unfolding eq
+    proof (rule closedin_continuous_map_preimage)
+      show "continuous_map (subtopology X K) (subtopology Y (f`K)) f"
+        by (simp add: continuous_map_in_subtopology f image_mono that)
+      show "closedin (subtopology Y (f`K)) (f ` K \<inter> C)"
+        using \<open>closedin Y C\<close> closedin_subtopology by blast
+    qed
+    ultimately show ?thesis
+      using \<open>k_space X\<close> k_space by blast
+  qed
+  ultimately show ?thesis
+    by (simp add: continuous_map_closedin)
+qed
+
+lemma closed_map_into_k_space:
+  assumes "k_space Y" and fim: "f ` (topspace X) \<subseteq> topspace Y"
+    and f: "\<And>K. compactin Y K
+                \<Longrightarrow> closed_map(subtopology X {x \<in> topspace X. f x \<in> K}) (subtopology Y K) f"
+  shows "closed_map X Y f"
+  unfolding closed_map_def
+proof (intro strip)
+  fix C
+  assume "closedin X C"
+  have "closedin (subtopology Y K) (K \<inter> f ` C)"
+    if "compactin Y K" for K
+  proof -
+    have eq: "K \<inter> f ` C = f ` ({x \<in> topspace X. f x \<in> K} \<inter> C)"
+      using \<open>closedin X C\<close> closedin_subset by auto
+    show ?thesis
+      unfolding eq
+      by (metis (no_types, lifting) \<open>closedin X C\<close> closed_map_def closedin_subtopology f inf_commute that)
+  qed
+  then show "closedin Y (f ` C)"
+    using \<open>k_space Y\<close> unfolding k_space
+    by (meson \<open>closedin X C\<close> closedin_subset dual_order.trans fim image_mono)
+qed
+
+
+text \<open>Essentially the same proof\<close>
+lemma open_map_into_k_space:
+  assumes "k_space Y" and fim: "f ` (topspace X) \<subseteq> topspace Y"
+    and f: "\<And>K. compactin Y K
+                 \<Longrightarrow> open_map (subtopology X {x \<in> topspace X. f x \<in> K}) (subtopology Y K) f"
+  shows "open_map X Y f"
+  unfolding open_map_def
+proof (intro strip)
+  fix C
+  assume "openin X C"
+  have "openin (subtopology Y K) (K \<inter> f ` C)"
+    if "compactin Y K" for K
+  proof -
+    have eq: "K \<inter> f ` C = f ` ({x \<in> topspace X. f x \<in> K} \<inter> C)"
+      using \<open>openin X C\<close> openin_subset by auto
+    show ?thesis
+      unfolding eq
+      by (metis (no_types, lifting) \<open>openin X C\<close> open_map_def openin_subtopology f inf_commute that)
+  qed
+  then show "openin Y (f ` C)"
+    using \<open>k_space Y\<close> unfolding k_space_open
+    by (meson \<open>openin X C\<close> openin_subset dual_order.trans fim image_mono)
+qed
+
+lemma quotient_map_into_k_space:
+  fixes f :: "'a \<Rightarrow> 'b"
+  assumes "k_space Y" and cmf: "continuous_map X Y f" 
+    and fim: "f ` (topspace X) = topspace Y"
+    and f: "\<And>k. compactin Y k
+                 \<Longrightarrow> quotient_map (subtopology X {x \<in> topspace X. f x \<in> k})
+                                  (subtopology Y k) f"
+  shows "quotient_map X Y f"
+proof -
+  have "closedin Y C"
+    if "C \<subseteq> topspace Y" and K: "closedin X {x \<in> topspace X. f x \<in> C}" for C
+  proof -
+    have "closedin (subtopology Y K) (K \<inter> C)" if "compactin Y K" for K
+    proof -
+      define Kf where "Kf \<equiv> {x \<in> topspace X. f x \<in> K}"
+      have *: "K \<inter> C \<subseteq> topspace Y \<and> K \<inter> C \<subseteq> K"
+        using \<open>C \<subseteq> topspace Y\<close> by blast
+      then have eq: "closedin (subtopology X Kf) (Kf \<inter> {x \<in> topspace X. f x \<in> C}) =
+                 closedin (subtopology Y K) (K \<inter> C)"
+        using f [OF that] * unfolding quotient_map_closedin Kf_def
+        by (smt (verit, ccfv_SIG) Collect_cong Int_def compactin_subset_topspace mem_Collect_eq that topspace_subtopology topspace_subtopology_subset)
+      have dd: "{x \<in> topspace X \<inter> Kf. f x \<in> K \<inter> C} = Kf \<inter> {x \<in> topspace X. f x \<in> C}"
+        by (auto simp add: Kf_def)
+      have "closedin (subtopology X Kf) {x \<in> topspace X. x \<in> Kf \<and> f x \<in> K \<and> f x \<in> C}"
+        using K closedin_subtopology by (fastforce simp add: Kf_def)
+      with K closedin_subtopology_Int_closed eq show ?thesis
+        by blast
+    qed
+    then show ?thesis 
+      using \<open>k_space Y\<close> that unfolding k_space by blast
+  qed
+  moreover have "closedin X {x \<in> topspace X. f x \<in> K}"
+    if "K \<subseteq> topspace Y" "closedin Y K" for K
+    using that cmf continuous_map_closedin by fastforce
+  ultimately show ?thesis
+    unfolding quotient_map_closedin using fim by blast
+qed
+
+lemma quotient_map_into_k_space_eq:
+  assumes "k_space Y" "kc_space Y"
+  shows "quotient_map X Y f \<longleftrightarrow>
+         continuous_map X Y f \<and> f ` (topspace X) = topspace Y \<and>
+         (\<forall>K. compactin Y K
+              \<longrightarrow> quotient_map (subtopology X {x \<in> topspace X. f x \<in> K}) (subtopology Y K) f)"
+  using assms
+  by (auto simp: kc_space_def intro: quotient_map_into_k_space quotient_map_restriction
+       dest: quotient_imp_continuous_map quotient_imp_surjective_map)
+
+lemma open_map_into_k_space_eq:
+  assumes "k_space Y"
+  shows "open_map X Y f \<longleftrightarrow>
+         f ` (topspace X) \<subseteq> topspace Y \<and>
+         (\<forall>k. compactin Y k
+              \<longrightarrow> open_map (subtopology X {x \<in> topspace X. f x \<in> k}) (subtopology Y k) f)"
+       (is "?lhs=?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: open_map_imp_subset_topspace open_map_restriction)
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (simp add: assms open_map_into_k_space)
+qed
+
+lemma closed_map_into_k_space_eq:
+  assumes "k_space Y"
+  shows "closed_map X Y f \<longleftrightarrow>
+         f ` (topspace X) \<subseteq> topspace Y \<and>
+         (\<forall>k. compactin Y k
+              \<longrightarrow> closed_map (subtopology X {x \<in> topspace X. f x \<in> k}) (subtopology Y k) f)"
+       (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: closed_map_imp_subset_topspace closed_map_restriction)
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (simp add: assms closed_map_into_k_space)
+qed
+
+lemma proper_map_into_k_space:
+  assumes "k_space Y" and fim: "f ` (topspace X) \<subseteq> topspace Y"
+    and f: "\<And>K. compactin Y K
+                 \<Longrightarrow> proper_map (subtopology X {x \<in> topspace X. f x \<in> K})
+                                (subtopology Y K) f"
+  shows "proper_map X Y f"
+proof -
+  have "closed_map X Y f"
+    by (meson assms closed_map_into_k_space fim proper_map_def)
+  with f topspace_subtopology_subset show ?thesis
+    apply (simp add: proper_map_alt)
+    by (smt (verit, best) Collect_cong compactin_absolute)
+qed
+
+lemma proper_map_into_k_space_eq:
+  assumes "k_space Y"
+  shows "proper_map X Y f \<longleftrightarrow>
+         f ` (topspace X) \<subseteq> topspace Y \<and>
+         (\<forall>K. compactin Y K
+              \<longrightarrow> proper_map (subtopology X {x \<in> topspace X. f x \<in> K}) (subtopology Y K) f)"
+         (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: proper_map_imp_subset_topspace proper_map_restriction)
+  show "?rhs \<Longrightarrow> ?lhs"
+    by (simp add: assms proper_map_into_k_space)
+qed
+
+lemma compact_imp_proper_map:
+  assumes "k_space Y" "kc_space Y" and fim: "f ` (topspace X) \<subseteq> topspace Y" 
+    and f: "continuous_map X Y f \<or> kc_space X" 
+    and comp: "\<And>K. compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}"
+  shows "proper_map X Y f"
+proof (rule compact_imp_proper_map_gen)
+  fix S
+  assume "S \<subseteq> topspace Y"
+      and "\<And>K. compactin Y K \<Longrightarrow> compactin Y (S \<inter> K)"
+  with assms show "closedin Y S"
+    by (simp add: closedin_subset_topspace inf_commute k_space kc_space_def)
+qed (use assms in auto)
+
+lemma proper_eq_compact_map:
+  assumes "k_space Y" "kc_space Y" 
+    and f: "continuous_map X Y f \<or> kc_space X" 
+  shows  "proper_map X Y f \<longleftrightarrow>
+             f ` (topspace X) \<subseteq> topspace Y \<and>
+             (\<forall>K. compactin Y K \<longrightarrow> compactin X {x \<in> topspace X. f x \<in> K})"
+         (is "?lhs \<longleftrightarrow> ?rhs")
+proof
+  show "?lhs \<Longrightarrow> ?rhs"
+    by (simp add: proper_map_alt proper_map_imp_subset_topspace)
+qed (use assms compact_imp_proper_map in auto)
+
+lemma compact_imp_perfect_map:
+  assumes "k_space Y" "kc_space Y" and "f ` (topspace X) = topspace Y" 
+    and "continuous_map X Y f" 
+    and "\<And>K. compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}"
+  shows "perfect_map X Y f"
+  by (simp add: assms compact_imp_proper_map perfect_map_def)
+
 end
 
diff --git a/src/HOL/Analysis/Abstract_Topology.thy b/src/HOL/Analysis/Abstract_Topology.thy
--- a/src/HOL/Analysis/Abstract_Topology.thy
+++ b/src/HOL/Analysis/Abstract_Topology.thy
@@ -1,5024 +1,5090 @@
 (*  Author:     L C Paulson, University of Cambridge [ported from HOL Light] *)
 
 section \<open>Operators involving abstract topology\<close>
 
 theory Abstract_Topology
   imports
     Complex_Main
     "HOL-Library.Set_Idioms"
     "HOL-Library.FuncSet"
 begin
 
 subsection \<open>General notion of a topology as a value\<close>
 
 definition\<^marker>\<open>tag important\<close> istopology :: "('a set \<Rightarrow> bool) \<Rightarrow> bool" where
   "istopology L \<equiv> (\<forall>S T. L S \<longrightarrow> L T \<longrightarrow> L (S \<inter> T)) \<and> (\<forall>\<K>. (\<forall>K\<in>\<K>. L K) \<longrightarrow> L (\<Union>\<K>))"
 
 typedef\<^marker>\<open>tag important\<close> 'a topology = "{L::('a set) \<Rightarrow> bool. istopology L}"
   morphisms "openin" "topology"
   unfolding istopology_def by blast
 
 lemma istopology_openin[iff]: "istopology(openin U)"
   using openin[of U] by blast
 
 lemma istopology_open[iff]: "istopology open"
   by (auto simp: istopology_def)
 
 lemma topology_inverse' [simp]: "istopology U \<Longrightarrow> openin (topology U) = U"
   using topology_inverse[unfolded mem_Collect_eq] .
 
 lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
   by (metis istopology_openin topology_inverse')
 
 lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
 proof
   assume "T1 = T2"
   then show "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp
 next
   assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
   then have "openin T1 = openin T2" by (simp add: fun_eq_iff)
   then have "topology (openin T1) = topology (openin T2)" by simp
   then show "T1 = T2" unfolding openin_inverse .
 qed
 
 
 text\<open>The "universe": the union of all sets in the topology.\<close>
 definition "topspace T = \<Union>{S. openin T S}"
 
 subsubsection \<open>Main properties of open sets\<close>
 
 proposition openin_clauses:
   fixes U :: "'a topology"
   shows
     "openin U {}"
     "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
     "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
   using openin[of U] unfolding istopology_def by auto
 
 lemma openin_subset: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
   unfolding topspace_def by blast
 
 lemma openin_empty[simp]: "openin U {}"
   by (rule openin_clauses)
 
 lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
   by (rule openin_clauses)
 
 lemma openin_Union[intro]: "(\<And>S. S \<in> K \<Longrightarrow> openin U S) \<Longrightarrow> openin U (\<Union>K)"
   using openin_clauses by blast
 
 lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
   using openin_Union[of "{S,T}" U] by auto
 
 lemma openin_topspace[intro, simp]: "openin U (topspace U)"
   by (force simp: openin_Union topspace_def)
 
 lemma openin_subopen: "openin U S \<longleftrightarrow> (\<forall>x \<in> S. \<exists>T. openin U T \<and> x \<in> T \<and> T \<subseteq> S)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs by auto
 next
   assume H: ?rhs
   let ?t = "\<Union>{T. openin U T \<and> T \<subseteq> S}"
   have "openin U ?t" by (force simp: openin_Union)
   also have "?t = S" using H by auto
   finally show "openin U S" .
 qed
 
 lemma openin_INT [intro]:
   assumes "finite I"
           "\<And>i. i \<in> I \<Longrightarrow> openin T (U i)"
   shows "openin T ((\<Inter>i \<in> I. U i) \<inter> topspace T)"
 using assms by (induct, auto simp: inf_sup_aci(2) openin_Int)
 
 lemma openin_INT2 [intro]:
   assumes "finite I" "I \<noteq> {}"
           "\<And>i. i \<in> I \<Longrightarrow> openin T (U i)"
   shows "openin T (\<Inter>i \<in> I. U i)"
 proof -
   have "(\<Inter>i \<in> I. U i) \<subseteq> topspace T"
     using \<open>I \<noteq> {}\<close> openin_subset[OF assms(3)] by auto
   then show ?thesis
     using openin_INT[of _ _ U, OF assms(1) assms(3)] by (simp add: inf.absorb2 inf_commute)
 qed
 
 lemma openin_Inter [intro]:
   assumes "finite \<F>" "\<F> \<noteq> {}" "\<And>X. X \<in> \<F> \<Longrightarrow> openin T X" shows "openin T (\<Inter>\<F>)"
   by (metis (full_types) assms openin_INT2 image_ident)
 
 lemma openin_Int_Inter:
   assumes "finite \<F>" "openin T U" "\<And>X. X \<in> \<F> \<Longrightarrow> openin T X" shows "openin T (U \<inter> \<Inter>\<F>)"
   using openin_Inter [of "insert U \<F>"] assms by auto
 
 
 subsubsection \<open>Closed sets\<close>
 
 definition\<^marker>\<open>tag important\<close> closedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool" where
 "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
 
 lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U"
   by (metis closedin_def)
 
 lemma closedin_empty[simp]: "closedin U {}"
   by (simp add: closedin_def)
 
 lemma closedin_topspace[intro, simp]: "closedin U (topspace U)"
   by (simp add: closedin_def)
 
 lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
   by (auto simp: Diff_Un closedin_def)
 
 lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union>{A - s|s. s\<in>S}"
   by auto
 
 lemma closedin_Union:
   assumes "finite S" "\<And>T. T \<in> S \<Longrightarrow> closedin U T"
     shows "closedin U (\<Union>S)"
   using assms by induction auto
 
 lemma closedin_Inter[intro]:
   assumes Ke: "K \<noteq> {}"
     and Kc: "\<And>S. S \<in>K \<Longrightarrow> closedin U S"
   shows "closedin U (\<Inter>K)"
   using Ke Kc unfolding closedin_def Diff_Inter by auto
 
 lemma closedin_INT[intro]:
   assumes "A \<noteq> {}" "\<And>x. x \<in> A \<Longrightarrow> closedin U (B x)"
   shows "closedin U (\<Inter>x\<in>A. B x)"
   using assms by blast
 
 lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
   using closedin_Inter[of "{S,T}" U] by auto
 
 lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
   by (metis Diff_subset closedin_def double_diff equalityD1 openin_subset)
 
 lemma topology_finer_closedin:
   "topspace X = topspace Y \<Longrightarrow> (\<forall>S. openin Y S \<longrightarrow> openin X S) \<longleftrightarrow> (\<forall>S. closedin Y S \<longrightarrow> closedin X S)"
   by (metis closedin_def openin_closedin_eq)
 
 lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
   by (simp add: openin_closedin_eq)
 
 lemma openin_diff[intro]:
   assumes oS: "openin U S"
     and cT: "closedin U T"
   shows "openin U (S - T)"
   by (metis Int_Diff cT closedin_def inf.orderE oS openin_Int openin_subset)
 
 lemma closedin_diff[intro]:
   assumes oS: "closedin U S"
     and cT: "openin U T"
   shows "closedin U (S - T)"
   by (metis Int_Diff cT closedin_Int closedin_subset inf.orderE oS openin_closedin_eq)
 
 lemma all_openin: "(\<forall>U. openin X U \<longrightarrow> P U) \<longleftrightarrow> (\<forall>U. closedin X U \<longrightarrow> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_def inf.absorb_iff2 openin_closedin_eq)
 
 lemma all_closedin: "(\<forall>U. closedin X U \<longrightarrow> P U) \<longleftrightarrow> (\<forall>U. openin X U \<longrightarrow> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_subset inf.absorb_iff2 openin_closedin_eq)
 
 lemma ex_openin: "(\<exists>U. openin X U \<and> P U) \<longleftrightarrow> (\<exists>U. closedin X U \<and> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_def inf.absorb_iff2 openin_closedin_eq)
 
 lemma ex_closedin: "(\<exists>U. closedin X U \<and> P U) \<longleftrightarrow> (\<exists>U. openin X U \<and> P (topspace X - U))"
   by (metis Diff_Diff_Int closedin_subset inf.absorb_iff2 openin_closedin_eq)
 
 
 subsection\<open>The discrete topology\<close>
 
 definition discrete_topology where "discrete_topology U \<equiv> topology (\<lambda>S. S \<subseteq> U)"
 
 lemma openin_discrete_topology [simp]: "openin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U"
 proof -
   have "istopology (\<lambda>S. S \<subseteq> U)"
     by (auto simp: istopology_def)
   then show ?thesis
     by (simp add: discrete_topology_def topology_inverse')
 qed
 
 lemma topspace_discrete_topology [simp]: "topspace(discrete_topology U) = U"
   by (meson openin_discrete_topology openin_subset openin_topspace order_refl subset_antisym)
 
 lemma closedin_discrete_topology [simp]: "closedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U"
   by (simp add: closedin_def)
 
 lemma discrete_topology_unique:
    "discrete_topology U = X \<longleftrightarrow> topspace X = U \<and> (\<forall>x \<in> U. openin X {x})" (is "?lhs = ?rhs")
 proof
   assume R: ?rhs
   then have "openin X S" if "S \<subseteq> U" for S
     using openin_subopen subsetD that by fastforce
   then show ?lhs
     by (metis R openin_discrete_topology openin_subset topology_eq)
 qed auto
 
 lemma discrete_topology_unique_alt:
   "discrete_topology U = X \<longleftrightarrow> topspace X \<subseteq> U \<and> (\<forall>x \<in> U. openin X {x})"
   using openin_subset
   by (auto simp: discrete_topology_unique)
 
 lemma subtopology_eq_discrete_topology_empty:
    "X = discrete_topology {} \<longleftrightarrow> topspace X = {}"
   using discrete_topology_unique [of "{}" X] by auto
 
 lemma subtopology_eq_discrete_topology_sing:
    "X = discrete_topology {a} \<longleftrightarrow> topspace X = {a}"
   by (metis discrete_topology_unique openin_topspace singletonD)
 
 
 subsection \<open>Subspace topology\<close>
 
 definition\<^marker>\<open>tag important\<close> subtopology :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a topology" 
   where "subtopology U V = topology (\<lambda>T. \<exists>S. T = S \<inter> V \<and> openin U S)"
 
 lemma istopology_subtopology: "istopology (\<lambda>T. \<exists>S. T = S \<inter> V \<and> openin U S)"
   (is "istopology ?L")
 proof -
   have "?L {}" by blast
   {
     fix A B
     assume A: "?L A" and B: "?L B"
     from A B obtain Sa and Sb where Sa: "openin U Sa" "A = Sa \<inter> V" and Sb: "openin U Sb" "B = Sb \<inter> V"
       by blast
     have "A \<inter> B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)"
       using Sa Sb by blast+
     then have "?L (A \<inter> B)" by blast
   }
   moreover
   {
     fix K
     assume K: "K \<subseteq> Collect ?L"
     have th0: "Collect ?L = (\<lambda>S. S \<inter> V) ` Collect (openin U)"
       by blast
     from K[unfolded th0 subset_image_iff]
     obtain Sk where Sk: "Sk \<subseteq> Collect (openin U)" "K = (\<lambda>S. S \<inter> V) ` Sk"
       by blast
     have "\<Union>K = (\<Union>Sk) \<inter> V"
       using Sk by auto
     moreover have "openin U (\<Union>Sk)"
       using Sk by (auto simp: subset_eq)
     ultimately have "?L (\<Union>K)" by blast
   }
   ultimately show ?thesis
     unfolding subset_eq mem_Collect_eq istopology_def by auto
 qed
 
 lemma openin_subtopology: "openin (subtopology U V) S \<longleftrightarrow> (\<exists>T. openin U T \<and> S = T \<inter> V)"
   unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
   by auto
 
+lemma subset_openin_subtopology:
+   "\<lbrakk>openin X S; S \<subseteq> T\<rbrakk> \<Longrightarrow> openin (subtopology X T) S"
+  by (metis inf.orderE openin_subtopology)
+
 lemma openin_subtopology_Int:
    "openin X S \<Longrightarrow> openin (subtopology X T) (S \<inter> T)"
   using openin_subtopology by auto
 
 lemma openin_subtopology_Int2:
    "openin X T \<Longrightarrow> openin (subtopology X S) (S \<inter> T)"
   using openin_subtopology by auto
 
 lemma openin_subtopology_diff_closed:
    "\<lbrakk>S \<subseteq> topspace X; closedin X T\<rbrakk> \<Longrightarrow> openin (subtopology X S) (S - T)"
   unfolding closedin_def openin_subtopology
   by (rule_tac x="topspace X - T" in exI) auto
 
 lemma openin_relative_to: "(openin X relative_to S) = openin (subtopology X S)"
   by (force simp: relative_to_def openin_subtopology)
 
 lemma topspace_subtopology [simp]: "topspace (subtopology U V) = topspace U \<inter> V"
   by (auto simp: topspace_def openin_subtopology)
 
 lemma topspace_subtopology_subset:
    "S \<subseteq> topspace X \<Longrightarrow> topspace(subtopology X S) = S"
   by (simp add: inf.absorb_iff2)
 
 lemma closedin_subtopology: "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
   unfolding closedin_def topspace_subtopology
   by (auto simp: openin_subtopology)
 
+lemma closedin_subtopology_Int_closed:
+   "closedin X T \<Longrightarrow> closedin (subtopology X S) (S \<inter> T)"
+  using closedin_subtopology inf_commute by blast
+
 lemma closedin_subset_topspace:
    "\<lbrakk>closedin X S; S \<subseteq> T\<rbrakk> \<Longrightarrow> closedin (subtopology X T) S"
   using closedin_subtopology by fastforce
 
 lemma closedin_relative_to:
    "(closedin X relative_to S) = closedin (subtopology X S)"
   by (force simp: relative_to_def closedin_subtopology)
 
 lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
   unfolding openin_subtopology
   by auto (metis IntD1 in_mono openin_subset)
 
 lemma subtopology_subtopology:
    "subtopology (subtopology X S) T = subtopology X (S \<inter> T)"
 proof -
   have eq: "\<And>T'. (\<exists>S'. T' = S' \<inter> T \<and> (\<exists>T. openin X T \<and> S' = T \<inter> S)) = (\<exists>Sa. T' = Sa \<inter> (S \<inter> T) \<and> openin X Sa)"
     by (metis inf_assoc)
   have "subtopology (subtopology X S) T = topology (\<lambda>Ta. \<exists>Sa. Ta = Sa \<inter> T \<and> openin (subtopology X S) Sa)"
     by (simp add: subtopology_def)
   also have "\<dots> = subtopology X (S \<inter> T)"
     by (simp add: openin_subtopology eq) (simp add: subtopology_def)
   finally show ?thesis .
 qed
 
 lemma openin_subtopology_alt:
      "openin (subtopology X U) S \<longleftrightarrow> S \<in> (\<lambda>T. U \<inter> T) ` Collect (openin X)"
   by (simp add: image_iff inf_commute openin_subtopology)
 
 lemma closedin_subtopology_alt:
      "closedin (subtopology X U) S \<longleftrightarrow> S \<in> (\<lambda>T. U \<inter> T) ` Collect (closedin X)"
   by (simp add: image_iff inf_commute closedin_subtopology)
 
 lemma subtopology_superset:
   assumes UV: "topspace U \<subseteq> V"
   shows "subtopology U V = U"
 proof -
   { fix S
     have "openin U S" if "openin U T" "S = T \<inter> V" for T
       by (metis Int_subset_iff assms inf.orderE openin_subset that)
     then have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S"
       by (metis assms inf.orderE inf_assoc openin_subset)
   }
   then show ?thesis
     unfolding topology_eq openin_subtopology by blast
 qed
 
 lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
   by (simp add: subtopology_superset)
 
 lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
   by (simp add: subtopology_superset)
 
 lemma subtopology_restrict:
    "subtopology X (topspace X \<inter> S) = subtopology X S"
   by (metis subtopology_subtopology subtopology_topspace)
 
 lemma openin_subtopology_empty:
   "openin (subtopology U {}) S \<longleftrightarrow> S = {}"
   by (metis Int_empty_right openin_empty openin_subtopology)
 
 lemma closedin_subtopology_empty:
   "closedin (subtopology U {}) S \<longleftrightarrow> S = {}"
   by (metis Int_empty_right closedin_empty closedin_subtopology)
 
 lemma closedin_subtopology_refl [simp]:
   "closedin (subtopology U X) X \<longleftrightarrow> X \<subseteq> topspace U"
   by (metis closedin_def closedin_topspace inf.absorb_iff2 le_inf_iff topspace_subtopology)
 
 lemma closedin_topspace_empty: "topspace T = {} \<Longrightarrow> (closedin T S \<longleftrightarrow> S = {})"
   by (simp add: closedin_def)
 
 lemma open_in_topspace_empty:
    "topspace X = {} \<Longrightarrow> openin X S \<longleftrightarrow> S = {}"
   by (simp add: openin_closedin_eq)
 
 lemma openin_imp_subset:
   "openin (subtopology U S) T \<Longrightarrow> T \<subseteq> S"
   by (metis Int_iff openin_subtopology subsetI)
 
 lemma closedin_imp_subset:
   "closedin (subtopology U S) T \<Longrightarrow> T \<subseteq> S"
   by (simp add: closedin_def)
 
 lemma openin_open_subtopology:
      "openin X S \<Longrightarrow> openin (subtopology X S) T \<longleftrightarrow> openin X T \<and> T \<subseteq> S"
   by (metis inf.orderE openin_Int openin_imp_subset openin_subtopology)
 
 lemma closedin_closed_subtopology:
      "closedin X S \<Longrightarrow> (closedin (subtopology X S) T \<longleftrightarrow> closedin X T \<and> T \<subseteq> S)"
   by (metis closedin_Int closedin_imp_subset closedin_subtopology inf.orderE)
 
 lemma closedin_trans_full:
    "\<lbrakk>closedin (subtopology X U) S; closedin X U\<rbrakk> \<Longrightarrow> closedin X S"
   using closedin_closed_subtopology by blast
 
 lemma openin_subtopology_Un:
     "\<lbrakk>openin (subtopology X T) S; openin (subtopology X U) S\<rbrakk>
      \<Longrightarrow> openin (subtopology X (T \<union> U)) S"
 by (simp add: openin_subtopology) blast
 
 lemma closedin_subtopology_Un:
     "\<lbrakk>closedin (subtopology X T) S; closedin (subtopology X U) S\<rbrakk>
      \<Longrightarrow> closedin (subtopology X (T \<union> U)) S"
 by (simp add: closedin_subtopology) blast
 
 lemma openin_trans_full:
    "\<lbrakk>openin (subtopology X U) S; openin X U\<rbrakk> \<Longrightarrow> openin X S"
   by (simp add: openin_open_subtopology)
 
 
 subsection \<open>The canonical topology from the underlying type class\<close>
 
 abbreviation\<^marker>\<open>tag important\<close> euclidean :: "'a::topological_space topology"
   where "euclidean \<equiv> topology open"
 
 abbreviation top_of_set :: "'a::topological_space set \<Rightarrow> 'a topology"
   where "top_of_set \<equiv> subtopology (topology open)"
 
 lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
   by simp
 
 declare open_openin [symmetric, simp]
 
 lemma topspace_euclidean [simp]: "topspace euclidean = UNIV"
   by (force simp: topspace_def)
 
 lemma topspace_euclidean_subtopology[simp]: "topspace (top_of_set S) = S"
   by (simp)
 
 lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
   by (simp add: closed_def closedin_def Compl_eq_Diff_UNIV)
 
 declare closed_closedin [symmetric, simp]
 
 lemma openin_subtopology_self [simp]: "openin (top_of_set S) S"
   by (metis openin_topspace topspace_euclidean_subtopology)
 
 subsubsection\<open>The most basic facts about the usual topology and metric on R\<close>
 
 abbreviation euclideanreal :: "real topology"
   where "euclideanreal \<equiv> topology open"
 
 subsection \<open>Basic "localization" results are handy for connectedness.\<close>
 
 lemma openin_open: "openin (top_of_set U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
   by (auto simp: openin_subtopology)
 
 lemma openin_Int_open:
    "\<lbrakk>openin (top_of_set U) S; open T\<rbrakk>
         \<Longrightarrow> openin (top_of_set U) (S \<inter> T)"
 by (metis open_Int Int_assoc openin_open)
 
 lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (top_of_set U) (U \<inter> S)"
   by (auto simp: openin_open)
 
 lemma open_openin_trans[trans]:
   "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (top_of_set S) T"
   by (metis Int_absorb1  openin_open_Int)
 
 lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (top_of_set T) S"
   by (auto simp: openin_open)
 
 lemma closedin_closed: "closedin (top_of_set U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
   by (simp add: closedin_subtopology Int_ac)
 
 lemma closedin_closed_Int: "closed S \<Longrightarrow> closedin (top_of_set U) (U \<inter> S)"
   by (metis closedin_closed)
 
 lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (top_of_set T) S"
   by (auto simp: closedin_closed)
 
 lemma closedin_closed_subset:
  "\<lbrakk>closedin (top_of_set U) V; T \<subseteq> U; S = V \<inter> T\<rbrakk>
              \<Longrightarrow> closedin (top_of_set T) S"
   by (metis (no_types, lifting) Int_assoc Int_commute closedin_closed inf.orderE)
 
 lemma finite_imp_closedin:
   fixes S :: "'a::t1_space set"
   shows "\<lbrakk>finite S; S \<subseteq> T\<rbrakk> \<Longrightarrow> closedin (top_of_set T) S"
     by (simp add: finite_imp_closed closed_subset)
 
 lemma closedin_singleton [simp]:
   fixes a :: "'a::t1_space"
   shows "closedin (top_of_set U) {a} \<longleftrightarrow> a \<in> U"
 using closedin_subset  by (force intro: closed_subset)
 
 lemma openin_euclidean_subtopology_iff:
   fixes S U :: "'a::metric_space set"
   shows "openin (top_of_set U) S \<longleftrightarrow>
     S \<subseteq> U \<and> (\<forall>x\<in>S. \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x'\<in> S)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding openin_open open_dist by blast
 next
   define T where "T = {x. \<exists>a\<in>S. \<exists>d>0. (\<forall>y\<in>U. dist y a < d \<longrightarrow> y \<in> S) \<and> dist x a < d}"
   have 1: "\<forall>x\<in>T. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> T"
     unfolding T_def
     apply clarsimp
     apply (rule_tac x="d - dist x a" in exI)
     by (metis add_0_left dist_commute dist_triangle_lt less_diff_eq)
   assume ?rhs then have 2: "S = U \<inter> T"
     unfolding T_def
     by auto (metis dist_self)
   from 1 2 show ?lhs
     unfolding openin_open open_dist by fast
 qed
 
 lemma connected_openin:
       "connected S \<longleftrightarrow>
        \<not>(\<exists>E1 E2. openin (top_of_set S) E1 \<and>
                  openin (top_of_set S) E2 \<and>
                  S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_def openin_open disjoint_iff_not_equal by blast
 
 lemma connected_openin_eq:
       "connected S \<longleftrightarrow>
        \<not>(\<exists>E1 E2. openin (top_of_set S) E1 \<and>
                  openin (top_of_set S) E2 \<and>
                  E1 \<union> E2 = S \<and> E1 \<inter> E2 = {} \<and>
                  E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_openin
   by (metis (no_types, lifting) Un_subset_iff openin_imp_subset subset_antisym)
 
 lemma connected_closedin:
       "connected S \<longleftrightarrow>
        (\<nexists>E1 E2.
         closedin (top_of_set S) E1 \<and>
         closedin (top_of_set S) E2 \<and>
         S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
        (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs 
     by (auto simp add: connected_closed closedin_closed)
 next
   assume R: ?rhs
   then show ?lhs 
   proof (clarsimp simp add: connected_closed closedin_closed)
     fix A B 
     assume s_sub: "S \<subseteq> A \<union> B" "B \<inter> S \<noteq> {}"
       and disj: "A \<inter> B \<inter> S = {}"
       and cl: "closed A" "closed B"
     have "S - A = B \<inter> S"
       using Diff_subset_conv Un_Diff_Int disj s_sub(1) by auto
     then show "A \<inter> S = {}"
       by (metis Int_Diff_Un Int_Diff_disjoint R cl closedin_closed_Int dual_order.refl inf_commute s_sub(2))
   qed
 qed
 
 lemma connected_closedin_eq:
       "connected S \<longleftrightarrow>
            \<not>(\<exists>E1 E2.
                  closedin (top_of_set S) E1 \<and>
                  closedin (top_of_set S) E2 \<and>
                  E1 \<union> E2 = S \<and> E1 \<inter> E2 = {} \<and>
                  E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_closedin
   by (metis Un_subset_iff closedin_imp_subset subset_antisym)
 
 text \<open>These "transitivity" results are handy too\<close>
 
 lemma openin_trans[trans]:
   "openin (top_of_set T) S \<Longrightarrow> openin (top_of_set U) T \<Longrightarrow>
     openin (top_of_set U) S"
   by (metis openin_Int_open openin_open)
 
 lemma openin_open_trans: "openin (top_of_set T) S \<Longrightarrow> open T \<Longrightarrow> open S"
   by (auto simp: openin_open intro: openin_trans)
 
 lemma closedin_trans[trans]:
   "closedin (top_of_set T) S \<Longrightarrow> closedin (top_of_set U) T \<Longrightarrow>
     closedin (top_of_set U) S"
   by (auto simp: closedin_closed closed_Inter Int_assoc)
 
 lemma closedin_closed_trans: "closedin (top_of_set T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
   by (auto simp: closedin_closed intro: closedin_trans)
 
 lemma openin_subtopology_Int_subset:
    "\<lbrakk>openin (top_of_set u) (u \<inter> S); v \<subseteq> u\<rbrakk> \<Longrightarrow> openin (top_of_set v) (v \<inter> S)"
   by (auto simp: openin_subtopology)
 
 lemma openin_open_eq: "open s \<Longrightarrow> (openin (top_of_set s) t \<longleftrightarrow> open t \<and> t \<subseteq> s)"
   using open_subset openin_open_trans openin_subset by fastforce
 
 
 subsection\<open>Derived set (set of limit points)\<close>
 
 definition derived_set_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "derived'_set'_of" 80)
   where "X derived_set_of S \<equiv>
          {x \<in> topspace X.
                 (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y\<noteq>x. y \<in> S \<and> y \<in> T))}"
 
 lemma derived_set_of_restrict [simp]:
    "X derived_set_of (topspace X \<inter> S) = X derived_set_of S"
   by (simp add: derived_set_of_def) (metis openin_subset subset_iff)
 
 lemma in_derived_set_of:
    "x \<in> X derived_set_of S \<longleftrightarrow> x \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y\<noteq>x. y \<in> S \<and> y \<in> T))"
   by (simp add: derived_set_of_def)
 
 lemma derived_set_of_subset_topspace:
    "X derived_set_of S \<subseteq> topspace X"
   by (auto simp add: derived_set_of_def)
 
 lemma derived_set_of_subtopology:
    "(subtopology X U) derived_set_of S = U \<inter> (X derived_set_of (U \<inter> S))"
   by (simp add: derived_set_of_def openin_subtopology) blast
 
 lemma derived_set_of_subset_subtopology:
    "(subtopology X S) derived_set_of T \<subseteq> S"
   by (simp add: derived_set_of_subtopology)
 
 lemma derived_set_of_empty [simp]: "X derived_set_of {} = {}"
   by (auto simp: derived_set_of_def)
 
 lemma derived_set_of_mono:
    "S \<subseteq> T \<Longrightarrow> X derived_set_of S \<subseteq> X derived_set_of T"
   unfolding derived_set_of_def by blast
 
 lemma derived_set_of_Un:
    "X derived_set_of (S \<union> T) = X derived_set_of S \<union> X derived_set_of T" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (clarsimp simp: in_derived_set_of) (metis IntE IntI openin_Int)
   show "?rhs \<subseteq> ?lhs"
     by (simp add: derived_set_of_mono)
 qed
 
 lemma derived_set_of_Union:
    "finite \<F> \<Longrightarrow> X derived_set_of (\<Union>\<F>) = (\<Union>S \<in> \<F>. X derived_set_of S)"
 proof (induction \<F> rule: finite_induct)
   case (insert S \<F>)
   then show ?case
     by (simp add: derived_set_of_Un)
 qed auto
 
 lemma derived_set_of_topspace:
   "X derived_set_of (topspace X) = {x \<in> topspace X. \<not> openin X {x}}" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (auto simp: in_derived_set_of)
   show "?rhs \<subseteq> ?lhs"
     by (clarsimp simp: in_derived_set_of) (metis openin_closedin_eq openin_subopen singletonD subset_eq)
 qed
 
 lemma discrete_topology_unique_derived_set:
      "discrete_topology U = X \<longleftrightarrow> topspace X = U \<and> X derived_set_of U = {}"
   by (auto simp: discrete_topology_unique derived_set_of_topspace)
 
 lemma subtopology_eq_discrete_topology_eq:
    "subtopology X U = discrete_topology U \<longleftrightarrow> U \<subseteq> topspace X \<and> U \<inter> X derived_set_of U = {}"
   using discrete_topology_unique_derived_set [of U "subtopology X U"]
   by (auto simp: eq_commute derived_set_of_subtopology)
 
 lemma subtopology_eq_discrete_topology:
    "S \<subseteq> topspace X \<and> S \<inter> X derived_set_of S = {}
         \<Longrightarrow> subtopology X S = discrete_topology S"
   by (simp add: subtopology_eq_discrete_topology_eq)
 
 lemma subtopology_eq_discrete_topology_gen:
   assumes "S \<inter> X derived_set_of S = {}"
   shows "subtopology X S = discrete_topology(topspace X \<inter> S)"
 proof -
   have "subtopology X S = subtopology X (topspace X \<inter> S)"
     by (simp add: subtopology_restrict)
   then show ?thesis
     using assms by (simp add: inf.assoc subtopology_eq_discrete_topology_eq)
 qed
 
 lemma subtopology_discrete_topology [simp]: 
   "subtopology (discrete_topology U) S = discrete_topology(U \<inter> S)"
 proof -
   have "(\<lambda>T. \<exists>Sa. T = Sa \<inter> S \<and> Sa \<subseteq> U) = (\<lambda>Sa. Sa \<subseteq> U \<and> Sa \<subseteq> S)"
     by force
   then show ?thesis
     by (simp add: subtopology_def) (simp add: discrete_topology_def)
 qed
 
 lemma openin_Int_derived_set_of_subset:
    "openin X S \<Longrightarrow> S \<inter> X derived_set_of T \<subseteq> X derived_set_of (S \<inter> T)"
   by (auto simp: derived_set_of_def)
 
 lemma openin_Int_derived_set_of_eq:
   assumes "openin X S"
   shows "S \<inter> X derived_set_of T = S \<inter> X derived_set_of (S \<inter> T)" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: assms openin_Int_derived_set_of_subset)
   show "?rhs \<subseteq> ?lhs"
     by (metis derived_set_of_mono inf_commute inf_le1 inf_mono order_refl)
 qed
 
 
 subsection\<open> Closure with respect to a topological space\<close>
 
 definition closure_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "closure'_of" 80)
   where "X closure_of S \<equiv> {x \<in> topspace X. \<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y \<in> S. y \<in> T)}"
 
 lemma closure_of_restrict: "X closure_of S = X closure_of (topspace X \<inter> S)"
   unfolding closure_of_def
   using openin_subset by blast
 
 lemma in_closure_of:
    "x \<in> X closure_of S \<longleftrightarrow>
     x \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y. y \<in> S \<and> y \<in> T))"
   by (auto simp: closure_of_def)
 
 lemma closure_of: "X closure_of S = topspace X \<inter> (S \<union> X derived_set_of S)"
   by (fastforce simp: in_closure_of in_derived_set_of)
 
 lemma closure_of_alt: "X closure_of S = topspace X \<inter> S \<union> X derived_set_of S"
   using derived_set_of_subset_topspace [of X S]
   unfolding closure_of_def in_derived_set_of
   by safe (auto simp: in_derived_set_of)
 
 lemma derived_set_of_subset_closure_of:
    "X derived_set_of S \<subseteq> X closure_of S"
   by (fastforce simp: closure_of_def in_derived_set_of)
 
 lemma closure_of_subtopology:
   "(subtopology X U) closure_of S = U \<inter> (X closure_of (U \<inter> S))"
   unfolding closure_of_def topspace_subtopology openin_subtopology
   by safe (metis (full_types) IntI Int_iff inf.commute)+
 
 lemma closure_of_empty [simp]: "X closure_of {} = {}"
   by (simp add: closure_of_alt)
 
 lemma closure_of_topspace [simp]: "X closure_of topspace X = topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_UNIV [simp]: "X closure_of UNIV = topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_subset_topspace: "X closure_of S \<subseteq> topspace X"
   by (simp add: closure_of)
 
 lemma closure_of_subset_subtopology: "(subtopology X S) closure_of T \<subseteq> S"
   by (simp add: closure_of_subtopology)
 
 lemma closure_of_mono: "S \<subseteq> T \<Longrightarrow> X closure_of S \<subseteq> X closure_of T"
   by (fastforce simp add: closure_of_def)
 
 lemma closure_of_subtopology_subset:
    "(subtopology X U) closure_of S \<subseteq> (X closure_of S)"
   unfolding closure_of_subtopology
   by clarsimp (meson closure_of_mono contra_subsetD inf.cobounded2)
 
 lemma closure_of_subtopology_mono:
    "T \<subseteq> U \<Longrightarrow> (subtopology X T) closure_of S \<subseteq> (subtopology X U) closure_of S"
   unfolding closure_of_subtopology
   by auto (meson closure_of_mono inf_mono subset_iff)
 
 lemma closure_of_Un [simp]: "X closure_of (S \<union> T) = X closure_of S \<union> X closure_of T"
   by (simp add: Un_assoc Un_left_commute closure_of_alt derived_set_of_Un inf_sup_distrib1)
 
 lemma closure_of_Union:
    "finite \<F> \<Longrightarrow> X closure_of (\<Union>\<F>) = (\<Union>S \<in> \<F>. X closure_of S)"
 by (induction \<F> rule: finite_induct) auto
 
 lemma closure_of_subset: "S \<subseteq> topspace X \<Longrightarrow> S \<subseteq> X closure_of S"
   by (auto simp: closure_of_def)
 
 lemma closure_of_subset_Int: "topspace X \<inter> S \<subseteq> X closure_of S"
   by (auto simp: closure_of_def)
 
 lemma closure_of_subset_eq: "S \<subseteq> topspace X \<and> X closure_of S \<subseteq> S \<longleftrightarrow> closedin X S"
 proof -
   have "openin X (topspace X - S)"
     if "\<And>x. \<lbrakk>x \<in> topspace X; \<forall>T. x \<in> T \<and> openin X T \<longrightarrow> S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow> x \<in> S"
     apply (subst openin_subopen)
     by (metis Diff_iff Diff_mono Diff_triv inf.commute openin_subset order_refl that)
   then show ?thesis
     by (auto simp: closedin_def closure_of_def disjoint_iff_not_equal)
 qed
 
 lemma closure_of_eq: "X closure_of S = S \<longleftrightarrow> closedin X S"
   by (metis closure_of_subset closure_of_subset_eq closure_of_subset_topspace subset_antisym)
 
 lemma closedin_contains_derived_set:
    "closedin X S \<longleftrightarrow> X derived_set_of S \<subseteq> S \<and> S \<subseteq> topspace X"
 proof (intro iffI conjI)
   show "closedin X S \<Longrightarrow> X derived_set_of S \<subseteq> S"
     using closure_of_eq derived_set_of_subset_closure_of by fastforce
   show "closedin X S \<Longrightarrow> S \<subseteq> topspace X"
     using closedin_subset by blast
   show "X derived_set_of S \<subseteq> S \<and> S \<subseteq> topspace X \<Longrightarrow> closedin X S"
     by (metis closure_of closure_of_eq inf.absorb_iff2 sup.orderE)
 qed
 
 lemma derived_set_subset_gen:
    "X derived_set_of S \<subseteq> S \<longleftrightarrow> closedin X (topspace X \<inter> S)"
   by (simp add: closedin_contains_derived_set derived_set_of_subset_topspace)
 
 lemma derived_set_subset: "S \<subseteq> topspace X \<Longrightarrow> (X derived_set_of S \<subseteq> S \<longleftrightarrow> closedin X S)"
   by (simp add: closedin_contains_derived_set)
 
 lemma closedin_derived_set:
      "closedin (subtopology X T) S \<longleftrightarrow>
       S \<subseteq> topspace X \<and> S \<subseteq> T \<and> (\<forall>x. x \<in> X derived_set_of S \<and> x \<in> T \<longrightarrow> x \<in> S)"
   by (auto simp: closedin_contains_derived_set derived_set_of_subtopology Int_absorb1)
 
 lemma closedin_Int_closure_of:
      "closedin (subtopology X S) T \<longleftrightarrow> S \<inter> X closure_of T = T"
   by (metis Int_left_absorb closure_of_eq closure_of_subtopology)
 
 lemma closure_of_closedin: "closedin X S \<Longrightarrow> X closure_of S = S"
   by (simp add: closure_of_eq)
 
 lemma closure_of_eq_diff: "X closure_of S = topspace X - \<Union>{T. openin X T \<and> disjnt S T}"
   by (auto simp: closure_of_def disjnt_iff)
 
 lemma closedin_closure_of [simp]: "closedin X (X closure_of S)"
   unfolding closure_of_eq_diff by blast
 
 lemma closure_of_closure_of [simp]: "X closure_of (X closure_of S) = X closure_of S"
   by (simp add: closure_of_eq)
 
 lemma closure_of_hull:
   assumes "S \<subseteq> topspace X" shows "X closure_of S = (closedin X) hull S"
   by (metis assms closedin_closure_of closure_of_eq closure_of_mono closure_of_subset hull_unique)
 
 lemma closure_of_minimal:
    "\<lbrakk>S \<subseteq> T; closedin X T\<rbrakk> \<Longrightarrow> (X closure_of S) \<subseteq> T"
   by (metis closure_of_eq closure_of_mono)
 
 lemma closure_of_minimal_eq:
    "\<lbrakk>S \<subseteq> topspace X; closedin X T\<rbrakk> \<Longrightarrow> (X closure_of S) \<subseteq> T \<longleftrightarrow> S \<subseteq> T"
   by (meson closure_of_minimal closure_of_subset subset_trans)
 
 lemma closure_of_unique:
    "\<lbrakk>S \<subseteq> T; closedin X T;
      \<And>T'. \<lbrakk>S \<subseteq> T'; closedin X T'\<rbrakk> \<Longrightarrow> T \<subseteq> T'\<rbrakk>
     \<Longrightarrow> X closure_of S = T"
   by (meson closedin_closure_of closedin_subset closure_of_minimal closure_of_subset eq_iff order.trans)
 
 lemma closure_of_eq_empty_gen: "X closure_of S = {} \<longleftrightarrow> disjnt (topspace X) S"
   unfolding disjnt_def closure_of_restrict [where S=S]
   using closure_of by fastforce
 
 lemma closure_of_eq_empty: "S \<subseteq> topspace X \<Longrightarrow> X closure_of S = {} \<longleftrightarrow> S = {}"
   using closure_of_subset by fastforce
 
 lemma openin_Int_closure_of_subset:
   assumes "openin X S"
   shows "S \<inter> X closure_of T \<subseteq> X closure_of (S \<inter> T)"
 proof -
   have "S \<inter> X derived_set_of T = S \<inter> X derived_set_of (S \<inter> T)"
     by (meson assms openin_Int_derived_set_of_eq)
   moreover have "S \<inter> (S \<inter> T) = S \<inter> T"
     by fastforce
   ultimately show ?thesis
     by (metis closure_of_alt inf.cobounded2 inf_left_commute inf_sup_distrib1)
 qed
 
 lemma closure_of_openin_Int_closure_of:
   assumes "openin X S"
   shows "X closure_of (S \<inter> X closure_of T) = X closure_of (S \<inter> T)"
 proof
   show "X closure_of (S \<inter> X closure_of T) \<subseteq> X closure_of (S \<inter> T)"
     by (simp add: assms closure_of_minimal openin_Int_closure_of_subset)
 next
   show "X closure_of (S \<inter> T) \<subseteq> X closure_of (S \<inter> X closure_of T)"
     by (metis Int_subset_iff assms closure_of_alt closure_of_mono inf_mono openin_subset subset_refl sup.coboundedI1)
 qed
 
 lemma openin_Int_closure_of_eq:
   assumes "openin X S" shows "S \<inter> X closure_of T = S \<inter> X closure_of (S \<inter> T)"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: assms openin_Int_closure_of_subset)
   show "?rhs \<subseteq> ?lhs"
     by (metis closure_of_mono inf_commute inf_le1 inf_mono order_refl)
 qed
 
 lemma openin_Int_closure_of_eq_empty:
   assumes "openin X S" shows "S \<inter> X closure_of T = {} \<longleftrightarrow> S \<inter> T = {}"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding disjoint_iff
     by (meson assms in_closure_of in_mono openin_subset)
   show "?rhs \<Longrightarrow> ?lhs"
     by (simp add: assms openin_Int_closure_of_eq)
 qed
 
 lemma closure_of_openin_Int_superset:
    "openin X S \<and> S \<subseteq> X closure_of T
         \<Longrightarrow> X closure_of (S \<inter> T) = X closure_of S"
   by (metis closure_of_openin_Int_closure_of inf.orderE)
 
 lemma closure_of_openin_subtopology_Int_closure_of:
   assumes S: "openin (subtopology X U) S" and "T \<subseteq> U"
   shows "X closure_of (S \<inter> X closure_of T) = X closure_of (S \<inter> T)" (is "?lhs = ?rhs")
 proof
   obtain S0 where S0: "openin X S0" "S = S0 \<inter> U"
     using assms by (auto simp: openin_subtopology)
   then show "?lhs \<subseteq> ?rhs"
   proof -
     have "S0 \<inter> X closure_of T = S0 \<inter> X closure_of (S0 \<inter> T)"
       by (meson S0(1) openin_Int_closure_of_eq)
     moreover have "S0 \<inter> T = S0 \<inter> U \<inter> T"
       using \<open>T \<subseteq> U\<close> by fastforce
     ultimately have "S \<inter> X closure_of T \<subseteq> X closure_of (S \<inter> T)"
       using S0(2) by auto
     then show ?thesis
       by (meson closedin_closure_of closure_of_minimal)
   qed
 next
   show "?rhs \<subseteq> ?lhs"
   proof -
     have "T \<inter> S \<subseteq> T \<union> X derived_set_of T"
       by force
     then show ?thesis
       by (smt (verit, del_insts) Int_iff in_closure_of inf.orderE openin_subset subsetI)
   qed
 qed
 
 lemma closure_of_subtopology_open:
      "openin X U \<or> S \<subseteq> U \<Longrightarrow> (subtopology X U) closure_of S = U \<inter> X closure_of S"
   by (metis closure_of_subtopology inf_absorb2 openin_Int_closure_of_eq)
 
 lemma discrete_topology_closure_of:
      "(discrete_topology U) closure_of S = U \<inter> S"
   by (metis closedin_discrete_topology closure_of_restrict closure_of_unique discrete_topology_unique inf_sup_ord(1) order_refl)
 
 
 text\<open> Interior with respect to a topological space.                             \<close>
 
 definition interior_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "interior'_of" 80)
   where "X interior_of S \<equiv> {x. \<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> S}"
 
 lemma interior_of_restrict:
    "X interior_of S = X interior_of (topspace X \<inter> S)"
   using openin_subset by (auto simp: interior_of_def)
 
 lemma interior_of_eq: "(X interior_of S = S) \<longleftrightarrow> openin X S"
   unfolding interior_of_def  using openin_subopen by blast
 
 lemma interior_of_openin: "openin X S \<Longrightarrow> X interior_of S = S"
   by (simp add: interior_of_eq)
 
 lemma interior_of_empty [simp]: "X interior_of {} = {}"
   by (simp add: interior_of_eq)
 
 lemma interior_of_topspace [simp]: "X interior_of (topspace X) = topspace X"
   by (simp add: interior_of_eq)
 
 lemma openin_interior_of [simp]: "openin X (X interior_of S)"
   unfolding interior_of_def
   using openin_subopen by fastforce
 
 lemma interior_of_interior_of [simp]:
    "X interior_of X interior_of S = X interior_of S"
   by (simp add: interior_of_eq)
 
 lemma interior_of_subset: "X interior_of S \<subseteq> S"
   by (auto simp: interior_of_def)
 
 lemma interior_of_subset_closure_of: "X interior_of S \<subseteq> X closure_of S"
   by (metis closure_of_subset_Int dual_order.trans interior_of_restrict interior_of_subset)
 
 lemma subset_interior_of_eq: "S \<subseteq> X interior_of S \<longleftrightarrow> openin X S"
   by (metis interior_of_eq interior_of_subset subset_antisym)
 
 lemma interior_of_mono: "S \<subseteq> T \<Longrightarrow> X interior_of S \<subseteq> X interior_of T"
   by (auto simp: interior_of_def)
 
 lemma interior_of_maximal: "\<lbrakk>T \<subseteq> S; openin X T\<rbrakk> \<Longrightarrow> T \<subseteq> X interior_of S"
   by (auto simp: interior_of_def)
 
 lemma interior_of_maximal_eq: "openin X T \<Longrightarrow> T \<subseteq> X interior_of S \<longleftrightarrow> T \<subseteq> S"
   by (meson interior_of_maximal interior_of_subset order_trans)
 
 lemma interior_of_unique:
    "\<lbrakk>T \<subseteq> S; openin X T; \<And>T'. \<lbrakk>T' \<subseteq> S; openin X T'\<rbrakk> \<Longrightarrow> T' \<subseteq> T\<rbrakk> \<Longrightarrow> X interior_of S = T"
   by (simp add: interior_of_maximal_eq interior_of_subset subset_antisym)
 
 lemma interior_of_subset_topspace: "X interior_of S \<subseteq> topspace X"
   by (simp add: openin_subset)
 
 lemma interior_of_subset_subtopology: "(subtopology X S) interior_of T \<subseteq> S"
   by (meson openin_imp_subset openin_interior_of)
 
 lemma interior_of_Int: "X interior_of (S \<inter> T) = X interior_of S \<inter> X interior_of T"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (simp add: interior_of_mono)
   show "?rhs \<subseteq> ?lhs"
     by (meson inf_mono interior_of_maximal interior_of_subset openin_Int openin_interior_of)
 qed
 
 lemma interior_of_Inter_subset: "X interior_of (\<Inter>\<F>) \<subseteq> (\<Inter>S \<in> \<F>. X interior_of S)"
   by (simp add: INT_greatest Inf_lower interior_of_mono)
 
 lemma union_interior_of_subset:
    "X interior_of S \<union> X interior_of T \<subseteq> X interior_of (S \<union> T)"
   by (simp add: interior_of_mono)
 
 lemma interior_of_eq_empty:
    "X interior_of S = {} \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<subseteq> S \<longrightarrow> T = {})"
   by (metis bot.extremum_uniqueI interior_of_maximal interior_of_subset openin_interior_of)
 
 lemma interior_of_eq_empty_alt:
    "X interior_of S = {} \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> T - S \<noteq> {})"
   by (auto simp: interior_of_eq_empty)
 
 lemma interior_of_Union_openin_subsets:
    "\<Union>{T. openin X T \<and> T \<subseteq> S} = X interior_of S"
   by (rule interior_of_unique [symmetric]) auto
 
 lemma interior_of_complement:
    "X interior_of (topspace X - S) = topspace X - X closure_of S"
   by (auto simp: interior_of_def closure_of_def)
 
 lemma interior_of_closure_of:
    "X interior_of S = topspace X - X closure_of (topspace X - S)"
   unfolding interior_of_complement [symmetric]
   by (metis Diff_Diff_Int interior_of_restrict)
 
 lemma closure_of_interior_of:
    "X closure_of S = topspace X - X interior_of (topspace X - S)"
   by (simp add: interior_of_complement Diff_Diff_Int closure_of)
 
 lemma closure_of_complement: "X closure_of (topspace X - S) = topspace X - X interior_of S"
   unfolding interior_of_def closure_of_def
   by (blast dest: openin_subset)
 
 lemma interior_of_eq_empty_complement:
   "X interior_of S = {} \<longleftrightarrow> X closure_of (topspace X - S) = topspace X"
   using interior_of_subset_topspace [of X S] closure_of_complement by fastforce
 
 lemma closure_of_eq_topspace:
    "X closure_of S = topspace X \<longleftrightarrow> X interior_of (topspace X - S) = {}"
   using closure_of_subset_topspace [of X S] interior_of_complement by fastforce
 
 lemma interior_of_subtopology_subset:
      "U \<inter> X interior_of S \<subseteq> (subtopology X U) interior_of S"
   by (auto simp: interior_of_def openin_subtopology)
 
 lemma interior_of_subtopology_subsets:
    "T \<subseteq> U \<Longrightarrow> T \<inter> (subtopology X U) interior_of S \<subseteq> (subtopology X T) interior_of S"
   by (metis inf.absorb_iff2 interior_of_subtopology_subset subtopology_subtopology)
 
 lemma interior_of_subtopology_mono:
    "\<lbrakk>S \<subseteq> T; T \<subseteq> U\<rbrakk> \<Longrightarrow> (subtopology X U) interior_of S \<subseteq> (subtopology X T) interior_of S"
   by (metis dual_order.trans inf.orderE inf_commute interior_of_subset interior_of_subtopology_subsets)
 
 lemma interior_of_subtopology_open:
   assumes "openin X U"
   shows "(subtopology X U) interior_of S = U \<inter> X interior_of S" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (meson assms interior_of_maximal interior_of_subset le_infI openin_interior_of openin_open_subtopology)
   show "?rhs \<subseteq> ?lhs"
     by (simp add: interior_of_subtopology_subset)
 qed
 
 lemma dense_intersects_open:
    "X closure_of S = topspace X \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> S \<inter> T \<noteq> {})"
 proof -
   have "X closure_of S = topspace X \<longleftrightarrow> (topspace X - X interior_of (topspace X - S) = topspace X)"
     by (simp add: closure_of_interior_of)
   also have "\<dots> \<longleftrightarrow> X interior_of (topspace X - S) = {}"
     by (simp add: closure_of_complement interior_of_eq_empty_complement)
   also have "\<dots> \<longleftrightarrow> (\<forall>T. openin X T \<and> T \<noteq> {} \<longrightarrow> S \<inter> T \<noteq> {})"
     unfolding interior_of_eq_empty_alt
     using openin_subset by fastforce
   finally show ?thesis .
 qed
 
 lemma interior_of_closedin_union_empty_interior_of:
   assumes "closedin X S" and disj: "X interior_of T = {}"
   shows "X interior_of (S \<union> T) = X interior_of S"
 proof -
   have "X closure_of (topspace X - T) = topspace X"
     by (metis Diff_Diff_Int disj closure_of_eq_topspace closure_of_restrict interior_of_closure_of)
   then show ?thesis
     unfolding interior_of_closure_of
     by (metis Diff_Un Diff_subset assms(1) closedin_def closure_of_openin_Int_superset)
 qed
 
 lemma interior_of_union_eq_empty:
    "closedin X S
         \<Longrightarrow> (X interior_of (S \<union> T) = {} \<longleftrightarrow>
              X interior_of S = {} \<and> X interior_of T = {})"
   by (metis interior_of_closedin_union_empty_interior_of le_sup_iff subset_empty union_interior_of_subset)
 
 lemma discrete_topology_interior_of [simp]:
     "(discrete_topology U) interior_of S = U \<inter> S"
   by (simp add: interior_of_restrict [of _ S] interior_of_eq)
 
 
 subsection \<open>Frontier with respect to topological space \<close>
 
 definition frontier_of :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixr "frontier'_of" 80)
   where "X frontier_of S \<equiv> X closure_of S - X interior_of S"
 
 lemma frontier_of_closures:
      "X frontier_of S = X closure_of S \<inter> X closure_of (topspace X - S)"
   by (metis Diff_Diff_Int closure_of_complement closure_of_subset_topspace double_diff frontier_of_def interior_of_subset_closure_of)
 
 lemma interior_of_union_frontier_of [simp]:
      "X interior_of S \<union> X frontier_of S = X closure_of S"
   by (simp add: frontier_of_def interior_of_subset_closure_of subset_antisym)
 
 lemma frontier_of_restrict: "X frontier_of S = X frontier_of (topspace X \<inter> S)"
   by (metis closure_of_restrict frontier_of_def interior_of_restrict)
 
 lemma closedin_frontier_of: "closedin X (X frontier_of S)"
   by (simp add: closedin_Int frontier_of_closures)
 
 lemma frontier_of_subset_topspace: "X frontier_of S \<subseteq> topspace X"
   by (simp add: closedin_frontier_of closedin_subset)
 
 lemma frontier_of_subset_subtopology: "(subtopology X S) frontier_of T \<subseteq> S"
   by (metis (no_types) closedin_derived_set closedin_frontier_of)
 
 lemma frontier_of_subtopology_subset:
   "U \<inter> (subtopology X U) frontier_of S \<subseteq> (X frontier_of S)"
 proof -
   have "U \<inter> X interior_of S - subtopology X U interior_of S = {}"
     by (simp add: interior_of_subtopology_subset)
   moreover have "X closure_of S \<inter> subtopology X U closure_of S = subtopology X U closure_of S"
     by (meson closure_of_subtopology_subset inf.absorb_iff2)
   ultimately show ?thesis
     unfolding frontier_of_def
     by blast
 qed
 
 lemma frontier_of_subtopology_mono:
    "\<lbrakk>S \<subseteq> T; T \<subseteq> U\<rbrakk> \<Longrightarrow> (subtopology X T) frontier_of S \<subseteq> (subtopology X U) frontier_of S"
     by (simp add: frontier_of_def Diff_mono closure_of_subtopology_mono interior_of_subtopology_mono)
 
 lemma clopenin_eq_frontier_of:
    "closedin X S \<and> openin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> X frontier_of S = {}"
 proof (cases "S \<subseteq> topspace X")
   case True
   then show ?thesis
     by (metis Diff_eq_empty_iff closure_of_eq closure_of_subset_eq frontier_of_def interior_of_eq interior_of_subset interior_of_union_frontier_of sup_bot_right)
 next
   case False
   then show ?thesis
     by (simp add: frontier_of_closures openin_closedin_eq)
 qed
 
 lemma frontier_of_eq_empty:
      "S \<subseteq> topspace X \<Longrightarrow> (X frontier_of S = {} \<longleftrightarrow> closedin X S \<and> openin X S)"
   by (simp add: clopenin_eq_frontier_of)
 
 lemma frontier_of_openin:
      "openin X S \<Longrightarrow> X frontier_of S = X closure_of S - S"
   by (metis (no_types) frontier_of_def interior_of_eq)
 
 lemma frontier_of_openin_straddle_Int:
   assumes "openin X U" "U \<inter> X frontier_of S \<noteq> {}"
   shows "U \<inter> S \<noteq> {}" "U - S \<noteq> {}"
 proof -
   have "U \<inter> (X closure_of S \<inter> X closure_of (topspace X - S)) \<noteq> {}"
     using assms by (simp add: frontier_of_closures)
   then show "U \<inter> S \<noteq> {}"
     using assms openin_Int_closure_of_eq_empty by fastforce
   show "U - S \<noteq> {}"
   proof -
     have "\<exists>A. X closure_of (A - S) \<inter> U \<noteq> {}"
       using \<open>U \<inter> (X closure_of S \<inter> X closure_of (topspace X - S)) \<noteq> {}\<close> by blast
     then have "\<not> U \<subseteq> S"
       by (metis Diff_disjoint Diff_eq_empty_iff Int_Diff assms(1) inf_commute openin_Int_closure_of_eq_empty)
     then show ?thesis
       by blast
   qed
 qed
 
 lemma frontier_of_subset_closedin: "closedin X S \<Longrightarrow> (X frontier_of S) \<subseteq> S"
   using closure_of_eq frontier_of_def by fastforce
 
 lemma frontier_of_empty [simp]: "X frontier_of {} = {}"
   by (simp add: frontier_of_def)
 
 lemma frontier_of_topspace [simp]: "X frontier_of topspace X = {}"
   by (simp add: frontier_of_def)
 
 lemma frontier_of_subset_eq:
   assumes "S \<subseteq> topspace X"
   shows "(X frontier_of S) \<subseteq> S \<longleftrightarrow> closedin X S"
 proof
   show "X frontier_of S \<subseteq> S \<Longrightarrow> closedin X S"
     by (metis assms closure_of_subset_eq interior_of_subset interior_of_union_frontier_of le_sup_iff)
   show "closedin X S \<Longrightarrow> X frontier_of S \<subseteq> S"
     by (simp add: frontier_of_subset_closedin)
 qed
 
 lemma frontier_of_complement: "X frontier_of (topspace X - S) = X frontier_of S"
   by (metis Diff_Diff_Int closure_of_restrict frontier_of_closures inf_commute)
 
 lemma frontier_of_disjoint_eq:
   assumes "S \<subseteq> topspace X"
   shows "((X frontier_of S) \<inter> S = {} \<longleftrightarrow> openin X S)"
 proof
   assume "X frontier_of S \<inter> S = {}"
   then have "closedin X (topspace X - S)"
     using assms closure_of_subset frontier_of_def interior_of_eq interior_of_subset by fastforce
   then show "openin X S"
     using assms by (simp add: openin_closedin)
 next
   show "openin X S \<Longrightarrow> X frontier_of S \<inter> S = {}"
     by (simp add: Diff_Diff_Int closedin_def frontier_of_openin inf.absorb_iff2 inf_commute)
 qed
 
 lemma frontier_of_disjoint_eq_alt:
   "S \<subseteq> (topspace X - X frontier_of S) \<longleftrightarrow> openin X S"
 proof (cases "S \<subseteq> topspace X")
   case True
   show ?thesis
     using True frontier_of_disjoint_eq by auto
 next
   case False
   then show ?thesis
     by (meson Diff_subset openin_subset subset_trans)
 qed
 
 lemma frontier_of_Int:
      "X frontier_of (S \<inter> T) =
       X closure_of (S \<inter> T) \<inter> (X frontier_of S \<union> X frontier_of T)"
 proof -
   have *: "U \<subseteq> S \<and> U \<subseteq> T \<Longrightarrow> U \<inter> (S \<inter> A \<union> T \<inter> B) = U \<inter> (A \<union> B)" for U S T A B :: "'a set"
     by blast
   show ?thesis
     by (simp add: frontier_of_closures closure_of_mono Diff_Int * flip: closure_of_Un)
 qed
 
 lemma frontier_of_Int_subset: "X frontier_of (S \<inter> T) \<subseteq> X frontier_of S \<union> X frontier_of T"
   by (simp add: frontier_of_Int)
 
 lemma frontier_of_Int_closedin:
   assumes "closedin X S" "closedin X T" 
   shows "X frontier_of(S \<inter> T) = X frontier_of S \<inter> T \<union> S \<inter> X frontier_of T"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     using assms by (force simp add: frontier_of_Int closedin_Int closure_of_closedin)
   show "?rhs \<subseteq> ?lhs"
     using assms frontier_of_subset_closedin
     by (auto simp add: frontier_of_Int closedin_Int closure_of_closedin)
 qed
 
 lemma frontier_of_Un_subset: "X frontier_of(S \<union> T) \<subseteq> X frontier_of S \<union> X frontier_of T"
   by (metis Diff_Un frontier_of_Int_subset frontier_of_complement)
 
 lemma frontier_of_Union_subset:
    "finite \<F> \<Longrightarrow> X frontier_of (\<Union>\<F>) \<subseteq> (\<Union>T \<in> \<F>. X frontier_of T)"
 proof (induction \<F> rule: finite_induct)
   case (insert A \<F>)
   then show ?case
     using frontier_of_Un_subset by fastforce
 qed simp
 
 lemma frontier_of_frontier_of_subset:
      "X frontier_of (X frontier_of S) \<subseteq> X frontier_of S"
   by (simp add: closedin_frontier_of frontier_of_subset_closedin)
 
 lemma frontier_of_subtopology_open:
      "openin X U \<Longrightarrow> (subtopology X U) frontier_of S = U \<inter> X frontier_of S"
   by (simp add: Diff_Int_distrib closure_of_subtopology_open frontier_of_def interior_of_subtopology_open)
 
 lemma discrete_topology_frontier_of [simp]:
      "(discrete_topology U) frontier_of S = {}"
   by (simp add: Diff_eq discrete_topology_closure_of frontier_of_closures)
 
 lemma openin_subset_topspace_eq:
   assumes "disjnt S (X frontier_of U)"
   shows "openin (subtopology X U) S \<longleftrightarrow> openin X S \<and> S \<subseteq> U"
 proof
   assume S: "openin (subtopology X U) S"
   show "openin X S \<and> S \<subseteq> U"
   proof
     show "S \<subseteq> U"
       using S openin_imp_subset by blast
     have "disjnt S (X frontier_of (topspace X \<inter> U))"
       by (metis assms frontier_of_restrict)
     moreover
     have "openin (subtopology X (topspace X \<inter> U)) S"
       by (simp add: S subtopology_restrict)
     moreover
     have "openin X S" 
       if dis: "disjnt S (X frontier_of U)" and ope: "openin (subtopology X U) S" and "U \<subseteq> topspace X" 
       for S U
     proof -
       obtain T where T: "openin X T" "S = T \<inter> U"
         using ope by (auto simp: openin_subtopology)
       have "T \<inter> U = T \<inter> X interior_of U"
         using that T interior_of_subset in_closure_of by (fastforce simp: disjnt_iff frontier_of_def)
       then show ?thesis
         using \<open>S = T \<inter> U\<close> \<open>openin X T\<close> by auto
     qed
   ultimately show "openin X S"
       by blast
   qed 
 qed (metis inf.absorb_iff1 openin_subtopology_Int)
 
 
 subsection\<open>Locally finite collections\<close>
 
 definition locally_finite_in
   where
  "locally_finite_in X \<A> \<longleftrightarrow>
         (\<Union>\<A> \<subseteq> topspace X) \<and>
         (\<forall>x \<in> topspace X. \<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> \<A>. U \<inter> V \<noteq> {}})"
 
 lemma finite_imp_locally_finite_in:
    "\<lbrakk>finite \<A>; \<Union>\<A> \<subseteq> topspace X\<rbrakk> \<Longrightarrow> locally_finite_in X \<A>"
   by (auto simp: locally_finite_in_def)
 
 lemma locally_finite_in_subset:
   assumes "locally_finite_in X \<A>" "\<B> \<subseteq> \<A>"
   shows "locally_finite_in X \<B>"
 proof -
   have "finite (\<A> \<inter> {U. U \<inter> V \<noteq> {}}) \<Longrightarrow> finite (\<B> \<inter> {U. U \<inter> V \<noteq> {}})" for V
     by (meson \<open>\<B> \<subseteq> \<A>\<close> finite_subset inf_le1 inf_le2 le_inf_iff subset_trans)
   then show ?thesis
     using assms unfolding locally_finite_in_def Int_def by fastforce
 qed
 
 lemma locally_finite_in_refinement:
   assumes \<A>: "locally_finite_in X \<A>" and f: "\<And>S. S \<in> \<A> \<Longrightarrow> f S \<subseteq> S"
   shows "locally_finite_in X (f ` \<A>)"
 proof -
   show ?thesis
     unfolding locally_finite_in_def
   proof safe
     fix x
     assume "x \<in> topspace X"
     then obtain V where "openin X V" "x \<in> V" "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       using \<A> unfolding locally_finite_in_def by blast
     moreover have "{U \<in> \<A>. f U \<inter> V \<noteq> {}} \<subseteq> {U \<in> \<A>. U \<inter> V \<noteq> {}}" for V
       using f by blast
     ultimately have "finite {U \<in> \<A>. f U \<inter> V \<noteq> {}}"
       using finite_subset by blast
     moreover have "f ` {U \<in> \<A>. f U \<inter> V \<noteq> {}} = {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       by blast
     ultimately have "finite {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       by (metis (no_types, lifting) finite_imageI)
     then show "\<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> f ` \<A>. U \<inter> V \<noteq> {}}"
       using \<open>openin X V\<close> \<open>x \<in> V\<close> by blast
   next
     show "\<And>x xa. \<lbrakk>xa \<in> \<A>; x \<in> f xa\<rbrakk> \<Longrightarrow> x \<in> topspace X"
       by (meson Sup_upper \<A> f locally_finite_in_def subset_iff)
   qed
 qed
 
 lemma locally_finite_in_subtopology:
   assumes \<A>: "locally_finite_in X \<A>" "\<Union>\<A> \<subseteq> S"
   shows "locally_finite_in (subtopology X S) \<A>"
   unfolding locally_finite_in_def
 proof safe
   fix x
   assume x: "x \<in> topspace (subtopology X S)"
   then obtain V where "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
     using \<A> unfolding locally_finite_in_def topspace_subtopology by blast
   show "\<exists>V. openin (subtopology X S) V \<and> x \<in> V \<and> finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
   proof (intro exI conjI)
     show "openin (subtopology X S) (S \<inter> V)"
       by (simp add: \<open>openin X V\<close> openin_subtopology_Int2)
     have "{U \<in> \<A>. U \<inter> (S \<inter> V) \<noteq> {}} \<subseteq> {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       by auto
     with fin show "finite {U \<in> \<A>. U \<inter> (S \<inter> V) \<noteq> {}}"
       using finite_subset by auto
     show "x \<in> S \<inter> V"
       using x \<open>x \<in> V\<close> by (simp)
   qed
 next
   show "\<And>x A. \<lbrakk>x \<in> A; A \<in> \<A>\<rbrakk> \<Longrightarrow> x \<in> topspace (subtopology X S)"
     using assms unfolding locally_finite_in_def topspace_subtopology by blast
 qed
 
 
 lemma closedin_locally_finite_Union:
   assumes clo: "\<And>S. S \<in> \<A> \<Longrightarrow> closedin X S" and \<A>: "locally_finite_in X \<A>"
   shows "closedin X (\<Union>\<A>)"
   using \<A> unfolding locally_finite_in_def closedin_def
 proof clarify
   show "openin X (topspace X - \<Union>\<A>)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> topspace X" and "x \<notin> \<Union>\<A>"
     then obtain V where "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
       using \<A> unfolding locally_finite_in_def by blast
     let ?T = "V - \<Union>{S \<in> \<A>. S \<inter> V \<noteq> {}}"
     show "\<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> topspace X - \<Union>\<A>"
     proof (intro exI conjI)
       show "openin X ?T"
         by (metis (no_types, lifting) fin \<open>openin X V\<close> clo closedin_Union mem_Collect_eq openin_diff)
       show "x \<in> ?T"
         using \<open>x \<notin> \<Union>\<A>\<close> \<open>x \<in> V\<close> by auto
       show "?T \<subseteq> topspace X - \<Union>\<A>"
         using \<open>openin X V\<close> openin_subset by auto
     qed
   qed
 qed
 
 lemma locally_finite_in_closure:
   assumes \<A>: "locally_finite_in X \<A>"
   shows "locally_finite_in X ((\<lambda>S. X closure_of S) ` \<A>)"
   using \<A> unfolding locally_finite_in_def
 proof (intro conjI; clarsimp)
   fix x A
   assume "x \<in> X closure_of A"
   then show "x \<in> topspace X"
     by (meson in_closure_of)
 next
   fix x
   assume "x \<in> topspace X" and "\<Union>\<A> \<subseteq> topspace X"
   then obtain V where V: "openin X V" "x \<in> V" and fin: "finite {U \<in> \<A>. U \<inter> V \<noteq> {}}"
     using \<A> unfolding locally_finite_in_def by blast
   have eq: "{y \<in> f ` \<A>. Q y} = f ` {x. x \<in> \<A> \<and> Q(f x)}" for f and Q :: "'a set \<Rightarrow> bool"
     by blast
   have eq2: "{A \<in> \<A>. X closure_of A \<inter> V \<noteq> {}} = {A \<in> \<A>. A \<inter> V \<noteq> {}}"
     using openin_Int_closure_of_eq_empty V  by blast
   have "finite {U \<in> (closure_of) X ` \<A>. U \<inter> V \<noteq> {}}"
     by (simp add: eq eq2 fin)
   with V show "\<exists>V. openin X V \<and> x \<in> V \<and> finite {U \<in> (closure_of) X ` \<A>. U \<inter> V \<noteq> {}}"
     by blast
 qed
 
 lemma closedin_Union_locally_finite_closure:
    "locally_finite_in X \<A> \<Longrightarrow> closedin X (\<Union>((\<lambda>S. X closure_of S) ` \<A>))"
   by (metis (mono_tags) closedin_closure_of closedin_locally_finite_Union imageE locally_finite_in_closure)
 
 lemma closure_of_Union_subset: "\<Union>((\<lambda>S. X closure_of S) ` \<A>) \<subseteq> X closure_of (\<Union>\<A>)"
   by (simp add: SUP_le_iff Sup_upper closure_of_mono)
 
 lemma closure_of_locally_finite_Union:
   assumes "locally_finite_in X \<A>" 
   shows "X closure_of (\<Union>\<A>) = \<Union>((\<lambda>S. X closure_of S) ` \<A>)"  
 proof (rule closure_of_unique)
   show "\<Union> \<A> \<subseteq> \<Union> ((closure_of) X ` \<A>)"
     using assms by (simp add: SUP_upper2 Sup_le_iff closure_of_subset locally_finite_in_def)
   show "closedin X (\<Union> ((closure_of) X ` \<A>))"
     using assms by (simp add: closedin_Union_locally_finite_closure)
   show "\<And>T'. \<lbrakk>\<Union> \<A> \<subseteq> T'; closedin X T'\<rbrakk> \<Longrightarrow> \<Union> ((closure_of) X ` \<A>) \<subseteq> T'"
     by (simp add: Sup_le_iff closure_of_minimal)
 qed
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>Continuous maps\<close>
 
 text \<open>We will need to deal with continuous maps in terms of topologies and not in terms
 of type classes, as defined below.\<close>
 
 definition continuous_map where
   "continuous_map X Y f \<equiv>
      (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
      (\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
 
 lemma continuous_map:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_image_subset_topspace:
    "continuous_map X Y f \<Longrightarrow> f ` (topspace X) \<subseteq> topspace Y"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_on_empty: "topspace X = {} \<Longrightarrow> continuous_map X Y f"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_closedin:
    "continuous_map X Y f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
          (\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C})"
 proof -
   have "(\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U}) =
         (\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C})"
     if "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
   proof -
     have eq: "{x \<in> topspace X. f x \<in> topspace Y \<and> f x \<notin> C} = (topspace X - {x \<in> topspace X. f x \<in> C})" for C
       using that by blast
     show ?thesis
     proof (intro iffI allI impI)
       fix C
       assume "\<forall>U. openin Y U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U}" and "closedin Y C"
       then show "closedin X {x \<in> topspace X. f x \<in> C}"
         by (auto simp add: closedin_def eq)
     next
       fix U
       assume "\<forall>C. closedin Y C \<longrightarrow> closedin X {x \<in> topspace X. f x \<in> C}" and "openin Y U"
       then show "openin X {x \<in> topspace X. f x \<in> U}"
         by (auto simp add: openin_closedin_eq eq)
     qed
   qed
   then show ?thesis
     by (auto simp: continuous_map_def)
 qed
 
 lemma openin_continuous_map_preimage:
    "\<lbrakk>continuous_map X Y f; openin Y U\<rbrakk> \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   by (simp add: continuous_map_def)
 
 lemma closedin_continuous_map_preimage:
    "\<lbrakk>continuous_map X Y f; closedin Y C\<rbrakk> \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> C}"
   by (simp add: continuous_map_closedin)
 
 lemma openin_continuous_map_preimage_gen:
   assumes "continuous_map X Y f" "openin X U" "openin Y V"
   shows "openin X {x \<in> U. f x \<in> V}"
 proof -
   have eq: "{x \<in> U. f x \<in> V} = U \<inter> {x \<in> topspace X. f x \<in> V}"
     using assms(2) openin_closedin_eq by fastforce
   show ?thesis
     unfolding eq
     using assms openin_continuous_map_preimage by fastforce
 qed
 
 lemma closedin_continuous_map_preimage_gen:
   assumes "continuous_map X Y f" "closedin X U" "closedin Y V"
   shows "closedin X {x \<in> U. f x \<in> V}"
 proof -
   have eq: "{x \<in> U. f x \<in> V} = U \<inter> {x \<in> topspace X. f x \<in> V}"
     using assms(2) closedin_def by fastforce
   show ?thesis
     unfolding eq
     using assms closedin_continuous_map_preimage by fastforce
 qed
 
 lemma continuous_map_image_closure_subset:
   assumes "continuous_map X Y f"
   shows "f ` (X closure_of S) \<subseteq> Y closure_of f ` S"
 proof -
   have *: "f ` (topspace X) \<subseteq> topspace Y"
     by (meson assms continuous_map)
   have "X closure_of T \<subseteq> {x \<in> X closure_of T. f x \<in> Y closure_of (f ` T)}"
     if "T \<subseteq> topspace X" for T
   proof (rule closure_of_minimal)
     show "T \<subseteq> {x \<in> X closure_of T. f x \<in> Y closure_of f ` T}"
       using closure_of_subset * that  by (fastforce simp: in_closure_of)
   next
     show "closedin X {x \<in> X closure_of T. f x \<in> Y closure_of f ` T}"
       using assms closedin_continuous_map_preimage_gen by fastforce
   qed
   then show ?thesis
     by (smt (verit, ccfv_threshold) assms continuous_map image_eqI image_subset_iff in_closure_of mem_Collect_eq)
 qed
 
 lemma continuous_map_subset_aux1: "continuous_map X Y f \<Longrightarrow>
        (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_image_closure_subset by blast
 
 lemma continuous_map_subset_aux2:
   assumes "\<forall>S. S \<subseteq> topspace X \<longrightarrow> f ` (X closure_of S) \<subseteq> Y closure_of f ` S"
   shows "continuous_map X Y f"
   unfolding continuous_map_closedin
 proof (intro conjI ballI allI impI)
   fix x
   assume "x \<in> topspace X"
   then show "f x \<in> topspace Y"
     using assms closure_of_subset_topspace by fastforce
 next
   fix C
   assume "closedin Y C"
   then show "closedin X {x \<in> topspace X. f x \<in> C}"
   proof (clarsimp simp flip: closure_of_subset_eq, intro conjI)
     fix x
     assume x: "x \<in> X closure_of {x \<in> topspace X. f x \<in> C}"
       and "C \<subseteq> topspace Y" and "Y closure_of C \<subseteq> C"
     show "x \<in> topspace X"
       by (meson x in_closure_of)
     have "{a \<in> topspace X. f a \<in> C} \<subseteq> topspace X"
       by simp
     moreover have "Y closure_of f ` {a \<in> topspace X. f a \<in> C} \<subseteq> C"
       by (simp add: \<open>closedin Y C\<close> closure_of_minimal image_subset_iff)
     ultimately show "f x \<in> C"
       using x assms by blast
   qed
 qed
 
 lemma continuous_map_eq_image_closure_subset:
      "continuous_map X Y f \<longleftrightarrow> (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 by metis
 
 lemma continuous_map_eq_image_closure_subset_alt:
      "continuous_map X Y f \<longleftrightarrow> (\<forall>S. S \<subseteq> topspace X \<longrightarrow> f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 by metis
 
 lemma continuous_map_eq_image_closure_subset_gen:
      "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and>
         (\<forall>S. f ` (X closure_of S) \<subseteq> Y closure_of f ` S)"
   using continuous_map_subset_aux1 continuous_map_subset_aux2 continuous_map_image_subset_topspace by metis
 
 lemma continuous_map_closure_preimage_subset:
    "continuous_map X Y f
         \<Longrightarrow> X closure_of {x \<in> topspace X. f x \<in> T}
             \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of T}"
   unfolding continuous_map_closedin
   by (rule closure_of_minimal) (use in_closure_of in \<open>fastforce+\<close>)
 
 
 lemma continuous_map_frontier_frontier_preimage_subset:
   assumes "continuous_map X Y f"
   shows "X frontier_of {x \<in> topspace X. f x \<in> T} \<subseteq> {x \<in> topspace X. f x \<in> Y frontier_of T}"
 proof -
   have eq: "topspace X - {x \<in> topspace X. f x \<in> T} = {x \<in> topspace X. f x \<in> topspace Y - T}"
     using assms unfolding continuous_map_def by blast
   have "X closure_of {x \<in> topspace X. f x \<in> T} \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of T}"
     by (simp add: assms continuous_map_closure_preimage_subset)
   moreover
   have "X closure_of (topspace X - {x \<in> topspace X. f x \<in> T}) \<subseteq> {x \<in> topspace X. f x \<in> Y closure_of (topspace Y - T)}"
     using continuous_map_closure_preimage_subset [OF assms] eq by presburger
   ultimately show ?thesis
     by (auto simp: frontier_of_closures)
 qed
 
 lemma topology_finer_continuous_id:
   assumes "topspace X = topspace Y" 
   shows "(\<forall>S. openin X S \<longrightarrow> openin Y S) \<longleftrightarrow> continuous_map Y X id"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding continuous_map_def
     using assms openin_subopen openin_subset by fastforce
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding continuous_map_def
     using assms openin_subopen topspace_def by fastforce
 qed
 
 lemma continuous_map_const [simp]:
    "continuous_map X Y (\<lambda>x. C) \<longleftrightarrow> topspace X = {} \<or> C \<in> topspace Y"
 proof (cases "topspace X = {}")
   case False
   show ?thesis
   proof (cases "C \<in> topspace Y")
     case True
     with openin_subopen show ?thesis
       by (auto simp: continuous_map_def)
   next
     case False
     then show ?thesis
       unfolding continuous_map_def by fastforce
   qed
 qed (auto simp: continuous_map_on_empty)
 
 declare continuous_map_const [THEN iffD2, continuous_intros]
 
 lemma continuous_map_compose [continuous_intros]:
   assumes f: "continuous_map X X' f" and g: "continuous_map X' X'' g"
   shows "continuous_map X X'' (g \<circ> f)"
   unfolding continuous_map_def
 proof (intro conjI ballI allI impI)
   fix x
   assume "x \<in> topspace X"
   then show "(g \<circ> f) x \<in> topspace X''"
     using assms unfolding continuous_map_def by force
 next
   fix U
   assume "openin X'' U"
   have eq: "{x \<in> topspace X. (g \<circ> f) x \<in> U} = {x \<in> topspace X. f x \<in> {y. y \<in> topspace X' \<and> g y \<in> U}}"
     by auto (meson f continuous_map_def)
   show "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U}"
     unfolding eq
     using assms unfolding continuous_map_def
     using \<open>openin X'' U\<close> by blast
 qed
 
 lemma continuous_map_eq:
   assumes "continuous_map X X' f" and "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x" 
   shows "continuous_map X X' g"
 proof -
   have eq: "{x \<in> topspace X. f x \<in> U} = {x \<in> topspace X. g x \<in> U}" for U
     using assms by auto
   show ?thesis
     using assms by (simp add: continuous_map_def eq)
 qed
 
 lemma restrict_continuous_map [simp]:
      "topspace X \<subseteq> S \<Longrightarrow> continuous_map X X' (restrict f S) \<longleftrightarrow> continuous_map X X' f"
   by (auto simp: elim!: continuous_map_eq)
 
 lemma continuous_map_in_subtopology:
   "continuous_map X (subtopology X' S) f \<longleftrightarrow> continuous_map X X' f \<and> f ` (topspace X) \<subseteq> S"
   (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof -
     have "\<And>A. f ` (X closure_of A) \<subseteq> subtopology X' S closure_of f ` A"
       by (meson L continuous_map_image_closure_subset)
     then show ?thesis
       by (metis (no_types) closure_of_subset_subtopology closure_of_subtopology_subset closure_of_topspace continuous_map_eq_image_closure_subset order.trans)
   qed
 next
   assume R: ?rhs
   then have eq: "{x \<in> topspace X. f x \<in> U} = {x \<in> topspace X. f x \<in> U \<and> f x \<in> S}" for U
     by auto
   show ?lhs
     using R
     unfolding continuous_map
     by (auto simp: openin_subtopology eq)
 qed
 
 
 lemma continuous_map_from_subtopology:
      "continuous_map X X' f \<Longrightarrow> continuous_map (subtopology X S) X' f"
   by (auto simp: continuous_map openin_subtopology)
 
 lemma continuous_map_into_fulltopology:
    "continuous_map X (subtopology X' T) f \<Longrightarrow> continuous_map X X' f"
   by (auto simp: continuous_map_in_subtopology)
 
 lemma continuous_map_into_subtopology:
    "\<lbrakk>continuous_map X X' f; f ` topspace X \<subseteq> T\<rbrakk> \<Longrightarrow> continuous_map X (subtopology X' T) f"
   by (auto simp: continuous_map_in_subtopology)
 
 lemma continuous_map_from_subtopology_mono:
      "\<lbrakk>continuous_map (subtopology X T) X' f; S \<subseteq> T\<rbrakk>
       \<Longrightarrow> continuous_map (subtopology X S) X' f"
   by (metis inf.absorb_iff2 continuous_map_from_subtopology subtopology_subtopology)
 
 lemma continuous_map_from_discrete_topology [simp]:
   "continuous_map (discrete_topology U) X f \<longleftrightarrow> f ` U \<subseteq> topspace X"
   by (auto simp: continuous_map_def)
 
 lemma continuous_map_iff_continuous [simp]: "continuous_map (top_of_set S) euclidean g = continuous_on S g"
   by (fastforce simp add: continuous_map openin_subtopology continuous_on_open_invariant)
 
 lemma continuous_map_iff_continuous2 [simp]: "continuous_map euclidean euclidean g = continuous_on UNIV g"
   by (metis continuous_map_iff_continuous subtopology_UNIV)
 
 lemma continuous_map_openin_preimage_eq:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. openin Y U \<longrightarrow> openin X (topspace X \<inter> f -` U))"
   by (auto simp: continuous_map_def vimage_def Int_def)
 
 lemma continuous_map_closedin_preimage_eq:
    "continuous_map X Y f \<longleftrightarrow>
         f ` (topspace X) \<subseteq> topspace Y \<and> (\<forall>U. closedin Y U \<longrightarrow> closedin X (topspace X \<inter> f -` U))"
   by (auto simp: continuous_map_closedin vimage_def Int_def)
 
 lemma continuous_map_square_root: "continuous_map euclideanreal euclideanreal sqrt"
   by (simp add: continuous_at_imp_continuous_on isCont_real_sqrt)
 
 lemma continuous_map_sqrt [continuous_intros]:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. sqrt(f x))"
   by (meson continuous_map_compose continuous_map_eq continuous_map_square_root o_apply)
 
 lemma continuous_map_id [simp, continuous_intros]: "continuous_map X X id"
   unfolding continuous_map_def  using openin_subopen topspace_def by fastforce
 
 declare continuous_map_id [unfolded id_def, simp, continuous_intros]
 
 lemma continuous_map_id_subt [simp]: "continuous_map (subtopology X S) X id"
   by (simp add: continuous_map_from_subtopology)
 
 declare continuous_map_id_subt [unfolded id_def, simp]
 
 
 lemma\<^marker>\<open>tag important\<close> continuous_map_alt:
    "continuous_map T1 T2 f 
     = ((\<forall>U. openin T2 U \<longrightarrow> openin T1 (f -` U \<inter> topspace T1)) \<and> f ` topspace T1 \<subseteq> topspace T2)"
   by (auto simp: continuous_map_def vimage_def image_def Collect_conj_eq inf_commute)
 
 lemma continuous_map_open [intro]:
   "continuous_map T1 T2 f \<Longrightarrow> openin T2 U \<Longrightarrow> openin T1 (f-`U \<inter> topspace(T1))"
   unfolding continuous_map_alt by auto
 
 lemma continuous_map_preimage_topspace [intro]:
   assumes "continuous_map T1 T2 f"
   shows "f-`(topspace T2) \<inter> topspace T1 = topspace T1"
 using assms unfolding continuous_map_def by auto
 
 
 
 subsection\<open>Open and closed maps (not a priori assumed continuous)\<close>
 
 definition open_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "open_map X1 X2 f \<equiv> \<forall>U. openin X1 U \<longrightarrow> openin X2 (f ` U)"
 
 definition closed_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "closed_map X1 X2 f \<equiv> \<forall>U. closedin X1 U \<longrightarrow> closedin X2 (f ` U)"
 
 lemma open_map_imp_subset_topspace:
      "open_map X1 X2 f \<Longrightarrow> f ` (topspace X1) \<subseteq> topspace X2"
   unfolding open_map_def by (simp add: openin_subset)
 
 lemma open_map_on_empty:
    "topspace X = {} \<Longrightarrow> open_map X Y f"
   by (metis empty_iff imageE in_mono open_map_def openin_subopen openin_subset)
 
 lemma closed_map_on_empty:
    "topspace X = {} \<Longrightarrow> closed_map X Y f"
   by (simp add: closed_map_def closedin_topspace_empty)
 
 lemma closed_map_const:
    "closed_map X Y (\<lambda>x. c) \<longleftrightarrow> topspace X = {} \<or> closedin Y {c}"
   by (metis closed_map_def closed_map_on_empty closedin_empty closedin_topspace image_constant_conv)
 
 lemma open_map_imp_subset:
     "\<lbrakk>open_map X1 X2 f; S \<subseteq> topspace X1\<rbrakk> \<Longrightarrow> f ` S \<subseteq> topspace X2"
   by (meson order_trans open_map_imp_subset_topspace subset_image_iff)
 
 lemma topology_finer_open_id:
      "(\<forall>S. openin X S \<longrightarrow> openin X' S) \<longleftrightarrow> open_map X X' id"
   unfolding open_map_def by auto
 
 lemma open_map_id: "open_map X X id"
   unfolding open_map_def by auto
 
 lemma open_map_eq:
      "\<lbrakk>open_map X X' f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> open_map X X' g"
   unfolding open_map_def
   by (metis image_cong openin_subset subset_iff)
 
 lemma open_map_inclusion_eq:
   "open_map (subtopology X S) X id \<longleftrightarrow> openin X (topspace X \<inter> S)"
   by (metis openin_topspace openin_trans_full subtopology_restrict topology_finer_open_id topspace_subtopology)
 
 lemma open_map_inclusion:
      "openin X S \<Longrightarrow> open_map (subtopology X S) X id"
   by (simp add: open_map_inclusion_eq openin_Int)
 
 lemma open_map_compose:
      "\<lbrakk>open_map X X' f; open_map X' X'' g\<rbrakk> \<Longrightarrow> open_map X X'' (g \<circ> f)"
   by (metis (no_types, lifting) image_comp open_map_def)
 
 lemma closed_map_imp_subset_topspace:
      "closed_map X1 X2 f \<Longrightarrow> f ` (topspace X1) \<subseteq> topspace X2"
   by (simp add: closed_map_def closedin_subset)
 
 lemma closed_map_imp_subset:
      "\<lbrakk>closed_map X1 X2 f; S \<subseteq> topspace X1\<rbrakk> \<Longrightarrow> f ` S \<subseteq> topspace X2"
   using closed_map_imp_subset_topspace by blast
 
 lemma topology_finer_closed_id:
     "(\<forall>S. closedin X S \<longrightarrow> closedin X' S) \<longleftrightarrow> closed_map X X' id"
   by (simp add: closed_map_def)
 
 lemma closed_map_id: "closed_map X X id"
   by (simp add: closed_map_def)
 
 lemma closed_map_eq:
    "\<lbrakk>closed_map X X' f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> closed_map X X' g"
   unfolding closed_map_def
   by (metis image_cong closedin_subset subset_iff)
 
 lemma closed_map_compose:
     "\<lbrakk>closed_map X X' f; closed_map X' X'' g\<rbrakk> \<Longrightarrow> closed_map X X'' (g \<circ> f)"
   by (metis (no_types, lifting) closed_map_def image_comp)
 
 lemma closed_map_inclusion_eq:
    "closed_map (subtopology X S) X id \<longleftrightarrow>
         closedin X (topspace X \<inter> S)"
 proof -
   have *: "closedin X (T \<inter> S)" if "closedin X (S \<inter> topspace X)" "closedin X T" for T
     by (smt (verit, best) closedin_Int closure_of_subset_eq inf_sup_aci le_iff_inf that)
   then show ?thesis
     by (fastforce simp add: closed_map_def Int_commute closedin_subtopology_alt intro: *)
 qed
 
 lemma closed_map_inclusion: "closedin X S \<Longrightarrow> closed_map (subtopology X S) X id"
   by (simp add: closed_map_inclusion_eq closedin_Int)
 
 lemma open_map_into_subtopology:
     "\<lbrakk>open_map X X' f; f ` topspace X \<subseteq> S\<rbrakk> \<Longrightarrow> open_map X (subtopology X' S) f"
   unfolding open_map_def openin_subtopology
   using openin_subset by fastforce
 
 lemma closed_map_into_subtopology:
     "\<lbrakk>closed_map X X' f; f ` topspace X \<subseteq> S\<rbrakk> \<Longrightarrow> closed_map X (subtopology X' S) f"
   unfolding closed_map_def closedin_subtopology
   using closedin_subset by fastforce
 
 lemma open_map_into_discrete_topology:
     "open_map X (discrete_topology U) f \<longleftrightarrow> f ` (topspace X) \<subseteq> U"
   unfolding open_map_def openin_discrete_topology using openin_subset by blast
 
 lemma closed_map_into_discrete_topology:
     "closed_map X (discrete_topology U) f \<longleftrightarrow> f ` (topspace X) \<subseteq> U"
   unfolding closed_map_def closedin_discrete_topology using closedin_subset by blast
 
 lemma bijective_open_imp_closed_map:
      "\<lbrakk>open_map X X' f; f ` (topspace X) = topspace X'; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> closed_map X X' f"
   unfolding open_map_def closed_map_def closedin_def
   by auto (metis Diff_subset inj_on_image_set_diff)
 
 lemma bijective_closed_imp_open_map:
      "\<lbrakk>closed_map X X' f; f ` (topspace X) = topspace X'; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> open_map X X' f"
   unfolding closed_map_def open_map_def openin_closedin_eq
   by auto (metis Diff_subset inj_on_image_set_diff)
 
 lemma open_map_from_subtopology:
      "\<lbrakk>open_map X X' f; openin X U\<rbrakk> \<Longrightarrow> open_map (subtopology X U) X' f"
   unfolding open_map_def openin_subtopology_alt by blast
 
 lemma closed_map_from_subtopology:
      "\<lbrakk>closed_map X X' f; closedin X U\<rbrakk> \<Longrightarrow> closed_map (subtopology X U) X' f"
   unfolding closed_map_def closedin_subtopology_alt by blast
 
 lemma open_map_restriction:
   assumes f: "open_map X X' f" and U: "{x \<in> topspace X. f x \<in> V} = U"
   shows "open_map (subtopology X U) (subtopology X' V) f"
   unfolding open_map_def
 proof clarsimp
   fix W
   assume "openin (subtopology X U) W"
   then obtain T where "openin X T" "W = T \<inter> U"
     by (meson openin_subtopology)
   with f U have "f ` W = (f ` T) \<inter> V"
     unfolding open_map_def openin_closedin_eq by auto
   then show "openin (subtopology X' V) (f ` W)"
     by (metis \<open>openin X T\<close> f open_map_def openin_subtopology_Int)
 qed
 
 lemma closed_map_restriction:
   assumes f: "closed_map X X' f" and U: "{x \<in> topspace X. f x \<in> V} = U"
   shows "closed_map (subtopology X U) (subtopology X' V) f"
   unfolding closed_map_def
 proof clarsimp
   fix W
   assume "closedin (subtopology X U) W"
   then obtain T where "closedin X T" "W = T \<inter> U"
     by (meson closedin_subtopology)
   with f U have "f ` W = (f ` T) \<inter> V"
     unfolding closed_map_def closedin_def by auto
   then show "closedin (subtopology X' V) (f ` W)"
     by (metis \<open>closedin X T\<close> closed_map_def closedin_subtopology f)
 qed
 
 lemma closed_map_closure_of_image:
    "closed_map X Y f \<longleftrightarrow>
         f ` topspace X \<subseteq> topspace Y \<and>
         (\<forall>S. S \<subseteq> topspace X \<longrightarrow> Y closure_of (f ` S) \<subseteq> image f (X closure_of S))" (is "?lhs=?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (simp add: closed_map_def closed_map_imp_subset_topspace closure_of_minimal closure_of_subset image_mono)
 next
   assume ?rhs
   then show ?lhs
     by (metis closed_map_def closed_map_into_discrete_topology closure_of_eq 
         closure_of_subset_eq topspace_discrete_topology)
 qed
 
 lemma open_map_interior_of_image_subset:
   "open_map X Y f \<longleftrightarrow> (\<forall>S. image f (X interior_of S) \<subseteq> Y interior_of (f ` S))"
   by (metis image_mono interior_of_eq interior_of_maximal interior_of_subset open_map_def openin_interior_of subset_antisym)
 
 lemma open_map_interior_of_image_subset_alt:
   "open_map X Y f \<longleftrightarrow> (\<forall>S\<subseteq>topspace X. f ` (X interior_of S) \<subseteq> Y interior_of f ` S)"
   by (metis interior_of_eq open_map_def open_map_interior_of_image_subset openin_subset subset_interior_of_eq)
 
 lemma open_map_interior_of_image_subset_gen:
   "open_map X Y f \<longleftrightarrow>
        (f ` topspace X \<subseteq> topspace Y \<and> (\<forall>S. f ` (X interior_of S) \<subseteq> Y interior_of f ` S))"
   by (meson open_map_imp_subset_topspace open_map_interior_of_image_subset)
 
 lemma open_map_preimage_neighbourhood:
    "open_map X Y f \<longleftrightarrow>
     (f ` topspace X \<subseteq> topspace Y \<and>
      (\<forall>U T. closedin X U \<and> T \<subseteq> topspace Y \<and>
             {x \<in> topspace X. f x \<in> T} \<subseteq> U \<longrightarrow>
             (\<exists>V. closedin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U)))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (intro conjI strip)
     show "f ` topspace X \<subseteq> topspace Y"
       by (simp add: \<open>open_map X Y f\<close> open_map_imp_subset_topspace)
   next
     fix U T
     assume UT: "closedin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U"
     have "closedin Y (topspace Y - f ` (topspace X - U))"
       by (meson UT L open_map_def openin_closedin_eq openin_diff openin_topspace)
     with UT
     show "\<exists>V. closedin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
       using image_iff by auto
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding open_map_def
   proof (intro strip)
     fix U assume "openin X U"
     have "{x \<in> topspace X. f x \<in> topspace Y - f ` U} \<subseteq> topspace X - U"
       by blast
     then obtain V where V: "closedin Y V" 
       and sub: "topspace Y - f ` U \<subseteq> V" "{x \<in> topspace X. f x \<in> V} \<subseteq> topspace X - U"
       using R \<open>openin X U\<close> by (meson Diff_subset openin_closedin_eq) 
     then have "f ` U \<subseteq> topspace Y - V"
       using R \<open>openin X U\<close> openin_subset by fastforce
     with sub have "f ` U = topspace Y - V"
       by auto
     then show "openin Y (f ` U)"
       using V(1) by auto
   qed
 qed
 
 
 lemma closed_map_preimage_neighbourhood:
    "closed_map X Y f \<longleftrightarrow>
         image f (topspace X) \<subseteq> topspace Y \<and>
         (\<forall>U T. openin X U \<and> T \<subseteq> topspace Y \<and>
               {x \<in> topspace X. f x \<in> T} \<subseteq> U
               \<longrightarrow> (\<exists>V. openin Y V \<and> T \<subseteq> V \<and>
                       {x \<in> topspace X. f x \<in> V} \<subseteq> U))" (is "?lhs=?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (intro conjI strip)
     show "f ` topspace X \<subseteq> topspace Y"
       by (simp add: L closed_map_imp_subset_topspace)
   next
     fix U T
     assume UT: "openin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U"
     then have "openin Y (topspace Y - f ` (topspace X - U))"
       by (meson L closed_map_def closedin_def closedin_diff closedin_topspace)
     then show "\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
       using UT image_iff by auto
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding closed_map_def
   proof (intro strip)
     fix U assume "closedin X U"
     have "{x \<in> topspace X. f x \<in> topspace Y - f ` U} \<subseteq> topspace X - U"
       by blast
     then obtain V where V: "openin Y V" 
       and sub: "topspace Y - f ` U \<subseteq> V" "{x \<in> topspace X. f x \<in> V} \<subseteq> topspace X - U"
       using R Diff_subset \<open>closedin X U\<close> unfolding closedin_def
       by (smt (verit, ccfv_threshold) Collect_mem_eq Collect_mono_iff)
     then have "f ` U \<subseteq> topspace Y - V"
       using R \<open>closedin X U\<close> closedin_subset by fastforce
     with sub have "f ` U = topspace Y - V"
       by auto
     with V show "closedin Y (f ` U)"
       by auto
   qed
 qed
 
 lemma closed_map_fibre_neighbourhood:
   "closed_map X Y f \<longleftrightarrow>
      f ` (topspace X) \<subseteq> topspace Y \<and>
      (\<forall>U y. openin X U \<and> y \<in> topspace Y \<and> {x \<in> topspace X. f x = y} \<subseteq> U
      \<longrightarrow> (\<exists>V. openin Y V \<and> y \<in> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))"
   unfolding closed_map_preimage_neighbourhood
 proof (intro conj_cong refl all_cong1)
   fix U
   assume "f ` topspace X \<subseteq> topspace Y"
   show "(\<forall>T. openin X U \<and> T \<subseteq> topspace Y \<and> {x \<in> topspace X. f x \<in> T} \<subseteq> U 
          \<longrightarrow> (\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))
       = (\<forall>y. openin X U \<and> y \<in> topspace Y \<and> {x \<in> topspace X. f x = y} \<subseteq> U 
          \<longrightarrow> (\<exists>V. openin Y V \<and> y \<in> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U))" 
     (is "(\<forall>T. ?P T) \<longleftrightarrow> (\<forall>y. ?Q y)")
   proof
     assume L [rule_format]: "\<forall>T. ?P T"
     show "\<forall>y. ?Q y"
     proof
       fix y show "?Q y"
         using L [of "{y}"] by blast
     qed
   next
     assume R: "\<forall>y. ?Q y"
     show "\<forall>T. ?P T"
     proof (cases "openin X U")
       case True
       note [[unify_search_bound=3]]
       obtain V where V: "\<And>y. \<lbrakk>y \<in> topspace Y; {x \<in> topspace X. f x = y} \<subseteq> U\<rbrakk> \<Longrightarrow>
                        openin Y (V y) \<and> y \<in> V y \<and> {x \<in> topspace X. f x \<in> V y} \<subseteq> U"
         using R by (simp add: True) meson
       show ?thesis
       proof clarify
         fix T
         assume "openin X U" and "T \<subseteq> topspace Y" and "{x \<in> topspace X. f x \<in> T} \<subseteq> U"
         with V show "\<exists>V. openin Y V \<and> T \<subseteq> V \<and> {x \<in> topspace X. f x \<in> V} \<subseteq> U"
           by (rule_tac x="\<Union>y\<in>T. V y" in exI) fastforce
       qed
     qed auto
   qed
 qed
 
 lemma open_map_in_subtopology:
    "openin Y S
         \<Longrightarrow> (open_map X (subtopology Y S) f \<longleftrightarrow> open_map X Y f \<and> f ` (topspace X) \<subseteq> S)"
   by (metis le_inf_iff open_map_def open_map_imp_subset_topspace open_map_into_subtopology openin_trans_full topspace_subtopology)
 
 lemma open_map_from_open_subtopology:
    "\<lbrakk>openin Y S; open_map X (subtopology Y S) f\<rbrakk> \<Longrightarrow> open_map X Y f"
   using open_map_in_subtopology by blast
 
 lemma closed_map_in_subtopology:
    "closedin Y S
         \<Longrightarrow> closed_map X (subtopology Y S) f \<longleftrightarrow> (closed_map X Y f \<and> f ` topspace X \<subseteq> S)"
   by (metis closed_map_def closed_map_imp_subset_topspace closed_map_into_subtopology 
         closedin_closed_subtopology closedin_subset topspace_subtopology_subset)
 
 lemma closed_map_from_closed_subtopology:
    "\<lbrakk>closedin Y S; closed_map X (subtopology Y S) f\<rbrakk> \<Longrightarrow> closed_map X Y f"
   using closed_map_in_subtopology by blast
 
 lemma closed_map_from_composition_left:
   assumes cmf: "closed_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
   shows "closed_map Y Z g"
   unfolding closed_map_def
 proof (intro strip)
   fix U assume "closedin Y U"
   then have "closedin X {x \<in> topspace X. f x \<in> U}"
     using contf closedin_continuous_map_preimage by blast
   then have "closedin Z ((g \<circ> f) ` {x \<in> topspace X. f x \<in> U})"
     using cmf closed_map_def by blast
   moreover 
   have "\<And>y. y \<in> U \<Longrightarrow> \<exists>x \<in> topspace X. f x \<in> U \<and> g y = g (f x)"
     by (smt (verit, ccfv_SIG) \<open>closedin Y U\<close> closedin_subset fim image_iff subsetD)
   then have "(g \<circ> f) ` {x \<in> topspace X. f x \<in> U} = g`U" by auto
   ultimately show "closedin Z (g ` U)"
     by metis
 qed
 
 text \<open>identical proof as the above\<close>
 lemma open_map_from_composition_left:
   assumes cmf: "open_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
   shows "open_map Y Z g"
   unfolding open_map_def
 proof (intro strip)
   fix U assume "openin Y U"
   then have "openin X {x \<in> topspace X. f x \<in> U}"
     using contf openin_continuous_map_preimage by blast
   then have "openin Z ((g \<circ> f) ` {x \<in> topspace X. f x \<in> U})"
     using cmf open_map_def by blast
   moreover 
   have "\<And>y. y \<in> U \<Longrightarrow> \<exists>x \<in> topspace X. f x \<in> U \<and> g y = g (f x)"
     by (smt (verit, ccfv_SIG) \<open>openin Y U\<close> openin_subset fim image_iff subsetD)
   then have "(g \<circ> f) ` {x \<in> topspace X. f x \<in> U} = g`U" by auto
   ultimately show "openin Z (g ` U)"
     by metis
 qed
 
 lemma closed_map_from_composition_right:
   assumes cmf: "closed_map X Z (g \<circ> f)" "f ` topspace X \<subseteq> topspace Y" "continuous_map Y Z g" "inj_on g (topspace Y)"
   shows "closed_map X Y f"
   unfolding closed_map_def
 proof (intro strip)
   fix C assume "closedin X C"
   have "\<And>y c. \<lbrakk>y \<in> topspace Y; g y = g (f c); c \<in> C\<rbrakk> \<Longrightarrow> y \<in> f ` C"
     using \<open>closedin X C\<close> assms closedin_subset inj_onD by fastforce
   then
   have "f ` C = {x \<in> topspace Y. g x \<in> (g \<circ> f) ` C}"
     using \<open>closedin X C\<close> assms(2) closedin_subset by fastforce
   moreover have "closedin Z ((g \<circ> f) ` C)"
     using \<open>closedin X C\<close> cmf closed_map_def by blast
   ultimately show "closedin Y (f ` C)"
     using assms(3) closedin_continuous_map_preimage by fastforce
 qed
 
 text \<open>identical proof as the above\<close>
 lemma open_map_from_composition_right:
   assumes "open_map X Z (g \<circ> f)" "f ` topspace X \<subseteq> topspace Y" "continuous_map Y Z g" "inj_on g (topspace Y)"
   shows "open_map X Y f"
   unfolding open_map_def
 proof (intro strip)
   fix C assume "openin X C"
   have "\<And>y c. \<lbrakk>y \<in> topspace Y; g y = g (f c); c \<in> C\<rbrakk> \<Longrightarrow> y \<in> f ` C"
     using \<open>openin X C\<close> assms openin_subset inj_onD by fastforce
   then
   have "f ` C = {x \<in> topspace Y. g x \<in> (g \<circ> f) ` C}"
     using \<open>openin X C\<close> assms(2) openin_subset by fastforce
   moreover have "openin Z ((g \<circ> f) ` C)"
     using \<open>openin X C\<close> assms(1) open_map_def by blast
   ultimately show "openin Y (f ` C)"
     using assms(3) openin_continuous_map_preimage by fastforce
 qed
 
 subsection\<open>Quotient maps\<close>
                                       
 definition quotient_map where
  "quotient_map X X' f \<longleftrightarrow>
         f ` (topspace X) = topspace X' \<and>
         (\<forall>U. U \<subseteq> topspace X' \<longrightarrow> (openin X {x. x \<in> topspace X \<and> f x \<in> U} \<longleftrightarrow> openin X' U))"
 
 lemma quotient_map_eq:
   assumes "quotient_map X X' f" "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x"
   shows "quotient_map X X' g"
   by (smt (verit) Collect_cong assms image_cong quotient_map_def)
 
 lemma quotient_map_compose:
   assumes f: "quotient_map X X' f" and g: "quotient_map X' X'' g"
   shows "quotient_map X X'' (g \<circ> f)"
   unfolding quotient_map_def
 proof (intro conjI allI impI)
   show "(g \<circ> f) ` topspace X = topspace X''"
     using assms by (simp only: image_comp [symmetric]) (simp add: quotient_map_def)
 next
   fix U''
   assume U'': "U'' \<subseteq> topspace X''"
   define U' where "U' \<equiv> {y \<in> topspace X'. g y \<in> U''}"
   have "U' \<subseteq> topspace X'"
     by (auto simp add: U'_def)
   then have U': "openin X {x \<in> topspace X. f x \<in> U'} = openin X' U'"
     using assms unfolding quotient_map_def by simp
   have "{x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U''} = {x \<in> topspace X. (g \<circ> f) x \<in> U''}"
     using f quotient_map_def by fastforce
   then show "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U''} = openin X'' U''"
     by (smt (verit, best) Collect_cong U' U'_def U'' g mem_Collect_eq quotient_map_def)
 qed
 
 lemma quotient_map_from_composition:
   assumes f: "continuous_map X X' f" and g: "continuous_map X' X'' g" and gf: "quotient_map X X'' (g \<circ> f)"
   shows  "quotient_map X' X'' g"
   unfolding quotient_map_def
 proof (intro conjI allI impI)
   show "g ` topspace X' = topspace X''"
     using assms unfolding continuous_map_def quotient_map_def by fastforce
 next
   fix U'' :: "'c set"
   assume U'': "U'' \<subseteq> topspace X''"
   have eq: "{x \<in> topspace X. g (f x) \<in> U''} = {x \<in> topspace X. f x \<in> {y. y \<in> topspace X' \<and> g y \<in> U''}}"
     using continuous_map_def f by fastforce
   show "openin X' {x \<in> topspace X'. g x \<in> U''} = openin X'' U''"
     using assms unfolding continuous_map_def quotient_map_def
     by (metis (mono_tags, lifting) Collect_cong U'' comp_apply eq)
 qed
 
 lemma quotient_imp_continuous_map:
     "quotient_map X X' f \<Longrightarrow> continuous_map X X' f"
   by (simp add: continuous_map openin_subset quotient_map_def)
 
 lemma quotient_imp_surjective_map:
     "quotient_map X X' f \<Longrightarrow> f ` (topspace X) = topspace X'"
   by (simp add: quotient_map_def)
 
 lemma quotient_map_closedin:
   "quotient_map X X' f \<longleftrightarrow>
         f ` (topspace X) = topspace X' \<and>
         (\<forall>U. U \<subseteq> topspace X' \<longrightarrow> (closedin X {x. x \<in> topspace X \<and> f x \<in> U} \<longleftrightarrow> closedin X' U))"
 proof -
   have eq: "(topspace X - {x \<in> topspace X. f x \<in> U'}) = {x \<in> topspace X. f x \<in> topspace X' \<and> f x \<notin> U'}"
     if "f ` topspace X = topspace X'" "U' \<subseteq> topspace X'" for U'
       using that by auto
   have "(\<forall>U\<subseteq>topspace X'. openin X {x \<in> topspace X. f x \<in> U} = openin X' U) =
           (\<forall>U\<subseteq>topspace X'. closedin X {x \<in> topspace X. f x \<in> U} = closedin X' U)"
     if "f ` topspace X = topspace X'"
   proof (rule iffI; intro allI impI subsetI)
     fix U'
     assume *[rule_format]: "\<forall>U\<subseteq>topspace X'. openin X {x \<in> topspace X. f x \<in> U} = openin X' U"
       and U': "U' \<subseteq> topspace X'"
     show "closedin X {x \<in> topspace X. f x \<in> U'} = closedin X' U'"
       using U'  by (auto simp add: closedin_def simp flip: * [of "topspace X' - U'"] eq [OF that])
   next
     fix U' :: "'b set"
     assume *[rule_format]: "\<forall>U\<subseteq>topspace X'. closedin X {x \<in> topspace X. f x \<in> U} = closedin X' U"
       and U': "U' \<subseteq> topspace X'"
     show "openin X {x \<in> topspace X. f x \<in> U'} = openin X' U'"
       using U'  by (auto simp add: openin_closedin_eq simp flip: * [of "topspace X' - U'"] eq [OF that])
   qed
   then show ?thesis
     unfolding quotient_map_def by force
 qed
 
 lemma continuous_open_imp_quotient_map:
   assumes "continuous_map X X' f" and om: "open_map X X' f" and feq: "f ` (topspace X) = topspace X'"
   shows "quotient_map X X' f"
 proof -
   { fix U
     assume U: "U \<subseteq> topspace X'" and "openin X {x \<in> topspace X. f x \<in> U}"
     then have ope: "openin X' (f ` {x \<in> topspace X. f x \<in> U})"
       using om unfolding open_map_def by blast
     then have "openin X' U"
       using U feq by (subst openin_subopen) force
   }
   moreover have "openin X {x \<in> topspace X. f x \<in> U}" if "U \<subseteq> topspace X'" and "openin X' U" for U
     using that assms unfolding continuous_map_def by blast
   ultimately show ?thesis
     unfolding quotient_map_def using assms by blast
 qed
 
 lemma continuous_closed_imp_quotient_map:
   assumes "continuous_map X X' f" and om: "closed_map X X' f" and feq: "f ` (topspace X) = topspace X'"
   shows "quotient_map X X' f"
 proof -
   have "f ` {x \<in> topspace X. f x \<in> U} = U" if "U \<subseteq> topspace X'" for U
     using that feq by auto
   with assms show ?thesis
     unfolding quotient_map_closedin closed_map_def continuous_map_closedin by auto
 qed
 
 lemma continuous_open_quotient_map:
    "\<lbrakk>continuous_map X X' f; open_map X X' f\<rbrakk> \<Longrightarrow> quotient_map X X' f \<longleftrightarrow> f ` (topspace X) = topspace X'"
   by (meson continuous_open_imp_quotient_map quotient_map_def)
 
 lemma continuous_closed_quotient_map:
      "\<lbrakk>continuous_map X X' f; closed_map X X' f\<rbrakk> \<Longrightarrow> quotient_map X X' f \<longleftrightarrow> f ` (topspace X) = topspace X'"
   by (meson continuous_closed_imp_quotient_map quotient_map_def)
 
 lemma injective_quotient_map:
   assumes "inj_on f (topspace X)"
   shows "quotient_map X X' f \<longleftrightarrow>
          continuous_map X X' f \<and> open_map X X' f \<and> closed_map X X' f \<and> f ` (topspace X) = topspace X'"
          (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   have om: "open_map X X' f"
   proof (clarsimp simp add: open_map_def)
     fix U
     assume "openin X U"
     then have "U \<subseteq> topspace X"
       by (simp add: openin_subset)
     moreover have "{x \<in> topspace X. f x \<in> f ` U} = U"
       using \<open>U \<subseteq> topspace X\<close> assms inj_onD by fastforce
     ultimately show "openin X' (f ` U)"
       using L unfolding quotient_map_def
       by (metis (no_types, lifting) Collect_cong \<open>openin X U\<close> image_mono)
   qed
   then have "closed_map X X' f"
     by (simp add: L assms bijective_open_imp_closed_map quotient_imp_surjective_map)
   then show ?rhs
     using L om by (simp add: quotient_imp_continuous_map quotient_imp_surjective_map)
 next
   assume ?rhs
   then show ?lhs
     by (simp add: continuous_closed_imp_quotient_map)
 qed
 
 lemma continuous_compose_quotient_map:
   assumes f: "quotient_map X X' f" and g: "continuous_map X X'' (g \<circ> f)"
   shows "continuous_map X' X'' g"
   unfolding quotient_map_def continuous_map_def
 proof (intro conjI ballI allI impI)
   show "\<And>x'. x' \<in> topspace X' \<Longrightarrow> g x' \<in> topspace X''"
     using assms unfolding quotient_map_def
     by (metis (no_types, opaque_lifting) continuous_map_image_subset_topspace image_comp image_subset_iff)
 next
   fix U'' :: "'c set"
   assume U'': "openin X'' U''"
   have "f ` topspace X = topspace X'"
     by (simp add: f quotient_imp_surjective_map)
   then have eq: "{x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U} = {x \<in> topspace X. g (f x) \<in> U}" for U
     by auto
   have "openin X {x \<in> topspace X. f x \<in> topspace X' \<and> g (f x) \<in> U''}"
     unfolding eq using U'' g openin_continuous_map_preimage by fastforce
   then have *: "openin X {x \<in> topspace X. f x \<in> {x \<in> topspace X'. g x \<in> U''}}"
     by auto
   show "openin X' {x \<in> topspace X'. g x \<in> U''}"
     using f unfolding quotient_map_def
     by (metis (no_types) Collect_subset *)
 qed
 
 lemma continuous_compose_quotient_map_eq:
    "quotient_map X X' f \<Longrightarrow> continuous_map X X'' (g \<circ> f) \<longleftrightarrow> continuous_map X' X'' g"
   using continuous_compose_quotient_map continuous_map_compose quotient_imp_continuous_map by blast
 
 lemma quotient_map_compose_eq:
    "quotient_map X X' f \<Longrightarrow> quotient_map X X'' (g \<circ> f) \<longleftrightarrow> quotient_map X' X'' g"
   by (meson continuous_compose_quotient_map_eq quotient_imp_continuous_map quotient_map_compose quotient_map_from_composition)
 
 lemma quotient_map_restriction:
   assumes quo: "quotient_map X Y f" and U: "{x \<in> topspace X. f x \<in> V} = U" and disj: "openin Y V \<or> closedin Y V"
  shows "quotient_map (subtopology X U) (subtopology Y V) f"
   using disj
 proof
   assume V: "openin Y V"
   with U have sub: "U \<subseteq> topspace X" "V \<subseteq> topspace Y"
     by (auto simp: openin_subset)
   have fim: "f ` topspace X = topspace Y"
      and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
     using quo unfolding quotient_map_def by auto
   have "openin X U"
     using U V Y sub(2) by blast
   show ?thesis
     unfolding quotient_map_def
   proof (intro conjI allI impI)
     show "f ` topspace (subtopology X U) = topspace (subtopology Y V)"
       using sub U fim by (auto)
   next
     fix Y' :: "'b set"
     assume "Y' \<subseteq> topspace (subtopology Y V)"
     then have "Y' \<subseteq> topspace Y" "Y' \<subseteq> V"
       by (simp_all)
     then have eq: "{x \<in> topspace X. x \<in> U \<and> f x \<in> Y'} = {x \<in> topspace X. f x \<in> Y'}"
       using U by blast
     then show "openin (subtopology X U) {x \<in> topspace (subtopology X U). f x \<in> Y'} = openin (subtopology Y V) Y'"
       using U V Y \<open>openin X U\<close>  \<open>Y' \<subseteq> topspace Y\<close> \<open>Y' \<subseteq> V\<close>
       by (simp add: openin_open_subtopology eq) (auto simp: openin_closedin_eq)
   qed
 next
   assume V: "closedin Y V"
   with U have sub: "U \<subseteq> topspace X" "V \<subseteq> topspace Y"
     by (auto simp: closedin_subset)
   have fim: "f ` topspace X = topspace Y"
      and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> U} = closedin Y U"
     using quo unfolding quotient_map_closedin by auto
   have "closedin X U"
     using U V Y sub(2) by blast
   show ?thesis
     unfolding quotient_map_closedin
   proof (intro conjI allI impI)
     show "f ` topspace (subtopology X U) = topspace (subtopology Y V)"
       using sub U fim by (auto)
   next
     fix Y' :: "'b set"
     assume "Y' \<subseteq> topspace (subtopology Y V)"
     then have "Y' \<subseteq> topspace Y" "Y' \<subseteq> V"
       by (simp_all)
     then have eq: "{x \<in> topspace X. x \<in> U \<and> f x \<in> Y'} = {x \<in> topspace X. f x \<in> Y'}"
       using U by blast
     then show "closedin (subtopology X U) {x \<in> topspace (subtopology X U). f x \<in> Y'} = closedin (subtopology Y V) Y'"
       using U V Y \<open>closedin X U\<close>  \<open>Y' \<subseteq> topspace Y\<close> \<open>Y' \<subseteq> V\<close>
       by (simp add: closedin_closed_subtopology eq) (auto simp: closedin_def)
   qed
 qed
 
 lemma quotient_map_saturated_open:
      "quotient_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> f ` (topspace X) = topspace Y \<and>
         (\<forall>U. openin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U \<longrightarrow> openin Y (f ` U))"
      (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have fim: "f ` topspace X = topspace Y"
     and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin Y U = openin X {x \<in> topspace X. f x \<in> U}"
     unfolding quotient_map_def by auto
   show ?rhs
   proof (intro conjI allI impI)
     show "continuous_map X Y f"
       by (simp add: L quotient_imp_continuous_map)
     show "f ` topspace X = topspace Y"
       by (simp add: fim)
   next
     fix U :: "'a set"
     assume U: "openin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U"
     then have sub:  "f ` U \<subseteq> topspace Y" and eq: "{x \<in> topspace X. f x \<in> f ` U} = U"
       using fim openin_subset by fastforce+
     show "openin Y (f ` U)"
       by (simp add: sub Y eq U)
   qed
 next
   assume ?rhs
   then have YX: "\<And>U. openin Y U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
        and fim: "f ` topspace X = topspace Y"
        and XY: "\<And>U. \<lbrakk>openin X U; {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U\<rbrakk> \<Longrightarrow> openin Y (f ` U)"
     by (auto simp: quotient_map_def continuous_map_def)
   show ?lhs
   proof (simp add: quotient_map_def fim, intro allI impI iffI)
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and X: "openin X {x \<in> topspace X. f x \<in> U}"
     have feq: "f ` {x \<in> topspace X. f x \<in> U} = U"
       using \<open>U \<subseteq> topspace Y\<close> fim by auto
     show "openin Y U"
       using XY [OF X] by (simp add: feq)
   next
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and Y: "openin Y U"
     show "openin X {x \<in> topspace X. f x \<in> U}"
       by (metis YX [OF Y])
   qed
 qed
 
 lemma quotient_map_saturated_closed:
      "quotient_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> f ` (topspace X) = topspace Y \<and>
         (\<forall>U. closedin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U \<longrightarrow> closedin Y (f ` U))"
      (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then obtain fim: "f ` topspace X = topspace Y"
     and Y: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> closedin Y U = closedin X {x \<in> topspace X. f x \<in> U}"
     by (simp add: quotient_map_closedin)
   show ?rhs
   proof (intro conjI allI impI)
     show "continuous_map X Y f"
       by (simp add: L quotient_imp_continuous_map)
     show "f ` topspace X = topspace Y"
       by (simp add: fim)
   next
     fix U :: "'a set"
     assume U: "closedin X U \<and> {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U"
     then have sub:  "f ` U \<subseteq> topspace Y" and eq: "{x \<in> topspace X. f x \<in> f ` U} = U"
       using fim closedin_subset by fastforce+
     show "closedin Y (f ` U)"
       by (simp add: sub Y eq U)
   qed
 next
   assume ?rhs
   then obtain YX: "\<And>U. closedin Y U \<Longrightarrow> closedin X {x \<in> topspace X. f x \<in> U}"
     and fim: "f ` topspace X = topspace Y"
     and XY: "\<And>U. \<lbrakk>closedin X U; {x \<in> topspace X. f x \<in> f ` U} \<subseteq> U\<rbrakk> \<Longrightarrow> closedin Y (f ` U)"
     by (simp add: continuous_map_closedin)
   show ?lhs
   proof (simp add: quotient_map_closedin fim, intro allI impI iffI)
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and X: "closedin X {x \<in> topspace X. f x \<in> U}"
     have feq: "f ` {x \<in> topspace X. f x \<in> U} = U"
       using \<open>U \<subseteq> topspace Y\<close> fim by auto
     show "closedin Y U"
       using XY [OF X] by (simp add: feq)
   next
     fix U :: "'b set"
     assume "U \<subseteq> topspace Y" and Y: "closedin Y U"
     show "closedin X {x \<in> topspace X. f x \<in> U}"
       by (metis YX [OF Y])
   qed
 qed
 
 lemma quotient_map_onto_image:
   assumes "f ` topspace X \<subseteq> topspace Y" and U: "\<And>U. U \<subseteq> topspace Y \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
   shows "quotient_map X (subtopology Y (f ` topspace X)) f"
   unfolding quotient_map_def topspace_subtopology
 proof (intro conjI strip)
   fix U
   assume "U \<subseteq> topspace Y \<inter> f ` topspace X"
   with U have "openin X {x \<in> topspace X. f x \<in> U} \<Longrightarrow> \<exists>x. openin Y x \<and> U = f ` topspace X \<inter> x"
     by fastforce
   moreover have "\<exists>x. openin Y x \<and> U = f ` topspace X \<inter> x \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
     by (metis (mono_tags, lifting) Collect_cong IntE IntI U image_eqI openin_subset)
   ultimately show "openin X {x \<in> topspace X. f x \<in> U} = openin (subtopology Y (f ` topspace X)) U"
     by (force simp: openin_subtopology_alt image_iff)
 qed (use assms in auto)
 
 lemma quotient_map_lift_exists:
   assumes f: "quotient_map X Y f" and h: "continuous_map X Z h" 
     and "\<And>x y. \<lbrakk>x \<in> topspace X; y \<in> topspace X; f x = f y\<rbrakk> \<Longrightarrow> h x = h y"
   obtains g where "continuous_map Y Z g" "g ` topspace Y = h ` topspace X"
                   "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = h x"
 proof -
   obtain g where g: "\<And>x. x \<in> topspace X \<Longrightarrow> h x = g(f x)"
     using function_factors_left_gen[of "\<lambda>x. x \<in> topspace X" f h] assms by blast
   show ?thesis
   proof
     show "g ` topspace Y = h ` topspace X"
       using f g by (force dest!: quotient_imp_surjective_map)
     show "continuous_map Y Z g"
       by (smt (verit)  f g h continuous_compose_quotient_map_eq continuous_map_eq o_def)
   qed (simp add: g)
 qed
 
 subsection\<open> Separated Sets\<close>
 
 definition separatedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> bool"
   where "separatedin X S T \<equiv>
            S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and>
            S \<inter> X closure_of T = {} \<and> T \<inter> X closure_of S = {}"
 
 lemma separatedin_empty [simp]:
      "separatedin X S {} \<longleftrightarrow> S \<subseteq> topspace X"
      "separatedin X {} S \<longleftrightarrow> S \<subseteq> topspace X"
   by (simp_all add: separatedin_def)
 
 lemma separatedin_refl [simp]:
      "separatedin X S S \<longleftrightarrow> S = {}"
   by (metis closure_of_subset empty_subsetI inf.orderE separatedin_def)
 
 lemma separatedin_sym:
      "separatedin X S T \<longleftrightarrow> separatedin X T S"
   by (auto simp: separatedin_def)
 
 lemma separatedin_imp_disjoint:
      "separatedin X S T \<Longrightarrow> disjnt S T"
   by (meson closure_of_subset disjnt_def disjnt_subset2 separatedin_def)
 
 lemma separatedin_mono:
    "\<lbrakk>separatedin X S T; S' \<subseteq> S; T' \<subseteq> T\<rbrakk> \<Longrightarrow> separatedin X S' T'"
   unfolding separatedin_def
   using closure_of_mono by blast
 
 lemma separatedin_open_sets:
      "\<lbrakk>openin X S; openin X T\<rbrakk> \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T"
   unfolding disjnt_def separatedin_def
   by (auto simp: openin_Int_closure_of_eq_empty openin_subset)
 
 lemma separatedin_closed_sets:
      "\<lbrakk>closedin X S; closedin X T\<rbrakk> \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T"
   unfolding closure_of_eq disjnt_def separatedin_def
   by (metis closedin_def closure_of_eq inf_commute)
 
 lemma separatedin_subtopology:
      "separatedin (subtopology X U) S T \<longleftrightarrow> S \<subseteq> U \<and> T \<subseteq> U \<and> separatedin X S T"
   by (auto simp: separatedin_def closure_of_subtopology Int_ac disjoint_iff elim!: inf.orderE)
 
 lemma separatedin_discrete_topology:
      "separatedin (discrete_topology U) S T \<longleftrightarrow> S \<subseteq> U \<and> T \<subseteq> U \<and> disjnt S T"
   by (metis openin_discrete_topology separatedin_def separatedin_open_sets topspace_discrete_topology)
 
 lemma separated_eq_distinguishable:
    "separatedin X {x} {y} \<longleftrightarrow>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         (\<exists>U. openin X U \<and> x \<in> U \<and> (y \<notin> U)) \<and>
         (\<exists>v. openin X v \<and> y \<in> v \<and> (x \<notin> v))"
   by (force simp: separatedin_def closure_of_def)
 
 lemma separatedin_Un [simp]:
    "separatedin X S (T \<union> U) \<longleftrightarrow> separatedin X S T \<and> separatedin X S U"
    "separatedin X (S \<union> T) U \<longleftrightarrow> separatedin X S U \<and> separatedin X T U"
   by (auto simp: separatedin_def)
 
 lemma separatedin_Union:
   "finite \<F> \<Longrightarrow> separatedin X S (\<Union>\<F>) \<longleftrightarrow> S \<subseteq> topspace X \<and> (\<forall>T \<in> \<F>. separatedin X S T)"
   "finite \<F> \<Longrightarrow> separatedin X (\<Union>\<F>) S \<longleftrightarrow> (\<forall>T \<in> \<F>. separatedin X S T) \<and> S \<subseteq> topspace X"
   by (auto simp: separatedin_def closure_of_Union)
 
 lemma separatedin_openin_diff:
    "\<lbrakk>openin X S; openin X T\<rbrakk> \<Longrightarrow> separatedin X (S - T) (T - S)"
   unfolding separatedin_def
   by (metis Diff_Int_distrib2 Diff_disjoint Diff_empty Diff_mono empty_Diff empty_subsetI openin_Int_closure_of_eq_empty openin_subset)
 
 lemma separatedin_closedin_diff:
   assumes "closedin X S" "closedin X T"
   shows "separatedin X (S - T) (T - S)"
 proof -
   have "S - T \<subseteq> topspace X" "T - S \<subseteq> topspace X"
     using assms closedin_subset by auto
   with assms show ?thesis
     by (simp add: separatedin_def Diff_Int_distrib2 closure_of_minimal inf_absorb2)
 qed
 
 lemma separation_closedin_Un_gen:
      "separatedin X S T \<longleftrightarrow>
         S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and> disjnt S T \<and>
         closedin (subtopology X (S \<union> T)) S \<and>
         closedin (subtopology X (S \<union> T)) T"
   by (auto simp add: separatedin_def closedin_Int_closure_of disjnt_iff dest: closure_of_subset)
 
 lemma separation_openin_Un_gen:
      "separatedin X S T \<longleftrightarrow>
         S \<subseteq> topspace X \<and> T \<subseteq> topspace X \<and> disjnt S T \<and>
         openin (subtopology X (S \<union> T)) S \<and>
         openin (subtopology X (S \<union> T)) T"
   unfolding openin_closedin_eq topspace_subtopology separation_closedin_Un_gen disjnt_def
   by (auto simp: Diff_triv Int_commute Un_Diff inf_absorb1 topspace_def)
 
 lemma separatedin_full:
    "S \<union> T = topspace X
    \<Longrightarrow> separatedin X S T \<longleftrightarrow> disjnt S T \<and> closedin X S \<and> openin X S \<and> closedin X T \<and> openin X T"
   by (metis separatedin_open_sets separation_closedin_Un_gen separation_openin_Un_gen subtopology_topspace)
 
 
 subsection\<open>Homeomorphisms\<close>
 text\<open>(1-way and 2-way versions may be useful in places)\<close>
 
 definition homeomorphic_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where
  "homeomorphic_map X Y f \<equiv> quotient_map X Y f \<and> inj_on f (topspace X)"
 
 definition homeomorphic_maps :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> bool"
   where
  "homeomorphic_maps X Y f g \<equiv>
     continuous_map X Y f \<and> continuous_map Y X g \<and>
      (\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
 
 
 lemma homeomorphic_map_eq:
    "\<lbrakk>homeomorphic_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> homeomorphic_map X Y g"
   by (meson homeomorphic_map_def inj_on_cong quotient_map_eq)
 
 lemma homeomorphic_maps_eq:
      "\<lbrakk>homeomorphic_maps X Y f g;
        \<And>x. x \<in> topspace X \<Longrightarrow> f x = f' x; \<And>y. y \<in> topspace Y \<Longrightarrow> g y = g' y\<rbrakk>
       \<Longrightarrow> homeomorphic_maps X Y f' g'"
   unfolding homeomorphic_maps_def
   by (metis continuous_map_eq continuous_map_eq_image_closure_subset_gen image_subset_iff)
 
 lemma homeomorphic_maps_sym:
      "homeomorphic_maps X Y f g \<longleftrightarrow> homeomorphic_maps Y X g f"
   by (auto simp: homeomorphic_maps_def)
 
 lemma homeomorphic_maps_id:
      "homeomorphic_maps X Y id id \<longleftrightarrow> Y = X"  (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have "topspace X = topspace Y"
     by (auto simp: homeomorphic_maps_def continuous_map_def)
   with L show ?rhs
     unfolding homeomorphic_maps_def
     by (metis topology_finer_continuous_id topology_eq)
 next
   assume ?rhs
   then show ?lhs
     unfolding homeomorphic_maps_def by auto
 qed
 
 lemma homeomorphic_map_id [simp]: "homeomorphic_map X Y id \<longleftrightarrow> Y = X"
        (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   then have eq: "topspace X = topspace Y"
     by (auto simp: homeomorphic_map_def continuous_map_def quotient_map_def)
   then have "\<And>S. openin X S \<longrightarrow> openin Y S"
     by (meson L homeomorphic_map_def injective_quotient_map topology_finer_open_id)
   then show ?rhs
     using L unfolding homeomorphic_map_def
     by (metis eq quotient_imp_continuous_map topology_eq topology_finer_continuous_id)
 next
   assume ?rhs
   then show ?lhs
     unfolding homeomorphic_map_def
     by (simp add: closed_map_id continuous_closed_imp_quotient_map)
 qed
 
 lemma homeomorphic_map_compose:
   assumes "homeomorphic_map X Y f" "homeomorphic_map Y X'' g"
   shows "homeomorphic_map X X'' (g \<circ> f)"
 proof -
   have "inj_on g (f ` topspace X)"
     by (metis (no_types) assms homeomorphic_map_def quotient_imp_surjective_map)
   then show ?thesis
     using assms by (meson comp_inj_on homeomorphic_map_def quotient_map_compose_eq)
 qed
 
 lemma homeomorphic_maps_compose:
    "homeomorphic_maps X Y f h \<and>
         homeomorphic_maps Y X'' g k
         \<Longrightarrow> homeomorphic_maps X X'' (g \<circ> f) (h \<circ> k)"
   unfolding homeomorphic_maps_def
   by (auto simp: continuous_map_compose; simp add: continuous_map_def)
 
 lemma homeomorphic_eq_everything_map:
    "homeomorphic_map X Y f \<longleftrightarrow>
         continuous_map X Y f \<and> open_map X Y f \<and> closed_map X Y f \<and>
         f ` (topspace X) = topspace Y \<and> inj_on f (topspace X)"
   unfolding homeomorphic_map_def
   by (force simp: injective_quotient_map intro: injective_quotient_map)
 
 lemma homeomorphic_imp_continuous_map:
      "homeomorphic_map X Y f \<Longrightarrow> continuous_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_open_map:
    "homeomorphic_map X Y f \<Longrightarrow> open_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_closed_map:
    "homeomorphic_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_surjective_map:
    "homeomorphic_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma homeomorphic_imp_injective_map:
     "homeomorphic_map X Y f \<Longrightarrow> inj_on f (topspace X)"
   by (simp add: homeomorphic_eq_everything_map)
 
 lemma bijective_open_imp_homeomorphic_map:
    "\<lbrakk>continuous_map X Y f; open_map X Y f; f ` (topspace X) = topspace Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> homeomorphic_map X Y f"
   by (simp add: homeomorphic_map_def continuous_open_imp_quotient_map)
 
 lemma bijective_closed_imp_homeomorphic_map:
    "\<lbrakk>continuous_map X Y f; closed_map X Y f; f ` (topspace X) = topspace Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> homeomorphic_map X Y f"
   by (simp add: continuous_closed_quotient_map homeomorphic_map_def)
 
 lemma open_eq_continuous_inverse_map:
   assumes X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> g(f x) = x"
     and Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> g y \<in> topspace X \<and> f(g y) = y"
   shows "open_map X Y f \<longleftrightarrow> continuous_map Y X g"
 proof -
   have eq: "{x \<in> topspace Y. g x \<in> U} = f ` U" if "openin X U" for U
     using openin_subset [OF that] by (force simp: X Y image_iff)
   show ?thesis
     by (auto simp: Y open_map_def continuous_map_def eq)
 qed
 
 lemma closed_eq_continuous_inverse_map:
   assumes X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> g(f x) = x"
     and Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> g y \<in> topspace X \<and> f(g y) = y"
   shows "closed_map X Y f \<longleftrightarrow> continuous_map Y X g"
 proof -
   have eq: "{x \<in> topspace Y. g x \<in> U} = f ` U" if "closedin X U" for U
     using closedin_subset [OF that] by (force simp: X Y image_iff)
   show ?thesis
     by (auto simp: Y closed_map_def continuous_map_closedin eq)
 qed
 
 lemma homeomorphic_maps_map:
   "homeomorphic_maps X Y f g \<longleftrightarrow>
         homeomorphic_map X Y f \<and> homeomorphic_map Y X g \<and>
         (\<forall>x \<in> topspace X. g(f x) = x) \<and> (\<forall>y \<in> topspace Y. f(g y) = y)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have L: "continuous_map X Y f" "continuous_map Y X g" "\<forall>x\<in>topspace X. g (f x) = x" "\<forall>x'\<in>topspace Y. f (g x') = x'"
     by (auto simp: homeomorphic_maps_def)
   show ?rhs
   proof (intro conjI bijective_open_imp_homeomorphic_map L)
     show "open_map X Y f"
       using L using open_eq_continuous_inverse_map [of concl: X Y f g] by (simp add: continuous_map_def)
     show "open_map Y X g"
       using L using open_eq_continuous_inverse_map [of concl: Y X g f] by (simp add: continuous_map_def)
     show "f ` topspace X = topspace Y" "g ` topspace Y = topspace X"
       using L by (force simp: continuous_map_closedin)+
     show "inj_on f (topspace X)" "inj_on g (topspace Y)"
       using L unfolding inj_on_def by metis+
   qed
 next
   assume ?rhs
   then show ?lhs
     by (auto simp: homeomorphic_maps_def homeomorphic_imp_continuous_map)
 qed
 
 lemma homeomorphic_maps_imp_map:
     "homeomorphic_maps X Y f g \<Longrightarrow> homeomorphic_map X Y f"
   using homeomorphic_maps_map by blast
 
 lemma homeomorphic_map_maps:
      "homeomorphic_map X Y f \<longleftrightarrow> (\<exists>g. homeomorphic_maps X Y f g)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have L: "continuous_map X Y f" "open_map X Y f" "closed_map X Y f"
     "f ` (topspace X) = topspace Y" "inj_on f (topspace X)"
     by (auto simp: homeomorphic_eq_everything_map)
   have X: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y \<and> inv_into (topspace X) f (f x) = x"
     using L by auto
   have Y: "\<And>y. y \<in> topspace Y \<Longrightarrow> inv_into (topspace X) f y \<in> topspace X \<and> f (inv_into (topspace X) f y) = y"
     by (simp add: L f_inv_into_f inv_into_into)
   have "homeomorphic_maps X Y f (inv_into (topspace X) f)"
     unfolding homeomorphic_maps_def
   proof (intro conjI L)
     show "continuous_map Y X (inv_into (topspace X) f)"
       by (simp add: L X Y flip: open_eq_continuous_inverse_map [where f=f])
   next
     show "\<forall>x\<in>topspace X. inv_into (topspace X) f (f x) = x"
          "\<forall>y\<in>topspace Y. f (inv_into (topspace X) f y) = y"
       using X Y by auto
   qed
   then show ?rhs
     by metis
 next
   assume ?rhs
   then show ?lhs
     using homeomorphic_maps_map by blast
 qed
 
 lemma homeomorphic_maps_involution:
    "\<lbrakk>continuous_map X X f; \<And>x. x \<in> topspace X \<Longrightarrow> f(f x) = x\<rbrakk> \<Longrightarrow> homeomorphic_maps X X f f"
   by (auto simp: homeomorphic_maps_def)
 
 lemma homeomorphic_map_involution:
    "\<lbrakk>continuous_map X X f; \<And>x. x \<in> topspace X \<Longrightarrow> f(f x) = x\<rbrakk> \<Longrightarrow> homeomorphic_map X X f"
   using homeomorphic_maps_involution homeomorphic_maps_map by blast
 
 lemma homeomorphic_map_openness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "openin Y (f ` U) \<longleftrightarrow> openin X U"
 proof -
   obtain g where "homeomorphic_maps X Y f g"
     using assms by (auto simp: homeomorphic_map_maps)
   then have g: "homeomorphic_map Y X g" and gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = x"
     by (auto simp: homeomorphic_maps_map)
   then have "openin X U \<Longrightarrow> openin Y (f ` U)"
     using hom homeomorphic_imp_open_map open_map_def by blast
   show "openin Y (f ` U) = openin X U"
   proof
     assume L: "openin Y (f ` U)"
     have "U = g ` (f ` U)"
       using U gf by force
     then show "openin X U"
       by (metis L homeomorphic_imp_open_map open_map_def g)
   next
     assume "openin X U"
     then show "openin Y (f ` U)"
       using hom homeomorphic_imp_open_map open_map_def by blast
   qed
 qed
 
 
 lemma homeomorphic_map_closedness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "closedin Y (f ` U) \<longleftrightarrow> closedin X U"
 proof -
   obtain g where "homeomorphic_maps X Y f g"
     using assms by (auto simp: homeomorphic_map_maps)
   then have g: "homeomorphic_map Y X g" and gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = x"
     by (auto simp: homeomorphic_maps_map)
   then have "closedin X U \<Longrightarrow> closedin Y (f ` U)"
     using hom homeomorphic_imp_closed_map closed_map_def by blast
   show "closedin Y (f ` U) = closedin X U"
   proof
     assume L: "closedin Y (f ` U)"
     have "U = g ` (f ` U)"
       using U gf by force
     then show "closedin X U"
       by (metis L homeomorphic_imp_closed_map closed_map_def g)
   next
     assume "closedin X U"
     then show "closedin Y (f ` U)"
       using hom homeomorphic_imp_closed_map closed_map_def by blast
   qed
 qed
 
 lemma homeomorphic_map_openness_eq:
      "homeomorphic_map X Y f \<Longrightarrow> openin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> openin Y (f ` U)"
   by (meson homeomorphic_map_openness openin_closedin_eq)
 
 lemma homeomorphic_map_closedness_eq:
     "homeomorphic_map X Y f \<Longrightarrow> closedin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> closedin Y (f ` U)"
   by (meson closedin_subset homeomorphic_map_closedness)
 
 lemma all_openin_homeomorphic_image:
   assumes "homeomorphic_map X Y f"
   shows "(\<forall>V. openin Y V \<longrightarrow> P V) \<longleftrightarrow> (\<forall>U. openin X U \<longrightarrow> P(f ` U))" 
   by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_openness openin_subset subset_image_iff)
 
 lemma all_closedin_homeomorphic_image:
   assumes "homeomorphic_map X Y f"
   shows "(\<forall>V. closedin Y V \<longrightarrow> P V) \<longleftrightarrow> (\<forall>U. closedin X U \<longrightarrow> P(f ` U))"  (is "?lhs = ?rhs")
   by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_closedness closedin_subset subset_image_iff)
 
 
 lemma homeomorphic_map_derived_set_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y derived_set_of (f ` S) = f ` (X derived_set_of S)"
 proof -
   have fim: "f ` (topspace X) = topspace Y" and inj: "inj_on f (topspace X)"
     using hom by (auto simp: homeomorphic_eq_everything_map)
   have iff: "(\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y. y \<noteq> x \<and> y \<in> S \<and> y \<in> T)) =
             (\<forall>T. T \<subseteq> topspace Y \<longrightarrow> f x \<in> T \<longrightarrow> openin Y T \<longrightarrow> (\<exists>y. y \<noteq> f x \<and> y \<in> f ` S \<and> y \<in> T))"
     if "x \<in> topspace X" for x
   proof -
     have \<section>: "(x \<in> T \<and> openin X T) = (T \<subseteq> topspace X \<and> f x \<in> f ` T \<and> openin Y (f ` T))" for T
       by (meson hom homeomorphic_map_openness_eq inj inj_on_image_mem_iff that)
     moreover have "(\<exists>y. y \<noteq> x \<and> y \<in> S \<and> y \<in> T) = (\<exists>y. y \<noteq> f x \<and> y \<in> f ` S \<and> y \<in> f ` T)"  (is "?lhs = ?rhs")
       if "T \<subseteq> topspace X \<and> f x \<in> f ` T \<and> openin Y (f ` T)" for T
       by (smt (verit, del_insts) S \<open>x \<in> topspace X\<close> image_iff inj inj_on_def subsetD that)
     ultimately show ?thesis
       by (auto simp flip: fim simp: all_subset_image)
   qed
   have *: "\<lbrakk>T = f ` S; \<And>x. x \<in> S \<Longrightarrow> P x \<longleftrightarrow> Q(f x)\<rbrakk> \<Longrightarrow> {y. y \<in> T \<and> Q y} = f ` {x \<in> S. P x}" for T S P Q
     by auto
   show ?thesis
     unfolding derived_set_of_def
     by (rule *) (use fim iff openin_subset in force)+
 qed
 
 
 lemma homeomorphic_map_closure_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y closure_of (f ` S) = f ` (X closure_of S)"
   unfolding closure_of
   using homeomorphic_imp_surjective_map [OF hom] S
   by (auto simp: in_derived_set_of homeomorphic_map_derived_set_of [OF assms])
 
 lemma homeomorphic_map_interior_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y interior_of (f ` S) = f ` (X interior_of S)"
 proof -
   { fix y
     assume "y \<in> topspace Y" and "y \<notin> Y closure_of (topspace Y - f ` S)"
     then have "y \<in> f ` (topspace X - X closure_of (topspace X - S))"
       using homeomorphic_eq_everything_map [THEN iffD1, OF hom] homeomorphic_map_closure_of [OF hom]
       by (metis DiffI Diff_subset S closure_of_subset_topspace inj_on_image_set_diff) }
   moreover
   { fix x
     assume "x \<in> topspace X"
     then have "f x \<in> topspace Y"
       using hom homeomorphic_imp_surjective_map by blast }
   moreover
   { fix x
     assume "x \<in> topspace X" and "x \<notin> X closure_of (topspace X - S)" and "f x \<in> Y closure_of (topspace Y - f ` S)"
     then have "False"
       using homeomorphic_map_closure_of [OF hom] hom
       unfolding homeomorphic_eq_everything_map
       by (metis Diff_subset S closure_of_subset_topspace inj_on_image_mem_iff inj_on_image_set_diff)
   }
   ultimately  show ?thesis
     by (auto simp: interior_of_closure_of)
 qed
 
 lemma homeomorphic_map_frontier_of:
   assumes hom: "homeomorphic_map X Y f" and S: "S \<subseteq> topspace X"
   shows "Y frontier_of (f ` S) = f ` (X frontier_of S)"
   unfolding frontier_of_def
 proof (intro equalityI subsetI DiffI)
   fix y
   assume "y \<in> Y closure_of f ` S - Y interior_of f ` S"
   then show "y \<in> f ` (X closure_of S - X interior_of S)"
     using S hom homeomorphic_map_closure_of homeomorphic_map_interior_of by fastforce
 next
   fix y
   assume "y \<in> f ` (X closure_of S - X interior_of S)"
   then show "y \<in> Y closure_of f ` S"
     using S hom homeomorphic_map_closure_of by fastforce
 next
   fix x
   assume "x \<in> f ` (X closure_of S - X interior_of S)"
   then obtain y where y: "x = f y" "y \<in> X closure_of S" "y \<notin> X interior_of S"
     by blast
   then show "x \<notin> Y interior_of f ` S"
     using S hom homeomorphic_map_interior_of y(1)
     unfolding homeomorphic_map_def
     by (smt (verit, ccfv_SIG) in_closure_of inj_on_image_mem_iff interior_of_subset_topspace) 
 qed
 
 lemma homeomorphic_maps_subtopologies:
    "\<lbrakk>homeomorphic_maps X Y f g;  f ` (topspace X \<inter> S) = topspace Y \<inter> T\<rbrakk>
         \<Longrightarrow> homeomorphic_maps (subtopology X S) (subtopology Y T) f g"
   unfolding homeomorphic_maps_def
   by (force simp: continuous_map_from_subtopology continuous_map_in_subtopology)
 
 lemma homeomorphic_maps_subtopologies_alt:
      "\<lbrakk>homeomorphic_maps X Y f g; f ` (topspace X \<inter> S) \<subseteq> T; g ` (topspace Y \<inter> T) \<subseteq> S\<rbrakk>
       \<Longrightarrow> homeomorphic_maps (subtopology X S) (subtopology Y T) f g"
   unfolding homeomorphic_maps_def
   by (force simp: continuous_map_from_subtopology continuous_map_in_subtopology)
 
 lemma homeomorphic_map_subtopologies:
    "\<lbrakk>homeomorphic_map X Y f; f ` (topspace X \<inter> S) = topspace Y \<inter> T\<rbrakk>
         \<Longrightarrow> homeomorphic_map (subtopology X S) (subtopology Y T) f"
   by (meson homeomorphic_map_maps homeomorphic_maps_subtopologies)
 
 lemma homeomorphic_map_subtopologies_alt:
   assumes hom: "homeomorphic_map X Y f" 
       and S: "\<And>x. \<lbrakk>x \<in> topspace X; f x \<in> topspace Y\<rbrakk> \<Longrightarrow> f x \<in> T \<longleftrightarrow> x \<in> S"
     shows "homeomorphic_map (subtopology X S) (subtopology Y T) f"
 proof -
   have "homeomorphic_maps (subtopology X S) (subtopology Y T) f g" 
     if "homeomorphic_maps X Y f g" for g
   proof (rule homeomorphic_maps_subtopologies [OF that])
     have "f ` (topspace X \<inter> S) \<subseteq> topspace Y \<inter> T"
       using S hom homeomorphic_imp_surjective_map by fastforce
     then show "f ` (topspace X \<inter> S) = topspace Y \<inter> T"
       using that unfolding homeomorphic_maps_def continuous_map_def
       by (smt (verit, del_insts) Int_iff S image_iff subsetI subset_antisym)
   qed
   then show ?thesis
     using hom by (meson homeomorphic_map_maps)
 qed
 
 
 subsection\<open>Relation of homeomorphism between topological spaces\<close>
 
 definition homeomorphic_space (infixr "homeomorphic'_space" 50)
   where "X homeomorphic_space Y \<equiv> \<exists>f g. homeomorphic_maps X Y f g"
 
 lemma homeomorphic_space_refl: "X homeomorphic_space X"
   by (meson homeomorphic_maps_id homeomorphic_space_def)
 
 lemma homeomorphic_space_sym:
    "X homeomorphic_space Y \<longleftrightarrow> Y homeomorphic_space X"
   unfolding homeomorphic_space_def by (metis homeomorphic_maps_sym)
 
 lemma homeomorphic_space_trans [trans]:
      "\<lbrakk>X1 homeomorphic_space X2; X2 homeomorphic_space X3\<rbrakk> \<Longrightarrow> X1 homeomorphic_space X3"
   unfolding homeomorphic_space_def by (metis homeomorphic_maps_compose)
 
 lemma homeomorphic_space:
      "X homeomorphic_space Y \<longleftrightarrow> (\<exists>f. homeomorphic_map X Y f)"
   by (simp add: homeomorphic_map_maps homeomorphic_space_def)
 
 lemma homeomorphic_maps_imp_homeomorphic_space:
      "homeomorphic_maps X Y f g \<Longrightarrow> X homeomorphic_space Y"
   unfolding homeomorphic_space_def by metis
 
 lemma homeomorphic_map_imp_homeomorphic_space:
      "homeomorphic_map X Y f \<Longrightarrow> X homeomorphic_space Y"
   unfolding homeomorphic_map_maps
   using homeomorphic_space_def by blast
 
 lemma homeomorphic_empty_space:
      "X homeomorphic_space Y \<Longrightarrow> topspace X = {} \<longleftrightarrow> topspace Y = {}"
   by (metis homeomorphic_imp_surjective_map homeomorphic_space image_is_empty)
 
 lemma homeomorphic_empty_space_eq:
   assumes "topspace X = {}"
   shows "X homeomorphic_space Y \<longleftrightarrow> topspace Y = {}"
   unfolding homeomorphic_maps_def homeomorphic_space_def
   by (metis assms continuous_map_on_empty continuous_map_closedin ex_in_conv)
 
 subsection\<open>Connected topological spaces\<close>
 
 definition connected_space :: "'a topology \<Rightarrow> bool" where
   "connected_space X \<equiv>
         \<not>(\<exists>E1 E2. openin X E1 \<and> openin X E2 \<and>
                   topspace X \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
 
 definition connectedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool" where
   "connectedin X S \<equiv> S \<subseteq> topspace X \<and> connected_space (subtopology X S)"
 
 lemma connected_spaceD:
   "\<lbrakk>connected_space X;
     openin X U; openin X V; topspace X \<subseteq> U \<union> V; U \<inter> V = {}; U \<noteq> {}; V \<noteq> {}\<rbrakk> \<Longrightarrow> False"
   by (auto simp: connected_space_def)
 
 lemma connectedin_subset_topspace: "connectedin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: connectedin_def)
 
 lemma connectedin_topspace:
      "connectedin X (topspace X) \<longleftrightarrow> connected_space X"
   by (simp add: connectedin_def)
 
 lemma connected_space_subtopology:
      "connectedin X S \<Longrightarrow> connected_space (subtopology X S)"
   by (simp add: connectedin_def)
 
 lemma connectedin_subtopology:
      "connectedin (subtopology X S) T \<longleftrightarrow> connectedin X T \<and> T \<subseteq> S"
   by (force simp: connectedin_def subtopology_subtopology inf_absorb2)
 
 lemma connected_space_eq:
      "connected_space X \<longleftrightarrow>
       (\<nexists>E1 E2. openin X E1 \<and> openin X E2 \<and> E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   unfolding connected_space_def
   by (metis openin_Un openin_subset subset_antisym)
 
 lemma connected_space_closedin:
      "connected_space X \<longleftrightarrow>
       (\<nexists>E1 E2. closedin X E1 \<and> closedin X E2 \<and> topspace X \<subseteq> E1 \<union> E2 \<and>
                E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "\<And>E1 E2. \<lbrakk>openin X E1; E1 \<inter> E2 = {}; topspace X \<subseteq> E1 \<union> E2; openin X E2\<rbrakk> \<Longrightarrow> E1 = {} \<or> E2 = {}"
     by (simp add: connected_space_def)
   then show ?rhs
     unfolding connected_space_def
     by (metis disjnt_def separatedin_closed_sets separation_openin_Un_gen subtopology_superset)
 next
   assume R: ?rhs
   then show ?lhs
     unfolding connected_space_def
     by (metis Diff_triv Int_commute separatedin_openin_diff separation_closedin_Un_gen subtopology_superset)
 qed
 
 lemma connected_space_closedin_eq:
      "connected_space X \<longleftrightarrow>
        (\<nexists>E1 E2. closedin X E1 \<and> closedin X E2 \<and>
                 E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> E1 \<noteq> {} \<and> E2 \<noteq> {})"
   by (metis closedin_Un closedin_def connected_space_closedin subset_antisym)
 
 lemma connected_space_clopen_in:
      "connected_space X \<longleftrightarrow>
         (\<forall>T. openin X T \<and> closedin X T \<longrightarrow> T = {} \<or> T = topspace X)"
 proof -
   have eq: "openin X E1 \<and> openin X E2 \<and> E1 \<union> E2 = topspace X \<and> E1 \<inter> E2 = {} \<and> P
         \<longleftrightarrow> E2 = topspace X - E1 \<and> openin X E1 \<and> openin X E2 \<and> P" for E1 E2 P
     using openin_subset by blast
   show ?thesis
     unfolding connected_space_eq eq closedin_def
     by (auto simp: openin_closedin_eq)
 qed
 
 lemma connectedin:
      "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
          (\<nexists>E1 E2.
              openin X E1 \<and> openin X E2 \<and>
              S \<subseteq> E1 \<union> E2 \<and> E1 \<inter> E2 \<inter> S = {} \<and> E1 \<inter> S \<noteq> {} \<and> E2 \<inter> S \<noteq> {})"  (is "?lhs = ?rhs")
 proof -
   have *: "(\<exists>E1:: 'a set. \<exists>E2:: 'a set. (\<exists>T1:: 'a set. P1 T1 \<and> E1 = f1 T1) \<and> (\<exists>T2:: 'a set. P2 T2 \<and> E2 = f2 T2) \<and>
              R E1 E2) \<longleftrightarrow> (\<exists>T1 T2. P1 T1 \<and> P2 T2 \<and> R(f1 T1) (f2 T2))" for P1 f1 P2 f2 R
     by auto
   show ?thesis 
     unfolding connectedin_def connected_space_def openin_subtopology topspace_subtopology *
     by (intro conj_cong arg_cong [where f=Not] ex_cong1; blast dest!: openin_subset)
 qed
 
 lemma connectedinD:
      "\<lbrakk>connectedin X S; openin X E1; openin X E2; S \<subseteq> E1 \<union> E2; E1 \<inter> E2 \<inter> S = {}; E1 \<inter> S \<noteq> {}; E2 \<inter> S \<noteq> {}\<rbrakk> \<Longrightarrow> False"
   by (meson connectedin)
 
 lemma connectedin_iff_connected [simp]: "connectedin euclidean S \<longleftrightarrow> connected S"
   by (simp add: connected_def connectedin)
 
 lemma connectedin_closedin:
    "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         \<not>(\<exists>E1 E2. closedin X E1 \<and> closedin X E2 \<and>
                   S \<subseteq> (E1 \<union> E2) \<and>
                   (E1 \<inter> E2 \<inter> S = {}) \<and>
                   \<not>(E1 \<inter> S = {}) \<and> \<not>(E2 \<inter> S = {}))"
 proof -
   have *: "(\<exists>E1:: 'a set. \<exists>E2:: 'a set. (\<exists>T1:: 'a set. P1 T1 \<and> E1 = f1 T1) \<and> (\<exists>T2:: 'a set. P2 T2 \<and> E2 = f2 T2) \<and>
              R E1 E2) \<longleftrightarrow> (\<exists>T1 T2. P1 T1 \<and> P2 T2 \<and> R(f1 T1) (f2 T2))" for P1 f1 P2 f2 R
     by auto
   show ?thesis
     unfolding connectedin_def connected_space_closedin closedin_subtopology topspace_subtopology *
     by (intro conj_cong arg_cong [where f=Not] ex_cong1; blast dest!: openin_subset)
 qed
 
 lemma connectedin_empty [simp]: "connectedin X {}"
   by (simp add: connectedin)
 
 lemma connected_space_topspace_empty:
      "topspace X = {} \<Longrightarrow> connected_space X"
   using connectedin_topspace by fastforce
 
 lemma connectedin_sing [simp]: "connectedin X {a} \<longleftrightarrow> a \<in> topspace X"
   by (simp add: connectedin)
 
 lemma connectedin_absolute [simp]:
   "connectedin (subtopology X S) S \<longleftrightarrow> connectedin X S"
   by (simp add: connectedin_subtopology)
 
 lemma connectedin_Union:
   assumes \<U>: "\<And>S. S \<in> \<U> \<Longrightarrow> connectedin X S" and ne: "\<Inter>\<U> \<noteq> {}"
   shows "connectedin X (\<Union>\<U>)"
 proof -
   have "\<Union>\<U> \<subseteq> topspace X"
     using \<U> by (simp add: Union_least connectedin_def)
   moreover have False
     if "openin X E1" "openin X E2" and cover: "\<Union>\<U> \<subseteq> E1 \<union> E2" and disj: "E1 \<inter> E2 \<inter> \<Union>\<U> = {}"
        and overlap1: "E1 \<inter> \<Union>\<U> \<noteq> {}" and overlap2: "E2 \<inter> \<Union>\<U> \<noteq> {}"
       for E1 E2
   proof -
     have disjS: "E1 \<inter> E2 \<inter> S = {}" if "S \<in> \<U>" for S
       using Diff_triv that disj by auto
     have coverS: "S \<subseteq> E1 \<union> E2" if "S \<in> \<U>" for S
       using that cover by blast
     have "\<U> \<noteq> {}"
       using overlap1 by blast
     obtain a where a: "\<And>U. U \<in> \<U> \<Longrightarrow> a \<in> U"
       using ne by force
     with \<open>\<U> \<noteq> {}\<close> have "a \<in> \<Union>\<U>"
       by blast
     then consider "a \<in> E1" | "a \<in> E2"
       using \<open>\<Union>\<U> \<subseteq> E1 \<union> E2\<close> by auto
     then show False
     proof cases
       case 1
       then obtain b S where "b \<in> E2" "b \<in> S" "S \<in> \<U>"
         using overlap2 by blast
       then show ?thesis
         using "1" \<open>openin X E1\<close> \<open>openin X E2\<close> disjS coverS a [OF \<open>S \<in> \<U>\<close>]  \<U>[OF \<open>S \<in> \<U>\<close>]
         unfolding connectedin
         by (meson disjoint_iff_not_equal)
     next
       case 2
       then obtain b S where "b \<in> E1" "b \<in> S" "S \<in> \<U>"
         using overlap1 by blast
       then show ?thesis
         using "2" \<open>openin X E1\<close> \<open>openin X E2\<close> disjS coverS a [OF \<open>S \<in> \<U>\<close>]  \<U>[OF \<open>S \<in> \<U>\<close>]
         unfolding connectedin
         by (meson disjoint_iff_not_equal)
     qed
   qed
   ultimately show ?thesis
     unfolding connectedin by blast
 qed
 
 lemma connectedin_Un:
      "\<lbrakk>connectedin X S; connectedin X T; S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow> connectedin X (S \<union> T)"
   using connectedin_Union [of "{S,T}"] by auto
 
 lemma connected_space_subconnected:
   "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. \<exists>S. connectedin X S \<and> x \<in> S \<and> y \<in> S)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     using connectedin_topspace by blast
 next
   assume R [rule_format]: ?rhs
   have False if "openin X U" "openin X V" and disj: "U \<inter> V = {}" and cover: "topspace X \<subseteq> U \<union> V"
     and "U \<noteq> {}" "V \<noteq> {}" for U V
   proof -
     obtain u v where "u \<in> U" "v \<in> V"
       using \<open>U \<noteq> {}\<close> \<open>V \<noteq> {}\<close> by auto
     then obtain T where "u \<in> T" "v \<in> T" and T: "connectedin X T"
       using R [of u v] that
       by (meson \<open>openin X U\<close> \<open>openin X V\<close> subsetD openin_subset)
     then show False
       using that unfolding connectedin
       by (metis IntI \<open>u \<in> U\<close> \<open>v \<in> V\<close> empty_iff inf_bot_left subset_trans)
   qed
   then show ?lhs
     by (auto simp: connected_space_def)
 qed
 
 lemma connectedin_intermediate_closure_of:
   assumes "connectedin X S" "S \<subseteq> T" "T \<subseteq> X closure_of S"
   shows "connectedin X T"
 proof -
   have S: "S \<subseteq> topspace X" and T: "T \<subseteq> topspace X"
     using assms by (meson closure_of_subset_topspace dual_order.trans)+
   have \<section>: "\<And>E1 E2. \<lbrakk>openin X E1; openin X E2; E1 \<inter> S = {} \<or> E2 \<inter> S = {}\<rbrakk> \<Longrightarrow> E1 \<inter> T = {} \<or> E2 \<inter> T = {}"
     using assms unfolding disjoint_iff by (meson in_closure_of subsetD)
   then show ?thesis
     using assms
     unfolding connectedin closure_of_subset_topspace S T
     by (metis Int_empty_right T dual_order.trans inf.orderE inf_left_commute)
 qed
 
 lemma connectedin_closure_of:
      "connectedin X S \<Longrightarrow> connectedin X (X closure_of S)"
   by (meson closure_of_subset connectedin_def connectedin_intermediate_closure_of subset_refl)
 
 lemma connectedin_separation:
   "connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         (\<nexists>C1 C2. C1 \<union> C2 = S \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> C1 \<inter> X closure_of C2 = {} \<and> C2 \<inter> X closure_of C1 = {})" 
   unfolding connectedin_def connected_space_closedin_eq closedin_Int_closure_of topspace_subtopology
   apply (intro conj_cong refl arg_cong [where f=Not])
   apply (intro ex_cong1 iffI, blast)
   using closure_of_subset_Int by force
 
 lemma connectedin_eq_not_separated:
    "connectedin X S \<longleftrightarrow>
          S \<subseteq> topspace X \<and>
          (\<nexists>C1 C2. C1 \<union> C2 = S \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   unfolding separatedin_def by (metis connectedin_separation sup.boundedE)
 
 lemma connectedin_eq_not_separated_subset:
   "connectedin X S \<longleftrightarrow>
       S \<subseteq> topspace X \<and> (\<nexists>C1 C2. S \<subseteq> C1 \<union> C2 \<and> S \<inter> C1 \<noteq> {} \<and> S \<inter> C2 \<noteq> {} \<and> separatedin X C1 C2)"
 proof -
   have "\<forall>C1 C2. S \<subseteq> C1 \<union> C2 \<longrightarrow> S \<inter> C1 = {} \<or> S \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
     if "\<And>C1 C2. C1 \<union> C2 = S \<longrightarrow> C1 = {} \<or> C2 = {} \<or> \<not> separatedin X C1 C2"
   proof (intro allI)
     fix C1 C2
     show "S \<subseteq> C1 \<union> C2 \<longrightarrow> S \<inter> C1 = {} \<or> S \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
       using that [of "S \<inter> C1" "S \<inter> C2"]
       by (auto simp: separatedin_mono)
   qed
   then show ?thesis
     by (metis Un_Int_eq(1) Un_Int_eq(2) connectedin_eq_not_separated order_refl)
 qed
 
 lemma connected_space_eq_not_separated:
      "connected_space X \<longleftrightarrow>
       (\<nexists>C1 C2. C1 \<union> C2 = topspace X \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   by (simp add: connectedin_eq_not_separated flip: connectedin_topspace)
 
 lemma connected_space_eq_not_separated_subset:
   "connected_space X \<longleftrightarrow>
     (\<nexists>C1 C2. topspace X \<subseteq> C1 \<union> C2 \<and> C1 \<noteq> {} \<and> C2 \<noteq> {} \<and> separatedin X C1 C2)"
   by (metis connected_space_eq_not_separated le_sup_iff separatedin_def subset_antisym)
 
 lemma connectedin_subset_separated_union:
      "\<lbrakk>connectedin X C; separatedin X S T; C \<subseteq> S \<union> T\<rbrakk> \<Longrightarrow> C \<subseteq> S \<or> C \<subseteq> T"
   unfolding connectedin_eq_not_separated_subset  by blast
 
 lemma connectedin_nonseparated_union:
   assumes "connectedin X S" "connectedin X T" "\<not>separatedin X S T"
   shows "connectedin X (S \<union> T)"
 proof -
   have "\<And>C1 C2. \<lbrakk>T \<subseteq> C1 \<union> C2; S \<subseteq> C1 \<union> C2\<rbrakk> \<Longrightarrow>
            S \<inter> C1 = {} \<and> T \<inter> C1 = {} \<or> S \<inter> C2 = {} \<and> T \<inter> C2 = {} \<or> \<not> separatedin X C1 C2"
     using assms
     unfolding connectedin_eq_not_separated_subset
     by (metis (no_types, lifting) assms connectedin_subset_separated_union inf.orderE separatedin_empty(1) separatedin_mono separatedin_sym)
   then show ?thesis
     unfolding connectedin_eq_not_separated_subset
     by (simp add: assms connectedin_subset_topspace Int_Un_distrib2)
 qed
 
 lemma connected_space_closures:
      "connected_space X \<longleftrightarrow>
         (\<nexists>e1 e2. e1 \<union> e2 = topspace X \<and> X closure_of e1 \<inter> X closure_of e2 = {} \<and> e1 \<noteq> {} \<and> e2 \<noteq> {})"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding connected_space_closedin_eq
     by (metis Un_upper1 Un_upper2 closedin_closure_of closure_of_Un closure_of_eq_empty closure_of_topspace)
 next
   assume ?rhs
   then show ?lhs
     unfolding connected_space_closedin_eq
     by (metis closure_of_eq)
 qed
 
 lemma connectedin_Int_frontier_of:
   assumes "connectedin X S" "S \<inter> T \<noteq> {}" "S - T \<noteq> {}"
   shows "S \<inter> X frontier_of T \<noteq> {}"
 proof -
   have "S \<subseteq> topspace X" and *:
     "\<And>E1 E2. openin X E1 \<longrightarrow> openin X E2 \<longrightarrow> E1 \<inter> E2 \<inter> S = {} \<longrightarrow> S \<subseteq> E1 \<union> E2 \<longrightarrow> E1 \<inter> S = {} \<or> E2 \<inter> S = {}"
     using \<open>connectedin X S\<close> by (auto simp: connectedin)
   moreover
   have "S - (topspace X \<inter> T) \<noteq> {}"
     using assms(3) by blast
   moreover
   have "S \<inter> topspace X \<inter> T \<noteq> {}"
     using assms connectedin by fastforce
   moreover
   have False if "S \<inter> T \<noteq> {}" "S - T \<noteq> {}" "T \<subseteq> topspace X" "S \<inter> X frontier_of T = {}" for T
   proof -
     have null: "S \<inter> (X closure_of T - X interior_of T) = {}"
       using that unfolding frontier_of_def by blast
     have "X interior_of T \<inter> (topspace X - X closure_of T) \<inter> S = {}"
       by (metis Diff_disjoint inf_bot_left interior_of_Int interior_of_complement interior_of_empty)
     moreover have "S \<subseteq> X interior_of T \<union> (topspace X - X closure_of T)"
       using that \<open>S \<subseteq> topspace X\<close> null by auto
     moreover have "S \<inter> X interior_of T \<noteq> {}"
       using closure_of_subset that(1) that(3) null by fastforce
     ultimately have "S \<inter> X interior_of (topspace X - T) = {}"
       by (metis "*" inf_commute interior_of_complement openin_interior_of)
     then have "topspace (subtopology X S) \<inter> X interior_of T = S"
       using \<open>S \<subseteq> topspace X\<close> interior_of_complement null by fastforce
     then show ?thesis
       using that by (metis Diff_eq_empty_iff inf_le2 interior_of_subset subset_trans)
   qed
   ultimately show ?thesis
     by (metis Int_lower1 frontier_of_restrict inf_assoc)
 qed
 
 lemma connectedin_continuous_map_image:
   assumes f: "continuous_map X Y f" and "connectedin X S"
   shows "connectedin Y (f ` S)"
 proof -
   have "S \<subseteq> topspace X" and *:
     "\<And>E1 E2. openin X E1 \<longrightarrow> openin X E2 \<longrightarrow> E1 \<inter> E2 \<inter> S = {} \<longrightarrow> S \<subseteq> E1 \<union> E2 \<longrightarrow> E1 \<inter> S = {} \<or> E2 \<inter> S = {}"
     using \<open>connectedin X S\<close> by (auto simp: connectedin)
   show ?thesis
     unfolding connectedin connected_space_def
   proof (intro conjI notI; clarify)
     show "f x \<in> topspace Y" if  "x \<in> S" for x
       using \<open>S \<subseteq> topspace X\<close> continuous_map_image_subset_topspace f that by blast
   next
     fix U V
     let ?U = "{x \<in> topspace X. f x \<in> U}"
     let ?V = "{x \<in> topspace X. f x \<in> V}"
     assume UV: "openin Y U" "openin Y V" "f ` S \<subseteq> U \<union> V" "U \<inter> V \<inter> f ` S = {}" "U \<inter> f ` S \<noteq> {}" "V \<inter> f ` S \<noteq> {}"
     then have 1: "?U \<inter> ?V \<inter> S = {}"
       by auto
     have 2: "openin X ?U" "openin X ?V"
       using \<open>openin Y U\<close> \<open>openin Y V\<close> continuous_map f by fastforce+
     show "False"
       using * [of ?U ?V] UV \<open>S \<subseteq> topspace X\<close>
       by (auto simp: 1 2)
   qed
 qed
 
 lemma connected_space_quotient_map_image:
    "\<lbrakk>quotient_map X X' q; connected_space X\<rbrakk> \<Longrightarrow> connected_space X'"
   by (metis connectedin_continuous_map_image connectedin_topspace quotient_imp_continuous_map quotient_imp_surjective_map)
 
 lemma homeomorphic_connected_space:
      "X homeomorphic_space Y \<Longrightarrow> connected_space X \<longleftrightarrow> connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   by (metis connected_space_subconnected connectedin_continuous_map_image connectedin_topspace continuous_map_image_subset_topspace image_eqI image_subset_iff)
 
 lemma homeomorphic_map_connectedness:
   assumes f: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "connectedin Y (f ` U) \<longleftrightarrow> connectedin X U"
 proof -
   have 1: "f ` U \<subseteq> topspace Y \<longleftrightarrow> U \<subseteq> topspace X"
     using U f homeomorphic_imp_surjective_map by blast
   moreover have "connected_space (subtopology Y (f ` U)) \<longleftrightarrow> connected_space (subtopology X U)"
   proof (rule homeomorphic_connected_space)
     have "f ` U \<subseteq> topspace Y"
       by (simp add: U 1)
     then have "topspace Y \<inter> f ` U = f ` U"
       by (simp add: subset_antisym)
     then show "subtopology Y (f ` U) homeomorphic_space subtopology X U"
       by (metis U f homeomorphic_map_imp_homeomorphic_space homeomorphic_map_subtopologies homeomorphic_space_sym inf.absorb_iff2)
   qed
   ultimately show ?thesis
     by (auto simp: connectedin_def)
 qed
 
 lemma homeomorphic_map_connectedness_eq:
    "homeomorphic_map X Y f
         \<Longrightarrow> connectedin X U \<longleftrightarrow>
              U \<subseteq> topspace X \<and> connectedin Y (f ` U)"
   using homeomorphic_map_connectedness connectedin_subset_topspace by metis
 
 lemma connectedin_discrete_topology:
    "connectedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U \<and> (\<exists>a. S \<subseteq> {a})"
 proof (cases "S \<subseteq> U")
   case True
   show ?thesis
   proof (cases "S = {}")
     case False
     moreover have "connectedin (discrete_topology U) S \<longleftrightarrow> (\<exists>a. S = {a})"
     proof
       show "connectedin (discrete_topology U) S \<Longrightarrow> \<exists>a. S = {a}"
         using False connectedin_Int_frontier_of insert_Diff by fastforce
     qed (use True in auto)
     ultimately show ?thesis
       by auto
   qed simp
 next
   case False
   then show ?thesis
     by (simp add: connectedin_def)
 qed
 
 lemma connected_space_discrete_topology:
      "connected_space (discrete_topology U) \<longleftrightarrow> (\<exists>a. U \<subseteq> {a})"
   by (metis connectedin_discrete_topology connectedin_topspace order_refl topspace_discrete_topology)
 
 
 subsection\<open>Compact sets\<close>
 
 definition compactin where
  "compactin X S \<longleftrightarrow>
      S \<subseteq> topspace X \<and>
      (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> S \<subseteq> \<Union>\<U>
           \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>))"
 
 definition compact_space where
    "compact_space X \<equiv> compactin X (topspace X)"
 
 lemma compact_space_alt:
    "compact_space X \<longleftrightarrow>
         (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> topspace X \<subseteq> \<Union>\<U>
             \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace X \<subseteq> \<Union>\<F>))"
   by (simp add: compact_space_def compactin_def)
 
 lemma compact_space:
    "compact_space X \<longleftrightarrow>
         (\<forall>\<U>. (\<forall>U \<in> \<U>. openin X U) \<and> \<Union>\<U> = topspace X
             \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> \<Union>\<F> = topspace X))"
   unfolding compact_space_alt
   using openin_subset by fastforce
 
 lemma compactinD:
   "\<lbrakk>compactin X S; \<And>U. U \<in> \<U> \<Longrightarrow> openin X U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
   by (auto simp: compactin_def)
 
 lemma compactin_euclidean_iff [simp]: "compactin euclidean S \<longleftrightarrow> compact S"
   by (simp add: compact_eq_Heine_Borel compactin_def) meson
 
 lemma compactin_absolute [simp]:
    "compactin (subtopology X S) S \<longleftrightarrow> compactin X S"
 proof -
   have eq: "(\<forall>U \<in> \<U>. \<exists>Y. openin X Y \<and> U = Y \<inter> S) \<longleftrightarrow> \<U> \<subseteq> (\<lambda>Y. Y \<inter> S) ` {y. openin X y}" for \<U>
     by auto
   show ?thesis
     by (auto simp: compactin_def openin_subtopology eq imp_conjL all_subset_image ex_finite_subset_image)
 qed
 
 lemma compactin_subspace: "compactin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> compact_space (subtopology X S)"
   unfolding compact_space_def topspace_subtopology
   by (metis compactin_absolute compactin_def inf.absorb2)
 
 lemma compact_space_subtopology: "compactin X S \<Longrightarrow> compact_space (subtopology X S)"
   by (simp add: compactin_subspace)
 
 lemma compactin_subtopology: "compactin (subtopology X S) T \<longleftrightarrow> compactin X T \<and> T \<subseteq> S"
   by (metis compactin_subspace inf.absorb_iff2 le_inf_iff subtopology_subtopology topspace_subtopology)
 
 lemma compactin_subset_topspace: "compactin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: compactin_subspace)
 
 lemma compactin_contractive:
    "\<lbrakk>compactin X' S; topspace X' = topspace X;
      \<And>U. openin X U \<Longrightarrow> openin X' U\<rbrakk> \<Longrightarrow> compactin X S"
   by (simp add: compactin_def)
 
 lemma finite_imp_compactin:
    "\<lbrakk>S \<subseteq> topspace X; finite S\<rbrakk> \<Longrightarrow> compactin X S"
   by (metis compactin_subspace compact_space finite_UnionD inf.absorb_iff2 order_refl topspace_subtopology)
 
 lemma compactin_empty [iff]: "compactin X {}"
   by (simp add: finite_imp_compactin)
 
 lemma compact_space_topspace_empty:
    "topspace X = {} \<Longrightarrow> compact_space X"
   by (simp add: compact_space_def)
 
 lemma finite_imp_compactin_eq:
    "finite S \<Longrightarrow> (compactin X S \<longleftrightarrow> S \<subseteq> topspace X)"
   using compactin_subset_topspace finite_imp_compactin by blast
 
 lemma compactin_sing [simp]: "compactin X {a} \<longleftrightarrow> a \<in> topspace X"
   by (simp add: finite_imp_compactin_eq)
 
 lemma closed_compactin:
   assumes XK: "compactin X K" and "C \<subseteq> K" and XC: "closedin X C"
   shows "compactin X C"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "C \<subseteq> topspace X"
     by (simp add: XC closedin_subset)
 next
   fix \<U> :: "'a set set"
   assume \<U>: "Ball \<U> (openin X) \<and> C \<subseteq> \<Union>\<U>"
   have "(\<forall>U\<in>insert (topspace X - C) \<U>. openin X U)"
     using XC \<U> by blast
   moreover have "K \<subseteq> \<Union>(insert (topspace X - C) \<U>)"
     using \<U> XK compactin_subset_topspace by fastforce
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> insert (topspace X - C) \<U>" "K \<subseteq> \<Union>\<F>"
     using assms unfolding compactin_def by metis
   moreover have "openin X (topspace X - C)"
     using XC by auto
   ultimately show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> C \<subseteq> \<Union>\<F>"
     using \<open>C \<subseteq> K\<close>
     by (rule_tac x="\<F> - {topspace X - C}" in exI) auto
 qed
 
 lemma closedin_compact_space:
    "\<lbrakk>compact_space X; closedin X S\<rbrakk> \<Longrightarrow> compactin X S"
   by (simp add: closed_compactin closedin_subset compact_space_def)
 
 lemma compact_Int_closedin:
   assumes "compactin X S" "closedin X T" shows "compactin X (S \<inter> T)"
 proof -
   have "compactin (subtopology X S) (S \<inter> T)"
     by (metis assms closedin_compact_space closedin_subtopology compactin_subspace inf_commute)
   then show ?thesis
     by (simp add: compactin_subtopology)
 qed
 
 lemma closed_Int_compactin: "\<lbrakk>closedin X S; compactin X T\<rbrakk> \<Longrightarrow> compactin X (S \<inter> T)"
   by (metis compact_Int_closedin inf_commute)
 
 lemma compactin_Un:
   assumes S: "compactin X S" and T: "compactin X T" shows "compactin X (S \<union> T)"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "S \<union> T \<subseteq> topspace X"
     using assms by (auto simp: compactin_def)
 next
   fix \<U> :: "'a set set"
   assume \<U>: "Ball \<U> (openin X) \<and> S \<union> T \<subseteq> \<Union>\<U>"
   with S obtain \<F> where \<V>: "finite \<F>" "\<F> \<subseteq> \<U>" "S \<subseteq> \<Union>\<F>"
     unfolding compactin_def by (meson sup.bounded_iff)
   obtain \<W> where "finite \<W>" "\<W> \<subseteq> \<U>" "T \<subseteq> \<Union>\<W>"
     using \<U> T
     unfolding compactin_def by (meson sup.bounded_iff)
   with \<V> show "\<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U> \<and> S \<union> T \<subseteq> \<Union>\<V>"
     by (rule_tac x="\<F> \<union> \<W>" in exI) auto
 qed
 
 lemma compactin_Union:
    "\<lbrakk>finite \<F>; \<And>S. S \<in> \<F> \<Longrightarrow> compactin X S\<rbrakk> \<Longrightarrow> compactin X (\<Union>\<F>)"
 by (induction rule: finite_induct) (simp_all add: compactin_Un)
 
 lemma compactin_subtopology_imp_compact:
   assumes "compactin (subtopology X S) K" shows "compactin X K"
   using assms
 proof (clarsimp simp add: compactin_def)
   fix \<U>
   define \<V> where "\<V> \<equiv> (\<lambda>U. U \<inter> S) ` \<U>"
   assume "K \<subseteq> topspace X" and "K \<subseteq> S" and "\<forall>x\<in>\<U>. openin X x" and "K \<subseteq> \<Union>\<U>"
   then have "\<forall>V \<in> \<V>. openin (subtopology X S) V" "K \<subseteq> \<Union>\<V>"
     unfolding \<V>_def by (auto simp: openin_subtopology)
   moreover
   assume "\<forall>\<U>. (\<forall>x\<in>\<U>. openin (subtopology X S) x) \<and> K \<subseteq> \<Union>\<U> \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>)"
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<V>" "K \<subseteq> \<Union>\<F>"
     by meson
   then have \<F>: "\<exists>U. U \<in> \<U> \<and> V = U \<inter> S" if "V \<in> \<F>" for V
     unfolding \<V>_def using that by blast
   let ?\<F> = "(\<lambda>F. @U. U \<in> \<U> \<and> F = U \<inter> S) ` \<F>"
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>"
   proof (intro exI conjI)
     show "finite ?\<F>"
       using \<open>finite \<F>\<close> by blast
     show "?\<F> \<subseteq> \<U>"
       using someI_ex [OF \<F>] by blast
     show "K \<subseteq> \<Union>?\<F>"
     proof clarsimp
       fix x
       assume "x \<in> K"
       then show "\<exists>V \<in> \<F>. x \<in> (SOME U. U \<in> \<U> \<and> V = U \<inter> S)"
         using \<open>K \<subseteq> \<Union>\<F>\<close> someI_ex [OF \<F>]
         by (metis (no_types, lifting) IntD1 Union_iff subsetCE)
     qed
   qed
 qed
 
 lemma compact_imp_compactin_subtopology:
   assumes "compactin X K" "K \<subseteq> S" shows "compactin (subtopology X S) K"
   using assms
 proof (clarsimp simp add: compactin_def)
   fix \<U> :: "'a set set"
   define \<V> where "\<V> \<equiv> {V. openin X V \<and> (\<exists>U \<in> \<U>. U = V \<inter> S)}"
   assume "K \<subseteq> S" and "K \<subseteq> topspace X" and "\<forall>U\<in>\<U>. openin (subtopology X S) U" and "K \<subseteq> \<Union>\<U>"
   then have "\<forall>V \<in> \<V>. openin X V" "K \<subseteq> \<Union>\<V>"
     unfolding \<V>_def by (fastforce simp: subset_eq openin_subtopology)+
   moreover
   assume "\<forall>\<U>. (\<forall>U\<in>\<U>. openin X U) \<and> K \<subseteq> \<Union>\<U> \<longrightarrow> (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>)"
   ultimately obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<V>" "K \<subseteq> \<Union>\<F>"
     by meson
   let ?\<F> = "(\<lambda>F. F \<inter> S) ` \<F>"
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> K \<subseteq> \<Union>\<F>"
   proof (intro exI conjI)
     show "finite ?\<F>"
       using \<open>finite \<F>\<close> by blast
     show "?\<F> \<subseteq> \<U>"
       using \<V>_def \<open>\<F> \<subseteq> \<V>\<close> by blast
     show "K \<subseteq> \<Union>?\<F>"
       using \<open>K \<subseteq> \<Union>\<F>\<close> assms(2) by auto
   qed
 qed
 
 
 proposition compact_space_fip:
    "compact_space X \<longleftrightarrow>
     (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter>\<U> \<noteq> {})"
    (is "_ = ?rhs")
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     unfolding compact_space_def
     by (metis Sup_bot_conv(1) closedin_topspace_empty compactin_empty finite.emptyI finite_UnionD order_refl)
 next
   case False
   show ?thesis
   proof safe
     fix \<U> :: "'a set set"
     assume * [rule_format]: "\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}"
     define \<V> where "\<V> \<equiv> (\<lambda>S. topspace X - S) ` \<U>"
     assume clo: "\<forall>C\<in>\<U>. closedin X C" and [simp]: "\<Inter>\<U> = {}"
     then have "\<forall>V \<in> \<V>. openin X V" "topspace X \<subseteq> \<Union>\<V>"
       by (auto simp: \<V>_def)
     moreover assume [unfolded compact_space_alt, rule_format, of \<V>]: "compact_space X"
     ultimately obtain \<F> where \<F>: "finite \<F>" "\<F> \<subseteq> \<U>" "topspace X \<subseteq> topspace X - \<Inter>\<F>"
       by (auto simp: ex_finite_subset_image \<V>_def)
     moreover have "\<F> \<noteq> {}"
       using \<F> \<open>topspace X \<noteq> {}\<close> by blast
     ultimately show "False"
       using * [of \<F>]
       by auto (metis Diff_iff Inter_iff clo closedin_def subsetD)
   next
     assume R [rule_format]: ?rhs
     show "compact_space X"
       unfolding compact_space_alt
     proof clarify
       fix \<U> :: "'a set set"
       define \<V> where "\<V> \<equiv> (\<lambda>S. topspace X - S) ` \<U>"
       assume "\<forall>C\<in>\<U>. openin X C" and "topspace X \<subseteq> \<Union>\<U>"
       with \<open>topspace X \<noteq> {}\<close> have *: "\<forall>V \<in> \<V>. closedin X V" "\<U> \<noteq> {}"
         by (auto simp: \<V>_def)
       show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace X \<subseteq> \<Union>\<F>"
       proof (rule ccontr; simp)
         assume "\<forall>\<F>\<subseteq>\<U>. finite \<F> \<longrightarrow> \<not> topspace X \<subseteq> \<Union>\<F>"
         then have "\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<V> \<longrightarrow> \<Inter>\<F> \<noteq> {}"
           by (simp add: \<V>_def all_finite_subset_image)
         with \<open>topspace X \<subseteq> \<Union>\<U>\<close> show False
           using R [of \<V>] * by (simp add: \<V>_def)
       qed
     qed
   qed
 qed
 
 corollary compactin_fip:
   "compactin X S \<longleftrightarrow>
     S \<subseteq> topspace X \<and>
     (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"
 proof (cases "S = {}")
   case False
   show ?thesis
   proof (cases "S \<subseteq> topspace X")
     case True
     then have "compactin X S \<longleftrightarrow>
           (\<forall>\<U>. \<U> \<subseteq> (\<lambda>T. S \<inter> T) ` {T. closedin X T} \<longrightarrow>
            (\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter>\<U> \<noteq> {})"
       by (simp add: compact_space_fip compactin_subspace closedin_subtopology image_def subset_eq Int_commute imp_conjL)
     also have "\<dots> = (\<forall>\<U>\<subseteq>Collect (closedin X). (\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> (\<inter>) S ` \<U> \<longrightarrow> \<Inter>\<F> \<noteq> {}) \<longrightarrow> \<Inter> ((\<inter>) S ` \<U>) \<noteq> {})"
       by (simp add: all_subset_image)
     also have "\<dots> = (\<forall>\<U>. (\<forall>C\<in>\<U>. closedin X C) \<and> (\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"
     proof -
       have eq: "((\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> \<Inter> ((\<inter>) S ` \<F>) \<noteq> {}) \<longrightarrow> \<Inter> ((\<inter>) S ` \<U>) \<noteq> {}) \<longleftrightarrow>
                 ((\<forall>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<longrightarrow> S \<inter> \<Inter>\<F> \<noteq> {}) \<longrightarrow> S \<inter> \<Inter>\<U> \<noteq> {})"  for \<U>
         by simp (use \<open>S \<noteq> {}\<close> in blast)
       show ?thesis
         unfolding imp_conjL [symmetric] all_finite_subset_image eq by blast
     qed
     finally show ?thesis
       using True by simp
   qed (simp add: compactin_subspace)
 qed force
 
 corollary compact_space_imp_nest:
   fixes C :: "nat \<Rightarrow> 'a set"
   assumes "compact_space X" and clo: "\<And>n. closedin X (C n)"
     and ne: "\<And>n. C n \<noteq> {}" and dec: "decseq C"
   shows "(\<Inter>n. C n) \<noteq> {}"
 proof -
   let ?\<U> = "range (\<lambda>n. \<Inter>m \<le> n. C m)"
   have "closedin X A" if "A \<in> ?\<U>" for A
     using that clo by auto
   moreover have "(\<Inter>n\<in>K. \<Inter>m \<le> n. C m) \<noteq> {}" if "finite K" for K
   proof -
     obtain n where "\<And>k. k \<in> K \<Longrightarrow> k \<le> n"
       using Max.coboundedI \<open>finite K\<close> by blast
     with dec have "C n \<subseteq> (\<Inter>n\<in>K. \<Inter>m \<le> n. C m)"
       unfolding decseq_def by blast
   with ne [of n] show ?thesis
     by blast
   qed
   ultimately show ?thesis
     using \<open>compact_space X\<close> [unfolded compact_space_fip, rule_format, of ?\<U>]
     by (simp add: all_finite_subset_image INT_extend_simps UN_atMost_UNIV del: INT_simps)
 qed
 
 lemma compactin_discrete_topology:
    "compactin (discrete_topology X) S \<longleftrightarrow> S \<subseteq> X \<and> finite S" (is "?lhs = ?rhs")
 proof (intro iffI conjI)
   assume L: ?lhs
   then show "S \<subseteq> X"
     by (auto simp: compactin_def)
   have *: "\<And>\<U>. Ball \<U> (openin (discrete_topology X)) \<and> S \<subseteq> \<Union>\<U> \<Longrightarrow>
         (\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>)"
     using L by (auto simp: compactin_def)
   show "finite S"
     using * [of "(\<lambda>x. {x}) ` X"] \<open>S \<subseteq> X\<close>
     by clarsimp (metis UN_singleton finite_subset_image infinite_super)
 next
   assume ?rhs
   then show ?lhs
     by (simp add: finite_imp_compactin)
 qed
 
 lemma compact_space_discrete_topology: "compact_space(discrete_topology X) \<longleftrightarrow> finite X"
   by (simp add: compactin_discrete_topology compact_space_def)
 
 lemma compact_space_imp_Bolzano_Weierstrass:
   assumes "compact_space X" "infinite S" "S \<subseteq> topspace X"
   shows "X derived_set_of S \<noteq> {}"
 proof
   assume X: "X derived_set_of S = {}"
   then have "closedin X S"
     by (simp add: closedin_contains_derived_set assms)
   then have "compactin X S"
     by (rule closedin_compact_space [OF \<open>compact_space X\<close>])
   with X show False
     by (metis \<open>infinite S\<close> compactin_subspace compact_space_discrete_topology inf_bot_right subtopology_eq_discrete_topology_eq)
 qed
 
 lemma compactin_imp_Bolzano_Weierstrass:
    "\<lbrakk>compactin X S; infinite T \<and> T \<subseteq> S\<rbrakk> \<Longrightarrow> S \<inter> X derived_set_of T \<noteq> {}"
   using compact_space_imp_Bolzano_Weierstrass [of "subtopology X S"]
   by (simp add: compactin_subspace derived_set_of_subtopology inf_absorb2)
 
 lemma compact_closure_of_imp_Bolzano_Weierstrass:
    "\<lbrakk>compactin X (X closure_of S); infinite T; T \<subseteq> S; T \<subseteq> topspace X\<rbrakk> \<Longrightarrow> X derived_set_of T \<noteq> {}"
   using closure_of_mono closure_of_subset compactin_imp_Bolzano_Weierstrass by fastforce
 
 lemma discrete_compactin_eq_finite:
    "S \<inter> X derived_set_of S = {} \<Longrightarrow> compactin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> finite S"
   by (meson compactin_imp_Bolzano_Weierstrass finite_imp_compactin_eq order_refl)
 
 lemma discrete_compact_space_eq_finite:
    "X derived_set_of (topspace X) = {} \<Longrightarrow> (compact_space X \<longleftrightarrow> finite(topspace X))"
   by (metis compact_space_discrete_topology discrete_topology_unique_derived_set)
 
 lemma image_compactin:
   assumes cpt: "compactin X S" and cont: "continuous_map X Y f"
   shows "compactin Y (f ` S)"
   unfolding compactin_def
 proof (intro conjI allI impI)
   show "f ` S \<subseteq> topspace Y"
     using compactin_subset_topspace cont continuous_map_image_subset_topspace cpt by blast
 next
   fix \<U> :: "'b set set"
   assume \<U>: "Ball \<U> (openin Y) \<and> f ` S \<subseteq> \<Union>\<U>"
   define \<V> where "\<V> \<equiv> (\<lambda>U. {x \<in> topspace X. f x \<in> U}) ` \<U>"
   have "S \<subseteq> topspace X"
     and *: "\<And>\<U>. \<lbrakk>\<forall>U\<in>\<U>. openin X U; S \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow> \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> S \<subseteq> \<Union>\<F>"
     using cpt by (auto simp: compactin_def)
   obtain \<F> where \<F>: "finite \<F>" "\<F> \<subseteq> \<V>" "S \<subseteq> \<Union>\<F>"
   proof -
     have 1: "\<forall>U\<in>\<V>. openin X U"
       unfolding \<V>_def using \<U> cont[unfolded continuous_map] by blast
     have 2: "S \<subseteq> \<Union>\<V>"
       unfolding \<V>_def using compactin_subset_topspace cpt \<U> by fastforce
     show thesis
       using * [OF 1 2] that by metis
   qed
   have "\<forall>v \<in> \<V>. \<exists>U. U \<in> \<U> \<and> v = {x \<in> topspace X. f x \<in> U}"
     using \<V>_def by blast
   then obtain U where U: "\<forall>v \<in> \<V>. U v \<in> \<U> \<and> v = {x \<in> topspace X. f x \<in> U v}"
     by metis
   show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> f ` S \<subseteq> \<Union>\<F>"
   proof (intro conjI exI)
     show "finite (U ` \<F>)"
       by (simp add: \<open>finite \<F>\<close>)
   next
     show "U ` \<F> \<subseteq> \<U>"
       using \<open>\<F> \<subseteq> \<V>\<close> U by auto
   next
     show "f ` S \<subseteq> \<Union> (U ` \<F>)"
       using \<F>(2-3) U UnionE subset_eq U by fastforce
   qed
 qed
 
 
 lemma homeomorphic_compact_space:
   assumes "X homeomorphic_space Y"
   shows "compact_space X \<longleftrightarrow> compact_space Y"
     using homeomorphic_space_sym
     by (metis assms compact_space_def homeomorphic_eq_everything_map homeomorphic_space image_compactin)
 
 lemma homeomorphic_map_compactness:
   assumes hom: "homeomorphic_map X Y f" and U: "U \<subseteq> topspace X"
   shows "compactin Y (f ` U) \<longleftrightarrow> compactin X U"
 proof -
   have "f ` U \<subseteq> topspace Y"
     using hom U homeomorphic_imp_surjective_map by blast
   moreover have "homeomorphic_map (subtopology X U) (subtopology Y (f ` U)) f"
     using U hom homeomorphic_imp_surjective_map by (blast intro: homeomorphic_map_subtopologies)
   then have "compact_space (subtopology Y (f ` U)) = compact_space (subtopology X U)"
     using homeomorphic_compact_space homeomorphic_map_imp_homeomorphic_space by blast
   ultimately show ?thesis
     by (simp add: compactin_subspace U)
 qed
 
 lemma homeomorphic_map_compactness_eq:
    "homeomorphic_map X Y f
         \<Longrightarrow> compactin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> compactin Y (f ` U)"
   by (meson compactin_subset_topspace homeomorphic_map_compactness)
 
 
 subsection\<open>Embedding maps\<close>
 
 definition embedding_map
   where "embedding_map X Y f \<equiv> homeomorphic_map X (subtopology Y (f ` (topspace X))) f"
 
 lemma embedding_map_eq:
    "\<lbrakk>embedding_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> embedding_map X Y g"
   unfolding embedding_map_def
   by (metis homeomorphic_map_eq image_cong)
 
 lemma embedding_map_compose:
   assumes "embedding_map X X' f" "embedding_map X' X'' g"
   shows "embedding_map X X'' (g \<circ> f)"
 proof -
   have hm: "homeomorphic_map X (subtopology X' (f ` topspace X)) f" "homeomorphic_map X' (subtopology X'' (g ` topspace X')) g"
     using assms by (auto simp: embedding_map_def)
   then obtain C where "g ` topspace X' \<inter> C = (g \<circ> f) ` topspace X"
     by (metis homeomorphic_imp_surjective_map image_comp image_mono inf.absorb_iff2 topspace_subtopology)
   then have "homeomorphic_map (subtopology X' (f ` topspace X)) (subtopology X'' ((g \<circ> f) ` topspace X)) g"
     by (metis hm homeomorphic_imp_surjective_map homeomorphic_map_subtopologies image_comp subtopology_subtopology topspace_subtopology)
   then show ?thesis
   unfolding embedding_map_def
   using hm(1) homeomorphic_map_compose by blast
 qed
 
 lemma surjective_embedding_map:
    "embedding_map X Y f \<and> f ` (topspace X) = topspace Y \<longleftrightarrow> homeomorphic_map X Y f"
   by (force simp: embedding_map_def homeomorphic_eq_everything_map)
 
 lemma embedding_map_in_subtopology:
    "embedding_map X (subtopology Y S) f \<longleftrightarrow> embedding_map X Y f \<and> f ` (topspace X) \<subseteq> S"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     unfolding embedding_map_def
     by (metis continuous_map_in_subtopology homeomorphic_imp_continuous_map inf_absorb2 subtopology_subtopology)
 qed (simp add: embedding_map_def inf.absorb_iff2 subtopology_subtopology)
 
 lemma injective_open_imp_embedding_map:
    "\<lbrakk>continuous_map X Y f; open_map X Y f; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> embedding_map X Y f"
   unfolding embedding_map_def
   by (simp add: continuous_map_in_subtopology continuous_open_quotient_map eq_iff homeomorphic_map_def open_map_imp_subset open_map_into_subtopology)
 
 lemma injective_closed_imp_embedding_map:
   "\<lbrakk>continuous_map X Y f; closed_map X Y f; inj_on f (topspace X)\<rbrakk> \<Longrightarrow> embedding_map X Y f"
   unfolding embedding_map_def
   by (simp add: closed_map_imp_subset closed_map_into_subtopology continuous_closed_quotient_map 
                 continuous_map_in_subtopology dual_order.eq_iff homeomorphic_map_def)
 
 lemma embedding_map_imp_homeomorphic_space:
    "embedding_map X Y f \<Longrightarrow> X homeomorphic_space (subtopology Y (f ` (topspace X)))"
   unfolding embedding_map_def
   using homeomorphic_space by blast
 
 lemma embedding_imp_closed_map:
    "\<lbrakk>embedding_map X Y f; closedin Y (f ` topspace X)\<rbrakk> \<Longrightarrow> closed_map X Y f"
   unfolding closed_map_def
   by (auto simp: closedin_closed_subtopology embedding_map_def homeomorphic_map_closedness_eq)
 
 lemma embedding_imp_closed_map_eq:
    "embedding_map X Y f \<Longrightarrow> (closed_map X Y f \<longleftrightarrow> closedin Y (f ` topspace X))"
   using closed_map_def embedding_imp_closed_map by blast
 
 
 subsection\<open>Retraction and section maps\<close>
 
 definition retraction_maps :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> bool"
   where "retraction_maps X Y f g \<equiv>
            continuous_map X Y f \<and> continuous_map Y X g \<and> (\<forall>x \<in> topspace Y. f(g x) = x)"
 
 definition section_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "section_map X Y f \<equiv> \<exists>g. retraction_maps Y X g f"
 
 definition retraction_map :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "retraction_map X Y f \<equiv> \<exists>g. retraction_maps X Y f g"
 
 lemma retraction_maps_eq:
    "\<lbrakk>retraction_maps X Y f g; \<And>x. x \<in> topspace X \<Longrightarrow> f x = f' x; \<And>x. x \<in> topspace Y \<Longrightarrow> g x = g' x\<rbrakk>
         \<Longrightarrow> retraction_maps X Y f' g'"
   unfolding retraction_maps_def by (metis (no_types, lifting) continuous_map_def continuous_map_eq)
 
 lemma section_map_eq:
    "\<lbrakk>section_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> section_map X Y g"
   unfolding section_map_def using retraction_maps_eq by blast
 
 lemma retraction_map_eq:
    "\<lbrakk>retraction_map X Y f; \<And>x. x \<in> topspace X \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> retraction_map X Y g"
   unfolding retraction_map_def using retraction_maps_eq by blast
 
 lemma homeomorphic_imp_retraction_maps:
    "homeomorphic_maps X Y f g \<Longrightarrow> retraction_maps X Y f g"
   by (simp add: homeomorphic_maps_def retraction_maps_def)
 
 lemma section_and_retraction_eq_homeomorphic_map:
    "section_map X Y f \<and> retraction_map X Y f \<longleftrightarrow> homeomorphic_map X Y f"  (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain g where "homeomorphic_maps X Y f g"
     unfolding homeomorphic_maps_def retraction_map_def section_map_def
     by (smt (verit, best) continuous_map_def retraction_maps_def)
   then show ?rhs
     using homeomorphic_map_maps by blast
 next
   assume ?rhs
   then show ?lhs
     unfolding retraction_map_def section_map_def
     by (meson homeomorphic_imp_retraction_maps homeomorphic_map_maps homeomorphic_maps_sym)
 qed
 
 lemma section_imp_embedding_map:
    "section_map X Y f \<Longrightarrow> embedding_map X Y f"
   unfolding section_map_def embedding_map_def homeomorphic_map_maps retraction_maps_def homeomorphic_maps_def
   by (force simp: continuous_map_in_subtopology continuous_map_from_subtopology)
 
 lemma retraction_imp_quotient_map:
   assumes "retraction_map X Y f"
   shows "quotient_map X Y f"
   unfolding quotient_map_def
 proof (intro conjI subsetI allI impI)
   show "f ` topspace X = topspace Y"
     using assms by (force simp: retraction_map_def retraction_maps_def continuous_map_def)
 next
   fix U
   assume U: "U \<subseteq> topspace Y"
   have "openin Y U"
     if "\<forall>x\<in>topspace Y. g x \<in> topspace X" "\<forall>x\<in>topspace Y. f (g x) = x"
        "openin Y {x \<in> topspace Y. g x \<in> {x \<in> topspace X. f x \<in> U}}" for g
     using openin_subopen U that by fastforce
   then show "openin X {x \<in> topspace X. f x \<in> U} = openin Y U"
     using assms by (auto simp: retraction_map_def retraction_maps_def continuous_map_def)
 qed
 
 lemma retraction_maps_compose:
    "\<lbrakk>retraction_maps X Y f f'; retraction_maps Y Z g g'\<rbrakk> \<Longrightarrow> retraction_maps X Z (g \<circ> f) (f' \<circ> g')"
   by (clarsimp simp: retraction_maps_def continuous_map_compose) (simp add: continuous_map_def)
 
 lemma retraction_map_compose:
    "\<lbrakk>retraction_map X Y f; retraction_map Y Z g\<rbrakk> \<Longrightarrow> retraction_map X Z (g \<circ> f)"
   by (meson retraction_map_def retraction_maps_compose)
 
 lemma section_map_compose:
    "\<lbrakk>section_map X Y f; section_map Y Z g\<rbrakk> \<Longrightarrow> section_map X Z (g \<circ> f)"
   by (meson retraction_maps_compose section_map_def)
 
 lemma surjective_section_eq_homeomorphic_map:
    "section_map X Y f \<and> f ` (topspace X) = topspace Y \<longleftrightarrow> homeomorphic_map X Y f"
   by (meson section_and_retraction_eq_homeomorphic_map section_imp_embedding_map surjective_embedding_map)
 
 lemma surjective_retraction_or_section_map:
    "f ` (topspace X) = topspace Y \<Longrightarrow> retraction_map X Y f \<or> section_map X Y f \<longleftrightarrow> retraction_map X Y f"
   using section_and_retraction_eq_homeomorphic_map surjective_section_eq_homeomorphic_map by fastforce
 
 lemma retraction_imp_surjective_map:
    "retraction_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: retraction_imp_quotient_map quotient_imp_surjective_map)
 
 lemma section_imp_injective_map:
    "\<lbrakk>section_map X Y f; x \<in> topspace X; y \<in> topspace X\<rbrakk> \<Longrightarrow> f x = f y \<longleftrightarrow> x = y"
   by (metis (mono_tags, opaque_lifting) retraction_maps_def section_map_def)
 
 lemma retraction_maps_to_retract_maps:
    "retraction_maps X Y r s
         \<Longrightarrow> retraction_maps X (subtopology X (s ` (topspace Y))) (s \<circ> r) id"
   unfolding retraction_maps_def
   by (auto simp: continuous_map_compose continuous_map_into_subtopology continuous_map_from_subtopology)
 subsection \<open>Continuity\<close>
 
 lemma continuous_on_open:
   "continuous_on S f \<longleftrightarrow>
     (\<forall>T. openin (top_of_set (f ` S)) T \<longrightarrow>
       openin (top_of_set S) (S \<inter> f -` T))"
   unfolding continuous_on_open_invariant openin_open Int_def vimage_def Int_commute
   by (simp add: imp_ex imageI conj_commute eq_commute cong: conj_cong)
 
 lemma continuous_on_closed:
   "continuous_on S f \<longleftrightarrow>
     (\<forall>T. closedin (top_of_set (f ` S)) T \<longrightarrow>
       closedin (top_of_set S) (S \<inter> f -` T))"
   unfolding continuous_on_closed_invariant closedin_closed Int_def vimage_def Int_commute
   by (simp add: imp_ex imageI conj_commute eq_commute cong: conj_cong)
 
 lemma continuous_on_imp_closedin:
   assumes "continuous_on S f" "closedin (top_of_set (f ` S)) T"
   shows "closedin (top_of_set S) (S \<inter> f -` T)"
   using assms continuous_on_closed by blast
 
 lemma continuous_map_subtopology_eu [simp]:
   "continuous_map (top_of_set S) (subtopology euclidean T) h \<longleftrightarrow> continuous_on S h \<and> h ` S \<subseteq> T"
   by (simp add: continuous_map_in_subtopology)
 
 lemma continuous_map_euclidean_top_of_set:
   assumes eq: "f -` S = UNIV" and cont: "continuous_on UNIV f"
   shows "continuous_map euclidean (top_of_set S) f"
   by (simp add: cont continuous_map_into_subtopology eq image_subset_iff_subset_vimage)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Half-global and completely global cases\<close>
 
 lemma continuous_openin_preimage_gen:
   assumes "continuous_on S f"  "open T"
   shows "openin (top_of_set S) (S \<inter> f -` T)"
 proof -
   have *: "(S \<inter> f -` T) = (S \<inter> f -` (T \<inter> f ` S))"
     by auto
   have "openin (top_of_set (f ` S)) (T \<inter> f ` S)"
     using openin_open_Int[of T "f ` S", OF assms(2)] unfolding openin_open by auto
   then show ?thesis
     using assms(1)[unfolded continuous_on_open, THEN spec[where x="T \<inter> f ` S"]]
     using * by auto
 qed
 
 lemma continuous_closedin_preimage:
   assumes "continuous_on S f" and "closed T"
   shows "closedin (top_of_set S) (S \<inter> f -` T)"
 proof -
   have *: "(S \<inter> f -` T) = (S \<inter> f -` (T \<inter> f ` S))"
     by auto
   have "closedin (top_of_set (f ` S)) (T \<inter> f ` S)"
     using closedin_closed_Int[of T "f ` S", OF assms(2)]
     by (simp add: Int_commute)
   then show ?thesis
     using assms(1)[unfolded continuous_on_closed, THEN spec[where x="T \<inter> f ` S"]]
     using * by auto
 qed
 
 lemma continuous_openin_preimage_eq:
    "continuous_on S f \<longleftrightarrow> (\<forall>T. open T \<longrightarrow> openin (top_of_set S) (S \<inter> f -` T))"
   by (metis Int_commute continuous_on_open_invariant open_openin openin_subtopology)
 
 lemma continuous_closedin_preimage_eq:
    "continuous_on S f \<longleftrightarrow>
     (\<forall>T. closed T \<longrightarrow> closedin (top_of_set S) (S \<inter> f -` T))"
   by (metis Int_commute closedin_closed continuous_on_closed_invariant)
 
 lemma continuous_open_preimage:
   assumes contf: "continuous_on S f" and "open S" "open T"
   shows "open (S \<inter> f -` T)"
 proof-
   obtain U where "open U" "(S \<inter> f -` T) = S \<inter> U"
     using continuous_openin_preimage_gen[OF contf \<open>open T\<close>]
     unfolding openin_open by auto
   then show ?thesis
     using open_Int[of S U, OF \<open>open S\<close>] by auto
 qed
 
 lemma continuous_closed_preimage:
   assumes contf: "continuous_on S f" and "closed S" "closed T"
   shows "closed (S \<inter> f -` T)"
 proof-
   obtain U where "closed U" "(S \<inter> f -` T) = S \<inter> U"
     using continuous_closedin_preimage[OF contf \<open>closed T\<close>]
     unfolding closedin_closed by auto
   then show ?thesis using closed_Int[of S U, OF \<open>closed S\<close>] by auto
 qed
 
 lemma continuous_open_vimage: "open S \<Longrightarrow> (\<And>x. continuous (at x) f) \<Longrightarrow> open (f -` S)"
   by (metis continuous_on_eq_continuous_within open_vimage) 
  
 lemma continuous_closed_vimage: "closed S \<Longrightarrow> (\<And>x. continuous (at x) f) \<Longrightarrow> closed (f -` S)"
   by (simp add: closed_vimage continuous_on_eq_continuous_within)
 
 lemma Times_in_interior_subtopology:
   assumes "(x, y) \<in> U" "openin (top_of_set (S \<times> T)) U"
   obtains V W where "openin (top_of_set S) V" "x \<in> V"
                     "openin (top_of_set T) W" "y \<in> W" "(V \<times> W) \<subseteq> U"
 proof -
   from assms obtain E where "open E" "U = S \<times> T \<inter> E" "(x, y) \<in> E" "x \<in> S" "y \<in> T"
     by (auto simp: openin_open)
   from open_prod_elim[OF \<open>open E\<close> \<open>(x, y) \<in> E\<close>]
   obtain E1 E2 where "open E1" "open E2" "(x, y) \<in> E1 \<times> E2" "E1 \<times> E2 \<subseteq> E"
     by blast
   show ?thesis
   proof
     show "openin (top_of_set S) (E1 \<inter> S)" "openin (top_of_set T) (E2 \<inter> T)"
       using \<open>open E1\<close> \<open>open E2\<close> by (auto simp: openin_open)
     show "x \<in> E1 \<inter> S" "y \<in> E2 \<inter> T"
       using \<open>(x, y) \<in> E1 \<times> E2\<close> \<open>x \<in> S\<close> \<open>y \<in> T\<close> by auto
     show "(E1 \<inter> S) \<times> (E2 \<inter> T) \<subseteq> U"
       using \<open>E1 \<times> E2 \<subseteq> E\<close> \<open>U = _\<close> by auto
   qed
 qed
 
 lemma closedin_Times:
   "closedin (top_of_set S) S' \<Longrightarrow> closedin (top_of_set T) T' \<Longrightarrow>
     closedin (top_of_set (S \<times> T)) (S' \<times> T')"
   unfolding closedin_closed using closed_Times by blast
 
 lemma openin_Times:
   "openin (top_of_set S) S' \<Longrightarrow> openin (top_of_set T) T' \<Longrightarrow>
     openin (top_of_set (S \<times> T)) (S' \<times> T')"
   unfolding openin_open using open_Times by blast
 
 lemma openin_Times_eq:
   fixes S :: "'a::topological_space set" and T :: "'b::topological_space set"
   shows
     "openin (top_of_set (S \<times> T)) (S' \<times> T') \<longleftrightarrow>
       S' = {} \<or> T' = {} \<or> openin (top_of_set S) S' \<and> openin (top_of_set T) T'"
     (is "?lhs = ?rhs")
 proof (cases "S' = {} \<or> T' = {}")
   case True
   then show ?thesis by auto
 next
   case False
   then obtain x y where "x \<in> S'" "y \<in> T'"
     by blast
   show ?thesis
   proof
     assume ?lhs
     have "openin (top_of_set S) S'"
     proof (subst openin_subopen, clarify)
       show "\<exists>U. openin (top_of_set S) U \<and> x \<in> U \<and> U \<subseteq> S'" if "x \<in> S'" for x
         using that \<open>y \<in> T'\<close> Times_in_interior_subtopology [OF _ \<open>?lhs\<close>, of x y]
         by simp (metis mem_Sigma_iff subsetD subsetI)
     qed
     moreover have "openin (top_of_set T) T'"
     proof (subst openin_subopen, clarify)
       show "\<exists>U. openin (top_of_set T) U \<and> y \<in> U \<and> U \<subseteq> T'" if "y \<in> T'" for y
         using that \<open>x \<in> S'\<close> Times_in_interior_subtopology [OF _ \<open>?lhs\<close>, of x y]
         by simp (metis mem_Sigma_iff subsetD subsetI)
     qed
     ultimately show ?rhs
       by simp
   next
     assume ?rhs
     with False show ?lhs
       by (simp add: openin_Times)
   qed
 qed
 
 lemma Lim_transform_within_openin:
   assumes f: "(f \<longlongrightarrow> l) (at a within T)"
     and "openin (top_of_set T) S" "a \<in> S"
     and eq: "\<And>x. \<lbrakk>x \<in> S; x \<noteq> a\<rbrakk> \<Longrightarrow> f x = g x"
   shows "(g \<longlongrightarrow> l) (at a within T)"
 proof -
   have "\<forall>\<^sub>F x in at a within T. x \<in> T \<and> x \<noteq> a"
     by (simp add: eventually_at_filter)
   moreover
   from \<open>openin _ _\<close> obtain U where "open U" "S = T \<inter> U"
     by (auto simp: openin_open)
   then have "a \<in> U" using \<open>a \<in> S\<close> by auto
   from topological_tendstoD[OF tendsto_ident_at \<open>open U\<close> \<open>a \<in> U\<close>]
   have "\<forall>\<^sub>F x in at a within T. x \<in> U" by auto
   ultimately
   have "\<forall>\<^sub>F x in at a within T. f x = g x"
     by eventually_elim (auto simp: \<open>S = _\<close> eq)
   with f show ?thesis
     by (rule Lim_transform_eventually)
 qed
 
 lemma continuous_on_open_gen:
   assumes "f ` S \<subseteq> T"
     shows "continuous_on S f \<longleftrightarrow>
              (\<forall>U. openin (top_of_set T) U
                   \<longrightarrow> openin (top_of_set S) (S \<inter> f -` U))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (clarsimp simp add: continuous_openin_preimage_eq openin_open)
       (metis Int_assoc assms image_subset_iff_subset_vimage inf.absorb_iff1)
 next
   assume R [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp add: continuous_openin_preimage_eq)
     fix U::"'a set"
     assume "open U"
     then have "openin (top_of_set S) (S \<inter> f -` (U \<inter> T))"
       by (metis R inf_commute openin_open)
     then show "openin (top_of_set S) (S \<inter> f -` U)"
       by (metis Int_assoc Int_commute assms image_subset_iff_subset_vimage inf.absorb_iff2 vimage_Int)
   qed
 qed
 
 lemma continuous_openin_preimage:
   "\<lbrakk>continuous_on S f; f ` S \<subseteq> T; openin (top_of_set T) U\<rbrakk>
         \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` U)"
   by (simp add: continuous_on_open_gen)
 
 lemma continuous_on_closed_gen:
   assumes "f ` S \<subseteq> T"
   shows "continuous_on S f \<longleftrightarrow>
              (\<forall>U. closedin (top_of_set T) U
                   \<longrightarrow> closedin (top_of_set S) (S \<inter> f -` U))"
 proof -
   have *: "U \<subseteq> T \<Longrightarrow> S \<inter> f -` (T - U) = S - (S \<inter> f -` U)" for U
     using assms by blast
   then show ?thesis
       unfolding continuous_on_open_gen [OF assms]
       by (metis closedin_def inf.cobounded1 openin_closedin_eq topspace_euclidean_subtopology)
 qed
 
 lemma continuous_closedin_preimage_gen:
   assumes "continuous_on S f" "f ` S \<subseteq> T" "closedin (top_of_set T) U"
     shows "closedin (top_of_set S) (S \<inter> f -` U)"
 using assms continuous_on_closed_gen by blast
 
 lemma continuous_transform_within_openin:
   assumes "continuous (at a within T) f"
     and "openin (top_of_set T) S" "a \<in> S"
     and eq: "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "continuous (at a within T) g"
   using assms by (simp add: Lim_transform_within_openin continuous_within)
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>The topology generated by some (open) subsets\<close>
 
 text \<open>In the definition below of a generated topology, the \<open>Empty\<close> case is not necessary,
 as it follows from \<open>UN\<close> taking for \<open>K\<close> the empty set. However, it is convenient to have,
 and is never a problem in proofs, so I prefer to write it down explicitly.
 
 We do not require \<open>UNIV\<close> to be an open set, as this will not be the case in applications. (We are
 thinking of a topology on a subset of \<open>UNIV\<close>, the remaining part of \<open>UNIV\<close> being irrelevant.)\<close>
 
 inductive generate_topology_on for S where
   Empty: "generate_topology_on S {}"
 | Int: "generate_topology_on S a \<Longrightarrow> generate_topology_on S b \<Longrightarrow> generate_topology_on S (a \<inter> b)"
 | UN: "(\<And>k. k \<in> K \<Longrightarrow> generate_topology_on S k) \<Longrightarrow> generate_topology_on S (\<Union>K)"
 | Basis: "s \<in> S \<Longrightarrow> generate_topology_on S s"
 
 lemma istopology_generate_topology_on:
   "istopology (generate_topology_on S)"
 unfolding istopology_def by (auto intro: generate_topology_on.intros)
 
 text \<open>The basic property of the topology generated by a set \<open>S\<close> is that it is the
 smallest topology containing all the elements of \<open>S\<close>:\<close>
 
 lemma generate_topology_on_coarsest:
   assumes T: "istopology T" "\<And>s. s \<in> S \<Longrightarrow> T s"
           and gen: "generate_topology_on S s0"
   shows "T s0"
   using gen 
 by (induct rule: generate_topology_on.induct) (use T in \<open>auto simp: istopology_def\<close>)
 
 abbreviation\<^marker>\<open>tag unimportant\<close> topology_generated_by::"('a set set) \<Rightarrow> ('a topology)"
   where "topology_generated_by S \<equiv> topology (generate_topology_on S)"
 
 lemma openin_topology_generated_by_iff:
   "openin (topology_generated_by S) s \<longleftrightarrow> generate_topology_on S s"
   using topology_inverse'[OF istopology_generate_topology_on[of S]] by simp
 
 lemma openin_topology_generated_by:
   "openin (topology_generated_by S) s \<Longrightarrow> generate_topology_on S s"
 using openin_topology_generated_by_iff by auto
 
 lemma topology_generated_by_topspace [simp]:
   "topspace (topology_generated_by S) = (\<Union>S)"
 proof
   {
     fix s assume "openin (topology_generated_by S) s"
     then have "generate_topology_on S s" by (rule openin_topology_generated_by)
     then have "s \<subseteq> (\<Union>S)" by (induct, auto)
   }
   then show "topspace (topology_generated_by S) \<subseteq> (\<Union>S)"
     unfolding topspace_def by auto
 next
   have "generate_topology_on S (\<Union>S)"
     using generate_topology_on.UN[OF generate_topology_on.Basis, of S S] by simp
   then show "(\<Union>S) \<subseteq> topspace (topology_generated_by S)"
     unfolding topspace_def using openin_topology_generated_by_iff by auto
 qed
 
 lemma topology_generated_by_Basis:
   "s \<in> S \<Longrightarrow> openin (topology_generated_by S) s"
   by (simp add: Basis openin_topology_generated_by_iff)
 
 lemma generate_topology_on_Inter:
   "\<lbrakk>finite \<F>; \<And>K. K \<in> \<F> \<Longrightarrow> generate_topology_on \<S> K; \<F> \<noteq> {}\<rbrakk> \<Longrightarrow> generate_topology_on \<S> (\<Inter>\<F>)"
   by (induction \<F> rule: finite_induct; force intro: generate_topology_on.intros)
 
 subsection\<open>Topology bases and sub-bases\<close>
 
 lemma istopology_base_alt:
    "istopology (arbitrary union_of P) \<longleftrightarrow>
     (\<forall>S T. (arbitrary union_of P) S \<and> (arbitrary union_of P) T
            \<longrightarrow> (arbitrary union_of P) (S \<inter> T))"
   by (simp add: istopology_def) (blast intro: arbitrary_union_of_Union)
 
 lemma istopology_base_eq:
    "istopology (arbitrary union_of P) \<longleftrightarrow>
     (\<forall>S T. P S \<and> P T \<longrightarrow> (arbitrary union_of P) (S \<inter> T))"
   by (simp add: istopology_base_alt arbitrary_union_of_Int_eq)
 
 lemma istopology_base:
    "(\<And>S T. \<lbrakk>P S; P T\<rbrakk> \<Longrightarrow> P(S \<inter> T)) \<Longrightarrow> istopology (arbitrary union_of P)"
   by (simp add: arbitrary_def istopology_base_eq union_of_inc)
 
 lemma openin_topology_base_unique:
    "openin X = arbitrary union_of P \<longleftrightarrow>
         (\<forall>V. P V \<longrightarrow> openin X V) \<and> (\<forall>U x. openin X U \<and> x \<in> U \<longrightarrow> (\<exists>V. P V \<and> x \<in> V \<and> V \<subseteq> U))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: union_of_def arbitrary_def)
 next
   assume R: ?rhs
   then have *: "\<exists>\<U>\<subseteq>Collect P. \<Union>\<U> = S" if "openin X S" for S
     using that by (rule_tac x="{V. P V \<and> V \<subseteq> S}" in exI) fastforce
   from R show ?lhs
     by (fastforce simp add: union_of_def arbitrary_def intro: *)
 qed
 
 lemma topology_base_unique:
   assumes "\<And>S. P S \<Longrightarrow> openin X S"
           "\<And>U x. \<lbrakk>openin X U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>B. P B \<and> x \<in> B \<and> B \<subseteq> U"
   shows   "topology (arbitrary union_of P) = X"
 proof -
   have "X = topology (openin X)"
     by (simp add: openin_inverse)
   also from assms have "openin X = arbitrary union_of P"
     by (subst openin_topology_base_unique) auto
   finally show ?thesis ..
 qed
 
 lemma topology_bases_eq_aux:
    "\<lbrakk>(arbitrary union_of P) S;
      \<And>U x. \<lbrakk>P U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>V. Q V \<and> x \<in> V \<and> V \<subseteq> U\<rbrakk>
         \<Longrightarrow> (arbitrary union_of Q) S"
   by (metis arbitrary_union_of_alt arbitrary_union_of_idempot)
 
 lemma topology_bases_eq:
    "\<lbrakk>\<And>U x. \<lbrakk>P U; x \<in> U\<rbrakk> \<Longrightarrow> \<exists>V. Q V \<and> x \<in> V \<and> V \<subseteq> U;
     \<And>V x. \<lbrakk>Q V; x \<in> V\<rbrakk> \<Longrightarrow> \<exists>U. P U \<and> x \<in> U \<and> U \<subseteq> V\<rbrakk>
         \<Longrightarrow> topology (arbitrary union_of P) =
             topology (arbitrary union_of Q)"
   by (fastforce intro:  arg_cong [where f=topology]  elim: topology_bases_eq_aux)
 
 lemma istopology_subbase:
    "istopology (arbitrary union_of (finite intersection_of P relative_to S))"
   by (simp add: finite_intersection_of_Int istopology_base relative_to_Int)
 
 lemma openin_subbase:
   "openin (topology (arbitrary union_of (finite intersection_of B relative_to U))) S
    \<longleftrightarrow> (arbitrary union_of (finite intersection_of B relative_to U)) S"
   by (simp add: istopology_subbase topology_inverse')
 
 lemma topspace_subbase [simp]:
    "topspace(topology (arbitrary union_of (finite intersection_of B relative_to U))) = U" (is "?lhs = _")
 proof
   show "?lhs \<subseteq> U"
     by (metis arbitrary_union_of_relative_to openin_subbase openin_topspace relative_to_imp_subset)
   show "U \<subseteq> ?lhs"
     by (metis arbitrary_union_of_inc finite_intersection_of_empty inf.orderE istopology_subbase 
               openin_subset relative_to_inc subset_UNIV topology_inverse')
 qed
 
 lemma minimal_topology_subbase:
   assumes X: "\<And>S. P S \<Longrightarrow> openin X S" and "openin X U"
   and S: "openin(topology(arbitrary union_of (finite intersection_of P relative_to U))) S"
 shows "openin X S"
 proof -
   have "(arbitrary union_of (finite intersection_of P relative_to U)) S"
     using S openin_subbase by blast
   with X \<open>openin X U\<close> show ?thesis
     by (force simp add: union_of_def intersection_of_def relative_to_def intro: openin_Int_Inter)
 qed
 
 lemma istopology_subbase_UNIV:
    "istopology (arbitrary union_of (finite intersection_of P))"
   by (simp add: istopology_base finite_intersection_of_Int)
 
 
 lemma generate_topology_on_eq:
   "generate_topology_on S = arbitrary union_of finite' intersection_of (\<lambda>x. x \<in> S)" (is "?lhs = ?rhs")
 proof (intro ext iffI)
   fix A
   assume "?lhs A"
   then show "?rhs A"
   proof induction
     case (Int a b)
     then show ?case
       by (metis (mono_tags, lifting) istopology_base_alt finite'_intersection_of_Int istopology_base)
   next
     case (UN K)
     then show ?case
       by (simp add: arbitrary_union_of_Union)
   next
     case (Basis s)
     then show ?case
       by (simp add: Sup_upper arbitrary_union_of_inc finite'_intersection_of_inc relative_to_subset)
   qed auto
 next
   fix A
   assume "?rhs A"
   then obtain \<U> where \<U>: "\<And>T. T \<in> \<U> \<Longrightarrow> \<exists>\<F>. finite' \<F> \<and> \<F> \<subseteq> S \<and> \<Inter>\<F> = T" and eq: "A = \<Union>\<U>"
     unfolding union_of_def intersection_of_def by auto
   show "?lhs A"
     unfolding eq
   proof (rule generate_topology_on.UN)
     fix T
     assume "T \<in> \<U>"
     with \<U> obtain \<F> where "finite' \<F>" "\<F> \<subseteq> S" "\<Inter>\<F> = T"
       by blast
     have "generate_topology_on S (\<Inter>\<F>)"
     proof (rule generate_topology_on_Inter)
       show "finite \<F>" "\<F> \<noteq> {}"
         by (auto simp: \<open>finite' \<F>\<close>)
       show "\<And>K. K \<in> \<F> \<Longrightarrow> generate_topology_on S K"
         by (metis \<open>\<F> \<subseteq> S\<close> generate_topology_on.simps subset_iff)
     qed
     then show "generate_topology_on S T"
       using \<open>\<Inter>\<F> = T\<close> by blast
   qed
 qed
 
 lemma continuous_on_generated_topo_iff:
   "continuous_map T1 (topology_generated_by S) f \<longleftrightarrow>
       ((\<forall>U. U \<in> S \<longrightarrow> openin T1 (f-`U \<inter> topspace(T1))) \<and> (f`(topspace T1) \<subseteq> (\<Union> S)))"
 unfolding continuous_map_alt topology_generated_by_topspace
 proof (auto simp add: topology_generated_by_Basis)
   assume H: "\<forall>U. U \<in> S \<longrightarrow> openin T1 (f -` U \<inter> topspace T1)"
   fix U assume "openin (topology_generated_by S) U"
   then have "generate_topology_on S U" by (rule openin_topology_generated_by)
   then show "openin T1 (f -` U \<inter> topspace T1)"
   proof (induct)
     fix a b
     assume H: "openin T1 (f -` a \<inter> topspace T1)" "openin T1 (f -` b \<inter> topspace T1)"
     have "f -` (a \<inter> b) \<inter> topspace T1 = (f-`a \<inter> topspace T1) \<inter> (f-`b \<inter> topspace T1)"
       by auto
     then show "openin T1 (f -` (a \<inter> b) \<inter> topspace T1)" using H by auto
   next
     fix K
     assume H: "openin T1 (f -` k \<inter> topspace T1)" if "k\<in> K" for k
     define L where "L = {f -` k \<inter> topspace T1|k. k \<in> K}"
     have *: "openin T1 l" if "l \<in>L" for l using that H unfolding L_def by auto
     have "openin T1 (\<Union>L)" using openin_Union[OF *] by simp
     moreover have "(\<Union>L) = (f -` \<Union>K \<inter> topspace T1)" unfolding L_def by auto
     ultimately show "openin T1 (f -` \<Union>K \<inter> topspace T1)" by simp
   qed (auto simp add: H)
 qed
 
 lemma continuous_on_generated_topo:
   assumes "\<And>U. U \<in>S \<Longrightarrow> openin T1 (f-`U \<inter> topspace(T1))"
           "f`(topspace T1) \<subseteq> (\<Union> S)"
   shows "continuous_map T1 (topology_generated_by S) f"
   using assms continuous_on_generated_topo_iff by blast
 
 
 subsection\<open>Continuity via bases/subbases, hence upper and lower semicontinuity\<close>
 
 lemma continuous_map_into_topology_base:
   assumes P: "openin Y = arbitrary union_of P"
     and f: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     and ope: "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   shows "continuous_map X Y f"
 proof -
   have *: "\<And>\<U>. (\<And>t. t \<in> \<U> \<Longrightarrow> P t) \<Longrightarrow> openin X {x \<in> topspace X. \<exists>U\<in>\<U>. f x \<in> U}"
     by (smt (verit) Ball_Collect ope mem_Collect_eq openin_subopen)
   show ?thesis
     using P by (auto simp: continuous_map_def arbitrary_def union_of_def intro!: f *)
 qed
 
 lemma continuous_map_into_topology_base_eq:
   assumes P: "openin Y = arbitrary union_of P"
   shows
    "continuous_map X Y f \<longleftrightarrow>
     (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and> (\<forall>U. P U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
  (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   then have "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     by (meson continuous_map_def)
   moreover have "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
     using L assms continuous_map openin_topology_base_unique by fastforce
   ultimately show ?rhs by auto
 qed (simp add: assms continuous_map_into_topology_base)
 
 lemma continuous_map_into_topology_subbase:
   fixes U P
   defines "Y \<equiv> topology(arbitrary union_of (finite intersection_of P relative_to U))"
   assumes f: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
     and ope: "\<And>U. P U \<Longrightarrow> openin X {x \<in> topspace X. f x \<in> U}"
   shows "continuous_map X Y f"
 proof (intro continuous_map_into_topology_base)
   show "openin Y = arbitrary union_of (finite intersection_of P relative_to U)"
     unfolding Y_def using istopology_subbase topology_inverse' by blast
   show "openin X {x \<in> topspace X. f x \<in> V}"
     if \<section>: "(finite intersection_of P relative_to U) V" for V 
   proof -
     define finv where "finv \<equiv> \<lambda>V. {x \<in> topspace X. f x \<in> V}"
     obtain \<U> where \<U>: "finite \<U>" "\<And>V. V \<in> \<U> \<Longrightarrow> P V"
                       "{x \<in> topspace X. f x \<in> V} = (\<Inter>V \<in> insert U \<U>. finv V)"
       using \<section> by (fastforce simp: finv_def intersection_of_def relative_to_def)
     show ?thesis
       unfolding \<U>
     proof (intro openin_Inter ope)
       have U: "U = topspace Y"
         unfolding Y_def using topspace_subbase by fastforce
       fix V
       assume V: "V \<in> finv ` insert U \<U>"
       with U f have "openin X {x \<in> topspace X. f x \<in> U}"
         by (auto simp: openin_subopen [of X "Collect _"])
       then show "openin X V"
         using V \<U>(2) ope by (fastforce simp: finv_def)
     qed (use \<open>finite \<U>\<close> in auto)
   qed
 qed (use f in auto)
 
 lemma continuous_map_into_topology_subbase_eq:
   assumes "Y = topology(arbitrary union_of (finite intersection_of P relative_to U))"
   shows
    "continuous_map X Y f \<longleftrightarrow>
     (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and> (\<forall>U. P U \<longrightarrow> openin X {x \<in> topspace X. f x \<in> U})"
    (is "?lhs=?rhs")
 proof
   assume L: ?lhs 
   show ?rhs
   proof (intro conjI strip)
     show "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> topspace Y"
       using L continuous_map_def by fastforce
     fix V
     assume "P V"
     have "U = topspace Y"
       unfolding assms using topspace_subbase by fastforce
     then have eq: "{x \<in> topspace X. f x \<in> V} = {x \<in> topspace X. f x \<in> U \<inter> V}"
       using L by (auto simp: continuous_map)
     have "openin Y (U \<inter> V)"
       unfolding assms openin_subbase
       by (meson \<open>P V\<close> arbitrary_union_of_inc finite_intersection_of_inc relative_to_inc)
     show "openin X {x \<in> topspace X. f x \<in> V}"
       using L \<open>openin Y (U \<inter> V)\<close> continuous_map eq by fastforce
   qed
 next
   show "?rhs \<Longrightarrow> ?lhs"
     unfolding assms
     by (intro continuous_map_into_topology_subbase) auto
 qed 
 
 lemma subbase_subtopology_euclidean:
   fixes U :: "'a::order_topology set"
   shows
   "topology
     (arbitrary union_of
       (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<union> range lessThan) relative_to U))
  = subtopology euclidean U"
 proof -
   have "\<exists>V. (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)) V \<and> x \<in> V \<and> V \<subseteq> W"
     if "open W" "x \<in> W" for W and x::'a
     using \<open>open W\<close> [unfolded open_generated_order] \<open>x \<in> W\<close>
   proof (induct rule: generate_topology.induct)
     case UNIV
     then show ?case
       using finite_intersection_of_empty by blast
   next
     case (Int a b)
     then show ?case 
         by (meson Int_iff finite_intersection_of_Int inf_mono)
   next
     case (UN K)
     then show ?case
       by (meson Union_iff subset_iff)
   next
     case (Basis s)
     then show ?case
       by (metis (no_types, lifting) Un_iff finite_intersection_of_inc order_refl)
   qed
   moreover 
   have "\<And>V::'a set. (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)) V \<Longrightarrow> open V"
     by (force simp: intersection_of_def subset_iff)
   ultimately have *: "openin (euclidean::'a topology) = 
            (arbitrary union_of (finite intersection_of (\<lambda>x. x \<in> range greaterThan \<or> x \<in> range lessThan)))" 
     by (smt (verit, best) openin_topology_base_unique open_openin)
   show ?thesis
     unfolding subtopology_def arbitrary_union_of_relative_to [symmetric] 
     apply (simp add: relative_to_def flip: *)
     by (metis Int_commute)
 qed
 
 lemma continuous_map_upper_lower_semicontinuous_lt_gen:
   fixes U :: "'a::order_topology set"
   shows "continuous_map X (subtopology euclidean U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x > a}) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a})"
   by (auto simp: continuous_map_into_topology_subbase_eq [OF subbase_subtopology_euclidean [symmetric, of U]] 
            greaterThan_def lessThan_def image_iff   simp flip: all_simps)
 
 lemma continuous_map_upper_lower_semicontinuous_lt:
   fixes f :: "'a \<Rightarrow> 'b::order_topology"
   shows "continuous_map X euclidean f \<longleftrightarrow>
          (\<forall>a. openin X {x \<in> topspace X. f x > a}) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a})"
   using continuous_map_upper_lower_semicontinuous_lt_gen [where U=UNIV]
   by auto
 
 lemma Int_Collect_imp_eq: "A \<inter> {x. x\<in>A \<longrightarrow> P x} = {x\<in>A. P x}"
   by blast
 
 lemma continuous_map_upper_lower_semicontinuous_le_gen:
   shows
     "continuous_map X (subtopology euclideanreal U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<ge> a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   unfolding continuous_map_upper_lower_semicontinuous_lt_gen
   by (auto simp: closedin_def Diff_eq Compl_eq not_le Int_Collect_imp_eq)
 
 lemma continuous_map_upper_lower_semicontinuous_le:
    "continuous_map X euclideanreal f \<longleftrightarrow>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<ge> a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   using continuous_map_upper_lower_semicontinuous_le_gen [where U=UNIV]
   by auto
 
 lemma continuous_map_upper_lower_semicontinuous_lte_gen:
    "continuous_map X (subtopology euclideanreal U) f \<longleftrightarrow>
          (\<forall>x \<in> topspace X. f x \<in> U) \<and>
          (\<forall>a. openin X {x \<in> topspace X. f x < a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   unfolding continuous_map_upper_lower_semicontinuous_lt_gen
   by (auto simp: closedin_def Diff_eq Compl_eq not_le Int_Collect_imp_eq)
 
 lemma continuous_map_upper_lower_semicontinuous_lte:
    "continuous_map X euclideanreal f \<longleftrightarrow>
          (\<forall>a. openin X {x \<in> topspace X. f x < a}) \<and>
          (\<forall>a. closedin X {x \<in> topspace X. f x \<le> a})"
   using continuous_map_upper_lower_semicontinuous_lte_gen [where U=UNIV]
   by auto
 
 
 subsection\<^marker>\<open>tag important\<close> \<open>Pullback topology\<close>
 
 text \<open>Pulling back a topology by map gives again a topology. \<open>subtopology\<close> is
 a special case of this notion, pulling back by the identity. We introduce the general notion as
 we will need it to define the strong operator topology on the space of continuous linear operators,
 by pulling back the product topology on the space of all functions.\<close>
 
 text \<open>\<open>pullback_topology A f T\<close> is the pullback of the topology \<open>T\<close> by the map \<open>f\<close> on
 the set \<open>A\<close>.\<close>
 
 definition\<^marker>\<open>tag important\<close> pullback_topology::"('a set) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b topology) \<Rightarrow> ('a topology)"
   where "pullback_topology A f T = topology (\<lambda>S. \<exists>U. openin T U \<and> S = f-`U \<inter> A)"
 
 lemma istopology_pullback_topology:
   "istopology (\<lambda>S. \<exists>U. openin T U \<and> S = f-`U \<inter> A)"
   unfolding istopology_def proof (auto)
   fix K assume "\<forall>S\<in>K. \<exists>U. openin T U \<and> S = f -` U \<inter> A"
   then have "\<exists>U. \<forall>S\<in>K. openin T (U S) \<and> S = f-`(U S) \<inter> A"
     by (rule bchoice)
   then obtain U where U: "\<forall>S\<in>K. openin T (U S) \<and> S = f-`(U S) \<inter> A"
     by blast
   define V where "V = (\<Union>S\<in>K. U S)"
   have "openin T V" "\<Union>K = f -` V \<inter> A" unfolding V_def using U by auto
   then show "\<exists>V. openin T V \<and> \<Union>K = f -` V \<inter> A" by auto
 qed
 
 lemma openin_pullback_topology:
   "openin (pullback_topology A f T) S \<longleftrightarrow> (\<exists>U. openin T U \<and> S = f-`U \<inter> A)"
 unfolding pullback_topology_def topology_inverse'[OF istopology_pullback_topology] by auto
 
 lemma topspace_pullback_topology:
   "topspace (pullback_topology A f T) = f-`(topspace T) \<inter> A"
 by (auto simp add: topspace_def openin_pullback_topology)
 
 proposition continuous_map_pullback [intro]:
   assumes "continuous_map T1 T2 g"
   shows "continuous_map (pullback_topology A f T1) T2 (g o f)"
 unfolding continuous_map_alt
 proof (auto)
   fix U::"'b set" assume "openin T2 U"
   then have "openin T1 (g-`U \<inter> topspace T1)"
     using assms unfolding continuous_map_alt by auto
   have "(g o f)-`U \<inter> topspace (pullback_topology A f T1) = (g o f)-`U \<inter> A \<inter> f-`(topspace T1)"
     unfolding topspace_pullback_topology by auto
   also have "... = f-`(g-`U \<inter> topspace T1) \<inter> A "
     by auto
   also have "openin (pullback_topology A f T1) (...)"
     unfolding openin_pullback_topology using \<open>openin T1 (g-`U \<inter> topspace T1)\<close> by auto
   finally show "openin (pullback_topology A f T1) ((g \<circ> f) -` U \<inter> topspace (pullback_topology A f T1))"
     by auto
 next
   fix x assume "x \<in> topspace (pullback_topology A f T1)"
   then have "f x \<in> topspace T1"
     unfolding topspace_pullback_topology by auto
   then show "g (f x) \<in> topspace T2"
     using assms unfolding continuous_map_def by auto
 qed
 
 proposition continuous_map_pullback' [intro]:
   assumes "continuous_map T1 T2 (f o g)" "topspace T1 \<subseteq> g-`A"
   shows "continuous_map T1 (pullback_topology A f T2) g"
 unfolding continuous_map_alt
 proof (auto)
   fix U assume "openin (pullback_topology A f T2) U"
   then have "\<exists>V. openin T2 V \<and> U = f-`V \<inter> A"
     unfolding openin_pullback_topology by auto
   then obtain V where "openin T2 V" "U = f-`V \<inter> A"
     by blast
   then have "g -` U \<inter> topspace T1 = g-`(f-`V \<inter> A) \<inter> topspace T1"
     by blast
   also have "... = (f o g)-`V \<inter> (g-`A \<inter> topspace T1)"
     by auto
   also have "... = (f o g)-`V \<inter> topspace T1"
     using assms(2) by auto
   also have "openin T1 (...)"
     using assms(1) \<open>openin T2 V\<close> by auto
   finally show "openin T1 (g -` U \<inter> topspace T1)" by simp
 next
   fix x assume "x \<in> topspace T1"
   have "(f o g) x \<in> topspace T2"
     using assms(1) \<open>x \<in> topspace T1\<close> unfolding continuous_map_def by auto
   then have "g x \<in> f-`(topspace T2)"
     unfolding comp_def by blast
   moreover have "g x \<in> A" using assms(2) \<open>x \<in> topspace T1\<close> by blast
   ultimately show "g x \<in> topspace (pullback_topology A f T2)"
     unfolding topspace_pullback_topology by blast
 qed
 subsection\<open>Proper maps (not a priori assumed continuous) \<close>
 
 definition proper_map
   where
  "proper_map X Y f \<equiv>
         closed_map X Y f \<and> (\<forall>y \<in> topspace Y. compactin X {x \<in> topspace X. f x = y})"
 
 lemma proper_imp_closed_map:
    "proper_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: proper_map_def)
 
 lemma proper_map_imp_subset_topspace:
    "proper_map X Y f \<Longrightarrow> f ` (topspace X) \<subseteq> topspace Y"
   by (simp add: closed_map_imp_subset_topspace proper_map_def)
 
+lemma proper_map_restriction:
+  assumes "proper_map X Y f" "{x \<in> topspace X. f x \<in> V} = U"
+  shows "proper_map (subtopology X U) (subtopology Y V) f"
+proof -
+  have [simp]: "{x \<in> topspace X. f x \<in> V \<and> f x = y} = {x \<in> topspace X. f x = y}" 
+    if "y \<in> V" for y
+    using that by auto
+  show ?thesis
+    using assms unfolding proper_map_def using closed_map_restriction
+    by (force simp: compactin_subtopology)
+qed
+
 lemma closed_injective_imp_proper_map:
   assumes f: "closed_map X Y f" and inj: "inj_on f (topspace X)"
   shows "proper_map X Y f"
   unfolding proper_map_def
 proof (clarsimp simp: f)
   show "compactin X {x \<in> topspace X. f x = y}"
     if "y \<in> topspace Y" for y
 using inj_on_eq_iff [OF inj] that
   proof -
     have "{x \<in> topspace X. f x = y} = {} \<or> (\<exists>a \<in> topspace X. {x \<in> topspace X. f x = y} = {a})"
       using inj_on_eq_iff [OF inj] by auto
     then show ?thesis
       using that by (metis (no_types, lifting) compactin_empty compactin_sing)
   qed
 qed
 
 lemma injective_imp_proper_eq_closed_map:
    "inj_on f (topspace X) \<Longrightarrow> (proper_map X Y f \<longleftrightarrow> closed_map X Y f)"
   using closed_injective_imp_proper_map proper_imp_closed_map by blast
 
 lemma homeomorphic_imp_proper_map:
    "homeomorphic_map X Y f \<Longrightarrow> proper_map X Y f"
   by (simp add: closed_injective_imp_proper_map homeomorphic_eq_everything_map)
 
 lemma compactin_proper_map_preimage:
   assumes f: "proper_map X Y f" and "compactin Y K"
   shows "compactin X {x. x \<in> topspace X \<and> f x \<in> K}"
 proof -
   have "f ` (topspace X) \<subseteq> topspace Y"
     by (simp add: f proper_map_imp_subset_topspace)
   have *: "\<And>y. y \<in> topspace Y \<Longrightarrow> compactin X {x \<in> topspace X. f x = y}"
     using f by (auto simp: proper_map_def)
   show ?thesis
     unfolding compactin_def
   proof clarsimp
     show "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> {x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>\<F>"
       if \<U>: "\<forall>U\<in>\<U>. openin X U" and sub: "{x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>\<U>"
       for \<U>
     proof -
       have "\<forall>y \<in> K. \<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>\<V>"
       proof
         fix y
         assume "y \<in> K"
         then have "compactin X {x \<in> topspace X. f x = y}"
           by (metis "*" \<open>compactin Y K\<close> compactin_subspace subsetD)
         with \<open>y \<in> K\<close> show "\<exists>\<V>. finite \<V> \<and> \<V> \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>\<V>"
           unfolding compactin_def using \<U> sub by fastforce
       qed
       then obtain \<V> where \<V>: "\<And>y. y \<in> K \<Longrightarrow> finite (\<V> y) \<and> \<V> y \<subseteq> \<U>  \<and> {x \<in> topspace X. f x = y} \<subseteq> \<Union>(\<V> y)"
         by (metis (full_types))
       define F where "F \<equiv> \<lambda>y. topspace Y - f ` (topspace X - \<Union>(\<V> y))"
       have "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> F ` K \<and> K \<subseteq> \<Union>\<F>"
       proof (rule compactinD [OF \<open>compactin Y K\<close>])
         have "\<And>x. x \<in> K \<Longrightarrow> closedin Y (f ` (topspace X - \<Union>(\<V> x)))"
           using f unfolding proper_map_def closed_map_def
           by (meson \<U> \<V> openin_Union openin_closedin_eq subsetD)
         then show "openin Y U" if "U \<in> F ` K" for U
           using that by (auto simp: F_def)
         show "K \<subseteq> \<Union>(F ` K)"
           using \<V> \<open>compactin Y K\<close> unfolding F_def compactin_def by fastforce
       qed
       then obtain J where "finite J" "J \<subseteq> K" and J: "K \<subseteq> \<Union>(F ` J)"
         by (auto simp: ex_finite_subset_image)
       show ?thesis
         unfolding F_def
       proof (intro exI conjI)
         show "finite (\<Union>(\<V> ` J))"
           using \<V> \<open>J \<subseteq> K\<close> \<open>finite J\<close> by blast
         show "\<Union>(\<V> ` J) \<subseteq> \<U>"
           using \<V> \<open>J \<subseteq> K\<close> by blast
         show "{x \<in> topspace X. f x \<in> K} \<subseteq> \<Union>(\<Union>(\<V> ` J))"
           using J \<open>J \<subseteq> K\<close> unfolding F_def by auto
       qed
     qed
   qed
 qed
 
 
 lemma compact_space_proper_map_preimage:
   assumes f: "proper_map X Y f" and fim: "f ` (topspace X) = topspace Y" and "compact_space Y"
   shows "compact_space X"
 proof -
   have eq: "topspace X = {x \<in> topspace X. f x \<in> topspace Y}"
     using fim by blast
   moreover have "compactin Y (topspace Y)"
     using \<open>compact_space Y\<close> compact_space_def by auto
   ultimately show ?thesis
     unfolding compact_space_def
     using eq f compactin_proper_map_preimage by fastforce
 qed
 
 lemma proper_map_alt:
    "proper_map X Y f \<longleftrightarrow>
     closed_map X Y f \<and> (\<forall>K. compactin Y K \<longrightarrow> compactin X {x. x \<in> topspace X \<and> f x \<in> K})"
   proof (intro iffI conjI allI impI)
   show "compactin X {x \<in> topspace X. f x \<in> K}"
     if "proper_map X Y f" and "compactin Y K" for K
     using that by (simp add: compactin_proper_map_preimage)
   show "proper_map X Y f"
     if f: "closed_map X Y f \<and> (\<forall>K. compactin Y K \<longrightarrow> compactin X {x \<in> topspace X. f x \<in> K})"
   proof -
     have "compactin X {x \<in> topspace X. f x = y}" if "y \<in> topspace Y" for y
     proof -
       have "compactin X {x \<in> topspace X. f x \<in> {y}}"
         using f compactin_sing that by fastforce
       then show ?thesis
         by auto
     qed
     with f show ?thesis
       by (auto simp: proper_map_def)
   qed
 qed (simp add: proper_imp_closed_map)
 
 lemma proper_map_on_empty:
    "topspace X = {} \<Longrightarrow> proper_map X Y f"
   by (auto simp: proper_map_def closed_map_on_empty)
 
 lemma proper_map_id [simp]:
    "proper_map X X id"
 proof (clarsimp simp: proper_map_alt closed_map_id)
   fix K
   assume K: "compactin X K"
   then have "{a \<in> topspace X. a \<in> K} = K"
     by (simp add: compactin_subspace subset_antisym subset_iff)
   then show "compactin X {a \<in> topspace X. a \<in> K}"
     using K by auto
 qed
 
 lemma proper_map_compose:
   assumes "proper_map X Y f" "proper_map Y Z g"
   shows "proper_map X Z (g \<circ> f)"
 proof -
   have "closed_map X Y f" and f: "\<And>K. compactin Y K \<Longrightarrow> compactin X {x \<in> topspace X. f x \<in> K}"
     and "closed_map Y Z g" and g: "\<And>K. compactin Z K \<Longrightarrow> compactin Y {x \<in> topspace Y. g x \<in> K}"
     using assms by (auto simp: proper_map_alt)
   show ?thesis
     unfolding proper_map_alt
   proof (intro conjI allI impI)
     show "closed_map X Z (g \<circ> f)"
       using \<open>closed_map X Y f\<close> \<open>closed_map Y Z g\<close> closed_map_compose by blast
     have "{x \<in> topspace X. g (f x) \<in> K} = {x \<in> topspace X. f x \<in> {b \<in> topspace Y. g b \<in> K}}" for K
       using \<open>closed_map X Y f\<close> closed_map_imp_subset_topspace by blast
     then show "compactin X {x \<in> topspace X. (g \<circ> f) x \<in> K}"
       if "compactin Z K" for K
       using f [OF g [OF that]] by auto
   qed
 qed
 
 lemma proper_map_const:
    "proper_map X Y (\<lambda>x. c) \<longleftrightarrow> compact_space X \<and> (topspace X = {} \<or> closedin Y {c})"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: compact_space_topspace_empty proper_map_on_empty)
 next
   case False
   have *: "compactin X {x \<in> topspace X. c = y}" if "compact_space X" for y
     using that unfolding compact_space_def
     by (metis (mono_tags, lifting) compactin_empty empty_subsetI mem_Collect_eq subsetI subset_antisym)
   then show ?thesis
     using closed_compactin closedin_subset
     by (force simp: False proper_map_def closed_map_const compact_space_def)
 qed
 
 lemma proper_map_inclusion:
    "S \<subseteq> topspace X \<Longrightarrow> proper_map (subtopology X S) X id \<longleftrightarrow> closedin X S \<and> (\<forall>k. compactin X k \<longrightarrow> compactin X (S \<inter> k))"
   by (metis closed_Int_compactin closed_map_inclusion_eq inf.absorb_iff2 inj_on_id injective_imp_proper_eq_closed_map)
 
+lemma proper_map_into_subtopology:
+   "\<lbrakk>proper_map X Y f; f ` topspace X \<subseteq> C\<rbrakk> \<Longrightarrow> proper_map X (subtopology Y C) f"
+  by (simp add: closed_map_into_subtopology compactin_subtopology proper_map_alt)
+
+lemma proper_map_from_composition_left:
+  assumes gf: "proper_map X Z (g \<circ> f)" and contf: "continuous_map X Y f" and fim: "f ` topspace X = topspace Y"
+  shows "proper_map Y Z g"
+  unfolding proper_map_def
+proof (intro strip conjI)
+  show "closed_map Y Z g"
+    by (meson closed_map_from_composition_left gf contf fim proper_imp_closed_map)
+  fix z assume "z \<in> topspace Z"
+  have eq: "{y \<in> topspace Y. g y = z} = f ` {x \<in> topspace X. (g \<circ> f) x = z}"
+    using fim by force
+  show "compactin Y {x \<in> topspace Y. g x = z}"
+    unfolding eq
+  proof (rule image_compactin [OF _ contf])
+    show "compactin X {x \<in> topspace X. (g \<circ> f) x = z}"
+      using \<open>z \<in> topspace Z\<close> gf proper_map_def by fastforce
+  qed
+qed
+
+lemma proper_map_from_composition_right_inj:
+  assumes gf: "proper_map X Z (g \<circ> f)" and fim: "f ` topspace X \<subseteq> topspace Y" 
+    and contf: "continuous_map Y Z g" and inj: "inj_on g (topspace Y)"
+  shows "proper_map X Y f"
+  unfolding proper_map_def
+proof (intro strip conjI)
+  show "closed_map X Y f"
+    by (meson closed_map_from_composition_right assms proper_imp_closed_map)
+  fix y
+  assume "y \<in> topspace Y"
+  with fim inj have eq: "{x \<in> topspace X. f x = y} = {x \<in> topspace X. (g \<circ> f) x = g y}"
+    by (auto simp: image_subset_iff inj_onD)
+  show "compactin X {x \<in> topspace X. f x = y}"
+    unfolding eq
+    by (smt (verit) Collect_cong \<open>y \<in> topspace Y\<close> contf continuous_map_closedin gf proper_map_def)
+qed
+
 
 subsection\<open>Perfect maps (proper, continuous and surjective)\<close>
 
 definition perfect_map 
   where "perfect_map X Y f \<equiv> continuous_map X Y f \<and> proper_map X Y f \<and> f ` (topspace X) = topspace Y"
 
 lemma homeomorphic_imp_perfect_map:
    "homeomorphic_map X Y f \<Longrightarrow> perfect_map X Y f"
   by (simp add: homeomorphic_eq_everything_map homeomorphic_imp_proper_map perfect_map_def)
 
 lemma perfect_imp_quotient_map:
    "perfect_map X Y f \<Longrightarrow> quotient_map X Y f"
   by (simp add: continuous_closed_imp_quotient_map perfect_map_def proper_map_def)
 
 lemma homeomorphic_eq_injective_perfect_map:
    "homeomorphic_map X Y f \<longleftrightarrow> perfect_map X Y f \<and> inj_on f (topspace X)"
   using homeomorphic_imp_perfect_map homeomorphic_map_def perfect_imp_quotient_map by blast
 
 lemma perfect_injective_eq_homeomorphic_map:
    "perfect_map X Y f \<and> inj_on f (topspace X) \<longleftrightarrow> homeomorphic_map X Y f"
   by (simp add: homeomorphic_eq_injective_perfect_map)
 
 lemma perfect_map_id [simp]: "perfect_map X X id"
   by (simp add: homeomorphic_imp_perfect_map)
 
 lemma perfect_map_compose:
    "\<lbrakk>perfect_map X Y f; perfect_map Y Z g\<rbrakk> \<Longrightarrow> perfect_map X Z (g \<circ> f)"
   by (meson continuous_map_compose perfect_imp_quotient_map perfect_map_def proper_map_compose quotient_map_compose_eq quotient_map_def)
 
 lemma perfect_imp_continuous_map:
    "perfect_map X Y f \<Longrightarrow> continuous_map X Y f"
   using perfect_map_def by blast
 
 lemma perfect_imp_closed_map:
    "perfect_map X Y f \<Longrightarrow> closed_map X Y f"
   by (simp add: perfect_map_def proper_map_def)
 
 lemma perfect_imp_proper_map:
    "perfect_map X Y f \<Longrightarrow> proper_map X Y f"
   by (simp add: perfect_map_def)
 
 lemma perfect_imp_surjective_map:
    "perfect_map X Y f \<Longrightarrow> f ` (topspace X) = topspace Y"
   by (simp add: perfect_map_def)
 
+lemma perfect_map_from_composition_left:
+  assumes "perfect_map X Z (g \<circ> f)" and "continuous_map X Y f"
+    and "continuous_map Y Z g" and "f ` topspace X = topspace Y"
+  shows "perfect_map Y Z g"
+  using assms unfolding perfect_map_def
+  by (metis image_comp proper_map_from_composition_left)
+
 end
diff --git a/src/HOL/Analysis/Analysis.thy b/src/HOL/Analysis/Analysis.thy
--- a/src/HOL/Analysis/Analysis.thy
+++ b/src/HOL/Analysis/Analysis.thy
@@ -1,57 +1,58 @@
 theory Analysis
   imports
   (* Linear Algebra *)
   Convex
   Determinants
   (* Topology *)
   FSigma
   Sum_Topology
   Abstract_Topological_Spaces
+  Abstract_Metric_Spaces
   Connected
   Abstract_Limits
   Isolated
   (* Functional Analysis *)
   Elementary_Normed_Spaces
   Norm_Arith
   (* Vector Analysis *)
   Convex_Euclidean_Space
   Operator_Norm
   (* Unsorted *)
   Line_Segment
   Derivative
   Cartesian_Euclidean_Space
   Weierstrass_Theorems
   (* Measure and Integration Theory *)
   Ball_Volume
   Integral_Test
   Improper_Integral
   Equivalence_Measurable_On_Borel
   Lebesgue_Integral_Substitution
   Embed_Measure
   Complete_Measure
   Radon_Nikodym
   Fashoda_Theorem
   Cross3
   Homeomorphism
   Bounded_Continuous_Function
   Abstract_Topology
   Product_Topology
   Lindelof_Spaces
   Infinite_Products
   Infinite_Sum
   Infinite_Set_Sum
   Polytope
   Jordan_Curve
   Poly_Roots
   Generalised_Binomial_Theorem
   Gamma_Function
   Change_Of_Vars
   Multivariate_Analysis
   Simplex_Content
   FPS_Convergence
   Smooth_Paths
   Abstract_Euclidean_Space
   Function_Metric
 begin
 
 end
diff --git a/src/HOL/Analysis/Measure_Space.thy b/src/HOL/Analysis/Measure_Space.thy
--- a/src/HOL/Analysis/Measure_Space.thy
+++ b/src/HOL/Analysis/Measure_Space.thy
@@ -1,3767 +1,3763 @@
 (*  Title:      HOL/Analysis/Measure_Space.thy
     Author:     Lawrence C Paulson
     Author:     Johannes Hölzl, TU München
     Author:     Armin Heller, TU München
 *)
 
 section \<open>Measure Spaces\<close>
 
 theory Measure_Space
 imports
   Measurable "HOL-Library.Extended_Nonnegative_Real"
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> "Relate extended reals and the indicator function"
 
 lemma suminf_cmult_indicator:
   fixes f :: "nat \<Rightarrow> ennreal"
   assumes "disjoint_family A" "x \<in> A i"
   shows "(\<Sum>n. f n * indicator (A n) x) = f i"
 proof -
   have **: "\<And>n. f n * indicator (A n) x = (if n = i then f n else 0 :: ennreal)"
     using \<open>x \<in> A i\<close> assms unfolding disjoint_family_on_def indicator_def by auto
   then have "\<And>n. (\<Sum>j<n. f j * indicator (A j) x) = (if i < n then f i else 0 :: ennreal)"
     by (auto simp: sum.If_cases)
   moreover have "(SUP n. if i < n then f i else 0) = (f i :: ennreal)"
   proof (rule SUP_eqI)
     fix y :: ennreal assume "\<And>n. n \<in> UNIV \<Longrightarrow> (if i < n then f i else 0) \<le> y"
     from this[of "Suc i"] show "f i \<le> y" by auto
   qed (use assms in simp)
   ultimately show ?thesis using assms
     by (simp add: suminf_eq_SUP)
 qed
 
 lemma suminf_indicator:
   assumes "disjoint_family A"
   shows "(\<Sum>n. indicator (A n) x :: ennreal) = indicator (\<Union>i. A i) x"
 proof cases
   assume *: "x \<in> (\<Union>i. A i)"
   then obtain i where "x \<in> A i" by auto
   from suminf_cmult_indicator[OF assms(1), OF \<open>x \<in> A i\<close>, of "\<lambda>k. 1"]
   show ?thesis using * by simp
 qed simp
 
 lemma sum_indicator_disjoint_family:
   fixes f :: "'d \<Rightarrow> 'e::semiring_1"
   assumes d: "disjoint_family_on A P" and "x \<in> A j" and "finite P" and "j \<in> P"
   shows "(\<Sum>i\<in>P. f i * indicator (A i) x) = f j"
 proof -
   have "P \<inter> {i. x \<in> A i} = {j}"
     using d \<open>x \<in> A j\<close> \<open>j \<in> P\<close> unfolding disjoint_family_on_def
     by auto
   with \<open>finite P\<close> show ?thesis
     by (simp add: indicator_def)
 qed
 
 text \<open>
   The type for emeasure spaces is already defined in \<^theory>\<open>HOL-Analysis.Sigma_Algebra\<close>, as it
   is also used to represent sigma algebras (with an arbitrary emeasure).
 \<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> "Extend binary sets"
 
 lemma LIMSEQ_binaryset:
   assumes f: "f {} = 0"
   shows  "(\<lambda>n. \<Sum>i<n. f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
 proof -
   have "(\<lambda>n. \<Sum>i < Suc (Suc n). f (binaryset A B i)) = (\<lambda>n. f A + f B)"
     proof
       fix n
       show "(\<Sum>i < Suc (Suc n). f (binaryset A B i)) = f A + f B"
         by (induct n)  (auto simp add: binaryset_def f)
     qed
   moreover
   have "\<dots> \<longlonglongrightarrow> f A + f B" by (rule tendsto_const)
   ultimately have "(\<lambda>n. \<Sum>i< n+2. f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
     by simp
   thus ?thesis by (rule LIMSEQ_offset [where k=2])
 qed
 
 lemma binaryset_sums:
   assumes f: "f {} = 0"
   shows  "(\<lambda>n. f (binaryset A B n)) sums (f A + f B)"
   using LIMSEQ_binaryset f sums_def by blast
 
 lemma suminf_binaryset_eq:
   fixes f :: "'a set \<Rightarrow> 'b::{comm_monoid_add, t2_space}"
   shows "f {} = 0 \<Longrightarrow> (\<Sum>n. f (binaryset A B n)) = f A + f B"
   by (metis binaryset_sums sums_unique)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Properties of a premeasure \<^term>\<open>\<mu>\<close>\<close>
 
 text \<open>
   The definitions for \<^const>\<open>positive\<close> and \<^const>\<open>countably_additive\<close> should be here, by they are
   necessary to define \<^typ>\<open>'a measure\<close> in \<^theory>\<open>HOL-Analysis.Sigma_Algebra\<close>.
 \<close>
 
 definition subadditive where
   "subadditive M f \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<inter> y = {} \<longrightarrow> f (x \<union> y) \<le> f x + f y)"
 
 lemma subadditiveD: "subadditive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M \<Longrightarrow> f (x \<union> y) \<le> f x + f y"
   by (auto simp add: subadditive_def)
 
 definition countably_subadditive where
   "countably_subadditive M f \<longleftrightarrow>
     (\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (f (\<Union>i. A i) \<le> (\<Sum>i. f (A i))))"
 
 lemma (in ring_of_sets) countably_subadditive_subadditive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" and cs: "countably_subadditive M f"
   shows  "subadditive M f"
 proof (auto simp add: subadditive_def)
   fix x y
   assume x: "x \<in> M" and y: "y \<in> M" and "x \<inter> y = {}"
   hence "disjoint_family (binaryset x y)"
     by (auto simp add: disjoint_family_on_def binaryset_def)
   hence "range (binaryset x y) \<subseteq> M \<longrightarrow>
          (\<Union>i. binaryset x y i) \<in> M \<longrightarrow>
          f (\<Union>i. binaryset x y i) \<le> (\<Sum> n. f (binaryset x y n))"
     using cs by (auto simp add: countably_subadditive_def)
   hence "{x,y,{}} \<subseteq> M \<longrightarrow> x \<union> y \<in> M \<longrightarrow>
          f (x \<union> y) \<le> (\<Sum> n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
   thus "f (x \<union> y) \<le>  f x + f y" using f x y
     by (auto simp add: Un o_def suminf_binaryset_eq positive_def)
 qed
 
 definition additive where
   "additive M \<mu> \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<inter> y = {} \<longrightarrow> \<mu> (x \<union> y) = \<mu> x + \<mu> y)"
 
 definition increasing where
   "increasing M \<mu> \<longleftrightarrow> (\<forall>x\<in>M. \<forall>y\<in>M. x \<subseteq> y \<longrightarrow> \<mu> x \<le> \<mu> y)"
 
 lemma positiveD1: "positive M f \<Longrightarrow> f {} = 0" by (auto simp: positive_def)
 
 lemma positiveD_empty:
   "positive M f \<Longrightarrow> f {} = 0"
   by (auto simp add: positive_def)
 
 lemma additiveD:
   "additive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M \<Longrightarrow> f (x \<union> y) = f x + f y"
   by (auto simp add: additive_def)
 
 lemma increasingD:
   "increasing M f \<Longrightarrow> x \<subseteq> y \<Longrightarrow> x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> f x \<le> f y"
   by (auto simp add: increasing_def)
 
 lemma countably_additiveI[case_names countably]:
   "(\<And>A. \<lbrakk>range A \<subseteq> M; disjoint_family A; (\<Union>i. A i) \<in> M\<rbrakk> \<Longrightarrow> (\<Sum>i. f(A i)) = f(\<Union>i. A i))
   \<Longrightarrow> countably_additive M f"
   by (simp add: countably_additive_def)
 
 lemma (in ring_of_sets) disjointed_additive:
   assumes f: "positive M f" "additive M f" and A: "range A \<subseteq> M" "incseq A"
   shows "(\<Sum>i\<le>n. f (disjointed A i)) = f (A n)"
 proof (induct n)
   case (Suc n)
   then have "(\<Sum>i\<le>Suc n. f (disjointed A i)) = f (A n) + f (disjointed A (Suc n))"
     by simp
   also have "\<dots> = f (A n \<union> disjointed A (Suc n))"
     using A by (subst f(2)[THEN additiveD]) (auto simp: disjointed_mono)
   also have "A n \<union> disjointed A (Suc n) = A (Suc n)"
     using \<open>incseq A\<close> by (auto dest: incseq_SucD simp: disjointed_mono)
   finally show ?case .
 qed simp
 
 lemma (in ring_of_sets) additive_sum:
   fixes A:: "'i \<Rightarrow> 'a set"
   assumes f: "positive M f" and ad: "additive M f" and "finite S"
       and A: "A`S \<subseteq> M"
       and disj: "disjoint_family_on A S"
   shows  "(\<Sum>i\<in>S. f (A i)) = f (\<Union>i\<in>S. A i)"
   using \<open>finite S\<close> disj A
 proof induct
   case empty show ?case using f by (simp add: positive_def)
 next
   case (insert s S)
   then have "A s \<inter> (\<Union>i\<in>S. A i) = {}"
     by (auto simp add: disjoint_family_on_def neq_iff)
   moreover
   have "A s \<in> M" using insert by blast
   moreover have "(\<Union>i\<in>S. A i) \<in> M"
     using insert \<open>finite S\<close> by auto
   ultimately have "f (A s \<union> (\<Union>i\<in>S. A i)) = f (A s) + f(\<Union>i\<in>S. A i)"
     using ad UNION_in_sets A by (auto simp add: additive_def)
   with insert show ?case using ad disjoint_family_on_mono[of S "insert s S" A]
     by (auto simp add: additive_def subset_insertI)
 qed
 
 lemma (in ring_of_sets) additive_increasing:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes posf: "positive M f" and addf: "additive M f"
   shows "increasing M f"
 proof (auto simp add: increasing_def)
   fix x y
   assume xy: "x \<in> M" "y \<in> M" "x \<subseteq> y"
   then have "y - x \<in> M" by auto
   then have "f x + 0 \<le> f x + f (y-x)" by (intro add_left_mono zero_le)
   also have "\<dots> = f (x \<union> (y-x))"
     by (metis addf Diff_disjoint \<open>y - x \<in> M\<close> additiveD xy(1))
   also have "\<dots> = f y"
     by (metis Un_Diff_cancel Un_absorb1 xy(3))
   finally show "f x \<le> f y" by simp
 qed
 
 lemma (in ring_of_sets) subadditive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" and A: "A`S \<subseteq> M" and S: "finite S"
   shows "f (\<Union>i\<in>S. A i) \<le> (\<Sum>i\<in>S. f (A i))"
 using S A
 proof (induct S)
   case empty thus ?case using f by (auto simp: positive_def)
 next
   case (insert x F)
   hence in_M: "A x \<in> M" "(\<Union>i\<in>F. A i) \<in> M" "(\<Union>i\<in>F. A i) - A x \<in> M" using A by force+
   have subs: "(\<Union>i\<in>F. A i) - A x \<subseteq> (\<Union>i\<in>F. A i)" by auto
   have "(\<Union>i\<in>(insert x F). A i) = A x \<union> ((\<Union>i\<in>F. A i) - A x)" by auto
   hence "f (\<Union>i\<in>(insert x F). A i) = f (A x \<union> ((\<Union>i\<in>F. A i) - A x))"
     by simp
   also have "\<dots> = f (A x) + f ((\<Union>i\<in>F. A i) - A x)"
     using f(2) by (rule additiveD) (insert in_M, auto)
   also have "\<dots> \<le> f (A x) + f (\<Union>i\<in>F. A i)"
     using additive_increasing[OF f] in_M subs 
     by (simp add: increasingD)
   also have "\<dots> \<le> f (A x) + (\<Sum>i\<in>F. f (A i))" 
     using insert by (auto intro: add_left_mono)
   finally show "f (\<Union>i\<in>(insert x F). A i) \<le> (\<Sum>i\<in>(insert x F). f (A i))"
     by (simp add: insert)
 qed
 
 lemma (in ring_of_sets) countably_additive_additive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes posf: "positive M f" and ca: "countably_additive M f"
   shows "additive M f"
 proof (auto simp add: additive_def)
   fix x y
   assume x: "x \<in> M" and y: "y \<in> M" and "x \<inter> y = {}"
   hence "disjoint_family (binaryset x y)"
     by (auto simp add: disjoint_family_on_def binaryset_def)
   hence "range (binaryset x y) \<subseteq> M \<longrightarrow>
          (\<Union>i. binaryset x y i) \<in> M \<longrightarrow>
          f (\<Union>i. binaryset x y i) = (\<Sum> n. f (binaryset x y n))"
     using ca by (simp add: countably_additive_def)
   hence "{x,y,{}} \<subseteq> M \<longrightarrow> x \<union> y \<in> M \<longrightarrow> f (x \<union> y) = (\<Sum>n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
   thus "f (x \<union> y) = f x + f y" using posf x y
     by (auto simp add: Un suminf_binaryset_eq positive_def)
 qed
 
 lemma (in algebra) increasing_additive_bound:
   fixes A:: "nat \<Rightarrow> 'a set" and  f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" and ad: "additive M f"
       and inc: "increasing M f"
       and A: "range A \<subseteq> M"
       and disj: "disjoint_family A"
   shows  "(\<Sum>i. f (A i)) \<le> f \<Omega>"
 proof (safe intro!: suminf_le_const)
   fix N
   note disj_N = disjoint_family_on_mono[OF _ disj, of "{..<N}"]
   have "(\<Sum>i<N. f (A i)) = f (\<Union>i\<in>{..<N}. A i)"
     using A by (intro additive_sum [OF f ad]) (auto simp: disj_N)
   also have "\<dots> \<le> f \<Omega>" using space_closed A
     by (intro increasingD[OF inc] finite_UN) auto
   finally show "(\<Sum>i<N. f (A i)) \<le> f \<Omega>" by simp
 qed (insert f A, auto simp: positive_def)
 
 lemma (in ring_of_sets) countably_additiveI_finite:
   fixes \<mu> :: "'a set \<Rightarrow> ennreal"
   assumes "finite \<Omega>" "positive M \<mu>" "additive M \<mu>"
   shows "countably_additive M \<mu>"
 proof (rule countably_additiveI)
   fix F :: "nat \<Rightarrow> 'a set" assume F: "range F \<subseteq> M" "(\<Union>i. F i) \<in> M" and disj: "disjoint_family F"
 
   have "\<forall>i. F i \<noteq> {} \<longrightarrow> (\<exists>x. x \<in> F i)" by auto
   then obtain f where f: "\<And>i. F i \<noteq> {} \<Longrightarrow> f i \<in> F i" by metis
 
   have finU: "finite (\<Union>i. F i)"
     by (metis F(2) assms(1) infinite_super sets_into_space)
 
   have F_subset: "{i. \<mu> (F i) \<noteq> 0} \<subseteq> {i. F i \<noteq> {}}"
     by (auto simp: positiveD_empty[OF \<open>positive M \<mu>\<close>])
   moreover have fin_not_empty: "finite {i. F i \<noteq> {}}"
   proof (rule finite_imageD)
     from f have "f`{i. F i \<noteq> {}} \<subseteq> (\<Union>i. F i)" by auto
     then show "finite (f`{i. F i \<noteq> {}})"
       by (simp add: finU finite_subset)
     show inj_f: "inj_on f {i. F i \<noteq> {}}" 
       using f disj
       by (simp add: inj_on_def disjoint_family_on_def disjoint_iff) metis
   qed 
   ultimately have fin_not_0: "finite {i. \<mu> (F i) \<noteq> 0}"
     by (rule finite_subset)
 
   have disj_not_empty: "disjoint_family_on F {i. F i \<noteq> {}}"
     using disj by (auto simp: disjoint_family_on_def)
 
   from fin_not_0 have "(\<Sum>i. \<mu> (F i)) = (\<Sum>i | \<mu> (F i) \<noteq> 0. \<mu> (F i))"
     by (rule suminf_finite) auto
   also have "\<dots> = (\<Sum>i | F i \<noteq> {}. \<mu> (F i))"
     using fin_not_empty F_subset by (rule sum.mono_neutral_left) auto
   also have "\<dots> = \<mu> (\<Union>i\<in>{i. F i \<noteq> {}}. F i)"
     using \<open>positive M \<mu>\<close> \<open>additive M \<mu>\<close> fin_not_empty disj_not_empty F by (intro additive_sum) auto
   also have "\<dots> = \<mu> (\<Union>i. F i)"
     by (rule arg_cong[where f=\<mu>]) auto
   finally show "(\<Sum>i. \<mu> (F i)) = \<mu> (\<Union>i. F i)" .
 qed
 
 lemma (in ring_of_sets) countably_additive_iff_continuous_from_below:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f"
   shows "countably_additive M f \<longleftrightarrow>
     (\<forall>A. range A \<subseteq> M \<longrightarrow> incseq A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i))"
   unfolding countably_additive_def
 proof safe
   assume count_sum: "\<forall>A. range A \<subseteq> M \<longrightarrow> disjoint_family A \<longrightarrow> \<Union>(A ` UNIV) \<in> M \<longrightarrow> (\<Sum>i. f (A i)) = f (\<Union>(A ` UNIV))"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "incseq A" "(\<Union>i. A i) \<in> M"
   then have dA: "range (disjointed A) \<subseteq> M" by (auto simp: range_disjointed_sets)
   with count_sum[THEN spec, of "disjointed A"] A(3)
   have f_UN: "(\<Sum>i. f (disjointed A i)) = f (\<Union>i. A i)"
     by (auto simp: UN_disjointed_eq disjoint_family_disjointed)
   moreover have "(\<lambda>n. (\<Sum>i<n. f (disjointed A i))) \<longlonglongrightarrow> (\<Sum>i. f (disjointed A i))"
     by (simp add: summable_LIMSEQ)
   from LIMSEQ_Suc[OF this]
   have "(\<lambda>n. (\<Sum>i\<le>n. f (disjointed A i))) \<longlonglongrightarrow> (\<Sum>i. f (disjointed A i))"
     unfolding lessThan_Suc_atMost .
   moreover have "\<And>n. (\<Sum>i\<le>n. f (disjointed A i)) = f (A n)"
     using disjointed_additive[OF f A(1,2)] .
   ultimately show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)" by simp
 next
   assume cont[rule_format]: "\<forall>A. range A \<subseteq> M \<longrightarrow> incseq A \<longrightarrow> (\<Union>i. A i) \<in> M \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
   fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> M" "disjoint_family A" "(\<Union>i. A i) \<in> M"
   have *: "(\<Union>n. (\<Union>i<n. A i)) = (\<Union>i. A i)" by auto
   have "range (\<lambda>i. \<Union>i<i. A i) \<subseteq> M" "(\<Union>i. \<Union>i<i. A i) \<in> M"
     using A * by auto
   then have "(\<lambda>n. f (\<Union>i<n. A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
     unfolding *[symmetric] by (force intro!: cont incseq_SucI)+
   moreover have "\<And>n. f (\<Union>i<n. A i) = (\<Sum>i<n. f (A i))"
     using A
     by (intro additive_sum[OF f, symmetric]) (auto intro: disjoint_family_on_mono)
   ultimately
   have "(\<lambda>i. f (A i)) sums f (\<Union>i. A i)"
     unfolding sums_def by simp
   then show "(\<Sum>i. f (A i)) = f (\<Union>i. A i)"
     by (metis sums_unique)
 qed
 
 lemma (in ring_of_sets) continuous_from_above_iff_empty_continuous:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f"
   shows "(\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) \<in> M \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i))
      \<longleftrightarrow> (\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0)"
 proof safe
   assume cont[rule_format]: "(\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) \<in> M \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i))"
   fix A :: "nat \<Rightarrow> 'a set" 
   assume A: "range A \<subseteq> M" "decseq A" "(\<Inter>i. A i) = {}" "\<forall>i. f (A i) \<noteq> \<infinity>"
   with cont[of A] show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
     using \<open>positive M f\<close>[unfolded positive_def] by auto
 next
   assume cont[rule_format]: "\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<forall>i. f (A i) \<noteq> \<infinity>) \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   fix A :: "nat \<Rightarrow> 'a set" 
   assume A: "range A \<subseteq> M" "decseq A" "(\<Inter>i. A i) \<in> M" "\<forall>i. f (A i) \<noteq> \<infinity>"
 
   have f_mono: "\<And>a b. a \<in> M \<Longrightarrow> b \<in> M \<Longrightarrow> a \<subseteq> b \<Longrightarrow> f a \<le> f b"
     using additive_increasing[OF f] unfolding increasing_def by simp
 
   have decseq_fA: "decseq (\<lambda>i. f (A i))"
     using A by (auto simp: decseq_def intro!: f_mono)
   have decseq: "decseq (\<lambda>i. A i - (\<Inter>i. A i))"
     using A by (auto simp: decseq_def)
   then have decseq_f: "decseq (\<lambda>i. f (A i - (\<Inter>i. A i)))"
     using A unfolding decseq_def by (auto intro!: f_mono Diff)
   have "f (\<Inter>x. A x) \<le> f (A 0)"
     using A by (auto intro!: f_mono)
   then have f_Int_fin: "f (\<Inter>x. A x) \<noteq> \<infinity>"
     using A by (auto simp: top_unique)
   have f_fin: "f (A i - (\<Inter>i. A i)) \<noteq> \<infinity>" for i
     using A by (metis Diff Diff_subset f_mono infinity_ennreal_def range_subsetD top_unique)
   have "(\<lambda>i. f (A i - (\<Inter>i. A i))) \<longlonglongrightarrow> 0"
   proof (intro cont[ OF _ decseq _ f_fin])
     show "range (\<lambda>i. A i - (\<Inter>i. A i)) \<subseteq> M" "(\<Inter>i. A i - (\<Inter>i. A i)) = {}"
       using A by auto
   qed
   with INF_Lim decseq_f have "(INF n. f (A n - (\<Inter>i. A i))) = 0" by metis
   moreover have "(INF n. f (\<Inter>i. A i)) = f (\<Inter>i. A i)"
     by auto
   ultimately have "(INF n. f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i)) = 0 + f (\<Inter>i. A i)"
     using A(4) f_fin f_Int_fin
     using INF_ennreal_add_const by presburger
   moreover {
     fix n
     have "f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i) = f ((A n - (\<Inter>i. A i)) \<union> (\<Inter>i. A i))"
       using A by (subst f(2)[THEN additiveD]) auto
     also have "(A n - (\<Inter>i. A i)) \<union> (\<Inter>i. A i) = A n"
       by auto
     finally have "f (A n - (\<Inter>i. A i)) + f (\<Inter>i. A i) = f (A n)" . }
   ultimately have "(INF n. f (A n)) = f (\<Inter>i. A i)"
     by simp
   with LIMSEQ_INF[OF decseq_fA]
   show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Inter>i. A i)" by simp
 qed
 
 lemma (in ring_of_sets) empty_continuous_imp_continuous_from_below:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" "\<forall>A\<in>M. f A \<noteq> \<infinity>"
   assumes cont: "\<forall>A. range A \<subseteq> M \<longrightarrow> decseq A \<longrightarrow> (\<Inter>i. A i) = {} \<longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   assumes A: "range A \<subseteq> M" "incseq A" "(\<Union>i. A i) \<in> M"
   shows "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
 proof -
   from A have "(\<lambda>i. f ((\<Union>i. A i) - A i)) \<longlonglongrightarrow> 0"
     by (intro cont[rule_format]) (auto simp: decseq_def incseq_def)
   moreover
   { fix i
     have "f ((\<Union>i. A i) - A i \<union> A i) = f ((\<Union>i. A i) - A i) + f (A i)"
       using A by (intro f(2)[THEN additiveD]) auto
     also have "((\<Union>i. A i) - A i) \<union> A i = (\<Union>i. A i)"
       by auto
     finally have "f ((\<Union>i. A i) - A i) = f (\<Union>i. A i) - f (A i)"
       using assms f by fastforce
   }
   moreover have "\<forall>\<^sub>F i in sequentially. f (A i) \<le> f (\<Union>i. A i)"
     using increasingD[OF additive_increasing[OF f(1, 2)], of "A _" "\<Union>i. A i"] A
     by (auto intro!: always_eventually simp: subset_eq)
   ultimately show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
     by (auto intro: ennreal_tendsto_const_minus)
 qed
 
 lemma (in ring_of_sets) empty_continuous_imp_countably_additive:
   fixes f :: "'a set \<Rightarrow> ennreal"
   assumes f: "positive M f" "additive M f" and fin: "\<forall>A\<in>M. f A \<noteq> \<infinity>"
   assumes cont: "\<And>A. range A \<subseteq> M \<Longrightarrow> decseq A \<Longrightarrow> (\<Inter>i. A i) = {} \<Longrightarrow> (\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
   shows "countably_additive M f"
   using countably_additive_iff_continuous_from_below[OF f]
   using empty_continuous_imp_continuous_from_below[OF f fin] cont
   by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Properties of \<^const>\<open>emeasure\<close>\<close>
 
 lemma emeasure_positive: "positive (sets M) (emeasure M)"
   by (cases M) (auto simp: sets_def emeasure_def Abs_measure_inverse measure_space_def)
 
 lemma emeasure_empty[simp, intro]: "emeasure M {} = 0"
   using emeasure_positive[of M] by (simp add: positive_def)
 
 lemma emeasure_single_in_space: "emeasure M {x} \<noteq> 0 \<Longrightarrow> x \<in> space M"
   using emeasure_notin_sets[of "{x}" M] by (auto dest: sets.sets_into_space zero_less_iff_neq_zero[THEN iffD2])
 
 lemma emeasure_countably_additive: "countably_additive (sets M) (emeasure M)"
   by (cases M) (auto simp: sets_def emeasure_def Abs_measure_inverse measure_space_def)
 
 lemma suminf_emeasure:
   "range A \<subseteq> sets M \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Sum>i. emeasure M (A i)) = emeasure M (\<Union>i. A i)"
   using sets.countable_UN[of A UNIV M] emeasure_countably_additive[of M]
   by (simp add: countably_additive_def)
 
 lemma sums_emeasure:
   "disjoint_family F \<Longrightarrow> (\<And>i. F i \<in> sets M) \<Longrightarrow> (\<lambda>i. emeasure M (F i)) sums emeasure M (\<Union>i. F i)"
   unfolding sums_iff by (intro conjI suminf_emeasure) auto
 
 lemma emeasure_additive: "additive (sets M) (emeasure M)"
   by (metis sets.countably_additive_additive emeasure_positive emeasure_countably_additive)
 
 lemma plus_emeasure:
   "a \<in> sets M \<Longrightarrow> b \<in> sets M \<Longrightarrow> a \<inter> b = {} \<Longrightarrow> emeasure M a + emeasure M b = emeasure M (a \<union> b)"
   using additiveD[OF emeasure_additive] ..
 
 lemma emeasure_Un:
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> emeasure M (A \<union> B) = emeasure M A + emeasure M (B - A)"
   using plus_emeasure[of A M "B - A"] by auto
 
 lemma emeasure_Un_Int:
   assumes "A \<in> sets M" "B \<in> sets M"
   shows "emeasure M A + emeasure M B = emeasure M (A \<union> B) + emeasure M (A \<inter> B)"
 proof -
   have "A = (A-B) \<union> (A \<inter> B)" by auto
   then have "emeasure M A = emeasure M (A-B) + emeasure M (A \<inter> B)"
     by (metis Diff_Diff_Int Diff_disjoint assms plus_emeasure sets.Diff)
   moreover have "A \<union> B = (A-B) \<union> B" by auto
   then have "emeasure M (A \<union> B) = emeasure M (A-B) + emeasure M B"
     by (metis Diff_disjoint Int_commute assms plus_emeasure sets.Diff)
   ultimately show ?thesis by (metis add.assoc add.commute)
 qed
 
 lemma sum_emeasure:
   "F`I \<subseteq> sets M \<Longrightarrow> disjoint_family_on F I \<Longrightarrow> finite I \<Longrightarrow>
     (\<Sum>i\<in>I. emeasure M (F i)) = emeasure M (\<Union>i\<in>I. F i)"
   by (metis sets.additive_sum emeasure_positive emeasure_additive)
 
 lemma emeasure_mono:
   "a \<subseteq> b \<Longrightarrow> b \<in> sets M \<Longrightarrow> emeasure M a \<le> emeasure M b"
   by (metis zero_le sets.additive_increasing emeasure_additive emeasure_notin_sets emeasure_positive increasingD)
 
 lemma emeasure_space:
   "emeasure M A \<le> emeasure M (space M)"
   by (metis emeasure_mono emeasure_notin_sets sets.sets_into_space sets.top zero_le)
 
 lemma emeasure_Diff:
   assumes "emeasure M B \<noteq> \<infinity>"
   and "A \<in> sets M" "B \<in> sets M" and "B \<subseteq> A"
   shows "emeasure M (A - B) = emeasure M A - emeasure M B"
   by (smt (verit, best) add_diff_self_ennreal assms emeasure_Un emeasure_mono 
       ennreal_add_left_cancel le_iff_sup)
 
 lemma emeasure_compl:
   "s \<in> sets M \<Longrightarrow> emeasure M s \<noteq> \<infinity> \<Longrightarrow> emeasure M (space M - s) = emeasure M (space M) - emeasure M s"
   by (rule emeasure_Diff) (auto dest: sets.sets_into_space)
 
 lemma Lim_emeasure_incseq:
   "range A \<subseteq> sets M \<Longrightarrow> incseq A \<Longrightarrow> (\<lambda>i. (emeasure M (A i))) \<longlonglongrightarrow> emeasure M (\<Union>i. A i)"
   using emeasure_countably_additive
   by (auto simp add: sets.countably_additive_iff_continuous_from_below emeasure_positive
     emeasure_additive)
 
 lemma incseq_emeasure:
   assumes "range B \<subseteq> sets M" "incseq B"
   shows "incseq (\<lambda>i. emeasure M (B i))"
   using assms by (auto simp: incseq_def intro!: emeasure_mono)
 
 lemma SUP_emeasure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A"
   shows "(SUP n. emeasure M (A n)) = emeasure M (\<Union>i. A i)"
   using LIMSEQ_SUP[OF incseq_emeasure, OF A] Lim_emeasure_incseq[OF A]
   by (simp add: LIMSEQ_unique)
 
 lemma decseq_emeasure:
   assumes "range B \<subseteq> sets M" "decseq B"
   shows "decseq (\<lambda>i. emeasure M (B i))"
   using assms by (auto simp: decseq_def intro!: emeasure_mono)
 
 lemma INF_emeasure_decseq:
   assumes A: "range A \<subseteq> sets M" and "decseq A"
   and finite: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(INF n. emeasure M (A n)) = emeasure M (\<Inter>i. A i)"
 proof -
   have le_MI: "emeasure M (\<Inter>i. A i) \<le> emeasure M (A 0)"
     using A by (auto intro!: emeasure_mono)
   hence *: "emeasure M (\<Inter>i. A i) \<noteq> \<infinity>" using finite[of 0] by (auto simp: top_unique)
 
   have "emeasure M (A 0) - (INF n. emeasure M (A n)) = (SUP n. emeasure M (A 0) - emeasure M (A n))"
     by (simp add: ennreal_INF_const_minus)
   also have "\<dots> = (SUP n. emeasure M (A 0 - A n))"
     using A finite \<open>decseq A\<close>[unfolded decseq_def] by (subst emeasure_Diff) auto
   also have "\<dots> = emeasure M (\<Union>i. A 0 - A i)"
   proof (rule SUP_emeasure_incseq)
     show "range (\<lambda>n. A 0 - A n) \<subseteq> sets M"
       using A by auto
     show "incseq (\<lambda>n. A 0 - A n)"
       using \<open>decseq A\<close> by (auto simp add: incseq_def decseq_def)
   qed
   also have "\<dots> = emeasure M (A 0) - emeasure M (\<Inter>i. A i)"
     using A finite * by (simp, subst emeasure_Diff) auto
   finally show ?thesis
     by (smt (verit, best) Inf_lower diff_diff_ennreal le_MI finite range_eqI)
 qed
 
 lemma INF_emeasure_decseq':
   assumes A: "\<And>i. A i \<in> sets M" and "decseq A"
   and finite: "\<exists>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(INF n. emeasure M (A n)) = emeasure M (\<Inter>i. A i)"
 proof -
   from finite obtain i where i: "emeasure M (A i) < \<infinity>"
     by (auto simp: less_top)
   have fin: "i \<le> j \<Longrightarrow> emeasure M (A j) < \<infinity>" for j
     by (rule le_less_trans[OF emeasure_mono i]) (auto intro!: decseqD[OF \<open>decseq A\<close>] A)
 
   have "(INF n. emeasure M (A n)) = (INF n. emeasure M (A (n + i)))"
   proof (rule INF_eq)
     show "\<exists>j\<in>UNIV. emeasure M (A (j + i)) \<le> emeasure M (A i')" for i'
       by (meson A \<open>decseq A\<close> decseq_def emeasure_mono iso_tuple_UNIV_I nat_le_iff_add)
   qed auto
   also have "\<dots> = emeasure M (INF n. (A (n + i)))"
     using A \<open>decseq A\<close> fin by (intro INF_emeasure_decseq) (auto simp: decseq_def less_top)
   also have "(INF n. (A (n + i))) = (INF n. A n)"
     by (meson INF_eq UNIV_I assms(2) decseqD le_add1)
   finally show ?thesis .
 qed
 
 lemma emeasure_INT_decseq_subset:
   fixes F :: "nat \<Rightarrow> 'a set"
   assumes I: "I \<noteq> {}" and F: "\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> i \<le> j \<Longrightarrow> F j \<subseteq> F i"
   assumes F_sets[measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M"
     and fin: "\<And>i. i \<in> I \<Longrightarrow> emeasure M (F i) \<noteq> \<infinity>"
   shows "emeasure M (\<Inter>i\<in>I. F i) = (INF i\<in>I. emeasure M (F i))"
 proof cases
   assume "finite I"
   have "(\<Inter>i\<in>I. F i) = F (Max I)"
     using I \<open>finite I\<close> by (intro antisym INF_lower INF_greatest F) auto
   moreover have "(INF i\<in>I. emeasure M (F i)) = emeasure M (F (Max I))"
     using I \<open>finite I\<close> by (intro antisym INF_lower INF_greatest F emeasure_mono) auto
   ultimately show ?thesis
     by simp
 next
   assume "infinite I"
   define L where "L n = (LEAST i. i \<in> I \<and> i \<ge> n)" for n
   have L: "L n \<in> I \<and> n \<le> L n" for n
     unfolding L_def
   proof (rule LeastI_ex)
     show "\<exists>x. x \<in> I \<and> n \<le> x"
       using \<open>infinite I\<close> finite_subset[of I "{..< n}"]
       by (rule_tac ccontr) (auto simp: not_le)
   qed
   have L_eq[simp]: "i \<in> I \<Longrightarrow> L i = i" for i
     unfolding L_def by (intro Least_equality) auto
   have L_mono: "i \<le> j \<Longrightarrow> L i \<le> L j" for i j
     using L[of j] unfolding L_def by (intro Least_le) (auto simp: L_def)
 
   have "emeasure M (\<Inter>i. F (L i)) = (INF i. emeasure M (F (L i)))"
   proof (intro INF_emeasure_decseq[symmetric])
     show "decseq (\<lambda>i. F (L i))"
       using L by (intro antimonoI F L_mono) auto
   qed (insert L fin, auto)
   also have "\<dots> = (INF i\<in>I. emeasure M (F i))"
   proof (intro antisym INF_greatest)
     show "i \<in> I \<Longrightarrow> (INF i. emeasure M (F (L i))) \<le> emeasure M (F i)" for i
       by (intro INF_lower2[of i]) auto
   qed (insert L, auto intro: INF_lower)
   also have "(\<Inter>i. F (L i)) = (\<Inter>i\<in>I. F i)"
   proof (intro antisym INF_greatest)
     show "i \<in> I \<Longrightarrow> (\<Inter>i. F (L i)) \<subseteq> F i" for i
       by (intro INF_lower2[of i]) auto
   qed (insert L, auto)
   finally show ?thesis .
 qed
 
 lemma Lim_emeasure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A" and fin: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. emeasure M (A i)) \<longlonglongrightarrow> emeasure M (\<Inter>i. A i)"
   using LIMSEQ_INF[OF decseq_emeasure, OF A]
   using INF_emeasure_decseq[OF A fin] by simp
 
 lemma emeasure_lfp'[consumes 1, case_names cont measurable]:
   assumes "P M"
   assumes cont: "sup_continuous F"
   assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> Measurable.pred N A) \<Longrightarrow> Measurable.pred M (F A)"
   shows "emeasure M {x\<in>space M. lfp F x} = (SUP i. emeasure M {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
 proof -
   have "emeasure M {x\<in>space M. lfp F x} = emeasure M (\<Union>i. {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
     using sup_continuous_lfp[OF cont] by (auto simp add: bot_fun_def intro!: arg_cong2[where f=emeasure])
   moreover { fix i from \<open>P M\<close> have "{x\<in>space M. (F ^^ i) (\<lambda>x. False) x} \<in> sets M"
     by (induct i arbitrary: M) (auto simp add: pred_def[symmetric] intro: *) }
   moreover have "incseq (\<lambda>i. {x\<in>space M. (F ^^ i) (\<lambda>x. False) x})"
   proof (rule incseq_SucI)
     fix i
     have "(F ^^ i) (\<lambda>x. False) \<le> (F ^^ (Suc i)) (\<lambda>x. False)"
     proof (induct i)
       case 0 show ?case by (simp add: le_fun_def)
     next
       case Suc thus ?case using monoD[OF sup_continuous_mono[OF cont] Suc] by auto
     qed
     then show "{x \<in> space M. (F ^^ i) (\<lambda>x. False) x} \<subseteq> {x \<in> space M. (F ^^ Suc i) (\<lambda>x. False) x}"
       by auto
   qed
   ultimately show ?thesis
     by (subst SUP_emeasure_incseq) auto
 qed
 
 lemma emeasure_lfp:
   assumes [simp]: "\<And>s. sets (M s) = sets N"
   assumes cont: "sup_continuous F" "sup_continuous f"
   assumes meas: "\<And>P. Measurable.pred N P \<Longrightarrow> Measurable.pred N (F P)"
   assumes iter: "\<And>P s. Measurable.pred N P \<Longrightarrow> P \<le> lfp F \<Longrightarrow> emeasure (M s) {x\<in>space N. F P x} = f (\<lambda>s. emeasure (M s) {x\<in>space N. P x}) s"
   shows "emeasure (M s) {x\<in>space N. lfp F x} = lfp f s"
 proof (subst lfp_transfer_bounded[where \<alpha>="\<lambda>F s. emeasure (M s) {x\<in>space N. F x}" and f=F , symmetric])
   fix C assume "incseq C" "\<And>i. Measurable.pred N (C i)"
   then show "(\<lambda>s. emeasure (M s) {x \<in> space N. (SUP i. C i) x}) = (SUP i. (\<lambda>s. emeasure (M s) {x \<in> space N. C i x}))"
     unfolding SUP_apply
     by (subst SUP_emeasure_incseq) (auto simp: mono_def fun_eq_iff intro!: arg_cong2[where f=emeasure])
 qed (auto simp add: iter le_fun_def SUP_apply intro!: meas cont)
 
 lemma emeasure_subadditive_finite:
   "finite I \<Longrightarrow> A ` I \<subseteq> sets M \<Longrightarrow> emeasure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. emeasure M (A i))"
   by (rule sets.subadditive[OF emeasure_positive emeasure_additive]) auto
 
 lemma emeasure_subadditive:
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> emeasure M (A \<union> B) \<le> emeasure M A + emeasure M B"
   using emeasure_subadditive_finite[of "{True, False}" "\<lambda>True \<Rightarrow> A | False \<Rightarrow> B" M] by simp
 
 lemma emeasure_subadditive_countably:
   assumes "range f \<subseteq> sets M"
   shows "emeasure M (\<Union>i. f i) \<le> (\<Sum>i. emeasure M (f i))"
 proof -
   have "emeasure M (\<Union>i. f i) = emeasure M (\<Union>i. disjointed f i)"
     unfolding UN_disjointed_eq ..
   also have "\<dots> = (\<Sum>i. emeasure M (disjointed f i))"
     using sets.range_disjointed_sets[OF assms] suminf_emeasure[of "disjointed f"]
     by (simp add:  disjoint_family_disjointed comp_def)
   also have "\<dots> \<le> (\<Sum>i. emeasure M (f i))"
     using sets.range_disjointed_sets[OF assms] assms
     by (auto intro!: suminf_le emeasure_mono disjointed_subset)
   finally show ?thesis .
 qed
 
 lemma emeasure_insert:
   assumes sets: "{x} \<in> sets M" "A \<in> sets M" and "x \<notin> A"
   shows "emeasure M (insert x A) = emeasure M {x} + emeasure M A"
 proof -
   have "{x} \<inter> A = {}" using \<open>x \<notin> A\<close> by auto
   from plus_emeasure[OF sets this] show ?thesis by simp
 qed
 
 lemma emeasure_insert_ne:
   "A \<noteq> {} \<Longrightarrow> {x} \<in> sets M \<Longrightarrow> A \<in> sets M \<Longrightarrow> x \<notin> A \<Longrightarrow> emeasure M (insert x A) = emeasure M {x} + emeasure M A"
   by (rule emeasure_insert)
 
 lemma emeasure_eq_sum_singleton:
   assumes "finite S" "\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M"
   shows "emeasure M S = (\<Sum>x\<in>S. emeasure M {x})"
   using sum_emeasure[of "\<lambda>x. {x}" S M] assms
   by (auto simp: disjoint_family_on_def subset_eq)
 
 lemma sum_emeasure_cover:
   assumes "finite S" and "A \<in> sets M" and br_in_M: "B ` S \<subseteq> sets M"
   assumes A: "A \<subseteq> (\<Union>i\<in>S. B i)"
   assumes disj: "disjoint_family_on B S"
   shows "emeasure M A = (\<Sum>i\<in>S. emeasure M (A \<inter> (B i)))"
 proof -
   have "(\<Sum>i\<in>S. emeasure M (A \<inter> (B i))) = emeasure M (\<Union>i\<in>S. A \<inter> (B i))"
   proof (rule sum_emeasure)
     show "disjoint_family_on (\<lambda>i. A \<inter> B i) S"
       using \<open>disjoint_family_on B S\<close>
       unfolding disjoint_family_on_def by auto
   qed (insert assms, auto)
   also have "(\<Union>i\<in>S. A \<inter> (B i)) = A"
     using A by auto
   finally show ?thesis by simp
 qed
 
 lemma emeasure_eq_0:
   "N \<in> sets M \<Longrightarrow> emeasure M N = 0 \<Longrightarrow> K \<subseteq> N \<Longrightarrow> emeasure M K = 0"
   by (metis emeasure_mono order_eq_iff zero_le)
 
 lemma emeasure_UN_eq_0:
   assumes "\<And>i::nat. emeasure M (N i) = 0" and "range N \<subseteq> sets M"
   shows "emeasure M (\<Union>i. N i) = 0"
 proof -
   have "emeasure M (\<Union>i. N i) \<le> 0"
     using emeasure_subadditive_countably[OF assms(2)] assms(1) by simp
   then show ?thesis
     by (auto intro: antisym zero_le)
 qed
 
 lemma measure_eqI_finite:
   assumes [simp]: "sets M = Pow A" "sets N = Pow A" and "finite A"
   assumes eq: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} = emeasure N {a}"
   shows "M = N"
 proof (rule measure_eqI)
   fix X assume "X \<in> sets M"
   then have X: "X \<subseteq> A" by auto
   then have "emeasure M X = (\<Sum>a\<in>X. emeasure M {a})"
     using \<open>finite A\<close> by (subst emeasure_eq_sum_singleton) (auto dest: finite_subset)
   also have "\<dots> = (\<Sum>a\<in>X. emeasure N {a})"
     using X eq by (auto intro!: sum.cong)
   also have "\<dots> = emeasure N X"
     using X \<open>finite A\<close> by (subst emeasure_eq_sum_singleton) (auto dest: finite_subset)
   finally show "emeasure M X = emeasure N X" .
 qed simp
 
 lemma measure_eqI_generator_eq:
   fixes M N :: "'a measure" and E :: "'a set set" and A :: "nat \<Rightarrow> 'a set"
   assumes "Int_stable E" "E \<subseteq> Pow \<Omega>"
   and eq: "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
   and M: "sets M = sigma_sets \<Omega> E"
   and N: "sets N = sigma_sets \<Omega> E"
   and A: "range A \<subseteq> E" "(\<Union>i. A i) = \<Omega>" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "M = N"
 proof -
   let ?\<mu>  = "emeasure M" and ?\<nu> = "emeasure N"
   interpret S: sigma_algebra \<Omega> "sigma_sets \<Omega> E" by (rule sigma_algebra_sigma_sets) fact
   have "space M = \<Omega>"
     using sets.top[of M] sets.space_closed[of M] S.top S.space_closed \<open>sets M = sigma_sets \<Omega> E\<close>
     by blast
 
   { fix F D assume "F \<in> E" and "?\<mu> F \<noteq> \<infinity>"
     then have [intro]: "F \<in> sigma_sets \<Omega> E" by auto
     have "?\<nu> F \<noteq> \<infinity>" using \<open>?\<mu> F \<noteq> \<infinity>\<close> \<open>F \<in> E\<close> eq by simp
     assume "D \<in> sets M"
     with \<open>Int_stable E\<close> \<open>E \<subseteq> Pow \<Omega>\<close> have "emeasure M (F \<inter> D) = emeasure N (F \<inter> D)"
       unfolding M
     proof (induct rule: sigma_sets_induct_disjoint)
       case (basic A)
       then have "F \<inter> A \<in> E" using \<open>Int_stable E\<close> \<open>F \<in> E\<close> by (auto simp: Int_stable_def)
       then show ?case using eq by auto
     next
       case empty then show ?case by simp
     next
       case (compl A)
       then have **: "F \<inter> (\<Omega> - A) = F - (F \<inter> A)"
         and [intro]: "F \<inter> A \<in> sigma_sets \<Omega> E"
         using \<open>F \<in> E\<close> S.sets_into_space by (auto simp: M)
       have "?\<nu> (F \<inter> A) \<le> ?\<nu> F" by (auto intro!: emeasure_mono simp: M N)
       then have "?\<nu> (F \<inter> A) \<noteq> \<infinity>" using \<open>?\<nu> F \<noteq> \<infinity>\<close> by (auto simp: top_unique)
       have "?\<mu> (F \<inter> A) \<le> ?\<mu> F" by (auto intro!: emeasure_mono simp: M N)
       then have "?\<mu> (F \<inter> A) \<noteq> \<infinity>" using \<open>?\<mu> F \<noteq> \<infinity>\<close> by (auto simp: top_unique)
       then have "?\<mu> (F \<inter> (\<Omega> - A)) = ?\<mu> F - ?\<mu> (F \<inter> A)" unfolding **
         using \<open>F \<inter> A \<in> sigma_sets \<Omega> E\<close> by (auto intro!: emeasure_Diff simp: M N)
       also have "\<dots> = ?\<nu> F - ?\<nu> (F \<inter> A)" using eq \<open>F \<in> E\<close> compl by simp
       also have "\<dots> = ?\<nu> (F \<inter> (\<Omega> - A))" unfolding **
         using \<open>F \<inter> A \<in> sigma_sets \<Omega> E\<close> \<open>?\<nu> (F \<inter> A) \<noteq> \<infinity>\<close>
         by (auto intro!: emeasure_Diff[symmetric] simp: M N)
       finally show ?case
         using \<open>space M = \<Omega>\<close> by auto
     next
       case (union A)
       then have "?\<mu> (\<Union>x. F \<inter> A x) = ?\<nu> (\<Union>x. F \<inter> A x)"
         by (subst (1 2) suminf_emeasure[symmetric]) (auto simp: disjoint_family_on_def subset_eq M N)
       with A show ?case
         by auto
     qed }
   note * = this
   show "M = N"
   proof (rule measure_eqI)
     show "sets M = sets N"
       using M N by simp
     have [simp, intro]: "\<And>i. A i \<in> sets M"
       using A(1) by (auto simp: subset_eq M)
     fix F assume "F \<in> sets M"
     let ?D = "disjointed (\<lambda>i. F \<inter> A i)"
     from \<open>space M = \<Omega>\<close> have F_eq: "F = (\<Union>i. ?D i)"
       using \<open>F \<in> sets M\<close>[THEN sets.sets_into_space] A(2)[symmetric] by (auto simp: UN_disjointed_eq)
     have [simp, intro]: "\<And>i. ?D i \<in> sets M"
       using sets.range_disjointed_sets[of "\<lambda>i. F \<inter> A i" M] \<open>F \<in> sets M\<close>
       by (auto simp: subset_eq)
     have "disjoint_family ?D"
       by (auto simp: disjoint_family_disjointed)
     moreover
     have "(\<Sum>i. emeasure M (?D i)) = (\<Sum>i. emeasure N (?D i))"
     proof (intro arg_cong[where f=suminf] ext)
       fix i
       have "A i \<inter> ?D i = ?D i"
         by (auto simp: disjointed_def)
       then show "emeasure M (?D i) = emeasure N (?D i)"
         using *[of "A i" "?D i", OF _ A(3)] A(1) by auto
     qed
     ultimately show "emeasure M F = emeasure N F"
       by (simp add: image_subset_iff \<open>sets M = sets N\<close>[symmetric] F_eq[symmetric] suminf_emeasure)
   qed
 qed
 
 lemma space_empty: "space M = {} \<Longrightarrow> M = count_space {}"
   by (rule measure_eqI) (simp_all add: space_empty_iff)
 
 lemma measure_eqI_generator_eq_countable:
   fixes M N :: "'a measure" and E :: "'a set set" and A :: "'a set set"
   assumes E: "Int_stable E" "E \<subseteq> Pow \<Omega>" "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
     and sets: "sets M = sigma_sets \<Omega> E" "sets N = sigma_sets \<Omega> E"
   and A: "A \<subseteq> E" "(\<Union>A) = \<Omega>" "countable A" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
   shows "M = N"
 proof cases
   assume "\<Omega> = {}"
   have *: "sigma_sets \<Omega> E = sets (sigma \<Omega> E)"
     using E(2) by simp
   have "space M = \<Omega>" "space N = \<Omega>"
     using sets E(2) unfolding * by (auto dest: sets_eq_imp_space_eq simp del: sets_measure_of)
   then show "M = N"
     unfolding \<open>\<Omega> = {}\<close> by (auto dest: space_empty)
 next
   assume "\<Omega> \<noteq> {}" with \<open>\<Union>A = \<Omega>\<close> have "A \<noteq> {}" by auto
   from this \<open>countable A\<close> have rng: "range (from_nat_into A) = A"
     by (rule range_from_nat_into)
   show "M = N"
   proof (rule measure_eqI_generator_eq[OF E sets])
     show "range (from_nat_into A) \<subseteq> E"
       unfolding rng using \<open>A \<subseteq> E\<close> .
     show "(\<Union>i. from_nat_into A i) = \<Omega>"
       unfolding rng using \<open>\<Union>A = \<Omega>\<close> .
     show "emeasure M (from_nat_into A i) \<noteq> \<infinity>" for i
       using rng by (intro A) auto
   qed
 qed
 
 lemma measure_of_of_measure: "measure_of (space M) (sets M) (emeasure M) = M"
 proof (intro measure_eqI emeasure_measure_of_sigma)
   show "sigma_algebra (space M) (sets M)" ..
   show "positive (sets M) (emeasure M)"
     by (simp add: positive_def)
   show "countably_additive (sets M) (emeasure M)"
     by (simp add: emeasure_countably_additive)
 qed simp_all
 
 subsection \<open>\<open>\<mu>\<close>-null sets\<close>
 
 definition\<^marker>\<open>tag important\<close> null_sets :: "'a measure \<Rightarrow> 'a set set" where
   "null_sets M = {N\<in>sets M. emeasure M N = 0}"
 
 lemma null_setsD1[dest]: "A \<in> null_sets M \<Longrightarrow> emeasure M A = 0"
   by (simp add: null_sets_def)
 
 lemma null_setsD2[dest]: "A \<in> null_sets M \<Longrightarrow> A \<in> sets M"
   unfolding null_sets_def by simp
 
 lemma null_setsI[intro]: "emeasure M A = 0 \<Longrightarrow> A \<in> sets M \<Longrightarrow> A \<in> null_sets M"
   unfolding null_sets_def by simp
 
 interpretation null_sets: ring_of_sets "space M" "null_sets M" for M
 proof (rule ring_of_setsI)
   show "null_sets M \<subseteq> Pow (space M)"
     using sets.sets_into_space by auto
   show "{} \<in> null_sets M"
     by auto
   fix A B assume null_sets: "A \<in> null_sets M" "B \<in> null_sets M"
   then have sets: "A \<in> sets M" "B \<in> sets M"
     by auto
   then have *: "emeasure M (A \<union> B) \<le> emeasure M A + emeasure M B"
     "emeasure M (A - B) \<le> emeasure M A"
     by (auto intro!: emeasure_subadditive emeasure_mono)
   then have "emeasure M B = 0" "emeasure M A = 0"
     using null_sets by auto
   with sets * show "A - B \<in> null_sets M" "A \<union> B \<in> null_sets M"
     by (auto intro!: antisym zero_le)
 qed
 
 lemma UN_from_nat_into:
   assumes I: "countable I" "I \<noteq> {}"
   shows "(\<Union>i\<in>I. N i) = (\<Union>i. N (from_nat_into I i))"
 proof -
   have "(\<Union>i\<in>I. N i) = \<Union>(N ` range (from_nat_into I))"
     using I by simp
   also have "\<dots> = (\<Union>i. (N \<circ> from_nat_into I) i)"
     by simp
   finally show ?thesis by simp
 qed
 
 lemma null_sets_UN':
   assumes "countable I"
   assumes "\<And>i. i \<in> I \<Longrightarrow> N i \<in> null_sets M"
   shows "(\<Union>i\<in>I. N i) \<in> null_sets M"
 proof cases
   assume "I = {}" then show ?thesis by simp
 next
   assume "I \<noteq> {}"
   show ?thesis
   proof (intro conjI CollectI null_setsI)
     show "(\<Union>i\<in>I. N i) \<in> sets M"
       using assms by (intro sets.countable_UN') auto
     have "emeasure M (\<Union>i\<in>I. N i) \<le> (\<Sum>n. emeasure M (N (from_nat_into I n)))"
       unfolding UN_from_nat_into[OF \<open>countable I\<close> \<open>I \<noteq> {}\<close>]
       using assms \<open>I \<noteq> {}\<close> by (intro emeasure_subadditive_countably) (auto intro: from_nat_into)
     also have "(\<lambda>n. emeasure M (N (from_nat_into I n))) = (\<lambda>_. 0)"
       using assms \<open>I \<noteq> {}\<close> by (auto intro: from_nat_into)
     finally show "emeasure M (\<Union>i\<in>I. N i) = 0"
       by (intro antisym zero_le) simp
   qed
 qed
 
 lemma null_sets_UN[intro]:
   "(\<And>i::'i::countable. N i \<in> null_sets M) \<Longrightarrow> (\<Union>i. N i) \<in> null_sets M"
   by (rule null_sets_UN') auto
 
 lemma null_set_Int1:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "A \<inter> B \<in> null_sets M"
 proof (intro CollectI conjI null_setsI)
   show "emeasure M (A \<inter> B) = 0" using assms
     by (intro emeasure_eq_0[of B _ "A \<inter> B"]) auto
 qed (insert assms, auto)
 
 lemma null_set_Int2:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "B \<inter> A \<in> null_sets M"
   using assms by (subst Int_commute) (rule null_set_Int1)
 
 lemma emeasure_Diff_null_set:
   assumes "B \<in> null_sets M" "A \<in> sets M"
   shows "emeasure M (A - B) = emeasure M A"
 proof -
   have *: "A - B = (A - (A \<inter> B))" by auto
   have "A \<inter> B \<in> null_sets M" using assms by (rule null_set_Int1)
   then show ?thesis
     unfolding * using assms
     by (subst emeasure_Diff) auto
 qed
 
 lemma null_set_Diff:
   assumes "B \<in> null_sets M" "A \<in> sets M" shows "B - A \<in> null_sets M"
 proof (intro CollectI conjI null_setsI)
   show "emeasure M (B - A) = 0" using assms by (intro emeasure_eq_0[of B _ "B - A"]) auto
 qed (insert assms, auto)
 
 lemma emeasure_Un_null_set:
   assumes "A \<in> sets M" "B \<in> null_sets M"
   shows "emeasure M (A \<union> B) = emeasure M A"
 proof -
   have *: "A \<union> B = A \<union> (B - A)" by auto
   have "B - A \<in> null_sets M" using assms(2,1) by (rule null_set_Diff)
   then show ?thesis
     unfolding * using assms
     by (subst plus_emeasure[symmetric]) auto
 qed
 
 lemma emeasure_Un':
   assumes "A \<in> sets M" "B \<in> sets M" "A \<inter> B \<in> null_sets M"
   shows   "emeasure M (A \<union> B) = emeasure M A + emeasure M B"
 proof -
   have "A \<union> B = A \<union> (B - A \<inter> B)" by blast
   also have "emeasure M \<dots> = emeasure M A + emeasure M (B - A \<inter> B)"
     using assms by (subst plus_emeasure) auto
   also have "emeasure M (B - A \<inter> B) = emeasure M B"
     using assms by (intro emeasure_Diff_null_set) auto
   finally show ?thesis .
 qed
 
 subsection \<open>The almost everywhere filter (i.e.\ quantifier)\<close>
 
 definition\<^marker>\<open>tag important\<close> ae_filter :: "'a measure \<Rightarrow> 'a filter" where
   "ae_filter M = (INF N\<in>null_sets M. principal (space M - N))"
 
 abbreviation almost_everywhere :: "'a measure \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
   "almost_everywhere M P \<equiv> eventually P (ae_filter M)"
 
 syntax
   "_almost_everywhere" :: "pttrn \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool" ("AE _ in _. _" [0,0,10] 10)
 
 translations
   "AE x in M. P" \<rightleftharpoons> "CONST almost_everywhere M (\<lambda>x. P)"
 
 abbreviation
   "set_almost_everywhere A M P \<equiv> AE x in M. x \<in> A \<longrightarrow> P x"
 
 syntax
   "_set_almost_everywhere" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> bool"
   ("AE _\<in>_ in _./ _" [0,0,0,10] 10)
 
 translations
   "AE x\<in>A in M. P" \<rightleftharpoons> "CONST set_almost_everywhere A M (\<lambda>x. P)"
 
 lemma eventually_ae_filter: "eventually P (ae_filter M) \<longleftrightarrow> (\<exists>N\<in>null_sets M. {x \<in> space M. \<not> P x} \<subseteq> N)"
   unfolding ae_filter_def by (subst eventually_INF_base) (auto simp: eventually_principal subset_eq)
 
 lemma AE_I':
   "N \<in> null_sets M \<Longrightarrow> {x\<in>space M. \<not> P x} \<subseteq> N \<Longrightarrow> (AE x in M. P x)"
   unfolding eventually_ae_filter by auto
 
 lemma AE_iff_null:
   assumes "{x\<in>space M. \<not> P x} \<in> sets M" (is "?P \<in> sets M")
   shows "(AE x in M. P x) \<longleftrightarrow> {x\<in>space M. \<not> P x} \<in> null_sets M"
 proof
   assume "AE x in M. P x" then obtain N where N: "N \<in> sets M" "?P \<subseteq> N" "emeasure M N = 0"
     unfolding eventually_ae_filter by auto
   have "emeasure M ?P \<le> emeasure M N"
     using assms N(1,2) by (auto intro: emeasure_mono)
   then have "emeasure M ?P = 0"
     unfolding \<open>emeasure M N = 0\<close> by auto
   then show "?P \<in> null_sets M" using assms by auto
 next
   assume "?P \<in> null_sets M" with assms show "AE x in M. P x" by (auto intro: AE_I')
 qed
 
 lemma AE_iff_null_sets:
   "N \<in> sets M \<Longrightarrow> N \<in> null_sets M \<longleftrightarrow> (AE x in M. x \<notin> N)"
   using Int_absorb1[OF sets.sets_into_space, of N M]
   by (subst AE_iff_null) (auto simp: Int_def[symmetric])
 
 lemma ae_filter_eq_bot_iff: "ae_filter M = bot \<longleftrightarrow> emeasure M (space M) = 0"
 proof -
   have "ae_filter M = bot \<longleftrightarrow> (AE x in M. False)"
     using trivial_limit_def by blast
   also have "\<dots> \<longleftrightarrow> space M \<in> null_sets M"
     by (simp add: AE_iff_null_sets eventually_ae_filter)
   also have "\<dots> \<longleftrightarrow> emeasure M (space M) = 0"
     by auto
   finally show ?thesis .
 qed
 
 lemma AE_not_in:
   "N \<in> null_sets M \<Longrightarrow> AE x in M. x \<notin> N"
   by (metis AE_iff_null_sets null_setsD2)
 
 lemma AE_iff_measurable:
   "N \<in> sets M \<Longrightarrow> {x\<in>space M. \<not> P x} = N \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> emeasure M N = 0"
   using AE_iff_null[of _ P] by auto
 
 lemma AE_E[consumes 1]:
   assumes "AE x in M. P x"
   obtains N where "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
   using assms unfolding eventually_ae_filter by auto
 
 lemma AE_E2:
   assumes "AE x in M. P x"
   shows "emeasure M {x\<in>space M. \<not> P x} = 0"
   by (metis (mono_tags, lifting) AE_iff_null assms emeasure_notin_sets null_setsD1)
 
 lemma AE_E3:
   assumes "AE x in M. P x"
   obtains N where "\<And>x. x \<in> space M - N \<Longrightarrow> P x" "N \<in> null_sets M"
 using assms unfolding eventually_ae_filter by auto
 
 lemma AE_I:
   assumes "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
   shows "AE x in M. P x"
   using assms unfolding eventually_ae_filter by auto
 
 lemma AE_mp[elim!]:
   assumes AE_P: "AE x in M. P x" and AE_imp: "AE x in M. P x \<longrightarrow> Q x"
   shows "AE x in M. Q x"
   using assms by (fact eventually_rev_mp)
 
 text \<open>The next lemma is convenient to combine with a lemma whose conclusion is of the
 form \<open>AE x in M. P x = Q x\<close>: for such a lemma, there is no \<open>[symmetric]\<close> variant,
 but using \<open>AE_symmetric[OF\<dots>]\<close> will replace it.\<close>
 
 (* depricated replace by laws about eventually *)
 lemma
   shows AE_iffI: "AE x in M. P x \<Longrightarrow> AE x in M. P x \<longleftrightarrow> Q x \<Longrightarrow> AE x in M. Q x"
     and AE_disjI1: "AE x in M. P x \<Longrightarrow> AE x in M. P x \<or> Q x"
     and AE_disjI2: "AE x in M. Q x \<Longrightarrow> AE x in M. P x \<or> Q x"
     and AE_conjI: "AE x in M. P x \<Longrightarrow> AE x in M. Q x \<Longrightarrow> AE x in M. P x \<and> Q x"
     and AE_conj_iff[simp]: "(AE x in M. P x \<and> Q x) \<longleftrightarrow> (AE x in M. P x) \<and> (AE x in M. Q x)"
   by auto
 
 lemma AE_symmetric:
   assumes "AE x in M. P x = Q x"
   shows "AE x in M. Q x = P x"
   using assms by auto
 
 lemma AE_impI:
   "(P \<Longrightarrow> AE x in M. Q x) \<Longrightarrow> AE x in M. P \<longrightarrow> Q x"
   by fastforce
 
 lemma AE_measure:
   assumes AE: "AE x in M. P x" and sets: "{x\<in>space M. P x} \<in> sets M" (is "?P \<in> sets M")
   shows "emeasure M {x\<in>space M. P x} = emeasure M (space M)"
 proof -
   from AE_E[OF AE] obtain N
     where N: "{x \<in> space M. \<not> P x} \<subseteq> N" "emeasure M N = 0" "N \<in> sets M"
     by auto
   with sets have "emeasure M (space M) \<le> emeasure M (?P \<union> N)"
     by (intro emeasure_mono) auto
   also have "\<dots> \<le> emeasure M ?P + emeasure M N"
     using sets N by (intro emeasure_subadditive) auto
   also have "\<dots> = emeasure M ?P" using N by simp
   finally show "emeasure M ?P = emeasure M (space M)"
     using emeasure_space[of M "?P"] by auto
 qed
 
 lemma AE_space: "AE x in M. x \<in> space M"
   by (rule AE_I[where N="{}"]) auto
 
 lemma AE_I2[simp, intro]:
   "(\<And>x. x \<in> space M \<Longrightarrow> P x) \<Longrightarrow> AE x in M. P x"
   using AE_space by force
 
 lemma AE_Ball_mp:
   "\<forall>x\<in>space M. P x \<Longrightarrow> AE x in M. P x \<longrightarrow> Q x \<Longrightarrow> AE x in M. Q x"
   by auto
 
 lemma AE_cong[cong]:
   "(\<And>x. x \<in> space M \<Longrightarrow> P x \<longleftrightarrow> Q x) \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> (AE x in M. Q x)"
   by auto
 
 lemma AE_cong_simp: "M = N \<Longrightarrow> (\<And>x. x \<in> space N =simp=> P x = Q x) \<Longrightarrow> (AE x in M. P x) \<longleftrightarrow> (AE x in N. Q x)"
   by (auto simp: simp_implies_def)
 
 lemma AE_all_countable:
   "(AE x in M. \<forall>i. P i x) \<longleftrightarrow> (\<forall>i::'i::countable. AE x in M. P i x)"
 proof
   assume "\<forall>i. AE x in M. P i x"
   from this[unfolded eventually_ae_filter Bex_def, THEN choice]
   obtain N where N: "\<And>i. N i \<in> null_sets M" "\<And>i. {x\<in>space M. \<not> P i x} \<subseteq> N i" by auto
   have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. {x\<in>space M. \<not> P i x})" by auto
   also have "\<dots> \<subseteq> (\<Union>i. N i)" using N by auto
   finally have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. N i)" .
   moreover from N have "(\<Union>i. N i) \<in> null_sets M"
     by (intro null_sets_UN) auto
   ultimately show "AE x in M. \<forall>i. P i x"
     unfolding eventually_ae_filter by auto
 qed auto
 
 lemma AE_ball_countable:
   assumes [intro]: "countable X"
   shows "(AE x in M. \<forall>y\<in>X. P x y) \<longleftrightarrow> (\<forall>y\<in>X. AE x in M. P x y)"
 proof
   assume "\<forall>y\<in>X. AE x in M. P x y"
   from this[unfolded eventually_ae_filter Bex_def, THEN bchoice]
   obtain N where N: "\<And>y. y \<in> X \<Longrightarrow> N y \<in> null_sets M" "\<And>y. y \<in> X \<Longrightarrow> {x\<in>space M. \<not> P x y} \<subseteq> N y"
     by auto
   have "{x\<in>space M. \<not> (\<forall>y\<in>X. P x y)} \<subseteq> (\<Union>y\<in>X. {x\<in>space M. \<not> P x y})"
     by auto
   also have "\<dots> \<subseteq> (\<Union>y\<in>X. N y)"
     using N by auto
   finally have "{x\<in>space M. \<not> (\<forall>y\<in>X. P x y)} \<subseteq> (\<Union>y\<in>X. N y)" .
   moreover from N have "(\<Union>y\<in>X. N y) \<in> null_sets M"
     by (intro null_sets_UN') auto
   ultimately show "AE x in M. \<forall>y\<in>X. P x y"
     unfolding eventually_ae_filter by auto
 qed auto
 
 lemma AE_ball_countable':
   "(\<And>N. N \<in> I \<Longrightarrow> AE x in M. P N x) \<Longrightarrow> countable I \<Longrightarrow> AE x in M. \<forall>N \<in> I. P N x"
   unfolding AE_ball_countable by simp
 
 lemma AE_pairwise: "countable F \<Longrightarrow> pairwise (\<lambda>A B. AE x in M. R x A B) F \<longleftrightarrow> (AE x in M. pairwise (R x) F)"
   unfolding pairwise_alt by (simp add: AE_ball_countable)
 
 lemma AE_discrete_difference:
   assumes X: "countable X"
   assumes null: "\<And>x. x \<in> X \<Longrightarrow> emeasure M {x} = 0"
   assumes sets: "\<And>x. x \<in> X \<Longrightarrow> {x} \<in> sets M"
   shows "AE x in M. x \<notin> X"
 proof -
   have "(\<Union>x\<in>X. {x}) \<in> null_sets M"
     using assms by (intro null_sets_UN') auto
   from AE_not_in[OF this] show "AE x in M. x \<notin> X"
     by auto
 qed
 
 lemma AE_finite_all:
   assumes f: "finite S" shows "(AE x in M. \<forall>i\<in>S. P i x) \<longleftrightarrow> (\<forall>i\<in>S. AE x in M. P i x)"
   using f by induct auto
 
 lemma AE_finite_allI:
   assumes "finite S"
   shows "(\<And>s. s \<in> S \<Longrightarrow> AE x in M. Q s x) \<Longrightarrow> AE x in M. \<forall>s\<in>S. Q s x"
   using AE_finite_all[OF \<open>finite S\<close>] by auto
 
 lemma emeasure_mono_AE:
   assumes imp: "AE x in M. x \<in> A \<longrightarrow> x \<in> B"
     and B: "B \<in> sets M"
   shows "emeasure M A \<le> emeasure M B"
 proof cases
   assume A: "A \<in> sets M"
   from imp obtain N where N: "{x\<in>space M. \<not> (x \<in> A \<longrightarrow> x \<in> B)} \<subseteq> N" "N \<in> null_sets M"
     by (auto simp: eventually_ae_filter)
   have "emeasure M A = emeasure M (A - N)"
     using N A by (subst emeasure_Diff_null_set) auto
   also have "emeasure M (A - N) \<le> emeasure M (B - N)"
     using N A B sets.sets_into_space by (auto intro!: emeasure_mono)
   also have "emeasure M (B - N) = emeasure M B"
     using N B by (subst emeasure_Diff_null_set) auto
   finally show ?thesis .
 qed (simp add: emeasure_notin_sets)
 
 lemma emeasure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "emeasure M A = emeasure M B"
   using assms by (safe intro!: antisym emeasure_mono_AE) auto
 
 lemma emeasure_Collect_eq_AE:
   "AE x in M. P x \<longleftrightarrow> Q x \<Longrightarrow> Measurable.pred M Q \<Longrightarrow> Measurable.pred M P \<Longrightarrow>
    emeasure M {x\<in>space M. P x} = emeasure M {x\<in>space M. Q x}"
    by (intro emeasure_eq_AE) auto
 
 lemma emeasure_eq_0_AE: "AE x in M. \<not> P x \<Longrightarrow> emeasure M {x\<in>space M. P x} = 0"
   using AE_iff_measurable[OF _ refl, of M "\<lambda>x. \<not> P x"]
   by (cases "{x\<in>space M. P x} \<in> sets M") (simp_all add: emeasure_notin_sets)
 
 lemma emeasure_0_AE:
   assumes "emeasure M (space M) = 0"
   shows "AE x in M. P x"
 using eventually_ae_filter assms by blast
 
 lemma emeasure_add_AE:
   assumes [measurable]: "A \<in> sets M" "B \<in> sets M" "C \<in> sets M"
   assumes 1: "AE x in M. x \<in> C \<longleftrightarrow> x \<in> A \<or> x \<in> B"
   assumes 2: "AE x in M. \<not> (x \<in> A \<and> x \<in> B)"
   shows "emeasure M C = emeasure M A + emeasure M B"
 proof -
   have "emeasure M C = emeasure M (A \<union> B)"
     by (rule emeasure_eq_AE) (insert 1, auto)
   also have "\<dots> = emeasure M A + emeasure M (B - A)"
     by (subst plus_emeasure) auto
   also have "emeasure M (B - A) = emeasure M B"
     by (rule emeasure_eq_AE) (insert 2, auto)
   finally show ?thesis .
 qed
 
 subsection \<open>\<open>\<sigma>\<close>-finite Measures\<close>
 
 locale\<^marker>\<open>tag important\<close> sigma_finite_measure =
   fixes M :: "'a measure"
   assumes sigma_finite_countable:
     "\<exists>A::'a set set. countable A \<and> A \<subseteq> sets M \<and> (\<Union>A) = space M \<and> (\<forall>a\<in>A. emeasure M a \<noteq> \<infinity>)"
 
 lemma (in sigma_finite_measure) sigma_finite:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
 proof -
   obtain A :: "'a set set" where
     [simp]: "countable A" and
     A: "A \<subseteq> sets M" "(\<Union>A) = space M" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
     using sigma_finite_countable by metis
   show thesis
   proof cases
     assume "A = {}" with \<open>(\<Union>A) = space M\<close> show thesis
       by (intro that[of "\<lambda>_. {}"]) auto
   next
     assume "A \<noteq> {}"
     show thesis
     proof
       show "range (from_nat_into A) \<subseteq> sets M"
         using \<open>A \<noteq> {}\<close> A by auto
       have "(\<Union>i. from_nat_into A i) = \<Union>A"
         using range_from_nat_into[OF \<open>A \<noteq> {}\<close> \<open>countable A\<close>] by auto
       with A show "(\<Union>i. from_nat_into A i) = space M"
         by auto
     qed (intro A from_nat_into \<open>A \<noteq> {}\<close>)
   qed
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_disjoint:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "disjoint_family A"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where
     range: "range A \<subseteq> sets M" and
     space: "(\<Union>i. A i) = space M" and
     measure: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
     using sigma_finite by blast
   show thesis
   proof (rule that[of "disjointed A"])
     show "range (disjointed A) \<subseteq> sets M"
       by (rule sets.range_disjointed_sets[OF range])
     show "(\<Union>i. disjointed A i) = space M"
       and "disjoint_family (disjointed A)"
       using disjoint_family_disjointed UN_disjointed_eq[of A] space range
       by auto
     show "emeasure M (disjointed A i) \<noteq> \<infinity>" for i
     proof -
       have "emeasure M (disjointed A i) \<le> emeasure M (A i)"
         using range disjointed_subset[of A i] by (auto intro!: emeasure_mono)
       then show ?thesis using measure[of i] by (auto simp: top_unique)
     qed
   qed
 qed
 
 lemma (in sigma_finite_measure) sigma_finite_incseq:
   obtains A :: "nat \<Rightarrow> 'a set"
   where "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "incseq A"
 proof -
   obtain F :: "nat \<Rightarrow> 'a set" where
     F: "range F \<subseteq> sets M" "(\<Union>i. F i) = space M" "\<And>i. emeasure M (F i) \<noteq> \<infinity>"
     using sigma_finite by blast
   show thesis
   proof (rule that[of "\<lambda>n. \<Union>i\<le>n. F i"])
     show "range (\<lambda>n. \<Union>i\<le>n. F i) \<subseteq> sets M"
       using F by (force simp: incseq_def)
     show "(\<Union>n. \<Union>i\<le>n. F i) = space M"
     proof -
       from F have "\<And>x. x \<in> space M \<Longrightarrow> \<exists>i. x \<in> F i" by auto
       with F show ?thesis by fastforce
     qed
     show "emeasure M (\<Union>i\<le>n. F i) \<noteq> \<infinity>" for n
     proof -
       have "emeasure M (\<Union>i\<le>n. F i) \<le> (\<Sum>i\<le>n. emeasure M (F i))"
         using F by (auto intro!: emeasure_subadditive_finite)
       also have "\<dots> < \<infinity>"
         using F by (auto simp: sum_Pinfty less_top)
       finally show ?thesis by simp
     qed
     show "incseq (\<lambda>n. \<Union>i\<le>n. F i)"
       by (force simp: incseq_def)
   qed
 qed
 
 lemma (in sigma_finite_measure) approx_PInf_emeasure_with_finite:
   fixes C::real
   assumes W_meas: "W \<in> sets M"
       and W_inf: "emeasure M W = \<infinity>"
   obtains Z where "Z \<in> sets M" "Z \<subseteq> W" "emeasure M Z < \<infinity>" "emeasure M Z > C"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set"
     where A: "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>" "incseq A"
     using sigma_finite_incseq by blast
   define B where "B = (\<lambda>i. W \<inter> A i)"
   have B_meas: "\<And>i. B i \<in> sets M" using W_meas \<open>range A \<subseteq> sets M\<close> B_def by blast
   have b: "\<And>i. B i \<subseteq> W" using B_def by blast
 
   { fix i
     have "emeasure M (B i) \<le> emeasure M (A i)"
       using A by (intro emeasure_mono) (auto simp: B_def)
     also have "emeasure M (A i) < \<infinity>"
       using \<open>\<And>i. emeasure M (A i) \<noteq> \<infinity>\<close> by (simp add: less_top)
     finally have "emeasure M (B i) < \<infinity>" . }
   note c = this
 
   have "W = (\<Union>i. B i)" using B_def \<open>(\<Union>i. A i) = space M\<close> W_meas by auto
   moreover have "incseq B" using B_def \<open>incseq A\<close> by (simp add: incseq_def subset_eq)
   ultimately have "(\<lambda>i. emeasure M (B i)) \<longlonglongrightarrow> emeasure M W" using W_meas B_meas
     by (simp add: B_meas Lim_emeasure_incseq image_subset_iff)
   then have "(\<lambda>i. emeasure M (B i)) \<longlonglongrightarrow> \<infinity>" using W_inf by simp
   from order_tendstoD(1)[OF this, of C]
   obtain i where d: "emeasure M (B i) > C"
     by (auto simp: eventually_sequentially)
   have "B i \<in> sets M" "B i \<subseteq> W" "emeasure M (B i) < \<infinity>" "emeasure M (B i) > C"
     using B_meas b c d by auto
   then show ?thesis using that by blast
 qed
 
 subsection \<open>Measure space induced by distribution of \<^const>\<open>measurable\<close>-functions\<close>
 
 definition\<^marker>\<open>tag important\<close> distr :: "'a measure \<Rightarrow> 'b measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b measure" where
 "distr M N f =
   measure_of (space N) (sets N) (\<lambda>A. emeasure M (f -` A \<inter> space M))"
 
 lemma
   shows sets_distr[simp, measurable_cong]: "sets (distr M N f) = sets N"
     and space_distr[simp]: "space (distr M N f) = space N"
   by (auto simp: distr_def)
 
 lemma
   shows measurable_distr_eq1[simp]: "measurable (distr Mf Nf f) Mf' = measurable Nf Mf'"
     and measurable_distr_eq2[simp]: "measurable Mg' (distr Mg Ng g) = measurable Mg' Ng"
   by (auto simp: measurable_def)
 
 lemma distr_cong:
   "M = K \<Longrightarrow> sets N = sets L \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x = g x) \<Longrightarrow> distr M N f = distr K L g"
   using sets_eq_imp_space_eq[of N L] by (simp add: distr_def Int_def cong: rev_conj_cong)
 
 lemma emeasure_distr:
   fixes f :: "'a \<Rightarrow> 'b"
   assumes f: "f \<in> measurable M N" and A: "A \<in> sets N"
   shows "emeasure (distr M N f) A = emeasure M (f -` A \<inter> space M)" (is "_ = ?\<mu> A")
   unfolding distr_def
 proof (rule emeasure_measure_of_sigma)
   show "positive (sets N) ?\<mu>"
     by (auto simp: positive_def)
 
   show "countably_additive (sets N) ?\<mu>"
   proof (intro countably_additiveI)
     fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets N" "disjoint_family A"
     then have A: "\<And>i. A i \<in> sets N" "(\<Union>i. A i) \<in> sets N" by auto
     then have *: "range (\<lambda>i. f -` (A i) \<inter> space M) \<subseteq> sets M"
       using f by (auto simp: measurable_def)
     moreover have "(\<Union>i. f -`  A i \<inter> space M) \<in> sets M"
       using * by blast
     moreover have **: "disjoint_family (\<lambda>i. f -` A i \<inter> space M)"
       using \<open>disjoint_family A\<close> by (auto simp: disjoint_family_on_def)
     ultimately show "(\<Sum>i. ?\<mu> (A i)) = ?\<mu> (\<Union>i. A i)"
       using suminf_emeasure[OF _ **] A f
       by (auto simp: comp_def vimage_UN)
   qed
   show "sigma_algebra (space N) (sets N)" ..
 qed fact
 
 lemma emeasure_Collect_distr:
   assumes X[measurable]: "X \<in> measurable M N" "Measurable.pred N P"
   shows "emeasure (distr M N X) {x\<in>space N. P x} = emeasure M {x\<in>space M. P (X x)}"
   by (subst emeasure_distr)
      (auto intro!: arg_cong2[where f=emeasure] X(1)[THEN measurable_space])
 
 lemma emeasure_lfp2[consumes 1, case_names cont f measurable]:
   assumes "P M"
   assumes cont: "sup_continuous F"
   assumes f: "\<And>M. P M \<Longrightarrow> f \<in> measurable M' M"
   assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> Measurable.pred N A) \<Longrightarrow> Measurable.pred M (F A)"
   shows "emeasure M' {x\<in>space M'. lfp F (f x)} = (SUP i. emeasure M' {x\<in>space M'. (F ^^ i) (\<lambda>x. False) (f x)})"
 proof (subst (1 2) emeasure_Collect_distr[symmetric, where X=f])
   show "f \<in> measurable M' M"  "f \<in> measurable M' M"
     using f[OF \<open>P M\<close>] by auto
   { fix i show "Measurable.pred M ((F ^^ i) (\<lambda>x. False))"
     using \<open>P M\<close> by (induction i arbitrary: M) (auto intro!: *) }
   show "Measurable.pred M (lfp F)"
     using \<open>P M\<close> cont * by (rule measurable_lfp_coinduct[of P])
 
   have "emeasure (distr M' M f) {x \<in> space (distr M' M f). lfp F x} =
     (SUP i. emeasure (distr M' M f) {x \<in> space (distr M' M f). (F ^^ i) (\<lambda>x. False) x})"
     using \<open>P M\<close>
   proof (coinduction arbitrary: M rule: emeasure_lfp')
     case (measurable A N) then have "\<And>N. P N \<Longrightarrow> Measurable.pred (distr M' N f) A"
       by metis
     then have "\<And>N. P N \<Longrightarrow> Measurable.pred N A"
       by simp
     with \<open>P N\<close>[THEN *] show ?case
       by auto
   qed fact
   then show "emeasure (distr M' M f) {x \<in> space M. lfp F x} =
     (SUP i. emeasure (distr M' M f) {x \<in> space M. (F ^^ i) (\<lambda>x. False) x})"
    by simp
 qed
 
 lemma distr_id[simp]: "distr N N (\<lambda>x. x) = N"
   by (rule measure_eqI) (auto simp: emeasure_distr)
 
 lemma distr_id2: "sets M = sets N \<Longrightarrow> distr N M (\<lambda>x. x) = N"
   by (rule measure_eqI) (auto simp: emeasure_distr)
 
 lemma measure_distr:
   "f \<in> measurable M N \<Longrightarrow> S \<in> sets N \<Longrightarrow> measure (distr M N f) S = measure M (f -` S \<inter> space M)"
   by (simp add: emeasure_distr measure_def)
 
 lemma distr_cong_AE:
   assumes 1: "M = K" "sets N = sets L" and
     2: "(AE x in M. f x = g x)" and "f \<in> measurable M N" and "g \<in> measurable K L"
   shows "distr M N f = distr K L g"
 proof (rule measure_eqI)
   fix A assume "A \<in> sets (distr M N f)"
   with assms show "emeasure (distr M N f) A = emeasure (distr K L g) A"
     by (auto simp add: emeasure_distr intro!: emeasure_eq_AE measurable_sets)
 qed (insert 1, simp)
 
 lemma AE_distrD:
   assumes f: "f \<in> measurable M M'"
     and AE: "AE x in distr M M' f. P x"
   shows "AE x in M. P (f x)"
 proof -
   from AE[THEN AE_E] obtain N
     where "{x \<in> space (distr M M' f). \<not> P x} \<subseteq> N"
       "emeasure (distr M M' f) N = 0"
       "N \<in> sets (distr M M' f)"
     by auto
   with f show ?thesis
     by (simp add: eventually_ae_filter, intro bexI[of _ "f -` N \<inter> space M"])
        (auto simp: emeasure_distr measurable_def)
 qed
 
 lemma AE_distr_iff:
   assumes f[measurable]: "f \<in> measurable M N" and P[measurable]: "{x \<in> space N. P x} \<in> sets N"
   shows "(AE x in distr M N f. P x) \<longleftrightarrow> (AE x in M. P (f x))"
 proof (subst (1 2) AE_iff_measurable[OF _ refl])
   have "f -` {x\<in>space N. \<not> P x} \<inter> space M = {x \<in> space M. \<not> P (f x)}"
     using f[THEN measurable_space] by auto
   then show "(emeasure (distr M N f) {x \<in> space (distr M N f). \<not> P x} = 0) =
     (emeasure M {x \<in> space M. \<not> P (f x)} = 0)"
     by (simp add: emeasure_distr)
 qed auto
 
 lemma null_sets_distr_iff:
   "f \<in> measurable M N \<Longrightarrow> A \<in> null_sets (distr M N f) \<longleftrightarrow> f -` A \<inter> space M \<in> null_sets M \<and> A \<in> sets N"
   by (auto simp add: null_sets_def emeasure_distr)
 
 proposition distr_distr:
   "g \<in> measurable N L \<Longrightarrow> f \<in> measurable M N \<Longrightarrow> distr (distr M N f) L g = distr M L (g \<circ> f)"
   by (auto simp add: emeasure_distr measurable_space
            intro!: arg_cong[where f="emeasure M"] measure_eqI)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Real measure values\<close>
 
 lemma ring_of_finite_sets: "ring_of_sets (space M) {A\<in>sets M. emeasure M A \<noteq> top}"
 proof (rule ring_of_setsI)
   show "a \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow> b \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow>
     a \<union> b \<in> {A \<in> sets M. emeasure M A \<noteq> top}" for a b
     using emeasure_subadditive[of a M b] by (auto simp: top_unique)
 
   show "a \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow> b \<in> {A \<in> sets M. emeasure M A \<noteq> top} \<Longrightarrow>
     a - b \<in> {A \<in> sets M. emeasure M A \<noteq> top}" for a b
     using emeasure_mono[of "a - b" a M] by (auto simp: top_unique)
 qed (auto dest: sets.sets_into_space)
 
 lemma measure_nonneg[simp]: "0 \<le> measure M A"
   unfolding measure_def by auto
 
 lemma measure_nonneg' [simp]: "\<not> measure M A < 0"
   using measure_nonneg not_le by blast
 
 lemma zero_less_measure_iff: "0 < measure M A \<longleftrightarrow> measure M A \<noteq> 0"
   using measure_nonneg[of M A] by (auto simp add: le_less)
 
 lemma measure_le_0_iff: "measure M X \<le> 0 \<longleftrightarrow> measure M X = 0"
   using measure_nonneg[of M X] by linarith
 
 lemma measure_empty[simp]: "measure M {} = 0"
   unfolding measure_def by (simp add: zero_ennreal.rep_eq)
 
 lemma emeasure_eq_ennreal_measure:
   "emeasure M A \<noteq> top \<Longrightarrow> emeasure M A = ennreal (measure M A)"
   by (cases "emeasure M A" rule: ennreal_cases) (auto simp: measure_def)
 
 lemma measure_zero_top: "emeasure M A = top \<Longrightarrow> measure M A = 0"
   by (simp add: measure_def)
 
 lemma measure_eq_emeasure_eq_ennreal: "0 \<le> x \<Longrightarrow> emeasure M A = ennreal x \<Longrightarrow> measure M A = x"
   using emeasure_eq_ennreal_measure[of M A]
   by (cases "A \<in> M") (auto simp: measure_notin_sets emeasure_notin_sets)
 
 lemma enn2real_plus:"a < top \<Longrightarrow> b < top \<Longrightarrow> enn2real (a + b) = enn2real a + enn2real b"
   by (simp add: enn2real_def plus_ennreal.rep_eq real_of_ereal_add less_top
            del: real_of_ereal_enn2ereal)
 
 lemma enn2real_sum:"(\<And>i. i \<in> I \<Longrightarrow> f i < top) \<Longrightarrow> enn2real (sum f I) = sum (enn2real \<circ> f) I"
   by (induction I rule: infinite_finite_induct) (auto simp: enn2real_plus)
 
 lemma measure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "measure M A = measure M B"
   using assms emeasure_eq_AE[OF assms] by (simp add: measure_def)
 
 lemma measure_Union:
   "emeasure M A \<noteq> \<infinity> \<Longrightarrow> emeasure M B \<noteq> \<infinity> \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A \<inter> B = {} \<Longrightarrow>
     measure M (A \<union> B) = measure M A + measure M B"
   by (simp add: measure_def plus_emeasure[symmetric] enn2real_plus less_top)
 
 lemma measure_finite_Union:
   "finite S \<Longrightarrow> A`S \<subseteq> sets M \<Longrightarrow> disjoint_family_on A S \<Longrightarrow> (\<And>i. i \<in> S \<Longrightarrow> emeasure M (A i) \<noteq> \<infinity>) \<Longrightarrow>
     measure M (\<Union>i\<in>S. A i) = (\<Sum>i\<in>S. measure M (A i))"
   by (induction S rule: finite_induct)
      (auto simp: disjoint_family_on_insert measure_Union sum_emeasure[symmetric] sets.countable_UN'[OF countable_finite])
 
 lemma measure_Diff:
   assumes finite: "emeasure M A \<noteq> \<infinity>"
   and measurable: "A \<in> sets M" "B \<in> sets M" "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
 proof -
   have "emeasure M (A - B) \<le> emeasure M A" "emeasure M B \<le> emeasure M A"
     using measurable by (auto intro!: emeasure_mono)
   hence "measure M ((A - B) \<union> B) = measure M (A - B) + measure M B"
     using measurable finite by (rule_tac measure_Union) (auto simp: top_unique)
   thus ?thesis using \<open>B \<subseteq> A\<close> by (auto simp: Un_absorb2)
 qed
 
 lemma measure_UNION:
   assumes measurable: "range A \<subseteq> sets M" "disjoint_family A"
   assumes finite: "emeasure M (\<Union>i. A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. measure M (A i)) sums (measure M (\<Union>i. A i))"
 proof -
   have "(\<lambda>i. emeasure M (A i)) sums (emeasure M (\<Union>i. A i))"
     unfolding suminf_emeasure[OF measurable, symmetric] by (simp add: summable_sums)
   moreover
   { fix i
     have "emeasure M (A i) \<le> emeasure M (\<Union>i. A i)"
       using measurable by (auto intro!: emeasure_mono)
     then have "emeasure M (A i) = ennreal ((measure M (A i)))"
       using finite by (intro emeasure_eq_ennreal_measure) (auto simp: top_unique) }
   ultimately show ?thesis using finite
     by (subst (asm) (2) emeasure_eq_ennreal_measure) simp_all
 qed
 
 lemma measure_subadditive:
   assumes measurable: "A \<in> sets M" "B \<in> sets M"
   and fin: "emeasure M A \<noteq> \<infinity>" "emeasure M B \<noteq> \<infinity>"
   shows "measure M (A \<union> B) \<le> measure M A + measure M B"
 proof -
   have "emeasure M (A \<union> B) \<noteq> \<infinity>"
     using emeasure_subadditive[OF measurable] fin by (auto simp: top_unique)
   then show "(measure M (A \<union> B)) \<le> (measure M A) + (measure M B)"
     unfolding measure_def
     by (metis emeasure_subadditive[OF measurable] fin   enn2real_mono enn2real_plus 
         ennreal_add_less_top infinity_ennreal_def less_top)
 qed
 
 lemma measure_subadditive_finite:
   assumes A: "finite I" "A`I \<subseteq> sets M" and fin: "\<And>i. i \<in> I \<Longrightarrow> emeasure M (A i) \<noteq> \<infinity>"
   shows "measure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. measure M (A i))"
 proof -
   { have "emeasure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. emeasure M (A i))"
       using emeasure_subadditive_finite[OF A] .
     also have "\<dots> < \<infinity>"
       using fin by (simp add: less_top A)
     finally have "emeasure M (\<Union>i\<in>I. A i) \<noteq> top" by simp }
   note * = this
   show ?thesis
     using emeasure_subadditive_finite[OF A] fin
     unfolding emeasure_eq_ennreal_measure[OF *]
     by (simp_all add: sum_nonneg emeasure_eq_ennreal_measure)
 qed
 
 lemma measure_subadditive_countably:
   assumes A: "range A \<subseteq> sets M" and fin: "(\<Sum>i. emeasure M (A i)) \<noteq> \<infinity>"
   shows "measure M (\<Union>i. A i) \<le> (\<Sum>i. measure M (A i))"
 proof -
   have **: "\<And>i. emeasure M (A i) \<noteq> top"
     using fin ennreal_suminf_lessD[of "\<lambda>i. emeasure M (A i)"] by (simp add: less_top)
   have ge0: "(\<Sum>i. Sigma_Algebra.measure M (A i)) \<ge> 0"
     using fin emeasure_eq_ennreal_measure[OF **]
     by (metis infinity_ennreal_def measure_nonneg suminf_cong suminf_nonneg summable_suminf_not_top)
   have "emeasure M (\<Union>i. A i) \<noteq> top"
     by (metis A emeasure_subadditive_countably fin infinity_ennreal_def neq_top_trans)
   then have "ennreal (measure M (\<Union>i. A i)) = emeasure M (\<Union>i. A i)"
     by (rule emeasure_eq_ennreal_measure[symmetric])
   also have "\<dots> \<le> (\<Sum>i. emeasure M (A i))"
     using emeasure_subadditive_countably[OF A] .
   also have "\<dots> = ennreal (\<Sum>i. measure M (A i))"
     using fin unfolding emeasure_eq_ennreal_measure[OF **]
     by (subst suminf_ennreal) (auto simp: **)
   finally show ?thesis
     using ge0 ennreal_le_iff by blast
 qed
 
 lemma measure_Un_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A \<union> B) = measure M A"
   by (simp add: measure_def emeasure_Un_null_set)
 
 lemma measure_Diff_null_set: "A \<in> sets M \<Longrightarrow> B \<in> null_sets M \<Longrightarrow> measure M (A - B) = measure M A"
   by (simp add: measure_def emeasure_Diff_null_set)
 
 lemma measure_eq_sum_singleton:
   "finite S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M) \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> emeasure M {x} \<noteq> \<infinity>) \<Longrightarrow>
     measure M S = (\<Sum>x\<in>S. measure M {x})"
   using emeasure_eq_sum_singleton[of S M]
   by (intro measure_eq_emeasure_eq_ennreal) (auto simp: sum_nonneg emeasure_eq_ennreal_measure)
 
 lemma Lim_measure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A" and fin: "emeasure M (\<Union>i. A i) \<noteq> \<infinity>"
   shows "(\<lambda>i. measure M (A i)) \<longlonglongrightarrow> measure M (\<Union>i. A i)"
 proof (rule tendsto_ennrealD)
   have "ennreal (measure M (\<Union>i. A i)) = emeasure M (\<Union>i. A i)"
     using fin by (auto simp: emeasure_eq_ennreal_measure)
   moreover have "ennreal (measure M (A i)) = emeasure M (A i)" for i
     using assms emeasure_mono[of "A _" "\<Union>i. A i" M]
     by (intro emeasure_eq_ennreal_measure[symmetric]) (auto simp: less_top UN_upper intro: le_less_trans)
   ultimately show "(\<lambda>x. ennreal (measure M (A x))) \<longlonglongrightarrow> ennreal (measure M (\<Union>i. A i))"
     using A by (auto intro!: Lim_emeasure_incseq)
 qed auto
 
 lemma Lim_measure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A" and fin: "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
   shows "(\<lambda>n. measure M (A n)) \<longlonglongrightarrow> measure M (\<Inter>i. A i)"
 proof (rule tendsto_ennrealD)
   have "ennreal (measure M (\<Inter>i. A i)) = emeasure M (\<Inter>i. A i)"
     using fin[of 0] A emeasure_mono[of "\<Inter>i. A i" "A 0" M]
     by (auto intro!: emeasure_eq_ennreal_measure[symmetric] simp: INT_lower less_top intro: le_less_trans)
   moreover have "ennreal (measure M (A i)) = emeasure M (A i)" for i
     using A fin[of i] by (intro emeasure_eq_ennreal_measure[symmetric]) auto
   ultimately show "(\<lambda>x. ennreal (measure M (A x))) \<longlonglongrightarrow> ennreal (measure M (\<Inter>i. A i))"
     using fin A by (auto intro!: Lim_emeasure_decseq)
 qed auto
 
 subsection \<open>Set of measurable sets with finite measure\<close>
 
 definition\<^marker>\<open>tag important\<close> fmeasurable :: "'a measure \<Rightarrow> 'a set set" where
 "fmeasurable M = {A\<in>sets M. emeasure M A < \<infinity>}"
 
 lemma fmeasurableD[dest, measurable_dest]: "A \<in> fmeasurable M \<Longrightarrow> A \<in> sets M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableD2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A \<noteq> top"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> A \<in> fmeasurable M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI_null_sets: "A \<in> null_sets M \<Longrightarrow> A \<in> fmeasurable M"
   by (auto simp: fmeasurable_def)
 
 lemma fmeasurableI2: "A \<in> fmeasurable M \<Longrightarrow> B \<subseteq> A \<Longrightarrow> B \<in> sets M \<Longrightarrow> B \<in> fmeasurable M"
   using emeasure_mono[of B A M] by (auto simp: fmeasurable_def)
 
 lemma measure_mono_fmeasurable:
   "A \<subseteq> B \<Longrightarrow> A \<in> sets M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M A \<le> measure M B"
   by (auto simp: measure_def fmeasurable_def intro!: emeasure_mono enn2real_mono)
 
 lemma emeasure_eq_measure2: "A \<in> fmeasurable M \<Longrightarrow> emeasure M A = measure M A"
   by (simp add: emeasure_eq_ennreal_measure fmeasurable_def less_top)
 
 interpretation fmeasurable: ring_of_sets "space M" "fmeasurable M"
 proof (rule ring_of_setsI)
   show "fmeasurable M \<subseteq> Pow (space M)" "{} \<in> fmeasurable M"
     by (auto simp: fmeasurable_def dest: sets.sets_into_space)
   fix a b assume *: "a \<in> fmeasurable M" "b \<in> fmeasurable M"
   then have "emeasure M (a \<union> b) \<le> emeasure M a + emeasure M b"
     by (intro emeasure_subadditive) auto
   also have "\<dots> < top"
     using * by (auto simp: fmeasurable_def)
   finally show  "a \<union> b \<in> fmeasurable M"
     using * by (auto intro: fmeasurableI)
   show "a - b \<in> fmeasurable M"
     using emeasure_mono[of "a - b" a M] * by (auto simp: fmeasurable_def)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Measurable sets formed by unions and intersections\<close>
 
 lemma fmeasurable_Diff: "A \<in> fmeasurable M \<Longrightarrow> B \<in> sets M \<Longrightarrow> A - B \<in> fmeasurable M"
   using fmeasurableI2[of A M "A - B"] by auto
 
 lemma fmeasurable_Int_fmeasurable:
    "\<lbrakk>S \<in> fmeasurable M; T \<in> sets M\<rbrakk> \<Longrightarrow> (S \<inter> T) \<in> fmeasurable M"
   by (meson fmeasurableD fmeasurableI2 inf_le1 sets.Int)
 
 lemma fmeasurable_UN:
   assumes "countable I" "\<And>i. i \<in> I \<Longrightarrow> F i \<subseteq> A" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "A \<in> fmeasurable M"
   shows "(\<Union>i\<in>I. F i) \<in> fmeasurable M"
 proof (rule fmeasurableI2)
   show "A \<in> fmeasurable M" "(\<Union>i\<in>I. F i) \<subseteq> A" using assms by auto
   show "(\<Union>i\<in>I. F i) \<in> sets M"
     using assms by (intro sets.countable_UN') auto
 qed
 
 lemma fmeasurable_INT:
   assumes "countable I" "i \<in> I" "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M" "F i \<in> fmeasurable M"
   shows "(\<Inter>i\<in>I. F i) \<in> fmeasurable M"
 proof (rule fmeasurableI2)
   show "F i \<in> fmeasurable M" "(\<Inter>i\<in>I. F i) \<subseteq> F i"
     using assms by auto
   show "(\<Inter>i\<in>I. F i) \<in> sets M"
     using assms by (intro sets.countable_INT') auto
 qed
 
 lemma measurable_measure_Diff:
   assumes "A \<in> fmeasurable M" "B \<in> sets M" "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
   by (simp add: assms fmeasurableD fmeasurableD2 measure_Diff)
 
 lemma measurable_Un_null_set:
   assumes "B \<in> null_sets M"
   shows "(A \<union> B \<in> fmeasurable M \<and> A \<in> sets M) \<longleftrightarrow> A \<in> fmeasurable M"
   using assms  by (fastforce simp add: fmeasurable.Un fmeasurableI_null_sets intro: fmeasurableI2)
 
 lemma measurable_Diff_null_set:
   assumes "B \<in> null_sets M"
   shows "(A - B) \<in> fmeasurable M \<and> A \<in> sets M \<longleftrightarrow> A \<in> fmeasurable M"
   using assms
   by (metis Un_Diff_cancel2 fmeasurable.Diff fmeasurableD fmeasurableI_null_sets measurable_Un_null_set)
 
 lemma fmeasurable_Diff_D:
     assumes m: "T - S \<in> fmeasurable M" "S \<in> fmeasurable M" and sub: "S \<subseteq> T"
     shows "T \<in> fmeasurable M"
 proof -
   have "T = S \<union> (T - S)"
     using assms by blast
   then show ?thesis
     by (metis m fmeasurable.Un)
 qed
 
 lemma measure_Un2:
   "A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow> measure M (A \<union> B) = measure M A + measure M (B - A)"
   using measure_Union[of M A "B - A"] by (auto simp: fmeasurableD2 fmeasurable.Diff)
 
 lemma measure_Un3:
   assumes "A \<in> fmeasurable M" "B \<in> fmeasurable M"
   shows "measure M (A \<union> B) = measure M A + measure M B - measure M (A \<inter> B)"
 proof -
   have "measure M (A \<union> B) = measure M A + measure M (B - A)"
     using assms by (rule measure_Un2)
   also have "B - A = B - (A \<inter> B)"
     by auto
   also have "measure M (B - (A \<inter> B)) = measure M B - measure M (A \<inter> B)"
     using assms by (intro measure_Diff) (auto simp: fmeasurable_def)
   finally show ?thesis
     by simp
 qed
 
 lemma measure_Un_AE:
   "AE x in M. x \<notin> A \<or> x \<notin> B \<Longrightarrow> A \<in> fmeasurable M \<Longrightarrow> B \<in> fmeasurable M \<Longrightarrow>
   measure M (A \<union> B) = measure M A + measure M B"
   by (subst measure_Un2) (auto intro!: measure_eq_AE)
 
 lemma measure_UNION_AE:
   assumes I: "finite I"
   shows "(\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. AE x in M. x \<notin> F i \<or> x \<notin> F j) I \<Longrightarrow>
     measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
   unfolding AE_pairwise[OF countable_finite, OF I]
   using I
 proof (induction I rule: finite_induct)
   case (insert x I)
   have "measure M (F x \<union> \<Union>(F ` I)) = measure M (F x) + measure M (\<Union>(F ` I))"
     by (rule measure_Un_AE) (use insert in \<open>auto simp: pairwise_insert\<close>)
     with insert show ?case
       by (simp add: pairwise_insert )
 qed simp
 
 lemma measure_UNION':
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>i j. disjnt (F i) (F j)) I \<Longrightarrow>
     measure M (\<Union>i\<in>I. F i) = (\<Sum>i\<in>I. measure M (F i))"
   by (intro measure_UNION_AE) (auto simp: disjnt_def elim!: pairwise_mono intro!: always_eventually)
 
 lemma measure_Union_AE:
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise (\<lambda>S T. AE x in M. x \<notin> S \<or> x \<notin> T) F \<Longrightarrow>
     measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
   using measure_UNION_AE[of F "\<lambda>x. x" M] by simp
 
 lemma measure_Union':
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> fmeasurable M) \<Longrightarrow> pairwise disjnt F \<Longrightarrow> measure M (\<Union>F) = (\<Sum>S\<in>F. measure M S)"
   using measure_UNION'[of F "\<lambda>x. x" M] by simp
 
 lemma measure_Un_le:
   assumes "A \<in> sets M" "B \<in> sets M" shows "measure M (A \<union> B) \<le> measure M A + measure M B"
 proof cases
   assume "A \<in> fmeasurable M \<and> B \<in> fmeasurable M"
   with measure_subadditive[of A M B] assms show ?thesis
     by (auto simp: fmeasurableD2)
 next
   assume "\<not> (A \<in> fmeasurable M \<and> B \<in> fmeasurable M)"
   then have "A \<union> B \<notin> fmeasurable M"
     using fmeasurableI2[of "A \<union> B" M A] fmeasurableI2[of "A \<union> B" M B] assms by auto
   with assms show ?thesis
     by (auto simp: fmeasurable_def measure_def less_top[symmetric])
 qed
 
 lemma measure_UNION_le:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets M) \<Longrightarrow> measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
 proof (induction I rule: finite_induct)
   case (insert i I)
   then have "measure M (\<Union>i\<in>insert i I. F i) = measure M (F i \<union> \<Union> (F ` I))"
     by simp
   also from insert have "measure M (F i \<union> \<Union> (F ` I)) \<le> measure M (F i) + measure M (\<Union> (F ` I))"
     by (intro measure_Un_le sets.finite_Union) auto
   also have "measure M (\<Union>i\<in>I. F i) \<le> (\<Sum>i\<in>I. measure M (F i))"
     using insert by auto
   finally show ?case
     using insert by simp
 qed simp
 
 lemma measure_Union_le:
   "finite F \<Longrightarrow> (\<And>S. S \<in> F \<Longrightarrow> S \<in> sets M) \<Longrightarrow> measure M (\<Union>F) \<le> (\<Sum>S\<in>F. measure M S)"
   using measure_UNION_le[of F "\<lambda>x. x" M] by simp
 
 text\<open>Version for indexed union over a countable set\<close>
 lemma
   assumes "countable I" and I: "\<And>i. i \<in> I \<Longrightarrow> A i \<in> fmeasurable M"
     and bound: "\<And>I'. I' \<subseteq> I \<Longrightarrow> finite I' \<Longrightarrow> measure M (\<Union>i\<in>I'. A i) \<le> B"
   shows fmeasurable_UN_bound: "(\<Union>i\<in>I. A i) \<in> fmeasurable M" (is ?fm)
     and measure_UN_bound: "measure M (\<Union>i\<in>I. A i) \<le> B" (is ?m)
 proof -
   have "B \<ge> 0"
     using bound by force
   have "?fm \<and> ?m"
   proof cases
     assume "I = {}"
     with \<open>B \<ge> 0\<close> show ?thesis
       by simp
   next
     assume "I \<noteq> {}"
     have "(\<Union>i\<in>I. A i) = (\<Union>i. (\<Union>n\<le>i. A (from_nat_into I n)))"
       by (subst range_from_nat_into[symmetric, OF \<open>I \<noteq> {}\<close> \<open>countable I\<close>]) auto
     then have "emeasure M (\<Union>i\<in>I. A i) = emeasure M (\<Union>i. (\<Union>n\<le>i. A (from_nat_into I n)))" by simp
     also have "\<dots> = (SUP i. emeasure M (\<Union>n\<le>i. A (from_nat_into I n)))"
       using I \<open>I \<noteq> {}\<close>[THEN from_nat_into] by (intro SUP_emeasure_incseq[symmetric]) (fastforce simp: incseq_Suc_iff)+
     also have "\<dots> \<le> B"
     proof (intro SUP_least)
       fix i :: nat
       have "emeasure M (\<Union>n\<le>i. A (from_nat_into I n)) = measure M (\<Union>n\<le>i. A (from_nat_into I n))"
         using I \<open>I \<noteq> {}\<close>[THEN from_nat_into] by (intro emeasure_eq_measure2 fmeasurable.finite_UN) auto
       also have "\<dots> = measure M (\<Union>n\<in>from_nat_into I ` {..i}. A n)"
         by simp
       also have "\<dots> \<le> B"
         by (intro ennreal_leI bound) (auto intro:  from_nat_into[OF \<open>I \<noteq> {}\<close>])
       finally show "emeasure M (\<Union>n\<le>i. A (from_nat_into I n)) \<le> ennreal B" .
     qed
     finally have *: "emeasure M (\<Union>i\<in>I. A i) \<le> B" .
     then have ?fm
       using I \<open>countable I\<close> by (intro fmeasurableI conjI) (auto simp: less_top[symmetric] top_unique)
     with * \<open>0\<le>B\<close> show ?thesis
       by (simp add: emeasure_eq_measure2)
   qed
   then show ?fm ?m by auto
 qed
 
 text\<open>Version for big union of a countable set\<close>
 lemma
   assumes "countable \<D>"
     and meas: "\<And>D. D \<in> \<D> \<Longrightarrow> D \<in> fmeasurable M"
     and bound:  "\<And>\<E>. \<lbrakk>\<E> \<subseteq> \<D>; finite \<E>\<rbrakk> \<Longrightarrow> measure M (\<Union>\<E>) \<le> B"
  shows fmeasurable_Union_bound: "\<Union>\<D> \<in> fmeasurable M"  (is ?fm)
     and measure_Union_bound: "measure M (\<Union>\<D>) \<le> B"     (is ?m)
 proof -
   have "B \<ge> 0"
     using bound by force
   have "?fm \<and> ?m"
   proof (cases "\<D> = {}")
     case True
     with \<open>B \<ge> 0\<close> show ?thesis
       by auto
   next
     case False
     then obtain D :: "nat \<Rightarrow> 'a set" where D: "\<D> = range D"
       using \<open>countable \<D>\<close> uncountable_def by force
       have 1: "\<And>i. D i \<in> fmeasurable M"
         by (simp add: D meas)
       have 2: "\<And>I'. finite I' \<Longrightarrow> measure M (\<Union>x\<in>I'. D x) \<le> B"
         by (simp add: D bound image_subset_iff)
       show ?thesis
         unfolding D
         by (intro conjI fmeasurable_UN_bound [OF _ 1 2] measure_UN_bound [OF _ 1 2]) auto
     qed
     then show ?fm ?m by auto
 qed
 
 text\<open>Version for indexed union over the type of naturals\<close>
 lemma
   fixes S :: "nat \<Rightarrow> 'a set"
   assumes S: "\<And>i. S i \<in> fmeasurable M" and B: "\<And>n. measure M (\<Union>i\<le>n. S i) \<le> B"
   shows fmeasurable_countable_Union: "(\<Union>i. S i) \<in> fmeasurable M"
     and measure_countable_Union_le: "measure M (\<Union>i. S i) \<le> B"
 proof -
   have mB: "measure M (\<Union>i\<in>I. S i) \<le> B" if "finite I" for I
   proof -
     have "(\<Union>i\<in>I. S i) \<subseteq> (\<Union>i\<le>Max I. S i)"
       using Max_ge that by force
     then have "measure M (\<Union>i\<in>I. S i) \<le> measure M (\<Union>i \<le> Max I. S i)"
       by (rule measure_mono_fmeasurable) (use S in \<open>blast+\<close>)
     then show ?thesis
       using B order_trans by blast
   qed
   show "(\<Union>i. S i) \<in> fmeasurable M"
     by (auto intro: fmeasurable_UN_bound [OF _ S mB])
   show "measure M (\<Union>n. S n) \<le> B"
     by (auto intro: measure_UN_bound [OF _ S mB])
 qed
 
 lemma measure_diff_le_measure_setdiff:
   assumes "S \<in> fmeasurable M" "T \<in> fmeasurable M"
   shows "measure M S - measure M T \<le> measure M (S - T)"
 proof -
   have "measure M S \<le> measure M ((S - T) \<union> T)"
     by (simp add: assms fmeasurable.Un fmeasurableD measure_mono_fmeasurable)
   also have "\<dots> \<le> measure M (S - T) + measure M T"
     using assms by (blast intro: measure_Un_le)
   finally show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma suminf_exist_split2:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   assumes "summable f"
   shows "(\<lambda>n. (\<Sum>k. f(k+n))) \<longlonglongrightarrow> 0"
 by (subst lim_sequentially, auto simp add: dist_norm suminf_exist_split[OF _ assms])
 
 lemma emeasure_union_summable:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "emeasure M (\<Union>n. A n) < \<infinity>" "emeasure M (\<Union>n. A n) \<le> (\<Sum>n. measure M (A n))"
 proof -
   define B where "B = (\<lambda>N. (\<Union>n\<in>{..<N}. A n))"
   have [measurable]: "B N \<in> sets M" for N unfolding B_def by auto
   have "(\<lambda>N. emeasure M (B N)) \<longlonglongrightarrow> emeasure M (\<Union>N. B N)"
     apply (rule Lim_emeasure_incseq) unfolding B_def by (auto simp add: SUP_subset_mono incseq_def)
   moreover have "emeasure M (B N) \<le> ennreal (\<Sum>n. measure M (A n))" for N
   proof -
     have *: "(\<Sum>n<N. measure M (A n)) \<le> (\<Sum>n. measure M (A n))"
       using assms(3) measure_nonneg sum_le_suminf by blast
 
     have "emeasure M (B N) \<le> (\<Sum>n<N. emeasure M (A n))"
       unfolding B_def by (rule emeasure_subadditive_finite, auto)
     also have "\<dots> = (\<Sum>n<N. ennreal(measure M (A n)))"
       using assms(2) by (simp add: emeasure_eq_ennreal_measure less_top)
     also have "\<dots> = ennreal (\<Sum>n<N. measure M (A n))"
       by auto
     also have "\<dots> \<le> ennreal (\<Sum>n. measure M (A n))"
       using * by (auto simp: ennreal_leI)
     finally show ?thesis by simp
   qed
   ultimately have "emeasure M (\<Union>N. B N) \<le> ennreal (\<Sum>n. measure M (A n))"
     by (simp add: Lim_bounded)
   then show "emeasure M (\<Union>n. A n) \<le> (\<Sum>n. measure M (A n))"
     unfolding B_def by (metis UN_UN_flatten UN_lessThan_UNIV)
   then show "emeasure M (\<Union>n. A n) < \<infinity>"
     by (auto simp: less_top[symmetric] top_unique)
 qed
 
 lemma borel_cantelli_limsup1:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "limsup A \<in> null_sets M"
 proof -
   have "emeasure M (limsup A) \<le> 0"
   proof (rule LIMSEQ_le_const)
     have "(\<lambda>n. (\<Sum>k. measure M (A (k+n)))) \<longlonglongrightarrow> 0" by (rule suminf_exist_split2[OF assms(3)])
     then show "(\<lambda>n. ennreal (\<Sum>k. measure M (A (k+n)))) \<longlonglongrightarrow> 0"
       unfolding ennreal_0[symmetric] by (intro tendsto_ennrealI)
     have "emeasure M (limsup A) \<le> (\<Sum>k. measure M (A (k+n)))" for n
     proof -
       have I: "(\<Union>k\<in>{n..}. A k) = (\<Union>k. A (k+n))" by (auto, metis le_add_diff_inverse2, fastforce)
       have "emeasure M (limsup A) \<le> emeasure M (\<Union>k\<in>{n..}. A k)"
         by (rule emeasure_mono, auto simp add: limsup_INF_SUP)
       also have "\<dots> = emeasure M (\<Union>k. A (k+n))"
         using I by auto
       also have "\<dots> \<le> (\<Sum>k. measure M (A (k+n)))"
         apply (rule emeasure_union_summable)
         using assms summable_ignore_initial_segment[OF assms(3), of n] by auto
       finally show ?thesis by simp
     qed
     then show "\<exists>N. \<forall>n\<ge>N. emeasure M (limsup A) \<le> (\<Sum>k. measure M (A (k+n)))"
       by auto
   qed
   then show ?thesis using assms(1) measurable_limsup by auto
 qed
 
 lemma borel_cantelli_AE1:
   assumes [measurable]: "\<And>n. A n \<in> sets M"
     and "\<And>n. emeasure M (A n) < \<infinity>" "summable (\<lambda>n. measure M (A n))"
   shows "AE x in M. eventually (\<lambda>n. x \<in> space M - A n) sequentially"
 proof -
   have "AE x in M. x \<notin> limsup A"
     using borel_cantelli_limsup1[OF assms] unfolding eventually_ae_filter by auto
   moreover have "\<forall>\<^sub>F n in sequentially. x \<notin> A n" if "x \<notin> limsup A" for x
     using that  by (auto simp: limsup_INF_SUP eventually_sequentially)
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Measure spaces with \<^term>\<open>emeasure M (space M) < \<infinity>\<close>\<close>
 
 locale\<^marker>\<open>tag important\<close> finite_measure = sigma_finite_measure M for M +
   assumes finite_emeasure_space: "emeasure M (space M) \<noteq> top"
 
 lemma finite_measureI[Pure.intro!]:
   "emeasure M (space M) \<noteq> \<infinity> \<Longrightarrow> finite_measure M"
   proof qed (auto intro!: exI[of _ "{space M}"])
 
 lemma (in finite_measure) emeasure_finite[simp, intro]: "emeasure M A \<noteq> top"
   using finite_emeasure_space emeasure_space[of M A] by (auto simp: top_unique)
 
 lemma (in finite_measure) fmeasurable_eq_sets: "fmeasurable M = sets M"
   by (auto simp: fmeasurable_def less_top[symmetric])
 
 lemma (in finite_measure) emeasure_eq_measure: "emeasure M A = ennreal (measure M A)"
   by (intro emeasure_eq_ennreal_measure) simp
 
 lemma (in finite_measure) emeasure_real: "\<exists>r. 0 \<le> r \<and> emeasure M A = ennreal r"
   using emeasure_finite[of A] by (cases "emeasure M A" rule: ennreal_cases) auto
 
 lemma (in finite_measure) bounded_measure: "measure M A \<le> measure M (space M)"
   using emeasure_space[of M A] emeasure_real[of A] emeasure_real[of "space M"] by (auto simp: measure_def)
 
 lemma (in finite_measure) finite_measure_Diff:
   assumes sets: "A \<in> sets M" "B \<in> sets M" and "B \<subseteq> A"
   shows "measure M (A - B) = measure M A - measure M B"
   using measure_Diff[OF _ assms] by simp
 
 lemma (in finite_measure) finite_measure_Union:
   assumes sets: "A \<in> sets M" "B \<in> sets M" and "A \<inter> B = {}"
   shows "measure M (A \<union> B) = measure M A + measure M B"
   using measure_Union[OF _ _ assms] by simp
 
 lemma (in finite_measure) finite_measure_finite_Union:
   assumes measurable: "finite S" "A`S \<subseteq> sets M" "disjoint_family_on A S"
   shows "measure M (\<Union>i\<in>S. A i) = (\<Sum>i\<in>S. measure M (A i))"
   using measure_finite_Union[OF assms] by simp
 
 lemma (in finite_measure) finite_measure_UNION:
   assumes A: "range A \<subseteq> sets M" "disjoint_family A"
   shows "(\<lambda>i. measure M (A i)) sums (measure M (\<Union>i. A i))"
   using measure_UNION[OF A] by simp
 
 lemma (in finite_measure) finite_measure_mono:
   assumes "A \<subseteq> B" "B \<in> sets M" shows "measure M A \<le> measure M B"
   using emeasure_mono[OF assms] emeasure_real[of A] emeasure_real[of B] by (auto simp: measure_def)
 
 lemma (in finite_measure) finite_measure_subadditive:
   assumes m: "A \<in> sets M" "B \<in> sets M"
   shows "measure M (A \<union> B) \<le> measure M A + measure M B"
   using measure_subadditive[OF m] by simp
 
 lemma (in finite_measure) finite_measure_subadditive_finite:
   assumes "finite I" "A`I \<subseteq> sets M" shows "measure M (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. measure M (A i))"
   using measure_subadditive_finite[OF assms] by simp
 
 lemma (in finite_measure) finite_measure_subadditive_countably:
   "range A \<subseteq> sets M \<Longrightarrow> summable (\<lambda>i. measure M (A i)) \<Longrightarrow> measure M (\<Union>i. A i) \<le> (\<Sum>i. measure M (A i))"
   by (rule measure_subadditive_countably)
      (simp_all add: ennreal_suminf_neq_top emeasure_eq_measure)
 
 lemma (in finite_measure) finite_measure_eq_sum_singleton:
   assumes "finite S" and *: "\<And>x. x \<in> S \<Longrightarrow> {x} \<in> sets M"
   shows "measure M S = (\<Sum>x\<in>S. measure M {x})"
   using measure_eq_sum_singleton[OF assms] by simp
 
 lemma (in finite_measure) finite_Lim_measure_incseq:
   assumes A: "range A \<subseteq> sets M" "incseq A"
   shows "(\<lambda>i. measure M (A i)) \<longlonglongrightarrow> measure M (\<Union>i. A i)"
   using Lim_measure_incseq[OF A] by simp
 
 lemma (in finite_measure) finite_Lim_measure_decseq:
   assumes A: "range A \<subseteq> sets M" "decseq A"
   shows "(\<lambda>n. measure M (A n)) \<longlonglongrightarrow> measure M (\<Inter>i. A i)"
   using Lim_measure_decseq[OF A] by simp
 
 lemma (in finite_measure) finite_measure_compl:
   assumes S: "S \<in> sets M"
   shows "measure M (space M - S) = measure M (space M) - measure M S"
   using measure_Diff[OF _ sets.top S sets.sets_into_space] S by simp
 
 lemma (in finite_measure) finite_measure_mono_AE:
   assumes imp: "AE x in M. x \<in> A \<longrightarrow> x \<in> B" and B: "B \<in> sets M"
   shows "measure M A \<le> measure M B"
   using assms emeasure_mono_AE[OF imp B]
   by (simp add: emeasure_eq_measure)
 
 lemma (in finite_measure) finite_measure_eq_AE:
   assumes iff: "AE x in M. x \<in> A \<longleftrightarrow> x \<in> B"
   assumes A: "A \<in> sets M" and B: "B \<in> sets M"
   shows "measure M A = measure M B"
   using assms emeasure_eq_AE[OF assms] by (simp add: emeasure_eq_measure)
 
 lemma (in finite_measure) measure_increasing: "increasing M (measure M)"
   by (auto intro!: finite_measure_mono simp: increasing_def)
 
 lemma (in finite_measure) measure_zero_union:
   assumes "s \<in> sets M" "t \<in> sets M" "measure M t = 0"
   shows "measure M (s \<union> t) = measure M s"
 using assms
 proof -
   have "measure M (s \<union> t) \<le> measure M s"
     using finite_measure_subadditive[of s t] assms by auto
   moreover have "measure M (s \<union> t) \<ge> measure M s"
     using assms by (blast intro: finite_measure_mono)
   ultimately show ?thesis by simp
 qed
 
 lemma (in finite_measure) measure_eq_compl:
   assumes "s \<in> sets M" "t \<in> sets M"
   assumes "measure M (space M - s) = measure M (space M - t)"
   shows "measure M s = measure M t"
   using assms finite_measure_compl by auto
 
 lemma (in finite_measure) measure_eq_bigunion_image:
   assumes "range f \<subseteq> sets M" "range g \<subseteq> sets M"
   assumes "disjoint_family f" "disjoint_family g"
   assumes "\<And> n :: nat. measure M (f n) = measure M (g n)"
   shows "measure M (\<Union>i. f i) = measure M (\<Union>i. g i)"
 using assms
 proof -
   have a: "(\<lambda> i. measure M (f i)) sums (measure M (\<Union>i. f i))"
     by (rule finite_measure_UNION[OF assms(1,3)])
   have b: "(\<lambda> i. measure M (g i)) sums (measure M (\<Union>i. g i))"
     by (rule finite_measure_UNION[OF assms(2,4)])
   show ?thesis using sums_unique[OF b] sums_unique[OF a] assms by simp
 qed
 
 lemma (in finite_measure) measure_countably_zero:
   assumes "range c \<subseteq> sets M"
   assumes "\<And> i. measure M (c i) = 0"
   shows "measure M (\<Union>i :: nat. c i) = 0"
 proof (rule antisym)
   show "measure M (\<Union>i :: nat. c i) \<le> 0"
     using finite_measure_subadditive_countably[OF assms(1)] by (simp add: assms(2))
 qed simp
 
 lemma (in finite_measure) measure_space_inter:
   assumes events:"s \<in> sets M" "t \<in> sets M"
   assumes "measure M t = measure M (space M)"
   shows "measure M (s \<inter> t) = measure M s"
 proof -
   have "measure M ((space M - s) \<union> (space M - t)) = measure M (space M - s)"
     using events assms finite_measure_compl[of "t"] by (auto intro!: measure_zero_union)
   also have "(space M - s) \<union> (space M - t) = space M - (s \<inter> t)"
     by blast
   finally show "measure M (s \<inter> t) = measure M s"
     using events by (auto intro!: measure_eq_compl[of "s \<inter> t" s])
 qed
 
 lemma (in finite_measure) measure_equiprobable_finite_unions:
   assumes s: "finite s" "\<And>x. x \<in> s \<Longrightarrow> {x} \<in> sets M"
   assumes "\<And> x y. \<lbrakk>x \<in> s; y \<in> s\<rbrakk> \<Longrightarrow> measure M {x} = measure M {y}"
   shows "measure M s = real (card s) * measure M {SOME x. x \<in> s}"
 proof cases
   assume "s \<noteq> {}"
   then have "\<exists> x. x \<in> s" by blast
   from someI_ex[OF this] assms
   have prob_some: "\<And> x. x \<in> s \<Longrightarrow> measure M {x} = measure M {SOME y. y \<in> s}" by blast
   have "measure M s = (\<Sum> x \<in> s. measure M {x})"
     using finite_measure_eq_sum_singleton[OF s] by simp
   also have "\<dots> = (\<Sum> x \<in> s. measure M {SOME y. y \<in> s})" using prob_some by auto
   also have "\<dots> = real (card s) * measure M {(SOME x. x \<in> s)}"
     using sum_constant assms by simp
   finally show ?thesis by simp
 qed simp
 
 lemma (in finite_measure) measure_real_sum_image_fn:
   assumes "e \<in> sets M"
   assumes "\<And> x. x \<in> s \<Longrightarrow> e \<inter> f x \<in> sets M"
   assumes "finite s"
   assumes disjoint: "\<And> x y. \<lbrakk>x \<in> s ; y \<in> s ; x \<noteq> y\<rbrakk> \<Longrightarrow> f x \<inter> f y = {}"
   assumes upper: "space M \<subseteq> (\<Union>i \<in> s. f i)"
   shows "measure M e = (\<Sum> x \<in> s. measure M (e \<inter> f x))"
 proof -
   have "e \<subseteq> (\<Union>i\<in>s. f i)"
     using \<open>e \<in> sets M\<close> sets.sets_into_space upper by blast
   then have e: "e = (\<Union>i \<in> s. e \<inter> f i)"
     by auto
   hence "measure M e = measure M (\<Union>i \<in> s. e \<inter> f i)" by simp
   also have "\<dots> = (\<Sum> x \<in> s. measure M (e \<inter> f x))"
   proof (rule finite_measure_finite_Union)
     show "finite s" by fact
     show "(\<lambda>i. e \<inter> f i)`s \<subseteq> sets M" using assms(2) by auto
     show "disjoint_family_on (\<lambda>i. e \<inter> f i) s"
       using disjoint by (auto simp: disjoint_family_on_def)
   qed
   finally show ?thesis .
 qed
 
 lemma (in finite_measure) measure_exclude:
   assumes "A \<in> sets M" "B \<in> sets M"
   assumes "measure M A = measure M (space M)" "A \<inter> B = {}"
   shows "measure M B = 0"
   using measure_space_inter[of B A] assms by (auto simp: ac_simps)
 lemma (in finite_measure) finite_measure_distr:
   assumes f: "f \<in> measurable M M'"
   shows "finite_measure (distr M M' f)"
 proof (rule finite_measureI)
   have "f -` space M' \<inter> space M = space M" using f by (auto dest: measurable_space)
   with f show "emeasure (distr M M' f) (space (distr M M' f)) \<noteq> \<infinity>" by (auto simp: emeasure_distr)
 qed
 
 lemma emeasure_gfp[consumes 1, case_names cont measurable]:
   assumes sets[simp]: "\<And>s. sets (M s) = sets N"
   assumes "\<And>s. finite_measure (M s)"
   assumes cont: "inf_continuous F" "inf_continuous f"
   assumes meas: "\<And>P. Measurable.pred N P \<Longrightarrow> Measurable.pred N (F P)"
   assumes iter: "\<And>P s. Measurable.pred N P \<Longrightarrow> emeasure (M s) {x\<in>space N. F P x} = f (\<lambda>s. emeasure (M s) {x\<in>space N. P x}) s"
   assumes bound: "\<And>P. f P \<le> f (\<lambda>s. emeasure (M s) (space (M s)))"
   shows "emeasure (M s) {x\<in>space N. gfp F x} = gfp f s"
 proof (subst gfp_transfer_bounded[where \<alpha>="\<lambda>F s. emeasure (M s) {x\<in>space N. F x}" and P="Measurable.pred N", symmetric])
   interpret finite_measure "M s" for s by fact
   fix C assume "decseq C" "\<And>i. Measurable.pred N (C i)"
   then show "(\<lambda>s. emeasure (M s) {x \<in> space N. (INF i. C i) x}) = (INF i. (\<lambda>s. emeasure (M s) {x \<in> space N. C i x}))"
     unfolding INF_apply
     by (subst INF_emeasure_decseq) (auto simp: antimono_def fun_eq_iff intro!: arg_cong2[where f=emeasure])
 next
   show "f x \<le> (\<lambda>s. emeasure (M s) {x \<in> space N. F top x})" for x
     using bound[of x] sets_eq_imp_space_eq[OF sets] by (simp add: iter)
 qed (auto simp add: iter le_fun_def INF_apply[abs_def] intro!: meas cont)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Counting space\<close>
 
 lemma strict_monoI_Suc:
-  assumes ord [simp]: "(\<And>n. f n < f (Suc n))" shows "strict_mono f"
-  unfolding strict_mono_def
-proof safe
-  fix n m :: nat assume "n < m" then show "f n < f m"
-    by (induct m) (auto simp: less_Suc_eq intro: less_trans ord)
-qed
+  assumes "(\<And>n. f n < f (Suc n))" shows "strict_mono f"
+  by (simp add: assms strict_mono_Suc_iff)
 
 lemma emeasure_count_space:
   assumes "X \<subseteq> A" shows "emeasure (count_space A) X = (if finite X then of_nat (card X) else \<infinity>)"
     (is "_ = ?M X")
   unfolding count_space_def
 proof (rule emeasure_measure_of_sigma)
   show "X \<in> Pow A" using \<open>X \<subseteq> A\<close> by auto
   show "sigma_algebra A (Pow A)" by (rule sigma_algebra_Pow)
   show positive: "positive (Pow A) ?M"
     by (auto simp: positive_def)
   have additive: "additive (Pow A) ?M"
     by (auto simp: card_Un_disjoint additive_def)
 
   interpret ring_of_sets A "Pow A"
     by (rule ring_of_setsI) auto
   show "countably_additive (Pow A) ?M"
     unfolding countably_additive_iff_continuous_from_below[OF positive additive]
   proof safe
     fix F :: "nat \<Rightarrow> 'a set" assume "incseq F"
     show "(\<lambda>i. ?M (F i)) \<longlonglongrightarrow> ?M (\<Union>i. F i)"
     proof cases
       assume "\<exists>i. \<forall>j\<ge>i. F i = F j"
       then obtain i where i: "\<forall>j\<ge>i. F i = F j" ..
       with \<open>incseq F\<close> have "F j \<subseteq> F i" for j
         by (cases "i \<le> j") (auto simp: incseq_def)
       then have eq: "(\<Union>i. F i) = F i"
         by auto
       with i show ?thesis
         by (auto intro!: Lim_transform_eventually[OF tendsto_const] eventually_sequentiallyI[where c=i])
     next
       assume "\<not> (\<exists>i. \<forall>j\<ge>i. F i = F j)"
       then obtain f where f: "\<And>i. i \<le> f i" "\<And>i. F i \<noteq> F (f i)" by metis
       then have "\<And>i. F i \<subseteq> F (f i)" using \<open>incseq F\<close> by (auto simp: incseq_def)
       with f have *: "\<And>i. F i \<subset> F (f i)" by auto
 
       have "incseq (\<lambda>i. ?M (F i))"
         using \<open>incseq F\<close> unfolding incseq_def by (auto simp: card_mono dest: finite_subset)
       then have "(\<lambda>i. ?M (F i)) \<longlonglongrightarrow> (SUP n. ?M (F n))"
         by (rule LIMSEQ_SUP)
 
       moreover have "(SUP n. ?M (F n)) = top"
       proof (rule ennreal_SUP_eq_top)
         fix n :: nat show "\<exists>k::nat\<in>UNIV. of_nat n \<le> ?M (F k)"
         proof (induct n)
           case (Suc n)
           then obtain k where "of_nat n \<le> ?M (F k)" ..
           moreover have "finite (F k) \<Longrightarrow> finite (F (f k)) \<Longrightarrow> card (F k) < card (F (f k))"
             using \<open>F k \<subset> F (f k)\<close> by (simp add: psubset_card_mono)
           moreover have "finite (F (f k)) \<Longrightarrow> finite (F k)"
             using \<open>k \<le> f k\<close> \<open>incseq F\<close> by (auto simp: incseq_def dest: finite_subset)
           ultimately show ?case
             by (auto intro!: exI[of _ "f k"] simp del: of_nat_Suc)
         qed auto
       qed
 
       moreover
       have "inj (\<lambda>n. F ((f ^^ n) 0))"
         by (intro strict_mono_imp_inj_on strict_monoI_Suc) (simp add: *)
       then have 1: "infinite (range (\<lambda>i. F ((f ^^ i) 0)))"
         by (rule range_inj_infinite)
       have "infinite (Pow (\<Union>i. F i))"
         by (rule infinite_super[OF _ 1]) auto
       then have "infinite (\<Union>i. F i)"
         by auto
       ultimately show ?thesis by (simp only:) simp
 
     qed
   qed
 qed
 
 lemma distr_bij_count_space:
   assumes f: "bij_betw f A B"
   shows "distr (count_space A) (count_space B) f = count_space B"
 proof (rule measure_eqI)
   have f': "f \<in> measurable (count_space A) (count_space B)"
     using f unfolding Pi_def bij_betw_def by auto
   fix X assume "X \<in> sets (distr (count_space A) (count_space B) f)"
   then have X: "X \<in> sets (count_space B)" by auto
   moreover from X have "f -` X \<inter> A = the_inv_into A f ` X"
     using f by (auto simp: bij_betw_def subset_image_iff image_iff the_inv_into_f_f intro: the_inv_into_f_f[symmetric])
   moreover have "inj_on (the_inv_into A f) B"
     using X f by (auto simp: bij_betw_def inj_on_the_inv_into)
   with X have "inj_on (the_inv_into A f) X"
     by (auto intro: subset_inj_on)
   ultimately show "emeasure (distr (count_space A) (count_space B) f) X = emeasure (count_space B) X"
     using f unfolding emeasure_distr[OF f' X]
     by (subst (1 2) emeasure_count_space) (auto simp: card_image dest: finite_imageD)
 qed simp
 
 lemma emeasure_count_space_finite[simp]:
   "X \<subseteq> A \<Longrightarrow> finite X \<Longrightarrow> emeasure (count_space A) X = of_nat (card X)"
   using emeasure_count_space[of X A] by simp
 
 lemma emeasure_count_space_infinite[simp]:
   "X \<subseteq> A \<Longrightarrow> infinite X \<Longrightarrow> emeasure (count_space A) X = \<infinity>"
   using emeasure_count_space[of X A] by simp
 
 lemma measure_count_space: "measure (count_space A) X = (if X \<subseteq> A then of_nat (card X) else 0)"
   by (cases "finite X") (auto simp: measure_notin_sets ennreal_of_nat_eq_real_of_nat
                                     measure_zero_top measure_eq_emeasure_eq_ennreal)
 
 lemma emeasure_count_space_eq_0:
   "emeasure (count_space A) X = 0 \<longleftrightarrow> (X \<subseteq> A \<longrightarrow> X = {})"
 proof cases
   assume X: "X \<subseteq> A"
   then show ?thesis
   proof (intro iffI impI)
     assume "emeasure (count_space A) X = 0"
     with X show "X = {}"
       by (subst (asm) emeasure_count_space) (auto split: if_split_asm)
   qed simp
 qed (simp add: emeasure_notin_sets)
 
 lemma null_sets_count_space: "null_sets (count_space A) = { {} }"
   unfolding null_sets_def by (auto simp add: emeasure_count_space_eq_0)
 
 lemma AE_count_space: "(AE x in count_space A. P x) \<longleftrightarrow> (\<forall>x\<in>A. P x)"
   unfolding eventually_ae_filter by (auto simp add: null_sets_count_space)
 
 lemma sigma_finite_measure_count_space_countable:
   assumes A: "countable A"
   shows "sigma_finite_measure (count_space A)"
   proof qed (insert A, auto intro!: exI[of _ "(\<lambda>a. {a}) ` A"])
 
 lemma sigma_finite_measure_count_space:
   fixes A :: "'a::countable set" shows "sigma_finite_measure (count_space A)"
   by (rule sigma_finite_measure_count_space_countable) auto
 
 lemma finite_measure_count_space:
   assumes [simp]: "finite A"
   shows "finite_measure (count_space A)"
   by rule simp
 
 lemma sigma_finite_measure_count_space_finite:
   assumes A: "finite A" shows "sigma_finite_measure (count_space A)"
 proof -
   interpret finite_measure "count_space A" using A by (rule finite_measure_count_space)
   show "sigma_finite_measure (count_space A)" ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Measure restricted to space\<close>
 
 lemma emeasure_restrict_space:
   assumes "\<Omega> \<inter> space M \<in> sets M" "A \<subseteq> \<Omega>"
   shows "emeasure (restrict_space M \<Omega>) A = emeasure M A"
 proof (cases "A \<in> sets M")
   case True
   show ?thesis
   proof (rule emeasure_measure_of[OF restrict_space_def])
     show "(\<inter>) \<Omega> ` sets M \<subseteq> Pow (\<Omega> \<inter> space M)" "A \<in> sets (restrict_space M \<Omega>)"
       using \<open>A \<subseteq> \<Omega>\<close> \<open>A \<in> sets M\<close> sets.space_closed by (auto simp: sets_restrict_space)
     show "positive (sets (restrict_space M \<Omega>)) (emeasure M)"
       by (auto simp: positive_def)
     show "countably_additive (sets (restrict_space M \<Omega>)) (emeasure M)"
     proof (rule countably_additiveI)
       fix A :: "nat \<Rightarrow> _" assume "range A \<subseteq> sets (restrict_space M \<Omega>)" "disjoint_family A"
       with assms have "\<And>i. A i \<in> sets M" "\<And>i. A i \<subseteq> space M" "disjoint_family A"
         by (fastforce simp: sets_restrict_space_iff[OF assms(1)] image_subset_iff
                       dest: sets.sets_into_space)+
       then show "(\<Sum>i. emeasure M (A i)) = emeasure M (\<Union>i. A i)"
         by (subst suminf_emeasure) (auto simp: disjoint_family_subset)
     qed
   qed
 next
   case False
   with assms have "A \<notin> sets (restrict_space M \<Omega>)"
     by (simp add: sets_restrict_space_iff)
   with False show ?thesis
     by (simp add: emeasure_notin_sets)
 qed
 
 lemma measure_restrict_space:
   assumes "\<Omega> \<inter> space M \<in> sets M" "A \<subseteq> \<Omega>"
   shows "measure (restrict_space M \<Omega>) A = measure M A"
   using emeasure_restrict_space[OF assms] by (simp add: measure_def)
 
 lemma AE_restrict_space_iff:
   assumes "\<Omega> \<inter> space M \<in> sets M"
   shows "(AE x in restrict_space M \<Omega>. P x) \<longleftrightarrow> (AE x in M. x \<in> \<Omega> \<longrightarrow> P x)"
 proof -
   have ex_cong: "\<And>P Q f. (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> (\<And>x. Q x \<Longrightarrow> P (f x)) \<Longrightarrow> (\<exists>x. P x) \<longleftrightarrow> (\<exists>x. Q x)"
     by auto
   { fix X assume X: "X \<in> sets M" "emeasure M X = 0"
     then have "emeasure M (\<Omega> \<inter> space M \<inter> X) \<le> emeasure M X"
       by (intro emeasure_mono) auto
     then have "emeasure M (\<Omega> \<inter> space M \<inter> X) = 0"
       using X by (auto intro!: antisym) }
   with assms show ?thesis
     unfolding eventually_ae_filter
     by (auto simp add: space_restrict_space null_sets_def sets_restrict_space_iff
                        emeasure_restrict_space cong: conj_cong
              intro!: ex_cong[where f="\<lambda>X. (\<Omega> \<inter> space M) \<inter> X"])
 qed
 
 lemma restrict_restrict_space:
   assumes "A \<inter> space M \<in> sets M" "B \<inter> space M \<in> sets M"
   shows "restrict_space (restrict_space M A) B = restrict_space M (A \<inter> B)" (is "?l = ?r")
 proof (rule measure_eqI[symmetric])
   show "sets ?r = sets ?l"
     unfolding sets_restrict_space image_comp by (intro image_cong) auto
 next
   fix X assume "X \<in> sets (restrict_space M (A \<inter> B))"
   then obtain Y where "Y \<in> sets M" "X = Y \<inter> A \<inter> B"
     by (auto simp: sets_restrict_space)
   with assms sets.Int[OF assms] show "emeasure ?r X = emeasure ?l X"
     by (subst (1 2) emeasure_restrict_space)
        (auto simp: space_restrict_space sets_restrict_space_iff emeasure_restrict_space ac_simps)
 qed
 
 lemma restrict_count_space: "restrict_space (count_space B) A = count_space (A \<inter> B)"
 proof (rule measure_eqI)
   show "sets (restrict_space (count_space B) A) = sets (count_space (A \<inter> B))"
     by (subst sets_restrict_space) auto
   moreover fix X assume "X \<in> sets (restrict_space (count_space B) A)"
   ultimately have "X \<subseteq> A \<inter> B" by auto
   then show "emeasure (restrict_space (count_space B) A) X = emeasure (count_space (A \<inter> B)) X"
     by (cases "finite X") (auto simp add: emeasure_restrict_space)
 qed
 
 lemma sigma_finite_measure_restrict_space:
   assumes "sigma_finite_measure M"
   and A: "A \<in> sets M"
   shows "sigma_finite_measure (restrict_space M A)"
 proof -
   interpret sigma_finite_measure M by fact
   from sigma_finite_countable obtain C
     where C: "countable C" "C \<subseteq> sets M" "(\<Union>C) = space M" "\<forall>a\<in>C. emeasure M a \<noteq> \<infinity>"
     by blast
   let ?C = "(\<inter>) A ` C"
   from C have "countable ?C" "?C \<subseteq> sets (restrict_space M A)" "(\<Union>?C) = space (restrict_space M A)"
     by(auto simp add: sets_restrict_space space_restrict_space)
   moreover {
     fix a
     assume "a \<in> ?C"
     then obtain a' where "a = A \<inter> a'" "a' \<in> C" ..
     then have "emeasure (restrict_space M A) a \<le> emeasure M a'"
       using A C by(auto simp add: emeasure_restrict_space intro: emeasure_mono)
     also have "\<dots> < \<infinity>" using C(4)[rule_format, of a'] \<open>a' \<in> C\<close> by (simp add: less_top)
     finally have "emeasure (restrict_space M A) a \<noteq> \<infinity>" by simp }
   ultimately show ?thesis
     by unfold_locales (rule exI conjI|assumption|blast)+
 qed
 
 lemma finite_measure_restrict_space:
   assumes "finite_measure M"
   and A: "A \<in> sets M"
   shows "finite_measure (restrict_space M A)"
 proof -
   interpret finite_measure M by fact
   show ?thesis
     by(rule finite_measureI)(simp add: emeasure_restrict_space A space_restrict_space)
 qed
 
 lemma restrict_distr:
   assumes [measurable]: "f \<in> measurable M N"
   assumes [simp]: "\<Omega> \<inter> space N \<in> sets N" and restrict: "f \<in> space M \<rightarrow> \<Omega>"
   shows "restrict_space (distr M N f) \<Omega> = distr M (restrict_space N \<Omega>) f"
   (is "?l = ?r")
 proof (rule measure_eqI)
   fix A assume "A \<in> sets (restrict_space (distr M N f) \<Omega>)"
   with restrict show "emeasure ?l A = emeasure ?r A"
     by (subst emeasure_distr)
        (auto simp: sets_restrict_space_iff emeasure_restrict_space emeasure_distr
              intro!: measurable_restrict_space2)
 qed (simp add: sets_restrict_space)
 
 lemma measure_eqI_restrict_generator:
   assumes E: "Int_stable E" "E \<subseteq> Pow \<Omega>" "\<And>X. X \<in> E \<Longrightarrow> emeasure M X = emeasure N X"
   assumes sets_eq: "sets M = sets N" and \<Omega>: "\<Omega> \<in> sets M"
   assumes "sets (restrict_space M \<Omega>) = sigma_sets \<Omega> E"
   assumes "sets (restrict_space N \<Omega>) = sigma_sets \<Omega> E"
   assumes ae: "AE x in M. x \<in> \<Omega>" "AE x in N. x \<in> \<Omega>"
   assumes A: "countable A" "A \<noteq> {}" "A \<subseteq> E" "\<Union>A = \<Omega>" "\<And>a. a \<in> A \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
   shows "M = N"
 proof (rule measure_eqI)
   fix X assume X: "X \<in> sets M"
   then have "emeasure M X = emeasure (restrict_space M \<Omega>) (X \<inter> \<Omega>)"
     using ae \<Omega> by (auto simp add: emeasure_restrict_space intro!: emeasure_eq_AE)
   also have "restrict_space M \<Omega> = restrict_space N \<Omega>"
   proof (rule measure_eqI_generator_eq)
     fix X assume "X \<in> E"
     then show "emeasure (restrict_space M \<Omega>) X = emeasure (restrict_space N \<Omega>) X"
       using E \<Omega> by (subst (1 2) emeasure_restrict_space) (auto simp: sets_eq sets_eq[THEN sets_eq_imp_space_eq])
   next
     show "range (from_nat_into A) \<subseteq> E" "(\<Union>i. from_nat_into A i) = \<Omega>"
       using A by (auto cong del: SUP_cong_simp)
   next
     fix i
     have "emeasure (restrict_space M \<Omega>) (from_nat_into A i) = emeasure M (from_nat_into A i)"
       using A \<Omega> by (subst emeasure_restrict_space)
                    (auto simp: sets_eq sets_eq[THEN sets_eq_imp_space_eq] intro: from_nat_into)
     with A show "emeasure (restrict_space M \<Omega>) (from_nat_into A i) \<noteq> \<infinity>"
       by (auto intro: from_nat_into)
   qed fact+
   also have "emeasure (restrict_space N \<Omega>) (X \<inter> \<Omega>) = emeasure N X"
     using X ae \<Omega> by (auto simp add: emeasure_restrict_space sets_eq intro!: emeasure_eq_AE)
   finally show "emeasure M X = emeasure N X" .
 qed fact
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Null measure\<close>
 
 definition null_measure :: "'a measure \<Rightarrow> 'a measure" where
 "null_measure M = sigma (space M) (sets M)"
 
 lemma space_null_measure[simp]: "space (null_measure M) = space M"
   by (simp add: null_measure_def)
 
 lemma sets_null_measure[simp, measurable_cong]: "sets (null_measure M) = sets M"
   by (simp add: null_measure_def)
 
 lemma emeasure_null_measure[simp]: "emeasure (null_measure M) X = 0"
   by (cases "X \<in> sets M", rule emeasure_measure_of)
      (auto simp: positive_def countably_additive_def emeasure_notin_sets null_measure_def
            dest: sets.sets_into_space)
 
 lemma measure_null_measure[simp]: "measure (null_measure M) X = 0"
   by (intro measure_eq_emeasure_eq_ennreal) auto
 
 lemma null_measure_idem [simp]: "null_measure (null_measure M) = null_measure M"
   by(rule measure_eqI) simp_all
 
 subsection \<open>Scaling a measure\<close>
 
 definition\<^marker>\<open>tag important\<close> scale_measure :: "ennreal \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
 "scale_measure r M = measure_of (space M) (sets M) (\<lambda>A. r * emeasure M A)"
 
 lemma space_scale_measure: "space (scale_measure r M) = space M"
   by (simp add: scale_measure_def)
 
 lemma sets_scale_measure [simp, measurable_cong]: "sets (scale_measure r M) = sets M"
   by (simp add: scale_measure_def)
 
 lemma emeasure_scale_measure [simp]:
   "emeasure (scale_measure r M) A = r * emeasure M A"
   (is "_ = ?\<mu> A")
 proof(cases "A \<in> sets M")
   case True
   show ?thesis unfolding scale_measure_def
   proof(rule emeasure_measure_of_sigma)
     show "sigma_algebra (space M) (sets M)" ..
     show "positive (sets M) ?\<mu>" by (simp add: positive_def)
     show "countably_additive (sets M) ?\<mu>"
     proof (rule countably_additiveI)
       fix A :: "nat \<Rightarrow> _"  assume *: "range A \<subseteq> sets M" "disjoint_family A"
       have "(\<Sum>i. ?\<mu> (A i)) = r * (\<Sum>i. emeasure M (A i))"
         by simp
       also have "\<dots> = ?\<mu> (\<Union>i. A i)" using * by(simp add: suminf_emeasure)
       finally show "(\<Sum>i. ?\<mu> (A i)) = ?\<mu> (\<Union>i. A i)" .
     qed
   qed(fact True)
 qed(simp add: emeasure_notin_sets)
 
 lemma scale_measure_1 [simp]: "scale_measure 1 M = M"
   by(rule measure_eqI) simp_all
 
 lemma scale_measure_0[simp]: "scale_measure 0 M = null_measure M"
   by(rule measure_eqI) simp_all
 
 lemma measure_scale_measure [simp]: "0 \<le> r \<Longrightarrow> measure (scale_measure r M) A = r * measure M A"
   using emeasure_scale_measure[of r M A]
     emeasure_eq_ennreal_measure[of M A]
     measure_eq_emeasure_eq_ennreal[of _ "scale_measure r M" A]
   by (cases "emeasure (scale_measure r M) A = top")
      (auto simp del: emeasure_scale_measure
            simp: ennreal_top_eq_mult_iff ennreal_mult_eq_top_iff measure_zero_top ennreal_mult[symmetric])
 
 lemma scale_scale_measure [simp]:
   "scale_measure r (scale_measure r' M) = scale_measure (r * r') M"
   by (rule measure_eqI) (simp_all add: max_def mult.assoc)
 
 lemma scale_null_measure [simp]: "scale_measure r (null_measure M) = null_measure M"
   by (rule measure_eqI) simp_all
 
 
 subsection \<open>Complete lattice structure on measures\<close>
 
 lemma (in finite_measure) finite_measure_Diff':
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> measure M (A - B) = measure M A - measure M (A \<inter> B)"
   using finite_measure_Diff[of A "A \<inter> B"] by (auto simp: Diff_Int)
 
 lemma (in finite_measure) finite_measure_Union':
   "A \<in> sets M \<Longrightarrow> B \<in> sets M \<Longrightarrow> measure M (A \<union> B) = measure M A + measure M (B - A)"
   using finite_measure_Union[of A "B - A"] by auto
 
 lemma finite_unsigned_Hahn_decomposition:
   assumes "finite_measure M" "finite_measure N" and [simp]: "sets N = sets M"
   shows "\<exists>Y\<in>sets M. (\<forall>X\<in>sets M. X \<subseteq> Y \<longrightarrow> N X \<le> M X) \<and> (\<forall>X\<in>sets M. X \<inter> Y = {} \<longrightarrow> M X \<le> N X)"
 proof -
   interpret M: finite_measure M by fact
   interpret N: finite_measure N by fact
 
   define d where "d X = measure M X - measure N X" for X
 
   have [intro]: "bdd_above (d`sets M)"
     using sets.sets_into_space[of _ M]
     by (intro bdd_aboveI[where M="measure M (space M)"])
        (auto simp: d_def field_simps subset_eq intro!: add_increasing M.finite_measure_mono)
 
   define \<gamma> where "\<gamma> = (SUP X\<in>sets M. d X)"
   have le_\<gamma>[intro]: "X \<in> sets M \<Longrightarrow> d X \<le> \<gamma>" for X
     by (auto simp: \<gamma>_def intro!: cSUP_upper)
 
   have "\<exists>f. \<forall>n. f n \<in> sets M \<and> d (f n) > \<gamma> - 1 / 2^n"
   proof (intro choice_iff[THEN iffD1] allI)
     fix n
     have "\<exists>X\<in>sets M. \<gamma> - 1 / 2^n < d X"
       unfolding \<gamma>_def by (intro less_cSUP_iff[THEN iffD1]) auto
     then show "\<exists>y. y \<in> sets M \<and> \<gamma> - 1 / 2 ^ n < d y"
       by auto
   qed
   then obtain E where [measurable]: "E n \<in> sets M" and E: "d (E n) > \<gamma> - 1 / 2^n" for n
     by auto
 
   define F where "F m n = (if m \<le> n then \<Inter>i\<in>{m..n}. E i else space M)" for m n
 
   have [measurable]: "m \<le> n \<Longrightarrow> F m n \<in> sets M" for m n
     by (auto simp: F_def)
 
   have 1: "\<gamma> - 2 / 2 ^ m + 1 / 2 ^ n \<le> d (F m n)" if "m \<le> n" for m n
     using that
   proof (induct rule: dec_induct)
     case base with E[of m] show ?case
       by (simp add: F_def field_simps)
   next
     case (step i)
     have F_Suc: "F m (Suc i) = F m i \<inter> E (Suc i)"
       using \<open>m \<le> i\<close> by (auto simp: F_def le_Suc_eq)
 
     have "\<gamma> + (\<gamma> - 2 / 2^m + 1 / 2 ^ Suc i) \<le> (\<gamma> - 1 / 2^Suc i) + (\<gamma> - 2 / 2^m + 1 / 2^i)"
       by (simp add: field_simps)
     also have "\<dots> \<le> d (E (Suc i)) + d (F m i)"
       using E[of "Suc i"] by (intro add_mono step) auto
     also have "\<dots> = d (E (Suc i)) + d (F m i - E (Suc i)) + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by (simp add: d_def field_simps F_Suc M.finite_measure_Diff' N.finite_measure_Diff')
     also have "\<dots> = d (E (Suc i) \<union> F m i) + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by (simp add: d_def field_simps M.finite_measure_Union' N.finite_measure_Union')
     also have "\<dots> \<le> \<gamma> + d (F m (Suc i))"
       using \<open>m \<le> i\<close> by auto
     finally show ?case
       by auto
   qed
 
   define F' where "F' m = (\<Inter>i\<in>{m..}. E i)" for m
   have F'_eq: "F' m = (\<Inter>i. F m (i + m))" for m
     by (fastforce simp: le_iff_add[of m] F'_def F_def)
 
   have [measurable]: "F' m \<in> sets M" for m
     by (auto simp: F'_def)
 
   have \<gamma>_le: "\<gamma> - 0 \<le> d (\<Union>m. F' m)"
   proof (rule LIMSEQ_le)
     show "(\<lambda>n. \<gamma> - 2 / 2 ^ n) \<longlonglongrightarrow> \<gamma> - 0"
       by (intro tendsto_intros LIMSEQ_divide_realpow_zero) auto
     have "incseq F'"
       by (auto simp: incseq_def F'_def)
     then show "(\<lambda>m. d (F' m)) \<longlonglongrightarrow> d (\<Union>m. F' m)"
       unfolding d_def
       by (intro tendsto_diff M.finite_Lim_measure_incseq N.finite_Lim_measure_incseq) auto
 
     have "\<gamma> - 2 / 2 ^ m + 0 \<le> d (F' m)" for m
     proof (rule LIMSEQ_le)
       have *: "decseq (\<lambda>n. F m (n + m))"
         by (auto simp: decseq_def F_def)
       show "(\<lambda>n. d (F m n)) \<longlonglongrightarrow> d (F' m)"
         unfolding d_def F'_eq
         by (rule LIMSEQ_offset[where k=m])
            (auto intro!: tendsto_diff M.finite_Lim_measure_decseq N.finite_Lim_measure_decseq *)
       show "(\<lambda>n. \<gamma> - 2 / 2 ^ m + 1 / 2 ^ n) \<longlonglongrightarrow> \<gamma> - 2 / 2 ^ m + 0"
         by (intro tendsto_add LIMSEQ_divide_realpow_zero tendsto_const) auto
       show "\<exists>N. \<forall>n\<ge>N. \<gamma> - 2 / 2 ^ m + 1 / 2 ^ n \<le> d (F m n)"
         using 1[of m] by (intro exI[of _ m]) auto
     qed
     then show "\<exists>N. \<forall>n\<ge>N. \<gamma> - 2 / 2 ^ n \<le> d (F' n)"
       by auto
   qed
 
   show ?thesis
   proof (safe intro!: bexI[of _ "\<Union>m. F' m"])
     fix X assume [measurable]: "X \<in> sets M" and X: "X \<subseteq> (\<Union>m. F' m)"
     have "d (\<Union>m. F' m) - d X = d ((\<Union>m. F' m) - X)"
       using X by (auto simp: d_def M.finite_measure_Diff N.finite_measure_Diff)
     also have "\<dots> \<le> \<gamma>"
       by auto
     finally have "0 \<le> d X"
       using \<gamma>_le by auto
     then show "emeasure N X \<le> emeasure M X"
       by (auto simp: d_def M.emeasure_eq_measure N.emeasure_eq_measure)
   next
     fix X assume [measurable]: "X \<in> sets M" and X: "X \<inter> (\<Union>m. F' m) = {}"
     then have "d (\<Union>m. F' m) + d X = d (X \<union> (\<Union>m. F' m))"
       by (auto simp: d_def M.finite_measure_Union N.finite_measure_Union)
     also have "\<dots> \<le> \<gamma>"
       by auto
     finally have "d X \<le> 0"
       using \<gamma>_le by auto
     then show "emeasure M X \<le> emeasure N X"
       by (auto simp: d_def M.emeasure_eq_measure N.emeasure_eq_measure)
   qed auto
 qed
 
 proposition unsigned_Hahn_decomposition:
   assumes [simp]: "sets N = sets M" and [measurable]: "A \<in> sets M"
     and [simp]: "emeasure M A \<noteq> top" "emeasure N A \<noteq> top"
   shows "\<exists>Y\<in>sets M. Y \<subseteq> A \<and> (\<forall>X\<in>sets M. X \<subseteq> Y \<longrightarrow> N X \<le> M X) \<and> (\<forall>X\<in>sets M. X \<subseteq> A \<longrightarrow> X \<inter> Y = {} \<longrightarrow> M X \<le> N X)"
 proof -
   have "\<exists>Y\<in>sets (restrict_space M A).
     (\<forall>X\<in>sets (restrict_space M A). X \<subseteq> Y \<longrightarrow> (restrict_space N A) X \<le> (restrict_space M A) X) \<and>
     (\<forall>X\<in>sets (restrict_space M A). X \<inter> Y = {} \<longrightarrow> (restrict_space M A) X \<le> (restrict_space N A) X)"
   proof (rule finite_unsigned_Hahn_decomposition)
     show "finite_measure (restrict_space M A)" "finite_measure (restrict_space N A)"
       by (auto simp: space_restrict_space emeasure_restrict_space less_top intro!: finite_measureI)
   qed (simp add: sets_restrict_space)
   with assms show ?thesis
     by (metis Int_subset_iff emeasure_restrict_space sets.Int_space_eq2 sets_restrict_space_iff space_restrict_space)
 qed
 
 text\<^marker>\<open>tag important\<close> \<open>
   Define a lexicographical order on \<^type>\<open>measure\<close>, in the order space, sets and measure. The parts
   of the lexicographical order are point-wise ordered.
 \<close>
 
 instantiation measure :: (type) order_bot
 begin
 
 inductive less_eq_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> bool" where
   "space M \<subset> space N \<Longrightarrow> less_eq_measure M N"
 | "space M = space N \<Longrightarrow> sets M \<subset> sets N \<Longrightarrow> less_eq_measure M N"
 | "space M = space N \<Longrightarrow> sets M = sets N \<Longrightarrow> emeasure M \<le> emeasure N \<Longrightarrow> less_eq_measure M N"
 
 lemma le_measure_iff:
   "M \<le> N \<longleftrightarrow> (if space M = space N then
     if sets M = sets N then emeasure M \<le> emeasure N else sets M \<subseteq> sets N else space M \<subseteq> space N)"
   by (auto elim: less_eq_measure.cases intro: less_eq_measure.intros)
 
 definition\<^marker>\<open>tag important\<close> less_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> bool" where
   "less_measure M N \<longleftrightarrow> (M \<le> N \<and> \<not> N \<le> M)"
 
 definition\<^marker>\<open>tag important\<close> bot_measure :: "'a measure" where
   "bot_measure = sigma {} {}"
 
 lemma
   shows space_bot[simp]: "space bot = {}"
     and sets_bot[simp]: "sets bot = {{}}"
     and emeasure_bot[simp]: "emeasure bot X = 0"
   by (auto simp: bot_measure_def sigma_sets_empty_eq emeasure_sigma)
 
 instance
 proof standard
   show "bot \<le> a" for a :: "'a measure"
     by (simp add: le_measure_iff bot_measure_def sigma_sets_empty_eq emeasure_sigma le_fun_def)
 qed (auto simp: le_measure_iff less_measure_def split: if_split_asm intro: measure_eqI)
 
 end
 
 proposition le_measure: "sets M = sets N \<Longrightarrow> M \<le> N \<longleftrightarrow> (\<forall>A\<in>sets M. emeasure M A \<le> emeasure N A)"
   by (metis emeasure_neq_0_sets le_fun_def le_measure_iff order_class.order_eq_iff sets_eq_imp_space_eq)
 
 definition\<^marker>\<open>tag important\<close> sup_measure' :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
 "sup_measure' A B =
   measure_of (space A) (sets A)
     (\<lambda>X. SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
 
 lemma assumes [simp]: "sets B = sets A"
   shows space_sup_measure'[simp]: "space (sup_measure' A B) = space A"
     and sets_sup_measure'[simp]: "sets (sup_measure' A B) = sets A"
   using sets_eq_imp_space_eq[OF assms] by (simp_all add: sup_measure'_def)
 
 lemma emeasure_sup_measure':
   assumes sets_eq[simp]: "sets B = sets A" and [simp, intro]: "X \<in> sets A"
   shows "emeasure (sup_measure' A B) X = (SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
     (is "_ = ?S X")
 proof -
   note sets_eq_imp_space_eq[OF sets_eq, simp]
   show ?thesis
     using sup_measure'_def
   proof (rule emeasure_measure_of)
     let ?d = "\<lambda>X Y. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y)"
     show "countably_additive (sets (sup_measure' A B)) (\<lambda>X. SUP Y \<in> sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y))"
     proof (rule countably_additiveI, goal_cases)
       case (1 X)
       then have [measurable]: "\<And>i. X i \<in> sets A" and "disjoint_family X"
         by auto
       have disjoint: "disjoint_family (\<lambda>i. X i \<inter> Y)" "disjoint_family (\<lambda>i. X i - Y)" for Y
         using "1"(2) disjoint_family_subset by fastforce+
       have "(\<Sum>i. ?S (X i)) = (SUP Y\<in>sets A. \<Sum>i. ?d (X i) Y)"
       proof (rule ennreal_suminf_SUP_eq_directed)
         fix J :: "nat set" and a b assume "finite J" and [measurable]: "a \<in> sets A" "b \<in> sets A"
         have "\<exists>c\<in>sets A. c \<subseteq> X i \<and> (\<forall>a\<in>sets A. ?d (X i) a \<le> ?d (X i) c)" for i
         proof cases
           assume "emeasure A (X i) = top \<or> emeasure B (X i) = top"
           then show ?thesis
             by force
         next
           assume finite: "\<not> (emeasure A (X i) = top \<or> emeasure B (X i) = top)"
           then have "\<exists>Y\<in>sets A. Y \<subseteq> X i \<and> (\<forall>C\<in>sets A. C \<subseteq> Y \<longrightarrow> B C \<le> A C) \<and> (\<forall>C\<in>sets A. C \<subseteq> X i \<longrightarrow> C \<inter> Y = {} \<longrightarrow> A C \<le> B C)"
             using unsigned_Hahn_decomposition[of B A "X i"] by simp
           then obtain Y where [measurable]: "Y \<in> sets A" and [simp]: "Y \<subseteq> X i"
             and B_le_A: "\<And>C. C \<in> sets A \<Longrightarrow> C \<subseteq> Y \<Longrightarrow> B C \<le> A C"
             and A_le_B: "\<And>C. C \<in> sets A \<Longrightarrow> C \<subseteq> X i \<Longrightarrow> C \<inter> Y = {} \<Longrightarrow> A C \<le> B C"
             by auto
 
           show ?thesis
           proof (intro bexI ballI conjI)
             fix a assume [measurable]: "a \<in> sets A"
             have *: "(X i \<inter> a \<inter> Y \<union> (X i \<inter> a - Y)) = X i \<inter> a" "(X i - a) \<inter> Y \<union> (X i - a - Y) = X i \<inter> - a"
               for a Y by auto
             then have "?d (X i) a =
               (A (X i \<inter> a \<inter> Y) + A (X i \<inter> a \<inter> - Y)) + (B (X i \<inter> - a \<inter> Y) + B (X i \<inter> - a \<inter> - Y))"
               by (subst (1 2) plus_emeasure) (auto simp: Diff_eq[symmetric])
             also have "\<dots> \<le> (A (X i \<inter> a \<inter> Y) + B (X i \<inter> a \<inter> - Y)) + (A (X i \<inter> - a \<inter> Y) + B (X i \<inter> - a \<inter> - Y))"
               by (intro add_mono order_refl B_le_A A_le_B) (auto simp: Diff_eq[symmetric])
             also have "\<dots> \<le> (A (X i \<inter> Y \<inter> a) + A (X i \<inter> Y \<inter> - a)) + (B (X i \<inter> - Y \<inter> a) + B (X i \<inter> - Y \<inter> - a))"
               by (simp add: ac_simps)
             also have "\<dots> \<le> A (X i \<inter> Y) + B (X i \<inter> - Y)"
               by (subst (1 2) plus_emeasure) (auto simp: Diff_eq[symmetric] *)
             finally show "?d (X i) a \<le> ?d (X i) Y" .
           qed auto
         qed
         then obtain C where [measurable]: "C i \<in> sets A" and "C i \<subseteq> X i"
           and C: "\<And>a. a \<in> sets A \<Longrightarrow> ?d (X i) a \<le> ?d (X i) (C i)" for i
           by metis
         have *: "X i \<inter> (\<Union>i. C i) = X i \<inter> C i" for i
           using \<open>disjoint_family X\<close> \<open>\<And>i. C i \<subseteq> X i\<close>
           by (simp add: disjoint_family_on_def disjoint_iff_not_equal set_eq_iff) (metis subsetD)
         then have **: "X i \<inter> - (\<Union>i. C i) = X i \<inter> - C i" for i by blast
         moreover have "(\<Union>i. C i) \<in> sets A"
           by fastforce
         ultimately show "\<exists>c\<in>sets A. \<forall>i\<in>J. ?d (X i) a \<le> ?d (X i) c \<and> ?d (X i) b \<le> ?d (X i) c"
           by (metis "*" C \<open>a \<in> sets A\<close> \<open>b \<in> sets A\<close>)
       qed
       also have "\<dots> = ?S (\<Union>i. X i)"
       proof -
         have "\<And>Y. Y \<in> sets A \<Longrightarrow> (\<Sum>i. emeasure A (X i \<inter> Y) + emeasure B (X i \<inter> -Y)) 
                               = emeasure A (\<Union>i. X i \<inter> Y) + emeasure B (\<Union>i. X i \<inter> -Y)"
           using disjoint
           by (auto simp flip: suminf_add Diff_eq simp add: image_subset_iff suminf_emeasure)
         then show ?thesis by force
       qed
       finally show "(\<Sum>i. ?S (X i)) = ?S (\<Union>i. X i)" .
     qed
   qed (auto dest: sets.sets_into_space simp: positive_def intro!: SUP_const)
 qed
 
 lemma le_emeasure_sup_measure'1:
   assumes "sets B = sets A" "X \<in> sets A" shows "emeasure A X \<le> emeasure (sup_measure' A B) X"
   by (subst emeasure_sup_measure'[OF assms]) (auto intro!: SUP_upper2[of "X"] assms)
 
 lemma le_emeasure_sup_measure'2:
   assumes "sets B = sets A" "X \<in> sets A" shows "emeasure B X \<le> emeasure (sup_measure' A B) X"
   by (subst emeasure_sup_measure'[OF assms]) (auto intro!: SUP_upper2[of "{}"] assms)
 
 lemma emeasure_sup_measure'_le2:
   assumes [simp]: "sets B = sets C" "sets A = sets C" and [measurable]: "X \<in> sets C"
   assumes A: "\<And>Y. Y \<subseteq> X \<Longrightarrow> Y \<in> sets A \<Longrightarrow> emeasure A Y \<le> emeasure C Y"
   assumes B: "\<And>Y. Y \<subseteq> X \<Longrightarrow> Y \<in> sets A \<Longrightarrow> emeasure B Y \<le> emeasure C Y"
   shows "emeasure (sup_measure' A B) X \<le> emeasure C X"
 proof (subst emeasure_sup_measure')
   show "(SUP Y\<in>sets A. emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y)) \<le> emeasure C X"
     unfolding \<open>sets A = sets C\<close>
   proof (intro SUP_least)
     fix Y assume [measurable]: "Y \<in> sets C"
     have [simp]: "X \<inter> Y \<union> (X - Y) = X"
       by auto
     have "emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y) \<le> emeasure C (X \<inter> Y) + emeasure C (X \<inter> - Y)"
       by (intro add_mono A B) (auto simp: Diff_eq[symmetric])
     also have "\<dots> = emeasure C X"
       by (subst plus_emeasure) (auto simp: Diff_eq[symmetric])
     finally show "emeasure A (X \<inter> Y) + emeasure B (X \<inter> - Y) \<le> emeasure C X" .
   qed
 qed simp_all
 
 definition\<^marker>\<open>tag important\<close> sup_lexord :: "'a \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b::order) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" where
 "sup_lexord A B k s c =
   (if k A = k B then c else
    if \<not> k A \<le> k B \<and> \<not> k B \<le> k A then s else
    if k B \<le> k A then A else B)"
 
 lemma sup_lexord:
   "(k A < k B \<Longrightarrow> P B) \<Longrightarrow> (k B < k A \<Longrightarrow> P A) \<Longrightarrow> (k A = k B \<Longrightarrow> P c) \<Longrightarrow>
     (\<not> k B \<le> k A \<Longrightarrow> \<not> k A \<le> k B \<Longrightarrow> P s) \<Longrightarrow> P (sup_lexord A B k s c)"
   by (auto simp: sup_lexord_def)
 
 lemmas le_sup_lexord = sup_lexord[where P="\<lambda>a. c \<le> a" for c]
 
 lemma sup_lexord1: "k A = k B \<Longrightarrow> sup_lexord A B k s c = c"
   by (simp add: sup_lexord_def)
 
 lemma sup_lexord_commute: "sup_lexord A B k s c = sup_lexord B A k s c"
   by (auto simp: sup_lexord_def)
 
 lemma sigma_sets_le_sets_iff: "(sigma_sets (space x) \<A> \<subseteq> sets x) = (\<A> \<subseteq> sets x)"
   using sets.sigma_sets_subset[of \<A> x] by auto
 
 lemma sigma_le_iff: "\<A> \<subseteq> Pow \<Omega> \<Longrightarrow> sigma \<Omega> \<A> \<le> x \<longleftrightarrow> (\<Omega> \<subseteq> space x \<and> (space x = \<Omega> \<longrightarrow> \<A> \<subseteq> sets x))"
   by (cases "\<Omega> = space x")
      (simp_all add: eq_commute[of _ "sets x"] le_measure_iff emeasure_sigma le_fun_def
                     sigma_sets_superset_generator sigma_sets_le_sets_iff)
 
 instantiation measure :: (type) semilattice_sup
 begin
 
 definition\<^marker>\<open>tag important\<close> sup_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
   "sup_measure A B =
     sup_lexord A B space (sigma (space A \<union> space B) {})
       (sup_lexord A B sets (sigma (space A) (sets A \<union> sets B)) (sup_measure' A B))"
 
 instance
 proof
   fix x y z :: "'a measure"
   show "x \<le> sup x y"
     unfolding sup_measure_def
   proof (intro le_sup_lexord)
     assume "space x = space y"
     then have *: "sets x \<union> sets y \<subseteq> Pow (space x)"
       using sets.space_closed by auto
     assume "\<not> sets y \<subseteq> sets x" "\<not> sets x \<subseteq> sets y"
     then have "sets x \<subset> sets x \<union> sets y"
       by auto
     also have "\<dots> \<le> sigma (space x) (sets x \<union> sets y)"
       by (subst sets_measure_of[OF *]) (rule sigma_sets_superset_generator)
     finally show "x \<le> sigma (space x) (sets x \<union> sets y)"
       by (simp add: space_measure_of[OF *] less_eq_measure.intros(2))
   next
     assume "\<not> space y \<subseteq> space x" "\<not> space x \<subseteq> space y"
     then show "x \<le> sigma (space x \<union> space y) {}"
       by (intro less_eq_measure.intros) auto
   next
     assume "sets x = sets y" then show "x \<le> sup_measure' x y"
       by (simp add: le_measure le_emeasure_sup_measure'1)
   qed (auto intro: less_eq_measure.intros)
   show "y \<le> sup x y"
     unfolding sup_measure_def
   proof (intro le_sup_lexord)
     assume **: "space x = space y"
     then have *: "sets x \<union> sets y \<subseteq> Pow (space y)"
       using sets.space_closed by auto
     assume "\<not> sets y \<subseteq> sets x" "\<not> sets x \<subseteq> sets y"
     then have "sets y \<subset> sets x \<union> sets y"
       by auto
     also have "\<dots> \<le> sigma (space y) (sets x \<union> sets y)"
       by (subst sets_measure_of[OF *]) (rule sigma_sets_superset_generator)
     finally show "y \<le> sigma (space x) (sets x \<union> sets y)"
       by (simp add: ** space_measure_of[OF *] less_eq_measure.intros(2))
   next
     assume "\<not> space y \<subseteq> space x" "\<not> space x \<subseteq> space y"
     then show "y \<le> sigma (space x \<union> space y) {}"
       by (intro less_eq_measure.intros) auto
   next
     assume "sets x = sets y" then show "y \<le> sup_measure' x y"
       by (simp add: le_measure le_emeasure_sup_measure'2)
   qed (auto intro: less_eq_measure.intros)
   show "x \<le> y \<Longrightarrow> z \<le> y \<Longrightarrow> sup x z \<le> y"
     unfolding sup_measure_def
   proof (intro sup_lexord[where P="\<lambda>x. x \<le> y"])
     assume "x \<le> y" "z \<le> y" and [simp]: "space x = space z" "sets x = sets z"
     from \<open>x \<le> y\<close> show "sup_measure' x z \<le> y"
     proof cases
       case 1 then show ?thesis
         by (intro less_eq_measure.intros(1)) simp
     next
       case 2 then show ?thesis
         by (intro less_eq_measure.intros(2)) simp_all
     next
       case 3 with \<open>z \<le> y\<close> \<open>x \<le> y\<close> show ?thesis
         by (auto simp add: le_measure intro!: emeasure_sup_measure'_le2)
     qed
   next
     assume **: "x \<le> y" "z \<le> y" "space x = space z" "\<not> sets z \<subseteq> sets x" "\<not> sets x \<subseteq> sets z"
     then have *: "sets x \<union> sets z \<subseteq> Pow (space x)"
       using sets.space_closed by auto
     show "sigma (space x) (sets x \<union> sets z) \<le> y"
       unfolding sigma_le_iff[OF *] using ** by (auto simp: le_measure_iff split: if_split_asm)
   next
     assume "x \<le> y" "z \<le> y" "\<not> space z \<subseteq> space x" "\<not> space x \<subseteq> space z"
     then have "space x \<subseteq> space y" "space z \<subseteq> space y"
       by (auto simp: le_measure_iff split: if_split_asm)
     then show "sigma (space x \<union> space z) {} \<le> y"
       by (simp add: sigma_le_iff)
   qed
 qed
 
 end
 
 lemma space_empty_eq_bot: "space a = {} \<longleftrightarrow> a = bot"
   using space_empty[of a] by (auto intro!: measure_eqI)
 
 lemma sets_eq_iff_bounded: "A \<le> B \<Longrightarrow> B \<le> C \<Longrightarrow> sets A = sets C \<Longrightarrow> sets B = sets A"
   by (auto dest: sets_eq_imp_space_eq simp add: le_measure_iff split: if_split_asm)
 
 lemma sets_sup: "sets A = sets M \<Longrightarrow> sets B = sets M \<Longrightarrow> sets (sup A B) = sets M"
   by (auto simp add: sup_measure_def sup_lexord_def dest: sets_eq_imp_space_eq)
 
 lemma le_measureD1: "A \<le> B \<Longrightarrow> space A \<le> space B"
   by (auto simp: le_measure_iff split: if_split_asm)
 
 lemma le_measureD2: "A \<le> B \<Longrightarrow> space A = space B \<Longrightarrow> sets A \<le> sets B"
   by (auto simp: le_measure_iff split: if_split_asm)
 
 lemma le_measureD3: "A \<le> B \<Longrightarrow> sets A = sets B \<Longrightarrow> emeasure A X \<le> emeasure B X"
   by (auto simp: le_measure_iff le_fun_def dest: sets_eq_imp_space_eq split: if_split_asm)
 
 lemma UN_space_closed: "\<Union>(sets ` S) \<subseteq> Pow (\<Union>(space ` S))"
   using sets.space_closed by auto
 
 definition\<^marker>\<open>tag important\<close>
   Sup_lexord :: "('a \<Rightarrow> 'b::complete_lattice) \<Rightarrow> ('a set \<Rightarrow> 'a) \<Rightarrow> ('a set \<Rightarrow> 'a) \<Rightarrow> 'a set \<Rightarrow> 'a"
 where
   "Sup_lexord k c s A =
   (let U = (SUP a\<in>A. k a)
    in if \<exists>a\<in>A. k a = U then c {a\<in>A. k a = U} else s A)"
 
 lemma Sup_lexord:
   "(\<And>a S. a \<in> A \<Longrightarrow> k a = (SUP a\<in>A. k a) \<Longrightarrow> S = {a'\<in>A. k a' = k a} \<Longrightarrow> P (c S)) \<Longrightarrow> ((\<And>a. a \<in> A \<Longrightarrow> k a \<noteq> (SUP a\<in>A. k a)) \<Longrightarrow> P (s A)) \<Longrightarrow>
     P (Sup_lexord k c s A)"
   by (auto simp: Sup_lexord_def Let_def)
 
 lemma Sup_lexord1:
   assumes A: "A \<noteq> {}" "(\<And>a. a \<in> A \<Longrightarrow> k a = (\<Union>a\<in>A. k a))" "P (c A)"
   shows "P (Sup_lexord k c s A)"
   unfolding Sup_lexord_def Let_def
 proof (clarsimp, safe)
   show "\<forall>a\<in>A. k a \<noteq> (\<Union>x\<in>A. k x) \<Longrightarrow> P (s A)"
     by (metis assms(1,2) ex_in_conv)
 next
   fix a assume "a \<in> A" "k a = (\<Union>x\<in>A. k x)"
   then have "{a \<in> A. k a = (\<Union>x\<in>A. k x)} = {a \<in> A. k a = k a}"
     by (metis A(2)[symmetric])
   then show "P (c {a \<in> A. k a = (\<Union>x\<in>A. k x)})"
     by (simp add: A(3))
 qed
 
 instantiation measure :: (type) complete_lattice
 begin
 
 interpretation sup_measure: comm_monoid_set sup "bot :: 'a measure"
   by standard (auto intro!: antisym)
 
 lemma sup_measure_F_mono':
   "finite J \<Longrightarrow> finite I \<Longrightarrow> sup_measure.F id I \<le> sup_measure.F id (I \<union> J)"
 proof (induction J rule: finite_induct)
   case empty then show ?case
     by simp
 next
   case (insert i J)
   show ?case
   proof cases
     assume "i \<in> I" with insert show ?thesis
       by (auto simp: insert_absorb)
   next
     assume "i \<notin> I"
     have "sup_measure.F id I \<le> sup_measure.F id (I \<union> J)"
       by (intro insert)
     also have "\<dots> \<le> sup_measure.F id (insert i (I \<union> J))"
       using insert \<open>i \<notin> I\<close> by (subst sup_measure.insert) auto
     finally show ?thesis
       by auto
   qed
 qed
 
 lemma sup_measure_F_mono: "finite I \<Longrightarrow> J \<subseteq> I \<Longrightarrow> sup_measure.F id J \<le> sup_measure.F id I"
   using sup_measure_F_mono'[of I J] by (auto simp: finite_subset Un_absorb1)
 
 lemma sets_sup_measure_F:
   "finite I \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> sets i = sets M) \<Longrightarrow> sets (sup_measure.F id I) = sets M"
   by (induction I rule: finite_ne_induct) (simp_all add: sets_sup)
 
 definition\<^marker>\<open>tag important\<close> Sup_measure' :: "'a measure set \<Rightarrow> 'a measure" where
 "Sup_measure' M =
   measure_of (\<Union>a\<in>M. space a) (\<Union>a\<in>M. sets a)
     (\<lambda>X. (SUP P\<in>{P. finite P \<and> P \<subseteq> M }. sup_measure.F id P X))"
 
 lemma space_Sup_measure'2: "space (Sup_measure' M) = (\<Union>m\<in>M. space m)"
   unfolding Sup_measure'_def by (intro space_measure_of[OF UN_space_closed])
 
 lemma sets_Sup_measure'2: "sets (Sup_measure' M) = sigma_sets (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m)"
   unfolding Sup_measure'_def by (intro sets_measure_of[OF UN_space_closed])
 
 lemma sets_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "M \<noteq> {}"
   shows "sets (Sup_measure' M) = sets A"
   using sets_eq[THEN sets_eq_imp_space_eq, simp] \<open>M \<noteq> {}\<close> by (simp add: Sup_measure'_def)
 
 lemma space_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "M \<noteq> {}"
   shows "space (Sup_measure' M) = space A"
   using sets_eq[THEN sets_eq_imp_space_eq, simp] \<open>M \<noteq> {}\<close>
   by (simp add: Sup_measure'_def )
 
 lemma emeasure_Sup_measure':
   assumes sets_eq[simp]: "\<And>m. m \<in> M \<Longrightarrow> sets m = sets A" and "X \<in> sets A" "M \<noteq> {}"
   shows "emeasure (Sup_measure' M) X = (SUP P\<in>{P. finite P \<and> P \<subseteq> M}. sup_measure.F id P X)"
     (is "_ = ?S X")
   using Sup_measure'_def
 proof (rule emeasure_measure_of)
   note sets_eq[THEN sets_eq_imp_space_eq, simp]
   have *: "sets (Sup_measure' M) = sets A" "space (Sup_measure' M) = space A"
     using \<open>M \<noteq> {}\<close> by (simp_all add: Sup_measure'_def)
   let ?\<mu> = "sup_measure.F id"
   show "countably_additive (sets (Sup_measure' M)) ?S"
   proof (rule countably_additiveI, goal_cases)
     case (1 F)
     then have **: "range F \<subseteq> sets A"
       by (auto simp: *)
     show "(\<Sum>i. ?S (F i)) = ?S (\<Union>i. F i)"
     proof (subst ennreal_suminf_SUP_eq_directed)
       fix i j and N :: "nat set" assume ij: "i \<in> {P. finite P \<and> P \<subseteq> M}" "j \<in> {P. finite P \<and> P \<subseteq> M}"
       have "(i \<noteq> {} \<longrightarrow> sets (?\<mu> i) = sets A) \<and> (j \<noteq> {} \<longrightarrow> sets (?\<mu> j) = sets A) \<and>
         (i \<noteq> {} \<or> j \<noteq> {} \<longrightarrow> sets (?\<mu> (i \<union> j)) = sets A)"
         using ij by (intro impI sets_sup_measure_F conjI) auto
       then have "?\<mu> j (F n) \<le> ?\<mu> (i \<union> j) (F n) \<and> ?\<mu> i (F n) \<le> ?\<mu> (i \<union> j) (F n)" for n
         using ij
         by (cases "i = {}"; cases "j = {}")
            (auto intro!: le_measureD3 sup_measure_F_mono simp: sets_sup_measure_F
                  simp del: id_apply)
       with ij show "\<exists>k\<in>{P. finite P \<and> P \<subseteq> M}. \<forall>n\<in>N. ?\<mu> i (F n) \<le> ?\<mu> k (F n) \<and> ?\<mu> j (F n) \<le> ?\<mu> k (F n)"
         by (safe intro!: bexI[of _ "i \<union> j"]) auto
     next
       show "(SUP P \<in> {P. finite P \<and> P \<subseteq> M}. \<Sum>n. ?\<mu> P (F n)) = (SUP P \<in> {P. finite P \<and> P \<subseteq> M}. ?\<mu> P (\<Union>(F ` UNIV)))"
       proof (intro arg_cong [of _ _ Sup] image_cong refl)
         fix i assume i: "i \<in> {P. finite P \<and> P \<subseteq> M}"
         show "(\<Sum>n. ?\<mu> i (F n)) = ?\<mu> i (\<Union>(F ` UNIV))"
         proof cases
           assume "i \<noteq> {}" with i ** show ?thesis
             by (smt (verit, best) "1"(2) Measure_Space.sets_sup_measure_F assms(1) mem_Collect_eq subset_eq suminf_cong suminf_emeasure)
         qed simp
       qed
     qed
   qed
   show "positive (sets (Sup_measure' M)) ?S"
     by (auto simp: positive_def bot_ennreal[symmetric])
   show "X \<in> sets (Sup_measure' M)"
     using assms * by auto
 qed (rule UN_space_closed)
 
 definition\<^marker>\<open>tag important\<close> Sup_measure :: "'a measure set \<Rightarrow> 'a measure" where
 "Sup_measure =
   Sup_lexord space
     (Sup_lexord sets Sup_measure'
       (\<lambda>U. sigma (\<Union>u\<in>U. space u) (\<Union>u\<in>U. sets u)))
     (\<lambda>U. sigma (\<Union>u\<in>U. space u) {})"
 
 definition\<^marker>\<open>tag important\<close> Inf_measure :: "'a measure set \<Rightarrow> 'a measure" where
   "Inf_measure A = Sup {x. \<forall>a\<in>A. x \<le> a}"
 
 definition\<^marker>\<open>tag important\<close> inf_measure :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> 'a measure" where
   "inf_measure a b = Inf {a, b}"
 
 definition\<^marker>\<open>tag important\<close> top_measure :: "'a measure" where
   "top_measure = Inf {}"
 
 instance
 proof
   note UN_space_closed [simp]
   show upper: "x \<le> Sup A" if x: "x \<in> A" for x :: "'a measure" and A
     unfolding Sup_measure_def
   proof (intro Sup_lexord[where P="\<lambda>y. x \<le> y"])
     assume "\<And>a. a \<in> A \<Longrightarrow> space a \<noteq> (\<Union>a\<in>A. space a)"
     from this[OF \<open>x \<in> A\<close>] \<open>x \<in> A\<close> show "x \<le> sigma (\<Union>a\<in>A. space a) {}"
       by (intro less_eq_measure.intros) auto
   next
     fix a S assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and neq: "\<And>aa. aa \<in> S \<Longrightarrow> sets aa \<noteq> (\<Union>a\<in>S. sets a)"
     have sp_a: "space a = (\<Union>(space ` S))"
       using \<open>a\<in>A\<close> by (auto simp: S)
     show "x \<le> sigma (\<Union>(space ` S)) (\<Union>(sets ` S))"
     proof cases
       assume [simp]: "space x = space a"
       have "sets x \<subset> (\<Union>a\<in>S. sets a)"
         using \<open>x\<in>A\<close> neq[of x] by (auto simp: S)
       also have "\<dots> \<subseteq> sigma_sets (\<Union>x\<in>S. space x) (\<Union>x\<in>S. sets x)"
         by (rule sigma_sets_superset_generator)
       finally show ?thesis
         by (intro less_eq_measure.intros(2)) (simp_all add: sp_a)
     next
       assume "space x \<noteq> space a"
       moreover have "space x \<le> space a"
         unfolding a using \<open>x\<in>A\<close> by auto
       ultimately show ?thesis
         by (intro less_eq_measure.intros) (simp add: less_le sp_a)
     qed
   next
     fix a b S S' assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and "b \<in> S" and b: "sets b = (\<Union>a\<in>S. sets a)" and S': "S' = {a' \<in> S. sets a' = sets b}"
     then have "S' \<noteq> {}" "space b = space a"
       by auto
     have sets_eq: "\<And>x. x \<in> S' \<Longrightarrow> sets x = sets b"
       by (auto simp: S')
     note sets_eq[THEN sets_eq_imp_space_eq, simp]
     have *: "sets (Sup_measure' S') = sets b" "space (Sup_measure' S') = space b"
       using \<open>S' \<noteq> {}\<close> by (simp_all add: Sup_measure'_def sets_eq)
     show "x \<le> Sup_measure' S'"
     proof cases
       assume "x \<in> S"
       with \<open>b \<in> S\<close> have "space x = space b"
         by (simp add: S)
       show ?thesis
       proof cases
         assume "x \<in> S'"
         show "x \<le> Sup_measure' S'"
         proof (intro le_measure[THEN iffD2] ballI)
           show "sets x = sets (Sup_measure' S')"
             using \<open>x\<in>S'\<close> * by (simp add: S')
           fix X assume "X \<in> sets x"
           show "emeasure x X \<le> emeasure (Sup_measure' S') X"
           proof (subst emeasure_Sup_measure'[OF _ \<open>X \<in> sets x\<close>])
             show "emeasure x X \<le> (SUP P \<in> {P. finite P \<and> P \<subseteq> S'}. emeasure (sup_measure.F id P) X)"
               using \<open>x\<in>S'\<close> by (intro SUP_upper2[where i="{x}"]) auto
           qed (insert \<open>x\<in>S'\<close> S', auto)
         qed
       next
         assume "x \<notin> S'"
         then have "sets x \<noteq> sets b"
           using \<open>x\<in>S\<close> by (auto simp: S')
         moreover have "sets x \<le> sets b"
           using \<open>x\<in>S\<close> unfolding b by auto
         ultimately show ?thesis
           using * \<open>x \<in> S\<close>
           by (intro less_eq_measure.intros(2))
              (simp_all add: * \<open>space x = space b\<close> less_le)
       qed
     next
       assume "x \<notin> S"
       with \<open>x\<in>A\<close> \<open>x \<notin> S\<close> \<open>space b = space a\<close> show ?thesis
         by (intro less_eq_measure.intros)
            (simp_all add: * less_le a SUP_upper S)
     qed
   qed
   show least: "Sup A \<le> x" if x: "\<And>z. z \<in> A \<Longrightarrow> z \<le> x" for x :: "'a measure" and A
     unfolding Sup_measure_def
   proof (intro Sup_lexord[where P="\<lambda>y. y \<le> x"])
     assume "\<And>a. a \<in> A \<Longrightarrow> space a \<noteq> (\<Union>a\<in>A. space a)"
     show "sigma (\<Union>(space ` A)) {} \<le> x"
       using x[THEN le_measureD1] by (subst sigma_le_iff) auto
   next
     fix a S assume "a \<in> A" "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       "\<And>a. a \<in> S \<Longrightarrow> sets a \<noteq> (\<Union>a\<in>S. sets a)"
     have "\<Union>(space ` S) \<subseteq> space x"
       using S le_measureD1[OF x] by auto
     moreover
     have "\<Union>(space ` S) = space a"
       using \<open>a\<in>A\<close> S by auto
     then have "space x = \<Union>(space ` S) \<Longrightarrow> \<Union>(sets ` S) \<subseteq> sets x"
       using \<open>a \<in> A\<close> le_measureD2[OF x] by (auto simp: S)
     ultimately show "sigma (\<Union>(space ` S)) (\<Union>(sets ` S)) \<le> x"
       by (subst sigma_le_iff) simp_all
   next
     fix a b S S' assume "a \<in> A" and a: "space a = (\<Union>a\<in>A. space a)" and S: "S = {a' \<in> A. space a' = space a}"
       and "b \<in> S" and b: "sets b = (\<Union>a\<in>S. sets a)" and S': "S' = {a' \<in> S. sets a' = sets b}"
     then have "S' \<noteq> {}" "space b = space a"
       by auto
     have sets_eq: "\<And>x. x \<in> S' \<Longrightarrow> sets x = sets b"
       by (auto simp: S')
     note sets_eq[THEN sets_eq_imp_space_eq, simp]
     have *: "sets (Sup_measure' S') = sets b" "space (Sup_measure' S') = space b"
       using \<open>S' \<noteq> {}\<close> by (simp_all add: Sup_measure'_def sets_eq)
     show "Sup_measure' S' \<le> x"
     proof cases
       assume "space x = space a"
       show ?thesis
       proof cases
         assume **: "sets x = sets b"
         show ?thesis
         proof (intro le_measure[THEN iffD2] ballI)
           show ***: "sets (Sup_measure' S') = sets x"
             by (simp add: * **)
           fix X assume "X \<in> sets (Sup_measure' S')"
           show "emeasure (Sup_measure' S') X \<le> emeasure x X"
             unfolding ***
           proof (subst emeasure_Sup_measure'[OF _ \<open>X \<in> sets (Sup_measure' S')\<close>])
             show "(SUP P \<in> {P. finite P \<and> P \<subseteq> S'}. emeasure (sup_measure.F id P) X) \<le> emeasure x X"
             proof (safe intro!: SUP_least)
               fix P assume P: "finite P" "P \<subseteq> S'"
               show "emeasure (sup_measure.F id P) X \<le> emeasure x X"
               proof cases
                 assume "P = {}" then show ?thesis
                   by auto
               next
                 assume "P \<noteq> {}"
                 from P have "finite P" "P \<subseteq> A"
                   unfolding S' S by (simp_all add: subset_eq)
                 then have "sup_measure.F id P \<le> x"
                   by (induction P) (auto simp: x)
                 moreover have "sets (sup_measure.F id P) = sets x"
                   using \<open>finite P\<close> \<open>P \<noteq> {}\<close> \<open>P \<subseteq> S'\<close> \<open>sets x = sets b\<close>
                   by (intro sets_sup_measure_F) (auto simp: S')
                 ultimately show "emeasure (sup_measure.F id P) X \<le> emeasure x X"
                   by (rule le_measureD3)
               qed
             qed
             show "m \<in> S' \<Longrightarrow> sets m = sets (Sup_measure' S')" for m
               unfolding * by (simp add: S')
           qed fact
         qed
       next
         assume "sets x \<noteq> sets b"
         moreover have "sets b \<le> sets x"
           unfolding b S using x[THEN le_measureD2] \<open>space x = space a\<close> by auto
         ultimately show "Sup_measure' S' \<le> x"
           using \<open>space x = space a\<close> \<open>b \<in> S\<close>
           by (intro less_eq_measure.intros(2)) (simp_all add: * S)
       qed
     next
       assume "space x \<noteq> space a"
       then have "space a < space x"
         using le_measureD1[OF x[OF \<open>a\<in>A\<close>]] by auto
       then show "Sup_measure' S' \<le> x"
         by (intro less_eq_measure.intros) (simp add: * \<open>space b = space a\<close>)
     qed
   qed
   show "Sup {} = (bot::'a measure)" "Inf {} = (top::'a measure)"
     by (auto intro!: antisym least simp: top_measure_def)
   show lower: "x \<in> A \<Longrightarrow> Inf A \<le> x" for x :: "'a measure" and A
     unfolding Inf_measure_def by (intro least) auto
   show greatest: "(\<And>z. z \<in> A \<Longrightarrow> x \<le> z) \<Longrightarrow> x \<le> Inf A" for x :: "'a measure" and A
     unfolding Inf_measure_def by (intro upper) auto
   show "inf x y \<le> x" "inf x y \<le> y" "x \<le> y \<Longrightarrow> x \<le> z \<Longrightarrow> x \<le> inf y z" for x y z :: "'a measure"
     by (auto simp: inf_measure_def intro!: lower greatest)
 qed
 
 end
 
 lemma sets_SUP:
   assumes "\<And>x. x \<in> I \<Longrightarrow> sets (M x) = sets N"
   shows "I \<noteq> {} \<Longrightarrow> sets (SUP i\<in>I. M i) = sets N"
   unfolding Sup_measure_def
   using assms assms[THEN sets_eq_imp_space_eq]
     sets_Sup_measure'[where A=N and M="M`I"]
   by (intro Sup_lexord1[where P="\<lambda>x. sets x = sets N"]) auto
 
 lemma emeasure_SUP:
   assumes sets: "\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sets N" "X \<in> sets N" "I \<noteq> {}"
   shows "emeasure (SUP i\<in>I. M i) X = (SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. emeasure (SUP i\<in>J. M i) X)"
 proof -
   interpret sup_measure: comm_monoid_set sup "bot :: 'b measure"
     by standard (auto intro!: antisym)
   have eq: "finite J \<Longrightarrow> sup_measure.F id J = (SUP i\<in>J. i)" for J :: "'b measure set"
     by (induction J rule: finite_induct) auto
   have 1: "J \<noteq> {} \<Longrightarrow> J \<subseteq> I \<Longrightarrow> sets (SUP x\<in>J. M x) = sets N" for J
     by (intro sets_SUP sets) (auto )
   from \<open>I \<noteq> {}\<close> obtain i where "i\<in>I" by auto
   have "Sup_measure' (M`I) X = (SUP P\<in>{P. finite P \<and> P \<subseteq> M`I}. sup_measure.F id P X)"
     using sets by (intro emeasure_Sup_measure') auto
   also have "Sup_measure' (M`I) = (SUP i\<in>I. M i)"
     unfolding Sup_measure_def using \<open>I \<noteq> {}\<close> sets sets(1)[THEN sets_eq_imp_space_eq]
     by (intro Sup_lexord1[where P="\<lambda>x. _ = x"]) auto
   also have "(SUP P\<in>{P. finite P \<and> P \<subseteq> M`I}. sup_measure.F id P X) =
     (SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. (SUP i\<in>J. M i) X)"
   proof (intro SUP_eq)
     fix J assume "J \<in> {P. finite P \<and> P \<subseteq> M`I}"
     then obtain J' where J': "J' \<subseteq> I" "finite J'" and J: "J = M`J'" and "finite J"
       using finite_subset_image[of J M I] by auto
     show "\<exists>j\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> I}. sup_measure.F id J X \<le> (SUP i\<in>j. M i) X"
     proof cases
       assume "J' = {}" with \<open>i \<in> I\<close> show ?thesis
         by (auto simp add: J)
     next
       assume "J' \<noteq> {}" with J J' show ?thesis
         by (intro bexI[of _ "J'"]) (auto simp add: eq simp del: id_apply)
     qed
   next
     fix J assume J: "J \<in> {P. P \<noteq> {} \<and> finite P \<and> P \<subseteq> I}"
     show "\<exists>J'\<in>{J. finite J \<and> J \<subseteq> M`I}. (SUP i\<in>J. M i) X \<le> sup_measure.F id J' X"
       using J by (intro bexI[of _ "M`J"]) (auto simp add: eq simp del: id_apply)
   qed
   finally show ?thesis .
 qed
 
 lemma emeasure_SUP_chain:
   assumes sets: "\<And>i. i \<in> A \<Longrightarrow> sets (M i) = sets N" "X \<in> sets N"
   assumes ch: "Complete_Partial_Order.chain (\<le>) (M ` A)" and "A \<noteq> {}"
   shows "emeasure (SUP i\<in>A. M i) X = (SUP i\<in>A. emeasure (M i) X)"
 proof (subst emeasure_SUP[OF sets \<open>A \<noteq> {}\<close>])
   show "(SUP J\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}. emeasure (Sup (M ` J)) X) = (SUP i\<in>A. emeasure (M i) X)"
   proof (rule SUP_eq)
     fix J assume "J \<in> {J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}"
     then have J: "Complete_Partial_Order.chain (\<le>) (M ` J)" "finite J" "J \<noteq> {}" and "J \<subseteq> A"
       using ch[THEN chain_subset, of "M`J"] by auto
     with in_chain_finite[OF J(1)] obtain j where "j \<in> J" "(SUP j\<in>J. M j) = M j"
       by auto
     with \<open>J \<subseteq> A\<close> show "\<exists>j\<in>A. emeasure (Sup (M ` J)) X \<le> emeasure (M j) X"
       by auto
   next
     fix j assume "j\<in>A" then show "\<exists>i\<in>{J. J \<noteq> {} \<and> finite J \<and> J \<subseteq> A}. emeasure (M j) X \<le> emeasure (Sup (M ` i)) X"
       by (intro bexI[of _ "{j}"]) auto
   qed
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Supremum of a set of \<open>\<sigma>\<close>-algebras\<close>
 
 lemma space_Sup_eq_UN: "space (Sup M) = (\<Union>x\<in>M. space x)" (is "?L=?R")
 proof
   show "?L \<subseteq> ?R"
     using Sup_lexord[where P="\<lambda>x. space x = _"]
     apply (clarsimp simp: Sup_measure_def)
     by (smt (verit) Sup_lexord_def UN_E mem_Collect_eq space_Sup_measure'2 space_measure_of_conv)
 qed (use Sup_upper le_measureD1 in fastforce)
 
 
 lemma sets_Sup_eq:
   assumes *: "\<And>m. m \<in> M \<Longrightarrow> space m = X" and "M \<noteq> {}"
   shows "sets (Sup M) = sigma_sets X (\<Union>x\<in>M. sets x)"
   unfolding Sup_measure_def
 proof (rule Sup_lexord1 [OF \<open>M \<noteq> {}\<close>])
   show "sets (Sup_lexord sets Sup_measure' (\<lambda>U. sigma (\<Union> (space ` U)) (\<Union> (sets ` U))) M)
       = sigma_sets X (\<Union> (sets ` M))"
   apply (rule Sup_lexord)
   apply (metis (mono_tags, lifting) "*" empty_iff mem_Collect_eq sets.sigma_sets_eq sets_Sup_measure')
   by (metis "*" SUP_eq_const UN_space_closed assms(2) sets_measure_of)
 qed (use * in blast)
 
 
 lemma in_sets_Sup: "(\<And>m. m \<in> M \<Longrightarrow> space m = X) \<Longrightarrow> m \<in> M \<Longrightarrow> A \<in> sets m \<Longrightarrow> A \<in> sets (Sup M)"
   by (subst sets_Sup_eq[where X=X]) auto
 
 lemma Sup_lexord_rel:
   assumes "\<And>i. i \<in> I \<Longrightarrow> k (A i) = k (B i)"
     "R (c (A ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))})) (c (B ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))}))"
     "R (s (A`I)) (s (B`I))"
   shows "R (Sup_lexord k c s (A`I)) (Sup_lexord k c s (B`I))"
 proof -
   have "A ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))} =  {a \<in> A ` I. k a = (SUP x\<in>I. k (B x))}"
     using assms(1) by auto
   moreover have "B ` {a \<in> I. k (B a) = (SUP x\<in>I. k (B x))} =  {a \<in> B ` I. k a = (SUP x\<in>I. k (B x))}"
     by auto
   ultimately show ?thesis
     using assms by (auto simp: Sup_lexord_def Let_def image_comp)
 qed
 
 lemma sets_SUP_cong:
   assumes eq: "\<And>i. i \<in> I \<Longrightarrow> sets (M i) = sets (N i)" 
   shows "sets (SUP i\<in>I. M i) = sets (SUP i\<in>I. N i)"
   unfolding Sup_measure_def
   using eq eq[THEN sets_eq_imp_space_eq]
   by (intro Sup_lexord_rel[where R="\<lambda>x y. sets x = sets y"], simp_all add: sets_Sup_measure'2)
 
 lemma sets_Sup_in_sets:
   assumes "M \<noteq> {}"
   assumes "\<And>m. m \<in> M \<Longrightarrow> space m = space N"
   assumes "\<And>m. m \<in> M \<Longrightarrow> sets m \<subseteq> sets N"
   shows "sets (Sup M) \<subseteq> sets N"
 proof -
   have *: "\<Union>(space ` M) = space N"
     using assms by auto
   show ?thesis
     unfolding * using assms by (subst sets_Sup_eq[of M "space N"]) (auto intro!: sets.sigma_sets_subset)
 qed
 
 lemma measurable_Sup1:
   assumes m: "m \<in> M" and f: "f \<in> measurable m N"
     and const_space: "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> space m = space n"
   shows "f \<in> measurable (Sup M) N"
 proof -
   have "space (Sup M) = space m"
     using m by (auto simp add: space_Sup_eq_UN dest: const_space)
   then show ?thesis
     using m f unfolding measurable_def by (auto intro: in_sets_Sup[OF const_space])
 qed
 
 lemma measurable_Sup2:
   assumes M: "M \<noteq> {}"
   assumes f: "\<And>m. m \<in> M \<Longrightarrow> f \<in> measurable N m"
     and const_space: "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> space m = space n"
   shows "f \<in> measurable N (Sup M)"
 proof -
   from M obtain m where "m \<in> M" by auto
   have space_eq: "\<And>n. n \<in> M \<Longrightarrow> space n = space m"
     by (intro const_space \<open>m \<in> M\<close>)
   have eq: "sets (sigma (\<Union> (space ` M)) (\<Union> (sets ` M))) = sets (Sup M)"
     by (metis M SUP_eq_const UN_space_closed sets_Sup_eq sets_measure_of space_eq)
   have "f \<in> measurable N (sigma (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m))"
   proof (rule measurable_measure_of)
     show "f \<in> space N \<rightarrow> \<Union>(space ` M)"
       using measurable_space[OF f] M by auto
   qed (auto intro: measurable_sets f dest: sets.sets_into_space)
   also have "measurable N (sigma (\<Union>m\<in>M. space m) (\<Union>m\<in>M. sets m)) = measurable N (Sup M)"
     using eq measurable_cong_sets by blast
   finally show ?thesis .
 qed
 
 lemma measurable_SUP2:
   "I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f \<in> measurable N (M i)) \<Longrightarrow>
     (\<And>i j. i \<in> I \<Longrightarrow> j \<in> I \<Longrightarrow> space (M i) = space (M j)) \<Longrightarrow> f \<in> measurable N (SUP i\<in>I. M i)"
   by (auto intro!: measurable_Sup2)
 
 lemma sets_Sup_sigma:
   assumes [simp]: "M \<noteq> {}" and M: "\<And>m. m \<in> M \<Longrightarrow> m \<subseteq> Pow \<Omega>"
   shows "sets (SUP m\<in>M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
 proof -
   { fix a m assume "a \<in> sigma_sets \<Omega> m" "m \<in> M"
     then have "a \<in> sigma_sets \<Omega> (\<Union>M)"
       by induction (auto intro: sigma_sets.intros(2-)) }
   then have "sigma_sets \<Omega> (\<Union> (sigma_sets \<Omega> ` M)) = sigma_sets \<Omega> (\<Union> M)"
     by (smt (verit, best) UN_iff Union_iff sigma_sets.Basic sigma_sets_eqI)
   then show "sets (SUP m\<in>M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
     by (subst sets_Sup_eq) (fastforce simp add: M Union_least)+
 qed
 
 lemma Sup_sigma:
   assumes [simp]: "M \<noteq> {}" and M: "\<And>m. m \<in> M \<Longrightarrow> m \<subseteq> Pow \<Omega>"
   shows "(SUP m\<in>M. sigma \<Omega> m) = (sigma \<Omega> (\<Union>M))"
 proof (intro antisym SUP_least)
   have *: "\<Union>M \<subseteq> Pow \<Omega>"
     using M by auto
   show "sigma \<Omega> (\<Union>M) \<le> (SUP m\<in>M. sigma \<Omega> m)"
   proof (intro less_eq_measure.intros(3))
     show "space (sigma \<Omega> (\<Union>M)) = space (SUP m\<in>M. sigma \<Omega> m)"
          "sets (sigma \<Omega> (\<Union>M)) = sets (SUP m\<in>M. sigma \<Omega> m)"
       by (auto simp add: M sets_Sup_sigma sets_eq_imp_space_eq space_measure_of_conv)
   qed (simp add: emeasure_sigma le_fun_def)
   fix m assume "m \<in> M" then show "sigma \<Omega> m \<le> sigma \<Omega> (\<Union>M)"
     by (subst sigma_le_iff) (auto simp add: M *)
 qed
 
 lemma SUP_sigma_sigma:
   "M \<noteq> {} \<Longrightarrow> (\<And>m. m \<in> M \<Longrightarrow> f m \<subseteq> Pow \<Omega>) \<Longrightarrow> (SUP m\<in>M. sigma \<Omega> (f m)) = sigma \<Omega> (\<Union>m\<in>M. f m)"
   using Sup_sigma[of "f`M" \<Omega>] by (auto simp: image_comp)
 
 lemma sets_vimage_Sup_eq:
   assumes *: "M \<noteq> {}" "f \<in> X \<rightarrow> Y" "\<And>m. m \<in> M \<Longrightarrow> space m = Y"
   shows "sets (vimage_algebra X f (Sup M)) = sets (SUP m \<in> M. vimage_algebra X f m)"
   (is "?L = ?R")
 proof
   have "\<And>m. m \<in> M \<Longrightarrow> f \<in> Sup (vimage_algebra X f ` M) \<rightarrow>\<^sub>M m"
     using assms
     by (smt (verit, del_insts) Pi_iff imageE image_eqI measurable_Sup1
             measurable_vimage_algebra1 space_vimage_algebra)
   then show "?L \<subseteq> ?R"
      by (intro sets_image_in_sets measurable_Sup2) (simp_all add: space_Sup_eq_UN *)
   show "?R \<subseteq> ?L"
     apply (intro sets_Sup_in_sets)
     apply (force simp add: * space_Sup_eq_UN sets_vimage_algebra2 intro: in_sets_Sup)+
     done
 qed
 
 lemma restrict_space_eq_vimage_algebra':
   "sets (restrict_space M \<Omega>) = sets (vimage_algebra (\<Omega> \<inter> space M) (\<lambda>x. x) M)"
 proof -
   have *: "{A \<inter> (\<Omega> \<inter> space M) |A. A \<in> sets M} = {A \<inter> \<Omega> |A. A \<in> sets M}"
     using sets.sets_into_space[of _ M] by blast
 
   show ?thesis
     unfolding restrict_space_def
     by (subst sets_measure_of)
        (auto simp add: image_subset_iff sets_vimage_algebra * dest: sets.sets_into_space intro!: arg_cong2[where f=sigma_sets])
 qed
 
 lemma sigma_le_sets:
   assumes [simp]: "A \<subseteq> Pow X" shows "sets (sigma X A) \<subseteq> sets N \<longleftrightarrow> X \<in> sets N \<and> A \<subseteq> sets N"
 proof
   have "X \<in> sigma_sets X A" "A \<subseteq> sigma_sets X A"
     by (auto intro: sigma_sets_top)
   moreover assume "sets (sigma X A) \<subseteq> sets N"
   ultimately show "X \<in> sets N \<and> A \<subseteq> sets N"
     by auto
 next
   assume *: "X \<in> sets N \<and> A \<subseteq> sets N"
   { fix Y assume "Y \<in> sigma_sets X A" from this * have "Y \<in> sets N"
       by induction auto }
   then show "sets (sigma X A) \<subseteq> sets N"
     by auto
 qed
 
 lemma measurable_iff_sets:
   "f \<in> measurable M N \<longleftrightarrow> (f \<in> space M \<rightarrow> space N \<and> sets (vimage_algebra (space M) f N) \<subseteq> sets M)"
     unfolding measurable_def
     by (smt (verit, ccfv_threshold) mem_Collect_eq sets_vimage_algebra sigma_sets_le_sets_iff subset_eq)
 
 lemma sets_vimage_algebra_space: "X \<in> sets (vimage_algebra X f M)"
   using sets.top[of "vimage_algebra X f M"] by simp
 
 lemma measurable_mono:
   assumes N: "sets N' \<le> sets N" "space N = space N'"
   assumes M: "sets M \<le> sets M'" "space M = space M'"
   shows "measurable M N \<subseteq> measurable M' N'"
   unfolding measurable_def
 proof safe
   fix f A assume "f \<in> space M \<rightarrow> space N" "A \<in> sets N'"
   moreover assume "\<forall>y\<in>sets N. f -` y \<inter> space M \<in> sets M" note this[THEN bspec, of A]
   ultimately show "f -` A \<inter> space M' \<in> sets M'"
     using assms by auto
 qed (use N M in auto)
 
 lemma measurable_Sup_measurable:
   assumes f: "f \<in> space N \<rightarrow> A"
   shows "f \<in> measurable N (Sup {M. space M = A \<and> f \<in> measurable N M})"
 proof (rule measurable_Sup2)
   show "{M. space M = A \<and> f \<in> measurable N M} \<noteq> {}"
     using f unfolding ex_in_conv[symmetric]
     by (intro exI[of _ "sigma A {}"]) (auto intro!: measurable_measure_of)
 qed auto
 
 lemma (in sigma_algebra) sigma_sets_subset':
   assumes a: "a \<subseteq> M" "\<Omega>' \<in> M"
   shows "sigma_sets \<Omega>' a \<subseteq> M"
 proof
   show "x \<in> M" if x: "x \<in> sigma_sets \<Omega>' a" for x
     using x by (induct rule: sigma_sets.induct) (use a in auto)
 qed
 
 lemma in_sets_SUP: "i \<in> I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> space (M i) = Y) \<Longrightarrow> X \<in> sets (M i) \<Longrightarrow> X \<in> sets (SUP i\<in>I. M i)"
   by (intro in_sets_Sup[where X=Y]) auto
 
 lemma measurable_SUP1:
   "i \<in> I \<Longrightarrow> f \<in> measurable (M i) N \<Longrightarrow> (\<And>m n. m \<in> I \<Longrightarrow> n \<in> I \<Longrightarrow> space (M m) = space (M n)) \<Longrightarrow>
     f \<in> measurable (SUP i\<in>I. M i) N"
   by (auto intro: measurable_Sup1)
 
 lemma sets_image_in_sets':
   assumes X: "X \<in> sets N"
   assumes f: "\<And>A. A \<in> sets M \<Longrightarrow> f -` A \<inter> X \<in> sets N"
   shows "sets (vimage_algebra X f M) \<subseteq> sets N"
   unfolding sets_vimage_algebra
   by (rule sets.sigma_sets_subset') (auto intro!: measurable_sets X f)
 
 lemma mono_vimage_algebra:
   "sets M \<le> sets N \<Longrightarrow> sets (vimage_algebra X f M) \<subseteq> sets (vimage_algebra X f N)"
   using sets.top[of "sigma X {f -` A \<inter> X |A. A \<in> sets N}"]
   unfolding vimage_algebra_def
   by (smt (verit, del_insts) space_measure_of sigma_le_sets Pow_iff inf_le2 mem_Collect_eq subset_eq)
 
 lemma mono_restrict_space: "sets M \<le> sets N \<Longrightarrow> sets (restrict_space M X) \<subseteq> sets (restrict_space N X)"
   unfolding sets_restrict_space by (rule image_mono)
 
 lemma sets_eq_bot: "sets M = {{}} \<longleftrightarrow> M = bot"
   by (metis measure_eqI emeasure_empty sets_bot singletonD)
 
 lemma sets_eq_bot2: "{{}} = sets M \<longleftrightarrow> M = bot"
   using sets_eq_bot[of M] by blast
 
 
 lemma (in finite_measure) countable_support:
   "countable {x. measure M {x} \<noteq> 0}"
 proof cases
   assume "measure M (space M) = 0"
   then show ?thesis 
     by (metis (mono_tags, lifting) bounded_measure measure_le_0_iff Collect_empty_eq countable_empty) 
 next
   let ?M = "measure M (space M)" and ?m = "\<lambda>x. measure M {x}"
   assume "?M \<noteq> 0"
   then have *: "{x. ?m x \<noteq> 0} = (\<Union>n. {x. ?M / Suc n < ?m x})"
     using reals_Archimedean[of "?m x / ?M" for x]
     by (auto simp: field_simps not_le[symmetric] divide_le_0_iff measure_le_0_iff)
   have **: "\<And>n. finite {x. ?M / Suc n < ?m x}"
   proof (rule ccontr)
     fix n assume "infinite {x. ?M / Suc n < ?m x}" (is "infinite ?X")
     then obtain X where "finite X" "card X = Suc (Suc n)" "X \<subseteq> ?X"
       by (metis infinite_arbitrarily_large)
     then have *: "\<And>x. x \<in> X \<Longrightarrow> ?M / Suc n \<le> ?m x"
       by auto
     { fix x assume "x \<in> X"
       from \<open>?M \<noteq> 0\<close> *[OF this] have "?m x \<noteq> 0" by (auto simp: field_simps measure_le_0_iff)
       then have "{x} \<in> sets M" by (auto dest: measure_notin_sets) }
     note singleton_sets = this
     have "?M < (\<Sum>x\<in>X. ?M / Suc n)"
       using \<open>?M \<noteq> 0\<close>
       by (simp add: \<open>card X = Suc (Suc n)\<close> field_simps less_le)
     also have "\<dots> \<le> (\<Sum>x\<in>X. ?m x)"
       by (rule sum_mono) fact
     also have "\<dots> = measure M (\<Union>x\<in>X. {x})"
       using singleton_sets \<open>finite X\<close>
       by (intro finite_measure_finite_Union[symmetric]) (auto simp: disjoint_family_on_def)
     finally have "?M < measure M (\<Union>x\<in>X. {x})" .
     moreover have "measure M (\<Union>x\<in>X. {x}) \<le> ?M"
       using singleton_sets[THEN sets.sets_into_space] by (intro finite_measure_mono) auto
     ultimately show False by simp
   qed
   show ?thesis
     unfolding * by (intro countable_UN countableI_type countable_finite[OF **])
 qed
 
 end
diff --git a/src/HOL/Analysis/Product_Topology.thy b/src/HOL/Analysis/Product_Topology.thy
--- a/src/HOL/Analysis/Product_Topology.thy
+++ b/src/HOL/Analysis/Product_Topology.thy
@@ -1,643 +1,684 @@
 section\<open>The binary product topology\<close>
 
 theory Product_Topology
   imports Function_Topology
 begin
 
 section \<open>Product Topology\<close>
 
 subsection\<open>Definition\<close>
 
 definition prod_topology :: "'a topology \<Rightarrow> 'b topology \<Rightarrow> ('a \<times> 'b) topology" where
  "prod_topology X Y \<equiv> topology (arbitrary union_of (\<lambda>U. U \<in> {S \<times> T |S T. openin X S \<and> openin Y T}))"
 
 lemma open_product_open:
   assumes "open A"
   shows "\<exists>\<U>. \<U> \<subseteq> {S \<times> T |S T. open S \<and> open T} \<and> \<Union> \<U> = A"
 proof -
   obtain f g where *: "\<And>u. u \<in> A \<Longrightarrow> open (f u) \<and> open (g u) \<and> u \<in> (f u) \<times> (g u) \<and> (f u) \<times> (g u) \<subseteq> A"
     using open_prod_def [of A] assms by metis
   let ?\<U> = "(\<lambda>u. f u \<times> g u) ` A"
   show ?thesis
     by (rule_tac x="?\<U>" in exI) (auto simp: dest: *)
 qed
 
 lemma open_product_open_eq: "(arbitrary union_of (\<lambda>U. \<exists>S T. U = S \<times> T \<and> open S \<and> open T)) = open"
   by (force simp: union_of_def arbitrary_def intro: open_product_open open_Times)
 
 lemma openin_prod_topology:
    "openin (prod_topology X Y) = arbitrary union_of (\<lambda>U. U \<in> {S \<times> T |S T. openin X S \<and> openin Y T})"
   unfolding prod_topology_def
 proof (rule topology_inverse')
   show "istopology (arbitrary union_of (\<lambda>U. U \<in> {S \<times> T |S T. openin X S \<and> openin Y T}))"
     apply (rule istopology_base, simp)
     by (metis openin_Int Times_Int_Times)
 qed
 
 lemma topspace_prod_topology [simp]:
    "topspace (prod_topology X Y) = topspace X \<times> topspace Y"
 proof -
   have "topspace(prod_topology X Y) = \<Union> (Collect (openin (prod_topology X Y)))" (is "_ = ?Z")
     unfolding topspace_def ..
   also have "\<dots> = topspace X \<times> topspace Y"
   proof
     show "?Z \<subseteq> topspace X \<times> topspace Y"
       apply (auto simp: openin_prod_topology union_of_def arbitrary_def)
       using openin_subset by force+
   next
     have *: "\<exists>A B. topspace X \<times> topspace Y = A \<times> B \<and> openin X A \<and> openin Y B"
       by blast
     show "topspace X \<times> topspace Y \<subseteq> ?Z"
       apply (rule Union_upper)
       using * by (simp add: openin_prod_topology arbitrary_union_of_inc)
   qed
   finally show ?thesis .
 qed
 
 lemma subtopology_Times:
   shows "subtopology (prod_topology X Y) (S \<times> T) = prod_topology (subtopology X S) (subtopology Y T)"
 proof -
   have "((\<lambda>U. \<exists>S T. U = S \<times> T \<and> openin X S \<and> openin Y T) relative_to S \<times> T) =
         (\<lambda>U. \<exists>S' T'. U = S' \<times> T' \<and> (openin X relative_to S) S' \<and> (openin Y relative_to T) T')"
     by (auto simp: relative_to_def Times_Int_Times fun_eq_iff) metis
   then show ?thesis
     by (simp add: topology_eq openin_prod_topology arbitrary_union_of_relative_to flip: openin_relative_to)
 qed
 
 lemma prod_topology_subtopology:
     "prod_topology (subtopology X S) Y = subtopology (prod_topology X Y) (S \<times> topspace Y)"
     "prod_topology X (subtopology Y T) = subtopology (prod_topology X Y) (topspace X \<times> T)"
 by (auto simp: subtopology_Times)
 
 lemma prod_topology_discrete_topology:
      "discrete_topology (S \<times> T) = prod_topology (discrete_topology S) (discrete_topology T)"
   by (auto simp: discrete_topology_unique openin_prod_topology intro: arbitrary_union_of_inc)
 
 lemma prod_topology_euclidean [simp]: "prod_topology euclidean euclidean = euclidean"
   by (simp add: prod_topology_def open_product_open_eq)
 
 lemma prod_topology_subtopology_eu [simp]:
   "prod_topology (subtopology euclidean S) (subtopology euclidean T) = subtopology euclidean (S \<times> T)"
   by (simp add: prod_topology_subtopology subtopology_subtopology Times_Int_Times)
 
 lemma openin_prod_topology_alt:
      "openin (prod_topology X Y) S \<longleftrightarrow>
       (\<forall>x y. (x,y) \<in> S \<longrightarrow> (\<exists>U V. openin X U \<and> openin Y V \<and> x \<in> U \<and> y \<in> V \<and> U \<times> V \<subseteq> S))"
   apply (auto simp: openin_prod_topology arbitrary_union_of_alt, fastforce)
   by (metis mem_Sigma_iff)
 
 lemma open_map_fst: "open_map (prod_topology X Y) X fst"
   unfolding open_map_def openin_prod_topology_alt
   by (force simp: openin_subopen [of X "fst ` _"] intro: subset_fst_imageI)
 
 lemma open_map_snd: "open_map (prod_topology X Y) Y snd"
   unfolding open_map_def openin_prod_topology_alt
   by (force simp: openin_subopen [of Y "snd ` _"] intro: subset_snd_imageI)
 
 lemma openin_prod_Times_iff:
      "openin (prod_topology X Y) (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> openin X S \<and> openin Y T"
 proof (cases "S = {} \<or> T = {}")
   case False
   then show ?thesis
     apply (simp add: openin_prod_topology_alt openin_subopen [of X S] openin_subopen [of Y T] times_subset_iff, safe)
       apply (meson|force)+
     done
 qed force
 
 
 lemma closure_of_Times:
    "(prod_topology X Y) closure_of (S \<times> T) = (X closure_of S) \<times> (Y closure_of T)"  (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (clarsimp simp: closure_of_def openin_prod_topology_alt) blast
   show "?rhs \<subseteq> ?lhs"
     by (clarsimp simp: closure_of_def openin_prod_topology_alt) (meson SigmaI subsetD)
 qed
 
 lemma closedin_prod_Times_iff:
    "closedin (prod_topology X Y) (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> closedin X S \<and> closedin Y T"
   by (auto simp: closure_of_Times times_eq_iff simp flip: closure_of_eq)
 
 lemma interior_of_Times: "(prod_topology X Y) interior_of (S \<times> T) = (X interior_of S) \<times> (Y interior_of T)"
 proof (rule interior_of_unique)
   show "(X interior_of S) \<times> Y interior_of T \<subseteq> S \<times> T"
     by (simp add: Sigma_mono interior_of_subset)
   show "openin (prod_topology X Y) ((X interior_of S) \<times> Y interior_of T)"
     by (simp add: openin_prod_Times_iff)
 next
   show "T' \<subseteq> (X interior_of S) \<times> Y interior_of T" if "T' \<subseteq> S \<times> T" "openin (prod_topology X Y) T'" for T'
   proof (clarsimp; intro conjI)
     fix a :: "'a" and b :: "'b"
     assume "(a, b) \<in> T'"
     with that obtain U V where UV: "openin X U" "openin Y V" "a \<in> U" "b \<in> V" "U \<times> V \<subseteq> T'"
       by (metis openin_prod_topology_alt)
     then show "a \<in> X interior_of S"
       using interior_of_maximal_eq that(1) by fastforce
     show "b \<in> Y interior_of T"
       using UV interior_of_maximal_eq that(1)
       by (metis SigmaI mem_Sigma_iff subset_eq)
   qed
 qed
 
+text \<open>Missing the opposite direction. Does it hold? A converse is proved for proper maps, a stronger condition\<close>
+lemma closed_map_prod:
+  assumes "closed_map (prod_topology X Y) (prod_topology X' Y') (\<lambda>(x,y). (f x, g y))"
+  shows "topspace(prod_topology X Y) = {} \<or> closed_map X X' f \<and> closed_map Y Y' g"
+proof (cases "topspace(prod_topology X Y) = {}")
+  case False
+  then have ne: "topspace X \<noteq> {}" "topspace Y \<noteq> {}"
+    by auto
+  have "closed_map X X' f"
+    unfolding closed_map_def
+  proof (intro strip)
+    fix C
+    assume "closedin X C"
+    show "closedin X' (f ` C)"
+    proof (cases "C={}")
+      case False
+      with assms have "closedin (prod_topology X' Y') ((\<lambda>(x,y). (f x, g y)) ` (C \<times> topspace Y))"
+        by (simp add: \<open>closedin X C\<close> closed_map_def closedin_prod_Times_iff)
+      with False ne show ?thesis
+        by (simp add: image_paired_Times closedin_Times closedin_prod_Times_iff)
+    qed auto
+  qed
+  moreover
+  have "closed_map Y Y' g"
+    unfolding closed_map_def
+  proof (intro strip)
+    fix C
+    assume "closedin Y C"
+    show "closedin Y' (g ` C)"
+    proof (cases "C={}")
+      case False
+      with assms have "closedin (prod_topology X' Y') ((\<lambda>(x,y). (f x, g y)) ` (topspace X \<times> C))"
+        by (simp add: \<open>closedin Y C\<close> closed_map_def closedin_prod_Times_iff)
+      with False ne show ?thesis
+        by (simp add: image_paired_Times closedin_Times closedin_prod_Times_iff)
+    qed auto
+  qed
+  ultimately show ?thesis
+    by (auto simp: False)
+qed auto
+
 subsection \<open>Continuity\<close>
 
 lemma continuous_map_pairwise:
    "continuous_map Z (prod_topology X Y) f \<longleftrightarrow> continuous_map Z X (fst \<circ> f) \<and> continuous_map Z Y (snd \<circ> f)"
    (is "?lhs = ?rhs")
 proof -
   let ?g = "fst \<circ> f" and ?h = "snd \<circ> f"
   have f: "f x = (?g x, ?h x)" for x
     by auto
   show ?thesis
   proof (cases "(\<forall>x \<in> topspace Z. ?g x \<in> topspace X) \<and> (\<forall>x \<in> topspace Z. ?h x \<in> topspace Y)")
     case True
     show ?thesis
     proof safe
       assume "continuous_map Z (prod_topology X Y) f"
       then have "openin Z {x \<in> topspace Z. fst (f x) \<in> U}" if "openin X U" for U
         unfolding continuous_map_def using True that
         apply clarify
         apply (drule_tac x="U \<times> topspace Y" in spec)
         by (simp add: openin_prod_Times_iff mem_Times_iff cong: conj_cong)
       with True show "continuous_map Z X (fst \<circ> f)"
         by (auto simp: continuous_map_def)
     next
       assume "continuous_map Z (prod_topology X Y) f"
       then have "openin Z {x \<in> topspace Z. snd (f x) \<in> V}" if "openin Y V" for V
         unfolding continuous_map_def using True that
         apply clarify
         apply (drule_tac x="topspace X \<times> V" in spec)
         by (simp add: openin_prod_Times_iff mem_Times_iff cong: conj_cong)
       with True show "continuous_map Z Y (snd \<circ> f)"
         by (auto simp: continuous_map_def)
     next
       assume Z: "continuous_map Z X (fst \<circ> f)" "continuous_map Z Y (snd \<circ> f)"
       have *: "openin Z {x \<in> topspace Z. f x \<in> W}"
         if "\<And>w. w \<in> W \<Longrightarrow> \<exists>U V. openin X U \<and> openin Y V \<and> w \<in> U \<times> V \<and> U \<times> V \<subseteq> W" for W
       proof (subst openin_subopen, clarify)
         fix x :: "'a"
         assume "x \<in> topspace Z" and "f x \<in> W"
         with that [OF \<open>f x \<in> W\<close>]
         obtain U V where UV: "openin X U" "openin Y V" "f x \<in> U \<times> V" "U \<times> V \<subseteq> W"
           by auto
         with Z  UV show "\<exists>T. openin Z T \<and> x \<in> T \<and> T \<subseteq> {x \<in> topspace Z. f x \<in> W}"
           apply (rule_tac x="{x \<in> topspace Z. ?g x \<in> U} \<inter> {x \<in> topspace Z. ?h x \<in> V}" in exI)
           apply (auto simp: \<open>x \<in> topspace Z\<close> continuous_map_def)
           done
       qed
       show "continuous_map Z (prod_topology X Y) f"
         using True by (simp add: continuous_map_def openin_prod_topology_alt mem_Times_iff *)
     qed
   qed (auto simp: continuous_map_def)
 qed
 
 lemma continuous_map_paired:
    "continuous_map Z (prod_topology X Y) (\<lambda>x. (f x,g x)) \<longleftrightarrow> continuous_map Z X f \<and> continuous_map Z Y g"
   by (simp add: continuous_map_pairwise o_def)
 
 lemma continuous_map_pairedI [continuous_intros]:
    "\<lbrakk>continuous_map Z X f; continuous_map Z Y g\<rbrakk> \<Longrightarrow> continuous_map Z (prod_topology X Y) (\<lambda>x. (f x,g x))"
   by (simp add: continuous_map_pairwise o_def)
 
 lemma continuous_map_fst [continuous_intros]: "continuous_map (prod_topology X Y) X fst"
   using continuous_map_pairwise [of "prod_topology X Y" X Y id]
   by (simp add: continuous_map_pairwise)
 
 lemma continuous_map_snd [continuous_intros]: "continuous_map (prod_topology X Y) Y snd"
   using continuous_map_pairwise [of "prod_topology X Y" X Y id]
   by (simp add: continuous_map_pairwise)
 
 lemma continuous_map_fst_of [continuous_intros]:
    "continuous_map Z (prod_topology X Y) f \<Longrightarrow> continuous_map Z X (fst \<circ> f)"
   by (simp add: continuous_map_pairwise)
 
 lemma continuous_map_snd_of [continuous_intros]:
    "continuous_map Z (prod_topology X Y) f \<Longrightarrow> continuous_map Z Y (snd \<circ> f)"
   by (simp add: continuous_map_pairwise)
     
 lemma continuous_map_prod_fst: 
   "i \<in> I \<Longrightarrow> continuous_map (prod_topology (product_topology (\<lambda>i. Y) I) X) Y (\<lambda>x. fst x i)"
   using continuous_map_componentwise_UNIV continuous_map_fst by fastforce
 
 lemma continuous_map_prod_snd: 
   "i \<in> I \<Longrightarrow> continuous_map (prod_topology X (product_topology (\<lambda>i. Y) I)) Y (\<lambda>x. snd x i)"
   using continuous_map_componentwise_UNIV continuous_map_snd by fastforce
 
 lemma continuous_map_if_iff [simp]: "continuous_map X Y (\<lambda>x. if P then f x else g x) \<longleftrightarrow> continuous_map X Y (if P then f else g)"
   by simp
 
 lemma continuous_map_if [continuous_intros]: "\<lbrakk>P \<Longrightarrow> continuous_map X Y f; ~P \<Longrightarrow> continuous_map X Y g\<rbrakk>
       \<Longrightarrow> continuous_map X Y (\<lambda>x. if P then f x else g x)"
   by simp
 
 lemma continuous_map_subtopology_fst [continuous_intros]: "continuous_map (subtopology (prod_topology X Y) Z) X fst"
       using continuous_map_from_subtopology continuous_map_fst by force
 
 lemma continuous_map_subtopology_snd [continuous_intros]: "continuous_map (subtopology (prod_topology X Y) Z) Y snd"
       using continuous_map_from_subtopology continuous_map_snd by force
 
 lemma quotient_map_fst [simp]:
    "quotient_map(prod_topology X Y) X fst \<longleftrightarrow> (topspace Y = {} \<longrightarrow> topspace X = {})"
   by (auto simp: continuous_open_quotient_map open_map_fst continuous_map_fst)
 
 lemma quotient_map_snd [simp]:
    "quotient_map(prod_topology X Y) Y snd \<longleftrightarrow> (topspace X = {} \<longrightarrow> topspace Y = {})"
   by (auto simp: continuous_open_quotient_map open_map_snd continuous_map_snd)
 
 lemma retraction_map_fst:
    "retraction_map (prod_topology X Y) X fst \<longleftrightarrow> (topspace Y = {} \<longrightarrow> topspace X = {})"
 proof (cases "topspace Y = {}")
   case True
   then show ?thesis
     using continuous_map_image_subset_topspace
     by (fastforce simp: retraction_map_def retraction_maps_def continuous_map_fst continuous_map_on_empty)
 next
   case False
   have "\<exists>g. continuous_map X (prod_topology X Y) g \<and> (\<forall>x\<in>topspace X. fst (g x) = x)"
     if y: "y \<in> topspace Y" for y
     by (rule_tac x="\<lambda>x. (x,y)" in exI) (auto simp: y continuous_map_paired)
   with False have "retraction_map (prod_topology X Y) X fst"
     by (fastforce simp: retraction_map_def retraction_maps_def continuous_map_fst)
   with False show ?thesis
     by simp
 qed
 
 lemma retraction_map_snd:
    "retraction_map (prod_topology X Y) Y snd \<longleftrightarrow> (topspace X = {} \<longrightarrow> topspace Y = {})"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     using continuous_map_image_subset_topspace
     by (fastforce simp: retraction_map_def retraction_maps_def continuous_map_fst continuous_map_on_empty)
 next
   case False
   have "\<exists>g. continuous_map Y (prod_topology X Y) g \<and> (\<forall>y\<in>topspace Y. snd (g y) = y)"
     if x: "x \<in> topspace X" for x
     by (rule_tac x="\<lambda>y. (x,y)" in exI) (auto simp: x continuous_map_paired)
   with False have "retraction_map (prod_topology X Y) Y snd"
     by (fastforce simp: retraction_map_def retraction_maps_def continuous_map_snd)
   with False show ?thesis
     by simp
 qed
 
 
 lemma continuous_map_of_fst:
    "continuous_map (prod_topology X Y) Z (f \<circ> fst) \<longleftrightarrow> topspace Y = {} \<or> continuous_map X Z f"
 proof (cases "topspace Y = {}")
   case True
   then show ?thesis
     by (simp add: continuous_map_on_empty)
 next
   case False
   then show ?thesis
     by (simp add: continuous_compose_quotient_map_eq)
 qed
 
 lemma continuous_map_of_snd:
    "continuous_map (prod_topology X Y) Z (f \<circ> snd) \<longleftrightarrow> topspace X = {} \<or> continuous_map Y Z f"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: continuous_map_on_empty)
 next
   case False
   then show ?thesis
     by (simp add: continuous_compose_quotient_map_eq)
 qed
 
 lemma continuous_map_prod_top:
    "continuous_map (prod_topology X Y) (prod_topology X' Y') (\<lambda>(x,y). (f x, g y)) \<longleftrightarrow>
     topspace (prod_topology X Y) = {} \<or> continuous_map X X' f \<and> continuous_map Y Y' g"
 proof (cases "topspace (prod_topology X Y) = {}")
   case True
   then show ?thesis
     by (simp add: continuous_map_on_empty)
 next
   case False
   then show ?thesis
     by (simp add: continuous_map_paired case_prod_unfold continuous_map_of_fst [unfolded o_def] continuous_map_of_snd [unfolded o_def])
 qed
 
 lemma in_prod_topology_closure_of:
   assumes  "z \<in> (prod_topology X Y) closure_of S"
   shows "fst z \<in> X closure_of (fst ` S)" "snd z \<in> Y closure_of (snd ` S)"
   using assms continuous_map_eq_image_closure_subset continuous_map_fst apply fastforce
   using assms continuous_map_eq_image_closure_subset continuous_map_snd apply fastforce
   done
 
 
 proposition compact_space_prod_topology:
    "compact_space(prod_topology X Y) \<longleftrightarrow> topspace(prod_topology X Y) = {} \<or> compact_space X \<and> compact_space Y"
 proof (cases "topspace(prod_topology X Y) = {}")
   case True
   then show ?thesis
     using compact_space_topspace_empty by blast
 next
   case False
   then have non_mt: "topspace X \<noteq> {}" "topspace Y \<noteq> {}"
     by auto
   have "compact_space X" "compact_space Y" if "compact_space(prod_topology X Y)"
   proof -
     have "compactin X (fst ` (topspace X \<times> topspace Y))"
       by (metis compact_space_def continuous_map_fst image_compactin that topspace_prod_topology)
     moreover
     have "compactin Y (snd ` (topspace X \<times> topspace Y))"
       by (metis compact_space_def continuous_map_snd image_compactin that topspace_prod_topology)
     ultimately show "compact_space X" "compact_space Y"
       by (simp_all add: non_mt compact_space_def)
   qed
   moreover
   define \<X> where "\<X> \<equiv> (\<lambda>V. topspace X \<times> V) ` Collect (openin Y)"
   define \<Y> where "\<Y> \<equiv> (\<lambda>U. U \<times> topspace Y) ` Collect (openin X)"
   have "compact_space(prod_topology X Y)" if "compact_space X" "compact_space Y"
   proof (rule Alexander_subbase_alt)
     show toptop: "topspace X \<times> topspace Y \<subseteq> \<Union>(\<X> \<union> \<Y>)"
       unfolding \<X>_def \<Y>_def by auto
     fix \<C> :: "('a \<times> 'b) set set"
     assume \<C>: "\<C> \<subseteq> \<X> \<union> \<Y>" "topspace X \<times> topspace Y \<subseteq> \<Union>\<C>"
     then obtain \<X>' \<Y>' where XY: "\<X>' \<subseteq> \<X>" "\<Y>' \<subseteq> \<Y>" and \<C>eq: "\<C> = \<X>' \<union> \<Y>'"
       using subset_UnE by metis
     then have sub: "topspace X \<times> topspace Y \<subseteq> \<Union>(\<X>' \<union> \<Y>')"
       using \<C> by simp
     obtain \<U> \<V> where \<U>: "\<And>U. U \<in> \<U> \<Longrightarrow> openin X U" "\<Y>' = (\<lambda>U. U \<times> topspace Y) ` \<U>"
       and \<V>: "\<And>V. V \<in> \<V> \<Longrightarrow> openin Y V" "\<X>' = (\<lambda>V. topspace X \<times> V) ` \<V>"
       using XY by (clarsimp simp add: \<X>_def \<Y>_def subset_image_iff) (force simp add: subset_iff)
     have "\<exists>\<D>. finite \<D> \<and> \<D> \<subseteq> \<X>' \<union> \<Y>' \<and> topspace X \<times> topspace Y \<subseteq> \<Union> \<D>"
     proof -
       have "topspace X \<subseteq> \<Union>\<U> \<or> topspace Y \<subseteq> \<Union>\<V>"
         using \<U> \<V> \<C> \<C>eq by auto
       then have *: "\<exists>\<D>. finite \<D> \<and>
                (\<forall>x \<in> \<D>. x \<in> (\<lambda>V. topspace X \<times> V) ` \<V> \<or> x \<in> (\<lambda>U. U \<times> topspace Y) ` \<U>) \<and>
                (topspace X \<times> topspace Y \<subseteq> \<Union>\<D>)"
       proof
         assume "topspace X \<subseteq> \<Union>\<U>"
         with \<open>compact_space X\<close> \<U> obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<U>" "topspace X \<subseteq> \<Union>\<F>"
           by (meson compact_space_alt)
         with that show ?thesis
           by (rule_tac x="(\<lambda>D. D \<times> topspace Y) ` \<F>" in exI) auto
       next
         assume "topspace Y \<subseteq> \<Union>\<V>"
         with \<open>compact_space Y\<close> \<V> obtain \<F> where "finite \<F>" "\<F> \<subseteq> \<V>" "topspace Y \<subseteq> \<Union>\<F>"
           by (meson compact_space_alt)
         with that show ?thesis
           by (rule_tac x="(\<lambda>C. topspace X \<times> C) ` \<F>" in exI) auto
       qed
       then show ?thesis
         using that \<U> \<V> by blast
     qed
     then show "\<exists>\<D>. finite \<D> \<and> \<D> \<subseteq> \<C> \<and> topspace X \<times> topspace Y \<subseteq> \<Union> \<D>"
       using \<C> \<C>eq by blast
   next
     have "(finite intersection_of (\<lambda>x. x \<in> \<X> \<or> x \<in> \<Y>) relative_to topspace X \<times> topspace Y)
            = (\<lambda>U. \<exists>S T. U = S \<times> T \<and> openin X S \<and> openin Y T)"
       (is "?lhs = ?rhs")
     proof -
       have "?rhs U" if "?lhs U" for U
       proof -
         have "topspace X \<times> topspace Y \<inter> \<Inter> T \<in> {A \<times> B |A B. A \<in> Collect (openin X) \<and> B \<in> Collect (openin Y)}"
           if "finite T" "T \<subseteq> \<X> \<union> \<Y>" for T
           using that
         proof induction
           case (insert B \<B>)
           then show ?case
             unfolding \<X>_def \<Y>_def
             apply (simp add: Int_ac subset_eq image_def)
             apply (metis (no_types) openin_Int openin_topspace Times_Int_Times)
             done
         qed auto
         then show ?thesis
           using that
           by (auto simp: subset_eq  elim!: relative_toE intersection_ofE)
       qed
       moreover
       have "?lhs Z" if Z: "?rhs Z" for Z
       proof -
         obtain U V where "Z = U \<times> V" "openin X U" "openin Y V"
           using Z by blast
         then have UV: "U \<times> V = (topspace X \<times> topspace Y) \<inter> (U \<times> V)"
           by (simp add: Sigma_mono inf_absorb2 openin_subset)
         moreover
         have "?lhs ((topspace X \<times> topspace Y) \<inter> (U \<times> V))"
         proof (rule relative_to_inc)
           show "(finite intersection_of (\<lambda>x. x \<in> \<X> \<or> x \<in> \<Y>)) (U \<times> V)"
             apply (simp add: intersection_of_def \<X>_def \<Y>_def)
             apply (rule_tac x="{(U \<times> topspace Y),(topspace X \<times> V)}" in exI)
             using \<open>openin X U\<close> \<open>openin Y V\<close> openin_subset UV apply (fastforce simp add:)
             done
         qed
         ultimately show ?thesis
           using \<open>Z = U \<times> V\<close> by auto
       qed
       ultimately show ?thesis
         by meson
     qed
     then show "topology (arbitrary union_of (finite intersection_of (\<lambda>x. x \<in> \<X> \<union> \<Y>)
            relative_to (topspace X \<times> topspace Y))) =
         prod_topology X Y"
       by (simp add: prod_topology_def)
   qed
   ultimately show ?thesis
     using False by blast
 qed
 
 lemma compactin_Times:
    "compactin (prod_topology X Y) (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> compactin X S \<and> compactin Y T"
   by (auto simp: compactin_subspace subtopology_Times compact_space_prod_topology)
 
 subsection\<open>Homeomorphic maps\<close>
 
 lemma homeomorphic_maps_prod:
    "homeomorphic_maps (prod_topology X Y) (prod_topology X' Y') (\<lambda>(x,y). (f x, g y)) (\<lambda>(x,y). (f' x, g' y)) \<longleftrightarrow>
         topspace(prod_topology X Y) = {} \<and>
         topspace(prod_topology X' Y') = {} \<or>
         homeomorphic_maps X X' f f' \<and>
         homeomorphic_maps Y Y' g g'"
   unfolding homeomorphic_maps_def continuous_map_prod_top
   by (auto simp: continuous_map_def homeomorphic_maps_def continuous_map_prod_top)
 
 lemma homeomorphic_maps_swap:
    "homeomorphic_maps (prod_topology X Y) (prod_topology Y X)
                           (\<lambda>(x,y). (y,x)) (\<lambda>(y,x). (x,y))"
   by (auto simp: homeomorphic_maps_def case_prod_unfold continuous_map_fst continuous_map_pairedI continuous_map_snd)
 
 lemma homeomorphic_map_swap:
    "homeomorphic_map (prod_topology X Y) (prod_topology Y X) (\<lambda>(x,y). (y,x))"
   using homeomorphic_map_maps homeomorphic_maps_swap by metis
 
 lemma homeomorphic_space_prod_topology_swap:
    "(prod_topology X Y) homeomorphic_space (prod_topology Y X)"
   using homeomorphic_map_swap homeomorphic_space by blast
 
 lemma embedding_map_graph:
    "embedding_map X (prod_topology X Y) (\<lambda>x. (x, f x)) \<longleftrightarrow> continuous_map X Y f"
     (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   have "snd \<circ> (\<lambda>x. (x, f x)) = f"
     by force
   moreover have "continuous_map X Y (snd \<circ> (\<lambda>x. (x, f x)))"
     using L unfolding embedding_map_def
     by (meson continuous_map_in_subtopology continuous_map_snd_of homeomorphic_imp_continuous_map)
   ultimately show ?rhs
     by simp
 next
   assume R: ?rhs
   then show ?lhs
     unfolding homeomorphic_map_maps embedding_map_def homeomorphic_maps_def
     by (rule_tac x=fst in exI)
        (auto simp: continuous_map_in_subtopology continuous_map_paired continuous_map_from_subtopology
                    continuous_map_fst)
 qed
 
 lemma homeomorphic_space_prod_topology:
    "\<lbrakk>X homeomorphic_space X''; Y homeomorphic_space Y'\<rbrakk>
         \<Longrightarrow> prod_topology X Y homeomorphic_space prod_topology X'' Y'"
 using homeomorphic_maps_prod unfolding homeomorphic_space_def by blast
 
 lemma prod_topology_homeomorphic_space_left:
    "topspace Y = {b} \<Longrightarrow> prod_topology X Y homeomorphic_space X"
   unfolding homeomorphic_space_def
   by (rule_tac x=fst in exI) (simp add: homeomorphic_map_def inj_on_def flip: homeomorphic_map_maps)
 
 lemma prod_topology_homeomorphic_space_right:
    "topspace X = {a} \<Longrightarrow> prod_topology X Y homeomorphic_space Y"
   unfolding homeomorphic_space_def
   by (rule_tac x=snd in exI) (simp add: homeomorphic_map_def inj_on_def flip: homeomorphic_map_maps)
 
 
 lemma homeomorphic_space_prod_topology_sing1:
      "b \<in> topspace Y \<Longrightarrow> X homeomorphic_space (prod_topology X (subtopology Y {b}))"
   by (metis empty_subsetI homeomorphic_space_sym inf.absorb_iff2 insert_subset prod_topology_homeomorphic_space_left topspace_subtopology)
 
 lemma homeomorphic_space_prod_topology_sing2:
      "a \<in> topspace X \<Longrightarrow> Y homeomorphic_space (prod_topology (subtopology X {a}) Y)"
   by (metis empty_subsetI homeomorphic_space_sym inf.absorb_iff2 insert_subset prod_topology_homeomorphic_space_right topspace_subtopology)
 
 lemma topological_property_of_prod_component:
   assumes major: "P(prod_topology X Y)"
     and X: "\<And>x. \<lbrakk>x \<in> topspace X; P(prod_topology X Y)\<rbrakk> \<Longrightarrow> P(subtopology (prod_topology X Y) ({x} \<times> topspace Y))"
     and Y: "\<And>y. \<lbrakk>y \<in> topspace Y; P(prod_topology X Y)\<rbrakk> \<Longrightarrow> P(subtopology (prod_topology X Y) (topspace X \<times> {y}))"
     and PQ:  "\<And>X X'. X homeomorphic_space X' \<Longrightarrow> (P X \<longleftrightarrow> Q X')"
     and PR: "\<And>X X'. X homeomorphic_space X' \<Longrightarrow> (P X \<longleftrightarrow> R X')"
   shows "topspace(prod_topology X Y) = {} \<or> Q X \<and> R Y"
 proof -
   have "Q X \<and> R Y" if "topspace(prod_topology X Y) \<noteq> {}"
   proof -
     from that obtain a b where a: "a \<in> topspace X" and b: "b \<in> topspace Y"
       by force
     show ?thesis
       using X [OF a major] and Y [OF b major] homeomorphic_space_prod_topology_sing1 [OF b, of X] homeomorphic_space_prod_topology_sing2 [OF a, of Y]
       by (simp add: subtopology_Times) (meson PQ PR homeomorphic_space_prod_topology_sing2 homeomorphic_space_sym)
   qed
   then show ?thesis by metis
 qed
 
 lemma limitin_pairwise:
    "limitin (prod_topology X Y) f l F \<longleftrightarrow> limitin X (fst \<circ> f) (fst l) F \<and> limitin Y (snd \<circ> f) (snd l) F"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain a b where ev: "\<And>U. \<lbrakk>(a,b) \<in> U; openin (prod_topology X Y) U\<rbrakk> \<Longrightarrow> \<forall>\<^sub>F x in F. f x \<in> U"
                         and a: "a \<in> topspace X" and b: "b \<in> topspace Y" and l: "l = (a,b)"
     by (auto simp: limitin_def)
   moreover have "\<forall>\<^sub>F x in F. fst (f x) \<in> U" if "openin X U" "a \<in> U" for U
   proof -
     have "\<forall>\<^sub>F c in F. f c \<in> U \<times> topspace Y"
       using b that ev [of "U \<times> topspace Y"] by (auto simp: openin_prod_topology_alt)
     then show ?thesis
       by (rule eventually_mono) (metis (mono_tags, lifting) SigmaE2 prod.collapse)
   qed
   moreover have "\<forall>\<^sub>F x in F. snd (f x) \<in> U" if "openin Y U" "b \<in> U" for U
   proof -
     have "\<forall>\<^sub>F c in F. f c \<in> topspace X \<times> U"
       using a that ev [of "topspace X \<times> U"] by (auto simp: openin_prod_topology_alt)
     then show ?thesis
       by (rule eventually_mono) (metis (mono_tags, lifting) SigmaE2 prod.collapse)
   qed
   ultimately show ?rhs
     by (simp add: limitin_def)
 next
   have "limitin (prod_topology X Y) f (a,b) F"
     if "limitin X (fst \<circ> f) a F" "limitin Y (snd \<circ> f) b F" for a b
     using that
   proof (clarsimp simp: limitin_def)
     fix Z :: "('a \<times> 'b) set"
     assume a: "a \<in> topspace X" "\<forall>U. openin X U \<and> a \<in> U \<longrightarrow> (\<forall>\<^sub>F x in F. fst (f x) \<in> U)"
       and b: "b \<in> topspace Y" "\<forall>U. openin Y U \<and> b \<in> U \<longrightarrow> (\<forall>\<^sub>F x in F. snd (f x) \<in> U)"
       and Z: "openin (prod_topology X Y) Z" "(a, b) \<in> Z"
     then obtain U V where "openin X U" "openin Y V" "a \<in> U" "b \<in> V" "U \<times> V \<subseteq> Z"
       using Z by (force simp: openin_prod_topology_alt)
     then have "\<forall>\<^sub>F x in F. fst (f x) \<in> U" "\<forall>\<^sub>F x in F. snd (f x) \<in> V"
       by (simp_all add: a b)
     then show "\<forall>\<^sub>F x in F. f x \<in> Z"
       by (rule eventually_elim2) (use \<open>U \<times> V \<subseteq> Z\<close> subsetD in auto)
   qed
   then show "?rhs \<Longrightarrow> ?lhs"
     by (metis prod.collapse)
 qed
 
 proposition connected_space_prod_topology:
    "connected_space(prod_topology X Y) \<longleftrightarrow>
     topspace(prod_topology X Y) = {} \<or> connected_space X \<and> connected_space Y" (is "?lhs=?rhs")
 proof (cases "topspace(prod_topology X Y) = {}")
   case True
   then show ?thesis
     using connected_space_topspace_empty by blast
 next
   case False
   then have nonempty: "topspace X \<noteq> {}" "topspace Y \<noteq> {}"
     by force+
   show ?thesis 
   proof
     assume ?lhs
     then show ?rhs
       by (meson connected_space_quotient_map_image nonempty quotient_map_fst quotient_map_snd)
   next
     assume ?rhs
     then have conX: "connected_space X" and conY: "connected_space Y"
       using False by blast+
     have False
       if "openin (prod_topology X Y) U" and "openin (prod_topology X Y) V"
         and UV: "topspace X \<times> topspace Y \<subseteq> U \<union> V" "U \<inter> V = {}" 
         and "U \<noteq> {}" and "V \<noteq> {}"
       for U V
     proof -
       have Usub: "U \<subseteq> topspace X \<times> topspace Y" and Vsub: "V \<subseteq> topspace X \<times> topspace Y"
         using that by (metis openin_subset topspace_prod_topology)+
       obtain a b where ab: "(a,b) \<in> U" and a: "a \<in> topspace X" and b: "b \<in> topspace Y"
         using \<open>U \<noteq> {}\<close> Usub by auto
       have "\<not> topspace X \<times> topspace Y \<subseteq> U"
         using Usub Vsub \<open>U \<inter> V = {}\<close> \<open>V \<noteq> {}\<close> by auto
       then obtain x y where x: "x \<in> topspace X" and y: "y \<in> topspace Y" and "(x,y) \<notin> U"
         by blast
       have oX: "openin X {x \<in> topspace X. (x,y) \<in> U}" "openin X {x \<in> topspace X. (x,y) \<in> V}"
        and oY: "openin Y {y \<in> topspace Y. (a,y) \<in> U}" "openin Y {y \<in> topspace Y. (a,y) \<in> V}"
         by (force intro: openin_continuous_map_preimage [where Y = "prod_topology X Y"] 
             simp: that continuous_map_pairwise o_def x y a)+
       have 1: "topspace Y \<subseteq> {y \<in> topspace Y. (a,y) \<in> U} \<union> {y \<in> topspace Y. (a,y) \<in> V}"
         using a that(3) by auto
       have 2: "{y \<in> topspace Y. (a,y) \<in> U} \<inter> {y \<in> topspace Y. (a,y) \<in> V} = {}"
         using that(4) by auto
       have 3: "{y \<in> topspace Y. (a,y) \<in> U} \<noteq> {}"
         using ab b by auto
       have 4: "{y \<in> topspace Y. (a,y) \<in> V} \<noteq> {}"
       proof -
         show ?thesis
           using connected_spaceD [OF conX oX] UV \<open>(x,y) \<notin> U\<close> a x y
                 disjoint_iff_not_equal by blast
       qed
       show ?thesis
         using connected_spaceD [OF conY oY 1 2 3 4] by auto
     qed
     then show ?lhs
       unfolding connected_space_def topspace_prod_topology by blast 
   qed
 qed
 
 lemma connectedin_Times:
    "connectedin (prod_topology X Y) (S \<times> T) \<longleftrightarrow>
         S = {} \<or> T = {} \<or> connectedin X S \<and> connectedin Y T"
   by (force simp: connectedin_def subtopology_Times connected_space_prod_topology)
 
 end
 
diff --git a/src/HOL/Analysis/T1_Spaces.thy b/src/HOL/Analysis/T1_Spaces.thy
--- a/src/HOL/Analysis/T1_Spaces.thy
+++ b/src/HOL/Analysis/T1_Spaces.thy
@@ -1,750 +1,756 @@
 section\<open>T1 and Hausdorff spaces\<close>
 
 theory T1_Spaces
 imports Product_Topology
 begin
 
 section\<open>T1 spaces with equivalences to many naturally "nice" properties. \<close>
 
 definition t1_space where
  "t1_space X \<equiv> \<forall>x \<in> topspace X. \<forall>y \<in> topspace X. x\<noteq>y \<longrightarrow> (\<exists>U. openin X U \<and> x \<in> U \<and> y \<notin> U)"
 
 lemma t1_space_expansive:
    "\<lbrakk>topspace Y = topspace X; \<And>U. openin X U \<Longrightarrow> openin Y U\<rbrakk> \<Longrightarrow> t1_space X \<Longrightarrow> t1_space Y"
   by (metis t1_space_def)
 
 lemma t1_space_alt:
    "t1_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. x\<noteq>y \<longrightarrow> (\<exists>U. closedin X U \<and> x \<in> U \<and> y \<notin> U))"
  by (metis DiffE DiffI closedin_def openin_closedin_eq t1_space_def)
 
 lemma t1_space_empty: "topspace X = {} \<Longrightarrow> t1_space X"
   by (simp add: t1_space_def)
 
 lemma t1_space_derived_set_of_singleton:
   "t1_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. X derived_set_of {x} = {})"
   apply (simp add: t1_space_def derived_set_of_def, safe)
    apply (metis openin_topspace)
   by force
 
 lemma t1_space_derived_set_of_finite:
    "t1_space X \<longleftrightarrow> (\<forall>S. finite S \<longrightarrow> X derived_set_of S = {})"
 proof (intro iffI allI impI)
   fix S :: "'a set"
   assume "finite S"
   then have fin: "finite ((\<lambda>x. {x}) ` (topspace X \<inter> S))"
     by blast
   assume "t1_space X"
   then have "X derived_set_of (\<Union>x \<in> topspace X \<inter> S. {x}) = {}"
     unfolding derived_set_of_Union [OF fin]
     by (auto simp: t1_space_derived_set_of_singleton)
   then have "X derived_set_of (topspace X \<inter> S) = {}"
     by simp
   then show "X derived_set_of S = {}"
     by simp
 qed (auto simp: t1_space_derived_set_of_singleton)
 
 lemma t1_space_closedin_singleton:
    "t1_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. closedin X {x})"
   apply (rule iffI)
   apply (simp add: closedin_contains_derived_set t1_space_derived_set_of_singleton)
   using t1_space_alt by auto
 
+lemma continuous_closed_imp_proper_map:
+   "\<lbrakk>compact_space X; t1_space Y; continuous_map X Y f; closed_map X Y f\<rbrakk> \<Longrightarrow> proper_map X Y f"
+  unfolding proper_map_def
+  by (smt (verit) closedin_compact_space closedin_continuous_map_preimage 
+      Collect_cong singleton_iff t1_space_closedin_singleton)
+
 lemma t1_space_euclidean: "t1_space (euclidean :: 'a::metric_space topology)"
   by (simp add: t1_space_closedin_singleton)
 
 lemma closedin_t1_singleton:
    "\<lbrakk>t1_space X; a \<in> topspace X\<rbrakk> \<Longrightarrow> closedin X {a}"
   by (simp add: t1_space_closedin_singleton)
 
 lemma t1_space_closedin_finite:
    "t1_space X \<longleftrightarrow> (\<forall>S. finite S \<and> S \<subseteq> topspace X \<longrightarrow> closedin X S)"
   apply (rule iffI)
   apply (simp add: closedin_contains_derived_set t1_space_derived_set_of_finite)
   by (simp add: t1_space_closedin_singleton)
 
 lemma closure_of_singleton:
    "t1_space X \<Longrightarrow> X closure_of {a} = (if a \<in> topspace X then {a} else {})"
   by (simp add: closure_of_eq t1_space_closedin_singleton closure_of_eq_empty_gen)
 
 lemma separated_in_singleton:
   assumes "t1_space X"
   shows "separatedin X {a} S \<longleftrightarrow> a \<in> topspace X \<and> S \<subseteq> topspace X \<and> (a \<notin> X closure_of S)"
         "separatedin X S {a} \<longleftrightarrow> a \<in> topspace X \<and> S \<subseteq> topspace X \<and> (a \<notin> X closure_of S)"
   unfolding separatedin_def
   using assms closure_of closure_of_singleton by fastforce+
 
 lemma t1_space_openin_delete:
    "t1_space X \<longleftrightarrow> (\<forall>U x. openin X U \<and> x \<in> U \<longrightarrow> openin X (U - {x}))"
   apply (rule iffI)
   apply (meson closedin_t1_singleton in_mono openin_diff openin_subset)
   by (simp add: closedin_def t1_space_closedin_singleton)
 
 lemma t1_space_openin_delete_alt:
    "t1_space X \<longleftrightarrow> (\<forall>U x. openin X U \<longrightarrow> openin X (U - {x}))"
   by (metis Diff_empty Diff_insert0 t1_space_openin_delete)
 
 
 lemma t1_space_singleton_Inter_open:
       "t1_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<Inter>{U. openin X U \<and> x \<in> U} = {x})"  (is "?P=?Q")
   and t1_space_Inter_open_supersets:
      "t1_space X \<longleftrightarrow> (\<forall>S. S \<subseteq> topspace X \<longrightarrow> \<Inter>{U. openin X U \<and> S \<subseteq> U} = S)" (is "?P=?R")
 proof -
   have "?R \<Longrightarrow> ?Q"
     apply clarify
     apply (drule_tac x="{x}" in spec, simp)
     done
   moreover have "?Q \<Longrightarrow> ?P"
     apply (clarsimp simp add: t1_space_def)
     apply (drule_tac x=x in bspec)
      apply (simp_all add: set_eq_iff)
     by (metis (no_types, lifting))
   moreover have "?P \<Longrightarrow> ?R"
   proof (clarsimp simp add: t1_space_closedin_singleton, rule subset_antisym)
     fix S
     assume S: "\<forall>x\<in>topspace X. closedin X {x}" "S \<subseteq> topspace X"
     then show "\<Inter> {U. openin X U \<and> S \<subseteq> U} \<subseteq> S"
       apply clarsimp
       by (metis Diff_insert_absorb Set.set_insert closedin_def openin_topspace subset_insert)
   qed force
   ultimately show "?P=?Q" "?P=?R"
     by auto
 qed
 
 lemma t1_space_derived_set_of_infinite_openin:
    "t1_space X \<longleftrightarrow>
         (\<forall>S. X derived_set_of S =
              {x \<in> topspace X. \<forall>U. x \<in> U \<and> openin X U \<longrightarrow> infinite(S \<inter> U)})"
          (is "_ = ?rhs")
 proof
   assume "t1_space X"
   show ?rhs
   proof safe
     fix S x U
     assume "x \<in> X derived_set_of S" "x \<in> U" "openin X U" "finite (S \<inter> U)"
     with \<open>t1_space X\<close> show "False"
       apply (simp add: t1_space_derived_set_of_finite)
       by (metis IntI empty_iff empty_subsetI inf_commute openin_Int_derived_set_of_subset subset_antisym)
   next
     fix S x
     have eq: "(\<exists>y. (y \<noteq> x) \<and> y \<in> S \<and> y \<in> T) \<longleftrightarrow> ~((S \<inter> T) \<subseteq> {x})" for x S T
       by blast
     assume "x \<in> topspace X" "\<forall>U. x \<in> U \<and> openin X U \<longrightarrow> infinite (S \<inter> U)"
     then show "x \<in> X derived_set_of S"
       apply (clarsimp simp add: derived_set_of_def eq)
       by (meson finite.emptyI finite.insertI finite_subset)
   qed (auto simp: in_derived_set_of)
 qed (auto simp: t1_space_derived_set_of_singleton)
 
 lemma finite_t1_space_imp_discrete_topology:
    "\<lbrakk>topspace X = U; finite U; t1_space X\<rbrakk> \<Longrightarrow> X = discrete_topology U"
   by (metis discrete_topology_unique_derived_set t1_space_derived_set_of_finite)
 
 lemma t1_space_subtopology: "t1_space X \<Longrightarrow> t1_space(subtopology X U)"
   by (simp add: derived_set_of_subtopology t1_space_derived_set_of_finite)
 
 lemma closedin_derived_set_of_gen:
    "t1_space X \<Longrightarrow> closedin X (X derived_set_of S)"
   apply (clarsimp simp add: in_derived_set_of closedin_contains_derived_set derived_set_of_subset_topspace)
   by (metis DiffD2 insert_Diff insert_iff t1_space_openin_delete)
 
 lemma derived_set_of_derived_set_subset_gen:
    "t1_space X \<Longrightarrow> X derived_set_of (X derived_set_of S) \<subseteq> X derived_set_of S"
   by (meson closedin_contains_derived_set closedin_derived_set_of_gen)
 
 lemma subtopology_eq_discrete_topology_gen_finite:
    "\<lbrakk>t1_space X; finite S\<rbrakk> \<Longrightarrow> subtopology X S = discrete_topology(topspace X \<inter> S)"
   by (simp add: subtopology_eq_discrete_topology_gen t1_space_derived_set_of_finite)
 
 lemma subtopology_eq_discrete_topology_finite:
    "\<lbrakk>t1_space X; S \<subseteq> topspace X; finite S\<rbrakk>
         \<Longrightarrow> subtopology X S = discrete_topology S"
   by (simp add: subtopology_eq_discrete_topology_eq t1_space_derived_set_of_finite)
 
 lemma t1_space_closed_map_image:
    "\<lbrakk>closed_map X Y f; f ` (topspace X) = topspace Y; t1_space X\<rbrakk> \<Longrightarrow> t1_space Y"
   by (metis closed_map_def finite_subset_image t1_space_closedin_finite)
 
 lemma homeomorphic_t1_space: "X homeomorphic_space Y \<Longrightarrow> (t1_space X \<longleftrightarrow> t1_space Y)"
   apply (clarsimp simp add: homeomorphic_space_def)
   by (meson homeomorphic_eq_everything_map homeomorphic_maps_map t1_space_closed_map_image)
 
 proposition t1_space_product_topology:
    "t1_space (product_topology X I)
 \<longleftrightarrow> topspace(product_topology X I) = {} \<or> (\<forall>i \<in> I. t1_space (X i))"
 proof (cases "topspace(product_topology X I) = {}")
   case True
   then show ?thesis
     using True t1_space_empty by blast
 next
   case False
   then obtain f where f: "f \<in> (\<Pi>\<^sub>E i\<in>I. topspace(X i))"
     by fastforce
   have "t1_space (product_topology X I) \<longleftrightarrow> (\<forall>i\<in>I. t1_space (X i))"
   proof (intro iffI ballI)
     show "t1_space (X i)" if "t1_space (product_topology X I)" and "i \<in> I" for i
     proof -
       have clo: "\<And>h. h \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<Longrightarrow> closedin (product_topology X I) {h}"
         using that by (simp add: t1_space_closedin_singleton)
       show ?thesis
         unfolding t1_space_closedin_singleton
       proof clarify
         show "closedin (X i) {xi}" if "xi \<in> topspace (X i)" for xi
           using clo [of "\<lambda>j \<in> I. if i=j then xi else f j"] f that \<open>i \<in> I\<close>
           by (fastforce simp add: closedin_product_topology_singleton)
       qed
     qed
   next
   next
     show "t1_space (product_topology X I)" if "\<forall>i\<in>I. t1_space (X i)"
       using that
       by (simp add: t1_space_closedin_singleton Ball_def PiE_iff closedin_product_topology_singleton)
   qed
   then show ?thesis
     using False by blast
 qed
 
 lemma t1_space_prod_topology:
    "t1_space(prod_topology X Y) \<longleftrightarrow> topspace(prod_topology X Y) = {} \<or> t1_space X \<and> t1_space Y"
 proof (cases "topspace (prod_topology X Y) = {}")
   case True then show ?thesis
   by (auto simp: t1_space_empty)
 next
   case False
   have eq: "{(x,y)} = {x} \<times> {y}" for x y
     by simp
   have "t1_space (prod_topology X Y) \<longleftrightarrow> (t1_space X \<and> t1_space Y)"
     using False
     by (force simp: t1_space_closedin_singleton closedin_prod_Times_iff eq simp del: insert_Times_insert)
   with False show ?thesis
     by simp
 qed
 
 subsection\<open>Hausdorff Spaces\<close>
 
 definition Hausdorff_space
   where
  "Hausdorff_space X \<equiv>
         \<forall>x y. x \<in> topspace X \<and> y \<in> topspace X \<and> (x \<noteq> y)
               \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V)"
 
 lemma Hausdorff_space_expansive:
    "\<lbrakk>Hausdorff_space X; topspace X = topspace Y; \<And>U. openin X U \<Longrightarrow> openin Y U\<rbrakk> \<Longrightarrow> Hausdorff_space Y"
   by (metis Hausdorff_space_def)
 
 lemma Hausdorff_space_topspace_empty:
    "topspace X = {} \<Longrightarrow> Hausdorff_space X"
   by (simp add: Hausdorff_space_def)
 
 lemma Hausdorff_imp_t1_space:
    "Hausdorff_space X \<Longrightarrow> t1_space X"
   by (metis Hausdorff_space_def disjnt_iff t1_space_def)
 
 lemma closedin_derived_set_of:
    "Hausdorff_space X \<Longrightarrow> closedin X (X derived_set_of S)"
   by (simp add: Hausdorff_imp_t1_space closedin_derived_set_of_gen)
 
 lemma t1_or_Hausdorff_space:
    "t1_space X \<or> Hausdorff_space X \<longleftrightarrow> t1_space X"
   using Hausdorff_imp_t1_space by blast
 
 lemma Hausdorff_space_sing_Inter_opens:
    "\<lbrakk>Hausdorff_space X; a \<in> topspace X\<rbrakk> \<Longrightarrow> \<Inter>{u. openin X u \<and> a \<in> u} = {a}"
   using Hausdorff_imp_t1_space t1_space_singleton_Inter_open by force
 
 lemma Hausdorff_space_subtopology:
   assumes "Hausdorff_space X" shows "Hausdorff_space(subtopology X S)"
 proof -
   have *: "disjnt U V \<Longrightarrow> disjnt (S \<inter> U) (S \<inter> V)" for U V
     by (simp add: disjnt_iff)
   from assms show ?thesis
     apply (simp add: Hausdorff_space_def openin_subtopology_alt)
     apply (fast intro: * elim!: all_forward)
     done
 qed
 
 lemma Hausdorff_space_compact_separation:
   assumes X: "Hausdorff_space X" and S: "compactin X S" and T: "compactin X T" and "disjnt S T"
   obtains U V where "openin X U" "openin X V" "S \<subseteq> U" "T \<subseteq> V" "disjnt U V"
 proof (cases "S = {}")
   case True
   then show thesis
     by (metis \<open>compactin X T\<close> compactin_subset_topspace disjnt_empty1 empty_subsetI openin_empty openin_topspace that)
 next
   case False
   have "\<forall>x \<in> S. \<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> T \<subseteq> V \<and> disjnt U V"
   proof
     fix a
     assume "a \<in> S"
     then have "a \<notin> T"
       by (meson assms(4) disjnt_iff)
     have a: "a \<in> topspace X"
       using S \<open>a \<in> S\<close> compactin_subset_topspace by blast
     show "\<exists>U V. openin X U \<and> openin X V \<and> a \<in> U \<and> T \<subseteq> V \<and> disjnt U V"
     proof (cases "T = {}")
       case True
       then show ?thesis
         using a disjnt_empty2 openin_empty by blast
     next
       case False
       have "\<forall>x \<in> topspace X - {a}. \<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> a \<in> V \<and> disjnt U V"
         using X a by (simp add: Hausdorff_space_def)
       then obtain U V where UV: "\<forall>x \<in> topspace X - {a}. openin X (U x) \<and> openin X (V x) \<and> x \<in> U x \<and> a \<in> V x \<and> disjnt (U x) (V x)"
         by metis
       with \<open>a \<notin> T\<close> compactin_subset_topspace [OF T]
       have Topen: "\<forall>W \<in> U ` T. openin X W" and Tsub: "T \<subseteq> \<Union> (U ` T)"
         by auto
       then obtain \<F> where \<F>: "finite \<F>" "\<F> \<subseteq> U ` T" and "T \<subseteq> \<Union>\<F>"
         using T unfolding compactin_def by meson
       then obtain F where F: "finite F" "F \<subseteq> T" "\<F> = U ` F" and SUF: "T \<subseteq> \<Union>(U ` F)" and "a \<notin> F"
         using finite_subset_image [OF \<F>] \<open>a \<notin> T\<close> by (metis subsetD)
       have U: "\<And>x. \<lbrakk>x \<in> topspace X; x \<noteq> a\<rbrakk> \<Longrightarrow> openin X (U x)"
         and V: "\<And>x. \<lbrakk>x \<in> topspace X; x \<noteq> a\<rbrakk> \<Longrightarrow> openin X (V x)"
         and disj: "\<And>x. \<lbrakk>x \<in> topspace X; x \<noteq> a\<rbrakk> \<Longrightarrow> disjnt (U x) (V x)"
         using UV by blast+
       show ?thesis
       proof (intro exI conjI)
         have "F \<noteq> {}"
           using False SUF by blast
         with \<open>a \<notin> F\<close> show "openin X (\<Inter>(V ` F))"
           using F compactin_subset_topspace [OF T] by (force intro: V)
         show "openin X (\<Union>(U ` F))"
           using F Topen Tsub by (force intro: U)
         show "disjnt (\<Inter>(V ` F)) (\<Union>(U ` F))"
           using disj
           apply (auto simp: disjnt_def)
           using \<open>F \<subseteq> T\<close> \<open>a \<notin> F\<close> compactin_subset_topspace [OF T] by blast
         show "a \<in> (\<Inter>(V ` F))"
           using \<open>F \<subseteq> T\<close> T UV \<open>a \<notin> T\<close> compactin_subset_topspace by blast
       qed (auto simp: SUF)
     qed
   qed
   then obtain U V where UV: "\<forall>x \<in> S. openin X (U x) \<and> openin X (V x) \<and> x \<in> U x \<and> T \<subseteq> V x \<and> disjnt (U x) (V x)"
     by metis
   then have "S \<subseteq> \<Union> (U ` S)"
     by auto
   moreover have "\<forall>W \<in> U ` S. openin X W"
     using UV by blast
   ultimately obtain I where I: "S \<subseteq> \<Union> (U ` I)" "I \<subseteq> S" "finite I"
     by (metis S compactin_def finite_subset_image)
   show thesis
   proof
     show "openin X (\<Union>(U ` I))"
       using \<open>I \<subseteq> S\<close> UV by blast
     show "openin X (\<Inter> (V ` I))"
       using False UV \<open>I \<subseteq> S\<close> \<open>S \<subseteq> \<Union> (U ` I)\<close> \<open>finite I\<close> by blast
     show "disjnt (\<Union>(U ` I)) (\<Inter> (V ` I))"
       by simp (meson UV \<open>I \<subseteq> S\<close> disjnt_subset2 in_mono le_INF_iff order_refl)
   qed (use UV I in auto)
 qed
 
 
 lemma Hausdorff_space_compact_sets:
   "Hausdorff_space X \<longleftrightarrow>
     (\<forall>S T. compactin X S \<and> compactin X T \<and> disjnt S T
            \<longrightarrow> (\<exists>U V. openin X U \<and> openin X V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> disjnt U V))"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson Hausdorff_space_compact_separation)
 next
   assume R [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp add: Hausdorff_space_def)
     fix x y
     assume "x \<in> topspace X" "y \<in> topspace X" "x \<noteq> y"
     then show "\<exists>U. openin X U \<and> (\<exists>V. openin X V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V)"
       using R [of "{x}" "{y}"] by auto
   qed
 qed
 
 lemma compactin_imp_closedin:
   assumes X: "Hausdorff_space X" and S: "compactin X S" shows "closedin X S"
 proof -
   have "S \<subseteq> topspace X"
     by (simp add: assms compactin_subset_topspace)
   moreover
   have "\<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> topspace X - S" if "x \<in> topspace X" "x \<notin> S" for x
     using Hausdorff_space_compact_separation [OF X _ S, of "{x}"] that
     apply (simp add: disjnt_def)
     by (metis Diff_mono Diff_triv openin_subset)
   ultimately show ?thesis
     using closedin_def openin_subopen by force
 qed
 
 lemma closedin_Hausdorff_singleton:
    "\<lbrakk>Hausdorff_space X; x \<in> topspace X\<rbrakk> \<Longrightarrow> closedin X {x}"
   by (simp add: Hausdorff_imp_t1_space closedin_t1_singleton)
 
 lemma closedin_Hausdorff_sing_eq:
    "Hausdorff_space X \<Longrightarrow> closedin X {x} \<longleftrightarrow> x \<in> topspace X"
   by (meson closedin_Hausdorff_singleton closedin_subset insert_subset)
 
 lemma Hausdorff_space_discrete_topology [simp]:
    "Hausdorff_space (discrete_topology U)"
   unfolding Hausdorff_space_def
   by (metis Hausdorff_space_compact_sets Hausdorff_space_def compactin_discrete_topology equalityE openin_discrete_topology)
 
 lemma compactin_Int:
    "\<lbrakk>Hausdorff_space X; compactin X S; compactin X T\<rbrakk> \<Longrightarrow> compactin X (S \<inter> T)"
   by (simp add: closed_Int_compactin compactin_imp_closedin)
 
 lemma finite_topspace_imp_discrete_topology:
    "\<lbrakk>topspace X = U; finite U; Hausdorff_space X\<rbrakk> \<Longrightarrow> X = discrete_topology U"
   using Hausdorff_imp_t1_space finite_t1_space_imp_discrete_topology by blast
 
 lemma derived_set_of_finite:
    "\<lbrakk>Hausdorff_space X; finite S\<rbrakk> \<Longrightarrow> X derived_set_of S = {}"
   using Hausdorff_imp_t1_space t1_space_derived_set_of_finite by auto
 
 lemma infinite_perfect_set:
    "\<lbrakk>Hausdorff_space X; S \<subseteq> X derived_set_of S; S \<noteq> {}\<rbrakk> \<Longrightarrow> infinite S"
   using derived_set_of_finite by blast
 
 lemma derived_set_of_singleton:
    "Hausdorff_space X \<Longrightarrow> X derived_set_of {x} = {}"
   by (simp add: derived_set_of_finite)
 
 lemma closedin_Hausdorff_finite:
    "\<lbrakk>Hausdorff_space X; S \<subseteq> topspace X; finite S\<rbrakk> \<Longrightarrow> closedin X S"
   by (simp add: compactin_imp_closedin finite_imp_compactin_eq)
 
 lemma open_in_Hausdorff_delete:
    "\<lbrakk>Hausdorff_space X; openin X S\<rbrakk> \<Longrightarrow> openin X (S - {x})"
   using Hausdorff_imp_t1_space t1_space_openin_delete_alt by auto
 
 lemma closedin_Hausdorff_finite_eq:
    "\<lbrakk>Hausdorff_space X; finite S\<rbrakk> \<Longrightarrow> closedin X S \<longleftrightarrow> S \<subseteq> topspace X"
   by (meson closedin_Hausdorff_finite closedin_def)
 
 lemma derived_set_of_infinite_openin:
    "Hausdorff_space X
         \<Longrightarrow> X derived_set_of S =
             {x \<in> topspace X. \<forall>U. x \<in> U \<and> openin X U \<longrightarrow> infinite(S \<inter> U)}"
   using Hausdorff_imp_t1_space t1_space_derived_set_of_infinite_openin by fastforce
 
 lemma Hausdorff_space_discrete_compactin:
    "Hausdorff_space X
         \<Longrightarrow> S \<inter> X derived_set_of S = {} \<and> compactin X S \<longleftrightarrow> S \<subseteq> topspace X \<and> finite S"
   using derived_set_of_finite discrete_compactin_eq_finite by fastforce
 
 lemma Hausdorff_space_finite_topspace:
    "Hausdorff_space X \<Longrightarrow> X derived_set_of (topspace X) = {} \<and> compact_space X \<longleftrightarrow> finite(topspace X)"
   using derived_set_of_finite discrete_compact_space_eq_finite by auto
 
 lemma derived_set_of_derived_set_subset:
    "Hausdorff_space X \<Longrightarrow> X derived_set_of (X derived_set_of S) \<subseteq> X derived_set_of S"
   by (simp add: Hausdorff_imp_t1_space derived_set_of_derived_set_subset_gen)
 
 
 lemma Hausdorff_space_injective_preimage:
   assumes "Hausdorff_space Y" and cmf: "continuous_map X Y f" and "inj_on f (topspace X)"
   shows "Hausdorff_space X"
   unfolding Hausdorff_space_def
 proof clarify
   fix x y
   assume x: "x \<in> topspace X" and y: "y \<in> topspace X" and "x \<noteq> y"
   then obtain U V where "openin Y U" "openin Y V" "f x \<in> U" "f y \<in> V" "disjnt U V"
     using assms unfolding Hausdorff_space_def continuous_map_def by (meson inj_onD)
   show "\<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
   proof (intro exI conjI)
     show "openin X {x \<in> topspace X. f x \<in> U}"
       using \<open>openin Y U\<close> cmf continuous_map by fastforce
     show "openin X {x \<in> topspace X. f x \<in> V}"
       using \<open>openin Y V\<close> cmf openin_continuous_map_preimage by blast
     show "disjnt {x \<in> topspace X. f x \<in> U} {x \<in> topspace X. f x \<in> V}"
       using \<open>disjnt U V\<close> by (auto simp add: disjnt_def)
   qed (use x \<open>f x \<in> U\<close> y \<open>f y \<in> V\<close> in auto)
 qed
 
 lemma homeomorphic_Hausdorff_space:
    "X homeomorphic_space Y \<Longrightarrow> Hausdorff_space X \<longleftrightarrow> Hausdorff_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_map
   by (auto simp: homeomorphic_eq_everything_map Hausdorff_space_injective_preimage)
 
 lemma Hausdorff_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; Hausdorff_space X\<rbrakk> \<Longrightarrow> Hausdorff_space Y"
   unfolding retraction_map_def
   using Hausdorff_space_subtopology homeomorphic_Hausdorff_space retraction_maps_section_image2 by blast
 
 lemma compact_Hausdorff_space_optimal:
   assumes eq: "topspace Y = topspace X" and XY: "\<And>U. openin X U \<Longrightarrow> openin Y U"
       and "Hausdorff_space X" "compact_space Y"
     shows "Y = X"
 proof -
   have "\<And>U. closedin X U \<Longrightarrow> closedin Y U"
     using XY using topology_finer_closedin [OF eq]
     by metis
   have "openin Y S = openin X S" for S
     by (metis XY assms(3) assms(4) closedin_compact_space compactin_contractive compactin_imp_closedin eq openin_closedin_eq)
   then show ?thesis
     by (simp add: topology_eq)
 qed
 
 lemma continuous_map_imp_closed_graph:
   assumes f: "continuous_map X Y f" and Y: "Hausdorff_space Y"
   shows "closedin (prod_topology X Y) ((\<lambda>x. (x,f x)) ` topspace X)"
   unfolding closedin_def
 proof
   show "(\<lambda>x. (x, f x)) ` topspace X \<subseteq> topspace (prod_topology X Y)"
     using continuous_map_def f by fastforce
   show "openin (prod_topology X Y) (topspace (prod_topology X Y) - (\<lambda>x. (x, f x)) ` topspace X)"
     unfolding openin_prod_topology_alt
   proof (intro allI impI)
     show "\<exists>U V. openin X U \<and> openin Y V \<and> x \<in> U \<and> y \<in> V \<and> U \<times> V \<subseteq> topspace (prod_topology X Y) - (\<lambda>x. (x, f x)) ` topspace X"
       if "(x,y) \<in> topspace (prod_topology X Y) - (\<lambda>x. (x, f x)) ` topspace X"
       for x y
     proof -
       have "x \<in> topspace X" "y \<in> topspace Y" "y \<noteq> f x"
         using that by auto
       moreover have "f x \<in> topspace Y"
         by (meson \<open>x \<in> topspace X\<close> continuous_map_def f)
       ultimately obtain U V where UV: "openin Y U" "openin Y V" "f x \<in> U" "y \<in> V" "disjnt U V"
         using Y Hausdorff_space_def by metis
       show ?thesis
       proof (intro exI conjI)
         show "openin X {x \<in> topspace X. f x \<in> U}"
           using \<open>openin Y U\<close> f openin_continuous_map_preimage by blast
         show "{x \<in> topspace X. f x \<in> U} \<times> V \<subseteq> topspace (prod_topology X Y) - (\<lambda>x. (x, f x)) ` topspace X"
           using UV by (auto simp: disjnt_iff dest: openin_subset)
       qed (use UV \<open>x \<in> topspace X\<close> in auto)
     qed
   qed
 qed
 
 lemma continuous_imp_closed_map:
    "\<lbrakk>continuous_map X Y f; compact_space X; Hausdorff_space Y\<rbrakk> \<Longrightarrow> closed_map X Y f"
   by (meson closed_map_def closedin_compact_space compactin_imp_closedin image_compactin)
 
 lemma continuous_imp_quotient_map:
    "\<lbrakk>continuous_map X Y f; compact_space X; Hausdorff_space Y; f ` (topspace X) = topspace Y\<rbrakk>
         \<Longrightarrow> quotient_map X Y f"
   by (simp add: continuous_imp_closed_map continuous_closed_imp_quotient_map)
 
 lemma continuous_imp_homeomorphic_map:
    "\<lbrakk>continuous_map X Y f; compact_space X; Hausdorff_space Y; 
      f ` (topspace X) = topspace Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> homeomorphic_map X Y f"
   by (simp add: continuous_imp_closed_map bijective_closed_imp_homeomorphic_map)
 
 lemma continuous_imp_embedding_map:
    "\<lbrakk>continuous_map X Y f; compact_space X; Hausdorff_space Y; inj_on f (topspace X)\<rbrakk>
         \<Longrightarrow> embedding_map X Y f"
   by (simp add: continuous_imp_closed_map injective_closed_imp_embedding_map)
 
 lemma continuous_inverse_map:
   assumes "compact_space X" "Hausdorff_space Y"
     and cmf: "continuous_map X Y f" and gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g(f x) = x"
     and Sf:  "S \<subseteq> f ` (topspace X)"
   shows "continuous_map (subtopology Y S) X g"
 proof (rule continuous_map_from_subtopology_mono [OF _ \<open>S \<subseteq> f ` (topspace X)\<close>])
   show "continuous_map (subtopology Y (f ` (topspace X))) X g"
     unfolding continuous_map_closedin
   proof (intro conjI ballI allI impI)
     fix x
     assume "x \<in> topspace (subtopology Y (f ` topspace X))"
     then show "g x \<in> topspace X"
       by (auto simp: gf)
   next
     fix C
     assume C: "closedin X C"
     show "closedin (subtopology Y (f ` topspace X))
            {x \<in> topspace (subtopology Y (f ` topspace X)). g x \<in> C}"
     proof (rule compactin_imp_closedin)
       show "Hausdorff_space (subtopology Y (f ` topspace X))"
         using Hausdorff_space_subtopology [OF \<open>Hausdorff_space Y\<close>] by blast
       have "compactin Y (f ` C)"
         using C cmf image_compactin closedin_compact_space [OF \<open>compact_space X\<close>] by blast
       moreover have "{x \<in> topspace Y. x \<in> f ` topspace X \<and> g x \<in> C} = f ` C"
         using closedin_subset [OF C] cmf by (auto simp: gf continuous_map_def)
       ultimately have "compactin Y {x \<in> topspace Y. x \<in> f ` topspace X \<and> g x \<in> C}"
         by simp
       then show "compactin (subtopology Y (f ` topspace X))
               {x \<in> topspace (subtopology Y (f ` topspace X)). g x \<in> C}"
         by (auto simp add: compactin_subtopology)
     qed
   qed
 qed
 
 lemma closed_map_paired_continuous_map_right:
    "\<lbrakk>continuous_map X Y f; Hausdorff_space Y\<rbrakk> \<Longrightarrow> closed_map X (prod_topology X Y) (\<lambda>x. (x,f x))"
   by (simp add: continuous_map_imp_closed_graph embedding_map_graph embedding_imp_closed_map)
 
 lemma closed_map_paired_continuous_map_left:
   assumes f: "continuous_map X Y f" and Y: "Hausdorff_space Y"
   shows "closed_map X (prod_topology Y X) (\<lambda>x. (f x,x))"
 proof -
   have eq: "(\<lambda>x. (f x,x)) = (\<lambda>(a,b). (b,a)) \<circ> (\<lambda>x. (x,f x))"
     by auto
   show ?thesis
     unfolding eq
   proof (rule closed_map_compose)
     show "closed_map X (prod_topology X Y) (\<lambda>x. (x, f x))"
       using Y closed_map_paired_continuous_map_right f by blast
     show "closed_map (prod_topology X Y) (prod_topology Y X) (\<lambda>(a, b). (b, a))"
       by (metis homeomorphic_map_swap homeomorphic_imp_closed_map)
   qed
 qed
 
 lemma proper_map_paired_continuous_map_right:
    "\<lbrakk>continuous_map X Y f; Hausdorff_space Y\<rbrakk>
         \<Longrightarrow> proper_map X (prod_topology X Y) (\<lambda>x. (x,f x))"
   using closed_injective_imp_proper_map closed_map_paired_continuous_map_right
   by (metis (mono_tags, lifting) Pair_inject inj_onI)
 
 lemma proper_map_paired_continuous_map_left:
    "\<lbrakk>continuous_map X Y f; Hausdorff_space Y\<rbrakk>
         \<Longrightarrow> proper_map X (prod_topology Y X) (\<lambda>x. (f x,x))"
   using closed_injective_imp_proper_map closed_map_paired_continuous_map_left
   by (metis (mono_tags, lifting) Pair_inject inj_onI)
 
 lemma Hausdorff_space_prod_topology:
   "Hausdorff_space(prod_topology X Y) \<longleftrightarrow> topspace(prod_topology X Y) = {} \<or> Hausdorff_space X \<and> Hausdorff_space Y"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (rule topological_property_of_prod_component) (auto simp: Hausdorff_space_subtopology homeomorphic_Hausdorff_space)
 next
   assume R: ?rhs
   show ?lhs
   proof (cases "(topspace X \<times> topspace Y) = {}")
     case False
     with R have ne: "topspace X \<noteq> {}" "topspace Y \<noteq> {}" and X: "Hausdorff_space X" and Y: "Hausdorff_space Y"
       by auto
     show ?thesis
       unfolding Hausdorff_space_def
     proof clarify
       fix x y x' y'
       assume xy: "(x, y) \<in> topspace (prod_topology X Y)"
         and xy': "(x',y') \<in> topspace (prod_topology X Y)"
         and *: "\<nexists>U V. openin (prod_topology X Y) U \<and> openin (prod_topology X Y) V
                \<and> (x, y) \<in> U \<and> (x', y') \<in> V \<and> disjnt U V"
       have False if "x \<noteq> x' \<or> y \<noteq> y'"
         using that
       proof
         assume "x \<noteq> x'"
         then obtain U V where "openin X U" "openin X V" "x \<in> U" "x' \<in> V" "disjnt U V"
           by (metis Hausdorff_space_def X mem_Sigma_iff topspace_prod_topology xy xy')
         let ?U = "U \<times> topspace Y"
         let ?V = "V \<times> topspace Y"
         have "openin (prod_topology X Y) ?U" "openin (prod_topology X Y) ?V"
           by (simp_all add: openin_prod_Times_iff \<open>openin X U\<close> \<open>openin X V\<close>)
         moreover have "disjnt ?U ?V"
           by (simp add: \<open>disjnt U V\<close>)
         ultimately show False
           using * \<open>x \<in> U\<close> \<open>x' \<in> V\<close> xy xy' by (metis SigmaD2 SigmaI topspace_prod_topology)
       next
         assume "y \<noteq> y'"
         then obtain U V where "openin Y U" "openin Y V" "y \<in> U" "y' \<in> V" "disjnt U V"
           by (metis Hausdorff_space_def Y mem_Sigma_iff topspace_prod_topology xy xy')
         let ?U = "topspace X \<times> U"
         let ?V = "topspace X \<times> V"
         have "openin (prod_topology X Y) ?U" "openin (prod_topology X Y) ?V"
           by (simp_all add: openin_prod_Times_iff \<open>openin Y U\<close> \<open>openin Y V\<close>)
         moreover have "disjnt ?U ?V"
           by (simp add: \<open>disjnt U V\<close>)
         ultimately show False
           using "*" \<open>y \<in> U\<close> \<open>y' \<in> V\<close> xy xy' by (metis SigmaD1 SigmaI topspace_prod_topology)
       qed
       then show "x = x' \<and> y = y'"
         by blast
     qed
   qed (simp add: Hausdorff_space_topspace_empty)
 qed
 
 
 lemma Hausdorff_space_product_topology:
    "Hausdorff_space (product_topology X I) \<longleftrightarrow> (\<Pi>\<^sub>E i\<in>I. topspace(X i)) = {} \<or> (\<forall>i \<in> I. Hausdorff_space (X i))"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (rule topological_property_of_product_component)
      apply (blast dest: Hausdorff_space_subtopology homeomorphic_Hausdorff_space)+
     done
 next
   assume R: ?rhs
   show ?lhs
   proof (cases "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) = {}")
     case True
     then show ?thesis
       by (simp add: Hausdorff_space_topspace_empty)
   next
     case False
     have "\<exists>U V. openin (product_topology X I) U \<and> openin (product_topology X I) V \<and> f \<in> U \<and> g \<in> V \<and> disjnt U V"
       if f: "f \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" and g: "g \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" and "f \<noteq> g"
       for f g :: "'a \<Rightarrow> 'b"
     proof -
       obtain m where "f m \<noteq> g m"
         using \<open>f \<noteq> g\<close> by blast
       then have "m \<in> I"
         using f g by fastforce
       then have "Hausdorff_space (X m)" 
         using False that R by blast
       then obtain U V where U: "openin (X m) U" and V: "openin (X m) V" and "f m \<in> U" "g m \<in> V" "disjnt U V"
         by (metis Hausdorff_space_def PiE_mem \<open>f m \<noteq> g m\<close> \<open>m \<in> I\<close> f g)
       show ?thesis
       proof (intro exI conjI)
         let ?U = "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) \<inter> {x. x m \<in> U}"
         let ?V = "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) \<inter> {x. x m \<in> V}"
         show "openin (product_topology X I) ?U" "openin (product_topology X I) ?V"
           using \<open>m \<in> I\<close> U V
           by (force simp add: openin_product_topology intro: arbitrary_union_of_inc relative_to_inc finite_intersection_of_inc)+
         show "f \<in> ?U"
           using \<open>f m \<in> U\<close> f by blast
         show "g \<in> ?V"
           using \<open>g m \<in> V\<close> g by blast
         show "disjnt ?U ?V"
           using \<open>disjnt U V\<close> by (auto simp: PiE_def Pi_def disjnt_def)
         qed
     qed
     then show ?thesis
       by (simp add: Hausdorff_space_def)   
   qed
 qed
 
 lemma Hausdorff_space_closed_neighbourhood:
    "Hausdorff_space X \<longleftrightarrow>
     (\<forall>x \<in> topspace X. \<exists>U C. openin X U \<and> closedin X C \<and>
                       Hausdorff_space(subtopology X C) \<and> x \<in> U \<and> U \<subseteq> C)" (is "_ = ?rhs")
 proof
   assume R: ?rhs
   show "Hausdorff_space X"
     unfolding Hausdorff_space_def
   proof clarify
     fix x y
     assume x: "x \<in> topspace X" and y: "y \<in> topspace X" and "x \<noteq> y"
     obtain T C where *: "openin X T" "closedin X C" "x \<in> T" "T \<subseteq> C"
                  and C: "Hausdorff_space (subtopology X C)"
       by (meson R \<open>x \<in> topspace X\<close>)
     show "\<exists>U V. openin X U \<and> openin X V \<and> x \<in> U \<and> y \<in> V \<and> disjnt U V"
     proof (cases "y \<in> C")
       case True
       with * C obtain U V where U: "openin (subtopology X C) U"
                         and V: "openin (subtopology X C) V"
                         and "x \<in> U" "y \<in> V" "disjnt U V"
         unfolding Hausdorff_space_def
         by (smt (verit, best) \<open>x \<noteq> y\<close> closedin_subset subsetD topspace_subtopology_subset)
       then obtain U' V' where UV': "U = U' \<inter> C" "openin X U'" "V = V' \<inter> C" "openin X V'"
         by (meson openin_subtopology)
       have "disjnt (T \<inter> U') V'"
         using \<open>disjnt U V\<close> UV' \<open>T \<subseteq> C\<close> by (force simp: disjnt_iff)
       with \<open>T \<subseteq> C\<close> have "disjnt (T \<inter> U') (V' \<union> (topspace X - C))"
         unfolding disjnt_def by blast
       moreover
       have "openin X (T \<inter> U')"
         by (simp add: \<open>openin X T\<close> \<open>openin X U'\<close> openin_Int)
       moreover have "openin X (V' \<union> (topspace X - C))"
         using \<open>closedin X C\<close> \<open>openin X V'\<close> by auto
       ultimately show ?thesis
         using UV' \<open>x \<in> T\<close> \<open>x \<in> U\<close> \<open>y \<in> V\<close> by blast
     next
       case False
       with * y show ?thesis
         by (force simp: closedin_def disjnt_def)
     qed
   qed
 qed fastforce
 
 end
diff --git a/src/HOL/Nat.thy b/src/HOL/Nat.thy
--- a/src/HOL/Nat.thy
+++ b/src/HOL/Nat.thy
@@ -1,2572 +1,2583 @@
 (*  Title:      HOL/Nat.thy
     Author:     Tobias Nipkow
     Author:     Lawrence C Paulson
     Author:     Markus Wenzel
 *)
 
 section \<open>Natural numbers\<close>
 
 theory Nat
 imports Inductive Typedef Fun Rings
 begin
 
 subsection \<open>Type \<open>ind\<close>\<close>
 
 typedecl ind
 
 axiomatization Zero_Rep :: ind and Suc_Rep :: "ind \<Rightarrow> ind"
   \<comment> \<open>The axiom of infinity in 2 parts:\<close>
   where Suc_Rep_inject: "Suc_Rep x = Suc_Rep y \<Longrightarrow> x = y"
     and Suc_Rep_not_Zero_Rep: "Suc_Rep x \<noteq> Zero_Rep"
 
 
 subsection \<open>Type nat\<close>
 
 text \<open>Type definition\<close>
 
 inductive Nat :: "ind \<Rightarrow> bool"
   where
     Zero_RepI: "Nat Zero_Rep"
   | Suc_RepI: "Nat i \<Longrightarrow> Nat (Suc_Rep i)"
 
 typedef nat = "{n. Nat n}"
   morphisms Rep_Nat Abs_Nat
   using Nat.Zero_RepI by auto
 
 lemma Nat_Rep_Nat: "Nat (Rep_Nat n)"
   using Rep_Nat by simp
 
 lemma Nat_Abs_Nat_inverse: "Nat n \<Longrightarrow> Rep_Nat (Abs_Nat n) = n"
   using Abs_Nat_inverse by simp
 
 lemma Nat_Abs_Nat_inject: "Nat n \<Longrightarrow> Nat m \<Longrightarrow> Abs_Nat n = Abs_Nat m \<longleftrightarrow> n = m"
   using Abs_Nat_inject by simp
 
 instantiation nat :: zero
 begin
 
 definition Zero_nat_def: "0 = Abs_Nat Zero_Rep"
 
 instance ..
 
 end
 
 definition Suc :: "nat \<Rightarrow> nat"
   where "Suc n = Abs_Nat (Suc_Rep (Rep_Nat n))"
 
 lemma Suc_not_Zero: "Suc m \<noteq> 0"
   by (simp add: Zero_nat_def Suc_def Suc_RepI Zero_RepI
       Nat_Abs_Nat_inject Suc_Rep_not_Zero_Rep Nat_Rep_Nat)
 
 lemma Zero_not_Suc: "0 \<noteq> Suc m"
   by (rule not_sym) (rule Suc_not_Zero)
 
 lemma Suc_Rep_inject': "Suc_Rep x = Suc_Rep y \<longleftrightarrow> x = y"
   by (rule iffI, rule Suc_Rep_inject) simp_all
 
 lemma nat_induct0:
   assumes "P 0" and "\<And>n. P n \<Longrightarrow> P (Suc n)"
   shows "P n"
 proof -
   have "P (Abs_Nat (Rep_Nat n))"
     using assms unfolding Zero_nat_def Suc_def
     by (iprover intro:  Nat_Rep_Nat [THEN Nat.induct] elim: Nat_Abs_Nat_inverse [THEN subst])
   then show ?thesis
     by (simp add: Rep_Nat_inverse)
 qed
 
 free_constructors case_nat for "0 :: nat" | Suc pred
   where "pred (0 :: nat) = (0 :: nat)"
 proof atomize_elim
   fix n
   show "n = 0 \<or> (\<exists>m. n = Suc m)"
     by (induction n rule: nat_induct0) auto
 next
   fix n m
   show "(Suc n = Suc m) = (n = m)"
     by (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI Suc_Rep_inject' Rep_Nat_inject)
 next
   fix n
   show "0 \<noteq> Suc n"
     by (simp add: Suc_not_Zero)
 qed
 
 
 \<comment> \<open>Avoid name clashes by prefixing the output of \<open>old_rep_datatype\<close> with \<open>old\<close>.\<close>
 setup \<open>Sign.mandatory_path "old"\<close>
 
 old_rep_datatype "0 :: nat" Suc
   by (erule nat_induct0) auto
 
 setup \<open>Sign.parent_path\<close>
 
 \<comment> \<open>But erase the prefix for properties that are not generated by \<open>free_constructors\<close>.\<close>
 setup \<open>Sign.mandatory_path "nat"\<close>
 
 declare old.nat.inject[iff del]
   and old.nat.distinct(1)[simp del, induct_simp del]
 
 lemmas induct = old.nat.induct
 lemmas inducts = old.nat.inducts
 lemmas rec = old.nat.rec
 lemmas simps = nat.inject nat.distinct nat.case nat.rec
 
 setup \<open>Sign.parent_path\<close>
 
 abbreviation rec_nat :: "'a \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a"
   where "rec_nat \<equiv> old.rec_nat"
 
 declare nat.sel[code del]
 
 hide_const (open) Nat.pred \<comment> \<open>hide everything related to the selector\<close>
 hide_fact
   nat.case_eq_if
   nat.collapse
   nat.expand
   nat.sel
   nat.exhaust_sel
   nat.split_sel
   nat.split_sel_asm
 
 lemma nat_exhaust [case_names 0 Suc, cases type: nat]:
   "(y = 0 \<Longrightarrow> P) \<Longrightarrow> (\<And>nat. y = Suc nat \<Longrightarrow> P) \<Longrightarrow> P"
   \<comment> \<open>for backward compatibility -- names of variables differ\<close>
   by (rule old.nat.exhaust)
 
 lemma nat_induct [case_names 0 Suc, induct type: nat]:
   fixes n
   assumes "P 0" and "\<And>n. P n \<Longrightarrow> P (Suc n)"
   shows "P n"
   \<comment> \<open>for backward compatibility -- names of variables differ\<close>
   using assms by (rule nat.induct)
 
 hide_fact
   nat_exhaust
   nat_induct0
 
 ML \<open>
 val nat_basic_lfp_sugar =
   let
     val ctr_sugar = the (Ctr_Sugar.ctr_sugar_of_global \<^theory> \<^type_name>\<open>nat\<close>);
     val recx = Logic.varify_types_global \<^term>\<open>rec_nat\<close>;
     val C = body_type (fastype_of recx);
   in
     {T = HOLogic.natT, fp_res_index = 0, C = C, fun_arg_Tsss = [[], [[HOLogic.natT, C]]],
      ctr_sugar = ctr_sugar, recx = recx, rec_thms = @{thms nat.rec}}
   end;
 \<close>
 
 setup \<open>
 let
   fun basic_lfp_sugars_of _ [\<^typ>\<open>nat\<close>] _ _ ctxt =
       ([], [0], [nat_basic_lfp_sugar], [], [], [], TrueI (*dummy*), [], false, ctxt)
     | basic_lfp_sugars_of bs arg_Ts callers callssss ctxt =
       BNF_LFP_Rec_Sugar.default_basic_lfp_sugars_of bs arg_Ts callers callssss ctxt;
 in
   BNF_LFP_Rec_Sugar.register_lfp_rec_extension
     {nested_simps = [], special_endgame_tac = K (K (K (K no_tac))), is_new_datatype = K (K true),
      basic_lfp_sugars_of = basic_lfp_sugars_of, rewrite_nested_rec_call = NONE}
 end
 \<close>
 
 text \<open>Injectiveness and distinctness lemmas\<close>
 
 lemma inj_Suc [simp]:
   "inj_on Suc N"
   by (simp add: inj_on_def)
 
 lemma bij_betw_Suc [simp]:
   "bij_betw Suc M N \<longleftrightarrow> Suc ` M = N"
   by (simp add: bij_betw_def)
 
 lemma Suc_neq_Zero: "Suc m = 0 \<Longrightarrow> R"
   by (rule notE) (rule Suc_not_Zero)
 
 lemma Zero_neq_Suc: "0 = Suc m \<Longrightarrow> R"
   by (rule Suc_neq_Zero) (erule sym)
 
 lemma Suc_inject: "Suc x = Suc y \<Longrightarrow> x = y"
   by (rule inj_Suc [THEN injD])
 
 lemma n_not_Suc_n: "n \<noteq> Suc n"
   by (induct n) simp_all
 
 lemma Suc_n_not_n: "Suc n \<noteq> n"
   by (rule not_sym) (rule n_not_Suc_n)
 
 text \<open>A special form of induction for reasoning about \<^term>\<open>m < n\<close> and \<^term>\<open>m - n\<close>.\<close>
 lemma diff_induct:
   assumes "\<And>x. P x 0"
     and "\<And>y. P 0 (Suc y)"
     and "\<And>x y. P x y \<Longrightarrow> P (Suc x) (Suc y)"
   shows "P m n"
 proof (induct n arbitrary: m)
   case 0
   show ?case by (rule assms(1))
 next
   case (Suc n)
   show ?case
   proof (induct m)
     case 0
     show ?case by (rule assms(2))
   next
     case (Suc m)
     from \<open>P m n\<close> show ?case by (rule assms(3))
   qed
 qed
 
 
 subsection \<open>Arithmetic operators\<close>
 
 instantiation nat :: comm_monoid_diff
 begin
 
 primrec plus_nat
   where
     add_0: "0 + n = (n::nat)"
   | add_Suc: "Suc m + n = Suc (m + n)"
 
 lemma add_0_right [simp]: "m + 0 = m"
   for m :: nat
   by (induct m) simp_all
 
 lemma add_Suc_right [simp]: "m + Suc n = Suc (m + n)"
   by (induct m) simp_all
 
 declare add_0 [code]
 
 lemma add_Suc_shift [code]: "Suc m + n = m + Suc n"
   by simp
 
 primrec minus_nat
   where
     diff_0 [code]: "m - 0 = (m::nat)"
   | diff_Suc: "m - Suc n = (case m - n of 0 \<Rightarrow> 0 | Suc k \<Rightarrow> k)"
 
 declare diff_Suc [simp del]
 
 lemma diff_0_eq_0 [simp, code]: "0 - n = 0"
   for n :: nat
   by (induct n) (simp_all add: diff_Suc)
 
 lemma diff_Suc_Suc [simp, code]: "Suc m - Suc n = m - n"
   by (induct n) (simp_all add: diff_Suc)
 
 instance
 proof
   fix n m q :: nat
   show "(n + m) + q = n + (m + q)" by (induct n) simp_all
   show "n + m = m + n" by (induct n) simp_all
   show "m + n - m = n" by (induct m) simp_all
   show "n - m - q = n - (m + q)" by (induct q) (simp_all add: diff_Suc)
   show "0 + n = n" by simp
   show "0 - n = 0" by simp
 qed
 
 end
 
 hide_fact (open) add_0 add_0_right diff_0
 
 instantiation nat :: comm_semiring_1_cancel
 begin
 
 definition One_nat_def [simp]: "1 = Suc 0"
 
 primrec times_nat
   where
     mult_0: "0 * n = (0::nat)"
   | mult_Suc: "Suc m * n = n + (m * n)"
 
 lemma mult_0_right [simp]: "m * 0 = 0"
   for m :: nat
   by (induct m) simp_all
 
 lemma mult_Suc_right [simp]: "m * Suc n = m + (m * n)"
   by (induct m) (simp_all add: add.left_commute)
 
 lemma add_mult_distrib: "(m + n) * k = (m * k) + (n * k)"
   for m n k :: nat
   by (induct m) (simp_all add: add.assoc)
 
 instance
 proof
   fix k n m q :: nat
   show "0 \<noteq> (1::nat)"
     by simp
   show "1 * n = n"
     by simp
   show "n * m = m * n"
     by (induct n) simp_all
   show "(n * m) * q = n * (m * q)"
     by (induct n) (simp_all add: add_mult_distrib)
   show "(n + m) * q = n * q + m * q"
     by (rule add_mult_distrib)
   show "k * (m - n) = (k * m) - (k * n)"
     by (induct m n rule: diff_induct) simp_all
 qed
 
 end
 
 
 subsubsection \<open>Addition\<close>
 
 text \<open>Reasoning about \<open>m + 0 = 0\<close>, etc.\<close>
 
 lemma add_is_0 [iff]: "m + n = 0 \<longleftrightarrow> m = 0 \<and> n = 0"
   for m n :: nat
   by (cases m) simp_all
 
 lemma add_is_1: "m + n = Suc 0 \<longleftrightarrow> m = Suc 0 \<and> n = 0 \<or> m = 0 \<and> n = Suc 0"
   by (cases m) simp_all
 
 lemma one_is_add: "Suc 0 = m + n \<longleftrightarrow> m = Suc 0 \<and> n = 0 \<or> m = 0 \<and> n = Suc 0"
   by (rule trans, rule eq_commute, rule add_is_1)
 
 lemma add_eq_self_zero: "m + n = m \<Longrightarrow> n = 0"
   for m n :: nat
   by (induct m) simp_all
 
 lemma plus_1_eq_Suc:
   "plus 1 = Suc"
   by (simp add: fun_eq_iff)
 
 lemma Suc_eq_plus1: "Suc n = n + 1"
   by simp
 
 lemma Suc_eq_plus1_left: "Suc n = 1 + n"
   by simp
 
 
 subsubsection \<open>Difference\<close>
 
 lemma Suc_diff_diff [simp]: "(Suc m - n) - Suc k = m - n - k"
   by (simp add: diff_diff_add)
 
 lemma diff_Suc_1 [simp]: "Suc n - 1 = n"
   by simp
 
 
 subsubsection \<open>Multiplication\<close>
 
 lemma mult_is_0 [simp]: "m * n = 0 \<longleftrightarrow> m = 0 \<or> n = 0" for m n :: nat
   by (induct m) auto
 
 lemma mult_eq_1_iff [simp]: "m * n = Suc 0 \<longleftrightarrow> m = Suc 0 \<and> n = Suc 0"
 proof (induct m)
   case 0
   then show ?case by simp
 next
   case (Suc m)
   then show ?case by (induct n) auto
 qed
 
 lemma one_eq_mult_iff [simp]: "Suc 0 = m * n \<longleftrightarrow> m = Suc 0 \<and> n = Suc 0"
   by (simp add: eq_commute flip: mult_eq_1_iff)
 
 lemma nat_mult_eq_1_iff [simp]: "m * n = 1 \<longleftrightarrow> m = 1 \<and> n = 1" 
   and nat_1_eq_mult_iff [simp]: "1 = m * n \<longleftrightarrow> m = 1 \<and> n = 1" for m n :: nat
   by auto
 
 lemma mult_cancel1 [simp]: "k * m = k * n \<longleftrightarrow> m = n \<or> k = 0"
   for k m n :: nat
 proof -
   have "k \<noteq> 0 \<Longrightarrow> k * m = k * n \<Longrightarrow> m = n"
   proof (induct n arbitrary: m)
     case 0
     then show "m = 0" by simp
   next
     case (Suc n)
     then show "m = Suc n"
       by (cases m) (simp_all add: eq_commute [of 0])
   qed
   then show ?thesis by auto
 qed
 
 lemma mult_cancel2 [simp]: "m * k = n * k \<longleftrightarrow> m = n \<or> k = 0"
   for k m n :: nat
   by (simp add: mult.commute)
 
 lemma Suc_mult_cancel1: "Suc k * m = Suc k * n \<longleftrightarrow> m = n"
   by (subst mult_cancel1) simp
 
 
 subsection \<open>Orders on \<^typ>\<open>nat\<close>\<close>
 
 subsubsection \<open>Operation definition\<close>
 
 instantiation nat :: linorder
 begin
 
 primrec less_eq_nat
   where
     "(0::nat) \<le> n \<longleftrightarrow> True"
   | "Suc m \<le> n \<longleftrightarrow> (case n of 0 \<Rightarrow> False | Suc n \<Rightarrow> m \<le> n)"
 
 declare less_eq_nat.simps [simp del]
 
 lemma le0 [iff]: "0 \<le> n" for
   n :: nat
   by (simp add: less_eq_nat.simps)
 
 lemma [code]: "0 \<le> n \<longleftrightarrow> True"
   for n :: nat
   by simp
 
 definition less_nat
   where less_eq_Suc_le: "n < m \<longleftrightarrow> Suc n \<le> m"
 
 lemma Suc_le_mono [iff]: "Suc n \<le> Suc m \<longleftrightarrow> n \<le> m"
   by (simp add: less_eq_nat.simps(2))
 
 lemma Suc_le_eq [code]: "Suc m \<le> n \<longleftrightarrow> m < n"
   unfolding less_eq_Suc_le ..
 
 lemma le_0_eq [iff]: "n \<le> 0 \<longleftrightarrow> n = 0"
   for n :: nat
   by (induct n) (simp_all add: less_eq_nat.simps(2))
 
 lemma not_less0 [iff]: "\<not> n < 0"
   for n :: nat
   by (simp add: less_eq_Suc_le)
 
 lemma less_nat_zero_code [code]: "n < 0 \<longleftrightarrow> False"
   for n :: nat
   by simp
 
 lemma Suc_less_eq [iff]: "Suc m < Suc n \<longleftrightarrow> m < n"
   by (simp add: less_eq_Suc_le)
 
 lemma less_Suc_eq_le [code]: "m < Suc n \<longleftrightarrow> m \<le> n"
   by (simp add: less_eq_Suc_le)
 
 lemma Suc_less_eq2: "Suc n < m \<longleftrightarrow> (\<exists>m'. m = Suc m' \<and> n < m')"
   by (cases m) auto
 
 lemma le_SucI: "m \<le> n \<Longrightarrow> m \<le> Suc n"
   by (induct m arbitrary: n) (simp_all add: less_eq_nat.simps(2) split: nat.splits)
 
 lemma Suc_leD: "Suc m \<le> n \<Longrightarrow> m \<le> n"
   by (cases n) (auto intro: le_SucI)
 
 lemma less_SucI: "m < n \<Longrightarrow> m < Suc n"
   by (simp add: less_eq_Suc_le) (erule Suc_leD)
 
 lemma Suc_lessD: "Suc m < n \<Longrightarrow> m < n"
   by (simp add: less_eq_Suc_le) (erule Suc_leD)
 
 instance
 proof
   fix n m q :: nat
   show "n < m \<longleftrightarrow> n \<le> m \<and> \<not> m \<le> n"
   proof (induct n arbitrary: m)
     case 0
     then show ?case
       by (cases m) (simp_all add: less_eq_Suc_le)
   next
     case (Suc n)
     then show ?case
       by (cases m) (simp_all add: less_eq_Suc_le)
   qed
   show "n \<le> n"
     by (induct n) simp_all
   then show "n = m" if "n \<le> m" and "m \<le> n"
     using that by (induct n arbitrary: m)
       (simp_all add: less_eq_nat.simps(2) split: nat.splits)
   show "n \<le> q" if "n \<le> m" and "m \<le> q"
     using that
   proof (induct n arbitrary: m q)
     case 0
     show ?case by simp
   next
     case (Suc n)
     then show ?case
       by (simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits, clarify,
         simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits, clarify,
         simp_all (no_asm_use) add: less_eq_nat.simps(2) split: nat.splits)
   qed
   show "n \<le> m \<or> m \<le> n"
     by (induct n arbitrary: m)
       (simp_all add: less_eq_nat.simps(2) split: nat.splits)
 qed
 
 end
 
 instantiation nat :: order_bot
 begin
 
 definition bot_nat :: nat
   where "bot_nat = 0"
 
 instance
   by standard (simp add: bot_nat_def)
 
 end
 
 instance nat :: no_top
   by standard (auto intro: less_Suc_eq_le [THEN iffD2])
 
 
 subsubsection \<open>Introduction properties\<close>
 
 lemma lessI [iff]: "n < Suc n"
   by (simp add: less_Suc_eq_le)
 
 lemma zero_less_Suc [iff]: "0 < Suc n"
   by (simp add: less_Suc_eq_le)
 
 
 subsubsection \<open>Elimination properties\<close>
 
 lemma less_not_refl: "\<not> n < n"
   for n :: nat
   by (rule order_less_irrefl)
 
 lemma less_not_refl2: "n < m \<Longrightarrow> m \<noteq> n"
   for m n :: nat
   by (rule not_sym) (rule less_imp_neq)
 
 lemma less_not_refl3: "s < t \<Longrightarrow> s \<noteq> t"
   for s t :: nat
   by (rule less_imp_neq)
 
 lemma less_irrefl_nat: "n < n \<Longrightarrow> R"
   for n :: nat
   by (rule notE, rule less_not_refl)
 
 lemma less_zeroE: "n < 0 \<Longrightarrow> R"
   for n :: nat
   by (rule notE) (rule not_less0)
 
 lemma less_Suc_eq: "m < Suc n \<longleftrightarrow> m < n \<or> m = n"
   unfolding less_Suc_eq_le le_less ..
 
 lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
   by (simp add: less_Suc_eq)
 
 lemma less_one [iff]: "n < 1 \<longleftrightarrow> n = 0"
   for n :: nat
   unfolding One_nat_def by (rule less_Suc0)
 
 lemma Suc_mono: "m < n \<Longrightarrow> Suc m < Suc n"
   by simp
 
 text \<open>"Less than" is antisymmetric, sort of.\<close>
 lemma less_antisym: "\<not> n < m \<Longrightarrow> n < Suc m \<Longrightarrow> m = n"
   unfolding not_less less_Suc_eq_le by (rule antisym)
 
 lemma nat_neq_iff: "m \<noteq> n \<longleftrightarrow> m < n \<or> n < m"
   for m n :: nat
   by (rule linorder_neq_iff)
 
 
 subsubsection \<open>Inductive (?) properties\<close>
 
 lemma Suc_lessI: "m < n \<Longrightarrow> Suc m \<noteq> n \<Longrightarrow> Suc m < n"
   unfolding less_eq_Suc_le [of m] le_less by simp
 
 lemma lessE:
   assumes major: "i < k"
     and 1: "k = Suc i \<Longrightarrow> P"
     and 2: "\<And>j. i < j \<Longrightarrow> k = Suc j \<Longrightarrow> P"
   shows P
 proof -
   from major have "\<exists>j. i \<le> j \<and> k = Suc j"
     unfolding less_eq_Suc_le by (induct k) simp_all
   then have "(\<exists>j. i < j \<and> k = Suc j) \<or> k = Suc i"
     by (auto simp add: less_le)
   with 1 2 show P by auto
 qed
 
 lemma less_SucE:
   assumes major: "m < Suc n"
     and less: "m < n \<Longrightarrow> P"
     and eq: "m = n \<Longrightarrow> P"
   shows P
 proof (rule major [THEN lessE])
   show "Suc n = Suc m \<Longrightarrow> P"
     using eq by blast
   show "\<And>j. \<lbrakk>m < j; Suc n = Suc j\<rbrakk> \<Longrightarrow> P"
     by (blast intro: less)
 qed
 
 lemma Suc_lessE:
   assumes major: "Suc i < k"
     and minor: "\<And>j. i < j \<Longrightarrow> k = Suc j \<Longrightarrow> P"
   shows P
 proof (rule major [THEN lessE])
   show "k = Suc (Suc i) \<Longrightarrow> P"
     using lessI minor by iprover
   show "\<And>j. \<lbrakk>Suc i < j; k = Suc j\<rbrakk> \<Longrightarrow> P"
     using Suc_lessD minor by iprover
 qed
 
 lemma Suc_less_SucD: "Suc m < Suc n \<Longrightarrow> m < n"
   by simp
 
 lemma less_trans_Suc:
   assumes le: "i < j"
   shows "j < k \<Longrightarrow> Suc i < k"
 proof (induct k)
   case 0
   then show ?case by simp
 next
   case (Suc k)
   with le show ?case
     by simp (auto simp add: less_Suc_eq dest: Suc_lessD)
 qed
 
 text \<open>Can be used with \<open>less_Suc_eq\<close> to get \<^prop>\<open>n = m \<or> n < m\<close>.\<close>
 lemma not_less_eq: "\<not> m < n \<longleftrightarrow> n < Suc m"
   by (simp only: not_less less_Suc_eq_le)
 
 lemma not_less_eq_eq: "\<not> m \<le> n \<longleftrightarrow> Suc n \<le> m"
   by (simp only: not_le Suc_le_eq)
 
 text \<open>Properties of "less than or equal".\<close>
 
 lemma le_imp_less_Suc: "m \<le> n \<Longrightarrow> m < Suc n"
   by (simp only: less_Suc_eq_le)
 
 lemma Suc_n_not_le_n: "\<not> Suc n \<le> n"
   by (simp add: not_le less_Suc_eq_le)
 
 lemma le_Suc_eq: "m \<le> Suc n \<longleftrightarrow> m \<le> n \<or> m = Suc n"
   by (simp add: less_Suc_eq_le [symmetric] less_Suc_eq)
 
 lemma le_SucE: "m \<le> Suc n \<Longrightarrow> (m \<le> n \<Longrightarrow> R) \<Longrightarrow> (m = Suc n \<Longrightarrow> R) \<Longrightarrow> R"
   by (drule le_Suc_eq [THEN iffD1], iprover+)
 
 lemma Suc_leI: "m < n \<Longrightarrow> Suc m \<le> n"
   by (simp only: Suc_le_eq)
 
 text \<open>Stronger version of \<open>Suc_leD\<close>.\<close>
 lemma Suc_le_lessD: "Suc m \<le> n \<Longrightarrow> m < n"
   by (simp only: Suc_le_eq)
 
 lemma less_imp_le_nat: "m < n \<Longrightarrow> m \<le> n" for m n :: nat
   unfolding less_eq_Suc_le by (rule Suc_leD)
 
 text \<open>For instance, \<open>(Suc m < Suc n) = (Suc m \<le> n) = (m < n)\<close>\<close>
 lemmas le_simps = less_imp_le_nat less_Suc_eq_le Suc_le_eq
 
 
 text \<open>Equivalence of \<open>m \<le> n\<close> and \<open>m < n \<or> m = n\<close>\<close>
 
 lemma less_or_eq_imp_le: "m < n \<or> m = n \<Longrightarrow> m \<le> n"
   for m n :: nat
   unfolding le_less .
 
 lemma le_eq_less_or_eq: "m \<le> n \<longleftrightarrow> m < n \<or> m = n"
   for m n :: nat
   by (rule le_less)
 
 text \<open>Useful with \<open>blast\<close>.\<close>
 lemma eq_imp_le: "m = n \<Longrightarrow> m \<le> n"
   for m n :: nat
   by auto
 
 lemma le_refl: "n \<le> n"
   for n :: nat
   by simp
 
 lemma le_trans: "i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> i \<le> k"
   for i j k :: nat
   by (rule order_trans)
 
 lemma le_antisym: "m \<le> n \<Longrightarrow> n \<le> m \<Longrightarrow> m = n"
   for m n :: nat
   by (rule antisym)
 
 lemma nat_less_le: "m < n \<longleftrightarrow> m \<le> n \<and> m \<noteq> n"
   for m n :: nat
   by (rule less_le)
 
 lemma le_neq_implies_less: "m \<le> n \<Longrightarrow> m \<noteq> n \<Longrightarrow> m < n"
   for m n :: nat
   unfolding less_le ..
 
 lemma nat_le_linear: "m \<le> n \<or> n \<le> m"
   for m n :: nat
   by (rule linear)
 
 lemmas linorder_neqE_nat = linorder_neqE [where 'a = nat]
 
 lemma le_less_Suc_eq: "m \<le> n \<Longrightarrow> n < Suc m \<longleftrightarrow> n = m"
   unfolding less_Suc_eq_le by auto
 
 lemma not_less_less_Suc_eq: "\<not> n < m \<Longrightarrow> n < Suc m \<longleftrightarrow> n = m"
   unfolding not_less by (rule le_less_Suc_eq)
 
 lemmas not_less_simps = not_less_less_Suc_eq le_less_Suc_eq
 
 lemma not0_implies_Suc: "n \<noteq> 0 \<Longrightarrow> \<exists>m. n = Suc m"
   by (cases n) simp_all
 
 lemma gr0_implies_Suc: "n > 0 \<Longrightarrow> \<exists>m. n = Suc m"
   by (cases n) simp_all
 
 lemma gr_implies_not0: "m < n \<Longrightarrow> n \<noteq> 0"
   for m n :: nat
   by (cases n) simp_all
 
 lemma neq0_conv[iff]: "n \<noteq> 0 \<longleftrightarrow> 0 < n"
   for n :: nat
   by (cases n) simp_all
 
 text \<open>This theorem is useful with \<open>blast\<close>\<close>
 lemma gr0I: "(n = 0 \<Longrightarrow> False) \<Longrightarrow> 0 < n"
   for n :: nat
   by (rule neq0_conv[THEN iffD1]) iprover
 
 lemma gr0_conv_Suc: "0 < n \<longleftrightarrow> (\<exists>m. n = Suc m)"
   by (fast intro: not0_implies_Suc)
 
 lemma not_gr0 [iff]: "\<not> 0 < n \<longleftrightarrow> n = 0"
   for n :: nat
   using neq0_conv by blast
 
 lemma Suc_le_D: "Suc n \<le> m' \<Longrightarrow> \<exists>m. m' = Suc m"
   by (induct m') simp_all
 
 text \<open>Useful in certain inductive arguments\<close>
 lemma less_Suc_eq_0_disj: "m < Suc n \<longleftrightarrow> m = 0 \<or> (\<exists>j. m = Suc j \<and> j < n)"
   by (cases m) simp_all
 
 lemma All_less_Suc: "(\<forall>i < Suc n. P i) = (P n \<and> (\<forall>i < n. P i))"
   by (auto simp: less_Suc_eq)
 
 lemma All_less_Suc2: "(\<forall>i < Suc n. P i) = (P 0 \<and> (\<forall>i < n. P(Suc i)))"
   by (auto simp: less_Suc_eq_0_disj)
 
 lemma Ex_less_Suc: "(\<exists>i < Suc n. P i) = (P n \<or> (\<exists>i < n. P i))"
   by (auto simp: less_Suc_eq)
 
 lemma Ex_less_Suc2: "(\<exists>i < Suc n. P i) = (P 0 \<or> (\<exists>i < n. P(Suc i)))"
   by (auto simp: less_Suc_eq_0_disj)
 
 text \<open>@{term mono} (non-strict) doesn't imply increasing, as the function could be constant\<close>
 lemma strict_mono_imp_increasing:
   fixes n::nat
   assumes "strict_mono f" shows "f n \<ge> n"
 proof (induction n)
   case 0
   then show ?case
     by auto
 next
   case (Suc n)
   then show ?case
     unfolding not_less_eq_eq [symmetric]
     using Suc_n_not_le_n assms order_trans strict_mono_less_eq by blast
 qed
 
 subsubsection \<open>Monotonicity of Addition\<close>
 
 lemma Suc_pred [simp]: "n > 0 \<Longrightarrow> Suc (n - Suc 0) = n"
   by (simp add: diff_Suc split: nat.split)
 
 lemma Suc_diff_1 [simp]: "0 < n \<Longrightarrow> Suc (n - 1) = n"
   unfolding One_nat_def by (rule Suc_pred)
 
 lemma nat_add_left_cancel_le [simp]: "k + m \<le> k + n \<longleftrightarrow> m \<le> n"
   for k m n :: nat
   by (induct k) simp_all
 
 lemma nat_add_left_cancel_less [simp]: "k + m < k + n \<longleftrightarrow> m < n"
   for k m n :: nat
   by (induct k) simp_all
 
 lemma add_gr_0 [iff]: "m + n > 0 \<longleftrightarrow> m > 0 \<or> n > 0"
   for m n :: nat
   by (auto dest: gr0_implies_Suc)
 
 text \<open>strict, in 1st argument\<close>
 lemma add_less_mono1: "i < j \<Longrightarrow> i + k < j + k"
   for i j k :: nat
   by (induct k) simp_all
 
 text \<open>strict, in both arguments\<close>
 lemma add_less_mono: 
   fixes i j k l :: nat
   assumes "i < j" "k < l" shows "i + k < j + l"
 proof -
   have "i + k < j + k"
     by (simp add: add_less_mono1 assms)
   also have "...  < j + l"
     using \<open>i < j\<close> by (induction j) (auto simp: assms)
   finally show ?thesis .
 qed
 
 lemma less_imp_Suc_add: "m < n \<Longrightarrow> \<exists>k. n = Suc (m + k)"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case Suc
   then show ?case
     by (simp add: order_le_less)
       (blast elim!: less_SucE intro!: Nat.add_0_right [symmetric] add_Suc_right [symmetric])
 qed
 
 lemma le_Suc_ex: "k \<le> l \<Longrightarrow> (\<exists>n. l = k + n)"
   for k l :: nat
   by (auto simp: less_Suc_eq_le[symmetric] dest: less_imp_Suc_add)
 
 lemma less_natE:
   assumes \<open>m < n\<close>
   obtains q where \<open>n = Suc (m + q)\<close>
   using assms by (auto dest: less_imp_Suc_add intro: that)
 
 text \<open>strict, in 1st argument; proof is by induction on \<open>k > 0\<close>\<close>
 lemma mult_less_mono2:
   fixes i j :: nat
   assumes "i < j" and "0 < k"
   shows "k * i < k * j"
   using \<open>0 < k\<close>
 proof (induct k)
   case 0
   then show ?case by simp
 next
   case (Suc k)
   with \<open>i < j\<close> show ?case
     by (cases k) (simp_all add: add_less_mono)
 qed
 
 text \<open>Addition is the inverse of subtraction:
   if \<^term>\<open>n \<le> m\<close> then \<^term>\<open>n + (m - n) = m\<close>.\<close>
 lemma add_diff_inverse_nat: "\<not> m < n \<Longrightarrow> n + (m - n) = m"
   for m n :: nat
   by (induct m n rule: diff_induct) simp_all
 
 lemma nat_le_iff_add: "m \<le> n \<longleftrightarrow> (\<exists>k. n = m + k)"
   for m n :: nat
   using nat_add_left_cancel_le[of m 0] by (auto dest: le_Suc_ex)
 
 text \<open>The naturals form an ordered \<open>semidom\<close> and a \<open>dioid\<close>.\<close>
 
 instance nat :: linordered_semidom
 proof
   fix m n q :: nat
   show "0 < (1::nat)"
     by simp
   show "m \<le> n \<Longrightarrow> q + m \<le> q + n"
     by simp
   show "m < n \<Longrightarrow> 0 < q \<Longrightarrow> q * m < q * n"
     by (simp add: mult_less_mono2)
   show "m \<noteq> 0 \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> m * n \<noteq> 0"
     by simp
   show "n \<le> m \<Longrightarrow> (m - n) + n = m"
     by (simp add: add_diff_inverse_nat add.commute linorder_not_less)
 qed
 
 instance nat :: dioid
   by standard (rule nat_le_iff_add)
 
 declare le0[simp del] \<comment> \<open>This is now @{thm zero_le}\<close>
 declare le_0_eq[simp del] \<comment> \<open>This is now @{thm le_zero_eq}\<close>
 declare not_less0[simp del] \<comment> \<open>This is now @{thm not_less_zero}\<close>
 declare not_gr0[simp del] \<comment> \<open>This is now @{thm not_gr_zero}\<close>
 
 instance nat :: ordered_cancel_comm_monoid_add ..
 instance nat :: ordered_cancel_comm_monoid_diff ..
 
 
 subsubsection \<open>\<^term>\<open>min\<close> and \<^term>\<open>max\<close>\<close>
 
 global_interpretation bot_nat_0: ordering_top \<open>(\<ge>)\<close> \<open>(>)\<close> \<open>0::nat\<close>
   by standard simp
 
 global_interpretation max_nat: semilattice_neutr_order max \<open>0::nat\<close> \<open>(\<ge>)\<close> \<open>(>)\<close>
   by standard (simp add: max_def)
 
 lemma mono_Suc: "mono Suc"
   by (rule monoI) simp
 
 lemma min_0L [simp]: "min 0 n = 0"
   for n :: nat
   by (rule min_absorb1) simp
 
 lemma min_0R [simp]: "min n 0 = 0"
   for n :: nat
   by (rule min_absorb2) simp
 
 lemma min_Suc_Suc [simp]: "min (Suc m) (Suc n) = Suc (min m n)"
   by (simp add: mono_Suc min_of_mono)
 
 lemma min_Suc1: "min (Suc n) m = (case m of 0 \<Rightarrow> 0 | Suc m' \<Rightarrow> Suc(min n m'))"
   by (simp split: nat.split)
 
 lemma min_Suc2: "min m (Suc n) = (case m of 0 \<Rightarrow> 0 | Suc m' \<Rightarrow> Suc(min m' n))"
   by (simp split: nat.split)
 
 lemma max_0L [simp]: "max 0 n = n"
   for n :: nat
   by (fact max_nat.left_neutral)
 
 lemma max_0R [simp]: "max n 0 = n"
   for n :: nat
   by (fact max_nat.right_neutral)
 
 lemma max_Suc_Suc [simp]: "max (Suc m) (Suc n) = Suc (max m n)"
   by (simp add: mono_Suc max_of_mono)
 
 lemma max_Suc1: "max (Suc n) m = (case m of 0 \<Rightarrow> Suc n | Suc m' \<Rightarrow> Suc (max n m'))"
   by (simp split: nat.split)
 
 lemma max_Suc2: "max m (Suc n) = (case m of 0 \<Rightarrow> Suc n | Suc m' \<Rightarrow> Suc (max m' n))"
   by (simp split: nat.split)
 
 lemma nat_mult_min_left: "min m n * q = min (m * q) (n * q)"
   for m n q :: nat
   by (simp add: min_def not_le)
     (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans)
 
 lemma nat_mult_min_right: "m * min n q = min (m * n) (m * q)"
   for m n q :: nat
   by (simp add: min_def not_le)
     (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans)
 
 lemma nat_add_max_left: "max m n + q = max (m + q) (n + q)"
   for m n q :: nat
   by (simp add: max_def)
 
 lemma nat_add_max_right: "m + max n q = max (m + n) (m + q)"
   for m n q :: nat
   by (simp add: max_def)
 
 lemma nat_mult_max_left: "max m n * q = max (m * q) (n * q)"
   for m n q :: nat
   by (simp add: max_def not_le)
     (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans)
 
 lemma nat_mult_max_right: "m * max n q = max (m * n) (m * q)"
   for m n q :: nat
   by (simp add: max_def not_le)
     (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans)
 
 
 subsubsection \<open>Additional theorems about \<^term>\<open>(\<le>)\<close>\<close>
 
 text \<open>Complete induction, aka course-of-values induction\<close>
 
 instance nat :: wellorder
 proof
   fix P and n :: nat
   assume step: "(\<And>m. m < n \<Longrightarrow> P m) \<Longrightarrow> P n" for n :: nat
   have "\<And>q. q \<le> n \<Longrightarrow> P q"
   proof (induct n)
     case (0 n)
     have "P 0" by (rule step) auto
     with 0 show ?case by auto
   next
     case (Suc m n)
     then have "n \<le> m \<or> n = Suc m"
       by (simp add: le_Suc_eq)
     then show ?case
     proof
       assume "n \<le> m"
       then show "P n" by (rule Suc(1))
     next
       assume n: "n = Suc m"
       show "P n" by (rule step) (rule Suc(1), simp add: n le_simps)
     qed
   qed
   then show "P n" by auto
 qed
 
 
 lemma Least_eq_0[simp]: "P 0 \<Longrightarrow> Least P = 0"
   for P :: "nat \<Rightarrow> bool"
   by (rule Least_equality[OF _ le0])
 
 lemma Least_Suc:
   assumes "P n" "\<not> P 0" 
   shows "(LEAST n. P n) = Suc (LEAST m. P (Suc m))"
 proof (cases n)
   case (Suc m)
   show ?thesis
   proof (rule antisym)
     show "(LEAST x. P x) \<le> Suc (LEAST x. P (Suc x))"
       using assms Suc by (force intro: LeastI Least_le)
     have \<section>: "P (LEAST x. P x)"
       by (blast intro: LeastI assms)
     show "Suc (LEAST m. P (Suc m)) \<le> (LEAST n. P n)"
     proof (cases "(LEAST n. P n)")
       case 0
       then show ?thesis
         using \<section> by (simp add: assms)
     next
       case Suc
       with \<section> show ?thesis
         by (auto simp: Least_le)
     qed
   qed
 qed (use assms in auto)
 
 lemma Least_Suc2: "P n \<Longrightarrow> Q m \<Longrightarrow> \<not> P 0 \<Longrightarrow> \<forall>k. P (Suc k) = Q k \<Longrightarrow> Least P = Suc (Least Q)"
   by (erule (1) Least_Suc [THEN ssubst]) simp
 
 lemma ex_least_nat_le:
   fixes P :: "nat \<Rightarrow> bool"
   assumes "P n" "\<not> P 0" 
   shows "\<exists>k\<le>n. (\<forall>i<k. \<not> P i) \<and> P k"
 proof (cases n)
   case (Suc m)
   with assms show ?thesis
     by (blast intro: Least_le LeastI_ex dest: not_less_Least)
 qed (use assms in auto)
 
 lemma ex_least_nat_less:
   fixes P :: "nat \<Rightarrow> bool"
   assumes "P n" "\<not> P 0" 
   shows "\<exists>k<n. (\<forall>i\<le>k. \<not> P i) \<and> P (Suc k)"
 proof (cases n)
   case (Suc m)
   then obtain k where k: "k \<le> n" "\<forall>i<k. \<not> P i" "P k"
     using ex_least_nat_le [OF assms] by blast
   show ?thesis 
     by (cases k) (use assms k less_eq_Suc_le in auto)
 qed (use assms in auto)
 
 
 lemma nat_less_induct:
   fixes P :: "nat \<Rightarrow> bool"
   assumes "\<And>n. \<forall>m. m < n \<longrightarrow> P m \<Longrightarrow> P n"
   shows "P n"
   using assms less_induct by blast
 
 lemma measure_induct_rule [case_names less]:
   fixes f :: "'a \<Rightarrow> 'b::wellorder"
   assumes step: "\<And>x. (\<And>y. f y < f x \<Longrightarrow> P y) \<Longrightarrow> P x"
   shows "P a"
   by (induct m \<equiv> "f a" arbitrary: a rule: less_induct) (auto intro: step)
 
 text \<open>old style induction rules:\<close>
 lemma measure_induct:
   fixes f :: "'a \<Rightarrow> 'b::wellorder"
   shows "(\<And>x. \<forall>y. f y < f x \<longrightarrow> P y \<Longrightarrow> P x) \<Longrightarrow> P a"
   by (rule measure_induct_rule [of f P a]) iprover
 
 lemma full_nat_induct:
   assumes step: "\<And>n. (\<forall>m. Suc m \<le> n \<longrightarrow> P m) \<Longrightarrow> P n"
   shows "P n"
   by (rule less_induct) (auto intro: step simp:le_simps)
 
 text\<open>An induction rule for establishing binary relations\<close>
 lemma less_Suc_induct [consumes 1]:
   assumes less: "i < j"
     and step: "\<And>i. P i (Suc i)"
     and trans: "\<And>i j k. i < j \<Longrightarrow> j < k \<Longrightarrow> P i j \<Longrightarrow> P j k \<Longrightarrow> P i k"
   shows "P i j"
 proof -
   from less obtain k where j: "j = Suc (i + k)"
     by (auto dest: less_imp_Suc_add)
   have "P i (Suc (i + k))"
   proof (induct k)
     case 0
     show ?case by (simp add: step)
   next
     case (Suc k)
     have "0 + i < Suc k + i" by (rule add_less_mono1) simp
     then have "i < Suc (i + k)" by (simp add: add.commute)
     from trans[OF this lessI Suc step]
     show ?case by simp
   qed
   then show "P i j" by (simp add: j)
 qed
 
 text \<open>
   The method of infinite descent, frequently used in number theory.
   Provided by Roelof Oosterhuis.
   \<open>P n\<close> is true for all natural numbers if
   \<^item> case ``0'': given \<open>n = 0\<close> prove \<open>P n\<close>
   \<^item> case ``smaller'': given \<open>n > 0\<close> and \<open>\<not> P n\<close> prove there exists
     a smaller natural number \<open>m\<close> such that \<open>\<not> P m\<close>.
 \<close>
 
 lemma infinite_descent: "(\<And>n. \<not> P n \<Longrightarrow> \<exists>m<n. \<not> P m) \<Longrightarrow> P n" for P :: "nat \<Rightarrow> bool"
   \<comment> \<open>compact version without explicit base case\<close>
   by (induct n rule: less_induct) auto
 
 lemma infinite_descent0 [case_names 0 smaller]:
   fixes P :: "nat \<Rightarrow> bool"
   assumes "P 0"
     and "\<And>n. n > 0 \<Longrightarrow> \<not> P n \<Longrightarrow> \<exists>m. m < n \<and> \<not> P m"
   shows "P n"
 proof (rule infinite_descent)
   fix n
   show "\<not> P n \<Longrightarrow> \<exists>m<n. \<not> P m"
     using assms by (cases "n > 0") auto
 qed
 
 text \<open>
   Infinite descent using a mapping to \<open>nat\<close>:
   \<open>P x\<close> is true for all \<open>x \<in> D\<close> if there exists a \<open>V \<in> D \<Rightarrow> nat\<close> and
   \<^item> case ``0'': given \<open>V x = 0\<close> prove \<open>P x\<close>
   \<^item> ``smaller'': given \<open>V x > 0\<close> and \<open>\<not> P x\<close> prove
   there exists a \<open>y \<in> D\<close> such that \<open>V y < V x\<close> and \<open>\<not> P y\<close>.
 \<close>
 corollary infinite_descent0_measure [case_names 0 smaller]:
   fixes V :: "'a \<Rightarrow> nat"
   assumes 1: "\<And>x. V x = 0 \<Longrightarrow> P x"
     and 2: "\<And>x. V x > 0 \<Longrightarrow> \<not> P x \<Longrightarrow> \<exists>y. V y < V x \<and> \<not> P y"
   shows "P x"
 proof -
   obtain n where "n = V x" by auto
   moreover have "\<And>x. V x = n \<Longrightarrow> P x"
   proof (induct n rule: infinite_descent0)
     case 0
     with 1 show "P x" by auto
   next
     case (smaller n)
     then obtain x where *: "V x = n " and "V x > 0 \<and> \<not> P x" by auto
     with 2 obtain y where "V y < V x \<and> \<not> P y" by auto
     with * obtain m where "m = V y \<and> m < n \<and> \<not> P y" by auto
     then show ?case by auto
   qed
   ultimately show "P x" by auto
 qed
 
 text \<open>Again, without explicit base case:\<close>
 lemma infinite_descent_measure:
   fixes V :: "'a \<Rightarrow> nat"
   assumes "\<And>x. \<not> P x \<Longrightarrow> \<exists>y. V y < V x \<and> \<not> P y"
   shows "P x"
 proof -
   from assms obtain n where "n = V x" by auto
   moreover have "\<And>x. V x = n \<Longrightarrow> P x"
   proof -
     have "\<exists>m < V x. \<exists>y. V y = m \<and> \<not> P y" if "\<not> P x" for x
       using assms and that by auto
     then show "\<And>x. V x = n \<Longrightarrow> P x"
       by (induct n rule: infinite_descent, auto)
   qed
   ultimately show "P x" by auto
 qed
 
 text \<open>A (clumsy) way of lifting \<open><\<close> monotonicity to \<open>\<le>\<close> monotonicity\<close>
 lemma less_mono_imp_le_mono:
   fixes f :: "nat \<Rightarrow> nat"
     and i j :: nat
   assumes "\<And>i j::nat. i < j \<Longrightarrow> f i < f j"
     and "i \<le> j"
   shows "f i \<le> f j"
   using assms by (auto simp add: order_le_less)
 
 
 text \<open>non-strict, in 1st argument\<close>
 lemma add_le_mono1: "i \<le> j \<Longrightarrow> i + k \<le> j + k"
   for i j k :: nat
   by (rule add_right_mono)
 
 text \<open>non-strict, in both arguments\<close>
 lemma add_le_mono: "i \<le> j \<Longrightarrow> k \<le> l \<Longrightarrow> i + k \<le> j + l"
   for i j k l :: nat
   by (rule add_mono)
 
 lemma le_add2: "n \<le> m + n"
   for m n :: nat
   by simp
 
 lemma le_add1: "n \<le> n + m"
   for m n :: nat
   by simp
 
 lemma less_add_Suc1: "i < Suc (i + m)"
   by (rule le_less_trans, rule le_add1, rule lessI)
 
 lemma less_add_Suc2: "i < Suc (m + i)"
   by (rule le_less_trans, rule le_add2, rule lessI)
 
 lemma less_iff_Suc_add: "m < n \<longleftrightarrow> (\<exists>k. n = Suc (m + k))"
   by (iprover intro!: less_add_Suc1 less_imp_Suc_add)
 
 lemma trans_le_add1: "i \<le> j \<Longrightarrow> i \<le> j + m"
   for i j m :: nat
   by (rule le_trans, assumption, rule le_add1)
 
 lemma trans_le_add2: "i \<le> j \<Longrightarrow> i \<le> m + j"
   for i j m :: nat
   by (rule le_trans, assumption, rule le_add2)
 
 lemma trans_less_add1: "i < j \<Longrightarrow> i < j + m"
   for i j m :: nat
   by (rule less_le_trans, assumption, rule le_add1)
 
 lemma trans_less_add2: "i < j \<Longrightarrow> i < m + j"
   for i j m :: nat
   by (rule less_le_trans, assumption, rule le_add2)
 
 lemma add_lessD1: "i + j < k \<Longrightarrow> i < k"
   for i j k :: nat
   by (rule le_less_trans [of _ "i+j"]) (simp_all add: le_add1)
 
 lemma not_add_less1 [iff]: "\<not> i + j < i"
   for i j :: nat
   by simp
 
 lemma not_add_less2 [iff]: "\<not> j + i < i"
   for i j :: nat
   by simp
 
 lemma add_leD1: "m + k \<le> n \<Longrightarrow> m \<le> n"
   for k m n :: nat
   by (rule order_trans [of _ "m + k"]) (simp_all add: le_add1)
 
 lemma add_leD2: "m + k \<le> n \<Longrightarrow> k \<le> n"
   for k m n :: nat
   by (force simp add: add.commute dest: add_leD1)
 
 lemma add_leE: "m + k \<le> n \<Longrightarrow> (m \<le> n \<Longrightarrow> k \<le> n \<Longrightarrow> R) \<Longrightarrow> R"
   for k m n :: nat
   by (blast dest: add_leD1 add_leD2)
 
 text \<open>needs \<open>\<And>k\<close> for \<open>ac_simps\<close> to work\<close>
 lemma less_add_eq_less: "\<And>k. k < l \<Longrightarrow> m + l = k + n \<Longrightarrow> m < n"
   for l m n :: nat
   by (force simp del: add_Suc_right simp add: less_iff_Suc_add add_Suc_right [symmetric] ac_simps)
 
 
 subsubsection \<open>More results about difference\<close>
 
 lemma Suc_diff_le: "n \<le> m \<Longrightarrow> Suc m - n = Suc (m - n)"
   by (induct m n rule: diff_induct) simp_all
 
 lemma diff_less_Suc: "m - n < Suc m"
   by (induct m n rule: diff_induct) (auto simp: less_Suc_eq)
 
 lemma diff_le_self [simp]: "m - n \<le> m"
   for m n :: nat
   by (induct m n rule: diff_induct) (simp_all add: le_SucI)
 
 lemma less_imp_diff_less: "j < k \<Longrightarrow> j - n < k"
   for j k n :: nat
   by (rule le_less_trans, rule diff_le_self)
 
 lemma diff_Suc_less [simp]: "0 < n \<Longrightarrow> n - Suc i < n"
   by (cases n) (auto simp add: le_simps)
 
 lemma diff_add_assoc: "k \<le> j \<Longrightarrow> (i + j) - k = i + (j - k)"
   for i j k :: nat
   by (fact ordered_cancel_comm_monoid_diff_class.diff_add_assoc) 
 
 lemma add_diff_assoc [simp]: "k \<le> j \<Longrightarrow> i + (j - k) = i + j - k"
   for i j k :: nat
   by (fact ordered_cancel_comm_monoid_diff_class.add_diff_assoc)
 
 lemma diff_add_assoc2: "k \<le> j \<Longrightarrow> (j + i) - k = (j - k) + i"
   for i j k :: nat
   by (fact ordered_cancel_comm_monoid_diff_class.diff_add_assoc2)
 
 lemma add_diff_assoc2 [simp]: "k \<le> j \<Longrightarrow> j - k + i = j + i - k"
   for i j k :: nat
   by (fact ordered_cancel_comm_monoid_diff_class.add_diff_assoc2)
 
 lemma le_imp_diff_is_add: "i \<le> j \<Longrightarrow> (j - i = k) = (j = k + i)"
   for i j k :: nat
   by auto
 
 lemma diff_is_0_eq [simp]: "m - n = 0 \<longleftrightarrow> m \<le> n"
   for m n :: nat
   by (induct m n rule: diff_induct) simp_all
 
 lemma diff_is_0_eq' [simp]: "m \<le> n \<Longrightarrow> m - n = 0"
   for m n :: nat
   by (rule iffD2, rule diff_is_0_eq)
 
 lemma zero_less_diff [simp]: "0 < n - m \<longleftrightarrow> m < n"
   for m n :: nat
   by (induct m n rule: diff_induct) simp_all
 
 lemma less_imp_add_positive:
   assumes "i < j"
   shows "\<exists>k::nat. 0 < k \<and> i + k = j"
 proof
   from assms show "0 < j - i \<and> i + (j - i) = j"
     by (simp add: order_less_imp_le)
 qed
 
 text \<open>a nice rewrite for bounded subtraction\<close>
 lemma nat_minus_add_max: "n - m + m = max n m"
   for m n :: nat
   by (simp add: max_def not_le order_less_imp_le)
 
 lemma nat_diff_split: "P (a - b) \<longleftrightarrow> (a < b \<longrightarrow> P 0) \<and> (\<forall>d. a = b + d \<longrightarrow> P d)"
   for a b :: nat
   \<comment> \<open>elimination of \<open>-\<close> on \<open>nat\<close>\<close>
   by (cases "a < b") (auto simp add: not_less le_less dest!: add_eq_self_zero [OF sym])
 
 lemma nat_diff_split_asm: "P (a - b) \<longleftrightarrow> \<not> (a < b \<and> \<not> P 0 \<or> (\<exists>d. a = b + d \<and> \<not> P d))"
   for a b :: nat
   \<comment> \<open>elimination of \<open>-\<close> on \<open>nat\<close> in assumptions\<close>
   by (auto split: nat_diff_split)
 
 lemma Suc_pred': "0 < n \<Longrightarrow> n = Suc(n - 1)"
   by simp
 
 lemma add_eq_if: "m + n = (if m = 0 then n else Suc ((m - 1) + n))"
   unfolding One_nat_def by (cases m) simp_all
 
 lemma mult_eq_if: "m * n = (if m = 0 then 0 else n + ((m - 1) * n))"
   for m n :: nat
   by (cases m) simp_all
 
 lemma Suc_diff_eq_diff_pred: "0 < n \<Longrightarrow> Suc m - n = m - (n - 1)"
   by (cases n) simp_all
 
 lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
   by (cases m) simp_all
 
 lemma Let_Suc [simp]: "Let (Suc n) f \<equiv> f (Suc n)"
   by (fact Let_def)
 
 
 subsubsection \<open>Monotonicity of multiplication\<close>
 
 lemma mult_le_mono1: "i \<le> j \<Longrightarrow> i * k \<le> j * k"
   for i j k :: nat
   by (simp add: mult_right_mono)
 
 lemma mult_le_mono2: "i \<le> j \<Longrightarrow> k * i \<le> k * j"
   for i j k :: nat
   by (simp add: mult_left_mono)
 
 text \<open>\<open>\<le>\<close> monotonicity, BOTH arguments\<close>
 lemma mult_le_mono: "i \<le> j \<Longrightarrow> k \<le> l \<Longrightarrow> i * k \<le> j * l"
   for i j k l :: nat
   by (simp add: mult_mono)
 
 lemma mult_less_mono1: "i < j \<Longrightarrow> 0 < k \<Longrightarrow> i * k < j * k"
   for i j k :: nat
   by (simp add: mult_strict_right_mono)
 
 text \<open>Differs from the standard \<open>zero_less_mult_iff\<close> in that there are no negative numbers.\<close>
 lemma nat_0_less_mult_iff [simp]: "0 < m * n \<longleftrightarrow> 0 < m \<and> 0 < n"
   for m n :: nat
 proof (induct m)
   case 0
   then show ?case by simp
 next
   case (Suc m)
   then show ?case by (cases n) simp_all
 qed
 
 lemma one_le_mult_iff [simp]: "Suc 0 \<le> m * n \<longleftrightarrow> Suc 0 \<le> m \<and> Suc 0 \<le> n"
 proof (induct m)
   case 0
   then show ?case by simp
 next
   case (Suc m)
   then show ?case by (cases n) simp_all
 qed
 
 lemma mult_less_cancel2 [simp]: "m * k < n * k \<longleftrightarrow> 0 < k \<and> m < n"
   for k m n :: nat
 proof (intro iffI conjI)
   assume m: "m * k < n * k"
   then show "0 < k"
     by (cases k) auto
   show "m < n"
   proof (cases k)
     case 0
     then show ?thesis
       using m by auto
   next
     case (Suc k')
     then show ?thesis
       using m
       by (simp flip: linorder_not_le) (blast intro: add_mono mult_le_mono1)
   qed
 next
   assume "0 < k \<and> m < n"
   then show "m * k < n * k"
     by (blast intro: mult_less_mono1)
 qed
 
 lemma mult_less_cancel1 [simp]: "k * m < k * n \<longleftrightarrow> 0 < k \<and> m < n"
   for k m n :: nat
   by (simp add: mult.commute [of k])
 
 lemma mult_le_cancel1 [simp]: "k * m \<le> k * n \<longleftrightarrow> (0 < k \<longrightarrow> m \<le> n)"
   for k m n :: nat
   by (simp add: linorder_not_less [symmetric], auto)
 
 lemma mult_le_cancel2 [simp]: "m * k \<le> n * k \<longleftrightarrow> (0 < k \<longrightarrow> m \<le> n)"
   for k m n :: nat
   by (simp add: linorder_not_less [symmetric], auto)
 
 lemma Suc_mult_less_cancel1: "Suc k * m < Suc k * n \<longleftrightarrow> m < n"
   by (subst mult_less_cancel1) simp
 
 lemma Suc_mult_le_cancel1: "Suc k * m \<le> Suc k * n \<longleftrightarrow> m \<le> n"
   by (subst mult_le_cancel1) simp
 
 lemma le_square: "m \<le> m * m"
   for m :: nat
   by (cases m) (auto intro: le_add1)
 
 lemma le_cube: "m \<le> m * (m * m)"
   for m :: nat
   by (cases m) (auto intro: le_add1)
 
 text \<open>Lemma for \<open>gcd\<close>\<close>
 lemma mult_eq_self_implies_10: 
   fixes m n :: nat
   assumes "m = m * n" shows "n = 1 \<or> m = 0"
 proof (rule disjCI)
   assume "m \<noteq> 0"
   show "n = 1"
   proof (cases n "1::nat" rule: linorder_cases)
     case greater
     show ?thesis
       using assms mult_less_mono2 [OF greater, of m] \<open>m \<noteq> 0\<close> by auto
   qed (use assms \<open>m \<noteq> 0\<close> in auto)
 qed
 
 lemma mono_times_nat:
   fixes n :: nat
   assumes "n > 0"
   shows "mono (times n)"
 proof
   fix m q :: nat
   assume "m \<le> q"
   with assms show "n * m \<le> n * q" by simp
 qed
 
 text \<open>The lattice order on \<^typ>\<open>nat\<close>.\<close>
 
 instantiation nat :: distrib_lattice
 begin
 
 definition "(inf :: nat \<Rightarrow> nat \<Rightarrow> nat) = min"
 
 definition "(sup :: nat \<Rightarrow> nat \<Rightarrow> nat) = max"
 
 instance
   by intro_classes
     (auto simp add: inf_nat_def sup_nat_def max_def not_le min_def
       intro: order_less_imp_le antisym elim!: order_trans order_less_trans)
 
 end
 
 
 subsection \<open>Natural operation of natural numbers on functions\<close>
 
 text \<open>
   We use the same logical constant for the power operations on
   functions and relations, in order to share the same syntax.
 \<close>
 
 consts compow :: "nat \<Rightarrow> 'a \<Rightarrow> 'a"
 
 abbreviation compower :: "'a \<Rightarrow> nat \<Rightarrow> 'a" (infixr "^^" 80)
   where "f ^^ n \<equiv> compow n f"
 
 notation (latex output)
   compower ("(_\<^bsup>_\<^esup>)" [1000] 1000)
 
 text \<open>\<open>f ^^ n = f \<circ> \<dots> \<circ> f\<close>, the \<open>n\<close>-fold composition of \<open>f\<close>\<close>
 
 overloading
   funpow \<equiv> "compow :: nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)"
 begin
 
 primrec funpow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
   where
     "funpow 0 f = id"
   | "funpow (Suc n) f = f \<circ> funpow n f"
 
 end
 
 lemma funpow_0 [simp]: "(f ^^ 0) x = x"
   by simp
 
 lemma funpow_Suc_right: "f ^^ Suc n = f ^^ n \<circ> f"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   fix n
   assume "f ^^ Suc n = f ^^ n \<circ> f"
   then show "f ^^ Suc (Suc n) = f ^^ Suc n \<circ> f"
     by (simp add: o_assoc)
 qed
 
 lemmas funpow_simps_right = funpow.simps(1) funpow_Suc_right
 
 text \<open>For code generation.\<close>
 
 context
 begin
 
 qualified definition funpow :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
   where funpow_code_def [code_abbrev]: "funpow = compow"
 
 lemma [code]:
   "funpow (Suc n) f = f \<circ> funpow n f"
   "funpow 0 f = id"
   by (simp_all add: funpow_code_def)
 
 end
 
 lemma funpow_add: "f ^^ (m + n) = f ^^ m \<circ> f ^^ n"
   by (induct m) simp_all
 
 lemma funpow_mult: "(f ^^ m) ^^ n = f ^^ (m * n)"
   for f :: "'a \<Rightarrow> 'a"
   by (induct n) (simp_all add: funpow_add)
 
 lemma funpow_swap1: "f ((f ^^ n) x) = (f ^^ n) (f x)"
 proof -
   have "f ((f ^^ n) x) = (f ^^ (n + 1)) x" by simp
   also have "\<dots>  = (f ^^ n \<circ> f ^^ 1) x" by (simp only: funpow_add)
   also have "\<dots> = (f ^^ n) (f x)" by simp
   finally show ?thesis .
 qed
 
 lemma comp_funpow: "comp f ^^ n = comp (f ^^ n)"
   for f :: "'a \<Rightarrow> 'a"
   by (induct n) simp_all
 
 lemma Suc_funpow[simp]: "Suc ^^ n = ((+) n)"
   by (induct n) simp_all
 
 lemma id_funpow[simp]: "id ^^ n = id"
   by (induct n) simp_all
 
 lemma funpow_mono: "mono f \<Longrightarrow> A \<le> B \<Longrightarrow> (f ^^ n) A \<le> (f ^^ n) B"
   for f :: "'a \<Rightarrow> ('a::order)"
   by (induct n arbitrary: A B)
      (auto simp del: funpow.simps(2) simp add: funpow_Suc_right mono_def)
 
 lemma funpow_mono2:
   assumes "mono f"
     and "i \<le> j"
     and "x \<le> y"
     and "x \<le> f x"
   shows "(f ^^ i) x \<le> (f ^^ j) y"
   using assms(2,3)
 proof (induct j arbitrary: y)
   case 0
   then show ?case by simp
 next
   case (Suc j)
   show ?case
   proof(cases "i = Suc j")
     case True
     with assms(1) Suc show ?thesis
       by (simp del: funpow.simps add: funpow_simps_right monoD funpow_mono)
   next
     case False
     with assms(1,4) Suc show ?thesis
       by (simp del: funpow.simps add: funpow_simps_right le_eq_less_or_eq less_Suc_eq_le)
         (simp add: Suc.hyps monoD order_subst1)
   qed
 qed
 
 lemma inj_fn[simp]:
   fixes f::"'a \<Rightarrow> 'a"
   assumes "inj f"
   shows "inj (f^^n)"
 proof (induction n)
   case Suc thus ?case using inj_compose[OF assms Suc.IH] by (simp del: comp_apply)
 qed simp
 
 lemma surj_fn[simp]:
   fixes f::"'a \<Rightarrow> 'a"
   assumes "surj f"
   shows "surj (f^^n)"
 proof (induction n)
   case Suc thus ?case by (simp add: comp_surj[OF Suc.IH assms] del: comp_apply)
 qed simp
 
 lemma bij_fn[simp]:
   fixes f::"'a \<Rightarrow> 'a"
   assumes "bij f"
   shows "bij (f^^n)"
 by (rule bijI[OF inj_fn[OF bij_is_inj[OF assms]] surj_fn[OF bij_is_surj[OF assms]]])
 
 lemma bij_betw_funpow: \<^marker>\<open>contributor \<open>Lars Noschinski\<close>\<close>
   assumes "bij_betw f S S" shows "bij_betw (f ^^ n) S S"
 proof (induct n)
   case 0 then show ?case by (auto simp: id_def[symmetric])
 next
   case (Suc n)
   then show ?case unfolding funpow.simps using assms by (rule bij_betw_trans)
 qed
 
 
 subsection \<open>Kleene iteration\<close>
 
 lemma Kleene_iter_lpfp:
   fixes f :: "'a::order_bot \<Rightarrow> 'a"
   assumes "mono f"
     and "f p \<le> p"
   shows "(f ^^ k) bot \<le> p"
 proof (induct k)
   case 0
   show ?case by simp
 next
   case Suc
   show ?case
     using monoD[OF assms(1) Suc] assms(2) by simp
 qed
 
 lemma lfp_Kleene_iter:
   assumes "mono f"
     and "(f ^^ Suc k) bot = (f ^^ k) bot"
   shows "lfp f = (f ^^ k) bot"
 proof (rule antisym)
   show "lfp f \<le> (f ^^ k) bot"
   proof (rule lfp_lowerbound)
     show "f ((f ^^ k) bot) \<le> (f ^^ k) bot"
       using assms(2) by simp
   qed
   show "(f ^^ k) bot \<le> lfp f"
     using Kleene_iter_lpfp[OF assms(1)] lfp_unfold[OF assms(1)] by simp
 qed
 
 lemma mono_pow: "mono f \<Longrightarrow> mono (f ^^ n)"
   for f :: "'a \<Rightarrow> 'a::complete_lattice"
   by (induct n) (auto simp: mono_def)
 
 lemma lfp_funpow:
   assumes f: "mono f"
   shows "lfp (f ^^ Suc n) = lfp f"
 proof (rule antisym)
   show "lfp f \<le> lfp (f ^^ Suc n)"
   proof (rule lfp_lowerbound)
     have "f (lfp (f ^^ Suc n)) = lfp (\<lambda>x. f ((f ^^ n) x))"
       unfolding funpow_Suc_right by (simp add: lfp_rolling f mono_pow comp_def)
     then show "f (lfp (f ^^ Suc n)) \<le> lfp (f ^^ Suc n)"
       by (simp add: comp_def)
   qed
   have "(f ^^ n) (lfp f) = lfp f" for n
     by (induct n) (auto intro: f lfp_fixpoint)
   then show "lfp (f ^^ Suc n) \<le> lfp f"
     by (intro lfp_lowerbound) (simp del: funpow.simps)
 qed
 
 lemma gfp_funpow:
   assumes f: "mono f"
   shows "gfp (f ^^ Suc n) = gfp f"
 proof (rule antisym)
   show "gfp f \<ge> gfp (f ^^ Suc n)"
   proof (rule gfp_upperbound)
     have "f (gfp (f ^^ Suc n)) = gfp (\<lambda>x. f ((f ^^ n) x))"
       unfolding funpow_Suc_right by (simp add: gfp_rolling f mono_pow comp_def)
     then show "f (gfp (f ^^ Suc n)) \<ge> gfp (f ^^ Suc n)"
       by (simp add: comp_def)
   qed
   have "(f ^^ n) (gfp f) = gfp f" for n
     by (induct n) (auto intro: f gfp_fixpoint)
   then show "gfp (f ^^ Suc n) \<ge> gfp f"
     by (intro gfp_upperbound) (simp del: funpow.simps)
 qed
 
 lemma Kleene_iter_gpfp:
   fixes f :: "'a::order_top \<Rightarrow> 'a"
   assumes "mono f"
     and "p \<le> f p"
   shows "p \<le> (f ^^ k) top"
 proof (induct k)
   case 0
   show ?case by simp
 next
   case Suc
   show ?case
     using monoD[OF assms(1) Suc] assms(2) by simp
 qed
 
 lemma gfp_Kleene_iter:
   assumes "mono f"
     and "(f ^^ Suc k) top = (f ^^ k) top"
   shows "gfp f = (f ^^ k) top"
     (is "?lhs = ?rhs")
 proof (rule antisym)
   have "?rhs \<le> f ?rhs"
     using assms(2) by simp
   then show "?rhs \<le> ?lhs"
     by (rule gfp_upperbound)
   show "?lhs \<le> ?rhs"
     using Kleene_iter_gpfp[OF assms(1)] gfp_unfold[OF assms(1)] by simp
 qed
 
 
 subsection \<open>Embedding of the naturals into any \<open>semiring_1\<close>: \<^term>\<open>of_nat\<close>\<close>
 
 context semiring_1
 begin
 
 definition of_nat :: "nat \<Rightarrow> 'a"
   where "of_nat n = (plus 1 ^^ n) 0"
 
 lemma of_nat_simps [simp]:
   shows of_nat_0: "of_nat 0 = 0"
     and of_nat_Suc: "of_nat (Suc m) = 1 + of_nat m"
   by (simp_all add: of_nat_def)
 
 lemma of_nat_1 [simp]: "of_nat 1 = 1"
   by (simp add: of_nat_def)
 
 lemma of_nat_add [simp]: "of_nat (m + n) = of_nat m + of_nat n"
   by (induct m) (simp_all add: ac_simps)
 
 lemma of_nat_mult [simp]: "of_nat (m * n) = of_nat m * of_nat n"
   by (induct m) (simp_all add: ac_simps distrib_right)
 
 lemma mult_of_nat_commute: "of_nat x * y = y * of_nat x"
   by (induct x) (simp_all add: algebra_simps)
 
 primrec of_nat_aux :: "('a \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   where
     "of_nat_aux inc 0 i = i"
   | "of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i)" \<comment> \<open>tail recursive\<close>
 
 lemma of_nat_code: "of_nat n = of_nat_aux (\<lambda>i. i + 1) n 0"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "\<And>i. of_nat_aux (\<lambda>i. i + 1) n (i + 1) = of_nat_aux (\<lambda>i. i + 1) n i + 1"
     by (induct n) simp_all
   from this [of 0] have "of_nat_aux (\<lambda>i. i + 1) n 1 = of_nat_aux (\<lambda>i. i + 1) n 0 + 1"
     by simp
   with Suc show ?case
     by (simp add: add.commute)
 qed
 
 lemma of_nat_of_bool [simp]:
   "of_nat (of_bool P) = of_bool P"
   by auto
 
 end
 
 declare of_nat_code [code]
 
 context semiring_1_cancel
 begin
 
 lemma of_nat_diff:
   \<open>of_nat (m - n) = of_nat m - of_nat n\<close> if \<open>n \<le> m\<close>
 proof -
   from that obtain q where \<open>m = n + q\<close>
     by (blast dest: le_Suc_ex)
   then show ?thesis
     by simp
 qed
 
 end
 
 text \<open>Class for unital semirings with characteristic zero.
  Includes non-ordered rings like the complex numbers.\<close>
 
 class semiring_char_0 = semiring_1 +
   assumes inj_of_nat: "inj of_nat"
 begin
 
 lemma of_nat_eq_iff [simp]: "of_nat m = of_nat n \<longleftrightarrow> m = n"
   by (auto intro: inj_of_nat injD)
 
 text \<open>Special cases where either operand is zero\<close>
 
 lemma of_nat_0_eq_iff [simp]: "0 = of_nat n \<longleftrightarrow> 0 = n"
   by (fact of_nat_eq_iff [of 0 n, unfolded of_nat_0])
 
 lemma of_nat_eq_0_iff [simp]: "of_nat m = 0 \<longleftrightarrow> m = 0"
   by (fact of_nat_eq_iff [of m 0, unfolded of_nat_0])
 
 lemma of_nat_1_eq_iff [simp]: "1 = of_nat n \<longleftrightarrow> n=1"
   using of_nat_eq_iff by fastforce
 
 lemma of_nat_eq_1_iff [simp]: "of_nat n = 1 \<longleftrightarrow> n=1"
   using of_nat_eq_iff by fastforce
 
 lemma of_nat_neq_0 [simp]: "of_nat (Suc n) \<noteq> 0"
   unfolding of_nat_eq_0_iff by simp
 
 lemma of_nat_0_neq [simp]: "0 \<noteq> of_nat (Suc n)"
   unfolding of_nat_0_eq_iff by simp
 
 end
 
 class ring_char_0 = ring_1 + semiring_char_0
 
 context linordered_nonzero_semiring
 begin
 
 lemma of_nat_0_le_iff [simp]: "0 \<le> of_nat n"
   by (induct n) simp_all
 
 lemma of_nat_less_0_iff [simp]: "\<not> of_nat m < 0"
   by (simp add: not_less)
 
 lemma of_nat_mono[simp]: "i \<le> j \<Longrightarrow> of_nat i \<le> of_nat j"
   by (auto simp: le_iff_add intro!: add_increasing2)
 
 lemma of_nat_less_iff [simp]: "of_nat m < of_nat n \<longleftrightarrow> m < n"
 proof(induct m n rule: diff_induct)
   case (1 m) then show ?case
     by auto
 next
   case (2 n) then show ?case
     by (simp add: add_pos_nonneg)
 next
   case (3 m n)
   then show ?case
     by (auto simp: add_commute [of 1] add_mono1 not_less add_right_mono leD)
 qed
 
 lemma of_nat_le_iff [simp]: "of_nat m \<le> of_nat n \<longleftrightarrow> m \<le> n"
   by (simp add: not_less [symmetric] linorder_not_less [symmetric])
 
 lemma less_imp_of_nat_less: "m < n \<Longrightarrow> of_nat m < of_nat n"
   by simp
 
 lemma of_nat_less_imp_less: "of_nat m < of_nat n \<Longrightarrow> m < n"
   by simp
 
 text \<open>Every \<open>linordered_nonzero_semiring\<close> has characteristic zero.\<close>
 
 subclass semiring_char_0
   by standard (auto intro!: injI simp add: order.eq_iff)
 
 text \<open>Special cases where either operand is zero\<close>
 
 lemma of_nat_le_0_iff [simp]: "of_nat m \<le> 0 \<longleftrightarrow> m = 0"
   by (rule of_nat_le_iff [of _ 0, simplified])
 
 lemma of_nat_0_less_iff [simp]: "0 < of_nat n \<longleftrightarrow> 0 < n"
   by (rule of_nat_less_iff [of 0, simplified])
 
 end
 
 context linordered_nonzero_semiring
 begin
 
 lemma of_nat_max: "of_nat (max x y) = max (of_nat x) (of_nat y)"
   by (auto simp: max_def ord_class.max_def)
 
 lemma of_nat_min: "of_nat (min x y) = min (of_nat x) (of_nat y)"
   by (auto simp: min_def ord_class.min_def)
 
 end
 
 context linordered_semidom
 begin
 
 subclass linordered_nonzero_semiring ..
 
 subclass semiring_char_0 ..
 
 end
 
 context linordered_idom
 begin
 
 lemma abs_of_nat [simp]:
   "\<bar>of_nat n\<bar> = of_nat n"
   by (simp add: abs_if)
 
 lemma sgn_of_nat [simp]:
   "sgn (of_nat n) = of_bool (n > 0)"
   by simp
 
 end
 
 lemma of_nat_id [simp]: "of_nat n = n"
   by (induct n) simp_all
 
 lemma of_nat_eq_id [simp]: "of_nat = id"
   by (auto simp add: fun_eq_iff)
 
 
 subsection \<open>The set of natural numbers\<close>
 
 context semiring_1
 begin
 
 definition Nats :: "'a set"  ("\<nat>")
   where "\<nat> = range of_nat"
 
 lemma of_nat_in_Nats [simp]: "of_nat n \<in> \<nat>"
   by (simp add: Nats_def)
 
 lemma Nats_0 [simp]: "0 \<in> \<nat>"
   using of_nat_0 [symmetric] unfolding Nats_def
   by (rule range_eqI)
 
 lemma Nats_1 [simp]: "1 \<in> \<nat>"
   using of_nat_1 [symmetric] unfolding Nats_def
   by (rule range_eqI)
 
 lemma Nats_add [simp]: "a \<in> \<nat> \<Longrightarrow> b \<in> \<nat> \<Longrightarrow> a + b \<in> \<nat>"
   unfolding Nats_def using of_nat_add [symmetric]
   by (blast intro: range_eqI)
 
 lemma Nats_mult [simp]: "a \<in> \<nat> \<Longrightarrow> b \<in> \<nat> \<Longrightarrow> a * b \<in> \<nat>"
   unfolding Nats_def using of_nat_mult [symmetric]
   by (blast intro: range_eqI)
 
 lemma Nats_cases [cases set: Nats]:
   assumes "x \<in> \<nat>"
   obtains (of_nat) n where "x = of_nat n"
   unfolding Nats_def
 proof -
   from \<open>x \<in> \<nat>\<close> have "x \<in> range of_nat" unfolding Nats_def .
   then obtain n where "x = of_nat n" ..
   then show thesis ..
 qed
 
 lemma Nats_induct [case_names of_nat, induct set: Nats]: "x \<in> \<nat> \<Longrightarrow> (\<And>n. P (of_nat n)) \<Longrightarrow> P x"
   by (rule Nats_cases) auto
 
 end
 
 lemma Nats_diff [simp]:
   fixes a:: "'a::linordered_idom"
   assumes "a \<in> \<nat>" "b \<in> \<nat>" "b \<le> a" shows "a - b \<in> \<nat>"
 proof -
   obtain i where i: "a = of_nat i"
     using Nats_cases assms by blast
   obtain j where j: "b = of_nat j"
     using Nats_cases assms by blast
   have "j \<le> i"
     using \<open>b \<le> a\<close> i j of_nat_le_iff by blast
   then have *: "of_nat i - of_nat j = (of_nat (i-j) :: 'a)"
     by (simp add: of_nat_diff)
   then show ?thesis
     by (simp add: * i j)
 qed
 
 
 subsection \<open>Further arithmetic facts concerning the natural numbers\<close>
 
 lemma subst_equals:
   assumes "t = s" and "u = t"
   shows "u = s"
   using assms(2,1) by (rule trans)
 
 locale nat_arith
 begin
 
 lemma add1: "(A::'a::comm_monoid_add) \<equiv> k + a \<Longrightarrow> A + b \<equiv> k + (a + b)"
   by (simp only: ac_simps)
 
 lemma add2: "(B::'a::comm_monoid_add) \<equiv> k + b \<Longrightarrow> a + B \<equiv> k + (a + b)"
   by (simp only: ac_simps)
 
 lemma suc1: "A == k + a \<Longrightarrow> Suc A \<equiv> k + Suc a"
   by (simp only: add_Suc_right)
 
 lemma rule0: "(a::'a::comm_monoid_add) \<equiv> a + 0"
   by (simp only: add_0_right)
 
 end
 
 ML_file \<open>Tools/nat_arith.ML\<close>
 
 simproc_setup nateq_cancel_sums
   ("(l::nat) + m = n" | "(l::nat) = m + n" | "Suc m = n" | "m = Suc n") =
   \<open>fn phi => try o Nat_Arith.cancel_eq_conv\<close>
 
 simproc_setup natless_cancel_sums
   ("(l::nat) + m < n" | "(l::nat) < m + n" | "Suc m < n" | "m < Suc n") =
   \<open>fn phi => try o Nat_Arith.cancel_less_conv\<close>
 
 simproc_setup natle_cancel_sums
   ("(l::nat) + m \<le> n" | "(l::nat) \<le> m + n" | "Suc m \<le> n" | "m \<le> Suc n") =
   \<open>fn phi => try o Nat_Arith.cancel_le_conv\<close>
 
 simproc_setup natdiff_cancel_sums
   ("(l::nat) + m - n" | "(l::nat) - (m + n)" | "Suc m - n" | "m - Suc n") =
   \<open>fn phi => try o Nat_Arith.cancel_diff_conv\<close>
 
 context order
 begin
 
 lemma lift_Suc_mono_le:
   assumes mono: "\<And>n. f n \<le> f (Suc n)"
     and "n \<le> n'"
   shows "f n \<le> f n'"
 proof (cases "n < n'")
   case True
   then show ?thesis
     by (induct n n' rule: less_Suc_induct) (auto intro: mono)
 next
   case False
   with \<open>n \<le> n'\<close> show ?thesis by auto
 qed
 
 lemma lift_Suc_antimono_le:
   assumes mono: "\<And>n. f n \<ge> f (Suc n)"
     and "n \<le> n'"
   shows "f n \<ge> f n'"
 proof (cases "n < n'")
   case True
   then show ?thesis
     by (induct n n' rule: less_Suc_induct) (auto intro: mono)
 next
   case False
   with \<open>n \<le> n'\<close> show ?thesis by auto
 qed
 
 lemma lift_Suc_mono_less:
   assumes mono: "\<And>n. f n < f (Suc n)"
     and "n < n'"
   shows "f n < f n'"
   using \<open>n < n'\<close> by (induct n n' rule: less_Suc_induct) (auto intro: mono)
 
 lemma lift_Suc_mono_less_iff: "(\<And>n. f n < f (Suc n)) \<Longrightarrow> f n < f m \<longleftrightarrow> n < m"
   by (blast intro: less_asym' lift_Suc_mono_less [of f]
     dest: linorder_not_less[THEN iffD1] le_eq_less_or_eq [THEN iffD1])
 
 end
 
 lemma mono_iff_le_Suc: "mono f \<longleftrightarrow> (\<forall>n. f n \<le> f (Suc n))"
   unfolding mono_def by (auto intro: lift_Suc_mono_le [of f])
 
 lemma antimono_iff_le_Suc: "antimono f \<longleftrightarrow> (\<forall>n. f (Suc n) \<le> f n)"
   unfolding antimono_def by (auto intro: lift_Suc_antimono_le [of f])
 
+lemma strict_mono_Suc_iff: "strict_mono f \<longleftrightarrow> (\<forall>n. f n < f (Suc n))"
+proof (intro iffI strict_monoI)
+  assume *: "\<forall>n. f n < f (Suc n)"
+  fix m n :: nat assume "m < n"
+  thus "f m < f n"
+    by (induction rule: less_Suc_induct) (use * in auto)
+qed (auto simp: strict_mono_def)
+
+lemma strict_mono_add: "strict_mono (\<lambda>n::'a::linordered_semidom. n + k)"
+  by (auto simp: strict_mono_def)
+
 lemma mono_nat_linear_lb:
   fixes f :: "nat \<Rightarrow> nat"
   assumes "\<And>m n. m < n \<Longrightarrow> f m < f n"
   shows "f m + k \<le> f (m + k)"
 proof (induct k)
   case 0
   then show ?case by simp
 next
   case (Suc k)
   then have "Suc (f m + k) \<le> Suc (f (m + k))" by simp
   also from assms [of "m + k" "Suc (m + k)"] have "Suc (f (m + k)) \<le> f (Suc (m + k))"
     by (simp add: Suc_le_eq)
   finally show ?case by simp
 qed
 
 
 text \<open>Subtraction laws, mostly by Clemens Ballarin\<close>
 
 lemma diff_less_mono:
   fixes a b c :: nat
   assumes "a < b" and "c \<le> a"
   shows "a - c < b - c"
 proof -
   from assms obtain d e where "b = c + (d + e)" and "a = c + e" and "d > 0"
     by (auto dest!: le_Suc_ex less_imp_Suc_add simp add: ac_simps)
   then show ?thesis by simp
 qed
 
 lemma less_diff_conv: "i < j - k \<longleftrightarrow> i + k < j"
   for i j k :: nat
   by (cases "k \<le> j") (auto simp add: not_le dest: less_imp_Suc_add le_Suc_ex)
 
 lemma less_diff_conv2: "k \<le> j \<Longrightarrow> j - k < i \<longleftrightarrow> j < i + k"
   for j k i :: nat
   by (auto dest: le_Suc_ex)
 
 lemma le_diff_conv: "j - k \<le> i \<longleftrightarrow> j \<le> i + k"
   for j k i :: nat
   by (cases "k \<le> j") (auto simp add: not_le dest!: less_imp_Suc_add le_Suc_ex)
 
 lemma diff_diff_cancel [simp]: "i \<le> n \<Longrightarrow> n - (n - i) = i"
   for i n :: nat
   by (auto dest: le_Suc_ex)
 
 lemma diff_less [simp]: "0 < n \<Longrightarrow> 0 < m \<Longrightarrow> m - n < m"
   for i n :: nat
   by (auto dest: less_imp_Suc_add)
 
 text \<open>Simplification of relational expressions involving subtraction\<close>
 
 lemma diff_diff_eq: "k \<le> m \<Longrightarrow> k \<le> n \<Longrightarrow> m - k - (n - k) = m - n"
   for m n k :: nat
   by (auto dest!: le_Suc_ex)
 
 hide_fact (open) diff_diff_eq
 
 lemma eq_diff_iff: "k \<le> m \<Longrightarrow> k \<le> n \<Longrightarrow> m - k = n - k \<longleftrightarrow> m = n"
   for m n k :: nat
   by (auto dest: le_Suc_ex)
 
 lemma less_diff_iff: "k \<le> m \<Longrightarrow> k \<le> n \<Longrightarrow> m - k < n - k \<longleftrightarrow> m < n"
   for m n k :: nat
   by (auto dest!: le_Suc_ex)
 
 lemma le_diff_iff: "k \<le> m \<Longrightarrow> k \<le> n \<Longrightarrow> m - k \<le> n - k \<longleftrightarrow> m \<le> n"
   for m n k :: nat
   by (auto dest!: le_Suc_ex)
 
 lemma le_diff_iff': "a \<le> c \<Longrightarrow> b \<le> c \<Longrightarrow> c - a \<le> c - b \<longleftrightarrow> b \<le> a"
   for a b c :: nat
   by (force dest: le_Suc_ex)
 
 
 text \<open>(Anti)Monotonicity of subtraction -- by Stephan Merz\<close>
 
 lemma diff_le_mono: "m \<le> n \<Longrightarrow> m - l \<le> n - l"
   for m n l :: nat
   by (auto dest: less_imp_le less_imp_Suc_add split: nat_diff_split)
 
 lemma diff_le_mono2: "m \<le> n \<Longrightarrow> l - n \<le> l - m"
   for m n l :: nat
   by (auto dest: less_imp_le le_Suc_ex less_imp_Suc_add less_le_trans split: nat_diff_split)
 
 lemma diff_less_mono2: "m < n \<Longrightarrow> m < l \<Longrightarrow> l - n < l - m"
   for m n l :: nat
   by (auto dest: less_imp_Suc_add split: nat_diff_split)
 
 lemma diffs0_imp_equal: "m - n = 0 \<Longrightarrow> n - m = 0 \<Longrightarrow> m = n"
   for m n :: nat
   by (simp split: nat_diff_split)
 
 lemma min_diff: "min (m - i) (n - i) = min m n - i"
   for m n i :: nat
   by (cases m n rule: le_cases)
     (auto simp add: not_le min.absorb1 min.absorb2 min.absorb_iff1 [symmetric] diff_le_mono)
 
 lemma inj_on_diff_nat:
   fixes k :: nat
   assumes "\<And>n. n \<in> N \<Longrightarrow> k \<le> n"
   shows "inj_on (\<lambda>n. n - k) N"
 proof (rule inj_onI)
   fix x y
   assume a: "x \<in> N" "y \<in> N" "x - k = y - k"
   with assms have "x - k + k = y - k + k" by auto
   with a assms show "x = y" by (auto simp add: eq_diff_iff)
 qed
 
 text \<open>Rewriting to pull differences out\<close>
 
 lemma diff_diff_right [simp]: "k \<le> j \<Longrightarrow> i - (j - k) = i + k - j"
   for i j k :: nat
   by (fact diff_diff_right)
 
 lemma diff_Suc_diff_eq1 [simp]:
   assumes "k \<le> j"
   shows "i - Suc (j - k) = i + k - Suc j"
 proof -
   from assms have *: "Suc (j - k) = Suc j - k"
     by (simp add: Suc_diff_le)
   from assms have "k \<le> Suc j"
     by (rule order_trans) simp
   with diff_diff_right [of k "Suc j" i] * show ?thesis
     by simp
 qed
 
 lemma diff_Suc_diff_eq2 [simp]:
   assumes "k \<le> j"
   shows "Suc (j - k) - i = Suc j - (k + i)"
 proof -
   from assms obtain n where "j = k + n"
     by (auto dest: le_Suc_ex)
   moreover have "Suc n - i = (k + Suc n) - (k + i)"
     using add_diff_cancel_left [of k "Suc n" i] by simp
   ultimately show ?thesis by simp
 qed
 
 lemma Suc_diff_Suc:
   assumes "n < m"
   shows "Suc (m - Suc n) = m - n"
 proof -
   from assms obtain q where "m = n + Suc q"
     by (auto dest: less_imp_Suc_add)
   moreover define r where "r = Suc q"
   ultimately have "Suc (m - Suc n) = r" and "m = n + r"
     by simp_all
   then show ?thesis by simp
 qed
 
 lemma one_less_mult: "Suc 0 < n \<Longrightarrow> Suc 0 < m \<Longrightarrow> Suc 0 < m * n"
   using less_1_mult [of n m] by (simp add: ac_simps)
 
 lemma n_less_m_mult_n: "0 < n \<Longrightarrow> Suc 0 < m \<Longrightarrow> n < m * n"
   using mult_strict_right_mono [of 1 m n] by simp
 
 lemma n_less_n_mult_m: "0 < n \<Longrightarrow> Suc 0 < m \<Longrightarrow> n < n * m"
   using mult_strict_left_mono [of 1 m n] by simp
 
 
 text \<open>Induction starting beyond zero\<close>
 
 lemma nat_induct_at_least [consumes 1, case_names base Suc]:
   "P n" if "n \<ge> m" "P m" "\<And>n. n \<ge> m \<Longrightarrow> P n \<Longrightarrow> P (Suc n)"
 proof -
   define q where "q = n - m"
   with \<open>n \<ge> m\<close> have "n = m + q"
     by simp
   moreover have "P (m + q)"
     by (induction q) (use that in simp_all)
   ultimately show "P n"
     by simp
 qed
 
 lemma nat_induct_non_zero [consumes 1, case_names 1 Suc]:
   "P n" if "n > 0" "P 1" "\<And>n. n > 0 \<Longrightarrow> P n \<Longrightarrow> P (Suc n)"
 proof -
   from \<open>n > 0\<close> have "n \<ge> 1"
     by (cases n) simp_all
   moreover note \<open>P 1\<close>
   moreover have "\<And>n. n \<ge> 1 \<Longrightarrow> P n \<Longrightarrow> P (Suc n)"
     using \<open>\<And>n. n > 0 \<Longrightarrow> P n \<Longrightarrow> P (Suc n)\<close>
     by (simp add: Suc_le_eq)
   ultimately show "P n"
     by (rule nat_induct_at_least)
 qed
 
 
 text \<open>Specialized induction principles that work "backwards":\<close>
 
 lemma inc_induct [consumes 1, case_names base step]:
   assumes less: "i \<le> j"
     and base: "P j"
     and step: "\<And>n. i \<le> n \<Longrightarrow> n < j \<Longrightarrow> P (Suc n) \<Longrightarrow> P n"
   shows "P i"
   using less step
 proof (induct "j - i" arbitrary: i)
   case (0 i)
   then have "i = j" by simp
   with base show ?case by simp
 next
   case (Suc d n)
   from Suc.hyps have "n \<noteq> j" by auto
   with Suc have "n < j" by (simp add: less_le)
   from \<open>Suc d = j - n\<close> have "d + 1 = j - n" by simp
   then have "d + 1 - 1 = j - n - 1" by simp
   then have "d = j - n - 1" by simp
   then have "d = j - (n + 1)" by (simp add: diff_diff_eq)
   then have "d = j - Suc n" by simp
   moreover from \<open>n < j\<close> have "Suc n \<le> j" by (simp add: Suc_le_eq)
   ultimately have "P (Suc n)"
   proof (rule Suc.hyps)
     fix q
     assume "Suc n \<le> q"
     then have "n \<le> q" by (simp add: Suc_le_eq less_imp_le)
     moreover assume "q < j"
     moreover assume "P (Suc q)"
     ultimately show "P q" by (rule Suc.prems)
   qed
   with order_refl \<open>n < j\<close> show "P n" by (rule Suc.prems)
 qed
 
 lemma strict_inc_induct [consumes 1, case_names base step]:
   assumes less: "i < j"
     and base: "\<And>i. j = Suc i \<Longrightarrow> P i"
     and step: "\<And>i. i < j \<Longrightarrow> P (Suc i) \<Longrightarrow> P i"
   shows "P i"
 using less proof (induct "j - i - 1" arbitrary: i)
   case (0 i)
   from \<open>i < j\<close> obtain n where "j = i + n" and "n > 0"
     by (auto dest!: less_imp_Suc_add)
   with 0 have "j = Suc i"
     by (auto intro: order_antisym simp add: Suc_le_eq)
   with base show ?case by simp
 next
   case (Suc d i)
   from \<open>Suc d = j - i - 1\<close> have *: "Suc d = j - Suc i"
     by (simp add: diff_diff_add)
   then have "Suc d - 1 = j - Suc i - 1" by simp
   then have "d = j - Suc i - 1" by simp
   moreover from * have "j - Suc i \<noteq> 0" by auto
   then have "Suc i < j" by (simp add: not_le)
   ultimately have "P (Suc i)" by (rule Suc.hyps)
   with \<open>i < j\<close> show "P i" by (rule step)
 qed
 
 lemma zero_induct_lemma: "P k \<Longrightarrow> (\<And>n. P (Suc n) \<Longrightarrow> P n) \<Longrightarrow> P (k - i)"
   using inc_induct[of "k - i" k P, simplified] by blast
 
 lemma zero_induct: "P k \<Longrightarrow> (\<And>n. P (Suc n) \<Longrightarrow> P n) \<Longrightarrow> P 0"
   using inc_induct[of 0 k P] by blast
 
 text \<open>Further induction rule similar to @{thm inc_induct}.\<close>
 
 lemma dec_induct [consumes 1, case_names base step]:
   "i \<le> j \<Longrightarrow> P i \<Longrightarrow> (\<And>n. i \<le> n \<Longrightarrow> n < j \<Longrightarrow> P n \<Longrightarrow> P (Suc n)) \<Longrightarrow> P j"
 proof (induct j arbitrary: i)
   case 0
   then show ?case by simp
 next
   case (Suc j)
   from Suc.prems consider "i \<le> j" | "i = Suc j"
     by (auto simp add: le_Suc_eq)
   then show ?case
   proof cases
     case 1
     moreover have "j < Suc j" by simp
     moreover have "P j" using \<open>i \<le> j\<close> \<open>P i\<close>
     proof (rule Suc.hyps)
       fix q
       assume "i \<le> q"
       moreover assume "q < j" then have "q < Suc j"
         by (simp add: less_Suc_eq)
       moreover assume "P q"
       ultimately show "P (Suc q)" by (rule Suc.prems)
     qed
     ultimately show "P (Suc j)" by (rule Suc.prems)
   next
     case 2
     with \<open>P i\<close> show "P (Suc j)" by simp
   qed
 qed
 
 lemma transitive_stepwise_le:
   assumes "m \<le> n" "\<And>x. R x x" "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z" and "\<And>n. R n (Suc n)"
   shows "R m n"
 using \<open>m \<le> n\<close>  
   by (induction rule: dec_induct) (use assms in blast)+
 
 
 subsubsection \<open>Greatest operator\<close>
 
 lemma ex_has_greatest_nat:
   "P (k::nat) \<Longrightarrow> \<forall>y. P y \<longrightarrow> y \<le> b \<Longrightarrow> \<exists>x. P x \<and> (\<forall>y. P y \<longrightarrow> y \<le> x)"
 proof (induction "b-k" arbitrary: b k rule: less_induct)
   case less
   show ?case
   proof cases
     assume "\<exists>n>k. P n"
     then obtain n where "n>k" "P n" by blast
     have "n \<le> b" using \<open>P n\<close> less.prems(2) by auto
     hence "b-n < b-k"
       by(rule diff_less_mono2[OF \<open>k<n\<close> less_le_trans[OF \<open>k<n\<close>]])
     from less.hyps[OF this \<open>P n\<close> less.prems(2)]
     show ?thesis .
   next
     assume "\<not> (\<exists>n>k. P n)"
     hence "\<forall>y. P y \<longrightarrow> y \<le> k" by (auto simp: not_less)
     thus ?thesis using less.prems(1) by auto
   qed
 qed
 
 lemma
   fixes k::nat
   assumes "P k" and minor: "\<And>y. P y \<Longrightarrow> y \<le> b"
   shows GreatestI_nat: "P (Greatest P)" 
     and Greatest_le_nat: "k \<le> Greatest P"
 proof -
   obtain x where "P x" "\<And>y. P y \<Longrightarrow> y \<le> x"
     using assms ex_has_greatest_nat by blast
   with \<open>P k\<close> show "P (Greatest P)" "k \<le> Greatest P"
     using GreatestI2_order by blast+
 qed
 
 lemma GreatestI_ex_nat:
   "\<lbrakk> \<exists>k::nat. P k;  \<And>y. P y \<Longrightarrow> y \<le> b \<rbrakk> \<Longrightarrow> P (Greatest P)"
   by (blast intro: GreatestI_nat)
 
 
 subsection \<open>Monotonicity of \<open>funpow\<close>\<close>
 
 lemma funpow_increasing: "m \<le> n \<Longrightarrow> mono f \<Longrightarrow> (f ^^ n) \<top> \<le> (f ^^ m) \<top>"
   for f :: "'a::{lattice,order_top} \<Rightarrow> 'a"
   by (induct rule: inc_induct)
     (auto simp del: funpow.simps(2) simp add: funpow_Suc_right
       intro: order_trans[OF _ funpow_mono])
 
 lemma funpow_decreasing: "m \<le> n \<Longrightarrow> mono f \<Longrightarrow> (f ^^ m) \<bottom> \<le> (f ^^ n) \<bottom>"
   for f :: "'a::{lattice,order_bot} \<Rightarrow> 'a"
   by (induct rule: dec_induct)
     (auto simp del: funpow.simps(2) simp add: funpow_Suc_right
       intro: order_trans[OF _ funpow_mono])
 
 lemma mono_funpow: "mono Q \<Longrightarrow> mono (\<lambda>i. (Q ^^ i) \<bottom>)"
   for Q :: "'a::{lattice,order_bot} \<Rightarrow> 'a"
   by (auto intro!: funpow_decreasing simp: mono_def)
 
 lemma antimono_funpow: "mono Q \<Longrightarrow> antimono (\<lambda>i. (Q ^^ i) \<top>)"
   for Q :: "'a::{lattice,order_top} \<Rightarrow> 'a"
   by (auto intro!: funpow_increasing simp: antimono_def)
 
 
 subsection \<open>The divides relation on \<^typ>\<open>nat\<close>\<close>
 
 lemma dvd_1_left [iff]: "Suc 0 dvd k"
   by (simp add: dvd_def)
 
 lemma dvd_1_iff_1 [simp]: "m dvd Suc 0 \<longleftrightarrow> m = Suc 0"
   by (simp add: dvd_def)
 
 lemma nat_dvd_1_iff_1 [simp]: "m dvd 1 \<longleftrightarrow> m = 1"
   for m :: nat
   by (simp add: dvd_def)
 
 lemma dvd_antisym: "m dvd n \<Longrightarrow> n dvd m \<Longrightarrow> m = n"
   for m n :: nat
   unfolding dvd_def by (force dest: mult_eq_self_implies_10 simp add: mult.assoc)
 
 lemma dvd_diff_nat [simp]: "k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd (m - n)"
   for k m n :: nat
   unfolding dvd_def by (blast intro: right_diff_distrib' [symmetric])
 
 lemma dvd_diffD: 
   fixes k m n :: nat
   assumes "k dvd m - n" "k dvd n" "n \<le> m"
   shows "k dvd m"
 proof -
   have "k dvd n + (m - n)"
     using assms by (blast intro: dvd_add)
   with assms show ?thesis
     by simp
 qed
 
 lemma dvd_diffD1: "k dvd m - n \<Longrightarrow> k dvd m \<Longrightarrow> n \<le> m \<Longrightarrow> k dvd n"
   for k m n :: nat
   by (drule_tac m = m in dvd_diff_nat) auto
 
 lemma dvd_mult_cancel:
   fixes m n k :: nat
   assumes "k * m dvd k * n" and "0 < k"
   shows "m dvd n"
 proof -
   from assms(1) obtain q where "k * n = (k * m) * q" ..
   then have "k * n = k * (m * q)" by (simp add: ac_simps)
   with \<open>0 < k\<close> have "n = m * q" by (auto simp add: mult_left_cancel)
   then show ?thesis ..
 qed
 
 lemma dvd_mult_cancel1:
   fixes m n :: nat
   assumes "0 < m"
   shows "m * n dvd m \<longleftrightarrow> n = 1"
 proof 
   assume "m * n dvd m"
   then have "m * n dvd m * 1"
     by simp
   then have "n dvd 1"
     by (iprover intro: assms dvd_mult_cancel)
   then show "n = 1"
     by auto
 qed auto
 
 lemma dvd_mult_cancel2: "0 < m \<Longrightarrow> n * m dvd m \<longleftrightarrow> n = 1"
   for m n :: nat
   using dvd_mult_cancel1 [of m n] by (simp add: ac_simps)
 
 lemma dvd_imp_le: "k dvd n \<Longrightarrow> 0 < n \<Longrightarrow> k \<le> n"
   for k n :: nat
   by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
 
 lemma nat_dvd_not_less: "0 < m \<Longrightarrow> m < n \<Longrightarrow> \<not> n dvd m"
   for m n :: nat
   by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc)
 
 lemma less_eq_dvd_minus:
   fixes m n :: nat
   assumes "m \<le> n"
   shows "m dvd n \<longleftrightarrow> m dvd n - m"
 proof -
   from assms have "n = m + (n - m)" by simp
   then obtain q where "n = m + q" ..
   then show ?thesis by (simp add: add.commute [of m])
 qed
 
 lemma dvd_minus_self: "m dvd n - m \<longleftrightarrow> n < m \<or> m dvd n"
   for m n :: nat
   by (cases "n < m") (auto elim!: dvdE simp add: not_less le_imp_diff_is_add dest: less_imp_le)
 
 lemma dvd_minus_add:
   fixes m n q r :: nat
   assumes "q \<le> n" "q \<le> r * m"
   shows "m dvd n - q \<longleftrightarrow> m dvd n + (r * m - q)"
 proof -
   have "m dvd n - q \<longleftrightarrow> m dvd r * m + (n - q)"
     using dvd_add_times_triv_left_iff [of m r] by simp
   also from assms have "\<dots> \<longleftrightarrow> m dvd r * m + n - q" by simp
   also from assms have "\<dots> \<longleftrightarrow> m dvd (r * m - q) + n" by simp
   also have "\<dots> \<longleftrightarrow> m dvd n + (r * m - q)" by (simp add: add.commute)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Aliasses\<close>
 
 lemma nat_mult_1: "1 * n = n"
   for n :: nat
   by (fact mult_1_left)
 
 lemma nat_mult_1_right: "n * 1 = n"
   for n :: nat
   by (fact mult_1_right)
 
 lemma diff_mult_distrib: "(m - n) * k = (m * k) - (n * k)"
   for k m n :: nat
   by (fact left_diff_distrib')
 
 lemma diff_mult_distrib2: "k * (m - n) = (k * m) - (k * n)"
   for k m n :: nat
   by (fact right_diff_distrib')
 
 (*Used in AUTO2 and Groups.le_diff_conv2 (with variables renamed) doesn't work for some reason*)
 lemma le_diff_conv2: "k \<le> j \<Longrightarrow> (i \<le> j - k) = (i + k \<le> j)"
   for i j k :: nat
   by (fact le_diff_conv2) 
 
 lemma diff_self_eq_0 [simp]: "m - m = 0"
   for m :: nat
   by (fact diff_cancel)
 
 lemma diff_diff_left [simp]: "i - j - k = i - (j + k)"
   for i j k :: nat
   by (fact diff_diff_add)
 
 lemma diff_commute: "i - j - k = i - k - j"
   for i j k :: nat
   by (fact diff_right_commute)
 
 lemma diff_add_inverse: "(n + m) - n = m"
   for m n :: nat
   by (fact add_diff_cancel_left')
 
 lemma diff_add_inverse2: "(m + n) - n = m"
   for m n :: nat
   by (fact add_diff_cancel_right')
 
 lemma diff_cancel: "(k + m) - (k + n) = m - n"
   for k m n :: nat
   by (fact add_diff_cancel_left)
 
 lemma diff_cancel2: "(m + k) - (n + k) = m - n"
   for k m n :: nat
   by (fact add_diff_cancel_right)
 
 lemma diff_add_0: "n - (n + m) = 0"
   for m n :: nat
   by (fact diff_add_zero)
 
 lemma add_mult_distrib2: "k * (m + n) = (k * m) + (k * n)"
   for k m n :: nat
   by (fact distrib_left)
 
 lemmas nat_distrib =
   add_mult_distrib distrib_left diff_mult_distrib diff_mult_distrib2
 
 
 subsection \<open>Size of a datatype value\<close>
 
 class size =
   fixes size :: "'a \<Rightarrow> nat" \<comment> \<open>see further theory \<open>Wellfounded\<close>\<close>
 
 instantiation nat :: size
 begin
 
 definition size_nat where [simp, code]: "size (n::nat) = n"
 
 instance ..
 
 end
 
 lemmas size_nat = size_nat_def
 
 lemma size_neq_size_imp_neq: "size x \<noteq> size y \<Longrightarrow> x \<noteq> y"
   by (erule contrapos_nn) (rule arg_cong)
 
 
 subsection \<open>Code module namespace\<close>
 
 code_identifier
   code_module Nat \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 hide_const (open) of_nat_aux
 
 end
diff --git a/src/HOL/Topological_Spaces.thy b/src/HOL/Topological_Spaces.thy
--- a/src/HOL/Topological_Spaces.thy
+++ b/src/HOL/Topological_Spaces.thy
@@ -1,3970 +1,3959 @@
 (*  Title:      HOL/Topological_Spaces.thy
     Author:     Brian Huffman
     Author:     Johannes Hölzl
 *)
 
 section \<open>Topological Spaces\<close>
 
 theory Topological_Spaces
   imports Main
 begin
 
 named_theorems continuous_intros "structural introduction rules for continuity"
 
 subsection \<open>Topological space\<close>
 
 class "open" =
   fixes "open" :: "'a set \<Rightarrow> bool"
 
 class topological_space = "open" +
   assumes open_UNIV [simp, intro]: "open UNIV"
   assumes open_Int [intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<inter> T)"
   assumes open_Union [intro]: "\<forall>S\<in>K. open S \<Longrightarrow> open (\<Union>K)"
 begin
 
 definition closed :: "'a set \<Rightarrow> bool"
   where "closed S \<longleftrightarrow> open (- S)"
 
 lemma open_empty [continuous_intros, intro, simp]: "open {}"
   using open_Union [of "{}"] by simp
 
 lemma open_Un [continuous_intros, intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<union> T)"
   using open_Union [of "{S, T}"] by simp
 
 lemma open_UN [continuous_intros, intro]: "\<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Union>x\<in>A. B x)"
   using open_Union [of "B ` A"] by simp
 
 lemma open_Inter [continuous_intros, intro]: "finite S \<Longrightarrow> \<forall>T\<in>S. open T \<Longrightarrow> open (\<Inter>S)"
   by (induction set: finite) auto
 
 lemma open_INT [continuous_intros, intro]: "finite A \<Longrightarrow> \<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Inter>x\<in>A. B x)"
   using open_Inter [of "B ` A"] by simp
 
 lemma openI:
   assumes "\<And>x. x \<in> S \<Longrightarrow> \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S"
   shows "open S"
 proof -
   have "open (\<Union>{T. open T \<and> T \<subseteq> S})" by auto
   moreover have "\<Union>{T. open T \<and> T \<subseteq> S} = S" by (auto dest!: assms)
   ultimately show "open S" by simp
 qed
 
 lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
 by (auto intro: openI)
 
 lemma closed_empty [continuous_intros, intro, simp]: "closed {}"
   unfolding closed_def by simp
 
 lemma closed_Un [continuous_intros, intro]: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<union> T)"
   unfolding closed_def by auto
 
 lemma closed_UNIV [continuous_intros, intro, simp]: "closed UNIV"
   unfolding closed_def by simp
 
 lemma closed_Int [continuous_intros, intro]: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<inter> T)"
   unfolding closed_def by auto
 
 lemma closed_INT [continuous_intros, intro]: "\<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Inter>x\<in>A. B x)"
   unfolding closed_def by auto
 
 lemma closed_Inter [continuous_intros, intro]: "\<forall>S\<in>K. closed S \<Longrightarrow> closed (\<Inter>K)"
   unfolding closed_def uminus_Inf by auto
 
 lemma closed_Union [continuous_intros, intro]: "finite S \<Longrightarrow> \<forall>T\<in>S. closed T \<Longrightarrow> closed (\<Union>S)"
   by (induct set: finite) auto
 
 lemma closed_UN [continuous_intros, intro]:
   "finite A \<Longrightarrow> \<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Union>x\<in>A. B x)"
   using closed_Union [of "B ` A"] by simp
 
 lemma open_closed: "open S \<longleftrightarrow> closed (- S)"
   by (simp add: closed_def)
 
 lemma closed_open: "closed S \<longleftrightarrow> open (- S)"
   by (rule closed_def)
 
 lemma open_Diff [continuous_intros, intro]: "open S \<Longrightarrow> closed T \<Longrightarrow> open (S - T)"
   by (simp add: closed_open Diff_eq open_Int)
 
 lemma closed_Diff [continuous_intros, intro]: "closed S \<Longrightarrow> open T \<Longrightarrow> closed (S - T)"
   by (simp add: open_closed Diff_eq closed_Int)
 
 lemma open_Compl [continuous_intros, intro]: "closed S \<Longrightarrow> open (- S)"
   by (simp add: closed_open)
 
 lemma closed_Compl [continuous_intros, intro]: "open S \<Longrightarrow> closed (- S)"
   by (simp add: open_closed)
 
 lemma open_Collect_neg: "closed {x. P x} \<Longrightarrow> open {x. \<not> P x}"
   unfolding Collect_neg_eq by (rule open_Compl)
 
 lemma open_Collect_conj:
   assumes "open {x. P x}" "open {x. Q x}"
   shows "open {x. P x \<and> Q x}"
   using open_Int[OF assms] by (simp add: Int_def)
 
 lemma open_Collect_disj:
   assumes "open {x. P x}" "open {x. Q x}"
   shows "open {x. P x \<or> Q x}"
   using open_Un[OF assms] by (simp add: Un_def)
 
 lemma open_Collect_ex: "(\<And>i. open {x. P i x}) \<Longrightarrow> open {x. \<exists>i. P i x}"
   using open_UN[of UNIV "\<lambda>i. {x. P i x}"] unfolding Collect_ex_eq by simp
 
 lemma open_Collect_imp: "closed {x. P x} \<Longrightarrow> open {x. Q x} \<Longrightarrow> open {x. P x \<longrightarrow> Q x}"
   unfolding imp_conv_disj by (intro open_Collect_disj open_Collect_neg)
 
 lemma open_Collect_const: "open {x. P}"
   by (cases P) auto
 
 lemma closed_Collect_neg: "open {x. P x} \<Longrightarrow> closed {x. \<not> P x}"
   unfolding Collect_neg_eq by (rule closed_Compl)
 
 lemma closed_Collect_conj:
   assumes "closed {x. P x}" "closed {x. Q x}"
   shows "closed {x. P x \<and> Q x}"
   using closed_Int[OF assms] by (simp add: Int_def)
 
 lemma closed_Collect_disj:
   assumes "closed {x. P x}" "closed {x. Q x}"
   shows "closed {x. P x \<or> Q x}"
   using closed_Un[OF assms] by (simp add: Un_def)
 
 lemma closed_Collect_all: "(\<And>i. closed {x. P i x}) \<Longrightarrow> closed {x. \<forall>i. P i x}"
   using closed_INT[of UNIV "\<lambda>i. {x. P i x}"] by (simp add: Collect_all_eq)
 
 lemma closed_Collect_imp: "open {x. P x} \<Longrightarrow> closed {x. Q x} \<Longrightarrow> closed {x. P x \<longrightarrow> Q x}"
   unfolding imp_conv_disj by (intro closed_Collect_disj closed_Collect_neg)
 
 lemma closed_Collect_const: "closed {x. P}"
   by (cases P) auto
 
 end
 
 
 subsection \<open>Hausdorff and other separation properties\<close>
 
 class t0_space = topological_space +
   assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
 
 class t1_space = topological_space +
   assumes t1_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> x \<in> U \<and> y \<notin> U"
 
 instance t1_space \<subseteq> t0_space
   by standard (fast dest: t1_space)
 
 context t1_space begin
 
 lemma separation_t1: "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> x \<in> U \<and> y \<notin> U)"
   using t1_space[of x y] by blast
 
 lemma closed_singleton [iff]: "closed {a}"
 proof -
   let ?T = "\<Union>{S. open S \<and> a \<notin> S}"
   have "open ?T"
     by (simp add: open_Union)
   also have "?T = - {a}"
     by (auto simp add: set_eq_iff separation_t1)
   finally show "closed {a}"
     by (simp only: closed_def)
 qed
 
 lemma closed_insert [continuous_intros, simp]:
   assumes "closed S"
   shows "closed (insert a S)"
 proof -
   from closed_singleton assms have "closed ({a} \<union> S)"
     by (rule closed_Un)
   then show "closed (insert a S)"
     by simp
 qed
 
 lemma finite_imp_closed: "finite S \<Longrightarrow> closed S"
   by (induct pred: finite) simp_all
 
 end
 
 text \<open>T2 spaces are also known as Hausdorff spaces.\<close>
 
 class t2_space = topological_space +
   assumes hausdorff: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
 
 instance t2_space \<subseteq> t1_space
   by standard (fast dest: hausdorff)
 
 lemma (in t2_space) separation_t2: "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
   using hausdorff [of x y] by blast
 
 lemma (in t0_space) separation_t0: "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U))"
   using t0_space [of x y] by blast
 
 
 text \<open>A classical separation axiom for topological space, the T3 axiom -- also called regularity:
 if a point is not in a closed set, then there are open sets separating them.\<close>
 
 class t3_space = t2_space +
   assumes t3_space: "closed S \<Longrightarrow> y \<notin> S \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"
 
 text \<open>A classical separation axiom for topological space, the T4 axiom -- also called normality:
 if two closed sets are disjoint, then there are open sets separating them.\<close>
 
 class t4_space = t2_space +
   assumes t4_space: "closed S \<Longrightarrow> closed T \<Longrightarrow> S \<inter> T = {} \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> U \<inter> V = {}"
 
 text \<open>T4 is stronger than T3, and weaker than metric.\<close>
 
 instance t4_space \<subseteq> t3_space
 proof
   fix S and y::'a assume "closed S" "y \<notin> S"
   then show "\<exists>U V. open U \<and> open V \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"
     using t4_space[of "{y}" S] by auto
 qed
 
 text \<open>A perfect space is a topological space with no isolated points.\<close>
 
 class perfect_space = topological_space +
   assumes not_open_singleton: "\<not> open {x}"
 
 lemma (in perfect_space) UNIV_not_singleton: "UNIV \<noteq> {x}"
   for x::'a
   by (metis (no_types) open_UNIV not_open_singleton)
 
 
 subsection \<open>Generators for toplogies\<close>
 
 inductive generate_topology :: "'a set set \<Rightarrow> 'a set \<Rightarrow> bool" for S :: "'a set set"
   where
     UNIV: "generate_topology S UNIV"
   | Int: "generate_topology S (a \<inter> b)" if "generate_topology S a" and "generate_topology S b"
   | UN: "generate_topology S (\<Union>K)" if "(\<And>k. k \<in> K \<Longrightarrow> generate_topology S k)"
   | Basis: "generate_topology S s" if "s \<in> S"
 
 hide_fact (open) UNIV Int UN Basis
 
 lemma generate_topology_Union:
   "(\<And>k. k \<in> I \<Longrightarrow> generate_topology S (K k)) \<Longrightarrow> generate_topology S (\<Union>k\<in>I. K k)"
   using generate_topology.UN [of "K ` I"] by auto
 
 lemma topological_space_generate_topology: "class.topological_space (generate_topology S)"
   by standard (auto intro: generate_topology.intros)
 
 
 subsection \<open>Order topologies\<close>
 
 class order_topology = order + "open" +
   assumes open_generated_order: "open = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 begin
 
 subclass topological_space
   unfolding open_generated_order
   by (rule topological_space_generate_topology)
 
 lemma open_greaterThan [continuous_intros, simp]: "open {a <..}"
   unfolding open_generated_order by (auto intro: generate_topology.Basis)
 
 lemma open_lessThan [continuous_intros, simp]: "open {..< a}"
   unfolding open_generated_order by (auto intro: generate_topology.Basis)
 
 lemma open_greaterThanLessThan [continuous_intros, simp]: "open {a <..< b}"
    unfolding greaterThanLessThan_eq by (simp add: open_Int)
 
 end
 
 class linorder_topology = linorder + order_topology
 
 lemma closed_atMost [continuous_intros, simp]: "closed {..a}"
   for a :: "'a::linorder_topology"
   by (simp add: closed_open)
 
 lemma closed_atLeast [continuous_intros, simp]: "closed {a..}"
   for a :: "'a::linorder_topology"
   by (simp add: closed_open)
 
 lemma closed_atLeastAtMost [continuous_intros, simp]: "closed {a..b}"
   for a b :: "'a::linorder_topology"
 proof -
   have "{a .. b} = {a ..} \<inter> {.. b}"
     by auto
   then show ?thesis
     by (simp add: closed_Int)
 qed
 
 lemma (in order) less_separate:
   assumes "x < y"
   shows "\<exists>a b. x \<in> {..< a} \<and> y \<in> {b <..} \<and> {..< a} \<inter> {b <..} = {}"
 proof (cases "\<exists>z. x < z \<and> z < y")
   case True
   then obtain z where "x < z \<and> z < y" ..
   then have "x \<in> {..< z} \<and> y \<in> {z <..} \<and> {z <..} \<inter> {..< z} = {}"
     by auto
   then show ?thesis by blast
 next
   case False
   with \<open>x < y\<close> have "x \<in> {..< y}" "y \<in> {x <..}" "{x <..} \<inter> {..< y} = {}"
     by auto
   then show ?thesis by blast
 qed
 
 instance linorder_topology \<subseteq> t2_space
 proof
   fix x y :: 'a
   show "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     using less_separate [of x y] less_separate [of y x]
     by (elim neqE; metis open_lessThan open_greaterThan Int_commute)
 qed
 
 lemma (in linorder_topology) open_right:
   assumes "open S" "x \<in> S"
     and gt_ex: "x < y"
   shows "\<exists>b>x. {x ..< b} \<subseteq> S"
   using assms unfolding open_generated_order
 proof induct
   case UNIV
   then show ?case by blast
 next
   case (Int A B)
   then obtain a b where "a > x" "{x ..< a} \<subseteq> A"  "b > x" "{x ..< b} \<subseteq> B"
     by auto
   then show ?case
     by (auto intro!: exI[of _ "min a b"])
 next
   case UN
   then show ?case by blast
 next
   case Basis
   then show ?case
     by (fastforce intro: exI[of _ y] gt_ex)
 qed
 
 lemma (in linorder_topology) open_left:
   assumes "open S" "x \<in> S"
     and lt_ex: "y < x"
   shows "\<exists>b<x. {b <.. x} \<subseteq> S"
   using assms unfolding open_generated_order
 proof induction
   case UNIV
   then show ?case by blast
 next
   case (Int A B)
   then obtain a b where "a < x" "{a <.. x} \<subseteq> A"  "b < x" "{b <.. x} \<subseteq> B"
     by auto
   then show ?case
     by (auto intro!: exI[of _ "max a b"])
 next
   case UN
   then show ?case by blast
 next
   case Basis
   then show ?case
     by (fastforce intro: exI[of _ y] lt_ex)
 qed
 
 
 subsection \<open>Setup some topologies\<close>
 
 subsubsection \<open>Boolean is an order topology\<close>
 
 class discrete_topology = topological_space +
   assumes open_discrete: "\<And>A. open A"
 
 instance discrete_topology < t2_space
 proof
   fix x y :: 'a
   assume "x \<noteq> y"
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by (intro exI[of _ "{_}"]) (auto intro!: open_discrete)
 qed
 
 instantiation bool :: linorder_topology
 begin
 
 definition open_bool :: "bool set \<Rightarrow> bool"
   where "open_bool = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_bool_def)
 
 end
 
 instance bool :: discrete_topology
 proof
   fix A :: "bool set"
   have *: "{False <..} = {True}" "{..< True} = {False}"
     by auto
   have "A = UNIV \<or> A = {} \<or> A = {False <..} \<or> A = {..< True}"
     using subset_UNIV[of A] unfolding UNIV_bool * by blast
   then show "open A"
     by auto
 qed
 
 instantiation nat :: linorder_topology
 begin
 
 definition open_nat :: "nat set \<Rightarrow> bool"
   where "open_nat = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_nat_def)
 
 end
 
 instance nat :: discrete_topology
 proof
   fix A :: "nat set"
   have "open {n}" for n :: nat
   proof (cases n)
     case 0
     moreover have "{0} = {..<1::nat}"
       by auto
     ultimately show ?thesis
        by auto
   next
     case (Suc n')
     then have "{n} = {..<Suc n} \<inter> {n' <..}"
       by auto
     with Suc show ?thesis
       by (auto intro: open_lessThan open_greaterThan)
   qed
   then have "open (\<Union>a\<in>A. {a})"
     by (intro open_UN) auto
   then show "open A"
     by simp
 qed
 
 instantiation int :: linorder_topology
 begin
 
 definition open_int :: "int set \<Rightarrow> bool"
   where "open_int = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_int_def)
 
 end
 
 instance int :: discrete_topology
 proof
   fix A :: "int set"
   have "{..<i + 1} \<inter> {i-1 <..} = {i}" for i :: int
     by auto
   then have "open {i}" for i :: int
     using open_Int[OF open_lessThan[of "i + 1"] open_greaterThan[of "i - 1"]] by auto
   then have "open (\<Union>a\<in>A. {a})"
     by (intro open_UN) auto
   then show "open A"
     by simp
 qed
 
 
 subsubsection \<open>Topological filters\<close>
 
 definition (in topological_space) nhds :: "'a \<Rightarrow> 'a filter"
   where "nhds a = (INF S\<in>{S. open S \<and> a \<in> S}. principal S)"
 
 definition (in topological_space) at_within :: "'a \<Rightarrow> 'a set \<Rightarrow> 'a filter"
     ("at (_)/ within (_)" [1000, 60] 60)
   where "at a within s = inf (nhds a) (principal (s - {a}))"
 
 abbreviation (in topological_space) at :: "'a \<Rightarrow> 'a filter"  ("at")
   where "at x \<equiv> at x within (CONST UNIV)"
 
 abbreviation (in order_topology) at_right :: "'a \<Rightarrow> 'a filter"
   where "at_right x \<equiv> at x within {x <..}"
 
 abbreviation (in order_topology) at_left :: "'a \<Rightarrow> 'a filter"
   where "at_left x \<equiv> at x within {..< x}"
 
 lemma (in topological_space) nhds_generated_topology:
   "open = generate_topology T \<Longrightarrow> nhds x = (INF S\<in>{S\<in>T. x \<in> S}. principal S)"
   unfolding nhds_def
 proof (safe intro!: antisym INF_greatest)
   fix S
   assume "generate_topology T S" "x \<in> S"
   then show "(INF S\<in>{S \<in> T. x \<in> S}. principal S) \<le> principal S"
     by induct
       (auto intro: INF_lower order_trans simp: inf_principal[symmetric] simp del: inf_principal)
 qed (auto intro!: INF_lower intro: generate_topology.intros)
 
 lemma (in topological_space) eventually_nhds:
   "eventually P (nhds a) \<longleftrightarrow> (\<exists>S. open S \<and> a \<in> S \<and> (\<forall>x\<in>S. P x))"
   unfolding nhds_def by (subst eventually_INF_base) (auto simp: eventually_principal)
 
 lemma eventually_eventually:
   "eventually (\<lambda>y. eventually P (nhds y)) (nhds x) = eventually P (nhds x)"
   by (auto simp: eventually_nhds)
 
 lemma (in topological_space) eventually_nhds_in_open:
   "open s \<Longrightarrow> x \<in> s \<Longrightarrow> eventually (\<lambda>y. y \<in> s) (nhds x)"
   by (subst eventually_nhds) blast
 
 lemma (in topological_space) eventually_nhds_x_imp_x: "eventually P (nhds x) \<Longrightarrow> P x"
   by (subst (asm) eventually_nhds) blast
 
 lemma (in topological_space) nhds_neq_bot [simp]: "nhds a \<noteq> bot"
   by (simp add: trivial_limit_def eventually_nhds)
 
 lemma (in t1_space) t1_space_nhds: "x \<noteq> y \<Longrightarrow> (\<forall>\<^sub>F x in nhds x. x \<noteq> y)"
   by (drule t1_space) (auto simp: eventually_nhds)
 
 lemma (in topological_space) nhds_discrete_open: "open {x} \<Longrightarrow> nhds x = principal {x}"
   by (auto simp: nhds_def intro!: antisym INF_greatest INF_lower2[of "{x}"])
 
 lemma (in discrete_topology) nhds_discrete: "nhds x = principal {x}"
   by (simp add: nhds_discrete_open open_discrete)
 
 lemma (in discrete_topology) at_discrete: "at x within S = bot"
   unfolding at_within_def nhds_discrete by simp
 
 lemma (in discrete_topology) tendsto_discrete:
   "filterlim (f :: 'b \<Rightarrow> 'a) (nhds y) F \<longleftrightarrow> eventually (\<lambda>x. f x = y) F"
   by (auto simp: nhds_discrete filterlim_principal)
 
 lemma (in topological_space) at_within_eq:
   "at x within s = (INF S\<in>{S. open S \<and> x \<in> S}. principal (S \<inter> s - {x}))"
   unfolding nhds_def at_within_def
   by (subst INF_inf_const2[symmetric]) (auto simp: Diff_Int_distrib)
 
 lemma (in topological_space) eventually_at_filter:
   "eventually P (at a within s) \<longleftrightarrow> eventually (\<lambda>x. x \<noteq> a \<longrightarrow> x \<in> s \<longrightarrow> P x) (nhds a)"
   by (simp add: at_within_def eventually_inf_principal imp_conjL[symmetric] conj_commute)
 
 lemma (in topological_space) at_le: "s \<subseteq> t \<Longrightarrow> at x within s \<le> at x within t"
   unfolding at_within_def by (intro inf_mono) auto
 
 lemma (in topological_space) eventually_at_topological:
   "eventually P (at a within s) \<longleftrightarrow> (\<exists>S. open S \<and> a \<in> S \<and> (\<forall>x\<in>S. x \<noteq> a \<longrightarrow> x \<in> s \<longrightarrow> P x))"
   by (simp add: eventually_nhds eventually_at_filter)
 
 lemma eventually_at_in_open:
   assumes "open A" "x \<in> A"
   shows   "eventually (\<lambda>y. y \<in> A - {x}) (at x)"
   using assms eventually_at_topological by blast
 
 lemma eventually_at_in_open':
   assumes "open A" "x \<in> A"
   shows   "eventually (\<lambda>y. y \<in> A) (at x)"
   using assms eventually_at_topological by blast
 
 lemma (in topological_space) at_within_open: "a \<in> S \<Longrightarrow> open S \<Longrightarrow> at a within S = at a"
   unfolding filter_eq_iff eventually_at_topological by (metis open_Int Int_iff UNIV_I)
 
 lemma (in topological_space) at_within_open_NO_MATCH:
   "a \<in> s \<Longrightarrow> open s \<Longrightarrow> NO_MATCH UNIV s \<Longrightarrow> at a within s = at a"
   by (simp only: at_within_open)
 
 lemma (in topological_space) at_within_open_subset:
   "a \<in> S \<Longrightarrow> open S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> at a within T = at a"
   by (metis at_le at_within_open dual_order.antisym subset_UNIV)
 
 lemma (in topological_space) at_within_nhd:
   assumes "x \<in> S" "open S" "T \<inter> S - {x} = U \<inter> S - {x}"
   shows "at x within T = at x within U"
   unfolding filter_eq_iff eventually_at_filter
 proof (intro allI eventually_subst)
   have "eventually (\<lambda>x. x \<in> S) (nhds x)"
     using \<open>x \<in> S\<close> \<open>open S\<close> by (auto simp: eventually_nhds)
   then show "\<forall>\<^sub>F n in nhds x. (n \<noteq> x \<longrightarrow> n \<in> T \<longrightarrow> P n) = (n \<noteq> x \<longrightarrow> n \<in> U \<longrightarrow> P n)" for P
     by eventually_elim (insert \<open>T \<inter> S - {x} = U \<inter> S - {x}\<close>, blast)
 qed
 
 lemma (in topological_space) at_within_empty [simp]: "at a within {} = bot"
   unfolding at_within_def by simp
 
 lemma (in topological_space) at_within_union:
   "at x within (S \<union> T) = sup (at x within S) (at x within T)"
   unfolding filter_eq_iff eventually_sup eventually_at_filter
   by (auto elim!: eventually_rev_mp)
 
 lemma (in topological_space) at_eq_bot_iff: "at a = bot \<longleftrightarrow> open {a}"
   unfolding trivial_limit_def eventually_at_topological
   by (metis UNIV_I empty_iff is_singletonE is_singletonI' singleton_iff)
 
 lemma (in t1_space) eventually_neq_at_within:
   "eventually (\<lambda>w. w \<noteq> x) (at z within A)"
   by (smt (verit, ccfv_threshold) eventually_True eventually_at_topological separation_t1)
 
 lemma (in perfect_space) at_neq_bot [simp]: "at a \<noteq> bot"
   by (simp add: at_eq_bot_iff not_open_singleton)
 
 lemma (in order_topology) nhds_order:
   "nhds x = inf (INF a\<in>{x <..}. principal {..< a}) (INF a\<in>{..< x}. principal {a <..})"
 proof -
   have 1: "{S \<in> range lessThan \<union> range greaterThan. x \<in> S} =
       (\<lambda>a. {..< a}) ` {x <..} \<union> (\<lambda>a. {a <..}) ` {..< x}"
     by auto
   show ?thesis
     by (simp only: nhds_generated_topology[OF open_generated_order] INF_union 1 INF_image comp_def)
 qed
 
 lemma (in topological_space) filterlim_at_within_If:
   assumes "filterlim f G (at x within (A \<inter> {x. P x}))"
     and "filterlim g G (at x within (A \<inter> {x. \<not>P x}))"
   shows "filterlim (\<lambda>x. if P x then f x else g x) G (at x within A)"
 proof (rule filterlim_If)
   note assms(1)
   also have "at x within (A \<inter> {x. P x}) = inf (nhds x) (principal (A \<inter> Collect P - {x}))"
     by (simp add: at_within_def)
   also have "A \<inter> Collect P - {x} = (A - {x}) \<inter> Collect P"
     by blast
   also have "inf (nhds x) (principal \<dots>) = inf (at x within A) (principal (Collect P))"
     by (simp add: at_within_def inf_assoc)
   finally show "filterlim f G (inf (at x within A) (principal (Collect P)))" .
 next
   note assms(2)
   also have "at x within (A \<inter> {x. \<not> P x}) = inf (nhds x) (principal (A \<inter> {x. \<not> P x} - {x}))"
     by (simp add: at_within_def)
   also have "A \<inter> {x. \<not> P x} - {x} = (A - {x}) \<inter> {x. \<not> P x}"
     by blast
   also have "inf (nhds x) (principal \<dots>) = inf (at x within A) (principal {x. \<not> P x})"
     by (simp add: at_within_def inf_assoc)
   finally show "filterlim g G (inf (at x within A) (principal {x. \<not> P x}))" .
 qed
 
 lemma (in topological_space) filterlim_at_If:
   assumes "filterlim f G (at x within {x. P x})"
     and "filterlim g G (at x within {x. \<not>P x})"
   shows "filterlim (\<lambda>x. if P x then f x else g x) G (at x)"
   using assms by (intro filterlim_at_within_If) simp_all
 lemma (in linorder_topology) at_within_order:
   assumes "UNIV \<noteq> {x}"
   shows "at x within s =
     inf (INF a\<in>{x <..}. principal ({..< a} \<inter> s - {x}))
         (INF a\<in>{..< x}. principal ({a <..} \<inter> s - {x}))"
 proof (cases "{x <..} = {}" "{..< x} = {}" rule: case_split [case_product case_split])
   case True_True
   have "UNIV = {..< x} \<union> {x} \<union> {x <..}"
     by auto
   with assms True_True show ?thesis
     by auto
 qed (auto simp del: inf_principal simp: at_within_def nhds_order Int_Diff
       inf_principal[symmetric] INF_inf_const2 inf_sup_aci[where 'a="'a filter"])
 
 lemma (in linorder_topology) at_left_eq:
   "y < x \<Longrightarrow> at_left x = (INF a\<in>{..< x}. principal {a <..< x})"
   by (subst at_within_order)
      (auto simp: greaterThan_Int_greaterThan greaterThanLessThan_eq[symmetric] min.absorb2 INF_constant
            intro!: INF_lower2 inf_absorb2)
 
 lemma (in linorder_topology) eventually_at_left:
   "y < x \<Longrightarrow> eventually P (at_left x) \<longleftrightarrow> (\<exists>b<x. \<forall>y>b. y < x \<longrightarrow> P y)"
   unfolding at_left_eq
   by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def)
 
 lemma (in linorder_topology) at_right_eq:
   "x < y \<Longrightarrow> at_right x = (INF a\<in>{x <..}. principal {x <..< a})"
   by (subst at_within_order)
      (auto simp: lessThan_Int_lessThan greaterThanLessThan_eq[symmetric] max.absorb2 INF_constant Int_commute
            intro!: INF_lower2 inf_absorb1)
 
 lemma (in linorder_topology) eventually_at_right:
   "x < y \<Longrightarrow> eventually P (at_right x) \<longleftrightarrow> (\<exists>b>x. \<forall>y>x. y < b \<longrightarrow> P y)"
   unfolding at_right_eq
   by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def)
 
 lemma eventually_at_right_less: "\<forall>\<^sub>F y in at_right (x::'a::{linorder_topology, no_top}). x < y"
   using gt_ex[of x] eventually_at_right[of x] by auto
 
 lemma trivial_limit_at_right_top: "at_right (top::_::{order_top,linorder_topology}) = bot"
   by (auto simp: filter_eq_iff eventually_at_topological)
 
 lemma trivial_limit_at_left_bot: "at_left (bot::_::{order_bot,linorder_topology}) = bot"
   by (auto simp: filter_eq_iff eventually_at_topological)
 
 lemma trivial_limit_at_left_real [simp]: "\<not> trivial_limit (at_left x)"
   for x :: "'a::{no_bot,dense_order,linorder_topology}"
   using lt_ex [of x]
   by safe (auto simp add: trivial_limit_def eventually_at_left dest: dense)
 
 lemma trivial_limit_at_right_real [simp]: "\<not> trivial_limit (at_right x)"
   for x :: "'a::{no_top,dense_order,linorder_topology}"
   using gt_ex[of x]
   by safe (auto simp add: trivial_limit_def eventually_at_right dest: dense)
 
 lemma (in linorder_topology) at_eq_sup_left_right: "at x = sup (at_left x) (at_right x)"
   by (auto simp: eventually_at_filter filter_eq_iff eventually_sup
       elim: eventually_elim2 eventually_mono)
 
 lemma (in linorder_topology) eventually_at_split:
   "eventually P (at x) \<longleftrightarrow> eventually P (at_left x) \<and> eventually P (at_right x)"
   by (subst at_eq_sup_left_right) (simp add: eventually_sup)
 
 lemma (in order_topology) eventually_at_leftI:
   assumes "\<And>x. x \<in> {a<..<b} \<Longrightarrow> P x" "a < b"
   shows   "eventually P (at_left b)"
   using assms unfolding eventually_at_topological by (intro exI[of _ "{a<..}"]) auto
 
 lemma (in order_topology) eventually_at_rightI:
   assumes "\<And>x. x \<in> {a<..<b} \<Longrightarrow> P x" "a < b"
   shows   "eventually P (at_right a)"
   using assms unfolding eventually_at_topological by (intro exI[of _ "{..<b}"]) auto
 
 lemma eventually_filtercomap_nhds:
   "eventually P (filtercomap f (nhds x)) \<longleftrightarrow> (\<exists>S. open S \<and> x \<in> S \<and> (\<forall>x. f x \<in> S \<longrightarrow> P x))"
   unfolding eventually_filtercomap eventually_nhds by auto
 
 lemma eventually_filtercomap_at_topological:
   "eventually P (filtercomap f (at A within B)) \<longleftrightarrow> 
      (\<exists>S. open S \<and> A \<in> S \<and> (\<forall>x. f x \<in> S \<inter> B - {A} \<longrightarrow> P x))" (is "?lhs = ?rhs")
   unfolding at_within_def filtercomap_inf eventually_inf_principal filtercomap_principal 
           eventually_filtercomap_nhds eventually_principal by blast
 
 lemma eventually_at_right_field:
   "eventually P (at_right x) \<longleftrightarrow> (\<exists>b>x. \<forall>y>x. y < b \<longrightarrow> P y)"
   for x :: "'a::{linordered_field, linorder_topology}"
   using linordered_field_no_ub[rule_format, of x]
   by (auto simp: eventually_at_right)
 
 lemma eventually_at_left_field:
   "eventually P (at_left x) \<longleftrightarrow> (\<exists>b<x. \<forall>y>b. y < x \<longrightarrow> P y)"
   for x :: "'a::{linordered_field, linorder_topology}"
   using linordered_field_no_lb[rule_format, of x]
   by (auto simp: eventually_at_left)
 
 lemma filtermap_nhds_eq_imp_filtermap_at_eq: 
   assumes "filtermap f (nhds z) = nhds (f z)"
   assumes "eventually (\<lambda>x. f x = f z \<longrightarrow> x = z) (at z)"
   shows   "filtermap f (at z) = at (f z)"
 proof (rule filter_eqI)
   fix P :: "'a \<Rightarrow> bool"
   have "eventually P (filtermap f (at z)) \<longleftrightarrow> (\<forall>\<^sub>F x in nhds z. x \<noteq> z \<longrightarrow> P (f x))"
     by (simp add: eventually_filtermap eventually_at_filter)
   also have "\<dots> \<longleftrightarrow> (\<forall>\<^sub>F x in nhds z. f x \<noteq> f z \<longrightarrow> P (f x))"
     by (rule eventually_cong [OF assms(2)[unfolded eventually_at_filter]]) auto
   also have "\<dots> \<longleftrightarrow> (\<forall>\<^sub>F x in filtermap f (nhds z). x \<noteq> f z \<longrightarrow> P x)"
     by (simp add: eventually_filtermap)
   also have "filtermap f (nhds z) = nhds (f z)"
     by (rule assms)
   also have "(\<forall>\<^sub>F x in nhds (f z). x \<noteq> f z \<longrightarrow> P x) \<longleftrightarrow> (\<forall>\<^sub>F x in at (f z). P x)"
     by (simp add: eventually_at_filter)
   finally show "eventually P (filtermap f (at z)) = eventually P (at (f z))" .
 qed
 
 subsubsection \<open>Tendsto\<close>
 
 abbreviation (in topological_space)
   tendsto :: "('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b filter \<Rightarrow> bool"  (infixr "\<longlongrightarrow>" 55)
   where "(f \<longlongrightarrow> l) F \<equiv> filterlim f (nhds l) F"
 
 definition (in t2_space) Lim :: "'f filter \<Rightarrow> ('f \<Rightarrow> 'a) \<Rightarrow> 'a"
   where "Lim A f = (THE l. (f \<longlongrightarrow> l) A)"
 
 lemma (in topological_space) tendsto_eq_rhs: "(f \<longlongrightarrow> x) F \<Longrightarrow> x = y \<Longrightarrow> (f \<longlongrightarrow> y) F"
   by simp
 
 named_theorems tendsto_intros "introduction rules for tendsto"
 setup \<open>
   Global_Theory.add_thms_dynamic (\<^binding>\<open>tendsto_eq_intros\<close>,
     fn context =>
       Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>tendsto_intros\<close>
       |> map_filter (try (fn thm => @{thm tendsto_eq_rhs} OF [thm])))
 \<close>
 
 context topological_space begin
 
 lemma tendsto_def:
    "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>S. open S \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) F)"
    unfolding nhds_def filterlim_INF filterlim_principal by auto
 
 lemma tendsto_cong: "(f \<longlongrightarrow> c) F \<longleftrightarrow> (g \<longlongrightarrow> c) F" if "eventually (\<lambda>x. f x = g x) F"
   by (rule filterlim_cong [OF refl refl that])
 
 lemma tendsto_mono: "F \<le> F' \<Longrightarrow> (f \<longlongrightarrow> l) F' \<Longrightarrow> (f \<longlongrightarrow> l) F"
   unfolding tendsto_def le_filter_def by fast
 
 lemma tendsto_ident_at [tendsto_intros, simp, intro]: "((\<lambda>x. x) \<longlongrightarrow> a) (at a within s)"
   by (auto simp: tendsto_def eventually_at_topological)
 
 lemma tendsto_const [tendsto_intros, simp, intro]: "((\<lambda>x. k) \<longlongrightarrow> k) F"
   by (simp add: tendsto_def)
 
 lemma filterlim_at:
   "(LIM x F. f x :> at b within s) \<longleftrightarrow> eventually (\<lambda>x. f x \<in> s \<and> f x \<noteq> b) F \<and> (f \<longlongrightarrow> b) F"
   by (simp add: at_within_def filterlim_inf filterlim_principal conj_commute)
 
 lemma (in -)
   assumes "filterlim f (nhds L) F"
   shows tendsto_imp_filterlim_at_right:
           "eventually (\<lambda>x. f x > L) F \<Longrightarrow> filterlim f (at_right L) F"
     and tendsto_imp_filterlim_at_left:
           "eventually (\<lambda>x. f x < L) F \<Longrightarrow> filterlim f (at_left L) F"
   using assms by (auto simp: filterlim_at elim: eventually_mono)
 
 lemma  filterlim_at_withinI:
   assumes "filterlim f (nhds c) F"
   assumes "eventually (\<lambda>x. f x \<in> A - {c}) F"
   shows   "filterlim f (at c within A) F"
   using assms by (simp add: filterlim_at)
 
 lemma filterlim_atI:
   assumes "filterlim f (nhds c) F"
   assumes "eventually (\<lambda>x. f x \<noteq> c) F"
   shows   "filterlim f (at c) F"
   using assms by (intro filterlim_at_withinI) simp_all
 
 lemma topological_tendstoI:
   "(\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) F) \<Longrightarrow> (f \<longlongrightarrow> l) F"
   by (auto simp: tendsto_def)
 
 lemma topological_tendstoD:
   "(f \<longlongrightarrow> l) F \<Longrightarrow> open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) F"
   by (auto simp: tendsto_def)
 
 lemma tendsto_bot [simp]: "(f \<longlongrightarrow> a) bot"
   by (simp add: tendsto_def)
 
 lemma tendsto_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> ((\<lambda>x. f x) \<longlongrightarrow> l) net"
   by (rule topological_tendstoI) (auto elim: eventually_mono)
 
 (* Contributed by Dominique Unruh *)
 lemma tendsto_principal_singleton[simp]:
   shows "(f \<longlongrightarrow> f x) (principal {x})"
   unfolding tendsto_def eventually_principal by simp
 
 end
 
 lemma (in topological_space) filterlim_within_subset:
   "filterlim f l (at x within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> filterlim f l (at x within T)"
   by (blast intro: filterlim_mono at_le)
 
 lemmas tendsto_within_subset = filterlim_within_subset
 
 lemma (in order_topology) order_tendsto_iff:
   "(f \<longlongrightarrow> x) F \<longleftrightarrow> (\<forall>l<x. eventually (\<lambda>x. l < f x) F) \<and> (\<forall>u>x. eventually (\<lambda>x. f x < u) F)"
   by (auto simp: nhds_order filterlim_inf filterlim_INF filterlim_principal)
 
 lemma (in order_topology) order_tendstoI:
   "(\<And>a. a < y \<Longrightarrow> eventually (\<lambda>x. a < f x) F) \<Longrightarrow> (\<And>a. y < a \<Longrightarrow> eventually (\<lambda>x. f x < a) F) \<Longrightarrow>
     (f \<longlongrightarrow> y) F"
   by (auto simp: order_tendsto_iff)
 
 lemma (in order_topology) order_tendstoD:
   assumes "(f \<longlongrightarrow> y) F"
   shows "a < y \<Longrightarrow> eventually (\<lambda>x. a < f x) F"
     and "y < a \<Longrightarrow> eventually (\<lambda>x. f x < a) F"
   using assms by (auto simp: order_tendsto_iff)
 
 lemma (in linorder_topology) tendsto_max[tendsto_intros]:
   assumes X: "(X \<longlongrightarrow> x) net"
     and Y: "(Y \<longlongrightarrow> y) net"
   shows "((\<lambda>x. max (X x) (Y x)) \<longlongrightarrow> max x y) net"
 proof (rule order_tendstoI)
   fix a
   assume "a < max x y"
   then show "eventually (\<lambda>x. a < max (X x) (Y x)) net"
     using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a]
     by (auto simp: less_max_iff_disj elim: eventually_mono)
 next
   fix a
   assume "max x y < a"
   then show "eventually (\<lambda>x. max (X x) (Y x) < a) net"
     using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a]
     by (auto simp: eventually_conj_iff)
 qed
 
 lemma (in linorder_topology) tendsto_min[tendsto_intros]:
   assumes X: "(X \<longlongrightarrow> x) net"
     and Y: "(Y \<longlongrightarrow> y) net"
   shows "((\<lambda>x. min (X x) (Y x)) \<longlongrightarrow> min x y) net"
 proof (rule order_tendstoI)
   fix a
   assume "a < min x y"
   then show "eventually (\<lambda>x. a < min (X x) (Y x)) net"
     using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a]
     by (auto simp: eventually_conj_iff)
 next
   fix a
   assume "min x y < a"
   then show "eventually (\<lambda>x. min (X x) (Y x) < a) net"
     using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a]
     by (auto simp: min_less_iff_disj elim: eventually_mono)
 qed
 
 lemma (in order_topology)
   assumes "a < b"
   shows at_within_Icc_at_right: "at a within {a..b} = at_right a"
     and at_within_Icc_at_left:  "at b within {a..b} = at_left b"
   using order_tendstoD(2)[OF tendsto_ident_at assms, of "{a<..}"]
   using order_tendstoD(1)[OF tendsto_ident_at assms, of "{..<b}"]
   by (auto intro!: order_class.order_antisym filter_leI
       simp: eventually_at_filter less_le
       elim: eventually_elim2)
 
 lemma (in order_topology) at_within_Icc_at: "a < x \<Longrightarrow> x < b \<Longrightarrow> at x within {a..b} = at x"
   by (rule at_within_open_subset[where S="{a<..<b}"]) auto
 
 lemma (in t2_space) tendsto_unique:
   assumes "F \<noteq> bot"
     and "(f \<longlongrightarrow> a) F"
     and "(f \<longlongrightarrow> b) F"
   shows "a = b"
 proof (rule ccontr)
   assume "a \<noteq> b"
   obtain U V where "open U" "open V" "a \<in> U" "b \<in> V" "U \<inter> V = {}"
     using hausdorff [OF \<open>a \<noteq> b\<close>] by fast
   have "eventually (\<lambda>x. f x \<in> U) F"
     using \<open>(f \<longlongrightarrow> a) F\<close> \<open>open U\<close> \<open>a \<in> U\<close> by (rule topological_tendstoD)
   moreover
   have "eventually (\<lambda>x. f x \<in> V) F"
     using \<open>(f \<longlongrightarrow> b) F\<close> \<open>open V\<close> \<open>b \<in> V\<close> by (rule topological_tendstoD)
   ultimately
   have "eventually (\<lambda>x. False) F"
   proof eventually_elim
     case (elim x)
     then have "f x \<in> U \<inter> V" by simp
     with \<open>U \<inter> V = {}\<close> show ?case by simp
   qed
   with \<open>\<not> trivial_limit F\<close> show "False"
     by (simp add: trivial_limit_def)
 qed
 
 lemma (in t2_space) tendsto_const_iff:
   fixes a b :: 'a
   assumes "\<not> trivial_limit F"
   shows "((\<lambda>x. a) \<longlongrightarrow> b) F \<longleftrightarrow> a = b"
   by (auto intro!: tendsto_unique [OF assms tendsto_const])
 
 lemma (in t2_space) tendsto_unique':
  assumes "F \<noteq> bot"
  shows "\<exists>\<^sub>\<le>\<^sub>1l. (f \<longlongrightarrow> l) F"
  using Uniq_def assms local.tendsto_unique by fastforce
 
 lemma Lim_in_closed_set:
   assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) F" "F \<noteq> bot" "(f \<longlongrightarrow> l) F"
   shows "l \<in> S"
 proof (rule ccontr)
   assume "l \<notin> S"
   with \<open>closed S\<close> have "open (- S)" "l \<in> - S"
     by (simp_all add: open_Compl)
   with assms(4) have "eventually (\<lambda>x. f x \<in> - S) F"
     by (rule topological_tendstoD)
   with assms(2) have "eventually (\<lambda>x. False) F"
     by (rule eventually_elim2) simp
   with assms(3) show "False"
     by (simp add: eventually_False)
 qed
 
 lemma (in t3_space) nhds_closed:
   assumes "x \<in> A" and "open A"
   shows   "\<exists>A'. x \<in> A' \<and> closed A' \<and> A' \<subseteq> A \<and> eventually (\<lambda>y. y \<in> A') (nhds x)"
 proof -
   from assms have "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> - A \<subseteq> V \<and> U \<inter> V = {}"
     by (intro t3_space) auto
   then obtain U V where UV: "open U" "open V" "x \<in> U" "-A \<subseteq> V" "U \<inter> V = {}"
     by auto
   have "eventually (\<lambda>y. y \<in> U) (nhds x)"
     using \<open>open U\<close> and \<open>x \<in> U\<close> by (intro eventually_nhds_in_open)
   hence "eventually (\<lambda>y. y \<in> -V) (nhds x)"
     by eventually_elim (use UV in auto)
   with UV show ?thesis by (intro exI[of _ "-V"]) auto
 qed
 
 lemma (in order_topology) increasing_tendsto:
   assumes bdd: "eventually (\<lambda>n. f n \<le> l) F"
     and en: "\<And>x. x < l \<Longrightarrow> eventually (\<lambda>n. x < f n) F"
   shows "(f \<longlongrightarrow> l) F"
   using assms by (intro order_tendstoI) (auto elim!: eventually_mono)
 
 lemma (in order_topology) decreasing_tendsto:
   assumes bdd: "eventually (\<lambda>n. l \<le> f n) F"
     and en: "\<And>x. l < x \<Longrightarrow> eventually (\<lambda>n. f n < x) F"
   shows "(f \<longlongrightarrow> l) F"
   using assms by (intro order_tendstoI) (auto elim!: eventually_mono)
 
 lemma (in order_topology) tendsto_sandwich:
   assumes ev: "eventually (\<lambda>n. f n \<le> g n) net" "eventually (\<lambda>n. g n \<le> h n) net"
   assumes lim: "(f \<longlongrightarrow> c) net" "(h \<longlongrightarrow> c) net"
   shows "(g \<longlongrightarrow> c) net"
 proof (rule order_tendstoI)
   fix a
   show "a < c \<Longrightarrow> eventually (\<lambda>x. a < g x) net"
     using order_tendstoD[OF lim(1), of a] ev by (auto elim: eventually_elim2)
 next
   fix a
   show "c < a \<Longrightarrow> eventually (\<lambda>x. g x < a) net"
     using order_tendstoD[OF lim(2), of a] ev by (auto elim: eventually_elim2)
 qed
 
 lemma (in t1_space) limit_frequently_eq:
   assumes "F \<noteq> bot"
     and "frequently (\<lambda>x. f x = c) F"
     and "(f \<longlongrightarrow> d) F"
   shows "d = c"
 proof (rule ccontr)
   assume "d \<noteq> c"
   from t1_space[OF this] obtain U where "open U" "d \<in> U" "c \<notin> U"
     by blast
   with assms have "eventually (\<lambda>x. f x \<in> U) F"
     unfolding tendsto_def by blast
   then have "eventually (\<lambda>x. f x \<noteq> c) F"
     by eventually_elim (insert \<open>c \<notin> U\<close>, blast)
   with assms(2) show False
     unfolding frequently_def by contradiction
 qed
 
 lemma (in t1_space) tendsto_imp_eventually_ne:
   assumes  "(f \<longlongrightarrow> c) F" "c \<noteq> c'"
   shows "eventually (\<lambda>z. f z \<noteq> c') F"
 proof (cases "F=bot")
   case True
   thus ?thesis by auto
 next
   case False
   show ?thesis
   proof (rule ccontr)
     assume "\<not> eventually (\<lambda>z. f z \<noteq> c') F"
     then have "frequently (\<lambda>z. f z = c') F"
       by (simp add: frequently_def)
     from limit_frequently_eq[OF False this \<open>(f \<longlongrightarrow> c) F\<close>] and \<open>c \<noteq> c'\<close> show False
       by contradiction
   qed
 qed
 
 lemma (in linorder_topology) tendsto_le:
   assumes F: "\<not> trivial_limit F"
     and x: "(f \<longlongrightarrow> x) F"
     and y: "(g \<longlongrightarrow> y) F"
     and ev: "eventually (\<lambda>x. g x \<le> f x) F"
   shows "y \<le> x"
 proof (rule ccontr)
   assume "\<not> y \<le> x"
   with less_separate[of x y] obtain a b where xy: "x < a" "b < y" "{..<a} \<inter> {b<..} = {}"
     by (auto simp: not_le)
   then have "eventually (\<lambda>x. f x < a) F" "eventually (\<lambda>x. b < g x) F"
     using x y by (auto intro: order_tendstoD)
   with ev have "eventually (\<lambda>x. False) F"
     by eventually_elim (insert xy, fastforce)
   with F show False
     by (simp add: eventually_False)
 qed
 
 lemma (in linorder_topology) tendsto_lowerbound:
   assumes x: "(f \<longlongrightarrow> x) F"
       and ev: "eventually (\<lambda>i. a \<le> f i) F"
       and F: "\<not> trivial_limit F"
   shows "a \<le> x"
   using F x tendsto_const ev by (rule tendsto_le)
 
 lemma (in linorder_topology) tendsto_upperbound:
   assumes x: "(f \<longlongrightarrow> x) F"
       and ev: "eventually (\<lambda>i. a \<ge> f i) F"
       and F: "\<not> trivial_limit F"
   shows "a \<ge> x"
   by (rule tendsto_le [OF F tendsto_const x ev])
 
 lemma filterlim_at_within_not_equal:
   fixes f::"'a \<Rightarrow> 'b::t2_space"
   assumes "filterlim f (at a within s) F"
   shows "eventually (\<lambda>w. f w\<in>s \<and> f w \<noteq>b) F"
 proof (cases "a=b")
   case True
   then show ?thesis using assms by (simp add: filterlim_at)
 next
   case False
   from hausdorff[OF this] obtain U V where UV:"open U" "open V" "a \<in> U" "b \<in> V" "U \<inter> V = {}"
     by auto  
   have "(f \<longlongrightarrow> a) F" using assms filterlim_at by auto
   then have "\<forall>\<^sub>F x in F. f x \<in> U" using UV unfolding tendsto_def by auto
   moreover have  "\<forall>\<^sub>F x in F. f x \<in> s \<and> f x\<noteq>a" using assms filterlim_at by auto
   ultimately show ?thesis 
     apply eventually_elim
     using UV by auto
 qed
 
 subsubsection \<open>Rules about \<^const>\<open>Lim\<close>\<close>
 
 lemma tendsto_Lim: "\<not> trivial_limit net \<Longrightarrow> (f \<longlongrightarrow> l) net \<Longrightarrow> Lim net f = l"
   unfolding Lim_def using tendsto_unique [of net f] by auto
 
 lemma Lim_ident_at: "\<not> trivial_limit (at x within s) \<Longrightarrow> Lim (at x within s) (\<lambda>x. x) = x"
   by (rule tendsto_Lim[OF _ tendsto_ident_at]) auto
 
 lemma Lim_cong:
   assumes "eventually (\<lambda>x. f x = g x) F" "F = G"
   shows   "Lim F f = Lim G g"
 proof (cases "(\<exists>c. (f \<longlongrightarrow> c) F) \<and> F \<noteq> bot")
   case True
   then obtain c where c: "(f \<longlongrightarrow> c) F"
     by blast
   hence "Lim F f = c"
     using True by (intro tendsto_Lim) auto
   moreover have "(f \<longlongrightarrow> c) F \<longleftrightarrow> (g \<longlongrightarrow> c) G"
     using assms by (intro filterlim_cong) auto
   with True c assms have "Lim G g = c"
     by (intro tendsto_Lim) auto
   ultimately show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof (cases "F = bot")
     case True
     thus ?thesis using assms
       by (auto simp: Topological_Spaces.Lim_def)
   next
     case False
     have "(f \<longlongrightarrow> c) F \<longleftrightarrow> (g \<longlongrightarrow> c) G" for c
       using assms by (intro filterlim_cong) auto
     thus ?thesis
       by (auto simp: Topological_Spaces.Lim_def)
   qed
 qed
 
 lemma eventually_Lim_ident_at:
   "(\<forall>\<^sub>F y in at x within X. P (Lim (at x within X) (\<lambda>x. x)) y) \<longleftrightarrow>
     (\<forall>\<^sub>F y in at x within X. P x y)" for x::"'a::t2_space"
   by (cases "at x within X = bot") (auto simp: Lim_ident_at)
 
 lemma filterlim_at_bot_at_right:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::linorder"
   assumes mono: "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
     and bij: "\<And>x. P x \<Longrightarrow> f (g x) = x" "\<And>x. P x \<Longrightarrow> Q (g x)"
     and Q: "eventually Q (at_right a)"
     and bound: "\<And>b. Q b \<Longrightarrow> a < b"
     and P: "eventually P at_bot"
   shows "filterlim f at_bot (at_right a)"
 proof -
   from P obtain x where x: "\<And>y. y \<le> x \<Longrightarrow> P y"
     unfolding eventually_at_bot_linorder by auto
   show ?thesis
   proof (intro filterlim_at_bot_le[THEN iffD2] allI impI)
     fix z
     assume "z \<le> x"
     with x have "P z" by auto
     have "eventually (\<lambda>x. x \<le> g z) (at_right a)"
       using bound[OF bij(2)[OF \<open>P z\<close>]]
       unfolding eventually_at_right[OF bound[OF bij(2)[OF \<open>P z\<close>]]]
       by (auto intro!: exI[of _ "g z"])
     with Q show "eventually (\<lambda>x. f x \<le> z) (at_right a)"
       by eventually_elim (metis bij \<open>P z\<close> mono)
   qed
 qed
 
 lemma filterlim_at_top_at_left:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::linorder"
   assumes mono: "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
     and bij: "\<And>x. P x \<Longrightarrow> f (g x) = x" "\<And>x. P x \<Longrightarrow> Q (g x)"
     and Q: "eventually Q (at_left a)"
     and bound: "\<And>b. Q b \<Longrightarrow> b < a"
     and P: "eventually P at_top"
   shows "filterlim f at_top (at_left a)"
 proof -
   from P obtain x where x: "\<And>y. x \<le> y \<Longrightarrow> P y"
     unfolding eventually_at_top_linorder by auto
   show ?thesis
   proof (intro filterlim_at_top_ge[THEN iffD2] allI impI)
     fix z
     assume "x \<le> z"
     with x have "P z" by auto
     have "eventually (\<lambda>x. g z \<le> x) (at_left a)"
       using bound[OF bij(2)[OF \<open>P z\<close>]]
       unfolding eventually_at_left[OF bound[OF bij(2)[OF \<open>P z\<close>]]]
       by (auto intro!: exI[of _ "g z"])
     with Q show "eventually (\<lambda>x. z \<le> f x) (at_left a)"
       by eventually_elim (metis bij \<open>P z\<close> mono)
   qed
 qed
 
 lemma filterlim_split_at:
   "filterlim f F (at_left x) \<Longrightarrow> filterlim f F (at_right x) \<Longrightarrow>
     filterlim f F (at x)"
   for x :: "'a::linorder_topology"
   by (subst at_eq_sup_left_right) (rule filterlim_sup)
 
 lemma filterlim_at_split:
   "filterlim f F (at x) \<longleftrightarrow> filterlim f F (at_left x) \<and> filterlim f F (at_right x)"
   for x :: "'a::linorder_topology"
   by (subst at_eq_sup_left_right) (simp add: filterlim_def filtermap_sup)
 
 lemma eventually_nhds_top:
   fixes P :: "'a :: {order_top,linorder_topology} \<Rightarrow> bool"
     and b :: 'a
   assumes "b < top"
   shows "eventually P (nhds top) \<longleftrightarrow> (\<exists>b<top. (\<forall>z. b < z \<longrightarrow> P z))"
   unfolding eventually_nhds
 proof safe
   fix S :: "'a set"
   assume "open S" "top \<in> S"
   note open_left[OF this \<open>b < top\<close>]
   moreover assume "\<forall>s\<in>S. P s"
   ultimately show "\<exists>b<top. \<forall>z>b. P z"
     by (auto simp: subset_eq Ball_def)
 next
   fix b
   assume "b < top" "\<forall>z>b. P z"
   then show "\<exists>S. open S \<and> top \<in> S \<and> (\<forall>xa\<in>S. P xa)"
     by (intro exI[of _ "{b <..}"]) auto
 qed
 
 lemma tendsto_at_within_iff_tendsto_nhds:
   "(g \<longlongrightarrow> g l) (at l within S) \<longleftrightarrow> (g \<longlongrightarrow> g l) (inf (nhds l) (principal S))"
   unfolding tendsto_def eventually_at_filter eventually_inf_principal
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 
 subsection \<open>Limits on sequences\<close>
 
 abbreviation (in topological_space)
   LIMSEQ :: "[nat \<Rightarrow> 'a, 'a] \<Rightarrow> bool"  ("((_)/ \<longlonglongrightarrow> (_))" [60, 60] 60)
   where "X \<longlonglongrightarrow> L \<equiv> (X \<longlongrightarrow> L) sequentially"
 
 abbreviation (in t2_space) lim :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a"
   where "lim X \<equiv> Lim sequentially X"
 
 definition (in topological_space) convergent :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where "convergent X = (\<exists>L. X \<longlonglongrightarrow> L)"
 
 lemma lim_def: "lim X = (THE L. X \<longlonglongrightarrow> L)"
   unfolding Lim_def ..
 
 lemma lim_explicit:
   "f \<longlonglongrightarrow> f0 \<longleftrightarrow> (\<forall>S. open S \<longrightarrow> f0 \<in> S \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. f n \<in> S))"
   unfolding tendsto_def eventually_sequentially by auto
 
 
 subsection \<open>Monotone sequences and subsequences\<close>
 
 text \<open>
   Definition of monotonicity.
   The use of disjunction here complicates proofs considerably.
   One alternative is to add a Boolean argument to indicate the direction.
   Another is to develop the notions of increasing and decreasing first.
 \<close>
 definition monoseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "monoseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X m \<le> X n) \<or> (\<forall>m. \<forall>n\<ge>m. X n \<le> X m)"
 
 abbreviation incseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "incseq X \<equiv> mono X"
 
 lemma incseq_def: "incseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X n \<ge> X m)"
   unfolding mono_def ..
 
 abbreviation decseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "decseq X \<equiv> antimono X"
 
 lemma decseq_def: "decseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X n \<le> X m)"
   unfolding antimono_def ..
 
 subsubsection \<open>Definition of subsequence.\<close>
 
 (* For compatibility with the old "subseq" *)
 lemma strict_mono_leD: "strict_mono r \<Longrightarrow> m \<le> n \<Longrightarrow> r m \<le> r n"
   by (erule (1) monoD [OF strict_mono_mono])
 
 lemma strict_mono_id: "strict_mono id"
   by (simp add: strict_mono_def)
 
 lemma incseq_SucI: "(\<And>n. X n \<le> X (Suc n)) \<Longrightarrow> incseq X"
   using lift_Suc_mono_le[of X] by (auto simp: incseq_def)
 
 lemma incseqD: "incseq f \<Longrightarrow> i \<le> j \<Longrightarrow> f i \<le> f j"
   by (auto simp: incseq_def)
 
 lemma incseq_SucD: "incseq A \<Longrightarrow> A i \<le> A (Suc i)"
   using incseqD[of A i "Suc i"] by auto
 
 lemma incseq_Suc_iff: "incseq f \<longleftrightarrow> (\<forall>n. f n \<le> f (Suc n))"
   by (auto intro: incseq_SucI dest: incseq_SucD)
 
 lemma incseq_const[simp, intro]: "incseq (\<lambda>x. k)"
   unfolding incseq_def by auto
 
 lemma decseq_SucI: "(\<And>n. X (Suc n) \<le> X n) \<Longrightarrow> decseq X"
   using order.lift_Suc_mono_le[OF dual_order, of X] by (auto simp: decseq_def)
 
 lemma decseqD: "decseq f \<Longrightarrow> i \<le> j \<Longrightarrow> f j \<le> f i"
   by (auto simp: decseq_def)
 
 lemma decseq_SucD: "decseq A \<Longrightarrow> A (Suc i) \<le> A i"
   using decseqD[of A i "Suc i"] by auto
 
 lemma decseq_Suc_iff: "decseq f \<longleftrightarrow> (\<forall>n. f (Suc n) \<le> f n)"
   by (auto intro: decseq_SucI dest: decseq_SucD)
 
 lemma decseq_const[simp, intro]: "decseq (\<lambda>x. k)"
   unfolding decseq_def by auto
 
 lemma monoseq_iff: "monoseq X \<longleftrightarrow> incseq X \<or> decseq X"
   unfolding monoseq_def incseq_def decseq_def ..
 
 lemma monoseq_Suc: "monoseq X \<longleftrightarrow> (\<forall>n. X n \<le> X (Suc n)) \<or> (\<forall>n. X (Suc n) \<le> X n)"
   unfolding monoseq_iff incseq_Suc_iff decseq_Suc_iff ..
 
 lemma monoI1: "\<forall>m. \<forall>n \<ge> m. X m \<le> X n \<Longrightarrow> monoseq X"
   by (simp add: monoseq_def)
 
 lemma monoI2: "\<forall>m. \<forall>n \<ge> m. X n \<le> X m \<Longrightarrow> monoseq X"
   by (simp add: monoseq_def)
 
 lemma mono_SucI1: "\<forall>n. X n \<le> X (Suc n) \<Longrightarrow> monoseq X"
   by (simp add: monoseq_Suc)
 
 lemma mono_SucI2: "\<forall>n. X (Suc n) \<le> X n \<Longrightarrow> monoseq X"
   by (simp add: monoseq_Suc)
 
 lemma monoseq_minus:
   fixes a :: "nat \<Rightarrow> 'a::ordered_ab_group_add"
   assumes "monoseq a"
   shows "monoseq (\<lambda> n. - a n)"
 proof (cases "\<forall>m. \<forall>n \<ge> m. a m \<le> a n")
   case True
   then have "\<forall>m. \<forall>n \<ge> m. - a n \<le> - a m" by auto
   then show ?thesis by (rule monoI2)
 next
   case False
   then have "\<forall>m. \<forall>n \<ge> m. - a m \<le> - a n"
     using \<open>monoseq a\<close>[unfolded monoseq_def] by auto
   then show ?thesis by (rule monoI1)
 qed
 
 
 subsubsection \<open>Subsequence (alternative definition, (e.g. Hoskins)\<close>
 
-lemma strict_mono_Suc_iff: "strict_mono f \<longleftrightarrow> (\<forall>n. f n < f (Suc n))"
-proof (intro iffI strict_monoI)
-  assume *: "\<forall>n. f n < f (Suc n)"
-  fix m n :: nat assume "m < n"
-  thus "f m < f n"
-    by (induction rule: less_Suc_induct) (use * in auto)
-qed (auto simp: strict_mono_def)
-
-lemma strict_mono_add: "strict_mono (\<lambda>n::'a::linordered_semidom. n + k)"
-  by (auto simp: strict_mono_def)
-
 text \<open>For any sequence, there is a monotonic subsequence.\<close>
 lemma seq_monosub:
   fixes s :: "nat \<Rightarrow> 'a::linorder"
   shows "\<exists>f. strict_mono f \<and> monoseq (\<lambda>n. (s (f n)))"
 proof (cases "\<forall>n. \<exists>p>n. \<forall>m\<ge>p. s m \<le> s p")
   case True
   then have "\<exists>f. \<forall>n. (\<forall>m\<ge>f n. s m \<le> s (f n)) \<and> f n < f (Suc n)"
     by (intro dependent_nat_choice) (auto simp: conj_commute)
   then obtain f :: "nat \<Rightarrow> nat" 
     where f: "strict_mono f" and mono: "\<And>n m. f n \<le> m \<Longrightarrow> s m \<le> s (f n)"
     by (auto simp: strict_mono_Suc_iff)
   then have "incseq f"
     unfolding strict_mono_Suc_iff incseq_Suc_iff by (auto intro: less_imp_le)
   then have "monoseq (\<lambda>n. s (f n))"
     by (auto simp add: incseq_def intro!: mono monoI2)
   with f show ?thesis
     by auto
 next
   case False
   then obtain N where N: "p > N \<Longrightarrow> \<exists>m>p. s p < s m" for p
     by (force simp: not_le le_less)
   have "\<exists>f. \<forall>n. N < f n \<and> f n < f (Suc n) \<and> s (f n) \<le> s (f (Suc n))"
   proof (intro dependent_nat_choice)
     fix x
     assume "N < x" with N[of x]
     show "\<exists>y>N. x < y \<and> s x \<le> s y"
       by (auto intro: less_trans)
   qed auto
   then show ?thesis
     by (auto simp: monoseq_iff incseq_Suc_iff strict_mono_Suc_iff)
 qed
 
 lemma seq_suble:
   assumes sf: "strict_mono (f :: nat \<Rightarrow> nat)"
   shows "n \<le> f n"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case (Suc n)
   with sf [unfolded strict_mono_Suc_iff, rule_format, of n] have "n < f (Suc n)"
      by arith
   then show ?case by arith
 qed
 
 lemma eventually_subseq:
   "strict_mono r \<Longrightarrow> eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
   unfolding eventually_sequentially by (metis seq_suble le_trans)
 
 lemma not_eventually_sequentiallyD:
   assumes "\<not> eventually P sequentially"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (\<forall>n. \<not> P (r n))"
 proof -
   from assms have "\<forall>n. \<exists>m\<ge>n. \<not> P m"
     unfolding eventually_sequentially by (simp add: not_less)
   then obtain r where "\<And>n. r n \<ge> n" "\<And>n. \<not> P (r n)"
     by (auto simp: choice_iff)
   then show ?thesis
     by (auto intro!: exI[of _ "\<lambda>n. r (((Suc \<circ> r) ^^ Suc n) 0)"]
              simp: less_eq_Suc_le strict_mono_Suc_iff)
 qed
 
 lemma sequentially_offset: 
   assumes "eventually (\<lambda>i. P i) sequentially"
   shows "eventually (\<lambda>i. P (i + k)) sequentially"
   using assms by (rule eventually_sequentially_seg [THEN iffD2])
 
 lemma seq_offset_neg: 
   "(f \<longlongrightarrow> l) sequentially \<Longrightarrow> ((\<lambda>i. f(i - k)) \<longlongrightarrow> l) sequentially"
   apply (erule filterlim_compose)
   apply (simp add: filterlim_def le_sequentially eventually_filtermap eventually_sequentially, arith)
   done
 
 lemma filterlim_subseq: "strict_mono f \<Longrightarrow> filterlim f sequentially sequentially"
   unfolding filterlim_iff by (metis eventually_subseq)
 
 lemma strict_mono_o: "strict_mono r \<Longrightarrow> strict_mono s \<Longrightarrow> strict_mono (r \<circ> s)"
   unfolding strict_mono_def by simp
 
 lemma strict_mono_compose: "strict_mono r \<Longrightarrow> strict_mono s \<Longrightarrow> strict_mono (\<lambda>x. r (s x))"
   using strict_mono_o[of r s] by (simp add: o_def)
 
 lemma incseq_imp_monoseq:  "incseq X \<Longrightarrow> monoseq X"
   by (simp add: incseq_def monoseq_def)
 
 lemma decseq_imp_monoseq:  "decseq X \<Longrightarrow> monoseq X"
   by (simp add: decseq_def monoseq_def)
 
 lemma decseq_eq_incseq: "decseq X = incseq (\<lambda>n. - X n)"
   for X :: "nat \<Rightarrow> 'a::ordered_ab_group_add"
   by (simp add: decseq_def incseq_def)
 
 lemma INT_decseq_offset:
   assumes "decseq F"
   shows "(\<Inter>i. F i) = (\<Inter>i\<in>{n..}. F i)"
 proof safe
   fix x i
   assume x: "x \<in> (\<Inter>i\<in>{n..}. F i)"
   show "x \<in> F i"
   proof cases
     from x have "x \<in> F n" by auto
     also assume "i \<le> n" with \<open>decseq F\<close> have "F n \<subseteq> F i"
       unfolding decseq_def by simp
     finally show ?thesis .
   qed (insert x, simp)
 qed auto
 
 lemma LIMSEQ_const_iff: "(\<lambda>n. k) \<longlonglongrightarrow> l \<longleftrightarrow> k = l"
   for k l :: "'a::t2_space"
   using trivial_limit_sequentially by (rule tendsto_const_iff)
 
 lemma LIMSEQ_SUP: "incseq X \<Longrightarrow> X \<longlonglongrightarrow> (SUP i. X i :: 'a::{complete_linorder,linorder_topology})"
   by (intro increasing_tendsto)
     (auto simp: SUP_upper less_SUP_iff incseq_def eventually_sequentially intro: less_le_trans)
 
 lemma LIMSEQ_INF: "decseq X \<Longrightarrow> X \<longlonglongrightarrow> (INF i. X i :: 'a::{complete_linorder,linorder_topology})"
   by (intro decreasing_tendsto)
     (auto simp: INF_lower INF_less_iff decseq_def eventually_sequentially intro: le_less_trans)
 
 lemma LIMSEQ_ignore_initial_segment: "f \<longlonglongrightarrow> a \<Longrightarrow> (\<lambda>n. f (n + k)) \<longlonglongrightarrow> a"
   unfolding tendsto_def by (subst eventually_sequentially_seg[where k=k])
 
 lemma LIMSEQ_offset: "(\<lambda>n. f (n + k)) \<longlonglongrightarrow> a \<Longrightarrow> f \<longlonglongrightarrow> a"
   unfolding tendsto_def
   by (subst (asm) eventually_sequentially_seg[where k=k])
 
 lemma LIMSEQ_Suc: "f \<longlonglongrightarrow> l \<Longrightarrow> (\<lambda>n. f (Suc n)) \<longlonglongrightarrow> l"
   by (drule LIMSEQ_ignore_initial_segment [where k="Suc 0"]) simp
 
 lemma LIMSEQ_imp_Suc: "(\<lambda>n. f (Suc n)) \<longlonglongrightarrow> l \<Longrightarrow> f \<longlonglongrightarrow> l"
   by (rule LIMSEQ_offset [where k="Suc 0"]) simp
 
 lemma LIMSEQ_lessThan_iff_atMost:
   shows "(\<lambda>n. f {..<n}) \<longlonglongrightarrow> x \<longleftrightarrow> (\<lambda>n. f {..n}) \<longlonglongrightarrow> x"
   apply (subst filterlim_sequentially_Suc [symmetric])
   apply (simp only: lessThan_Suc_atMost)
   done
 
 lemma (in t2_space) LIMSEQ_Uniq: "\<exists>\<^sub>\<le>\<^sub>1l. X \<longlonglongrightarrow> l"
  by (simp add: tendsto_unique')
 
 lemma (in t2_space) LIMSEQ_unique: "X \<longlonglongrightarrow> a \<Longrightarrow> X \<longlonglongrightarrow> b \<Longrightarrow> a = b"
   using trivial_limit_sequentially by (rule tendsto_unique)
 
 lemma LIMSEQ_le_const: "X \<longlonglongrightarrow> x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. a \<le> X n \<Longrightarrow> a \<le> x"
   for a x :: "'a::linorder_topology"
   by (simp add: eventually_at_top_linorder tendsto_lowerbound)
 
 lemma LIMSEQ_le: "X \<longlonglongrightarrow> x \<Longrightarrow> Y \<longlonglongrightarrow> y \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. X n \<le> Y n \<Longrightarrow> x \<le> y"
   for x y :: "'a::linorder_topology"
   using tendsto_le[of sequentially Y y X x] by (simp add: eventually_sequentially)
 
 lemma LIMSEQ_le_const2: "X \<longlonglongrightarrow> x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. X n \<le> a \<Longrightarrow> x \<le> a"
   for a x :: "'a::linorder_topology"
   by (rule LIMSEQ_le[of X x "\<lambda>n. a"]) auto
 
 lemma Lim_bounded: "f \<longlonglongrightarrow> l \<Longrightarrow> \<forall>n\<ge>M. f n \<le> C \<Longrightarrow> l \<le> C"
   for l :: "'a::linorder_topology"
   by (intro LIMSEQ_le_const2) auto
 
 lemma Lim_bounded2:
   fixes f :: "nat \<Rightarrow> 'a::linorder_topology"
   assumes lim:"f \<longlonglongrightarrow> l" and ge: "\<forall>n\<ge>N. f n \<ge> C"
   shows "l \<ge> C"
   using ge
   by (intro tendsto_le[OF trivial_limit_sequentially lim tendsto_const])
      (auto simp: eventually_sequentially)
 
 lemma lim_mono:
   fixes X Y :: "nat \<Rightarrow> 'a::linorder_topology"
   assumes "\<And>n. N \<le> n \<Longrightarrow> X n \<le> Y n"
     and "X \<longlonglongrightarrow> x"
     and "Y \<longlonglongrightarrow> y"
   shows "x \<le> y"
   using assms(1) by (intro LIMSEQ_le[OF assms(2,3)]) auto
 
 lemma Sup_lim:
   fixes a :: "'a::{complete_linorder,linorder_topology}"
   assumes "\<And>n. b n \<in> s"
     and "b \<longlonglongrightarrow> a"
   shows "a \<le> Sup s"
   by (metis Lim_bounded assms complete_lattice_class.Sup_upper)
 
 lemma Inf_lim:
   fixes a :: "'a::{complete_linorder,linorder_topology}"
   assumes "\<And>n. b n \<in> s"
     and "b \<longlonglongrightarrow> a"
   shows "Inf s \<le> a"
   by (metis Lim_bounded2 assms complete_lattice_class.Inf_lower)
 
 lemma SUP_Lim:
   fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
   assumes inc: "incseq X"
     and l: "X \<longlonglongrightarrow> l"
   shows "(SUP n. X n) = l"
   using LIMSEQ_SUP[OF inc] tendsto_unique[OF trivial_limit_sequentially l]
   by simp
 
 lemma INF_Lim:
   fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
   assumes dec: "decseq X"
     and l: "X \<longlonglongrightarrow> l"
   shows "(INF n. X n) = l"
   using LIMSEQ_INF[OF dec] tendsto_unique[OF trivial_limit_sequentially l]
   by simp
 
 lemma convergentD: "convergent X \<Longrightarrow> \<exists>L. X \<longlonglongrightarrow> L"
   by (simp add: convergent_def)
 
 lemma convergentI: "X \<longlonglongrightarrow> L \<Longrightarrow> convergent X"
   by (auto simp add: convergent_def)
 
 lemma convergent_LIMSEQ_iff: "convergent X \<longleftrightarrow> X \<longlonglongrightarrow> lim X"
   by (auto intro: theI LIMSEQ_unique simp add: convergent_def lim_def)
 
 lemma convergent_const: "convergent (\<lambda>n. c)"
   by (rule convergentI) (rule tendsto_const)
 
 lemma monoseq_le:
   "monoseq a \<Longrightarrow> a \<longlonglongrightarrow> x \<Longrightarrow>
     (\<forall>n. a n \<le> x) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n) \<or>
     (\<forall>n. x \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)"
   for x :: "'a::linorder_topology"
   by (metis LIMSEQ_le_const LIMSEQ_le_const2 decseq_def incseq_def monoseq_iff)
 
 lemma LIMSEQ_subseq_LIMSEQ: "X \<longlonglongrightarrow> L \<Longrightarrow> strict_mono f \<Longrightarrow> (X \<circ> f) \<longlonglongrightarrow> L"
   unfolding comp_def by (rule filterlim_compose [of X, OF _ filterlim_subseq])
 
 lemma convergent_subseq_convergent: "convergent X \<Longrightarrow> strict_mono f \<Longrightarrow> convergent (X \<circ> f)"
   by (auto simp: convergent_def intro: LIMSEQ_subseq_LIMSEQ)
 
 lemma limI: "X \<longlonglongrightarrow> L \<Longrightarrow> lim X = L"
   by (rule tendsto_Lim) (rule trivial_limit_sequentially)
 
 lemma lim_le: "convergent f \<Longrightarrow> (\<And>n. f n \<le> x) \<Longrightarrow> lim f \<le> x"
   for x :: "'a::linorder_topology"
   using LIMSEQ_le_const2[of f "lim f" x] by (simp add: convergent_LIMSEQ_iff)
 
 lemma lim_const [simp]: "lim (\<lambda>m. a) = a"
   by (simp add: limI)
 
 
 subsubsection \<open>Increasing and Decreasing Series\<close>
 
 lemma incseq_le: "incseq X \<Longrightarrow> X \<longlonglongrightarrow> L \<Longrightarrow> X n \<le> L"
   for L :: "'a::linorder_topology"
   by (metis incseq_def LIMSEQ_le_const)
 
 lemma decseq_ge: "decseq X \<Longrightarrow> X \<longlonglongrightarrow> L \<Longrightarrow> L \<le> X n"
   for L :: "'a::linorder_topology"
   by (metis decseq_def LIMSEQ_le_const2)
 
 
 subsection \<open>First countable topologies\<close>
 
 class first_countable_topology = topological_space +
   assumes first_countable_basis:
     "\<exists>A::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
 
 lemma (in first_countable_topology) countable_basis_at_decseq:
   obtains A :: "nat \<Rightarrow> 'a set" where
     "\<And>i. open (A i)" "\<And>i. x \<in> (A i)"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
 proof atomize_elim
   from first_countable_basis[of x] obtain A :: "nat \<Rightarrow> 'a set"
     where nhds: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
       and incl: "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>i. A i \<subseteq> S"
     by auto
   define F where "F n = (\<Inter>i\<le>n. A i)" for n
   show "\<exists>A. (\<forall>i. open (A i)) \<and> (\<forall>i. x \<in> A i) \<and>
     (\<forall>S. open S \<longrightarrow> x \<in> S \<longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially)"
   proof (safe intro!: exI[of _ F])
     fix i
     show "open (F i)"
       using nhds(1) by (auto simp: F_def)
     show "x \<in> F i"
       using nhds(2) by (auto simp: F_def)
   next
     fix S
     assume "open S" "x \<in> S"
     from incl[OF this] obtain i where "F i \<subseteq> S"
       unfolding F_def by auto
     moreover have "\<And>j. i \<le> j \<Longrightarrow> F j \<subseteq> F i"
       by (simp add: Inf_superset_mono F_def image_mono)
     ultimately show "eventually (\<lambda>i. F i \<subseteq> S) sequentially"
       by (auto simp: eventually_sequentially)
   qed
 qed
 
 lemma (in first_countable_topology) nhds_countable:
   obtains X :: "nat \<Rightarrow> 'a set"
   where "decseq X" "\<And>n. open (X n)" "\<And>n. x \<in> X n" "nhds x = (INF n. principal (X n))"
 proof -
   from first_countable_basis obtain A :: "nat \<Rightarrow> 'a set"
     where *: "\<And>n. x \<in> A n" "\<And>n. open (A n)" "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>i. A i \<subseteq> S"
     by metis
   show thesis
   proof
     show "decseq (\<lambda>n. \<Inter>i\<le>n. A i)"
       by (simp add: antimono_iff_le_Suc atMost_Suc)
     show "x \<in> (\<Inter>i\<le>n. A i)" "\<And>n. open (\<Inter>i\<le>n. A i)" for n
       using * by auto
     with * show "nhds x = (INF n. principal (\<Inter>i\<le>n. A i))"
       unfolding nhds_def
       apply (intro INF_eq)
        apply fastforce
       apply blast
       done
   qed
 qed
 
 lemma (in first_countable_topology) countable_basis:
   obtains A :: "nat \<Rightarrow> 'a set" where
     "\<And>i. open (A i)" "\<And>i. x \<in> A i"
     "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
 proof atomize_elim
   obtain A :: "nat \<Rightarrow> 'a set" where *:
     "\<And>i. open (A i)"
     "\<And>i. x \<in> A i"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
     by (rule countable_basis_at_decseq) blast
   have "eventually (\<lambda>n. F n \<in> S) sequentially"
     if "\<forall>n. F n \<in> A n" "open S" "x \<in> S" for F S
     using *(3)[of S] that by (auto elim: eventually_mono simp: subset_eq)
   with * show "\<exists>A. (\<forall>i. open (A i)) \<and> (\<forall>i. x \<in> A i) \<and> (\<forall>F. (\<forall>n. F n \<in> A n) \<longrightarrow> F \<longlonglongrightarrow> x)"
     by (intro exI[of _ A]) (auto simp: tendsto_def)
 qed
 
 lemma (in first_countable_topology) sequentially_imp_eventually_nhds_within:
   assumes "\<forall>f. (\<forall>n. f n \<in> s) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (inf (nhds a) (principal s))"
 proof (rule ccontr)
   obtain A :: "nat \<Rightarrow> 'a set" where *:
     "\<And>i. open (A i)"
     "\<And>i. a \<in> A i"
     "\<And>F. \<forall>n. F n \<in> A n \<Longrightarrow> F \<longlonglongrightarrow> a"
     by (rule countable_basis) blast
   assume "\<not> ?thesis"
   with * have "\<exists>F. \<forall>n. F n \<in> s \<and> F n \<in> A n \<and> \<not> P (F n)"
     unfolding eventually_inf_principal eventually_nhds
     by (intro choice) fastforce
   then obtain F where F: "\<forall>n. F n \<in> s" and "\<forall>n. F n \<in> A n" and F': "\<forall>n. \<not> P (F n)"
     by blast
   with * have "F \<longlonglongrightarrow> a"
     by auto
   then have "eventually (\<lambda>n. P (F n)) sequentially"
     using assms F by simp
   then show False
     by (simp add: F')
 qed
 
 lemma (in first_countable_topology) eventually_nhds_within_iff_sequentially:
   "eventually P (inf (nhds a) (principal s)) \<longleftrightarrow>
     (\<forall>f. (\<forall>n. f n \<in> s) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially)"
 proof (safe intro!: sequentially_imp_eventually_nhds_within)
   assume "eventually P (inf (nhds a) (principal s))"
   then obtain S where "open S" "a \<in> S" "\<forall>x\<in>S. x \<in> s \<longrightarrow> P x"
     by (auto simp: eventually_inf_principal eventually_nhds)
   moreover
   fix f
   assume "\<forall>n. f n \<in> s" "f \<longlonglongrightarrow> a"
   ultimately show "eventually (\<lambda>n. P (f n)) sequentially"
     by (auto dest!: topological_tendstoD elim: eventually_mono)
 qed
 
 lemma (in first_countable_topology) eventually_nhds_iff_sequentially:
   "eventually P (nhds a) \<longleftrightarrow> (\<forall>f. f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially)"
   using eventually_nhds_within_iff_sequentially[of P a UNIV] by simp
 
 (*Thanks to Sébastien Gouëzel*)
 lemma Inf_as_limit:
   fixes A::"'a::{linorder_topology, first_countable_topology, complete_linorder} set"
   assumes "A \<noteq> {}"
   shows "\<exists>u. (\<forall>n. u n \<in> A) \<and> u \<longlonglongrightarrow> Inf A"
 proof (cases "Inf A \<in> A")
   case True
   show ?thesis
     by (rule exI[of _ "\<lambda>n. Inf A"], auto simp add: True)
 next
   case False
   obtain y where "y \<in> A" using assms by auto
   then have "Inf A < y" using False Inf_lower less_le by auto
   obtain F :: "nat \<Rightarrow> 'a set" where F: "\<And>i. open (F i)" "\<And>i. Inf A \<in> F i"
                                        "\<And>u. (\<forall>n. u n \<in> F n) \<Longrightarrow> u \<longlonglongrightarrow> Inf A"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> F n \<and> z \<in> A)"
   have "\<exists>z. z \<in> U \<and> z \<in> A" if "Inf A \<in> U" "open U" for U
   proof -
     obtain b where "b > Inf A" "{Inf A ..<b} \<subseteq> U"
       using open_right[OF \<open>open U\<close> \<open>Inf A \<in> U\<close> \<open>Inf A < y\<close>] by auto
     obtain z where "z < b" "z \<in> A"
       using \<open>Inf A < b\<close> Inf_less_iff by auto
     then have "z \<in> {Inf A ..<b}"
       by (simp add: Inf_lower)
     then show ?thesis using \<open>z \<in> A\<close> \<open>{Inf A ..<b} \<subseteq> U\<close> by auto
   qed
   then have *: "u n \<in> F n \<and> u n \<in> A" for n
     using \<open>Inf A \<in> F n\<close> \<open>open (F n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> Inf A" using F(3) by simp
   then show ?thesis using * by auto
 qed
 
 lemma tendsto_at_iff_sequentially:
   "(f \<longlongrightarrow> a) (at x within s) \<longleftrightarrow> (\<forall>X. (\<forall>i. X i \<in> s - {x}) \<longrightarrow> X \<longlonglongrightarrow> x \<longrightarrow> ((f \<circ> X) \<longlonglongrightarrow> a))"
   for f :: "'a::first_countable_topology \<Rightarrow> _"
   unfolding filterlim_def[of _ "nhds a"] le_filter_def eventually_filtermap
     at_within_def eventually_nhds_within_iff_sequentially comp_def
   by metis
 
 lemma approx_from_above_dense_linorder:
   fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}"
   assumes "x < y"
   shows "\<exists>u. (\<forall>n. u n > x) \<and> (u \<longlonglongrightarrow> x)"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where A: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
                                       "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> A n \<and> z > x)"
   have "\<exists>z. z \<in> U \<and> x < z" if "x \<in> U" "open U" for U
     using open_right[OF \<open>open U\<close> \<open>x \<in> U\<close> \<open>x < y\<close>]
     by (meson atLeastLessThan_iff dense less_imp_le subset_eq)
   then have *: "u n \<in> A n \<and> x < u n" for n
     using \<open>x \<in> A n\<close> \<open>open (A n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> x" using A(3) by simp
   then show ?thesis using * by auto
 qed
 
 lemma approx_from_below_dense_linorder:
   fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}"
   assumes "x > y"
   shows "\<exists>u. (\<forall>n. u n < x) \<and> (u \<longlonglongrightarrow> x)"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where A: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
                                       "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> A n \<and> z < x)"
   have "\<exists>z. z \<in> U \<and> z < x" if "x \<in> U" "open U" for U
     using open_left[OF \<open>open U\<close> \<open>x \<in> U\<close> \<open>x > y\<close>]
     by (meson dense greaterThanAtMost_iff less_imp_le subset_eq)
   then have *: "u n \<in> A n \<and> u n < x" for n
     using \<open>x \<in> A n\<close> \<open>open (A n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> x" using A(3) by simp
   then show ?thesis using * by auto
 qed
 
 
 subsection \<open>Function limit at a point\<close>
 
 abbreviation LIM :: "('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
     ("((_)/ \<midarrow>(_)/\<rightarrow> (_))" [60, 0, 60] 60)
   where "f \<midarrow>a\<rightarrow> L \<equiv> (f \<longlongrightarrow> L) (at a)"
 
 lemma tendsto_within_open: "a \<in> S \<Longrightarrow> open S \<Longrightarrow> (f \<longlongrightarrow> l) (at a within S) \<longleftrightarrow> (f \<midarrow>a\<rightarrow> l)"
   by (simp add: tendsto_def at_within_open[where S = S])
 
 lemma tendsto_within_open_NO_MATCH:
   "a \<in> S \<Longrightarrow> NO_MATCH UNIV S \<Longrightarrow> open S \<Longrightarrow> (f \<longlongrightarrow> l)(at a within S) \<longleftrightarrow> (f \<longlongrightarrow> l)(at a)"
   for f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   using tendsto_within_open by blast
 
 lemma LIM_const_not_eq[tendsto_intros]: "k \<noteq> L \<Longrightarrow> \<not> (\<lambda>x. k) \<midarrow>a\<rightarrow> L"
   for a :: "'a::perfect_space" and k L :: "'b::t2_space"
   by (simp add: tendsto_const_iff)
 
 lemmas LIM_not_zero = LIM_const_not_eq [where L = 0]
 
 lemma LIM_const_eq: "(\<lambda>x. k) \<midarrow>a\<rightarrow> L \<Longrightarrow> k = L"
   for a :: "'a::perfect_space" and k L :: "'b::t2_space"
   by (simp add: tendsto_const_iff)
 
 lemma LIM_unique: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> f \<midarrow>a\<rightarrow> M \<Longrightarrow> L = M"
   for a :: "'a::perfect_space" and L M :: "'b::t2_space"
   using at_neq_bot by (rule tendsto_unique)
 
 lemma LIM_Uniq: "\<exists>\<^sub>\<le>\<^sub>1L::'b::t2_space. f \<midarrow>a\<rightarrow> L"
   for a :: "'a::perfect_space"
  by (auto simp add: Uniq_def LIM_unique)
 
 
 text \<open>Limits are equal for functions equal except at limit point.\<close>
 lemma LIM_equal: "\<forall>x. x \<noteq> a \<longrightarrow> f x = g x \<Longrightarrow> (f \<midarrow>a\<rightarrow> l) \<longleftrightarrow> (g \<midarrow>a\<rightarrow> l)"
   by (simp add: tendsto_def eventually_at_topological)
 
 lemma LIM_cong: "a = b \<Longrightarrow> (\<And>x. x \<noteq> b \<Longrightarrow> f x = g x) \<Longrightarrow> l = m \<Longrightarrow> (f \<midarrow>a\<rightarrow> l) \<longleftrightarrow> (g \<midarrow>b\<rightarrow> m)"
   by (simp add: LIM_equal)
 
 lemma tendsto_cong_limit: "(f \<longlongrightarrow> l) F \<Longrightarrow> k = l \<Longrightarrow> (f \<longlongrightarrow> k) F"
   by simp
 
 lemma tendsto_at_iff_tendsto_nhds: "g \<midarrow>l\<rightarrow> g l \<longleftrightarrow> (g \<longlongrightarrow> g l) (nhds l)"
   unfolding tendsto_def eventually_at_filter
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 lemma tendsto_compose: "g \<midarrow>l\<rightarrow> g l \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> g l) F"
   unfolding tendsto_at_iff_tendsto_nhds by (rule filterlim_compose[of g])
 
 lemma tendsto_compose_eventually:
   "g \<midarrow>l\<rightarrow> m \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> eventually (\<lambda>x. f x \<noteq> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> m) F"
   by (rule filterlim_compose[of g _ "at l"]) (auto simp add: filterlim_at)
 
 lemma LIM_compose_eventually:
   assumes "f \<midarrow>a\<rightarrow> b"
     and "g \<midarrow>b\<rightarrow> c"
     and "eventually (\<lambda>x. f x \<noteq> b) (at a)"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   using assms(2,1,3) by (rule tendsto_compose_eventually)
 
 lemma tendsto_compose_filtermap: "((g \<circ> f) \<longlongrightarrow> T) F \<longleftrightarrow> (g \<longlongrightarrow> T) (filtermap f F)"
   by (simp add: filterlim_def filtermap_filtermap comp_def)
 
 lemma tendsto_compose_at:
   assumes f: "(f \<longlongrightarrow> y) F" and g: "(g \<longlongrightarrow> z) (at y)" and fg: "eventually (\<lambda>w. f w = y \<longrightarrow> g y = z) F"
   shows "((g \<circ> f) \<longlongrightarrow> z) F"
 proof -
   have "(\<forall>\<^sub>F a in F. f a \<noteq> y) \<or> g y = z"
     using fg by force
   moreover have "(g \<longlongrightarrow> z) (filtermap f F) \<or> \<not> (\<forall>\<^sub>F a in F. f a \<noteq> y)"
     by (metis (no_types) filterlim_atI filterlim_def tendsto_mono f g)
   ultimately show ?thesis
     by (metis (no_types) f filterlim_compose filterlim_filtermap g tendsto_at_iff_tendsto_nhds tendsto_compose_filtermap)
 qed
 
 lemma tendsto_nhds_iff: "(f \<longlongrightarrow> (c :: 'a :: t1_space)) (nhds x) \<longleftrightarrow> f \<midarrow>x\<rightarrow> c \<and> f x = c"
 proof safe
   assume lim: "(f \<longlongrightarrow> c) (nhds x)"
   show "f x = c"
   proof (rule ccontr)
     assume "f x \<noteq> c"
     hence "c \<noteq> f x"
       by auto
     then obtain A where A: "open A" "c \<in> A" "f x \<notin> A"
       by (subst (asm) separation_t1) auto
     with lim obtain B where "open B" "x \<in> B" "\<And>x. x \<in> B \<Longrightarrow> f x \<in> A"
       unfolding tendsto_def eventually_nhds by metis 
     with \<open>f x \<notin> A\<close> show False
       by blast
   qed
   show "(f \<longlongrightarrow> c) (at x)"
     using lim by (rule filterlim_mono) (auto simp: at_within_def)
 next
   assume "f \<midarrow>x\<rightarrow> f x" "c = f x"
   thus "(f \<longlongrightarrow> f x) (nhds x)"
     unfolding tendsto_def eventually_at_filter by (fast elim: eventually_mono)
 qed
 
 
 subsubsection \<open>Relation of \<open>LIM\<close> and \<open>LIMSEQ\<close>\<close>
 
 lemma (in first_countable_topology) sequentially_imp_eventually_within:
   "(\<forall>f. (\<forall>n. f n \<in> s \<and> f n \<noteq> a) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially) \<Longrightarrow>
     eventually P (at a within s)"
   unfolding at_within_def
   by (intro sequentially_imp_eventually_nhds_within) auto
 
 lemma (in first_countable_topology) sequentially_imp_eventually_at:
   "(\<forall>f. (\<forall>n. f n \<noteq> a) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially) \<Longrightarrow> eventually P (at a)"
   using sequentially_imp_eventually_within [where s=UNIV] by simp
 
 lemma LIMSEQ_SEQ_conv:
   "(\<forall>S. (\<forall>n. S n \<noteq> a) \<and> S \<longlonglongrightarrow> a \<longrightarrow> (\<lambda>n. X (S n)) \<longlonglongrightarrow> L)  \<longleftrightarrow>  X \<midarrow>a\<rightarrow> L"  (is "?lhs=?rhs")
   for a :: "'a::first_countable_topology" and L :: "'b::topological_space"
 proof
   assume ?lhs then show ?rhs
     by (simp add: sequentially_imp_eventually_within tendsto_def) 
 next
   assume ?rhs then show ?lhs
     using tendsto_compose_eventually eventuallyI by blast
 qed    
 
 lemma sequentially_imp_eventually_at_left:
   fixes a :: "'a::{linorder_topology,first_countable_topology}"
   assumes b[simp]: "b < a"
     and *: "\<And>f. (\<And>n. b < f n) \<Longrightarrow> (\<And>n. f n < a) \<Longrightarrow> incseq f \<Longrightarrow> f \<longlonglongrightarrow> a \<Longrightarrow>
       eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (at_left a)"
 proof (safe intro!: sequentially_imp_eventually_within)
   fix X
   assume X: "\<forall>n. X n \<in> {..< a} \<and> X n \<noteq> a" "X \<longlonglongrightarrow> a"
   show "eventually (\<lambda>n. P (X n)) sequentially"
   proof (rule ccontr)
     assume neg: "\<not> ?thesis"
     have "\<exists>s. \<forall>n. (\<not> P (X (s n)) \<and> b < X (s n)) \<and> (X (s n) \<le> X (s (Suc n)) \<and> Suc (s n) \<le> s (Suc n))"
       (is "\<exists>s. ?P s")
     proof (rule dependent_nat_choice)
       have "\<not> eventually (\<lambda>n. b < X n \<longrightarrow> P (X n)) sequentially"
         by (intro not_eventually_impI neg order_tendstoD(1) [OF X(2) b])
       then show "\<exists>x. \<not> P (X x) \<and> b < X x"
         by (auto dest!: not_eventuallyD)
     next
       fix x n
       have "\<not> eventually (\<lambda>n. Suc x \<le> n \<longrightarrow> b < X n \<longrightarrow> X x < X n \<longrightarrow> P (X n)) sequentially"
         using X
         by (intro not_eventually_impI order_tendstoD(1)[OF X(2)] eventually_ge_at_top neg) auto
       then show "\<exists>n. (\<not> P (X n) \<and> b < X n) \<and> (X x \<le> X n \<and> Suc x \<le> n)"
         by (auto dest!: not_eventuallyD)
     qed
     then obtain s where "?P s" ..
     with X have "b < X (s n)"
       and "X (s n) < a"
       and "incseq (\<lambda>n. X (s n))"
       and "(\<lambda>n. X (s n)) \<longlonglongrightarrow> a"
       and "\<not> P (X (s n))"
       for n
       by (auto simp: strict_mono_Suc_iff Suc_le_eq incseq_Suc_iff
           intro!: LIMSEQ_subseq_LIMSEQ[OF \<open>X \<longlonglongrightarrow> a\<close>, unfolded comp_def])
     from *[OF this(1,2,3,4)] this(5) show False
       by auto
   qed
 qed
 
 lemma tendsto_at_left_sequentially:
   fixes a b :: "'b::{linorder_topology,first_countable_topology}"
   assumes "b < a"
   assumes *: "\<And>S. (\<And>n. S n < a) \<Longrightarrow> (\<And>n. b < S n) \<Longrightarrow> incseq S \<Longrightarrow> S \<longlonglongrightarrow> a \<Longrightarrow>
     (\<lambda>n. X (S n)) \<longlonglongrightarrow> L"
   shows "(X \<longlongrightarrow> L) (at_left a)"
   using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_left)
 
 lemma sequentially_imp_eventually_at_right:
   fixes a b :: "'a::{linorder_topology,first_countable_topology}"
   assumes b[simp]: "a < b"
   assumes *: "\<And>f. (\<And>n. a < f n) \<Longrightarrow> (\<And>n. f n < b) \<Longrightarrow> decseq f \<Longrightarrow> f \<longlonglongrightarrow> a \<Longrightarrow>
     eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (at_right a)"
 proof (safe intro!: sequentially_imp_eventually_within)
   fix X
   assume X: "\<forall>n. X n \<in> {a <..} \<and> X n \<noteq> a" "X \<longlonglongrightarrow> a"
   show "eventually (\<lambda>n. P (X n)) sequentially"
   proof (rule ccontr)
     assume neg: "\<not> ?thesis"
     have "\<exists>s. \<forall>n. (\<not> P (X (s n)) \<and> X (s n) < b) \<and> (X (s (Suc n)) \<le> X (s n) \<and> Suc (s n) \<le> s (Suc n))"
       (is "\<exists>s. ?P s")
     proof (rule dependent_nat_choice)
       have "\<not> eventually (\<lambda>n. X n < b \<longrightarrow> P (X n)) sequentially"
         by (intro not_eventually_impI neg order_tendstoD(2) [OF X(2) b])
       then show "\<exists>x. \<not> P (X x) \<and> X x < b"
         by (auto dest!: not_eventuallyD)
     next
       fix x n
       have "\<not> eventually (\<lambda>n. Suc x \<le> n \<longrightarrow> X n < b \<longrightarrow> X n < X x \<longrightarrow> P (X n)) sequentially"
         using X
         by (intro not_eventually_impI order_tendstoD(2)[OF X(2)] eventually_ge_at_top neg) auto
       then show "\<exists>n. (\<not> P (X n) \<and> X n < b) \<and> (X n \<le> X x \<and> Suc x \<le> n)"
         by (auto dest!: not_eventuallyD)
     qed
     then obtain s where "?P s" ..
     with X have "a < X (s n)"
       and "X (s n) < b"
       and "decseq (\<lambda>n. X (s n))"
       and "(\<lambda>n. X (s n)) \<longlonglongrightarrow> a"
       and "\<not> P (X (s n))"
       for n
       by (auto simp: strict_mono_Suc_iff Suc_le_eq decseq_Suc_iff
           intro!: LIMSEQ_subseq_LIMSEQ[OF \<open>X \<longlonglongrightarrow> a\<close>, unfolded comp_def])
     from *[OF this(1,2,3,4)] this(5) show False
       by auto
   qed
 qed
 
 lemma tendsto_at_right_sequentially:
   fixes a :: "_ :: {linorder_topology, first_countable_topology}"
   assumes "a < b"
     and *: "\<And>S. (\<And>n. a < S n) \<Longrightarrow> (\<And>n. S n < b) \<Longrightarrow> decseq S \<Longrightarrow> S \<longlonglongrightarrow> a \<Longrightarrow>
       (\<lambda>n. X (S n)) \<longlonglongrightarrow> L"
   shows "(X \<longlongrightarrow> L) (at_right a)"
   using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_right)
 
 
 subsection \<open>Continuity\<close>
 
 subsubsection \<open>Continuity on a set\<close>
 
 definition continuous_on :: "'a set \<Rightarrow> ('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool"
   where "continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. (f \<longlongrightarrow> f x) (at x within s))"
 
 lemma continuous_on_cong [cong]:
   "s = t \<Longrightarrow> (\<And>x. x \<in> t \<Longrightarrow> f x = g x) \<Longrightarrow> continuous_on s f \<longleftrightarrow> continuous_on t g"
   unfolding continuous_on_def
   by (intro ball_cong filterlim_cong) (auto simp: eventually_at_filter)
 
 lemma continuous_on_cong_simp:
   "s = t \<Longrightarrow> (\<And>x. x \<in> t =simp=> f x = g x) \<Longrightarrow> continuous_on s f \<longleftrightarrow> continuous_on t g"
   unfolding simp_implies_def by (rule continuous_on_cong)
 
 lemma continuous_on_topological:
   "continuous_on s f \<longleftrightarrow>
     (\<forall>x\<in>s. \<forall>B. open B \<longrightarrow> f x \<in> B \<longrightarrow> (\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)))"
   unfolding continuous_on_def tendsto_def eventually_at_topological by metis
 
 lemma continuous_on_open_invariant:
   "continuous_on s f \<longleftrightarrow> (\<forall>B. open B \<longrightarrow> (\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s))"
 proof safe
   fix B :: "'b set"
   assume "continuous_on s f" "open B"
   then have "\<forall>x\<in>f -` B \<inter> s. (\<exists>A. open A \<and> x \<in> A \<and> s \<inter> A \<subseteq> f -` B)"
     by (auto simp: continuous_on_topological subset_eq Ball_def imp_conjL)
   then obtain A where "\<forall>x\<in>f -` B \<inter> s. open (A x) \<and> x \<in> A x \<and> s \<inter> A x \<subseteq> f -` B"
     unfolding bchoice_iff ..
   then show "\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s"
     by (intro exI[of _ "\<Union>x\<in>f -` B \<inter> s. A x"]) auto
 next
   assume B: "\<forall>B. open B \<longrightarrow> (\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s)"
   show "continuous_on s f"
     unfolding continuous_on_topological
   proof safe
     fix x B
     assume "x \<in> s" "open B" "f x \<in> B"
     with B obtain A where A: "open A" "A \<inter> s = f -` B \<inter> s"
       by auto
     with \<open>x \<in> s\<close> \<open>f x \<in> B\<close> show "\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)"
       by (intro exI[of _ A]) auto
   qed
 qed
 
 lemma continuous_on_open_vimage:
   "open s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>B. open B \<longrightarrow> open (f -` B \<inter> s))"
   unfolding continuous_on_open_invariant
   by (metis open_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s])
 
 corollary continuous_imp_open_vimage:
   assumes "continuous_on s f" "open s" "open B" "f -` B \<subseteq> s"
   shows "open (f -` B)"
   by (metis assms continuous_on_open_vimage le_iff_inf)
 
 corollary open_vimage[continuous_intros]:
   assumes "open s"
     and "continuous_on UNIV f"
   shows "open (f -` s)"
   using assms by (simp add: continuous_on_open_vimage [OF open_UNIV])
 
 lemma continuous_on_closed_invariant:
   "continuous_on s f \<longleftrightarrow> (\<forall>B. closed B \<longrightarrow> (\<exists>A. closed A \<and> A \<inter> s = f -` B \<inter> s))"
 proof -
   have *: "(\<And>A. P A \<longleftrightarrow> Q (- A)) \<Longrightarrow> (\<forall>A. P A) \<longleftrightarrow> (\<forall>A. Q A)"
     for P Q :: "'b set \<Rightarrow> bool"
     by (metis double_compl)
   show ?thesis
     unfolding continuous_on_open_invariant
     by (intro *) (auto simp: open_closed[symmetric])
 qed
 
 lemma continuous_on_closed_vimage:
   "closed s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>B. closed B \<longrightarrow> closed (f -` B \<inter> s))"
   unfolding continuous_on_closed_invariant
   by (metis closed_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s])
 
 corollary closed_vimage_Int[continuous_intros]:
   assumes "closed s"
     and "continuous_on t f"
     and t: "closed t"
   shows "closed (f -` s \<inter> t)"
   using assms by (simp add: continuous_on_closed_vimage [OF t])
 
 corollary closed_vimage[continuous_intros]:
   assumes "closed s"
     and "continuous_on UNIV f"
   shows "closed (f -` s)"
   using closed_vimage_Int [OF assms] by simp
 
 lemma continuous_on_empty [simp]: "continuous_on {} f"
   by (simp add: continuous_on_def)
 
 lemma continuous_on_sing [simp]: "continuous_on {x} f"
   by (simp add: continuous_on_def at_within_def)
 
 lemma continuous_on_open_Union:
   "(\<And>s. s \<in> S \<Longrightarrow> open s) \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> continuous_on s f) \<Longrightarrow> continuous_on (\<Union>S) f"
   unfolding continuous_on_def
   by safe (metis open_Union at_within_open UnionI)
 
 lemma continuous_on_open_UN:
   "(\<And>s. s \<in> S \<Longrightarrow> open (A s)) \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> continuous_on (A s) f) \<Longrightarrow>
     continuous_on (\<Union>s\<in>S. A s) f"
   by (rule continuous_on_open_Union) auto
 
 lemma continuous_on_open_Un:
   "open s \<Longrightarrow> open t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t f \<Longrightarrow> continuous_on (s \<union> t) f"
   using continuous_on_open_Union [of "{s,t}"] by auto
 
 lemma continuous_on_closed_Un:
   "closed s \<Longrightarrow> closed t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t f \<Longrightarrow> continuous_on (s \<union> t) f"
   by (auto simp add: continuous_on_closed_vimage closed_Un Int_Un_distrib)
 
 lemma continuous_on_closed_Union:
   assumes "finite I"
     "\<And>i. i \<in> I \<Longrightarrow> closed (U i)"
     "\<And>i. i \<in> I \<Longrightarrow> continuous_on (U i) f"
   shows "continuous_on (\<Union> i \<in> I. U i) f"
   using assms
   by (induction I) (auto intro!: continuous_on_closed_Un)
 
 lemma continuous_on_If:
   assumes closed: "closed s" "closed t"
     and cont: "continuous_on s f" "continuous_on t g"
     and P: "\<And>x. x \<in> s \<Longrightarrow> \<not> P x \<Longrightarrow> f x = g x" "\<And>x. x \<in> t \<Longrightarrow> P x \<Longrightarrow> f x = g x"
   shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
     (is "continuous_on _ ?h")
 proof-
   from P have "\<forall>x\<in>s. f x = ?h x" "\<forall>x\<in>t. g x = ?h x"
     by auto
   with cont have "continuous_on s ?h" "continuous_on t ?h"
     by simp_all
   with closed show ?thesis
     by (rule continuous_on_closed_Un)
 qed
 
 lemma continuous_on_cases:
   "closed s \<Longrightarrow> closed t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t g \<Longrightarrow>
     \<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x \<Longrightarrow>
     continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
   by (rule continuous_on_If) auto
 
 lemma continuous_on_id[continuous_intros,simp]: "continuous_on s (\<lambda>x. x)"
   unfolding continuous_on_def by fast
 
 lemma continuous_on_id'[continuous_intros,simp]: "continuous_on s id"
   unfolding continuous_on_def id_def by fast
 
 lemma continuous_on_const[continuous_intros,simp]: "continuous_on s (\<lambda>x. c)"
   unfolding continuous_on_def by auto
 
 lemma continuous_on_subset: "continuous_on s f \<Longrightarrow> t \<subseteq> s \<Longrightarrow> continuous_on t f"
   unfolding continuous_on_def
   by (metis subset_eq tendsto_within_subset)
 
 lemma continuous_on_compose[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g \<circ> f)"
   unfolding continuous_on_topological by simp metis
 
 lemma continuous_on_compose2:
   "continuous_on t g \<Longrightarrow> continuous_on s f \<Longrightarrow> f ` s \<subseteq> t \<Longrightarrow> continuous_on s (\<lambda>x. g (f x))"
   using continuous_on_compose[of s f g] continuous_on_subset by (force simp add: comp_def)
 
 lemma continuous_on_generate_topology:
   assumes *: "open = generate_topology X"
     and **: "\<And>B. B \<in> X \<Longrightarrow> \<exists>C. open C \<and> C \<inter> A = f -` B \<inter> A"
   shows "continuous_on A f"
   unfolding continuous_on_open_invariant
 proof safe
   fix B :: "'a set"
   assume "open B"
   then show "\<exists>C. open C \<and> C \<inter> A = f -` B \<inter> A"
     unfolding *
   proof induct
     case (UN K)
     then obtain C where "\<And>k. k \<in> K \<Longrightarrow> open (C k)" "\<And>k. k \<in> K \<Longrightarrow> C k \<inter> A = f -` k \<inter> A"
       by metis
     then show ?case
       by (intro exI[of _ "\<Union>k\<in>K. C k"]) blast
   qed (auto intro: **)
 qed
 
 lemma continuous_onI_mono:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::{dense_order,linorder_topology}"
   assumes "open (f`A)"
     and mono: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
   shows "continuous_on A f"
 proof (rule continuous_on_generate_topology[OF open_generated_order], safe)
   have monoD: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x < f y \<Longrightarrow> x < y"
     by (auto simp: not_le[symmetric] mono)
   have "\<exists>x. x \<in> A \<and> f x < b \<and> a < x" if a: "a \<in> A" and fa: "f a < b" for a b
   proof -
     obtain y where "f a < y" "{f a ..< y} \<subseteq> f`A"
       using open_right[OF \<open>open (f`A)\<close>, of "f a" b] a fa
       by auto
     obtain z where z: "f a < z" "z < min b y"
       using dense[of "f a" "min b y"] \<open>f a < y\<close> \<open>f a < b\<close> by auto
     then obtain c where "z = f c" "c \<in> A"
       using \<open>{f a ..< y} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
     with a z show ?thesis
       by (auto intro!: exI[of _ c] simp: monoD)
   qed
   then show "\<exists>C. open C \<and> C \<inter> A = f -` {..<b} \<inter> A" for b
     by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. f x < b}. {..< x})"])
        (auto intro: le_less_trans[OF mono] less_imp_le)
 
   have "\<exists>x. x \<in> A \<and> b < f x \<and> x < a" if a: "a \<in> A" and fa: "b < f a" for a b
   proof -
     note a fa
     moreover
     obtain y where "y < f a" "{y <.. f a} \<subseteq> f`A"
       using open_left[OF \<open>open (f`A)\<close>, of "f a" b]  a fa
       by auto
     then obtain z where z: "max b y < z" "z < f a"
       using dense[of "max b y" "f a"] \<open>y < f a\<close> \<open>b < f a\<close> by auto
     then obtain c where "z = f c" "c \<in> A"
       using \<open>{y <.. f a} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
     with a z show ?thesis
       by (auto intro!: exI[of _ c] simp: monoD)
   qed
   then show "\<exists>C. open C \<and> C \<inter> A = f -` {b <..} \<inter> A" for b
     by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. b < f x}. {x <..})"])
        (auto intro: less_le_trans[OF _ mono] less_imp_le)
 qed
 
 lemma continuous_on_IccI:
   "\<lbrakk>(f \<longlongrightarrow> f a) (at_right a);
     (f \<longlongrightarrow> f b) (at_left b);
     (\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> f \<midarrow>x\<rightarrow> f x); a < b\<rbrakk> \<Longrightarrow>
     continuous_on {a .. b} f"
   for a::"'a::linorder_topology"
   using at_within_open[of _ "{a<..<b}"]
   by (auto simp: continuous_on_def at_within_Icc_at_right at_within_Icc_at_left le_less
       at_within_Icc_at)
 
 lemma
   fixes a b::"'a::linorder_topology"
   assumes "continuous_on {a .. b} f" "a < b"
   shows continuous_on_Icc_at_rightD: "(f \<longlongrightarrow> f a) (at_right a)"
     and continuous_on_Icc_at_leftD: "(f \<longlongrightarrow> f b) (at_left b)"
   using assms
   by (auto simp: at_within_Icc_at_right at_within_Icc_at_left continuous_on_def
       dest: bspec[where x=a] bspec[where x=b])
 
 lemma continuous_on_discrete [simp]:
   "continuous_on A (f :: 'a :: discrete_topology \<Rightarrow> _)"
   by (auto simp: continuous_on_def at_discrete)
 
 lemma continuous_on_of_nat [continuous_intros]:
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>n. of_nat (f n))"
   using continuous_on_compose[OF assms continuous_on_discrete[of _ of_nat]]
   by (simp add: o_def)
 
 lemma continuous_on_of_int [continuous_intros]:
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>n. of_int (f n))"
   using continuous_on_compose[OF assms continuous_on_discrete[of _ of_int]]
   by (simp add: o_def)
 
 subsubsection \<open>Continuity at a point\<close>
 
 definition continuous :: "'a::t2_space filter \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool"
   where "continuous F f \<longleftrightarrow> (f \<longlongrightarrow> f (Lim F (\<lambda>x. x))) F"
 
 lemma continuous_bot[continuous_intros, simp]: "continuous bot f"
   unfolding continuous_def by auto
 
 lemma continuous_trivial_limit: "trivial_limit net \<Longrightarrow> continuous net f"
   by simp
 
 lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f \<longlongrightarrow> f x) (at x within s)"
   by (cases "trivial_limit (at x within s)") (auto simp add: Lim_ident_at continuous_def)
 
 lemma continuous_within_topological:
   "continuous (at x within s) f \<longleftrightarrow>
     (\<forall>B. open B \<longrightarrow> f x \<in> B \<longrightarrow> (\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)))"
   unfolding continuous_within tendsto_def eventually_at_topological by metis
 
 lemma continuous_within_compose[continuous_intros]:
   "continuous (at x within s) f \<Longrightarrow> continuous (at (f x) within f ` s) g \<Longrightarrow>
     continuous (at x within s) (g \<circ> f)"
   by (simp add: continuous_within_topological) metis
 
 lemma continuous_within_compose2:
   "continuous (at x within s) f \<Longrightarrow> continuous (at (f x) within f ` s) g \<Longrightarrow>
     continuous (at x within s) (\<lambda>x. g (f x))"
   using continuous_within_compose[of x s f g] by (simp add: comp_def)
 
 lemma continuous_at: "continuous (at x) f \<longleftrightarrow> f \<midarrow>x\<rightarrow> f x"
   using continuous_within[of x UNIV f] by simp
 
 lemma continuous_ident[continuous_intros, simp]: "continuous (at x within S) (\<lambda>x. x)"
   unfolding continuous_within by (rule tendsto_ident_at)
 
 lemma continuous_id[continuous_intros, simp]: "continuous (at x within S) id"
   by (simp add: id_def)
 
 lemma continuous_const[continuous_intros, simp]: "continuous F (\<lambda>x. c)"
   unfolding continuous_def by (rule tendsto_const)
 
 lemma continuous_on_eq_continuous_within:
   "continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. continuous (at x within s) f)"
   unfolding continuous_on_def continuous_within ..
 
 lemma continuous_discrete [simp]:
   "continuous (at x within A) (f :: 'a :: discrete_topology \<Rightarrow> _)"
   by (auto simp: continuous_def at_discrete)
 
 abbreviation isCont :: "('a::t2_space \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> bool"
   where "isCont f a \<equiv> continuous (at a) f"
 
 lemma isCont_def: "isCont f a \<longleftrightarrow> f \<midarrow>a\<rightarrow> f a"
   by (rule continuous_at)
 
 lemma isContD: "isCont f x \<Longrightarrow> f \<midarrow>x\<rightarrow> f x"
   by (simp add: isCont_def)
 
 lemma isCont_cong:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)"
   shows "isCont f x \<longleftrightarrow> isCont g x"
 proof -
   from assms have [simp]: "f x = g x"
     by (rule eventually_nhds_x_imp_x)
   from assms have "eventually (\<lambda>x. f x = g x) (at x)"
     by (auto simp: eventually_at_filter elim!: eventually_mono)
   with assms have "isCont f x \<longleftrightarrow> isCont g x" unfolding isCont_def
     by (intro filterlim_cong) (auto elim!: eventually_mono)
   with assms show ?thesis by simp
 qed
 
 lemma continuous_at_imp_continuous_at_within: "isCont f x \<Longrightarrow> continuous (at x within s) f"
   by (auto intro: tendsto_mono at_le simp: continuous_at continuous_within)
 
 lemma continuous_on_eq_continuous_at: "open s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. isCont f x)"
   by (simp add: continuous_on_def continuous_at at_within_open[of _ s])
 
 lemma continuous_within_open: "a \<in> A \<Longrightarrow> open A \<Longrightarrow> continuous (at a within A) f \<longleftrightarrow> isCont f a"
   by (simp add: at_within_open_NO_MATCH)
 
 lemma continuous_at_imp_continuous_on: "\<forall>x\<in>s. isCont f x \<Longrightarrow> continuous_on s f"
   by (auto intro: continuous_at_imp_continuous_at_within simp: continuous_on_eq_continuous_within)
 
 lemma isCont_o2: "isCont f a \<Longrightarrow> isCont g (f a) \<Longrightarrow> isCont (\<lambda>x. g (f x)) a"
   unfolding isCont_def by (rule tendsto_compose)
 
 lemma continuous_at_compose[continuous_intros]: "isCont f a \<Longrightarrow> isCont g (f a) \<Longrightarrow> isCont (g \<circ> f) a"
   unfolding o_def by (rule isCont_o2)
 
 lemma isCont_tendsto_compose: "isCont g l \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> g l) F"
   unfolding isCont_def by (rule tendsto_compose)
 
 lemma continuous_on_tendsto_compose:
   assumes f_cont: "continuous_on s f"
     and g: "(g \<longlongrightarrow> l) F"
     and l: "l \<in> s"
     and ev: "\<forall>\<^sub>Fx in F. g x \<in> s"
   shows "((\<lambda>x. f (g x)) \<longlongrightarrow> f l) F"
 proof -
   from f_cont l have f: "(f \<longlongrightarrow> f l) (at l within s)"
     by (simp add: continuous_on_def)
   have i: "((\<lambda>x. if g x = l then f l else f (g x)) \<longlongrightarrow> f l) F"
     by (rule filterlim_If)
        (auto intro!: filterlim_compose[OF f] eventually_conj tendsto_mono[OF _ g]
              simp: filterlim_at eventually_inf_principal eventually_mono[OF ev])
   show ?thesis
     by (rule filterlim_cong[THEN iffD1[OF _ i]]) auto
 qed
 
 lemma continuous_within_compose3:
   "isCont g (f x) \<Longrightarrow> continuous (at x within s) f \<Longrightarrow> continuous (at x within s) (\<lambda>x. g (f x))"
   using continuous_at_imp_continuous_at_within continuous_within_compose2 by blast
 
 lemma at_within_isCont_imp_nhds:
   fixes f:: "'a:: {t2_space,perfect_space} \<Rightarrow> 'b:: t2_space"
   assumes "\<forall>\<^sub>F w in at z. f w = g w" "isCont f z" "isCont g z"
   shows "\<forall>\<^sub>F w in nhds z. f w = g w"
 proof -
   have "g \<midarrow>z\<rightarrow> f z"
     using assms isContD tendsto_cong by blast 
   moreover have "g \<midarrow>z\<rightarrow> g z" using \<open>isCont g z\<close> using isCont_def by blast
   ultimately have "f z=g z" using LIM_unique by auto
   moreover have "\<forall>\<^sub>F x in nhds z. x \<noteq> z \<longrightarrow> f x = g x"
     using assms unfolding eventually_at_filter by auto
   ultimately show ?thesis 
     by (auto elim:eventually_mono)
 qed
 
 lemma filtermap_nhds_open_map':
   assumes cont: "isCont f a"
     and "open A" "a \<in> A"
     and open_map: "\<And>S. open S \<Longrightarrow> S \<subseteq> A \<Longrightarrow> open (f ` S)"
   shows "filtermap f (nhds a) = nhds (f a)"
   unfolding filter_eq_iff
 proof safe
   fix P
   assume "eventually P (filtermap f (nhds a))"
   then obtain S where S: "open S" "a \<in> S" "\<forall>x\<in>S. P (f x)"
     by (auto simp: eventually_filtermap eventually_nhds)
   show "eventually P (nhds (f a))"
     unfolding eventually_nhds 
   proof (rule exI [of _ "f ` (A \<inter> S)"], safe)
     show "open (f ` (A \<inter> S))"
       using S by (intro open_Int assms) auto
     show "f a \<in> f ` (A \<inter> S)"
       using assms S by auto
     show "P (f x)" if "x \<in> A" "x \<in> S" for x
       using S that by auto
   qed
 qed (metis filterlim_iff tendsto_at_iff_tendsto_nhds isCont_def eventually_filtermap cont)
 
 lemma filtermap_nhds_open_map:
   assumes cont: "isCont f a"
     and open_map: "\<And>S. open S \<Longrightarrow> open (f`S)"
   shows "filtermap f (nhds a) = nhds (f a)"
   using cont filtermap_nhds_open_map' open_map by blast
 
 lemma continuous_at_split:
   "continuous (at x) f \<longleftrightarrow> continuous (at_left x) f \<and> continuous (at_right x) f"
   for x :: "'a::linorder_topology"
   by (simp add: continuous_within filterlim_at_split)
 
 lemma continuous_on_max [continuous_intros]:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. max (f x) (g x))"
   by (auto simp: continuous_on_def intro!: tendsto_max)
 
 lemma continuous_on_min [continuous_intros]:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. min (f x) (g x))"
   by (auto simp: continuous_on_def intro!: tendsto_min)
 
 lemma continuous_max [continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::linorder_topology"
   shows "\<lbrakk>continuous F f; continuous F g\<rbrakk> \<Longrightarrow> continuous F (\<lambda>x. (max (f x) (g x)))"
   by (simp add: tendsto_max continuous_def)
 
 lemma continuous_min [continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::linorder_topology"
   shows "\<lbrakk>continuous F f; continuous F g\<rbrakk> \<Longrightarrow> continuous F (\<lambda>x. (min (f x) (g x)))"
   by (simp add: tendsto_min continuous_def)
 
 text \<open>
   The following open/closed Collect lemmas are ported from
   Sébastien Gouëzel's \<open>Ergodic_Theory\<close>.
 \<close>
 lemma open_Collect_neq:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "open {x. f x \<noteq> g x}"
 proof (rule openI)
   fix t
   assume "t \<in> {x. f x \<noteq> g x}"
   then obtain U V where *: "open U" "open V" "f t \<in> U" "g t \<in> V" "U \<inter> V = {}"
     by (auto simp add: separation_t2)
   with open_vimage[OF \<open>open U\<close> f] open_vimage[OF \<open>open V\<close> g]
   show "\<exists>T. open T \<and> t \<in> T \<and> T \<subseteq> {x. f x \<noteq> g x}"
     by (intro exI[of _ "f -` U \<inter> g -` V"]) auto
 qed
 
 lemma closed_Collect_eq:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "closed {x. f x = g x}"
   using open_Collect_neq[OF f g] by (simp add: closed_def Collect_neg_eq)
 
 lemma open_Collect_less:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "open {x. f x < g x}"
 proof (rule openI)
   fix t
   assume t: "t \<in> {x. f x < g x}"
   show "\<exists>T. open T \<and> t \<in> T \<and> T \<subseteq> {x. f x < g x}"
   proof (cases "\<exists>z. f t < z \<and> z < g t")
     case True
     then obtain z where "f t < z \<and> z < g t" by blast
     then show ?thesis
       using open_vimage[OF _ f, of "{..< z}"] open_vimage[OF _ g, of "{z <..}"]
       by (intro exI[of _ "f -` {..<z} \<inter> g -` {z<..}"]) auto
   next
     case False
     then have *: "{g t ..} = {f t <..}" "{..< g t} = {.. f t}"
       using t by (auto intro: leI)
     show ?thesis
       using open_vimage[OF _ f, of "{..< g t}"] open_vimage[OF _ g, of "{f t <..}"] t
       apply (intro exI[of _ "f -` {..< g t} \<inter> g -` {f t<..}"])
       apply (simp add: open_Int)
       apply (auto simp add: *)
       done
   qed
 qed
 
 lemma closed_Collect_le:
   fixes f g :: "'a :: topological_space \<Rightarrow> 'b::linorder_topology"
   assumes f: "continuous_on UNIV f"
     and g: "continuous_on UNIV g"
   shows "closed {x. f x \<le> g x}"
   using open_Collect_less [OF g f]
   by (simp add: closed_def Collect_neg_eq[symmetric] not_le)
 
 
 subsubsection \<open>Open-cover compactness\<close>
 
 context topological_space
 begin
 
 definition compact :: "'a set \<Rightarrow> bool" where
 compact_eq_Heine_Borel:  (* This name is used for backwards compatibility *)
     "compact S \<longleftrightarrow> (\<forall>C. (\<forall>c\<in>C. open c) \<and> S \<subseteq> \<Union>C \<longrightarrow> (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"
 
 lemma compactI:
   assumes "\<And>C. \<forall>t\<in>C. open t \<Longrightarrow> s \<subseteq> \<Union>C \<Longrightarrow> \<exists>C'. C' \<subseteq> C \<and> finite C' \<and> s \<subseteq> \<Union>C'"
   shows "compact s"
   unfolding compact_eq_Heine_Borel using assms by metis
 
 lemma compact_empty[simp]: "compact {}"
   by (auto intro!: compactI)
 
 lemma compactE: (*related to COMPACT_IMP_HEINE_BOREL in HOL Light*)
   assumes "compact S" "S \<subseteq> \<Union>\<T>" "\<And>B. B \<in> \<T> \<Longrightarrow> open B"
   obtains \<T>' where "\<T>' \<subseteq> \<T>" "finite \<T>'" "S \<subseteq> \<Union>\<T>'"
   by (meson assms compact_eq_Heine_Borel)
 
 lemma compactE_image:
   assumes "compact S"
     and opn: "\<And>T. T \<in> C \<Longrightarrow> open (f T)"
     and S: "S \<subseteq> (\<Union>c\<in>C. f c)"
   obtains C' where "C' \<subseteq> C" and "finite C'" and "S \<subseteq> (\<Union>c\<in>C'. f c)"
     apply (rule compactE[OF \<open>compact S\<close> S])
     using opn apply force
     by (metis finite_subset_image)
 
 lemma compact_Int_closed [intro]:
   assumes "compact S"
     and "closed T"
   shows "compact (S \<inter> T)"
 proof (rule compactI)
   fix C
   assume C: "\<forall>c\<in>C. open c"
   assume cover: "S \<inter> T \<subseteq> \<Union>C"
   from C \<open>closed T\<close> have "\<forall>c\<in>C \<union> {- T}. open c"
     by auto
   moreover from cover have "S \<subseteq> \<Union>(C \<union> {- T})"
     by auto
   ultimately have "\<exists>D\<subseteq>C \<union> {- T}. finite D \<and> S \<subseteq> \<Union>D"
     using \<open>compact S\<close> unfolding compact_eq_Heine_Borel by auto
   then obtain D where "D \<subseteq> C \<union> {- T} \<and> finite D \<and> S \<subseteq> \<Union>D" ..
   then show "\<exists>D\<subseteq>C. finite D \<and> S \<inter> T \<subseteq> \<Union>D"
     by (intro exI[of _ "D - {-T}"]) auto
 qed
 
 lemma compact_diff: "\<lbrakk>compact S; open T\<rbrakk> \<Longrightarrow> compact(S - T)"
   by (simp add: Diff_eq compact_Int_closed open_closed)
 
 lemma inj_setminus: "inj_on uminus (A::'a set set)"
   by (auto simp: inj_on_def)
 
 
 subsection \<open>Finite intersection property\<close>
 
 lemma compact_fip:
   "compact U \<longleftrightarrow>
     (\<forall>A. (\<forall>a\<in>A. closed a) \<longrightarrow> (\<forall>B \<subseteq> A. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {}) \<longrightarrow> U \<inter> \<Inter>A \<noteq> {})"
   (is "_ \<longleftrightarrow> ?R")
 proof (safe intro!: compact_eq_Heine_Borel[THEN iffD2])
   fix A
   assume "compact U"
   assume A: "\<forall>a\<in>A. closed a" "U \<inter> \<Inter>A = {}"
   assume fin: "\<forall>B \<subseteq> A. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {}"
   from A have "(\<forall>a\<in>uminus`A. open a) \<and> U \<subseteq> \<Union>(uminus`A)"
     by auto
   with \<open>compact U\<close> obtain B where "B \<subseteq> A" "finite (uminus`B)" "U \<subseteq> \<Union>(uminus`B)"
     unfolding compact_eq_Heine_Borel by (metis subset_image_iff)
   with fin[THEN spec, of B] show False
     by (auto dest: finite_imageD intro: inj_setminus)
 next
   fix A
   assume ?R
   assume "\<forall>a\<in>A. open a" "U \<subseteq> \<Union>A"
   then have "U \<inter> \<Inter>(uminus`A) = {}" "\<forall>a\<in>uminus`A. closed a"
     by auto
   with \<open>?R\<close> obtain B where "B \<subseteq> A" "finite (uminus`B)" "U \<inter> \<Inter>(uminus`B) = {}"
     by (metis subset_image_iff)
   then show "\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T"
     by (auto intro!: exI[of _ B] inj_setminus dest: finite_imageD)
 qed
 
 lemma compact_imp_fip:
   assumes "compact S"
     and "\<And>T. T \<in> F \<Longrightarrow> closed T"
     and "\<And>F'. finite F' \<Longrightarrow> F' \<subseteq> F \<Longrightarrow> S \<inter> (\<Inter>F') \<noteq> {}"
   shows "S \<inter> (\<Inter>F) \<noteq> {}"
   using assms unfolding compact_fip by auto
 
 lemma compact_imp_fip_image:
   assumes "compact s"
     and P: "\<And>i. i \<in> I \<Longrightarrow> closed (f i)"
     and Q: "\<And>I'. finite I' \<Longrightarrow> I' \<subseteq> I \<Longrightarrow> (s \<inter> (\<Inter>i\<in>I'. f i) \<noteq> {})"
   shows "s \<inter> (\<Inter>i\<in>I. f i) \<noteq> {}"
 proof -
   from P have "\<forall>i \<in> f ` I. closed i"
     by blast
   moreover have "\<forall>A. finite A \<and> A \<subseteq> f ` I \<longrightarrow> (s \<inter> (\<Inter>A) \<noteq> {})"
     by (metis Q finite_subset_image)
   ultimately show "s \<inter> (\<Inter>(f ` I)) \<noteq> {}"
     by (metis \<open>compact s\<close> compact_imp_fip)
 qed
 
 end
 
 lemma (in t2_space) compact_imp_closed:
   assumes "compact s"
   shows "closed s"
   unfolding closed_def
 proof (rule openI)
   fix y
   assume "y \<in> - s"
   let ?C = "\<Union>x\<in>s. {u. open u \<and> x \<in> u \<and> eventually (\<lambda>y. y \<notin> u) (nhds y)}"
   have "s \<subseteq> \<Union>?C"
   proof
     fix x
     assume "x \<in> s"
     with \<open>y \<in> - s\<close> have "x \<noteq> y" by clarsimp
     then have "\<exists>u v. open u \<and> open v \<and> x \<in> u \<and> y \<in> v \<and> u \<inter> v = {}"
       by (rule hausdorff)
     with \<open>x \<in> s\<close> show "x \<in> \<Union>?C"
       unfolding eventually_nhds by auto
   qed
   then obtain D where "D \<subseteq> ?C" and "finite D" and "s \<subseteq> \<Union>D"
     by (rule compactE [OF \<open>compact s\<close>]) auto
   from \<open>D \<subseteq> ?C\<close> have "\<forall>x\<in>D. eventually (\<lambda>y. y \<notin> x) (nhds y)"
     by auto
   with \<open>finite D\<close> have "eventually (\<lambda>y. y \<notin> \<Union>D) (nhds y)"
     by (simp add: eventually_ball_finite)
   with \<open>s \<subseteq> \<Union>D\<close> have "eventually (\<lambda>y. y \<notin> s) (nhds y)"
     by (auto elim!: eventually_mono)
   then show "\<exists>t. open t \<and> y \<in> t \<and> t \<subseteq> - s"
     by (simp add: eventually_nhds subset_eq)
 qed
 
 lemma compact_continuous_image:
   assumes f: "continuous_on s f"
     and s: "compact s"
   shows "compact (f ` s)"
 proof (rule compactI)
   fix C
   assume "\<forall>c\<in>C. open c" and cover: "f`s \<subseteq> \<Union>C"
   with f have "\<forall>c\<in>C. \<exists>A. open A \<and> A \<inter> s = f -` c \<inter> s"
     unfolding continuous_on_open_invariant by blast
   then obtain A where A: "\<forall>c\<in>C. open (A c) \<and> A c \<inter> s = f -` c \<inter> s"
     unfolding bchoice_iff ..
   with cover have "\<And>c. c \<in> C \<Longrightarrow> open (A c)" "s \<subseteq> (\<Union>c\<in>C. A c)"
     by (fastforce simp add: subset_eq set_eq_iff)+
   from compactE_image[OF s this] obtain D where "D \<subseteq> C" "finite D" "s \<subseteq> (\<Union>c\<in>D. A c)" .
   with A show "\<exists>D \<subseteq> C. finite D \<and> f`s \<subseteq> \<Union>D"
     by (intro exI[of _ D]) (fastforce simp add: subset_eq set_eq_iff)+
 qed
 
 lemma continuous_on_inv:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes "continuous_on s f"
     and "compact s"
     and "\<forall>x\<in>s. g (f x) = x"
   shows "continuous_on (f ` s) g"
   unfolding continuous_on_topological
 proof (clarsimp simp add: assms(3))
   fix x :: 'a and B :: "'a set"
   assume "x \<in> s" and "open B" and "x \<in> B"
   have 1: "\<forall>x\<in>s. f x \<in> f ` (s - B) \<longleftrightarrow> x \<in> s - B"
     using assms(3) by (auto, metis)
   have "continuous_on (s - B) f"
     using \<open>continuous_on s f\<close> Diff_subset
     by (rule continuous_on_subset)
   moreover have "compact (s - B)"
     using \<open>open B\<close> and \<open>compact s\<close>
     unfolding Diff_eq by (intro compact_Int_closed closed_Compl)
   ultimately have "compact (f ` (s - B))"
     by (rule compact_continuous_image)
   then have "closed (f ` (s - B))"
     by (rule compact_imp_closed)
   then have "open (- f ` (s - B))"
     by (rule open_Compl)
   moreover have "f x \<in> - f ` (s - B)"
     using \<open>x \<in> s\<close> and \<open>x \<in> B\<close> by (simp add: 1)
   moreover have "\<forall>y\<in>s. f y \<in> - f ` (s - B) \<longrightarrow> y \<in> B"
     by (simp add: 1)
   ultimately show "\<exists>A. open A \<and> f x \<in> A \<and> (\<forall>y\<in>s. f y \<in> A \<longrightarrow> y \<in> B)"
     by fast
 qed
 
 lemma continuous_on_inv_into:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes s: "continuous_on s f" "compact s"
     and f: "inj_on f s"
   shows "continuous_on (f ` s) (the_inv_into s f)"
   by (rule continuous_on_inv[OF s]) (auto simp: the_inv_into_f_f[OF f])
 
 lemma (in linorder_topology) compact_attains_sup:
   assumes "compact S" "S \<noteq> {}"
   shows "\<exists>s\<in>S. \<forall>t\<in>S. t \<le> s"
 proof (rule classical)
   assume "\<not> (\<exists>s\<in>S. \<forall>t\<in>S. t \<le> s)"
   then obtain t where t: "\<forall>s\<in>S. t s \<in> S" and "\<forall>s\<in>S. s < t s"
     by (metis not_le)
   then have "\<And>s. s\<in>S \<Longrightarrow> open {..< t s}" "S \<subseteq> (\<Union>s\<in>S. {..< t s})"
     by auto
   with \<open>compact S\<close> obtain C where "C \<subseteq> S" "finite C" and C: "S \<subseteq> (\<Union>s\<in>C. {..< t s})"
     by (metis compactE_image)
   with \<open>S \<noteq> {}\<close> have Max: "Max (t`C) \<in> t`C" and "\<forall>s\<in>t`C. s \<le> Max (t`C)"
     by (auto intro!: Max_in)
   with C have "S \<subseteq> {..< Max (t`C)}"
     by (auto intro: less_le_trans simp: subset_eq)
   with t Max \<open>C \<subseteq> S\<close> show ?thesis
     by fastforce
 qed
 
 lemma (in linorder_topology) compact_attains_inf:
   assumes "compact S" "S \<noteq> {}"
   shows "\<exists>s\<in>S. \<forall>t\<in>S. s \<le> t"
 proof (rule classical)
   assume "\<not> (\<exists>s\<in>S. \<forall>t\<in>S. s \<le> t)"
   then obtain t where t: "\<forall>s\<in>S. t s \<in> S" and "\<forall>s\<in>S. t s < s"
     by (metis not_le)
   then have "\<And>s. s\<in>S \<Longrightarrow> open {t s <..}" "S \<subseteq> (\<Union>s\<in>S. {t s <..})"
     by auto
   with \<open>compact S\<close> obtain C where "C \<subseteq> S" "finite C" and C: "S \<subseteq> (\<Union>s\<in>C. {t s <..})"
     by (metis compactE_image)
   with \<open>S \<noteq> {}\<close> have Min: "Min (t`C) \<in> t`C" and "\<forall>s\<in>t`C. Min (t`C) \<le> s"
     by (auto intro!: Min_in)
   with C have "S \<subseteq> {Min (t`C) <..}"
     by (auto intro: le_less_trans simp: subset_eq)
   with t Min \<open>C \<subseteq> S\<close> show ?thesis
     by fastforce
 qed
 
 lemma continuous_attains_sup:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f \<Longrightarrow> (\<exists>x\<in>s. \<forall>y\<in>s.  f y \<le> f x)"
   using compact_attains_sup[of "f ` s"] compact_continuous_image[of s f] by auto
 
 lemma continuous_attains_inf:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f \<Longrightarrow> (\<exists>x\<in>s. \<forall>y\<in>s. f x \<le> f y)"
   using compact_attains_inf[of "f ` s"] compact_continuous_image[of s f] by auto
 
 
 subsection \<open>Connectedness\<close>
 
 context topological_space
 begin
 
 definition "connected S \<longleftrightarrow>
   \<not> (\<exists>A B. open A \<and> open B \<and> S \<subseteq> A \<union> B \<and> A \<inter> B \<inter> S = {} \<and> A \<inter> S \<noteq> {} \<and> B \<inter> S \<noteq> {})"
 
 lemma connectedI:
   "(\<And>A B. open A \<Longrightarrow> open B \<Longrightarrow> A \<inter> U \<noteq> {} \<Longrightarrow> B \<inter> U \<noteq> {} \<Longrightarrow> A \<inter> B \<inter> U = {} \<Longrightarrow> U \<subseteq> A \<union> B \<Longrightarrow> False)
   \<Longrightarrow> connected U"
   by (auto simp: connected_def)
 
 lemma connected_empty [simp]: "connected {}"
   by (auto intro!: connectedI)
 
 lemma connected_sing [simp]: "connected {x}"
   by (auto intro!: connectedI)
 
 lemma connectedD:
   "connected A \<Longrightarrow> open U \<Longrightarrow> open V \<Longrightarrow> U \<inter> V \<inter> A = {} \<Longrightarrow> A \<subseteq> U \<union> V \<Longrightarrow> U \<inter> A = {} \<or> V \<inter> A = {}"
   by (auto simp: connected_def)
 
 end
 
 lemma connected_closed:
   "connected s \<longleftrightarrow>
     \<not> (\<exists>A B. closed A \<and> closed B \<and> s \<subseteq> A \<union> B \<and> A \<inter> B \<inter> s = {} \<and> A \<inter> s \<noteq> {} \<and> B \<inter> s \<noteq> {})"
   apply (simp add: connected_def del: ex_simps, safe)
    apply (drule_tac x="-A" in spec)
    apply (drule_tac x="-B" in spec)
    apply (fastforce simp add: closed_def [symmetric])
   apply (drule_tac x="-A" in spec)
   apply (drule_tac x="-B" in spec)
   apply (fastforce simp add: open_closed [symmetric])
   done
 
 lemma connected_closedD:
   "\<lbrakk>connected s; A \<inter> B \<inter> s = {}; s \<subseteq> A \<union> B; closed A; closed B\<rbrakk> \<Longrightarrow> A \<inter> s = {} \<or> B \<inter> s = {}"
   by (simp add: connected_closed)
 
 lemma connected_Union:
   assumes cs: "\<And>s. s \<in> S \<Longrightarrow> connected s"
     and ne: "\<Inter>S \<noteq> {}"
   shows "connected(\<Union>S)"
 proof (rule connectedI)
   fix A B
   assume A: "open A" and B: "open B" and Alap: "A \<inter> \<Union>S \<noteq> {}" and Blap: "B \<inter> \<Union>S \<noteq> {}"
     and disj: "A \<inter> B \<inter> \<Union>S = {}" and cover: "\<Union>S \<subseteq> A \<union> B"
   have disjs:"\<And>s. s \<in> S \<Longrightarrow> A \<inter> B \<inter> s = {}"
     using disj by auto
   obtain sa where sa: "sa \<in> S" "A \<inter> sa \<noteq> {}"
     using Alap by auto
   obtain sb where sb: "sb \<in> S" "B \<inter> sb \<noteq> {}"
     using Blap by auto
   obtain x where x: "\<And>s. s \<in> S \<Longrightarrow> x \<in> s"
     using ne by auto
   then have "x \<in> \<Union>S"
     using \<open>sa \<in> S\<close> by blast
   then have "x \<in> A \<or> x \<in> B"
     using cover by auto
   then show False
     using cs [unfolded connected_def]
     by (metis A B IntI Sup_upper sa sb disjs x cover empty_iff subset_trans)
 qed
 
 lemma connected_Un: "connected s \<Longrightarrow> connected t \<Longrightarrow> s \<inter> t \<noteq> {} \<Longrightarrow> connected (s \<union> t)"
   using connected_Union [of "{s,t}"] by auto
 
 lemma connected_diff_open_from_closed:
   assumes st: "s \<subseteq> t"
     and tu: "t \<subseteq> u"
     and s: "open s"
     and t: "closed t"
     and u: "connected u"
     and ts: "connected (t - s)"
   shows "connected(u - s)"
 proof (rule connectedI)
   fix A B
   assume AB: "open A" "open B" "A \<inter> (u - s) \<noteq> {}" "B \<inter> (u - s) \<noteq> {}"
     and disj: "A \<inter> B \<inter> (u - s) = {}"
     and cover: "u - s \<subseteq> A \<union> B"
   then consider "A \<inter> (t - s) = {}" | "B \<inter> (t - s) = {}"
     using st ts tu connectedD [of "t-s" "A" "B"] by auto
   then show False
   proof cases
     case 1
     then have "(A - t) \<inter> (B \<union> s) \<inter> u = {}"
       using disj st by auto
     moreover have "u \<subseteq> (A - t) \<union> (B \<union> s)"
       using 1 cover by auto
     ultimately show False
       using connectedD [of u "A - t" "B \<union> s"] AB s t 1 u by auto
   next
     case 2
     then have "(A \<union> s) \<inter> (B - t) \<inter> u = {}"
       using disj st by auto
     moreover have "u \<subseteq> (A \<union> s) \<union> (B - t)"
       using 2 cover by auto
     ultimately show False
       using connectedD [of u "A \<union> s" "B - t"] AB s t 2 u by auto
   qed
 qed
 
 lemma connected_iff_const:
   fixes S :: "'a::topological_space set"
   shows "connected S \<longleftrightarrow> (\<forall>P::'a \<Rightarrow> bool. continuous_on S P \<longrightarrow> (\<exists>c. \<forall>s\<in>S. P s = c))"
 proof safe
   fix P :: "'a \<Rightarrow> bool"
   assume "connected S" "continuous_on S P"
   then have "\<And>b. \<exists>A. open A \<and> A \<inter> S = P -` {b} \<inter> S"
     unfolding continuous_on_open_invariant by (simp add: open_discrete)
   from this[of True] this[of False]
   obtain t f where "open t" "open f" and *: "f \<inter> S = P -` {False} \<inter> S" "t \<inter> S = P -` {True} \<inter> S"
     by meson
   then have "t \<inter> S = {} \<or> f \<inter> S = {}"
     by (intro connectedD[OF \<open>connected S\<close>])  auto
   then show "\<exists>c. \<forall>s\<in>S. P s = c"
   proof (rule disjE)
     assume "t \<inter> S = {}"
     then show ?thesis
       unfolding * by (intro exI[of _ False]) auto
   next
     assume "f \<inter> S = {}"
     then show ?thesis
       unfolding * by (intro exI[of _ True]) auto
   qed
 next
   assume P: "\<forall>P::'a \<Rightarrow> bool. continuous_on S P \<longrightarrow> (\<exists>c. \<forall>s\<in>S. P s = c)"
   show "connected S"
   proof (rule connectedI)
     fix A B
     assume *: "open A" "open B" "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
     have "continuous_on S (\<lambda>x. x \<in> A)"
       unfolding continuous_on_open_invariant
     proof safe
       fix C :: "bool set"
       have "C = UNIV \<or> C = {True} \<or> C = {False} \<or> C = {}"
         using subset_UNIV[of C] unfolding UNIV_bool by auto
       with * show "\<exists>T. open T \<and> T \<inter> S = (\<lambda>x. x \<in> A) -` C \<inter> S"
         by (intro exI[of _ "(if True \<in> C then A else {}) \<union> (if False \<in> C then B else {})"]) auto
     qed
     from P[rule_format, OF this] obtain c where "\<And>s. s \<in> S \<Longrightarrow> (s \<in> A) = c"
       by blast
     with * show False
       by (cases c) auto
   qed
 qed
 
 lemma connectedD_const: "connected S \<Longrightarrow> continuous_on S P \<Longrightarrow> \<exists>c. \<forall>s\<in>S. P s = c"
   for P :: "'a::topological_space \<Rightarrow> bool"
   by (auto simp: connected_iff_const)
 
 lemma connectedI_const:
   "(\<And>P::'a::topological_space \<Rightarrow> bool. continuous_on S P \<Longrightarrow> \<exists>c. \<forall>s\<in>S. P s = c) \<Longrightarrow> connected S"
   by (auto simp: connected_iff_const)
 
 lemma connected_local_const:
   assumes "connected A" "a \<in> A" "b \<in> A"
     and *: "\<forall>a\<in>A. eventually (\<lambda>b. f a = f b) (at a within A)"
   shows "f a = f b"
 proof -
   obtain S where S: "\<And>a. a \<in> A \<Longrightarrow> a \<in> S a" "\<And>a. a \<in> A \<Longrightarrow> open (S a)"
     "\<And>a x. a \<in> A \<Longrightarrow> x \<in> S a \<Longrightarrow> x \<in> A \<Longrightarrow> f a = f x"
     using * unfolding eventually_at_topological by metis
   let ?P = "\<Union>b\<in>{b\<in>A. f a = f b}. S b" and ?N = "\<Union>b\<in>{b\<in>A. f a \<noteq> f b}. S b"
   have "?P \<inter> A = {} \<or> ?N \<inter> A = {}"
     using \<open>connected A\<close> S \<open>a\<in>A\<close>
     by (intro connectedD) (auto, metis)
   then show "f a = f b"
   proof
     assume "?N \<inter> A = {}"
     then have "\<forall>x\<in>A. f a = f x"
       using S(1) by auto
     with \<open>b\<in>A\<close> show ?thesis by auto
   next
     assume "?P \<inter> A = {}" then show ?thesis
       using \<open>a \<in> A\<close> S(1)[of a] by auto
   qed
 qed
 
 lemma (in linorder_topology) connectedD_interval:
   assumes "connected U"
     and xy: "x \<in> U" "y \<in> U"
     and "x \<le> z" "z \<le> y"
   shows "z \<in> U"
 proof -
   have eq: "{..<z} \<union> {z<..} = - {z}"
     by auto
   have "\<not> connected U" if "z \<notin> U" "x < z" "z < y"
     using xy that
     apply (simp only: connected_def simp_thms)
     apply (rule_tac exI[of _ "{..< z}"])
     apply (rule_tac exI[of _ "{z <..}"])
     apply (auto simp add: eq)
     done
   with assms show "z \<in> U"
     by (metis less_le)
 qed
 
 lemma (in linorder_topology) not_in_connected_cases:
   assumes conn: "connected S"
   assumes nbdd: "x \<notin> S"
   assumes ne: "S \<noteq> {}"
   obtains "bdd_above S" "\<And>y. y \<in> S \<Longrightarrow> x \<ge> y" | "bdd_below S" "\<And>y. y \<in> S \<Longrightarrow> x \<le> y"
 proof -
   obtain s where "s \<in> S" using ne by blast
   {
     assume "s \<le> x"
     have "False" if "x \<le> y" "y \<in> S" for y
       using connectedD_interval[OF conn \<open>s \<in> S\<close> \<open>y \<in> S\<close> \<open>s \<le> x\<close> \<open>x \<le> y\<close>] \<open>x \<notin> S\<close>
       by simp
     then have wit: "y \<in> S \<Longrightarrow> x \<ge> y" for y
       using le_cases by blast
     then have "bdd_above S"
       by (rule local.bdd_aboveI)
     note this wit
   } moreover {
     assume "x \<le> s"
     have "False" if "x \<ge> y" "y \<in> S" for y
       using connectedD_interval[OF conn \<open>y \<in> S\<close> \<open>s \<in> S\<close> \<open>x \<ge> y\<close> \<open>s \<ge> x\<close> ] \<open>x \<notin> S\<close>
       by simp
     then have wit: "y \<in> S \<Longrightarrow> x \<le> y" for y
       using le_cases by blast
     then have "bdd_below S"
       by (rule bdd_belowI)
     note this wit
   } ultimately show ?thesis
     by (meson le_cases that)
 qed
 
 lemma connected_continuous_image:
   assumes *: "continuous_on s f"
     and "connected s"
   shows "connected (f ` s)"
 proof (rule connectedI_const)
   fix P :: "'b \<Rightarrow> bool"
   assume "continuous_on (f ` s) P"
   then have "continuous_on s (P \<circ> f)"
     by (rule continuous_on_compose[OF *])
   from connectedD_const[OF \<open>connected s\<close> this] show "\<exists>c. \<forall>s\<in>f ` s. P s = c"
     by auto
 qed
 
 lemma connected_Un_UN:
   assumes "connected A" "\<And>X. X \<in> B \<Longrightarrow> connected X" "\<And>X. X \<in> B \<Longrightarrow> A \<inter> X \<noteq> {}"
   shows   "connected (A \<union> \<Union>B)"
 proof (rule connectedI_const)
   fix f :: "'a \<Rightarrow> bool"
   assume f: "continuous_on (A \<union> \<Union>B) f"
   have "connected A" "continuous_on A f"
     by (auto intro: assms continuous_on_subset[OF f(1)])
   from connectedD_const[OF this] obtain c where c: "\<And>x. x \<in> A \<Longrightarrow> f x = c"
     by metis
   have "f x = c" if "x \<in> X" "X \<in> B" for x X
   proof -
     have "connected X" "continuous_on X f"
       using that by (auto intro: assms continuous_on_subset[OF f])
     from connectedD_const[OF this] obtain c' where c': "\<And>x. x \<in> X \<Longrightarrow> f x = c'"
       by metis
     from assms(3) and that obtain y where "y \<in> A \<inter> X"
       by auto
     with c[of y] c'[of y] c'[of x] that show ?thesis
       by auto
   qed
   with c show "\<exists>c. \<forall>x\<in>A \<union> \<Union> B. f x = c"
     by (intro exI[of _ c]) auto
 qed   
 
 section \<open>Linear Continuum Topologies\<close>
 
 class linear_continuum_topology = linorder_topology + linear_continuum
 begin
 
 lemma Inf_notin_open:
   assumes A: "open A"
     and bnd: "\<forall>a\<in>A. x < a"
   shows "Inf A \<notin> A"
 proof
   assume "Inf A \<in> A"
   then obtain b where "b < Inf A" "{b <.. Inf A} \<subseteq> A"
     using open_left[of A "Inf A" x] assms by auto
   with dense[of b "Inf A"] obtain c where "c < Inf A" "c \<in> A"
     by (auto simp: subset_eq)
   then show False
     using cInf_lower[OF \<open>c \<in> A\<close>] bnd
     by (metis not_le less_imp_le bdd_belowI)
 qed
 
 lemma Sup_notin_open:
   assumes A: "open A"
     and bnd: "\<forall>a\<in>A. a < x"
   shows "Sup A \<notin> A"
 proof
   assume "Sup A \<in> A"
   with assms obtain b where "Sup A < b" "{Sup A ..< b} \<subseteq> A"
     using open_right[of A "Sup A" x] by auto
   with dense[of "Sup A" b] obtain c where "Sup A < c" "c \<in> A"
     by (auto simp: subset_eq)
   then show False
     using cSup_upper[OF \<open>c \<in> A\<close>] bnd
     by (metis less_imp_le not_le bdd_aboveI)
 qed
 
 end
 
 instance linear_continuum_topology \<subseteq> perfect_space
 proof
   fix x :: 'a
   obtain y where "x < y \<or> y < x"
     using ex_gt_or_lt [of x] ..
   with Inf_notin_open[of "{x}" y] Sup_notin_open[of "{x}" y] show "\<not> open {x}"
     by auto
 qed
 
 lemma connectedI_interval:
   fixes U :: "'a :: linear_continuum_topology set"
   assumes *: "\<And>x y z. x \<in> U \<Longrightarrow> y \<in> U \<Longrightarrow> x \<le> z \<Longrightarrow> z \<le> y \<Longrightarrow> z \<in> U"
   shows "connected U"
 proof (rule connectedI)
   {
     fix A B
     assume "open A" "open B" "A \<inter> B \<inter> U = {}" "U \<subseteq> A \<union> B"
     fix x y
     assume "x < y" "x \<in> A" "y \<in> B" "x \<in> U" "y \<in> U"
 
     let ?z = "Inf (B \<inter> {x <..})"
 
     have "x \<le> ?z" "?z \<le> y"
       using \<open>y \<in> B\<close> \<open>x < y\<close> by (auto intro: cInf_lower cInf_greatest)
     with \<open>x \<in> U\<close> \<open>y \<in> U\<close> have "?z \<in> U"
       by (rule *)
     moreover have "?z \<notin> B \<inter> {x <..}"
       using \<open>open B\<close> by (intro Inf_notin_open) auto
     ultimately have "?z \<in> A"
       using \<open>x \<le> ?z\<close> \<open>A \<inter> B \<inter> U = {}\<close> \<open>x \<in> A\<close> \<open>U \<subseteq> A \<union> B\<close> by auto
     have "\<exists>b\<in>B. b \<in> A \<and> b \<in> U" if "?z < y"
     proof -
       obtain a where "?z < a" "{?z ..< a} \<subseteq> A"
         using open_right[OF \<open>open A\<close> \<open>?z \<in> A\<close> \<open>?z < y\<close>] by auto
       moreover obtain b where "b \<in> B" "x < b" "b < min a y"
         using cInf_less_iff[of "B \<inter> {x <..}" "min a y"] \<open>?z < a\<close> \<open>?z < y\<close> \<open>x < y\<close> \<open>y \<in> B\<close>
         by auto
       moreover have "?z \<le> b"
         using \<open>b \<in> B\<close> \<open>x < b\<close>
         by (intro cInf_lower) auto
       moreover have "b \<in> U"
         using \<open>x \<le> ?z\<close> \<open>?z \<le> b\<close> \<open>b < min a y\<close>
         by (intro *[OF \<open>x \<in> U\<close> \<open>y \<in> U\<close>]) (auto simp: less_imp_le)
       ultimately show ?thesis
         by (intro bexI[of _ b]) auto
     qed
     then have False
       using \<open>?z \<le> y\<close> \<open>?z \<in> A\<close> \<open>y \<in> B\<close> \<open>y \<in> U\<close> \<open>A \<inter> B \<inter> U = {}\<close>
       unfolding le_less by blast
   }
   note not_disjoint = this
 
   fix A B assume AB: "open A" "open B" "U \<subseteq> A \<union> B" "A \<inter> B \<inter> U = {}"
   moreover assume "A \<inter> U \<noteq> {}" then obtain x where x: "x \<in> U" "x \<in> A" by auto
   moreover assume "B \<inter> U \<noteq> {}" then obtain y where y: "y \<in> U" "y \<in> B" by auto
   moreover note not_disjoint[of B A y x] not_disjoint[of A B x y]
   ultimately show False
     by (cases x y rule: linorder_cases) auto
 qed
 
 lemma connected_iff_interval: "connected U \<longleftrightarrow> (\<forall>x\<in>U. \<forall>y\<in>U. \<forall>z. x \<le> z \<longrightarrow> z \<le> y \<longrightarrow> z \<in> U)"
   for U :: "'a::linear_continuum_topology set"
   by (auto intro: connectedI_interval dest: connectedD_interval)
 
 lemma connected_UNIV[simp]: "connected (UNIV::'a::linear_continuum_topology set)"
   by (simp add: connected_iff_interval)
 
 lemma connected_Ioi[simp]: "connected {a<..}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ici[simp]: "connected {a..}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Iio[simp]: "connected {..<a}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Iic[simp]: "connected {..a}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ioo[simp]: "connected {a<..<b}"
   for a b :: "'a::linear_continuum_topology"
   unfolding connected_iff_interval by auto
 
 lemma connected_Ioc[simp]: "connected {a<..b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ico[simp]: "connected {a..<b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Icc[simp]: "connected {a..b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_contains_Ioo:
   fixes A :: "'a :: linorder_topology set"
   assumes "connected A" "a \<in> A" "b \<in> A" shows "{a <..< b} \<subseteq> A"
   using connectedD_interval[OF assms] by (simp add: subset_eq Ball_def less_imp_le)
 
 lemma connected_contains_Icc:
   fixes A :: "'a::linorder_topology set"
   assumes "connected A" "a \<in> A" "b \<in> A"
   shows "{a..b} \<subseteq> A"
 proof
   fix x assume "x \<in> {a..b}"
   then have "x = a \<or> x = b \<or> x \<in> {a<..<b}"
     by auto
   then show "x \<in> A"
     using assms connected_contains_Ioo[of A a b] by auto
 qed
 
 
 subsection \<open>Intermediate Value Theorem\<close>
 
 lemma IVT':
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   assumes y: "f a \<le> y" "y \<le> f b" "a \<le> b"
     and *: "continuous_on {a .. b} f"
   shows "\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
 proof -
   have "connected {a..b}"
     unfolding connected_iff_interval by auto
   from connected_continuous_image[OF * this, THEN connectedD_interval, of "f a" "f b" y] y
   show ?thesis
     by (auto simp add: atLeastAtMost_def atLeast_def atMost_def)
 qed
 
 lemma IVT2':
   fixes f :: "'a :: linear_continuum_topology \<Rightarrow> 'b :: linorder_topology"
   assumes y: "f b \<le> y" "y \<le> f a" "a \<le> b"
     and *: "continuous_on {a .. b} f"
   shows "\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
 proof -
   have "connected {a..b}"
     unfolding connected_iff_interval by auto
   from connected_continuous_image[OF * this, THEN connectedD_interval, of "f b" "f a" y] y
   show ?thesis
     by (auto simp add: atLeastAtMost_def atLeast_def atMost_def)
 qed
 
 lemma IVT:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   shows "f a \<le> y \<Longrightarrow> y \<le> f b \<Longrightarrow> a \<le> b \<Longrightarrow> (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x) \<Longrightarrow>
     \<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
   by (rule IVT') (auto intro: continuous_at_imp_continuous_on)
 
 lemma IVT2:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   shows "f b \<le> y \<Longrightarrow> y \<le> f a \<Longrightarrow> a \<le> b \<Longrightarrow> (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x) \<Longrightarrow>
     \<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
   by (rule IVT2') (auto intro: continuous_at_imp_continuous_on)
 
 lemma continuous_inj_imp_mono:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   assumes x: "a < x" "x < b"
     and cont: "continuous_on {a..b} f"
     and inj: "inj_on f {a..b}"
   shows "(f a < f x \<and> f x < f b) \<or> (f b < f x \<and> f x < f a)"
 proof -
   note I = inj_on_eq_iff[OF inj]
   {
     assume "f x < f a" "f x < f b"
     then obtain s t where "x \<le> s" "s \<le> b" "a \<le> t" "t \<le> x" "f s = f t" "f x < f s"
       using IVT'[of f x "min (f a) (f b)" b] IVT2'[of f x "min (f a) (f b)" a] x
       by (auto simp: continuous_on_subset[OF cont] less_imp_le)
     with x I have False by auto
   }
   moreover
   {
     assume "f a < f x" "f b < f x"
     then obtain s t where "x \<le> s" "s \<le> b" "a \<le> t" "t \<le> x" "f s = f t" "f s < f x"
       using IVT'[of f a "max (f a) (f b)" x] IVT2'[of f b "max (f a) (f b)" x] x
       by (auto simp: continuous_on_subset[OF cont] less_imp_le)
     with x I have False by auto
   }
   ultimately show ?thesis
     using I[of a x] I[of x b] x less_trans[OF x]
     by (auto simp add: le_less less_imp_neq neq_iff)
 qed
 
 lemma continuous_at_Sup_mono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "mono f"
     and cont: "continuous (at_left (Sup S)) f"
     and S: "S \<noteq> {}" "bdd_above S"
   shows "f (Sup S) = (SUP s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Sup S)) (at_left (Sup S))"
     using cont unfolding continuous_within .
   show "f (Sup S) \<le> (SUP s\<in>S. f s)"
   proof cases
     assume "Sup S \<in> S"
     then show ?thesis
       by (rule cSUP_upper) (auto intro: bdd_above_image_mono S \<open>mono f\<close>)
   next
     assume "Sup S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Sup S \<notin> S\<close> S have "s < Sup S"
       unfolding less_le by (blast intro: cSup_upper)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(1)[OF f, of "SUP s\<in>S. f s"] obtain b where "b < Sup S"
         and *: "\<And>y. b < y \<Longrightarrow> y < Sup S \<Longrightarrow> (SUP s\<in>S. f s) < f y"
         by (auto simp: not_le eventually_at_left[OF \<open>s < Sup S\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "b < c"
         using less_cSupD[of S b] by auto
       with \<open>Sup S \<notin> S\<close> S have "c < Sup S"
         unfolding less_le by (blast intro: cSup_upper)
       from *[OF \<open>b < c\<close> \<open>c < Sup S\<close>] cSUP_upper[OF \<open>c \<in> S\<close> bdd_above_image_mono[of f]]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cSUP_least \<open>mono f\<close>[THEN monoD] cSup_upper S)
 
 lemma continuous_at_Sup_antimono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "antimono f"
     and cont: "continuous (at_left (Sup S)) f"
     and S: "S \<noteq> {}" "bdd_above S"
   shows "f (Sup S) = (INF s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Sup S)) (at_left (Sup S))"
     using cont unfolding continuous_within .
   show "(INF s\<in>S. f s) \<le> f (Sup S)"
   proof cases
     assume "Sup S \<in> S"
     then show ?thesis
       by (intro cINF_lower) (auto intro: bdd_below_image_antimono S \<open>antimono f\<close>)
   next
     assume "Sup S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Sup S \<notin> S\<close> S have "s < Sup S"
       unfolding less_le by (blast intro: cSup_upper)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(2)[OF f, of "INF s\<in>S. f s"] obtain b where "b < Sup S"
         and *: "\<And>y. b < y \<Longrightarrow> y < Sup S \<Longrightarrow> f y < (INF s\<in>S. f s)"
         by (auto simp: not_le eventually_at_left[OF \<open>s < Sup S\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "b < c"
         using less_cSupD[of S b] by auto
       with \<open>Sup S \<notin> S\<close> S have "c < Sup S"
         unfolding less_le by (blast intro: cSup_upper)
       from *[OF \<open>b < c\<close> \<open>c < Sup S\<close>] cINF_lower[OF bdd_below_image_antimono, of f S c] \<open>c \<in> S\<close>
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cINF_greatest \<open>antimono f\<close>[THEN antimonoD] cSup_upper S)
 
 lemma continuous_at_Inf_mono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "mono f"
     and cont: "continuous (at_right (Inf S)) f"
     and S: "S \<noteq> {}" "bdd_below S"
   shows "f (Inf S) = (INF s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Inf S)) (at_right (Inf S))"
     using cont unfolding continuous_within .
   show "(INF s\<in>S. f s) \<le> f (Inf S)"
   proof cases
     assume "Inf S \<in> S"
     then show ?thesis
       by (rule cINF_lower[rotated]) (auto intro: bdd_below_image_mono S \<open>mono f\<close>)
   next
     assume "Inf S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Inf S \<notin> S\<close> S have "Inf S < s"
       unfolding less_le by (blast intro: cInf_lower)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(2)[OF f, of "INF s\<in>S. f s"] obtain b where "Inf S < b"
         and *: "\<And>y. Inf S < y \<Longrightarrow> y < b \<Longrightarrow> f y < (INF s\<in>S. f s)"
         by (auto simp: not_le eventually_at_right[OF \<open>Inf S < s\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "c < b"
         using cInf_lessD[of S b] by auto
       with \<open>Inf S \<notin> S\<close> S have "Inf S < c"
         unfolding less_le by (blast intro: cInf_lower)
       from *[OF \<open>Inf S < c\<close> \<open>c < b\<close>] cINF_lower[OF bdd_below_image_mono[of f] \<open>c \<in> S\<close>]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cINF_greatest \<open>mono f\<close>[THEN monoD] cInf_lower \<open>bdd_below S\<close> \<open>S \<noteq> {}\<close>)
 
 lemma continuous_at_Inf_antimono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "antimono f"
     and cont: "continuous (at_right (Inf S)) f"
     and S: "S \<noteq> {}" "bdd_below S"
   shows "f (Inf S) = (SUP s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Inf S)) (at_right (Inf S))"
     using cont unfolding continuous_within .
   show "f (Inf S) \<le> (SUP s\<in>S. f s)"
   proof cases
     assume "Inf S \<in> S"
     then show ?thesis
       by (rule cSUP_upper) (auto intro: bdd_above_image_antimono S \<open>antimono f\<close>)
   next
     assume "Inf S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Inf S \<notin> S\<close> S have "Inf S < s"
       unfolding less_le by (blast intro: cInf_lower)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(1)[OF f, of "SUP s\<in>S. f s"] obtain b where "Inf S < b"
         and *: "\<And>y. Inf S < y \<Longrightarrow> y < b \<Longrightarrow> (SUP s\<in>S. f s) < f y"
         by (auto simp: not_le eventually_at_right[OF \<open>Inf S < s\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "c < b"
         using cInf_lessD[of S b] by auto
       with \<open>Inf S \<notin> S\<close> S have "Inf S < c"
         unfolding less_le by (blast intro: cInf_lower)
       from *[OF \<open>Inf S < c\<close> \<open>c < b\<close>] cSUP_upper[OF \<open>c \<in> S\<close> bdd_above_image_antimono[of f]]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cSUP_least \<open>antimono f\<close>[THEN antimonoD] cInf_lower S)
 
 
 subsection \<open>Uniform spaces\<close>
 
 class uniformity =
   fixes uniformity :: "('a \<times> 'a) filter"
 begin
 
 abbreviation uniformity_on :: "'a set \<Rightarrow> ('a \<times> 'a) filter"
   where "uniformity_on s \<equiv> inf uniformity (principal (s\<times>s))"
 
 end
 
 lemma uniformity_Abort:
   "uniformity =
     Filter.abstract_filter (\<lambda>u. Code.abort (STR ''uniformity is not executable'') (\<lambda>u. uniformity))"
   by simp
 
 class open_uniformity = "open" + uniformity +
   assumes open_uniformity:
     "\<And>U. open U \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 begin
 
 subclass topological_space
   by standard (force elim: eventually_mono eventually_elim2 simp: split_beta' open_uniformity)+
 
 end
 
 class uniform_space = open_uniformity +
   assumes uniformity_refl: "eventually E uniformity \<Longrightarrow> E (x, x)"
     and uniformity_sym: "eventually E uniformity \<Longrightarrow> eventually (\<lambda>(x, y). E (y, x)) uniformity"
     and uniformity_trans:
       "eventually E uniformity \<Longrightarrow>
         \<exists>D. eventually D uniformity \<and> (\<forall>x y z. D (x, y) \<longrightarrow> D (y, z) \<longrightarrow> E (x, z))"
 begin
 
 lemma uniformity_bot: "uniformity \<noteq> bot"
   using uniformity_refl by auto
 
 lemma uniformity_trans':
   "eventually E uniformity \<Longrightarrow>
     eventually (\<lambda>((x, y), (y', z)). y = y' \<longrightarrow> E (x, z)) (uniformity \<times>\<^sub>F uniformity)"
   by (drule uniformity_trans) (auto simp add: eventually_prod_same)
 
 lemma uniformity_transE:
   assumes "eventually E uniformity"
   obtains D where "eventually D uniformity" "\<And>x y z. D (x, y) \<Longrightarrow> D (y, z) \<Longrightarrow> E (x, z)"
   using uniformity_trans [OF assms] by auto
 
 lemma eventually_nhds_uniformity:
   "eventually P (nhds x) \<longleftrightarrow> eventually (\<lambda>(x', y). x' = x \<longrightarrow> P y) uniformity"
   (is "_ \<longleftrightarrow> ?N P x")
   unfolding eventually_nhds
 proof safe
   assume *: "?N P x"
   have "?N (?N P) x" if "?N P x" for x
   proof -
     from that obtain D where ev: "eventually D uniformity"
       and D: "D (a, b) \<Longrightarrow> D (b, c) \<Longrightarrow> case (a, c) of (x', y) \<Rightarrow> x' = x \<longrightarrow> P y" for a b c
       by (rule uniformity_transE) simp
     from ev show ?thesis
       by eventually_elim (insert ev D, force elim: eventually_mono split: prod.split)
   qed
   then have "open {x. ?N P x}"
     by (simp add: open_uniformity)
   then show "\<exists>S. open S \<and> x \<in> S \<and> (\<forall>x\<in>S. P x)"
     by (intro exI[of _ "{x. ?N P x}"]) (auto dest: uniformity_refl simp: *)
 qed (force simp add: open_uniformity elim: eventually_mono)
 
 
 subsubsection \<open>Totally bounded sets\<close>
 
 definition totally_bounded :: "'a set \<Rightarrow> bool"
   where "totally_bounded S \<longleftrightarrow>
     (\<forall>E. eventually E uniformity \<longrightarrow> (\<exists>X. finite X \<and> (\<forall>s\<in>S. \<exists>x\<in>X. E (x, s))))"
 
 lemma totally_bounded_empty[iff]: "totally_bounded {}"
   by (auto simp add: totally_bounded_def)
 
 lemma totally_bounded_subset: "totally_bounded S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> totally_bounded T"
   by (fastforce simp add: totally_bounded_def)
 
 lemma totally_bounded_Union[intro]:
   assumes M: "finite M" "\<And>S. S \<in> M \<Longrightarrow> totally_bounded S"
   shows "totally_bounded (\<Union>M)"
   unfolding totally_bounded_def
 proof safe
   fix E
   assume "eventually E uniformity"
   with M obtain X where "\<forall>S\<in>M. finite (X S) \<and> (\<forall>s\<in>S. \<exists>x\<in>X S. E (x, s))"
     by (metis totally_bounded_def)
   with \<open>finite M\<close> show "\<exists>X. finite X \<and> (\<forall>s\<in>\<Union>M. \<exists>x\<in>X. E (x, s))"
     by (intro exI[of _ "\<Union>S\<in>M. X S"]) force
 qed
 
 
 subsubsection \<open>Cauchy filter\<close>
 
 definition cauchy_filter :: "'a filter \<Rightarrow> bool"
   where "cauchy_filter F \<longleftrightarrow> F \<times>\<^sub>F F \<le> uniformity"
 
 definition Cauchy :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where Cauchy_uniform: "Cauchy X = cauchy_filter (filtermap X sequentially)"
 
 lemma Cauchy_uniform_iff:
   "Cauchy X \<longleftrightarrow> (\<forall>P. eventually P uniformity \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m)))"
   unfolding Cauchy_uniform cauchy_filter_def le_filter_def eventually_prod_same
     eventually_filtermap eventually_sequentially
 proof safe
   let ?U = "\<lambda>P. eventually P uniformity"
   {
     fix P
     assume "?U P" "\<forall>P. ?U P \<longrightarrow> (\<exists>Q. (\<exists>N. \<forall>n\<ge>N. Q (X n)) \<and> (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y)))"
     then obtain Q N where "\<And>n. n \<ge> N \<Longrightarrow> Q (X n)" "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> P (x, y)"
       by metis
     then show "\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m)"
       by blast
   next
     fix P
     assume "?U P" and P: "\<forall>P. ?U P \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m))"
     then obtain Q where "?U Q" and Q: "\<And>x y z. Q (x, y) \<Longrightarrow> Q (y, z) \<Longrightarrow> P (x, z)"
       by (auto elim: uniformity_transE)
     then have "?U (\<lambda>x. Q x \<and> (\<lambda>(x, y). Q (y, x)) x)"
       unfolding eventually_conj_iff by (simp add: uniformity_sym)
     from P[rule_format, OF this]
     obtain N where N: "\<And>n m. n \<ge> N \<Longrightarrow> m \<ge> N \<Longrightarrow> Q (X n, X m) \<and> Q (X m, X n)"
       by auto
     show "\<exists>Q. (\<exists>N. \<forall>n\<ge>N. Q (X n)) \<and> (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y))"
     proof (safe intro!: exI[of _ "\<lambda>x. \<forall>n\<ge>N. Q (x, X n) \<and> Q (X n, x)"] exI[of _ N] N)
       fix x y
       assume "\<forall>n\<ge>N. Q (x, X n) \<and> Q (X n, x)" "\<forall>n\<ge>N. Q (y, X n) \<and> Q (X n, y)"
       then have "Q (x, X N)" "Q (X N, y)" by auto
       then show "P (x, y)"
         by (rule Q)
     qed
   }
 qed
 
 lemma nhds_imp_cauchy_filter:
   assumes *: "F \<le> nhds x"
   shows "cauchy_filter F"
 proof -
   have "F \<times>\<^sub>F F \<le> nhds x \<times>\<^sub>F nhds x"
     by (intro prod_filter_mono *)
   also have "\<dots> \<le> uniformity"
     unfolding le_filter_def eventually_nhds_uniformity eventually_prod_same
   proof safe
     fix P
     assume "eventually P uniformity"
     then obtain Ql where ev: "eventually Ql uniformity"
       and "Ql (x, y) \<Longrightarrow> Ql (y, z) \<Longrightarrow> P (x, z)" for x y z
       by (rule uniformity_transE) simp
     with ev[THEN uniformity_sym]
     show "\<exists>Q. eventually (\<lambda>(x', y). x' = x \<longrightarrow> Q y) uniformity \<and>
         (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y))"
       by (rule_tac exI[of _ "\<lambda>y. Ql (y, x) \<and> Ql (x, y)"]) (fastforce elim: eventually_elim2)
   qed
   finally show ?thesis
     by (simp add: cauchy_filter_def)
 qed
 
 lemma LIMSEQ_imp_Cauchy: "X \<longlonglongrightarrow> x \<Longrightarrow> Cauchy X"
   unfolding Cauchy_uniform filterlim_def by (intro nhds_imp_cauchy_filter)
 
 lemma Cauchy_subseq_Cauchy:
   assumes "Cauchy X" "strict_mono f"
   shows "Cauchy (X \<circ> f)"
   unfolding Cauchy_uniform comp_def filtermap_filtermap[symmetric] cauchy_filter_def
   by (rule order_trans[OF _ \<open>Cauchy X\<close>[unfolded Cauchy_uniform cauchy_filter_def]])
      (intro prod_filter_mono filtermap_mono filterlim_subseq[OF \<open>strict_mono f\<close>, unfolded filterlim_def])
 
 lemma convergent_Cauchy: "convergent X \<Longrightarrow> Cauchy X"
   unfolding convergent_def by (erule exE, erule LIMSEQ_imp_Cauchy)
 
 definition complete :: "'a set \<Rightarrow> bool"
   where complete_uniform: "complete S \<longleftrightarrow>
     (\<forall>F \<le> principal S. F \<noteq> bot \<longrightarrow> cauchy_filter F \<longrightarrow> (\<exists>x\<in>S. F \<le> nhds x))"
 
 lemma (in uniform_space) cauchy_filter_complete_converges:
   assumes "cauchy_filter F" "complete A" "F \<le> principal A" "F \<noteq> bot"
   shows   "\<exists>c. F \<le> nhds c"
   using assms unfolding complete_uniform by blast
 
 end
 
 subsubsection \<open>Uniformly continuous functions\<close>
 
 definition uniformly_continuous_on :: "'a set \<Rightarrow> ('a::uniform_space \<Rightarrow> 'b::uniform_space) \<Rightarrow> bool"
   where uniformly_continuous_on_uniformity: "uniformly_continuous_on s f \<longleftrightarrow>
     (LIM (x, y) (uniformity_on s). (f x, f y) :> uniformity)"
 
 lemma uniformly_continuous_onD:
   "uniformly_continuous_on s f \<Longrightarrow> eventually E uniformity \<Longrightarrow>
     eventually (\<lambda>(x, y). x \<in> s \<longrightarrow> y \<in> s \<longrightarrow> E (f x, f y)) uniformity"
   by (simp add: uniformly_continuous_on_uniformity filterlim_iff
       eventually_inf_principal split_beta' mem_Times_iff imp_conjL)
 
 lemma uniformly_continuous_on_const[continuous_intros]: "uniformly_continuous_on s (\<lambda>x. c)"
   by (auto simp: uniformly_continuous_on_uniformity filterlim_iff uniformity_refl)
 
 lemma uniformly_continuous_on_id[continuous_intros]: "uniformly_continuous_on s (\<lambda>x. x)"
   by (auto simp: uniformly_continuous_on_uniformity filterlim_def)
 
 lemma uniformly_continuous_on_compose:
   "uniformly_continuous_on s g \<Longrightarrow> uniformly_continuous_on (g`s) f \<Longrightarrow>
     uniformly_continuous_on s (\<lambda>x. f (g x))"
   using filterlim_compose[of "\<lambda>(x, y). (f x, f y)" uniformity
       "uniformity_on (g`s)"  "\<lambda>(x, y). (g x, g y)" "uniformity_on s"]
   by (simp add: split_beta' uniformly_continuous_on_uniformity
       filterlim_inf filterlim_principal eventually_inf_principal mem_Times_iff)
 
 lemma uniformly_continuous_imp_continuous:
   assumes f: "uniformly_continuous_on s f"
   shows "continuous_on s f"
   by (auto simp: filterlim_iff eventually_at_filter eventually_nhds_uniformity continuous_on_def
            elim: eventually_mono dest!: uniformly_continuous_onD[OF f])
 
 
 section \<open>Product Topology\<close>
 
 subsection \<open>Product is a topological space\<close>
 
 instantiation prod :: (topological_space, topological_space) topological_space
 begin
 
 definition open_prod_def[code del]:
   "open (S :: ('a \<times> 'b) set) \<longleftrightarrow>
     (\<forall>x\<in>S. \<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S)"
 
 lemma open_prod_elim:
   assumes "open S" and "x \<in> S"
   obtains A B where "open A" and "open B" and "x \<in> A \<times> B" and "A \<times> B \<subseteq> S"
   using assms unfolding open_prod_def by fast
 
 lemma open_prod_intro:
   assumes "\<And>x. x \<in> S \<Longrightarrow> \<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S"
   shows "open S"
   using assms unfolding open_prod_def by fast
 
 instance
 proof
   show "open (UNIV :: ('a \<times> 'b) set)"
     unfolding open_prod_def by auto
 next
   fix S T :: "('a \<times> 'b) set"
   assume "open S" "open T"
   show "open (S \<inter> T)"
   proof (rule open_prod_intro)
     fix x
     assume x: "x \<in> S \<inter> T"
     from x have "x \<in> S" by simp
     obtain Sa Sb where A: "open Sa" "open Sb" "x \<in> Sa \<times> Sb" "Sa \<times> Sb \<subseteq> S"
       using \<open>open S\<close> and \<open>x \<in> S\<close> by (rule open_prod_elim)
     from x have "x \<in> T" by simp
     obtain Ta Tb where B: "open Ta" "open Tb" "x \<in> Ta \<times> Tb" "Ta \<times> Tb \<subseteq> T"
       using \<open>open T\<close> and \<open>x \<in> T\<close> by (rule open_prod_elim)
     let ?A = "Sa \<inter> Ta" and ?B = "Sb \<inter> Tb"
     have "open ?A \<and> open ?B \<and> x \<in> ?A \<times> ?B \<and> ?A \<times> ?B \<subseteq> S \<inter> T"
       using A B by (auto simp add: open_Int)
     then show "\<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S \<inter> T"
       by fast
   qed
 next
   fix K :: "('a \<times> 'b) set set"
   assume "\<forall>S\<in>K. open S"
   then show "open (\<Union>K)"
     unfolding open_prod_def by fast
 qed
 
 end
 
 declare [[code abort: "open :: ('a::topological_space \<times> 'b::topological_space) set \<Rightarrow> bool"]]
 
 lemma open_Times: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<times> T)"
   unfolding open_prod_def by auto
 
 lemma fst_vimage_eq_Times: "fst -` S = S \<times> UNIV"
   by auto
 
 lemma snd_vimage_eq_Times: "snd -` S = UNIV \<times> S"
   by auto
 
 lemma open_vimage_fst: "open S \<Longrightarrow> open (fst -` S)"
   by (simp add: fst_vimage_eq_Times open_Times)
 
 lemma open_vimage_snd: "open S \<Longrightarrow> open (snd -` S)"
   by (simp add: snd_vimage_eq_Times open_Times)
 
 lemma closed_vimage_fst: "closed S \<Longrightarrow> closed (fst -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_fst)
 
 lemma closed_vimage_snd: "closed S \<Longrightarrow> closed (snd -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_snd)
 
 lemma closed_Times: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<times> T)"
 proof -
   have "S \<times> T = (fst -` S) \<inter> (snd -` T)"
     by auto
   then show "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<times> T)"
     by (simp add: closed_vimage_fst closed_vimage_snd closed_Int)
 qed
 
 lemma subset_fst_imageI: "A \<times> B \<subseteq> S \<Longrightarrow> y \<in> B \<Longrightarrow> A \<subseteq> fst ` S"
   unfolding image_def subset_eq by force
 
 lemma subset_snd_imageI: "A \<times> B \<subseteq> S \<Longrightarrow> x \<in> A \<Longrightarrow> B \<subseteq> snd ` S"
   unfolding image_def subset_eq by force
 
 lemma open_image_fst:
   assumes "open S"
   shows "open (fst ` S)"
 proof (rule openI)
   fix x
   assume "x \<in> fst ` S"
   then obtain y where "(x, y) \<in> S"
     by auto
   then obtain A B where "open A" "open B" "x \<in> A" "y \<in> B" "A \<times> B \<subseteq> S"
     using \<open>open S\<close> unfolding open_prod_def by auto
   from \<open>A \<times> B \<subseteq> S\<close> \<open>y \<in> B\<close> have "A \<subseteq> fst ` S"
     by (rule subset_fst_imageI)
   with \<open>open A\<close> \<open>x \<in> A\<close> have "open A \<and> x \<in> A \<and> A \<subseteq> fst ` S"
     by simp
   then show "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> fst ` S" ..
 qed
 
 lemma open_image_snd:
   assumes "open S"
   shows "open (snd ` S)"
 proof (rule openI)
   fix y
   assume "y \<in> snd ` S"
   then obtain x where "(x, y) \<in> S"
     by auto
   then obtain A B where "open A" "open B" "x \<in> A" "y \<in> B" "A \<times> B \<subseteq> S"
     using \<open>open S\<close> unfolding open_prod_def by auto
   from \<open>A \<times> B \<subseteq> S\<close> \<open>x \<in> A\<close> have "B \<subseteq> snd ` S"
     by (rule subset_snd_imageI)
   with \<open>open B\<close> \<open>y \<in> B\<close> have "open B \<and> y \<in> B \<and> B \<subseteq> snd ` S"
     by simp
   then show "\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> snd ` S" ..
 qed
 
 lemma nhds_prod: "nhds (a, b) = nhds a \<times>\<^sub>F nhds b"
   unfolding nhds_def
 proof (subst prod_filter_INF, auto intro!: antisym INF_greatest simp: principal_prod_principal)
   fix S T
   assume "open S" "a \<in> S" "open T" "b \<in> T"
   then show "(INF x \<in> {S. open S \<and> (a, b) \<in> S}. principal x) \<le> principal (S \<times> T)"
     by (intro INF_lower) (auto intro!: open_Times)
 next
   fix S'
   assume "open S'" "(a, b) \<in> S'"
   then obtain S T where "open S" "a \<in> S" "open T" "b \<in> T" "S \<times> T \<subseteq> S'"
     by (auto elim: open_prod_elim)
   then show "(INF x \<in> {S. open S \<and> a \<in> S}. INF y \<in> {S. open S \<and> b \<in> S}.
       principal (x \<times> y)) \<le> principal S'"
     by (auto intro!: INF_lower2)
 qed
 
 
 subsubsection \<open>Continuity of operations\<close>
 
 lemma tendsto_fst [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. fst (f x)) \<longlongrightarrow> fst a) F"
 proof (rule topological_tendstoI)
   fix S
   assume "open S" and "fst a \<in> S"
   then have "open (fst -` S)" and "a \<in> fst -` S"
     by (simp_all add: open_vimage_fst)
   with assms have "eventually (\<lambda>x. f x \<in> fst -` S) F"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. fst (f x) \<in> S) F"
     by simp
 qed
 
 lemma tendsto_snd [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. snd (f x)) \<longlongrightarrow> snd a) F"
 proof (rule topological_tendstoI)
   fix S
   assume "open S" and "snd a \<in> S"
   then have "open (snd -` S)" and "a \<in> snd -` S"
     by (simp_all add: open_vimage_snd)
   with assms have "eventually (\<lambda>x. f x \<in> snd -` S) F"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. snd (f x) \<in> S) F"
     by simp
 qed
 
 lemma tendsto_Pair [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F" and "(g \<longlongrightarrow> b) F"
   shows "((\<lambda>x. (f x, g x)) \<longlongrightarrow> (a, b)) F"
   unfolding nhds_prod using assms by (rule filterlim_Pair)
 
 lemma continuous_fst[continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. fst (f x))"
   unfolding continuous_def by (rule tendsto_fst)
 
 lemma continuous_snd[continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. snd (f x))"
   unfolding continuous_def by (rule tendsto_snd)
 
 lemma continuous_Pair[continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. (f x, g x))"
   unfolding continuous_def by (rule tendsto_Pair)
 
 lemma continuous_on_fst[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. fst (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_fst)
 
 lemma continuous_on_snd[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. snd (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_snd)
 
 lemma continuous_on_Pair[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. (f x, g x))"
   unfolding continuous_on_def by (auto intro: tendsto_Pair)
 
 lemma continuous_on_swap[continuous_intros]: "continuous_on A prod.swap"
   by (simp add: prod.swap_def continuous_on_fst continuous_on_snd
       continuous_on_Pair continuous_on_id)
 
 lemma continuous_on_swap_args:
   assumes "continuous_on (A\<times>B) (\<lambda>(x,y). d x y)"
     shows "continuous_on (B\<times>A) (\<lambda>(x,y). d y x)"
 proof -
   have "(\<lambda>(x,y). d y x) = (\<lambda>(x,y). d x y) \<circ> prod.swap"
     by force
   then show ?thesis
     by (metis assms continuous_on_compose continuous_on_swap product_swap)
 qed
 
 lemma isCont_fst [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. fst (f x)) a"
   by (fact continuous_fst)
 
 lemma isCont_snd [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. snd (f x)) a"
   by (fact continuous_snd)
 
 lemma isCont_Pair [simp]: "\<lbrakk>isCont f a; isCont g a\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. (f x, g x)) a"
   by (fact continuous_Pair)
 
 lemma continuous_on_compose_Pair:
   assumes f: "continuous_on (Sigma A B) (\<lambda>(a, b). f a b)"
   assumes g: "continuous_on C g"
   assumes h: "continuous_on C h"
   assumes subset: "\<And>c. c \<in> C \<Longrightarrow> g c \<in> A" "\<And>c. c \<in> C \<Longrightarrow> h c \<in> B (g c)"
   shows "continuous_on C (\<lambda>c. f (g c) (h c))"
   using continuous_on_compose2[OF f continuous_on_Pair[OF g h]] subset
   by auto
 
 
 subsubsection \<open>Connectedness of products\<close>
 
 proposition connected_Times:
   assumes S: "connected S" and T: "connected T"
   shows "connected (S \<times> T)"
 proof (rule connectedI_const)
   fix P::"'a \<times> 'b \<Rightarrow> bool"
   assume P[THEN continuous_on_compose2, continuous_intros]: "continuous_on (S \<times> T) P"
   have "continuous_on S (\<lambda>s. P (s, t))" if "t \<in> T" for t
     by (auto intro!: continuous_intros that)
   from connectedD_const[OF S this]
   obtain c1 where c1: "\<And>s t. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> P (s, t) = c1 t"
     by metis
   moreover
   have "continuous_on T (\<lambda>t. P (s, t))" if "s \<in> S" for s
     by (auto intro!: continuous_intros that)
   from connectedD_const[OF T this]
   obtain c2 where "\<And>s t. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> P (s, t) = c2 s"
     by metis
   ultimately show "\<exists>c. \<forall>s\<in>S \<times> T. P s = c"
     by auto
 qed
 
 corollary connected_Times_eq [simp]:
    "connected (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> connected S \<and> connected T"  (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof cases
     assume "S \<noteq> {} \<and> T \<noteq> {}"
     moreover
     have "connected (fst ` (S \<times> T))" "connected (snd ` (S \<times> T))"
       using continuous_on_fst continuous_on_snd continuous_on_id
       by (blast intro: connected_continuous_image [OF _ L])+
     ultimately show ?thesis
       by auto
   qed auto
 qed (auto simp: connected_Times)
 
 
 subsubsection \<open>Separation axioms\<close>
 
 instance prod :: (t0_space, t0_space) t0_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U. open U \<and> (x \<in> U) \<noteq> (y \<in> U)"
     by (fast dest: t0_space elim: open_vimage_fst open_vimage_snd)
 qed
 
 instance prod :: (t1_space, t1_space) t1_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U. open U \<and> x \<in> U \<and> y \<notin> U"
     by (fast dest: t1_space elim: open_vimage_fst open_vimage_snd)
 qed
 
 instance prod :: (t2_space, t2_space) t2_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by (fast dest: hausdorff elim: open_vimage_fst open_vimage_snd)
 qed
 
 lemma isCont_swap[continuous_intros]: "isCont prod.swap a"
   using continuous_on_eq_continuous_within continuous_on_swap by blast
 
 lemma open_diagonal_complement:
   "open {(x,y) |x y. x \<noteq> (y::('a::t2_space))}"
 proof -
   have "open {(x, y). x \<noteq> (y::'a)}"
     unfolding split_def by (intro open_Collect_neq continuous_intros)
   also have "{(x, y). x \<noteq> (y::'a)} = {(x, y) |x y. x \<noteq> (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_diagonal:
   "closed {y. \<exists> x::('a::t2_space). y = (x,x)}"
 proof -
   have "{y. \<exists> x::'a. y = (x,x)} = UNIV - {(x,y) | x y. x \<noteq> y}" by auto
   then show ?thesis using open_diagonal_complement closed_Diff by auto
 qed
 
 lemma open_superdiagonal:
   "open {(x,y) | x y. x > (y::'a::{linorder_topology})}"
 proof -
   have "open {(x, y). x > (y::'a)}"
     unfolding split_def by (intro open_Collect_less continuous_intros)
   also have "{(x, y). x > (y::'a)} = {(x, y) |x y. x > (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_subdiagonal:
   "closed {(x,y) | x y. x \<le> (y::'a::{linorder_topology})}"
 proof -
   have "{(x,y) | x y. x \<le> (y::'a)} = UNIV - {(x,y) | x y. x > (y::'a)}" by auto
   then show ?thesis using open_superdiagonal closed_Diff by auto
 qed
 
 lemma open_subdiagonal:
   "open {(x,y) | x y. x < (y::'a::{linorder_topology})}"
 proof -
   have "open {(x, y). x < (y::'a)}"
     unfolding split_def by (intro open_Collect_less continuous_intros)
   also have "{(x, y). x < (y::'a)} = {(x, y) |x y. x < (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_superdiagonal:
   "closed {(x,y) | x y. x \<ge> (y::('a::{linorder_topology}))}"
 proof -
   have "{(x,y) | x y. x \<ge> (y::'a)} = UNIV - {(x,y) | x y. x < y}" by auto
   then show ?thesis using open_subdiagonal closed_Diff by auto
 qed
 
 end