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,4601 +1,4607 @@
 (*  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[intro]: "istopology(openin U)"
   using openin[of U] by blast
 
 lemma istopology_open: "istopology open"
   by (auto simp: istopology_def)
 
 lemma topology_inverse': "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"
   using topology_inverse[of U] istopology_openin[of "topology U"] by auto
 
 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[intro]: "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)"
   apply (rule closedin_Inter)
   using assms
   apply auto
   done
 
 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)"
   apply (auto simp: closedin_def Diff_Diff_Int inf_absorb2)
   apply (metis openin_subset subset_eq)
   done
 
 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)"
   apply safe
    apply (simp add: closedin_def)
   by (simp add: 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)"
 proof -
   have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S]  oS cT
     by (auto simp: topspace_def openin_subset)
   then show ?thesis using oS cT
     by (auto simp: closedin_def)
 qed
 
 lemma closedin_diff[intro]:
   assumes oS: "closedin U S"
     and cT: "openin U T"
   shows "closedin U (S - T)"
 proof -
   have "S - T = S \<inter> (topspace U - T)"
     using closedin_subset[of U S] oS cT by (auto simp: topspace_def)
   then show ?thesis
     using oS cT by (auto simp: openin_closedin_eq)
 qed
 
 
 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
   moreover have "x \<in> topspace X" if "openin X S" and "x \<in> S" for x S
     using openin_subset that by blast
   ultimately
   show ?lhs
     using R by (auto simp: 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 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 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
     {
       fix T
       assume T: "openin U T" "S = T \<inter> V"
       from T openin_subset[OF T(1)] UV have eq: "S = T"
         by blast
       have "openin U S"
         unfolding eq using T by blast
     }
     moreover
     {
       assume S: "openin U S"
       then have "\<exists>T. openin U T \<and> S = T \<inter> V"
         using openin_subset[OF S] UV by auto
     }
     ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S"
       by blast
   }
   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 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"
   apply (rule cong[where x=S and y=S])
   apply (rule topology_inverse[symmetric])
   apply (auto simp: istopology_def)
   done
 
 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)
     apply (clarsimp simp add: less_diff_eq)
     by (metis dist_commute dist_triangle_lt)
   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> {})"
-  apply (simp add: connected_def openin_open disjoint_iff_not_equal, safe)
-  by (simp_all, blast+)  (* SLOW *)
+  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> {})"
   apply (simp add: connected_openin, safe, blast)
   by (metis Int_lower1 Un_subset_iff openin_open 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 \<inter> (A \<union> B) = S"
       using s_sub(1) by auto
     have "S - A = B \<inter> S"
       using Diff_subset_conv Un_Diff_Int disj s_sub(1) by auto
     then have "S \<inter> A = {}"
       by (metis Diff_Diff_Int Diff_disjoint Un_Diff_Int R cl closedin_closed_Int inf_commute order_refl s_sub(2))
     then show "A \<inter> S = {}"
       by blast
   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> {})"
   apply (simp add: connected_closedin, safe, blast)
   by (metis Int_lower1 Un_subset_iff closedin_closed 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"
     apply (clarsimp simp: in_derived_set_of)
     by (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}}"
   apply (auto simp: in_derived_set_of)
   by (metis Set.set_insert all_not_in_conv insertCI openin_subset subsetCE)
 
 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:
    "S \<inter> X derived_set_of S = {} \<Longrightarrow> subtopology X S = discrete_topology(topspace X \<inter> S)"
   by (metis Int_lower1 derived_set_of_restrict inf_assoc inf_bot_right subtopology_eq_discrete_topology_eq subtopology_subtopology subtopology_topspace)
 
 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:
   "openin X S \<Longrightarrow> S \<inter> X derived_set_of T = S \<inter> X derived_set_of (S \<inter> T)"
   apply auto
    apply (meson IntI openin_Int_derived_set_of_subset subsetCE)
   by (meson derived_set_of_mono inf_sup_ord(2) subset_eq)
 
 
 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
   apply safe
   apply (meson IntI openin_subset subset_iff)
   by auto
 
 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 (cases "S \<subseteq> topspace X")
   case True
   then have "\<forall>x. x \<in> topspace X \<and> (\<forall>T. x \<in> T \<and> openin X T \<longrightarrow> (\<exists>y\<in>S. y \<in> T)) \<longrightarrow> x \<in> S
              \<Longrightarrow> openin X (topspace X - S)"
     apply (subst openin_subopen, safe)
     by (metis DiffI subset_eq openin_subset [of X])
   then show ?thesis
     by (auto simp: closedin_def closure_of_def)
 next
   case False
   then show ?thesis
     by (simp add: closedin_def)
 qed
 
 lemma closure_of_eq: "X closure_of S = S \<longleftrightarrow> closedin X S"
 proof (cases "S \<subseteq> topspace X")
   case True
   then show ?thesis
     by (metis closure_of_subset closure_of_subset_eq set_eq_subset)
 next
   case False
   then show ?thesis
     using closure_of closure_of_subset_eq by fastforce
 qed
 
 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_restrict 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"
 proof (rule hull_unique [THEN sym])
   show "S \<subseteq> X closure_of S"
     by (simp add: closure_of_subset assms)
 next
   show "closedin X (X closure_of S)"
     by simp
   show "\<And>T. \<lbrakk>S \<subseteq> T; closedin X T\<rbrakk> \<Longrightarrow> X closure_of S \<subseteq> T"
     by (metis closure_of_eq closure_of_mono)
 qed
 
 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_lower1 Int_subset_iff assms closedin_closure_of closure_of_minimal_eq closure_of_mono inf_le2 le_infI1 openin_subset)
 qed
 
 lemma openin_Int_closure_of_eq:
   "openin X S \<Longrightarrow> S \<inter> X closure_of T = S \<inter> X closure_of (S \<inter> T)"
   apply (rule equalityI)
    apply (simp add: openin_Int_closure_of_subset)
   by (meson closure_of_mono inf.cobounded2 inf_mono subset_refl)
 
 lemma openin_Int_closure_of_eq_empty:
    "openin X S \<Longrightarrow> S \<inter> X closure_of T = {} \<longleftrightarrow> S \<inter> T = {}"
   apply (subst openin_Int_closure_of_eq, auto)
   by (meson IntI closure_of_subset_Int disjoint_iff_not_equal openin_subset subset_eq)
 
 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)
   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 (metis Int_subset_iff S closure_of closure_of_mono inf.cobounded2 inf.coboundedI2 inf_commute openin_closedin_eq topspace_subtopology)
   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"
   apply (rule equalityI)
    apply (simp add: interior_of_mono)
   apply (auto simp: interior_of_maximal_eq openin_Int interior_of_subset le_infI1 le_infI2)
   done
 
 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"
 proof -
   have "\<forall>A. U \<inter> X closure_of (U \<inter> A) = U \<inter> X closure_of A"
     using assms openin_Int_closure_of_eq by blast
   then have "topspace X \<inter> U - U \<inter> X closure_of (topspace X \<inter> U - S) = U \<inter> (topspace X - X closure_of (topspace X - S))"
     by (metis (no_types) Diff_Int_distrib Int_Diff inf_commute)
   then show ?thesis
     unfolding interior_of_closure_of closure_of_subtopology_open topspace_subtopology
     using openin_Int_closure_of_eq [OF assms]
     by (metis assms closure_of_subtopology_open)
 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:
   "\<lbrakk>closedin X S; closedin X T\<rbrakk> \<Longrightarrow> X frontier_of(S \<inter> T) = X frontier_of S \<inter> T \<union> S \<inter> X frontier_of T"
   apply (simp add: frontier_of_Int closedin_Int closure_of_closedin)
   using frontier_of_subset_closedin by blast
 
 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)
 
 
 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 {U \<in> \<A>. U \<inter> V \<noteq> {}} \<Longrightarrow> finite {U \<in> \<B>. U \<inter> V \<noteq> {}}" for V
     apply (erule rev_finite_subset) using \<open>\<B> \<subseteq> \<A>\<close> by blast
   then show ?thesis
   using assms unfolding locally_finite_in_def by (fastforce simp add:)
 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 Q
     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 clarify (meson Union_upper closure_of_mono subsetD)
 
 lemma closure_of_locally_finite_Union:
    "locally_finite_in X \<A> \<Longrightarrow> X closure_of (\<Union>\<A>) = \<Union>((\<lambda>S. X closure_of S) ` \<A>)"
   apply (rule closure_of_unique)
   apply (simp add: SUP_upper2 Sup_le_iff closure_of_subset locally_finite_in_def)
   apply (simp add: closedin_Union_locally_finite_closure)
   by (simp add: Sup_le_iff closure_of_minimal)
 
 
 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 have "openin X {x \<in> topspace X. f x \<in> topspace Y - C}" by blast
       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 have "closedin X {x \<in> topspace X. f x \<in> topspace Y - U}" by blast
       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 have "f ` (X closure_of (topspace X \<inter> S)) \<subseteq> Y closure_of (f ` (topspace X \<inter> S))"
     by blast
   also have "\<dots> \<subseteq> Y closure_of (topspace Y \<inter> f ` S)"
     using * by (blast intro!: closure_of_mono)
   finally have "f ` (X closure_of (topspace X \<inter> S)) \<subseteq> Y closure_of (topspace Y \<inter> f ` S)" .
   then show ?thesis
     by (metis closure_of_restrict)
 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 have "f ` (X closure_of {a \<in> topspace X. f a \<in> C}) \<subseteq> C"
       using assms by blast
     then show "f x \<in> C"
       using x by auto
   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:
   "topspace X = topspace Y \<Longrightarrow> ((\<forall>S. openin X S \<longrightarrow> openin Y S) \<longleftrightarrow> continuous_map Y X id)"
   unfolding continuous_map_def
   apply auto
   using openin_subopen openin_subset apply fastforce
   using openin_subopen topspace_def by fastforce
 
 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 dual_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}"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: closed_map_on_empty)
 next
   case False
   then show ?thesis
     by (auto simp: closed_map_def image_constant_conv)
 qed
 
 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)"
 proof -
   have *: "openin X (T \<inter> S)" if "openin X (S \<inter> topspace X)" "openin X T" for T
   proof -
     have "T \<subseteq> topspace X"
       using that by (simp add: openin_subset)
     with that show "openin X (T \<inter> S)"
       by (metis inf.absorb1 inf.left_commute inf_commute openin_Int)
   qed
   show ?thesis
     by (fastforce simp add: open_map_def Int_commute openin_subtopology_alt intro: *)
 qed
 
 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
   proof -
     have "T \<subseteq> topspace X"
       using that by (simp add: closedin_subset)
     with that show "closedin X (T \<inter> S)"
       by (metis inf.absorb1 inf.left_commute inf_commute closedin_Int)
   qed
   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:
      "\<lbrakk>open_map X X' f; {x. x \<in> topspace X \<and> f x \<in> V} = U\<rbrakk>
       \<Longrightarrow> open_map (subtopology X U) (subtopology X' V) f"
   unfolding open_map_def openin_subtopology_alt
   apply clarify
   apply (rename_tac T)
   apply (rule_tac x="f ` T" in image_eqI)
   using openin_closedin_eq by fastforce+
 
 lemma closed_map_restriction:
      "\<lbrakk>closed_map X X' f; {x. x \<in> topspace X \<and> f x \<in> V} = U\<rbrakk>
       \<Longrightarrow> closed_map (subtopology X U) (subtopology X' V) f"
   unfolding closed_map_def closedin_subtopology_alt
   apply clarify
   apply (rename_tac T)
   apply (rule_tac x="f ` T" in image_eqI)
   using closedin_def by fastforce+
 
 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"
 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
   unfolding quotient_map_def
   by (metis (mono_tags, lifting) eq image_cong)
 qed
 
 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'' \<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 eq: "{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
   have "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U''} = openin X {x \<in> topspace X. f x \<in> U'}"
     using assms  by (simp add: quotient_map_def U'_def eq)
   also have "\<dots> = openin X'' U''"
     using U'_def \<open>U'' \<subseteq> topspace X''\<close> U' g quotient_map_def by fastforce
   finally show "openin X {x \<in> topspace X. (g \<circ> f) x \<in> U''} = openin X'' U''" .
 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 "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
   moreover have "closed_map X X' f"
   proof (clarsimp simp add: closed_map_def)
     fix U
     assume "closedin X U"
     then have "U \<subseteq> topspace X"
       by (simp add: closedin_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 "closedin X' (f ` U)"
       using L unfolding quotient_map_closedin
       by (metis (no_types, lifting) Collect_cong \<open>closedin X U\<close> image_mono)
   qed
   ultimately show ?rhs
     using L 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, hide_lams) 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"
   apply safe
   apply (meson continuous_compose_quotient_map_eq quotient_imp_continuous_map quotient_map_from_composition)
   by (simp add: quotient_map_compose)
 
 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
 
 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 = {}"
 proof -
   have "\<And>x. \<lbrakk>separatedin X S S; x \<in> S\<rbrakk> \<Longrightarrow> False"
     by (metis all_not_in_conv closure_of_subset inf.orderE separatedin_def)
   then show ?thesis
     by auto
 qed
 
 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"
-  by (metis closedin_def closure_of_eq disjnt_def inf_commute separatedin_def)
+  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"
   apply (simp add: separatedin_def closure_of_subtopology)
   apply (safe; metis Int_absorb1 inf.assoc inf.orderE insert_disjoint(2) mk_disjoint_insert)
   done
 
 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
   apply (intro conjI)
   apply (meson Diff_subset openin_subset subset_trans)+
   using openin_Int_closure_of_eq_empty by fastforce+
 
 lemma separatedin_closedin_diff:
      "\<lbrakk>closedin X S; closedin X T\<rbrakk> \<Longrightarrow> separatedin X (S - T) (T - S)"
   apply (simp add: separatedin_def Diff_Int_distrib2 closure_of_minimal inf_absorb2)
   apply (meson Diff_subset closedin_subset subset_trans)
   done
 
 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"
   apply (simp add: separatedin_def closedin_Int_closure_of disjnt_iff)
   using closure_of_subset apply blast
   done
 
 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)
 
 
 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'"
   apply (simp add: 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))"  (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson assms homeomorphic_map_openness_eq)
 next
   assume ?rhs
   then show ?lhs
     by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_openness openin_subset subset_image_iff)
 qed
 
 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")
 proof
   assume ?lhs
   then show ?rhs
     by (meson assms homeomorphic_map_closedness_eq)
 next
   assume ?rhs
   then show ?lhs
     by (metis (no_types, lifting) assms homeomorphic_imp_surjective_map homeomorphic_map_closedness closedin_subset subset_image_iff)
 qed
 
 
 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 1: "(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)
     have 2: "(\<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
     proof
       show "?lhs \<Longrightarrow> ?rhs"
         by (meson "1" imageI inj inj_on_eq_iff inj_on_subset that)
       show "?rhs \<Longrightarrow> ?lhs"
         using S inj inj_onD that by fastforce
     qed
     show ?thesis
       apply (simp flip: fim add: all_subset_image)
       apply (simp flip: imp_conjL)
       by (intro all_cong1 imp_cong 1 2)
   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
     apply (rule *)
     using fim apply blast
     using iff openin_subset by 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 (no_types, lifting) Diff_subset S closure_of_subset_topspace inj_on_image_mem_iff_alt 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 have "y \<in> topspace X"
     by (simp add: in_closure_of)
   then have "f y \<notin> f ` (X interior_of S)"
     by (meson hom homeomorphic_eq_everything_map inj_on_image_mem_iff_alt interior_of_subset_topspace y(3))
   then show "x \<notin> Y interior_of f ` S"
     using S hom homeomorphic_map_interior_of y(1) by blast
 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:
    "\<lbrakk>homeomorphic_map X Y f;
      \<And>x. \<lbrakk>x \<in> topspace X; f x \<in> topspace Y\<rbrakk> \<Longrightarrow> f x \<in> T \<longleftrightarrow> x \<in> S\<rbrakk>
     \<Longrightarrow> homeomorphic_map (subtopology X S) (subtopology Y T) f"
   unfolding homeomorphic_map_maps
   apply (erule ex_forward)
   apply (rule homeomorphic_maps_subtopologies)
   apply (auto simp: homeomorphic_maps_def continuous_map_def)
   by (metis IntI image_iff)
 
 
 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 = {}"
 proof -
   have "\<forall>f t. continuous_map X (t::'b topology) f"
     using assms continuous_map_on_empty by blast
   then show ?thesis
     by (metis (no_types) assms continuous_map_on_empty empty_iff homeomorphic_empty_space homeomorphic_maps_def homeomorphic_space_def)
 qed
 
 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 L: "\<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)
   show ?rhs
     unfolding connected_space_def
   proof clarify
     fix E1 E2
     assume "closedin X E1" and "closedin X E2" and "topspace X \<subseteq> E1 \<union> E2" and "E1 \<inter> E2 = {}"
       and "E1 \<noteq> {}" and "E2 \<noteq> {}"
     have "E1 \<union> E2 = topspace X"
       by (meson Un_subset_iff \<open>closedin X E1\<close> \<open>closedin X E2\<close> \<open>topspace X \<subseteq> E1 \<union> E2\<close> closedin_def subset_antisym)
     then have "topspace X - E2 = E1"
       using \<open>E1 \<inter> E2 = {}\<close> by fastforce
     then have "topspace X = E1"
       using \<open>E1 \<noteq> {}\<close> L \<open>closedin X E1\<close> \<open>closedin X E2\<close> by blast
     then show "False"
       using \<open>E1 \<inter> E2 = {}\<close> \<open>E1 \<union> E2 = topspace X\<close> \<open>E2 \<noteq> {}\<close> by blast
   qed
 next
   assume R: ?rhs
   show ?lhs
     unfolding connected_space_def
   proof clarify
     fix E1 E2
     assume "openin X E1" and "openin X E2" and "topspace X \<subseteq> E1 \<union> E2" and "E1 \<inter> E2 = {}"
       and "E1 \<noteq> {}" and "E2 \<noteq> {}"
     have "E1 \<union> E2 = topspace X"
       by (meson Un_subset_iff \<open>openin X E1\<close> \<open>openin X E2\<close> \<open>topspace X \<subseteq> E1 \<union> E2\<close> openin_closedin_eq subset_antisym)
     then have "topspace X - E2 = E1"
       using \<open>E1 \<inter> E2 = {}\<close> by fastforce
     then have "topspace X = E1"
       using \<open>E1 \<noteq> {}\<close> R \<open>openin X E1\<close> \<open>openin X E2\<close> by blast
     then show "False"
       using \<open>E1 \<inter> E2 = {}\<close> \<open>E1 \<union> E2 = topspace X\<close> \<open>E2 \<noteq> {}\<close> by blast
   qed
 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> {})"
   apply (simp add: connected_space_closedin)
   apply (intro all_cong)
   using closedin_subset apply blast
   done
 
 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> {})"
 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 Not_eq_iff *
     apply (intro conj_cong arg_cong [where f=Not] ex_cong1 refl)
     apply (blast elim: dest!: openin_subset)+
     done
 qed
 
 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 Not_eq_iff *
     apply (intro conj_cong arg_cong [where f=Not] ex_cong1 refl)
     apply (blast elim: dest!: openin_subset)+
     done
 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"
   apply (simp only: connectedin_def topspace_subtopology subtopology_subtopology)
   apply (intro conj_cong imp_cong arg_cong [where f=Not] all_cong1 ex_cong1 refl)
   by auto
 
 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)+
   show ?thesis
   using assms
   apply (simp add: connectedin closure_of_subset_topspace S T)
   apply (elim all_forward imp_forward2 asm_rl)
   apply (blast dest: openin_Int_closure_of_eq_empty [of X _ S])+
   done
 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 = {})" (is "?lhs = ?rhs")
   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)"
   apply (simp add: separatedin_def connectedin_separation)
   apply (intro conj_cong all_cong1 refl, blast)
   done
 
 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
   show ?thesis
     apply (simp add: connectedin_eq_not_separated)
     apply (intro conj_cong refl iffI *)
     apply (blast elim!: all_forward)+
     done
 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)"
   apply (simp add: connected_space_eq_not_separated)
   apply (intro all_cong1)
   by (metis Un_absorb dual_order.antisym separatedin_def subset_refl sup_mono)
 
 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:
    "\<lbrakk>connectedin X S; connectedin X T; \<not>separatedin X S T\<rbrakk> \<Longrightarrow> connectedin X (S \<union> T)"
   apply (simp add: connectedin_eq_not_separated_subset, auto)
     apply (metis (no_types, hide_lams) Diff_subset_conv Diff_triv disjoint_iff_not_equal separatedin_mono sup_commute)
   apply (metis (no_types, hide_lams) Diff_subset_conv Diff_triv disjoint_iff_not_equal separatedin_mono separatedin_sym sup_commute)
   by (meson disjoint_iff_not_equal)
 
 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_inter_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)
   have "S - (topspace X \<inter> T) \<noteq> {}"
     using assms(3) by blast
   moreover
   have "S \<inter> topspace X \<inter> T \<noteq> {}"
     using assms(1) assms(2) 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 1: "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)
     have 2: "S \<subseteq> X interior_of T \<union> (topspace X - X closure_of T)"
       using that \<open>S \<subseteq> topspace X\<close> null by auto
     have 3: "S \<inter> X interior_of T \<noteq> {}"
       using closure_of_subset that(1) that(3) null by fastforce
     show ?thesis
       using null \<open>S \<subseteq> topspace X\<close> that * [of "X interior_of T" "topspace X - X closure_of T"]
       apply (clarsimp simp add: openin_diff 1 2)
       apply (simp add: Int_commute Diff_Int_distrib 3)
       by (metis Int_absorb2 contra_subsetD interior_of_subset)
   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 homeomorphic_connected_space:
      "X homeomorphic_space Y \<Longrightarrow> connected_space X \<longleftrightarrow> connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   apply safe
   apply (metis connectedin_continuous_map_image connected_space_subconnected continuous_map_image_subset_topspace image_eqI image_subset_iff)
   by (metis (no_types, hide_lams) connectedin_continuous_map_image connectedin_topspace continuous_map_def continuous_map_image_subset_topspace imageI set_eq_subset subsetI)
 
 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 (no_types) Int_subset_iff U f homeomorphic_map_imp_homeomorphic_space homeomorphic_map_subtopologies homeomorphic_space_sym subset_antisym subset_refl)
   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})"
       apply safe
       using False connectedin_inter_frontier_of insert_Diff apply fastforce
       using True by 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"
 apply (simp add: compactin_subspace)
   by (metis inf.orderE inf_commute subtopology_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
     apply (clarsimp simp add: compact_space_def closedin_topspace_empty)
     by (metis finite.emptyI finite_insert infinite_super insertI1 subsetI)
 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
         apply (simp only: imp_conjL [symmetric] all_finite_subset_image eq)
         apply (simp add: subset_eq)
         done
     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 inc: "\<And>m n. m \<le> n \<Longrightarrow> C n \<subseteq> C m"
   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 inc have "C n \<subseteq> (\<Inter>n\<in>K. \<Inter>m \<le> n. C m)"
     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"
   apply (rule iffI)
   using compactin_imp_Bolzano_Weierstrass compactin_subset_topspace apply blast
   by (simp add: finite_imp_compactin_eq)
 
 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 (no_types) Int_absorb1 continuous_map_image_subset_topspace continuous_map_in_subtopology homeomorphic_eq_everything_map image_comp image_mono)
   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"
   apply (auto simp: embedding_map_def subtopology_subtopology Int_absorb1)
     apply (metis (no_types) homeomorphic_imp_surjective_map subtopology_subtopology subtopology_topspace topspace_subtopology)
   apply (simp add: continuous_map_def homeomorphic_eq_everything_map)
   done
 
 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
   apply (rule bijective_open_imp_homeomorphic_map)
   using continuous_map_in_subtopology apply blast
     apply (auto simp: continuous_map_in_subtopology open_map_into_subtopology continuous_map)
   done
 
 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
   apply (rule bijective_closed_imp_homeomorphic_map)
      apply (simp_all add: continuous_map_into_subtopology closed_map_into_subtopology)
   apply (simp add: continuous_map inf.absorb_iff2)
   done
 
 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)
 
 
 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"
   apply (auto simp: section_map_def retraction_map_def homeomorphic_map_maps retraction_maps_def homeomorphic_maps_def)
   by (metis (full_types) continuous_map_image_subset_topspace image_subset_iff)
 
 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, hide_lams) 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"
   apply safe
   apply (metis continuous_map_closedin_preimage_eq continuous_map_in_subtopology continuous_on_closed order_refl topspace_euclidean_subtopology)
   apply (simp add: continuous_map_closedin_preimage_eq image_subset_iff)
   by (metis (no_types, hide_lams) continuous_map_closedin_preimage_eq continuous_map_in_subtopology continuous_on_closed order_refl topspace_euclidean_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))"
 apply safe
 apply (simp add: continuous_openin_preimage_gen)
 apply (fastforce simp add: continuous_on_open openin_open)
 done
 
 lemma continuous_closedin_preimage_eq:
    "continuous_on S f \<longleftrightarrow>
     (\<forall>T. closed T \<longrightarrow> closedin (top_of_set S) (S \<inter> f -` T))"
 apply safe
 apply (simp add: continuous_closedin_preimage)
 apply (fastforce simp add: continuous_on_closed closedin_closed)
 done
 
 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 simp: )
   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'"
       apply (subst openin_subopen, clarify)
       apply (rule Times_in_interior_subtopology [OF _ \<open>?lhs\<close>])
       using \<open>y \<in> T'\<close>
        apply auto
       done
     moreover have "openin (top_of_set T) T'"
       apply (subst openin_subopen, clarify)
       apply (rule Times_in_interior_subtopology [OF _ \<open>?lhs\<close>])
       using \<open>x \<in> S'\<close>
        apply auto
       done
     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))"
     (is "?lhs = ?rhs")
 proof -
   have *: "U \<subseteq> T \<Longrightarrow> S \<inter> f -` (T - U) = S - (S \<inter> f -` U)" for U
     using assms by blast
   show ?thesis
   proof
     assume L: ?lhs
     show ?rhs
     proof clarify
       fix U
       assume "closedin (top_of_set T) U"
       then show "closedin (top_of_set S) (S \<inter> f -` U)"
         using L unfolding continuous_on_open_gen [OF assms]
         by (metis * closedin_def inf_le1 topspace_euclidean_subtopology)
     qed
   next
     assume R [rule_format]: ?rhs
     show ?lhs
       unfolding continuous_on_open_gen [OF assms]
       by (metis * R inf_le1 openin_closedin_eq topspace_euclidean_subtopology)
   qed
 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 "istopology T"
           "\<And>s. s \<in> S \<Longrightarrow> T s"
           "generate_topology_on S s0"
   shows "T s0"
 using assms(3) apply (induct rule: generate_topology_on.induct)
 using assms(1) assms(2) unfolding istopology_def by auto
 
 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 only: openin_topology_generated_by_iff, auto simp: generate_topology_on.Basis)
 
 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:
-   "\<lbrakk>\<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\<rbrakk>
-    \<Longrightarrow> topology(arbitrary union_of P) = X"
-  by (metis openin_topology_base_unique openin_inverse [of X])
+  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:
    "\<lbrakk>\<And>S. P S \<Longrightarrow> openin X S; openin X U;
      openin(topology(arbitrary union_of (finite intersection_of P relative_to U))) S\<rbrakk>
     \<Longrightarrow> openin X S"
   apply (simp add: istopology_subbase topology_inverse)
   apply (simp add: union_of_def intersection_of_def relative_to_def)
   apply (blast intro: openin_Int_Inter)
   done
 
 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\<^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 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
   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
   proof (cases "c = y")
     case True
     then show ?thesis
       using compact_space_def \<open>compact_space X\<close> by auto
   qed auto
   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 (auto simp: proper_map_alt closed_map_inclusion_eq inf.absorb_iff2 Collect_conj_eq compactin_subtopology intro: closed_Int_compactin)
 
 
 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)
 
 end
diff --git a/src/HOL/Analysis/Affine.thy b/src/HOL/Analysis/Affine.thy
--- a/src/HOL/Analysis/Affine.thy
+++ b/src/HOL/Analysis/Affine.thy
@@ -1,1655 +1,1655 @@
 section "Affine Sets"
 
 theory Affine
 imports Linear_Algebra
 begin
 
 lemma if_smult: "(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)"
   by (fact if_distrib)
 
 lemma sum_delta_notmem:
   assumes "x \<notin> s"
   shows "sum (\<lambda>y. if (y = x) then P x else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (x = y) then P x else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (y = x) then P y else Q y) s = sum Q s"
     and "sum (\<lambda>y. if (x = y) then P y else Q y) s = sum Q s"
   apply (rule_tac [!] sum.cong)
   using assms
   apply auto
   done
 
 lemmas independent_finite = independent_imp_finite
 
 lemma span_substd_basis:
   assumes d: "d \<subseteq> Basis"
   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   (is "_ = ?B")
 proof -
   have "d \<subseteq> ?B"
     using d by (auto simp: inner_Basis)
   moreover have s: "subspace ?B"
     using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
   ultimately have "span d \<subseteq> ?B"
     using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
   moreover have *: "card d \<le> dim (span d)"
     using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms]
       span_superset[of d]
     by auto
   moreover from * have "dim ?B \<le> dim (span d)"
     using dim_substandard[OF assms] by auto
   ultimately show ?thesis
     using s subspace_dim_equal[of "span d" "?B"] subspace_span[of d] by auto
 qed
 
 lemma basis_to_substdbasis_subspace_isomorphism:
   fixes B :: "'a::euclidean_space set"
   assumes "independent B"
   shows "\<exists>f d::'a set. card d = card B \<and> linear f \<and> f ` B = d \<and>
     f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} \<and> inj_on f (span B) \<and> d \<subseteq> Basis"
 proof -
   have B: "card B = dim B"
     using dim_unique[of B B "card B"] assms span_superset[of B] by auto
   have "dim B \<le> card (Basis :: 'a set)"
     using dim_subset_UNIV[of B] by simp
   from ex_card[OF this] obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
     by auto
   let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
   proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_superset)
     show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
       using d inner_not_same_Basis by blast
   qed (auto simp: span_substd_basis independent_substdbasis dim_substandard d t B assms)
   with t \<open>card B = dim B\<close> d show ?thesis by auto
 qed
 
 subsection \<open>Affine set and affine hull\<close>
 
 definition\<^marker>\<open>tag important\<close> affine :: "'a::real_vector set \<Rightarrow> bool"
   where "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
 
 lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
   unfolding affine_def by (metis eq_diff_eq')
 
 lemma affine_empty [iff]: "affine {}"
   unfolding affine_def by auto
 
 lemma affine_sing [iff]: "affine {x}"
   unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
 
 lemma affine_UNIV [iff]: "affine UNIV"
   unfolding affine_def by auto
 
 lemma affine_Inter [intro]: "(\<And>s. s\<in>f \<Longrightarrow> affine s) \<Longrightarrow> affine (\<Inter>f)"
   unfolding affine_def by auto
 
 lemma affine_Int[intro]: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
   unfolding affine_def by auto
 
 lemma affine_scaling: "affine s \<Longrightarrow> affine (image (\<lambda>x. c *\<^sub>R x) s)"
   apply (clarsimp simp add: affine_def)
   apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI)
   apply (auto simp: algebra_simps)
   done
 
 lemma affine_affine_hull [simp]: "affine(affine hull s)"
   unfolding hull_def
   using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"] by auto
 
 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
   by (metis affine_affine_hull hull_same)
 
 lemma affine_hyperplane: "affine {x. a \<bullet> x = b}"
   by (simp add: affine_def algebra_simps) (metis distrib_right mult.left_neutral)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Some explicit formulations\<close>
 
 text "Formalized by Lars Schewe."
 
 lemma affine:
   fixes V::"'a::real_vector set"
   shows "affine V \<longleftrightarrow>
          (\<forall>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> V \<and> sum u S = 1 \<longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V)"
 proof -
   have "u *\<^sub>R x + v *\<^sub>R y \<in> V" if "x \<in> V" "y \<in> V" "u + v = (1::real)"
     and *: "\<And>S u. \<lbrakk>finite S; S \<noteq> {}; S \<subseteq> V; sum u S = 1\<rbrakk> \<Longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V" for x y u v
   proof (cases "x = y")
     case True
     then show ?thesis
       using that by (metis scaleR_add_left scaleR_one)
   next
     case False
     then show ?thesis
       using that *[of "{x,y}" "\<lambda>w. if w = x then u else v"] by auto
   qed
   moreover have "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
                 if *: "\<And>x y u v. \<lbrakk>x\<in>V; y\<in>V; u + v = 1\<rbrakk> \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
                   and "finite S" "S \<noteq> {}" "S \<subseteq> V" "sum u S = 1" for S u
   proof -
     define n where "n = card S"
     consider "card S = 0" | "card S = 1" | "card S = 2" | "card S > 2" by linarith
     then show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
     proof cases
       assume "card S = 1"
       then obtain a where "S={a}"
         by (auto simp: card_Suc_eq)
       then show ?thesis
         using that by simp
     next
       assume "card S = 2"
       then obtain a b where "S = {a, b}"
         by (metis Suc_1 card_1_singletonE card_Suc_eq)
       then show ?thesis
         using *[of a b] that
         by (auto simp: sum_clauses(2))
     next
       assume "card S > 2"
       then show ?thesis using that n_def
       proof (induct n arbitrary: u S)
         case 0
         then show ?case by auto
       next
         case (Suc n u S)
         have "sum u S = card S" if "\<not> (\<exists>x\<in>S. u x \<noteq> 1)"
           using that unfolding card_eq_sum by auto
         with Suc.prems obtain x where "x \<in> S" and x: "u x \<noteq> 1" by force
         have c: "card (S - {x}) = card S - 1"
           by (simp add: Suc.prems(3) \<open>x \<in> S\<close>)
         have "sum u (S - {x}) = 1 - u x"
           by (simp add: Suc.prems sum_diff1 \<open>x \<in> S\<close>)
         with x have eq1: "inverse (1 - u x) * sum u (S - {x}) = 1"
           by auto
         have inV: "(\<Sum>y\<in>S - {x}. (inverse (1 - u x) * u y) *\<^sub>R y) \<in> V"
         proof (cases "card (S - {x}) > 2")
           case True
           then have S: "S - {x} \<noteq> {}" "card (S - {x}) = n"
             using Suc.prems c by force+
           show ?thesis
           proof (rule Suc.hyps)
             show "(\<Sum>a\<in>S - {x}. inverse (1 - u x) * u a) = 1"
               by (auto simp: eq1 sum_distrib_left[symmetric])
           qed (use S Suc.prems True in auto)
         next
           case False
           then have "card (S - {x}) = Suc (Suc 0)"
             using Suc.prems c by auto
           then obtain a b where ab: "(S - {x}) = {a, b}" "a\<noteq>b"
             unfolding card_Suc_eq by auto
           then show ?thesis
             using eq1 \<open>S \<subseteq> V\<close>
             by (auto simp: sum_distrib_left distrib_left intro!: Suc.prems(2)[of a b])
         qed
         have "u x + (1 - u x) = 1 \<Longrightarrow>
           u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>y\<in>S - {x}. u y *\<^sub>R y) /\<^sub>R (1 - u x)) \<in> V"
           by (rule Suc.prems) (use \<open>x \<in> S\<close> Suc.prems inV in \<open>auto simp: scaleR_right.sum\<close>)
         moreover have "(\<Sum>a\<in>S. u a *\<^sub>R a) = u x *\<^sub>R x + (\<Sum>a\<in>S - {x}. u a *\<^sub>R a)"
           by (meson Suc.prems(3) sum.remove \<open>x \<in> S\<close>)
         ultimately show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
           by (simp add: x)
       qed
     qed (use \<open>S\<noteq>{}\<close> \<open>finite S\<close> in auto)
   qed
   ultimately show ?thesis
     unfolding affine_def by meson
 qed
 
 
 lemma affine_hull_explicit:
   "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
   (is "_ = ?rhs")
 proof (rule hull_unique)
   show "p \<subseteq> ?rhs"
   proof (intro subsetI CollectI exI conjI)
     show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
       by auto
   qed auto
   show "?rhs \<subseteq> T" if "p \<subseteq> T" "affine T" for T
     using that unfolding affine by blast
   show "affine ?rhs"
     unfolding affine_def
   proof clarify
     fix u v :: real and sx ux sy uy
     assume uv: "u + v = 1"
       and x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "sum ux sx = (1::real)"
       and y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "sum uy sy = (1::real)" 
     have **: "(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy"
       by auto
     show "\<exists>S w. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and>
         sum w S = 1 \<and> (\<Sum>v\<in>S. w v *\<^sub>R v) = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
     proof (intro exI conjI)
       show "finite (sx \<union> sy)"
         using x y by auto
       show "sum (\<lambda>i. (if i\<in>sx then u * ux i else 0) + (if i\<in>sy then v * uy i else 0)) (sx \<union> sy) = 1"
         using x y uv
         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric] sum_distrib_left [symmetric] **)
       have "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i)
           = (\<Sum>i\<in>sx. (u * ux i) *\<^sub>R i) + (\<Sum>i\<in>sy. (v * uy i) *\<^sub>R i)"
         using x y
         unfolding scaleR_left_distrib scaleR_zero_left if_smult
         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric]  **)
       also have "\<dots> = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
         unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] by blast
       finally show "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i) 
                   = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)" .
     qed (use x y in auto)
   qed
 qed
 
 lemma affine_hull_finite:
   assumes "finite S"
   shows "affine hull S = {y. \<exists>u. sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
 proof -
   have *: "\<exists>h. sum h S = 1 \<and> (\<Sum>v\<in>S. h v *\<^sub>R v) = x" 
     if "F \<subseteq> S" "finite F" "F \<noteq> {}" and sum: "sum u F = 1" and x: "(\<Sum>v\<in>F. u v *\<^sub>R v) = x" for x F u
   proof -
     have "S \<inter> F = F"
       using that by auto
     show ?thesis
     proof (intro exI conjI)
       show "(\<Sum>x\<in>S. if x \<in> F then u x else 0) = 1"
         by (metis (mono_tags, lifting) \<open>S \<inter> F = F\<close> assms sum.inter_restrict sum)
       show "(\<Sum>v\<in>S. (if v \<in> F then u v else 0) *\<^sub>R v) = x"
         by (simp add: if_smult cong: if_cong) (metis (no_types) \<open>S \<inter> F = F\<close> assms sum.inter_restrict x)
     qed
   qed
   show ?thesis
     unfolding affine_hull_explicit using assms
     by (fastforce dest: *)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Stepping theorems and hence small special cases\<close>
 
 lemma affine_hull_empty[simp]: "affine hull {} = {}"
   by simp
 
 lemma affine_hull_finite_step:
   fixes y :: "'a::real_vector"
   shows "finite S \<Longrightarrow>
       (\<exists>u. sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y) \<longleftrightarrow>
       (\<exists>v u. sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)" (is "_ \<Longrightarrow> ?lhs = ?rhs")
 proof -
   assume fin: "finite S"
   show "?lhs = ?rhs"
   proof
     assume ?lhs
     then obtain u where u: "sum u (insert a S) = w \<and> (\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
       by auto
     show ?rhs
     proof (cases "a \<in> S")
       case True
       then show ?thesis
         using u by (simp add: insert_absorb) (metis diff_zero real_vector.scale_zero_left)
     next
       case False
       show ?thesis
         by (rule exI [where x="u a"]) (use u fin False in auto)
     qed
   next
     assume ?rhs
     then obtain v u where vu: "sum u S = w - v"  "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
       by auto
     have *: "\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)"
       by auto
     show ?lhs
     proof (cases "a \<in> S")
       case True
       show ?thesis
         by (rule exI [where x="\<lambda>x. (if x=a then v else 0) + u x"])
            (simp add: True scaleR_left_distrib sum.distrib sum_clauses fin vu * cong: if_cong)
     next
       case False
       then show ?thesis
         apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI) 
         apply (simp add: vu sum_clauses(2)[OF fin] *)
         by (simp add: sum_delta_notmem(3) vu)
     qed
   qed
 qed
 
 lemma affine_hull_2:
   fixes a b :: "'a::real_vector"
   shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}"
   (is "?lhs = ?rhs")
 proof -
   have *:
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   have "?lhs = {y. \<exists>u. sum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
     using affine_hull_finite[of "{a,b}"] by auto
   also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
     by (simp add: affine_hull_finite_step[of "{b}" a])
   also have "\<dots> = ?rhs" unfolding * by auto
   finally show ?thesis by auto
 qed
 
 lemma affine_hull_3:
   fixes a b c :: "'a::real_vector"
   shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}"
 proof -
   have *:
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
   show ?thesis
     apply (simp add: affine_hull_finite affine_hull_finite_step)
     unfolding *
     apply safe
      apply (metis add.assoc)
     apply (rule_tac x=u in exI, force)
     done
 qed
 
 lemma mem_affine:
   assumes "affine S" "x \<in> S" "y \<in> S" "u + v = 1"
   shows "u *\<^sub>R x + v *\<^sub>R y \<in> S"
   using assms affine_def[of S] by auto
 
 lemma mem_affine_3:
   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S" "u + v + w = 1"
   shows "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> S"
 proof -
   have "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> affine hull {x, y, z}"
     using affine_hull_3[of x y z] assms by auto
   moreover
   have "affine hull {x, y, z} \<subseteq> affine hull S"
     using hull_mono[of "{x, y, z}" "S"] assms by auto
   moreover
   have "affine hull S = S"
     using assms affine_hull_eq[of S] by auto
   ultimately show ?thesis by auto
 qed
 
 lemma mem_affine_3_minus:
   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S"
   shows "x + v *\<^sub>R (y-z) \<in> S"
   using mem_affine_3[of S x y z 1 v "-v"] assms
   by (simp add: algebra_simps)
 
 corollary%unimportant mem_affine_3_minus2:
     "\<lbrakk>affine S; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> x - v *\<^sub>R (y-z) \<in> S"
   by (metis add_uminus_conv_diff mem_affine_3_minus real_vector.scale_minus_left)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Some relations between affine hull and subspaces\<close>
 
 lemma affine_hull_insert_subset_span:
   "affine hull (insert a S) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> S}}"
 proof -
   have "\<exists>v T u. x = a + v \<and> (finite T \<and> T \<subseteq> {x - a |x. x \<in> S} \<and> (\<Sum>v\<in>T. u v *\<^sub>R v) = v)"
     if "finite F" "F \<noteq> {}" "F \<subseteq> insert a S" "sum u F = 1" "(\<Sum>v\<in>F. u v *\<^sub>R v) = x"
     for x F u
   proof -
     have *: "(\<lambda>x. x - a) ` (F - {a}) \<subseteq> {x - a |x. x \<in> S}"
       using that by auto
     show ?thesis
     proof (intro exI conjI)
       show "finite ((\<lambda>x. x - a) ` (F - {a}))"
         by (simp add: that(1))
       show "(\<Sum>v\<in>(\<lambda>x. x - a) ` (F - {a}). u(v+a) *\<^sub>R v) = x-a"
         by (simp add: sum.reindex[unfolded inj_on_def] algebra_simps
             sum_subtractf scaleR_left.sum[symmetric] sum_diff1 that)
     qed (use \<open>F \<subseteq> insert a S\<close> in auto)
   qed
   then show ?thesis
-    unfolding affine_hull_explicit span_explicit by blast
+    unfolding affine_hull_explicit span_explicit by fast
 qed
 
 lemma affine_hull_insert_span:
   assumes "a \<notin> S"
   shows "affine hull (insert a S) = {a + v | v . v \<in> span {x - a | x.  x \<in> S}}"
 proof -
   have *: "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
     if "v \<in> span {x - a |x. x \<in> S}" "y = a + v" for y v
   proof -
     from that
     obtain T u where u: "finite T" "T \<subseteq> {x - a |x. x \<in> S}" "a + (\<Sum>v\<in>T. u v *\<^sub>R v) = y"
       unfolding span_explicit by auto
     define F where "F = (\<lambda>x. x + a) ` T"
     have F: "finite F" "F \<subseteq> S" "(\<Sum>v\<in>F. u (v - a) *\<^sub>R (v - a)) = y - a"
       unfolding F_def using u by (auto simp: sum.reindex[unfolded inj_on_def])
     have *: "F \<inter> {a} = {}" "F \<inter> - {a} = F"
       using F assms by auto
     show "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
       apply (rule_tac x = "insert a F" in exI)
       apply (rule_tac x = "\<lambda>x. if x=a then 1 - sum (\<lambda>x. u (x - a)) F else u (x - a)" in exI)
       using assms F
       apply (auto simp:  sum_clauses sum.If_cases if_smult sum_subtractf scaleR_left.sum algebra_simps *)
       done
   qed
   show ?thesis
     by (intro subset_antisym affine_hull_insert_subset_span) (auto simp: affine_hull_explicit dest!: *)
 qed
 
 lemma affine_hull_span:
   assumes "a \<in> S"
   shows "affine hull S = {a + v | v. v \<in> span {x - a | x. x \<in> S - {a}}}"
   using affine_hull_insert_span[of a "S - {a}", unfolded insert_Diff[OF assms]] by auto
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Parallel affine sets\<close>
 
 definition affine_parallel :: "'a::real_vector set \<Rightarrow> 'a::real_vector set \<Rightarrow> bool"
   where "affine_parallel S T \<longleftrightarrow> (\<exists>a. T = (\<lambda>x. a + x) ` S)"
 
 lemma affine_parallel_expl_aux:
   fixes S T :: "'a::real_vector set"
   assumes "\<And>x. x \<in> S \<longleftrightarrow> a + x \<in> T"
   shows "T = (\<lambda>x. a + x) ` S"
 proof -
   have "x \<in> ((\<lambda>x. a + x) ` S)" if "x \<in> T" for x
     using that
     by (simp add: image_iff) (metis add.commute diff_add_cancel assms)
   moreover have "T \<ge> (\<lambda>x. a + x) ` S"
     using assms by auto
   ultimately show ?thesis by auto
 qed
 
 lemma affine_parallel_expl: "affine_parallel S T \<longleftrightarrow> (\<exists>a. \<forall>x. x \<in> S \<longleftrightarrow> a + x \<in> T)"
   by (auto simp add: affine_parallel_def)
     (use affine_parallel_expl_aux [of S _ T] in blast)
 
 lemma affine_parallel_reflex: "affine_parallel S S"
   unfolding affine_parallel_def
   using image_add_0 by blast
 
 lemma affine_parallel_commut:
   assumes "affine_parallel A B"
   shows "affine_parallel B A"
 proof -
   from assms obtain a where B: "B = (\<lambda>x. a + x) ` A"
     unfolding affine_parallel_def by auto
   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
   from B show ?thesis
     using translation_galois [of B a A]
     unfolding affine_parallel_def by blast
 qed
 
 lemma affine_parallel_assoc:
   assumes "affine_parallel A B"
     and "affine_parallel B C"
   shows "affine_parallel A C"
 proof -
   from assms obtain ab where "B = (\<lambda>x. ab + x) ` A"
     unfolding affine_parallel_def by auto
   moreover
   from assms obtain bc where "C = (\<lambda>x. bc + x) ` B"
     unfolding affine_parallel_def by auto
   ultimately show ?thesis
     using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto
 qed
 
 lemma affine_translation_aux:
   fixes a :: "'a::real_vector"
   assumes "affine ((\<lambda>x. a + x) ` S)"
   shows "affine S"
 proof -
   {
     fix x y u v
     assume xy: "x \<in> S" "y \<in> S" "(u :: real) + v = 1"
     then have "(a + x) \<in> ((\<lambda>x. a + x) ` S)" "(a + y) \<in> ((\<lambda>x. a + x) ` S)"
       by auto
     then have h1: "u *\<^sub>R  (a + x) + v *\<^sub>R (a + y) \<in> (\<lambda>x. a + x) ` S"
       using xy assms unfolding affine_def by auto
     have "u *\<^sub>R (a + x) + v *\<^sub>R (a + y) = (u + v) *\<^sub>R a + (u *\<^sub>R x + v *\<^sub>R y)"
       by (simp add: algebra_simps)
     also have "\<dots> = a + (u *\<^sub>R x + v *\<^sub>R y)"
       using \<open>u + v = 1\<close> by auto
     ultimately have "a + (u *\<^sub>R x + v *\<^sub>R y) \<in> (\<lambda>x. a + x) ` S"
       using h1 by auto
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> S" by auto
   }
   then show ?thesis unfolding affine_def by auto
 qed
 
 lemma affine_translation:
   "affine S \<longleftrightarrow> affine ((+) a ` S)" for a :: "'a::real_vector"
 proof
   show "affine ((+) a ` S)" if "affine S"
     using that translation_assoc [of "- a" a S]
     by (auto intro: affine_translation_aux [of "- a" "((+) a ` S)"])
   show "affine S" if "affine ((+) a ` S)"
     using that by (rule affine_translation_aux)
 qed
 
 lemma parallel_is_affine:
   fixes S T :: "'a::real_vector set"
   assumes "affine S" "affine_parallel S T"
   shows "affine T"
 proof -
   from assms obtain a where "T = (\<lambda>x. a + x) ` S"
     unfolding affine_parallel_def by auto
   then show ?thesis
     using affine_translation assms by auto
 qed
 
 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
   unfolding subspace_def affine_def by auto
 
 lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
   by (metis hull_minimal span_superset subspace_imp_affine subspace_span)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Subspace parallel to an affine set\<close>
 
 lemma subspace_affine: "subspace S \<longleftrightarrow> affine S \<and> 0 \<in> S"
 proof -
   have h0: "subspace S \<Longrightarrow> affine S \<and> 0 \<in> S"
     using subspace_imp_affine[of S] subspace_0 by auto
   {
     assume assm: "affine S \<and> 0 \<in> S"
     {
       fix c :: real
       fix x
       assume x: "x \<in> S"
       have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
       moreover
       have "(1 - c) *\<^sub>R 0 + c *\<^sub>R x \<in> S"
         using affine_alt[of S] assm x by auto
       ultimately have "c *\<^sub>R x \<in> S" by auto
     }
     then have h1: "\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S" by auto
 
     {
       fix x y
       assume xy: "x \<in> S" "y \<in> S"
       define u where "u = (1 :: real)/2"
       have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)"
         by auto
       moreover
       have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y"
         by (simp add: algebra_simps)
       moreover
       have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> S"
         using affine_alt[of S] assm xy by auto
       ultimately
       have "(1/2) *\<^sub>R (x+y) \<in> S"
         using u_def by auto
       moreover
       have "x + y = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))"
         by auto
       ultimately
       have "x + y \<in> S"
         using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
     }
     then have "\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S"
       by auto
     then have "subspace S"
       using h1 assm unfolding subspace_def by auto
   }
   then show ?thesis using h0 by metis
 qed
 
 lemma affine_diffs_subspace:
   assumes "affine S" "a \<in> S"
   shows "subspace ((\<lambda>x. (-a)+x) ` S)"
 proof -
   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
   have "affine ((\<lambda>x. (-a)+x) ` S)"
     using affine_translation assms by blast
   moreover have "0 \<in> ((\<lambda>x. (-a)+x) ` S)"
     using assms exI[of "(\<lambda>x. x\<in>S \<and> -a+x = 0)" a] by auto
   ultimately show ?thesis using subspace_affine by auto
 qed
 
 lemma affine_diffs_subspace_subtract:
   "subspace ((\<lambda>x. x - a) ` S)" if "affine S" "a \<in> S"
   using that affine_diffs_subspace [of _ a] by simp
 
 lemma parallel_subspace_explicit:
   assumes "affine S"
     and "a \<in> S"
   assumes "L \<equiv> {y. \<exists>x \<in> S. (-a) + x = y}"
   shows "subspace L \<and> affine_parallel S L"
 proof -
   from assms have "L = plus (- a) ` S" by auto
   then have par: "affine_parallel S L"
     unfolding affine_parallel_def ..
   then have "affine L" using assms parallel_is_affine by auto
   moreover have "0 \<in> L"
     using assms by auto
   ultimately show ?thesis
     using subspace_affine par by auto
 qed
 
 lemma parallel_subspace_aux:
   assumes "subspace A"
     and "subspace B"
     and "affine_parallel A B"
   shows "A \<supseteq> B"
 proof -
   from assms obtain a where a: "\<forall>x. x \<in> A \<longleftrightarrow> a + x \<in> B"
     using affine_parallel_expl[of A B] by auto
   then have "-a \<in> A"
     using assms subspace_0[of B] by auto
   then have "a \<in> A"
     using assms subspace_neg[of A "-a"] by auto
   then show ?thesis
     using assms a unfolding subspace_def by auto
 qed
 
 lemma parallel_subspace:
   assumes "subspace A"
     and "subspace B"
     and "affine_parallel A B"
   shows "A = B"
 proof
   show "A \<supseteq> B"
     using assms parallel_subspace_aux by auto
   show "A \<subseteq> B"
     using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
 qed
 
 lemma affine_parallel_subspace:
   assumes "affine S" "S \<noteq> {}"
   shows "\<exists>!L. subspace L \<and> affine_parallel S L"
 proof -
   have ex: "\<exists>L. subspace L \<and> affine_parallel S L"
     using assms parallel_subspace_explicit by auto
   {
     fix L1 L2
     assume ass: "subspace L1 \<and> affine_parallel S L1" "subspace L2 \<and> affine_parallel S L2"
     then have "affine_parallel L1 L2"
       using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
     then have "L1 = L2"
       using ass parallel_subspace by auto
   }
   then show ?thesis using ex by auto
 qed
 
 
 subsection \<open>Affine Dependence\<close>
 
 text "Formalized by Lars Schewe."
 
 definition\<^marker>\<open>tag important\<close> affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
   where "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> affine hull (s - {x}))"
 
 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
   unfolding affine_dependent_def dependent_def
   using affine_hull_subset_span by auto
 
 lemma affine_dependent_subset:
    "\<lbrakk>affine_dependent s; s \<subseteq> t\<rbrakk> \<Longrightarrow> affine_dependent t"
 apply (simp add: affine_dependent_def Bex_def)
 apply (blast dest: hull_mono [OF Diff_mono [OF _ subset_refl]])
 done
 
 lemma affine_independent_subset:
   shows "\<lbrakk>\<not> affine_dependent t; s \<subseteq> t\<rbrakk> \<Longrightarrow> \<not> affine_dependent s"
 by (metis affine_dependent_subset)
 
 lemma affine_independent_Diff:
    "\<not> affine_dependent s \<Longrightarrow> \<not> affine_dependent(s - t)"
 by (meson Diff_subset affine_dependent_subset)
 
 proposition affine_dependent_explicit:
   "affine_dependent p \<longleftrightarrow>
     (\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
 proof -
   have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> (\<Sum>w\<in>S. u w *\<^sub>R w) = 0"
     if "(\<Sum>w\<in>S. u w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum u S = 1" for x S u
   proof (intro exI conjI)
     have "x \<notin> S" 
       using that by auto
     then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else u v) = 0"
       using that by (simp add: sum_delta_notmem)
     show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0"
       using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
   qed (use that in auto)
   moreover have "\<exists>x\<in>p. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
     if "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum u S = 0" "v \<in> S" "u v \<noteq> 0" for S u v
   proof (intro bexI exI conjI)
     have "S \<noteq> {v}"
       using that by auto
     then show "S - {v} \<noteq> {}"
       using that by auto
     show "(\<Sum>x \<in> S - {v}. - (1 / u v) * u x) = 1"
       unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
     show "(\<Sum>x\<in>S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v"
       unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
                 scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
       using that by auto
     show "S - {v} \<subseteq> p - {v}"
       using that by auto
   qed (use that in auto)
   ultimately show ?thesis
     unfolding affine_dependent_def affine_hull_explicit by auto
 qed
 
 lemma affine_dependent_explicit_finite:
   fixes S :: "'a::real_vector set"
   assumes "finite S"
   shows "affine_dependent S \<longleftrightarrow>
     (\<exists>u. sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
   (is "?lhs = ?rhs")
 proof
   have *: "\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else 0::'a)"
     by auto
   assume ?lhs
   then obtain t u v where
     "finite t" "t \<subseteq> S" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
     unfolding affine_dependent_explicit by auto
   then show ?rhs
     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
     apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>t\<subseteq>S\<close>])
     done
 next
   assume ?rhs
   then obtain u v where "sum u S = 0"  "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
     by auto
   then show ?lhs unfolding affine_dependent_explicit
     using assms by auto
 qed
 
 lemma dependent_imp_affine_dependent:
   assumes "dependent {x - a| x . x \<in> s}"
     and "a \<notin> s"
   shows "affine_dependent (insert a s)"
 proof -
   from assms(1)[unfolded dependent_explicit] obtain S u v
     where obt: "finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v  \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
     by auto
   define t where "t = (\<lambda>x. x + a) ` S"
 
   have inj: "inj_on (\<lambda>x. x + a) S"
     unfolding inj_on_def by auto
   have "0 \<notin> S"
     using obt(2) assms(2) unfolding subset_eq by auto
   have fin: "finite t" and "t \<subseteq> s"
     unfolding t_def using obt(1,2) by auto
   then have "finite (insert a t)" and "insert a t \<subseteq> insert a s"
     by auto
   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
     apply (rule sum.cong)
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
     apply auto
     done
   have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
     unfolding sum_clauses(2)[OF fin] * using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by auto
   moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
     using obt(3,4) \<open>0\<notin>S\<close>
     by (rule_tac x="v + a" in bexI) (auto simp: t_def)
   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by (auto intro!: sum.cong)
   have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
     unfolding scaleR_left.sum
     unfolding t_def and sum.reindex[OF inj] and o_def
     using obt(5)
     by (auto simp: sum.distrib scaleR_right_distrib)
   then have "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
     unfolding sum_clauses(2)[OF fin]
     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
     by (auto simp: *)
   ultimately show ?thesis
     unfolding affine_dependent_explicit
     apply (rule_tac x="insert a t" in exI, auto)
     done
 qed
 
 lemma affine_dependent_biggerset:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<ge> DIM('a) + 2"
   shows "affine_dependent s"
 proof -
   have "s \<noteq> {}" using assms by auto
   then obtain a where "a\<in>s" by auto
   have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
     by auto
   have "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
     unfolding * by (simp add: card_image inj_on_def)
   also have "\<dots> > DIM('a)" using assms(2)
     unfolding card_Diff_singleton[OF assms(1) \<open>a\<in>s\<close>] by auto
   finally show ?thesis
     apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
     apply (rule dependent_imp_affine_dependent)
     apply (rule dependent_biggerset, auto)
     done
 qed
 
 lemma affine_dependent_biggerset_general:
   assumes "finite (S :: 'a::euclidean_space set)"
     and "card S \<ge> dim S + 2"
   shows "affine_dependent S"
 proof -
   from assms(2) have "S \<noteq> {}" by auto
   then obtain a where "a\<in>S" by auto
   have *: "{x - a |x. x \<in> S - {a}} = (\<lambda>x. x - a) ` (S - {a})"
     by auto
   have **: "card {x - a |x. x \<in> S - {a}} = card (S - {a})"
     by (metis (no_types, lifting) "*" card_image diff_add_cancel inj_on_def)
   have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
     using \<open>a\<in>S\<close> by (auto simp: span_base span_diff intro: subset_le_dim)
   also have "\<dots> < dim S + 1" by auto
   also have "\<dots> \<le> card (S - {a})"
     using assms
     using card_Diff_singleton[OF assms(1) \<open>a\<in>S\<close>]
     by auto
   finally show ?thesis
     apply (subst insert_Diff[OF \<open>a\<in>S\<close>, symmetric])
     apply (rule dependent_imp_affine_dependent)
     apply (rule dependent_biggerset_general)
     unfolding **
     apply auto
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some Properties of Affine Dependent Sets\<close>
 
 lemma affine_independent_0 [simp]: "\<not> affine_dependent {}"
   by (simp add: affine_dependent_def)
 
 lemma affine_independent_1 [simp]: "\<not> affine_dependent {a}"
   by (simp add: affine_dependent_def)
 
 lemma affine_independent_2 [simp]: "\<not> affine_dependent {a,b}"
   by (simp add: affine_dependent_def insert_Diff_if hull_same)
 
 lemma affine_hull_translation: "affine hull ((\<lambda>x. a + x) `  S) = (\<lambda>x. a + x) ` (affine hull S)"
 proof -
   have "affine ((\<lambda>x. a + x) ` (affine hull S))"
     using affine_translation affine_affine_hull by blast
   moreover have "(\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
     using hull_subset[of S] by auto
   ultimately have h1: "affine hull ((\<lambda>x. a + x) `  S) \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
     by (metis hull_minimal)
   have "affine((\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)))"
     using affine_translation affine_affine_hull by blast
   moreover have "(\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S))"
     using hull_subset[of "(\<lambda>x. a + x) `  S"] by auto
   moreover have "S = (\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S"
     using translation_assoc[of "-a" a] by auto
   ultimately have "(\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)) >= (affine hull S)"
     by (metis hull_minimal)
   then have "affine hull ((\<lambda>x. a + x) ` S) >= (\<lambda>x. a + x) ` (affine hull S)"
     by auto
   then show ?thesis using h1 by auto
 qed
 
 lemma affine_dependent_translation:
   assumes "affine_dependent S"
   shows "affine_dependent ((\<lambda>x. a + x) ` S)"
 proof -
   obtain x where x: "x \<in> S \<and> x \<in> affine hull (S - {x})"
     using assms affine_dependent_def by auto
   have "(+) a ` (S - {x}) = (+) a ` S - {a + x}"
     by auto
   then have "a + x \<in> affine hull ((\<lambda>x. a + x) ` S - {a + x})"
     using affine_hull_translation[of a "S - {x}"] x by auto
   moreover have "a + x \<in> (\<lambda>x. a + x) ` S"
     using x by auto
   ultimately show ?thesis
     unfolding affine_dependent_def by auto
 qed
 
 lemma affine_dependent_translation_eq:
   "affine_dependent S \<longleftrightarrow> affine_dependent ((\<lambda>x. a + x) ` S)"
 proof -
   {
     assume "affine_dependent ((\<lambda>x. a + x) ` S)"
     then have "affine_dependent S"
       using affine_dependent_translation[of "((\<lambda>x. a + x) ` S)" "-a"] translation_assoc[of "-a" a]
       by auto
   }
   then show ?thesis
     using affine_dependent_translation by auto
 qed
 
 lemma affine_hull_0_dependent:
   assumes "0 \<in> affine hull S"
   shows "dependent S"
 proof -
   obtain s u where s_u: "finite s \<and> s \<noteq> {} \<and> s \<subseteq> S \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
     using assms affine_hull_explicit[of S] by auto
   then have "\<exists>v\<in>s. u v \<noteq> 0" by auto
   then have "finite s \<and> s \<subseteq> S \<and> (\<exists>v\<in>s. u v \<noteq> 0 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0)"
     using s_u by auto
   then show ?thesis
     unfolding dependent_explicit[of S] by auto
 qed
 
 lemma affine_dependent_imp_dependent2:
   assumes "affine_dependent (insert 0 S)"
   shows "dependent S"
 proof -
   obtain x where x: "x \<in> insert 0 S \<and> x \<in> affine hull (insert 0 S - {x})"
     using affine_dependent_def[of "(insert 0 S)"] assms by blast
   then have "x \<in> span (insert 0 S - {x})"
     using affine_hull_subset_span by auto
   moreover have "span (insert 0 S - {x}) = span (S - {x})"
     using insert_Diff_if[of "0" S "{x}"] span_insert_0[of "S-{x}"] by auto
   ultimately have "x \<in> span (S - {x})" by auto
   then have "x \<noteq> 0 \<Longrightarrow> dependent S"
     using x dependent_def by auto
   moreover
   {
     assume "x = 0"
     then have "0 \<in> affine hull S"
       using x hull_mono[of "S - {0}" S] by auto
     then have "dependent S"
       using affine_hull_0_dependent by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma affine_dependent_iff_dependent:
   assumes "a \<notin> S"
   shows "affine_dependent (insert a S) \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` S)"
 proof -
   have "((+) (- a) ` S) = {x - a| x . x \<in> S}" by auto
   then show ?thesis
     using affine_dependent_translation_eq[of "(insert a S)" "-a"]
       affine_dependent_imp_dependent2 assms
       dependent_imp_affine_dependent[of a S]
     by (auto simp del: uminus_add_conv_diff)
 qed
 
 lemma affine_dependent_iff_dependent2:
   assumes "a \<in> S"
   shows "affine_dependent S \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` (S-{a}))"
 proof -
   have "insert a (S - {a}) = S"
     using assms by auto
   then show ?thesis
     using assms affine_dependent_iff_dependent[of a "S-{a}"] by auto
 qed
 
 lemma affine_hull_insert_span_gen:
   "affine hull (insert a s) = (\<lambda>x. a + x) ` span ((\<lambda>x. - a + x) ` s)"
 proof -
   have h1: "{x - a |x. x \<in> s} = ((\<lambda>x. -a+x) ` s)"
     by auto
   {
     assume "a \<notin> s"
     then have ?thesis
       using affine_hull_insert_span[of a s] h1 by auto
   }
   moreover
   {
     assume a1: "a \<in> s"
     have "\<exists>x. x \<in> s \<and> -a+x=0"
       apply (rule exI[of _ a])
       using a1
       apply auto
       done
     then have "insert 0 ((\<lambda>x. -a+x) ` (s - {a})) = (\<lambda>x. -a+x) ` s"
       by auto
     then have "span ((\<lambda>x. -a+x) ` (s - {a}))=span ((\<lambda>x. -a+x) ` s)"
       using span_insert_0[of "(+) (- a) ` (s - {a})"] by (auto simp del: uminus_add_conv_diff)
     moreover have "{x - a |x. x \<in> (s - {a})} = ((\<lambda>x. -a+x) ` (s - {a}))"
       by auto
     moreover have "insert a (s - {a}) = insert a s"
       by auto
     ultimately have ?thesis
       using affine_hull_insert_span[of "a" "s-{a}"] by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma affine_hull_span2:
   assumes "a \<in> s"
   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` (s-{a}))"
   using affine_hull_insert_span_gen[of a "s - {a}", unfolded insert_Diff[OF assms]]
   by auto
 
 lemma affine_hull_span_gen:
   assumes "a \<in> affine hull s"
   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` s)"
 proof -
   have "affine hull (insert a s) = affine hull s"
     using hull_redundant[of a affine s] assms by auto
   then show ?thesis
     using affine_hull_insert_span_gen[of a "s"] by auto
 qed
 
 lemma affine_hull_span_0:
   assumes "0 \<in> affine hull S"
   shows "affine hull S = span S"
   using affine_hull_span_gen[of "0" S] assms by auto
 
 lemma extend_to_affine_basis_nonempty:
   fixes S V :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent S" "S \<subseteq> V" "S \<noteq> {}"
   shows "\<exists>T. \<not> affine_dependent T \<and> S \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
 proof -
   obtain a where a: "a \<in> S"
     using assms by auto
   then have h0: "independent  ((\<lambda>x. -a + x) ` (S-{a}))"
     using affine_dependent_iff_dependent2 assms by auto
   obtain B where B:
     "(\<lambda>x. -a+x) ` (S - {a}) \<subseteq> B \<and> B \<subseteq> (\<lambda>x. -a+x) ` V \<and> independent B \<and> (\<lambda>x. -a+x) ` V \<subseteq> span B"
     using assms
     by (blast intro: maximal_independent_subset_extend[OF _ h0, of "(\<lambda>x. -a + x) ` V"])
   define T where "T = (\<lambda>x. a+x) ` insert 0 B"
   then have "T = insert a ((\<lambda>x. a+x) ` B)"
     by auto
   then have "affine hull T = (\<lambda>x. a+x) ` span B"
     using affine_hull_insert_span_gen[of a "((\<lambda>x. a+x) ` B)"] translation_assoc[of "-a" a B]
     by auto
   then have "V \<subseteq> affine hull T"
     using B assms translation_inverse_subset[of a V "span B"]
     by auto
   moreover have "T \<subseteq> V"
     using T_def B a assms by auto
   ultimately have "affine hull T = affine hull V"
     by (metis Int_absorb1 Int_absorb2 hull_hull hull_mono)
   moreover have "S \<subseteq> T"
     using T_def B translation_inverse_subset[of a "S-{a}" B]
     by auto
   moreover have "\<not> affine_dependent T"
     using T_def affine_dependent_translation_eq[of "insert 0 B"]
       affine_dependent_imp_dependent2 B
     by auto
   ultimately show ?thesis using \<open>T \<subseteq> V\<close> by auto
 qed
 
 lemma affine_basis_exists:
   fixes V :: "'n::euclidean_space set"
   shows "\<exists>B. B \<subseteq> V \<and> \<not> affine_dependent B \<and> affine hull V = affine hull B"
 proof (cases "V = {}")
   case True
   then show ?thesis
     using affine_independent_0 by auto
 next
   case False
   then obtain x where "x \<in> V" by auto
   then show ?thesis
     using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V]
     by auto
 qed
 
 proposition extend_to_affine_basis:
   fixes S V :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent S" "S \<subseteq> V"
   obtains T where "\<not> affine_dependent T" "S \<subseteq> T" "T \<subseteq> V" "affine hull T = affine hull V"
 proof (cases "S = {}")
   case True then show ?thesis
     using affine_basis_exists by (metis empty_subsetI that)
 next
   case False
   then show ?thesis by (metis assms extend_to_affine_basis_nonempty that)
 qed
 
 
 subsection \<open>Affine Dimension of a Set\<close>
 
 definition\<^marker>\<open>tag important\<close> aff_dim :: "('a::euclidean_space) set \<Rightarrow> int"
   where "aff_dim V =
   (SOME d :: int.
     \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1)"
 
 lemma aff_dim_basis_exists:
   fixes V :: "('n::euclidean_space) set"
   shows "\<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
 proof -
   obtain B where "\<not> affine_dependent B \<and> affine hull B = affine hull V"
     using affine_basis_exists[of V] by auto
   then show ?thesis
     unfolding aff_dim_def
       some_eq_ex[of "\<lambda>d. \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1"]
     apply auto
     apply (rule exI[of _ "int (card B) - (1 :: int)"])
     apply (rule exI[of _ "B"], auto)
     done
 qed
 
 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
 by (metis affine_empty subset_empty subset_hull)
 
 lemma empty_eq_affine_hull[simp]: "{} = affine hull S \<longleftrightarrow> S = {}"
 by (metis affine_hull_eq_empty)
 
 lemma aff_dim_parallel_subspace_aux:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B" "a \<in> B"
   shows "finite B \<and> ((card B) - 1 = dim (span ((\<lambda>x. -a+x) ` (B-{a}))))"
 proof -
   have "independent ((\<lambda>x. -a + x) ` (B-{a}))"
     using affine_dependent_iff_dependent2 assms by auto
   then have fin: "dim (span ((\<lambda>x. -a+x) ` (B-{a}))) = card ((\<lambda>x. -a + x) ` (B-{a}))"
     "finite ((\<lambda>x. -a + x) ` (B - {a}))"
     using indep_card_eq_dim_span[of "(\<lambda>x. -a+x) ` (B-{a})"] by auto
   show ?thesis
   proof (cases "(\<lambda>x. -a + x) ` (B - {a}) = {}")
     case True
     have "B = insert a ((\<lambda>x. a + x) ` (\<lambda>x. -a + x) ` (B - {a}))"
       using translation_assoc[of "a" "-a" "(B - {a})"] assms by auto
     then have "B = {a}" using True by auto
     then show ?thesis using assms fin by auto
   next
     case False
     then have "card ((\<lambda>x. -a + x) ` (B - {a})) > 0"
       using fin by auto
     moreover have h1: "card ((\<lambda>x. -a + x) ` (B-{a})) = card (B-{a})"
       by (rule card_image) (use translate_inj_on in blast)
     ultimately have "card (B-{a}) > 0" by auto
     then have *: "finite (B - {a})"
       using card_gt_0_iff[of "(B - {a})"] by auto
     then have "card (B - {a}) = card B - 1"
       using card_Diff_singleton assms by auto
     with * show ?thesis using fin h1 by auto
   qed
 qed
 
 lemma aff_dim_parallel_subspace:
   fixes V L :: "'n::euclidean_space set"
   assumes "V \<noteq> {}"
     and "subspace L"
     and "affine_parallel (affine hull V) L"
   shows "aff_dim V = int (dim L)"
 proof -
   obtain B where
     B: "affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> int (card B) = aff_dim V + 1"
     using aff_dim_basis_exists by auto
   then have "B \<noteq> {}"
     using assms B
     by auto
   then obtain a where a: "a \<in> B" by auto
   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
   moreover have "affine_parallel (affine hull B) Lb"
     using Lb_def B assms affine_hull_span2[of a B] a
       affine_parallel_commut[of "Lb" "(affine hull B)"]
     unfolding affine_parallel_def
     by auto
   moreover have "subspace Lb"
     using Lb_def subspace_span by auto
   moreover have "affine hull B \<noteq> {}"
     using assms B by auto
   ultimately have "L = Lb"
     using assms affine_parallel_subspace[of "affine hull B"] affine_affine_hull[of B] B
     by auto
   then have "dim L = dim Lb"
     by auto
   moreover have "card B - 1 = dim Lb" and "finite B"
     using Lb_def aff_dim_parallel_subspace_aux a B by auto
   ultimately show ?thesis
     using B \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
 qed
 
 lemma aff_independent_finite:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B"
   shows "finite B"
 proof -
   {
     assume "B \<noteq> {}"
     then obtain a where "a \<in> B" by auto
     then have ?thesis
       using aff_dim_parallel_subspace_aux assms by auto
   }
   then show ?thesis by auto
 qed
 
 
 lemma aff_dim_empty:
   fixes S :: "'n::euclidean_space set"
   shows "S = {} \<longleftrightarrow> aff_dim S = -1"
 proof -
   obtain B where *: "affine hull B = affine hull S"
     and "\<not> affine_dependent B"
     and "int (card B) = aff_dim S + 1"
     using aff_dim_basis_exists by auto
   moreover
   from * have "S = {} \<longleftrightarrow> B = {}"
     by auto
   ultimately show ?thesis
     using aff_independent_finite[of B] card_gt_0_iff[of B] by auto
 qed
 
 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
   by (simp add: aff_dim_empty [symmetric])
 
 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
   unfolding aff_dim_def using hull_hull[of _ S] by auto
 
 lemma aff_dim_affine_hull2:
   assumes "affine hull S = affine hull T"
   shows "aff_dim S = aff_dim T"
   unfolding aff_dim_def using assms by auto
 
 lemma aff_dim_unique:
   fixes B V :: "'n::euclidean_space set"
   assumes "affine hull B = affine hull V \<and> \<not> affine_dependent B"
   shows "of_nat (card B) = aff_dim V + 1"
 proof (cases "B = {}")
   case True
   then have "V = {}"
     using assms
     by auto
   then have "aff_dim V = (-1::int)"
     using aff_dim_empty by auto
   then show ?thesis
     using \<open>B = {}\<close> by auto
 next
   case False
   then obtain a where a: "a \<in> B" by auto
   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
   have "affine_parallel (affine hull B) Lb"
     using Lb_def affine_hull_span2[of a B] a
       affine_parallel_commut[of "Lb" "(affine hull B)"]
     unfolding affine_parallel_def by auto
   moreover have "subspace Lb"
     using Lb_def subspace_span by auto
   ultimately have "aff_dim B = int(dim Lb)"
     using aff_dim_parallel_subspace[of B Lb] \<open>B \<noteq> {}\<close> by auto
   moreover have "(card B) - 1 = dim Lb" "finite B"
     using Lb_def aff_dim_parallel_subspace_aux a assms by auto
   ultimately have "of_nat (card B) = aff_dim B + 1"
     using \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
   then show ?thesis
     using aff_dim_affine_hull2 assms by auto
 qed
 
 lemma aff_dim_affine_independent:
   fixes B :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent B"
   shows "of_nat (card B) = aff_dim B + 1"
   using aff_dim_unique[of B B] assms by auto
 
 lemma affine_independent_iff_card:
     fixes s :: "'a::euclidean_space set"
     shows "\<not> affine_dependent s \<longleftrightarrow> finite s \<and> aff_dim s = int(card s) - 1"
   apply (rule iffI)
   apply (simp add: aff_dim_affine_independent aff_independent_finite)
   by (metis affine_basis_exists [of s] aff_dim_unique card_subset_eq diff_add_cancel of_nat_eq_iff)
 
 lemma aff_dim_sing [simp]:
   fixes a :: "'n::euclidean_space"
   shows "aff_dim {a} = 0"
   using aff_dim_affine_independent[of "{a}"] affine_independent_1 by auto
 
 lemma aff_dim_2 [simp]: "aff_dim {a,b} = (if a = b then 0 else 1)"
 proof (clarsimp)
   assume "a \<noteq> b"
   then have "aff_dim{a,b} = card{a,b} - 1"
     using affine_independent_2 [of a b] aff_dim_affine_independent by fastforce
   also have "\<dots> = 1"
     using \<open>a \<noteq> b\<close> by simp
   finally show "aff_dim {a, b} = 1" .
 qed
 
 lemma aff_dim_inner_basis_exists:
   fixes V :: "('n::euclidean_space) set"
   shows "\<exists>B. B \<subseteq> V \<and> affine hull B = affine hull V \<and>
     \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
 proof -
   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> V" "affine hull B = affine hull V"
     using affine_basis_exists[of V] by auto
   then have "of_nat(card B) = aff_dim V+1" using aff_dim_unique by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_le_card:
   fixes V :: "'n::euclidean_space set"
   assumes "finite V"
   shows "aff_dim V \<le> of_nat (card V) - 1"
 proof -
   obtain B where B: "B \<subseteq> V" "of_nat (card B) = aff_dim V + 1"
     using aff_dim_inner_basis_exists[of V] by auto
   then have "card B \<le> card V"
     using assms card_mono by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_parallel_eq:
   fixes S T :: "'n::euclidean_space set"
   assumes "affine_parallel (affine hull S) (affine hull T)"
   shows "aff_dim S = aff_dim T"
 proof -
   {
     assume "T \<noteq> {}" "S \<noteq> {}"
     then obtain L where L: "subspace L \<and> affine_parallel (affine hull T) L"
       using affine_parallel_subspace[of "affine hull T"]
         affine_affine_hull[of T]
       by auto
     then have "aff_dim T = int (dim L)"
       using aff_dim_parallel_subspace \<open>T \<noteq> {}\<close> by auto
     moreover have *: "subspace L \<and> affine_parallel (affine hull S) L"
        using L affine_parallel_assoc[of "affine hull S" "affine hull T" L] assms by auto
     moreover from * have "aff_dim S = int (dim L)"
       using aff_dim_parallel_subspace \<open>S \<noteq> {}\<close> by auto
     ultimately have ?thesis by auto
   }
   moreover
   {
     assume "S = {}"
     then have "S = {}" and "T = {}"
       using assms
       unfolding affine_parallel_def
       by auto
     then have ?thesis using aff_dim_empty by auto
   }
   moreover
   {
     assume "T = {}"
     then have "S = {}" and "T = {}"
       using assms
       unfolding affine_parallel_def
       by auto
     then have ?thesis
       using aff_dim_empty by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma aff_dim_translation_eq:
   "aff_dim ((+) a ` S) = aff_dim S" for a :: "'n::euclidean_space"
 proof -
   have "affine_parallel (affine hull S) (affine hull ((\<lambda>x. a + x) ` S))"
     unfolding affine_parallel_def
     apply (rule exI[of _ "a"])
     using affine_hull_translation[of a S]
     apply auto
     done
   then show ?thesis
     using aff_dim_parallel_eq[of S "(\<lambda>x. a + x) ` S"] by auto
 qed
 
 lemma aff_dim_translation_eq_subtract:
   "aff_dim ((\<lambda>x. x - a) ` S) = aff_dim S" for a :: "'n::euclidean_space"
   using aff_dim_translation_eq [of "- a"] by (simp cong: image_cong_simp)
 
 lemma aff_dim_affine:
   fixes S L :: "'n::euclidean_space set"
   assumes "S \<noteq> {}"
     and "affine S"
     and "subspace L"
     and "affine_parallel S L"
   shows "aff_dim S = int (dim L)"
 proof -
   have *: "affine hull S = S"
     using assms affine_hull_eq[of S] by auto
   then have "affine_parallel (affine hull S) L"
     using assms by (simp add: *)
   then show ?thesis
     using assms aff_dim_parallel_subspace[of S L] by blast
 qed
 
 lemma dim_affine_hull:
   fixes S :: "'n::euclidean_space set"
   shows "dim (affine hull S) = dim S"
 proof -
   have "dim (affine hull S) \<ge> dim S"
     using dim_subset by auto
   moreover have "dim (span S) \<ge> dim (affine hull S)"
     using dim_subset affine_hull_subset_span by blast
   moreover have "dim (span S) = dim S"
     using dim_span by auto
   ultimately show ?thesis by auto
 qed
 
 lemma aff_dim_subspace:
   fixes S :: "'n::euclidean_space set"
   assumes "subspace S"
   shows "aff_dim S = int (dim S)"
 proof (cases "S={}")
   case True with assms show ?thesis
     by (simp add: subspace_affine)
 next
   case False
   with aff_dim_affine[of S S] assms subspace_imp_affine[of S] affine_parallel_reflex[of S] subspace_affine
   show ?thesis by auto
 qed
 
 lemma aff_dim_zero:
   fixes S :: "'n::euclidean_space set"
   assumes "0 \<in> affine hull S"
   shows "aff_dim S = int (dim S)"
 proof -
   have "subspace (affine hull S)"
     using subspace_affine[of "affine hull S"] affine_affine_hull assms
     by auto
   then have "aff_dim (affine hull S) = int (dim (affine hull S))"
     using assms aff_dim_subspace[of "affine hull S"] by auto
   then show ?thesis
     using aff_dim_affine_hull[of S] dim_affine_hull[of S]
     by auto
 qed
 
 lemma aff_dim_eq_dim:
   "aff_dim S = int (dim ((+) (- a) ` S))" if "a \<in> affine hull S"
     for S :: "'n::euclidean_space set"
 proof -
   have "0 \<in> affine hull (+) (- a) ` S"
     unfolding affine_hull_translation
     using that by (simp add: ac_simps)
   with aff_dim_zero show ?thesis
     by (metis aff_dim_translation_eq)
 qed
 
 lemma aff_dim_eq_dim_subtract:
   "aff_dim S = int (dim ((\<lambda>x. x - a) ` S))" if "a \<in> affine hull S"
     for S :: "'n::euclidean_space set"
   using aff_dim_eq_dim [of a] that by (simp cong: image_cong_simp)
 
 lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
   using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"]
     dim_UNIV[where 'a="'n::euclidean_space"]
   by auto
 
 lemma aff_dim_geq:
   fixes V :: "'n::euclidean_space set"
   shows "aff_dim V \<ge> -1"
 proof -
   obtain B where "affine hull B = affine hull V"
     and "\<not> affine_dependent B"
     and "int (card B) = aff_dim V + 1"
     using aff_dim_basis_exists by auto
   then show ?thesis by auto
 qed
 
 lemma aff_dim_negative_iff [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim S < 0 \<longleftrightarrow>S = {}"
 by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq)
 
 lemma aff_lowdim_subset_hyperplane:
   fixes S :: "'a::euclidean_space set"
   assumes "aff_dim S < DIM('a)"
   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x = b}"
 proof (cases "S={}")
   case True
   moreover
   have "(SOME b. b \<in> Basis) \<noteq> 0"
     by (metis norm_some_Basis norm_zero zero_neq_one)
   ultimately show ?thesis
     using that by blast
 next
   case False
   then obtain c S' where "c \<notin> S'" "S = insert c S'"
     by (meson equals0I mk_disjoint_insert)
   have "dim ((+) (-c) ` S) < DIM('a)"
     by (metis \<open>S = insert c S'\<close> aff_dim_eq_dim assms hull_inc insertI1 of_nat_less_imp_less)
   then obtain a where "a \<noteq> 0" "span ((+) (-c) ` S) \<subseteq> {x. a \<bullet> x = 0}"
     using lowdim_subset_hyperplane by blast
   moreover
   have "a \<bullet> w = a \<bullet> c" if "span ((+) (- c) ` S) \<subseteq> {x. a \<bullet> x = 0}" "w \<in> S" for w
   proof -
     have "w-c \<in> span ((+) (- c) ` S)"
       by (simp add: span_base \<open>w \<in> S\<close>)
     with that have "w-c \<in> {x. a \<bullet> x = 0}"
       by blast
     then show ?thesis
       by (auto simp: algebra_simps)
   qed
   ultimately have "S \<subseteq> {x. a \<bullet> x = a \<bullet> c}"
     by blast
   then show ?thesis
     by (rule that[OF \<open>a \<noteq> 0\<close>])
 qed
 
 lemma affine_independent_card_dim_diffs:
   fixes S :: "'a :: euclidean_space set"
   assumes "\<not> affine_dependent S" "a \<in> S"
     shows "card S = dim {x - a|x. x \<in> S} + 1"
 proof -
   have 1: "{b - a|b. b \<in> (S - {a})} \<subseteq> {x - a|x. x \<in> S}" by auto
   have 2: "x - a \<in> span {b - a |b. b \<in> S - {a}}" if "x \<in> S" for x
   proof (cases "x = a")
     case True then show ?thesis by (simp add: span_clauses)
   next
     case False then show ?thesis
       using assms by (blast intro: span_base that)
   qed
   have "\<not> affine_dependent (insert a S)"
     by (simp add: assms insert_absorb)
   then have 3: "independent {b - a |b. b \<in> S - {a}}"
       using dependent_imp_affine_dependent by fastforce
   have "{b - a |b. b \<in> S - {a}} = (\<lambda>b. b-a) ` (S - {a})"
     by blast
   then have "card {b - a |b. b \<in> S - {a}} = card ((\<lambda>b. b-a) ` (S - {a}))"
     by simp
   also have "\<dots> = card (S - {a})"
     by (metis (no_types, lifting) card_image diff_add_cancel inj_onI)
   also have "\<dots> = card S - 1"
     by (simp add: aff_independent_finite assms)
   finally have 4: "card {b - a |b. b \<in> S - {a}} = card S - 1" .
   have "finite S"
     by (meson assms aff_independent_finite)
   with \<open>a \<in> S\<close> have "card S \<noteq> 0" by auto
   moreover have "dim {x - a |x. x \<in> S} = card S - 1"
     using 2 by (blast intro: dim_unique [OF 1 _ 3 4])
   ultimately show ?thesis
     by auto
 qed
 
 lemma independent_card_le_aff_dim:
   fixes B :: "'n::euclidean_space set"
   assumes "B \<subseteq> V"
   assumes "\<not> affine_dependent B"
   shows "int (card B) \<le> aff_dim V + 1"
 proof -
   obtain T where T: "\<not> affine_dependent T \<and> B \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
     by (metis assms extend_to_affine_basis[of B V])
   then have "of_nat (card T) = aff_dim V + 1"
     using aff_dim_unique by auto
   then show ?thesis
     using T card_mono[of T B] aff_independent_finite[of T] by auto
 qed
 
 lemma aff_dim_subset:
   fixes S T :: "'n::euclidean_space set"
   assumes "S \<subseteq> T"
   shows "aff_dim S \<le> aff_dim T"
 proof -
   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> S" "affine hull B = affine hull S"
     "of_nat (card B) = aff_dim S + 1"
     using aff_dim_inner_basis_exists[of S] by auto
   then have "int (card B) \<le> aff_dim T + 1"
     using assms independent_card_le_aff_dim[of B T] by auto
   with B show ?thesis by auto
 qed
 
 lemma aff_dim_le_DIM:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim S \<le> int (DIM('n))"
 proof -
   have "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
     using aff_dim_UNIV by auto
   then show "aff_dim (S:: 'n::euclidean_space set) \<le> int(DIM('n))"
     using aff_dim_subset[of S "(UNIV :: ('n::euclidean_space) set)"] subset_UNIV by auto
 qed
 
 lemma affine_dim_equal:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S" "affine T" "S \<noteq> {}" "S \<subseteq> T" "aff_dim S = aff_dim T"
   shows "S = T"
 proof -
   obtain a where "a \<in> S" using assms by auto
   then have "a \<in> T" using assms by auto
   define LS where "LS = {y. \<exists>x \<in> S. (-a) + x = y}"
   then have ls: "subspace LS" "affine_parallel S LS"
     using assms parallel_subspace_explicit[of S a LS] \<open>a \<in> S\<close> by auto
   then have h1: "int(dim LS) = aff_dim S"
     using assms aff_dim_affine[of S LS] by auto
   have "T \<noteq> {}" using assms by auto
   define LT where "LT = {y. \<exists>x \<in> T. (-a) + x = y}"
   then have lt: "subspace LT \<and> affine_parallel T LT"
     using assms parallel_subspace_explicit[of T a LT] \<open>a \<in> T\<close> by auto
   then have "int(dim LT) = aff_dim T"
     using assms aff_dim_affine[of T LT] \<open>T \<noteq> {}\<close> by auto
   then have "dim LS = dim LT"
     using h1 assms by auto
   moreover have "LS \<le> LT"
     using LS_def LT_def assms by auto
   ultimately have "LS = LT"
     using subspace_dim_equal[of LS LT] ls lt by auto
   moreover have "S = {x. \<exists>y \<in> LS. a+y=x}"
     using LS_def by auto
   moreover have "T = {x. \<exists>y \<in> LT. a+y=x}"
     using LT_def by auto
   ultimately show ?thesis by auto
 qed
 
 lemma aff_dim_eq_0:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S = 0 \<longleftrightarrow> (\<exists>a. S = {a})"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by auto
 next
   case False
   then obtain a where "a \<in> S" by auto
   show ?thesis
   proof safe
     assume 0: "aff_dim S = 0"
     have "\<not> {a,b} \<subseteq> S" if "b \<noteq> a" for b
       by (metis "0" aff_dim_2 aff_dim_subset not_one_le_zero that)
     then show "\<exists>a. S = {a}"
       using \<open>a \<in> S\<close> by blast
   qed auto
 qed
 
 lemma affine_hull_UNIV:
   fixes S :: "'n::euclidean_space set"
   assumes "aff_dim S = int(DIM('n))"
   shows "affine hull S = (UNIV :: ('n::euclidean_space) set)"
 proof -
   have "S \<noteq> {}"
     using assms aff_dim_empty[of S] by auto
   have h0: "S \<subseteq> affine hull S"
     using hull_subset[of S _] by auto
   have h1: "aff_dim (UNIV :: ('n::euclidean_space) set) = aff_dim S"
     using aff_dim_UNIV assms by auto
   then have h2: "aff_dim (affine hull S) \<le> aff_dim (UNIV :: ('n::euclidean_space) set)"
     using aff_dim_le_DIM[of "affine hull S"] assms h0 by auto
   have h3: "aff_dim S \<le> aff_dim (affine hull S)"
     using h0 aff_dim_subset[of S "affine hull S"] assms by auto
   then have h4: "aff_dim (affine hull S) = aff_dim (UNIV :: ('n::euclidean_space) set)"
     using h0 h1 h2 by auto
   then show ?thesis
     using affine_dim_equal[of "affine hull S" "(UNIV :: ('n::euclidean_space) set)"]
       affine_affine_hull[of S] affine_UNIV assms h4 h0 \<open>S \<noteq> {}\<close>
     by auto
 qed
 
 lemma disjoint_affine_hull:
   fixes s :: "'n::euclidean_space set"
   assumes "\<not> affine_dependent s" "t \<subseteq> s" "u \<subseteq> s" "t \<inter> u = {}"
     shows "(affine hull t) \<inter> (affine hull u) = {}"
 proof -
   have "finite s" using assms by (simp add: aff_independent_finite)
   then have "finite t" "finite u" using assms finite_subset by blast+
   { fix y
     assume yt: "y \<in> affine hull t" and yu: "y \<in> affine hull u"
     then obtain a b
            where a1 [simp]: "sum a t = 1" and [simp]: "sum (\<lambda>v. a v *\<^sub>R v) t = y"
              and [simp]: "sum b u = 1" "sum (\<lambda>v. b v *\<^sub>R v) u = y"
       by (auto simp: affine_hull_finite \<open>finite t\<close> \<open>finite u\<close>)
     define c where "c x = (if x \<in> t then a x else if x \<in> u then -(b x) else 0)" for x
     have [simp]: "s \<inter> t = t" "s \<inter> - t \<inter> u = u" using assms by auto
     have "sum c s = 0"
       by (simp add: c_def comm_monoid_add_class.sum.If_cases \<open>finite s\<close> sum_negf)
     moreover have "\<not> (\<forall>v\<in>s. c v = 0)"
       by (metis (no_types) IntD1 \<open>s \<inter> t = t\<close> a1 c_def sum.neutral zero_neq_one)
     moreover have "(\<Sum>v\<in>s. c v *\<^sub>R v) = 0"
       by (simp add: c_def if_smult sum_negf
              comm_monoid_add_class.sum.If_cases \<open>finite s\<close>)
     ultimately have False
       using assms \<open>finite s\<close> by (auto simp: affine_dependent_explicit)
   }
   then show ?thesis by blast
 qed
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Bochner_Integration.thy b/src/HOL/Analysis/Bochner_Integration.thy
--- a/src/HOL/Analysis/Bochner_Integration.thy
+++ b/src/HOL/Analysis/Bochner_Integration.thy
@@ -1,3364 +1,3372 @@
 (*  Title:      HOL/Analysis/Bochner_Integration.thy
     Author:     Johannes Hölzl, TU München
 *)
 
 section \<open>Bochner Integration for Vector-Valued Functions\<close>
 
 theory Bochner_Integration
   imports Finite_Product_Measure
 begin
 
 text \<open>
 
 In the following development of the Bochner integral we use second countable topologies instead
 of separable spaces. A second countable topology is also separable.
 
 \<close>
 
 proposition borel_measurable_implies_sequence_metric:
   fixes f :: "'a \<Rightarrow> 'b :: {metric_space, second_countable_topology}"
   assumes [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>F. (\<forall>i. simple_function M (F i)) \<and> (\<forall>x\<in>space M. (\<lambda>i. F i x) \<longlonglongrightarrow> f x) \<and>
     (\<forall>i. \<forall>x\<in>space M. dist (F i x) z \<le> 2 * dist (f x) z)"
 proof -
   obtain D :: "'b set" where "countable D" and D: "\<And>X. open X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>d\<in>D. d \<in> X"
     by (erule countable_dense_setE)
 
   define e where "e = from_nat_into D"
   { fix n x
     obtain d where "d \<in> D" and d: "d \<in> ball x (1 / Suc n)"
       using D[of "ball x (1 / Suc n)"] by auto
     from \<open>d \<in> D\<close> D[of UNIV] \<open>countable D\<close> obtain i where "d = e i"
       unfolding e_def by (auto dest: from_nat_into_surj)
     with d have "\<exists>i. dist x (e i) < 1 / Suc n"
       by auto }
   note e = this
 
   define A where [abs_def]: "A m n =
     {x\<in>space M. dist (f x) (e n) < 1 / (Suc m) \<and> 1 / (Suc m) \<le> dist (f x) z}" for m n
   define B where [abs_def]: "B m = disjointed (A m)" for m
 
   define m where [abs_def]: "m N x = Max {m. m \<le> N \<and> x \<in> (\<Union>n\<le>N. B m n)}" for N x
   define F where [abs_def]: "F N x =
     (if (\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)) \<and> (\<exists>n\<le>N. x \<in> B (m N x) n)
      then e (LEAST n. x \<in> B (m N x) n) else z)" for N x
 
   have B_imp_A[intro, simp]: "\<And>x m n. x \<in> B m n \<Longrightarrow> x \<in> A m n"
     using disjointed_subset[of "A m" for m] unfolding B_def by auto
 
   { fix m
     have "\<And>n. A m n \<in> sets M"
       by (auto simp: A_def)
     then have "\<And>n. B m n \<in> sets M"
       using sets.range_disjointed_sets[of "A m" M] by (auto simp: B_def) }
   note this[measurable]
 
   { fix N i x assume "\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)"
     then have "m N x \<in> {m::nat. m \<le> N \<and> x \<in> (\<Union>n\<le>N. B m n)}"
       unfolding m_def by (intro Max_in) auto
     then have "m N x \<le> N" "\<exists>n\<le>N. x \<in> B (m N x) n"
       by auto }
   note m = this
 
   { fix j N i x assume "j \<le> N" "i \<le> N" "x \<in> B j i"
     then have "j \<le> m N x"
       unfolding m_def by (intro Max_ge) auto }
   note m_upper = this
 
   show ?thesis
     unfolding simple_function_def
   proof (safe intro!: exI[of _ F])
     have [measurable]: "\<And>i. F i \<in> borel_measurable M"
       unfolding F_def m_def by measurable
     show "\<And>x i. F i -` {x} \<inter> space M \<in> sets M"
       by measurable
 
     { fix i
       { fix n x assume "x \<in> B (m i x) n"
         then have "(LEAST n. x \<in> B (m i x) n) \<le> n"
           by (intro Least_le)
         also assume "n \<le> i"
         finally have "(LEAST n. x \<in> B (m i x) n) \<le> i" . }
       then have "F i ` space M \<subseteq> {z} \<union> e ` {.. i}"
         by (auto simp: F_def)
       then show "finite (F i ` space M)"
         by (rule finite_subset) auto }
 
     { fix N i n x assume "i \<le> N" "n \<le> N" "x \<in> B i n"
       then have 1: "\<exists>m\<le>N. x \<in> (\<Union>n\<le>N. B m n)" by auto
       from m[OF this] obtain n where n: "m N x \<le> N" "n \<le> N" "x \<in> B (m N x) n" by auto
       moreover
       define L where "L = (LEAST n. x \<in> B (m N x) n)"
       have "dist (f x) (e L) < 1 / Suc (m N x)"
       proof -
         have "x \<in> B (m N x) L"
           using n(3) unfolding L_def by (rule LeastI)
         then have "x \<in> A (m N x) L"
           by auto
         then show ?thesis
           unfolding A_def by simp
       qed
       ultimately have "dist (f x) (F N x) < 1 / Suc (m N x)"
         by (auto simp add: F_def L_def) }
     note * = this
 
     fix x assume "x \<in> space M"
     show "(\<lambda>i. F i x) \<longlonglongrightarrow> f x"
     proof cases
       assume "f x = z"
       then have "\<And>i n. x \<notin> A i n"
         unfolding A_def by auto
       then have "\<And>i. F i x = z"
         by (auto simp: F_def)
       then show ?thesis
         using \<open>f x = z\<close> by auto
     next
       assume "f x \<noteq> z"
 
       show ?thesis
       proof (rule tendstoI)
         fix e :: real assume "0 < e"
         with \<open>f x \<noteq> z\<close> obtain n where "1 / Suc n < e" "1 / Suc n < dist (f x) z"
           by (metis dist_nz order_less_trans neq_iff nat_approx_posE)
         with \<open>x\<in>space M\<close> \<open>f x \<noteq> z\<close> have "x \<in> (\<Union>i. B n i)"
           unfolding A_def B_def UN_disjointed_eq using e by auto
         then obtain i where i: "x \<in> B n i" by auto
 
         show "eventually (\<lambda>i. dist (F i x) (f x) < e) sequentially"
           using eventually_ge_at_top[of "max n i"]
         proof eventually_elim
           fix j assume j: "max n i \<le> j"
           with i have "dist (f x) (F j x) < 1 / Suc (m j x)"
             by (intro *[OF _ _ i]) auto
           also have "\<dots> \<le> 1 / Suc n"
             using j m_upper[OF _ _ i]
             by (auto simp: field_simps)
           also note \<open>1 / Suc n < e\<close>
           finally show "dist (F j x) (f x) < e"
             by (simp add: less_imp_le dist_commute)
         qed
       qed
     qed
     fix i
     { fix n m assume "x \<in> A n m"
       then have "dist (e m) (f x) + dist (f x) z \<le> 2 * dist (f x) z"
         unfolding A_def by (auto simp: dist_commute)
       also have "dist (e m) z \<le> dist (e m) (f x) + dist (f x) z"
         by (rule dist_triangle)
       finally (xtrans) have "dist (e m) z \<le> 2 * dist (f x) z" . }
     then show "dist (F i x) z \<le> 2 * dist (f x) z"
       unfolding F_def
       apply auto
       apply (rule LeastI2)
       apply auto
       done
   qed
 qed
 
 lemma
   fixes f :: "'a \<Rightarrow> 'b::semiring_1" assumes "finite A"
   shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator (B x) (g x)) = (\<Sum>x\<in>{x\<in>A. g x \<in> B x}. f x)"
   and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator (B x) (g x) * f x) = (\<Sum>x\<in>{x\<in>A. g x \<in> B x}. f x)"
   unfolding indicator_def
   using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)
 
 lemma borel_measurable_induct_real[consumes 2, case_names set mult add seq]:
   fixes P :: "('a \<Rightarrow> real) \<Rightarrow> bool"
   assumes u: "u \<in> borel_measurable M" "\<And>x. 0 \<le> u x"
   assumes set: "\<And>A. A \<in> sets M \<Longrightarrow> P (indicator A)"
   assumes mult: "\<And>u c. 0 \<le> c \<Longrightarrow> u \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> u x) \<Longrightarrow> P u \<Longrightarrow> P (\<lambda>x. c * u x)"
   assumes add: "\<And>u v. u \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> u x) \<Longrightarrow> P u \<Longrightarrow> v \<in> borel_measurable M \<Longrightarrow> (\<And>x. 0 \<le> v x) \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> u x = 0 \<or> v x = 0) \<Longrightarrow> P v \<Longrightarrow> P (\<lambda>x. v x + u x)"
   assumes seq: "\<And>U. (\<And>i. U i \<in> borel_measurable M) \<Longrightarrow> (\<And>i x. 0 \<le> U i x) \<Longrightarrow> (\<And>i. P (U i)) \<Longrightarrow> incseq U \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. U i x) \<longlonglongrightarrow> u x) \<Longrightarrow> P u"
   shows "P u"
 proof -
   have "(\<lambda>x. ennreal (u x)) \<in> borel_measurable M" using u by auto
   from borel_measurable_implies_simple_function_sequence'[OF this]
   obtain U where U: "\<And>i. simple_function M (U i)" "incseq U" "\<And>i x. U i x < top" and
     sup: "\<And>x. (SUP i. U i x) = ennreal (u x)"
     by blast
 
   define U' where [abs_def]: "U' i x = indicator (space M) x * enn2real (U i x)" for i x
   then have U'_sf[measurable]: "\<And>i. simple_function M (U' i)"
     using U by (auto intro!: simple_function_compose1[where g=enn2real])
 
   show "P u"
   proof (rule seq)
     show U': "U' i \<in> borel_measurable M" "\<And>x. 0 \<le> U' i x" for i
       using U by (auto
           intro: borel_measurable_simple_function
           intro!: borel_measurable_enn2real borel_measurable_times
           simp: U'_def zero_le_mult_iff)
     show "incseq U'"
       using U(2,3)
       by (auto simp: incseq_def le_fun_def image_iff eq_commute U'_def indicator_def enn2real_mono)
 
     fix x assume x: "x \<in> space M"
     have "(\<lambda>i. U i x) \<longlonglongrightarrow> (SUP i. U i x)"
       using U(2) by (intro LIMSEQ_SUP) (auto simp: incseq_def le_fun_def)
     moreover have "(\<lambda>i. U i x) = (\<lambda>i. ennreal (U' i x))"
       using x U(3) by (auto simp: fun_eq_iff U'_def image_iff eq_commute)
     moreover have "(SUP i. U i x) = ennreal (u x)"
       using sup u(2) by (simp add: max_def)
     ultimately show "(\<lambda>i. U' i x) \<longlonglongrightarrow> u x"
       using u U' by simp
   next
     fix i
     have "U' i ` space M \<subseteq> enn2real ` (U i ` space M)" "finite (U i ` space M)"
       unfolding U'_def using U(1) by (auto dest: simple_functionD)
     then have fin: "finite (U' i ` space M)"
       by (metis finite_subset finite_imageI)
     moreover have "\<And>z. {y. U' i z = y \<and> y \<in> U' i ` space M \<and> z \<in> space M} = (if z \<in> space M then {U' i z} else {})"
       by auto
     ultimately have U': "(\<lambda>z. \<Sum>y\<in>U' i`space M. y * indicator {x\<in>space M. U' i x = y} z) = U' i"
       by (simp add: U'_def fun_eq_iff)
     have "\<And>x. x \<in> U' i ` space M \<Longrightarrow> 0 \<le> x"
       by (auto simp: U'_def)
     with fin have "P (\<lambda>z. \<Sum>y\<in>U' i`space M. y * indicator {x\<in>space M. U' i x = y} z)"
     proof induct
       case empty from set[of "{}"] show ?case
         by (simp add: indicator_def[abs_def])
     next
       case (insert x F)
-      then show ?case
-        by (auto intro!: add mult set sum_nonneg split: split_indicator split_indicator_asm
-                 simp del: sum_mult_indicator simp: sum_nonneg_eq_0_iff)
+      from insert.prems have nonneg: "x \<ge> 0" "\<And>y. y \<in> F \<Longrightarrow> y \<ge> 0"
+        by simp_all
+      hence *: "P (\<lambda>xa. x * indicat_real {x' \<in> space M. U' i x' = x} xa)"
+        by (intro mult set) auto
+      have "P (\<lambda>z. x * indicat_real {x' \<in> space M. U' i x' = x} z + 
+                   (\<Sum>y\<in>F. y * indicat_real {x \<in> space M. U' i x = y} z))"
+        using insert(1-3)
+        by (intro add * sum_nonneg mult_nonneg_nonneg)
+           (auto simp: nonneg indicator_def sum_nonneg_eq_0_iff)
+      thus ?case 
+        using insert.hyps by (subst sum.insert) auto
     qed
     with U' show "P (U' i)" by simp
   qed
 qed
 
 lemma scaleR_cong_right:
   fixes x :: "'a :: real_vector"
   shows "(x \<noteq> 0 \<Longrightarrow> r = p) \<Longrightarrow> r *\<^sub>R x = p *\<^sub>R x"
   by (cases "x = 0") auto
 
 inductive simple_bochner_integrable :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b::real_vector) \<Rightarrow> bool" for M f where
   "simple_function M f \<Longrightarrow> emeasure M {y\<in>space M. f y \<noteq> 0} \<noteq> \<infinity> \<Longrightarrow>
     simple_bochner_integrable M f"
 
 lemma simple_bochner_integrable_compose2:
   assumes p_0: "p 0 0 = 0"
   shows "simple_bochner_integrable M f \<Longrightarrow> simple_bochner_integrable M g \<Longrightarrow>
     simple_bochner_integrable M (\<lambda>x. p (f x) (g x))"
 proof (safe intro!: simple_bochner_integrable.intros elim!: simple_bochner_integrable.cases del: notI)
   assume sf: "simple_function M f" "simple_function M g"
   then show "simple_function M (\<lambda>x. p (f x) (g x))"
     by (rule simple_function_compose2)
 
   from sf have [measurable]:
       "f \<in> measurable M (count_space UNIV)"
       "g \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function)
 
   assume fin: "emeasure M {y \<in> space M. f y \<noteq> 0} \<noteq> \<infinity>" "emeasure M {y \<in> space M. g y \<noteq> 0} \<noteq> \<infinity>"
 
   have "emeasure M {x\<in>space M. p (f x) (g x) \<noteq> 0} \<le>
       emeasure M ({x\<in>space M. f x \<noteq> 0} \<union> {x\<in>space M. g x \<noteq> 0})"
     by (intro emeasure_mono) (auto simp: p_0)
   also have "\<dots> \<le> emeasure M {x\<in>space M. f x \<noteq> 0} + emeasure M {x\<in>space M. g x \<noteq> 0}"
     by (intro emeasure_subadditive) auto
   finally show "emeasure M {y \<in> space M. p (f y) (g y) \<noteq> 0} \<noteq> \<infinity>"
     using fin by (auto simp: top_unique)
 qed
 
 lemma simple_function_finite_support:
   assumes f: "simple_function M f" and fin: "(\<integral>\<^sup>+x. f x \<partial>M) < \<infinity>" and nn: "\<And>x. 0 \<le> f x"
   shows "emeasure M {x\<in>space M. f x \<noteq> 0} \<noteq> \<infinity>"
 proof cases
   from f have meas[measurable]: "f \<in> borel_measurable M"
     by (rule borel_measurable_simple_function)
 
   assume non_empty: "\<exists>x\<in>space M. f x \<noteq> 0"
 
   define m where "m = Min (f`space M - {0})"
   have "m \<in> f`space M - {0}"
     unfolding m_def using f non_empty by (intro Min_in) (auto simp: simple_function_def)
   then have m: "0 < m"
     using nn by (auto simp: less_le)
 
   from m have "m * emeasure M {x\<in>space M. 0 \<noteq> f x} =
     (\<integral>\<^sup>+x. m * indicator {x\<in>space M. 0 \<noteq> f x} x \<partial>M)"
     using f by (intro nn_integral_cmult_indicator[symmetric]) auto
   also have "\<dots> \<le> (\<integral>\<^sup>+x. f x \<partial>M)"
     using AE_space
   proof (intro nn_integral_mono_AE, eventually_elim)
     fix x assume "x \<in> space M"
     with nn show "m * indicator {x \<in> space M. 0 \<noteq> f x} x \<le> f x"
       using f by (auto split: split_indicator simp: simple_function_def m_def)
   qed
   also note \<open>\<dots> < \<infinity>\<close>
   finally show ?thesis
     using m by (auto simp: ennreal_mult_less_top)
 next
   assume "\<not> (\<exists>x\<in>space M. f x \<noteq> 0)"
   with nn have *: "{x\<in>space M. f x \<noteq> 0} = {}"
     by auto
   show ?thesis unfolding * by simp
 qed
 
 lemma simple_bochner_integrableI_bounded:
   assumes f: "simple_function M f" and fin: "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   shows "simple_bochner_integrable M f"
 proof
   have "emeasure M {y \<in> space M. ennreal (norm (f y)) \<noteq> 0} \<noteq> \<infinity>"
   proof (rule simple_function_finite_support)
     show "simple_function M (\<lambda>x. ennreal (norm (f x)))"
       using f by (rule simple_function_compose1)
     show "(\<integral>\<^sup>+ y. ennreal (norm (f y)) \<partial>M) < \<infinity>" by fact
   qed simp
   then show "emeasure M {y \<in> space M. f y \<noteq> 0} \<noteq> \<infinity>" by simp
 qed fact
 
 definition\<^marker>\<open>tag important\<close> simple_bochner_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b::real_vector) \<Rightarrow> 'b" where
   "simple_bochner_integral M f = (\<Sum>y\<in>f`space M. measure M {x\<in>space M. f x = y} *\<^sub>R y)"
 
 proposition simple_bochner_integral_partition:
   assumes f: "simple_bochner_integrable M f" and g: "simple_function M g"
   assumes sub: "\<And>x y. x \<in> space M \<Longrightarrow> y \<in> space M \<Longrightarrow> g x = g y \<Longrightarrow> f x = f y"
   assumes v: "\<And>x. x \<in> space M \<Longrightarrow> f x = v (g x)"
   shows "simple_bochner_integral M f = (\<Sum>y\<in>g ` space M. measure M {x\<in>space M. g x = y} *\<^sub>R v y)"
     (is "_ = ?r")
 proof -
   from f g have [simp]: "finite (f`space M)" "finite (g`space M)"
     by (auto simp: simple_function_def elim: simple_bochner_integrable.cases)
 
   from f have [measurable]: "f \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function elim: simple_bochner_integrable.cases)
 
   from g have [measurable]: "g \<in> measurable M (count_space UNIV)"
     by (auto intro: measurable_simple_function elim: simple_bochner_integrable.cases)
 
   { fix y assume "y \<in> space M"
     then have "f ` space M \<inter> {i. \<exists>x\<in>space M. i = f x \<and> g y = g x} = {v (g y)}"
       by (auto cong: sub simp: v[symmetric]) }
   note eq = this
 
   have "simple_bochner_integral M f =
     (\<Sum>y\<in>f`space M. (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then measure M {x\<in>space M. g x = z} else 0) *\<^sub>R y)"
     unfolding simple_bochner_integral_def
   proof (safe intro!: sum.cong scaleR_cong_right)
     fix y assume y: "y \<in> space M" "f y \<noteq> 0"
     have [simp]: "g ` space M \<inter> {z. \<exists>x\<in>space M. f y = f x \<and> z = g x} =
         {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by auto
     have eq:"{x \<in> space M. f x = f y} =
         (\<Union>i\<in>{z. \<exists>x\<in>space M. f y = f x \<and> z = g x}. {x \<in> space M. g x = i})"
       by (auto simp: eq_commute cong: sub rev_conj_cong)
     have "finite (g`space M)" by simp
     then have "finite {z. \<exists>x\<in>space M. f y = f x \<and> z = g x}"
       by (rule rev_finite_subset) auto
     moreover
     { fix x assume "x \<in> space M" "f x = f y"
       then have "x \<in> space M" "f x \<noteq> 0"
         using y by auto
       then have "emeasure M {y \<in> space M. g y = g x} \<le> emeasure M {y \<in> space M. f y \<noteq> 0}"
         by (auto intro!: emeasure_mono cong: sub)
       then have "emeasure M {xa \<in> space M. g xa = g x} < \<infinity>"
         using f by (auto simp: simple_bochner_integrable.simps less_top) }
     ultimately
     show "measure M {x \<in> space M. f x = f y} =
       (\<Sum>z\<in>g ` space M. if \<exists>x\<in>space M. f y = f x \<and> z = g x then measure M {x \<in> space M. g x = z} else 0)"
       apply (simp add: sum.If_cases eq)
       apply (subst measure_finite_Union[symmetric])
       apply (auto simp: disjoint_family_on_def less_top)
       done
   qed
   also have "\<dots> = (\<Sum>y\<in>f`space M. (\<Sum>z\<in>g`space M.
       if \<exists>x\<in>space M. y = f x \<and> z = g x then measure M {x\<in>space M. g x = z} *\<^sub>R y else 0))"
     by (auto intro!: sum.cong simp: scaleR_sum_left)
   also have "\<dots> = ?r"
     by (subst sum.swap)
        (auto intro!: sum.cong simp: sum.If_cases scaleR_sum_right[symmetric] eq)
   finally show "simple_bochner_integral M f = ?r" .
 qed
 
 lemma simple_bochner_integral_add:
   assumes f: "simple_bochner_integrable M f" and g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f x + g x) =
     simple_bochner_integral M f + simple_bochner_integral M g"
 proof -
   from f g have "simple_bochner_integral M (\<lambda>x. f x + g x) =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R (fst y + snd y))"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   moreover from f g have "simple_bochner_integral M f =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R fst y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   moreover from f g have "simple_bochner_integral M g =
     (\<Sum>y\<in>(\<lambda>x. (f x, g x)) ` space M. measure M {x \<in> space M. (f x, g x) = y} *\<^sub>R snd y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   ultimately show ?thesis
     by (simp add: sum.distrib[symmetric] scaleR_add_right)
 qed
 
 lemma simple_bochner_integral_linear:
   assumes "linear f"
   assumes g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f (g x)) = f (simple_bochner_integral M g)"
 proof -
   interpret linear f by fact
   from g have "simple_bochner_integral M (\<lambda>x. f (g x)) =
     (\<Sum>y\<in>g ` space M. measure M {x \<in> space M. g x = y} *\<^sub>R f y)"
     by (intro simple_bochner_integral_partition)
        (auto simp: simple_bochner_integrable_compose2[where p="\<lambda>x y. f x"]
              elim: simple_bochner_integrable.cases)
   also have "\<dots> = f (simple_bochner_integral M g)"
     by (simp add: simple_bochner_integral_def sum scale)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_minus:
   assumes f: "simple_bochner_integrable M f"
   shows "simple_bochner_integral M (\<lambda>x. - f x) = - simple_bochner_integral M f"
 proof -
   from linear_uminus f show ?thesis
     by (rule simple_bochner_integral_linear)
 qed
 
 lemma simple_bochner_integral_diff:
   assumes f: "simple_bochner_integrable M f" and g: "simple_bochner_integrable M g"
   shows "simple_bochner_integral M (\<lambda>x. f x - g x) =
     simple_bochner_integral M f - simple_bochner_integral M g"
   unfolding diff_conv_add_uminus using f g
   by (subst simple_bochner_integral_add)
      (auto simp: simple_bochner_integral_minus simple_bochner_integrable_compose2[where p="\<lambda>x y. - y"])
 
 lemma simple_bochner_integral_norm_bound:
   assumes f: "simple_bochner_integrable M f"
   shows "norm (simple_bochner_integral M f) \<le> simple_bochner_integral M (\<lambda>x. norm (f x))"
 proof -
   have "norm (simple_bochner_integral M f) \<le>
     (\<Sum>y\<in>f ` space M. norm (measure M {x \<in> space M. f x = y} *\<^sub>R y))"
     unfolding simple_bochner_integral_def by (rule norm_sum)
   also have "\<dots> = (\<Sum>y\<in>f ` space M. measure M {x \<in> space M. f x = y} *\<^sub>R norm y)"
     by simp
   also have "\<dots> = simple_bochner_integral M (\<lambda>x. norm (f x))"
     using f
     by (intro simple_bochner_integral_partition[symmetric])
        (auto intro: f simple_bochner_integrable_compose2 elim: simple_bochner_integrable.cases)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_nonneg[simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "(\<And>x. 0 \<le> f x) \<Longrightarrow> 0 \<le> simple_bochner_integral M f"
   by (force simp add: simple_bochner_integral_def intro: sum_nonneg)
 
 lemma simple_bochner_integral_eq_nn_integral:
   assumes f: "simple_bochner_integrable M f" "\<And>x. 0 \<le> f x"
   shows "simple_bochner_integral M f = (\<integral>\<^sup>+x. f x \<partial>M)"
 proof -
   { fix x y z have "(x \<noteq> 0 \<Longrightarrow> y = z) \<Longrightarrow> ennreal x * y = ennreal x * z"
       by (cases "x = 0") (auto simp: zero_ennreal_def[symmetric]) }
   note ennreal_cong_mult = this
 
   have [measurable]: "f \<in> borel_measurable M"
     using f(1) by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   { fix y assume y: "y \<in> space M" "f y \<noteq> 0"
     have "ennreal (measure M {x \<in> space M. f x = f y}) = emeasure M {x \<in> space M. f x = f y}"
     proof (rule emeasure_eq_ennreal_measure[symmetric])
       have "emeasure M {x \<in> space M. f x = f y} \<le> emeasure M {x \<in> space M. f x \<noteq> 0}"
         using y by (intro emeasure_mono) auto
       with f show "emeasure M {x \<in> space M. f x = f y} \<noteq> top"
         by (auto simp: simple_bochner_integrable.simps top_unique)
     qed
     moreover have "{x \<in> space M. f x = f y} = (\<lambda>x. ennreal (f x)) -` {ennreal (f y)} \<inter> space M"
       using f by auto
     ultimately have "ennreal (measure M {x \<in> space M. f x = f y}) =
           emeasure M ((\<lambda>x. ennreal (f x)) -` {ennreal (f y)} \<inter> space M)" by simp }
   with f have "simple_bochner_integral M f = (\<integral>\<^sup>Sx. f x \<partial>M)"
     unfolding simple_integral_def
     by (subst simple_bochner_integral_partition[OF f(1), where g="\<lambda>x. ennreal (f x)" and v=enn2real])
        (auto intro: f simple_function_compose1 elim: simple_bochner_integrable.cases
              intro!: sum.cong ennreal_cong_mult
              simp: ac_simps ennreal_mult
              simp flip: sum_ennreal)
   also have "\<dots> = (\<integral>\<^sup>+x. f x \<partial>M)"
     using f
     by (intro nn_integral_eq_simple_integral[symmetric])
        (auto simp: simple_function_compose1 simple_bochner_integrable.simps)
   finally show ?thesis .
 qed
 
 lemma simple_bochner_integral_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes s: "simple_bochner_integrable M s" and t: "simple_bochner_integrable M t"
   shows "ennreal (norm (simple_bochner_integral M s - simple_bochner_integral M t)) \<le>
     (\<integral>\<^sup>+ x. norm (f x - s x) \<partial>M) + (\<integral>\<^sup>+ x. norm (f x - t x) \<partial>M)"
     (is "ennreal (norm (?s - ?t)) \<le> ?S + ?T")
 proof -
   have [measurable]: "s \<in> borel_measurable M" "t \<in> borel_measurable M"
     using s t by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   have "ennreal (norm (?s - ?t)) = norm (simple_bochner_integral M (\<lambda>x. s x - t x))"
     using s t by (subst simple_bochner_integral_diff) auto
   also have "\<dots> \<le> simple_bochner_integral M (\<lambda>x. norm (s x - t x))"
     using simple_bochner_integrable_compose2[of "(-)" M "s" "t"] s t
     by (auto intro!: simple_bochner_integral_norm_bound)
   also have "\<dots> = (\<integral>\<^sup>+x. norm (s x - t x) \<partial>M)"
     using simple_bochner_integrable_compose2[of "\<lambda>x y. norm (x - y)" M "s" "t"] s t
     by (auto intro!: simple_bochner_integral_eq_nn_integral)
   also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s x)) + ennreal (norm (f x - t x)) \<partial>M)"
     by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
        (metis (erased, hide_lams) add_diff_cancel_left add_diff_eq diff_add_eq order_trans
               norm_minus_commute norm_triangle_ineq4 order_refl)
   also have "\<dots> = ?S + ?T"
    by (rule nn_integral_add) auto
   finally show ?thesis .
 qed
 
 inductive has_bochner_integral :: "'a measure \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b::{real_normed_vector, second_countable_topology} \<Rightarrow> bool"
   for M f x where
   "f \<in> borel_measurable M \<Longrightarrow>
     (\<And>i. simple_bochner_integrable M (s i)) \<Longrightarrow>
     (\<lambda>i. \<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0 \<Longrightarrow>
     (\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x \<Longrightarrow>
     has_bochner_integral M f x"
 
 lemma has_bochner_integral_cong:
   assumes "M = N" "\<And>x. x \<in> space N \<Longrightarrow> f x = g x" "x = y"
   shows "has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral N g y"
   unfolding has_bochner_integral.simps assms(1,3)
   using assms(2) by (simp cong: measurable_cong_simp nn_integral_cong_simp)
 
 lemma has_bochner_integral_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. f x = g x) \<Longrightarrow>
     has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral M g x"
   unfolding has_bochner_integral.simps
   by (intro arg_cong[where f=Ex] ext conj_cong rev_conj_cong refl arg_cong[where f="\<lambda>x. x \<longlonglongrightarrow> 0"]
             nn_integral_cong_AE)
      auto
 
 lemma borel_measurable_has_bochner_integral:
   "has_bochner_integral M f x \<Longrightarrow> f \<in> borel_measurable M"
   by (rule has_bochner_integral.cases)
 
 lemma borel_measurable_has_bochner_integral'[measurable_dest]:
   "has_bochner_integral M f x \<Longrightarrow> g \<in> measurable N M \<Longrightarrow> (\<lambda>x. f (g x)) \<in> borel_measurable N"
   using borel_measurable_has_bochner_integral[measurable] by measurable
 
 lemma has_bochner_integral_simple_bochner_integrable:
   "simple_bochner_integrable M f \<Longrightarrow> has_bochner_integral M f (simple_bochner_integral M f)"
   by (rule has_bochner_integral.intros[where s="\<lambda>_. f"])
      (auto intro: borel_measurable_simple_function
            elim: simple_bochner_integrable.cases
            simp: zero_ennreal_def[symmetric])
 
 lemma has_bochner_integral_real_indicator:
   assumes [measurable]: "A \<in> sets M" and A: "emeasure M A < \<infinity>"
   shows "has_bochner_integral M (indicator A) (measure M A)"
 proof -
   have sbi: "simple_bochner_integrable M (indicator A::'a \<Rightarrow> real)"
   proof
     have "{y \<in> space M. (indicator A y::real) \<noteq> 0} = A"
       using sets.sets_into_space[OF \<open>A\<in>sets M\<close>] by (auto split: split_indicator)
     then show "emeasure M {y \<in> space M. (indicator A y::real) \<noteq> 0} \<noteq> \<infinity>"
       using A by auto
   qed (rule simple_function_indicator assms)+
   moreover have "simple_bochner_integral M (indicator A) = measure M A"
     using simple_bochner_integral_eq_nn_integral[OF sbi] A
     by (simp add: ennreal_indicator emeasure_eq_ennreal_measure)
   ultimately show ?thesis
     by (metis has_bochner_integral_simple_bochner_integrable)
 qed
 
 lemma has_bochner_integral_add[intro]:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M g y \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f x + g x) (x + y)"
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   fix sf sg
   assume f_sf: "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - sf i x) \<partial>M) \<longlonglongrightarrow> 0"
   assume g_sg: "(\<lambda>i. \<integral>\<^sup>+ x. norm (g x - sg i x) \<partial>M) \<longlonglongrightarrow> 0"
 
   assume sf: "\<forall>i. simple_bochner_integrable M (sf i)"
     and sg: "\<forall>i. simple_bochner_integrable M (sg i)"
   then have [measurable]: "\<And>i. sf i \<in> borel_measurable M" "\<And>i. sg i \<in> borel_measurable M"
     by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
   assume [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
 
   show "\<And>i. simple_bochner_integrable M (\<lambda>x. sf i x + sg i x)"
     using sf sg by (simp add: simple_bochner_integrable_compose2)
 
   show "(\<lambda>i. \<integral>\<^sup>+ x. (norm (f x + g x - (sf i x + sg i x))) \<partial>M) \<longlonglongrightarrow> 0"
     (is "?f \<longlonglongrightarrow> 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. 0 \<le> ?f n) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> 0"
       by auto
     show "eventually (\<lambda>i. ?f i \<le> (\<integral>\<^sup>+ x. (norm (f x - sf i x)) \<partial>M) + \<integral>\<^sup>+ x. (norm (g x - sg i x)) \<partial>M) sequentially"
       (is "eventually (\<lambda>i. ?f i \<le> ?g i) sequentially")
     proof (intro always_eventually allI)
       fix i have "?f i \<le> (\<integral>\<^sup>+ x. (norm (f x - sf i x)) + ennreal (norm (g x - sg i x)) \<partial>M)"
         by (auto intro!: nn_integral_mono norm_diff_triangle_ineq
                  simp flip: ennreal_plus)
       also have "\<dots> = ?g i"
         by (intro nn_integral_add) auto
       finally show "?f i \<le> ?g i" .
     qed
     show "?g \<longlonglongrightarrow> 0"
       using tendsto_add[OF f_sf g_sg] by simp
   qed
 qed (auto simp: simple_bochner_integral_add tendsto_add)
 
 lemma has_bochner_integral_bounded_linear:
   assumes "bounded_linear T"
   shows "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M (\<lambda>x. T (f x)) (T x)"
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   interpret T: bounded_linear T by fact
   have [measurable]: "T \<in> borel_measurable borel"
     by (intro borel_measurable_continuous_onI T.continuous_on continuous_on_id)
   assume [measurable]: "f \<in> borel_measurable M"
   then show "(\<lambda>x. T (f x)) \<in> borel_measurable M"
     by auto
 
   fix s assume f_s: "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0"
   assume s: "\<forall>i. simple_bochner_integrable M (s i)"
   then show "\<And>i. simple_bochner_integrable M (\<lambda>x. T (s i x))"
     by (auto intro: simple_bochner_integrable_compose2 T.zero)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   obtain K where K: "K > 0" "\<And>x i. norm (T (f x) - T (s i x)) \<le> norm (f x - s i x) * K"
     using T.pos_bounded by (auto simp: T.diff[symmetric])
 
   show "(\<lambda>i. \<integral>\<^sup>+ x. norm (T (f x) - T (s i x)) \<partial>M) \<longlonglongrightarrow> 0"
     (is "?f \<longlonglongrightarrow> 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. 0 \<le> ?f n) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> 0"
       by auto
 
     show "eventually (\<lambda>i. ?f i \<le> K * (\<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M)) sequentially"
       (is "eventually (\<lambda>i. ?f i \<le> ?g i) sequentially")
     proof (intro always_eventually allI)
       fix i have "?f i \<le> (\<integral>\<^sup>+ x. ennreal K * norm (f x - s i x) \<partial>M)"
         using K by (intro nn_integral_mono) (auto simp: ac_simps ennreal_mult[symmetric])
       also have "\<dots> = ?g i"
         using K by (intro nn_integral_cmult) auto
       finally show "?f i \<le> ?g i" .
     qed
     show "?g \<longlonglongrightarrow> 0"
       using ennreal_tendsto_cmult[OF _ f_s] by simp
   qed
 
   assume "(\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x"
   with s show "(\<lambda>i. simple_bochner_integral M (\<lambda>x. T (s i x))) \<longlonglongrightarrow> T x"
     by (auto intro!: T.tendsto simp: simple_bochner_integral_linear T.linear_axioms)
 qed
 
 lemma has_bochner_integral_zero[intro]: "has_bochner_integral M (\<lambda>x. 0) 0"
   by (auto intro!: has_bochner_integral.intros[where s="\<lambda>_ _. 0"]
            simp: zero_ennreal_def[symmetric] simple_bochner_integrable.simps
                  simple_bochner_integral_def image_constant_conv)
 
 lemma has_bochner_integral_scaleR_left[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x *\<^sub>R c) (x *\<^sub>R c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_scaleR_left])
 
 lemma has_bochner_integral_scaleR_right[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c *\<^sub>R f x) (c *\<^sub>R x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_scaleR_right])
 
 lemma has_bochner_integral_mult_left[intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x * c) (x * c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_mult_left])
 
 lemma has_bochner_integral_mult_right[intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c * f x) (c * x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_mult_right])
 
 lemmas has_bochner_integral_divide =
   has_bochner_integral_bounded_linear[OF bounded_linear_divide]
 
 lemma has_bochner_integral_divide_zero[intro]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x / c) (x / c)"
   using has_bochner_integral_divide by (cases "c = 0") auto
 
 lemma has_bochner_integral_inner_left[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. f x \<bullet> c) (x \<bullet> c)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_inner_left])
 
 lemma has_bochner_integral_inner_right[intro]:
   "(c \<noteq> 0 \<Longrightarrow> has_bochner_integral M f x) \<Longrightarrow> has_bochner_integral M (\<lambda>x. c \<bullet> f x) (c \<bullet> x)"
   by (cases "c = 0") (auto simp add: has_bochner_integral_bounded_linear[OF bounded_linear_inner_right])
 
 lemmas has_bochner_integral_minus =
   has_bochner_integral_bounded_linear[OF bounded_linear_minus[OF bounded_linear_ident]]
 lemmas has_bochner_integral_Re =
   has_bochner_integral_bounded_linear[OF bounded_linear_Re]
 lemmas has_bochner_integral_Im =
   has_bochner_integral_bounded_linear[OF bounded_linear_Im]
 lemmas has_bochner_integral_cnj =
   has_bochner_integral_bounded_linear[OF bounded_linear_cnj]
 lemmas has_bochner_integral_of_real =
   has_bochner_integral_bounded_linear[OF bounded_linear_of_real]
 lemmas has_bochner_integral_fst =
   has_bochner_integral_bounded_linear[OF bounded_linear_fst]
 lemmas has_bochner_integral_snd =
   has_bochner_integral_bounded_linear[OF bounded_linear_snd]
 
 lemma has_bochner_integral_indicator:
   "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. indicator A x *\<^sub>R c) (measure M A *\<^sub>R c)"
   by (intro has_bochner_integral_scaleR_left has_bochner_integral_real_indicator)
 
 lemma has_bochner_integral_diff:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M g y \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f x - g x) (x - y)"
   unfolding diff_conv_add_uminus
   by (intro has_bochner_integral_add has_bochner_integral_minus)
 
 lemma has_bochner_integral_sum:
   "(\<And>i. i \<in> I \<Longrightarrow> has_bochner_integral M (f i) (x i)) \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. \<Sum>i\<in>I. f i x) (\<Sum>i\<in>I. x i)"
   by (induct I rule: infinite_finite_induct) auto
 
 proposition has_bochner_integral_implies_finite_norm:
   "has_bochner_integral M f x \<Longrightarrow> (\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
 proof (elim has_bochner_integral.cases)
   fix s v
   assume [measurable]: "f \<in> borel_measurable M" and s: "\<And>i. simple_bochner_integrable M (s i)" and
     lim_0: "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
   from order_tendstoD[OF lim_0, of "\<infinity>"]
   obtain i where f_s_fin: "(\<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) < \<infinity>"
     by (auto simp: eventually_sequentially)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   define m where "m = (if space M = {} then 0 else Max ((\<lambda>x. norm (s i x))`space M))"
   have "finite (s i ` space M)"
     using s by (auto simp: simple_function_def simple_bochner_integrable.simps)
   then have "finite (norm ` s i ` space M)"
     by (rule finite_imageI)
   then have "\<And>x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> m" "0 \<le> m"
     by (auto simp: m_def image_comp comp_def Max_ge_iff)
   then have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal m * indicator {x\<in>space M. s i x \<noteq> 0} x \<partial>M)"
     by (auto split: split_indicator intro!: Max_ge nn_integral_mono simp:)
   also have "\<dots> < \<infinity>"
     using s by (subst nn_integral_cmult_indicator) (auto simp: \<open>0 \<le> m\<close> simple_bochner_integrable.simps ennreal_mult_less_top less_top)
   finally have s_fin: "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) < \<infinity>" .
 
   have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) + ennreal (norm (s i x)) \<partial>M)"
     by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
        (metis add.commute norm_triangle_sub)
   also have "\<dots> = (\<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) + (\<integral>\<^sup>+x. norm (s i x) \<partial>M)"
     by (rule nn_integral_add) auto
   also have "\<dots> < \<infinity>"
     using s_fin f_s_fin by auto
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed
 
 proposition has_bochner_integral_norm_bound:
   assumes i: "has_bochner_integral M f x"
   shows "norm x \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
 using assms proof
   fix s assume
     x: "(\<lambda>i. simple_bochner_integral M (s i)) \<longlonglongrightarrow> x" (is "?s \<longlonglongrightarrow> x") and
     s[simp]: "\<And>i. simple_bochner_integrable M (s i)" and
     lim: "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0" and
     f[measurable]: "f \<in> borel_measurable M"
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M"
     using s by (auto simp: simple_bochner_integrable.simps intro: borel_measurable_simple_function)
 
   show "norm x \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
   proof (rule LIMSEQ_le)
     show "(\<lambda>i. ennreal (norm (?s i))) \<longlonglongrightarrow> norm x"
       using x by (auto simp: tendsto_ennreal_iff intro: tendsto_intros)
     show "\<exists>N. \<forall>n\<ge>N. norm (?s n) \<le> (\<integral>\<^sup>+x. norm (f x - s n x) \<partial>M) + (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
       (is "\<exists>N. \<forall>n\<ge>N. _ \<le> ?t n")
     proof (intro exI allI impI)
       fix n
       have "ennreal (norm (?s n)) \<le> simple_bochner_integral M (\<lambda>x. norm (s n x))"
         by (auto intro!: simple_bochner_integral_norm_bound)
       also have "\<dots> = (\<integral>\<^sup>+x. norm (s n x) \<partial>M)"
         by (intro simple_bochner_integral_eq_nn_integral)
            (auto intro: s simple_bochner_integrable_compose2)
       also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s n x)) + norm (f x) \<partial>M)"
         by (auto intro!: nn_integral_mono simp flip: ennreal_plus)
            (metis add.commute norm_minus_commute norm_triangle_sub)
       also have "\<dots> = ?t n"
         by (rule nn_integral_add) auto
       finally show "norm (?s n) \<le> ?t n" .
     qed
     have "?t \<longlonglongrightarrow> 0 + (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
       using has_bochner_integral_implies_finite_norm[OF i]
       by (intro tendsto_add tendsto_const lim)
     then show "?t \<longlonglongrightarrow> \<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M"
       by simp
   qed
 qed
 
 lemma has_bochner_integral_eq:
   "has_bochner_integral M f x \<Longrightarrow> has_bochner_integral M f y \<Longrightarrow> x = y"
 proof (elim has_bochner_integral.cases)
   assume f[measurable]: "f \<in> borel_measurable M"
 
   fix s t
   assume "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?S \<longlonglongrightarrow> 0")
   assume "(\<lambda>i. \<integral>\<^sup>+ x. norm (f x - t i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?T \<longlonglongrightarrow> 0")
   assume s: "\<And>i. simple_bochner_integrable M (s i)"
   assume t: "\<And>i. simple_bochner_integrable M (t i)"
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable M" "\<And>i. t i \<in> borel_measurable M"
     using s t by (auto intro: borel_measurable_simple_function elim: simple_bochner_integrable.cases)
 
   let ?s = "\<lambda>i. simple_bochner_integral M (s i)"
   let ?t = "\<lambda>i. simple_bochner_integral M (t i)"
   assume "?s \<longlonglongrightarrow> x" "?t \<longlonglongrightarrow> y"
   then have "(\<lambda>i. norm (?s i - ?t i)) \<longlonglongrightarrow> norm (x - y)"
     by (intro tendsto_intros)
   moreover
   have "(\<lambda>i. ennreal (norm (?s i - ?t i))) \<longlonglongrightarrow> ennreal 0"
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>i. 0 \<le> ennreal (norm (?s i - ?t i))) sequentially" "(\<lambda>_. 0) \<longlonglongrightarrow> ennreal 0"
       by auto
 
     show "eventually (\<lambda>i. norm (?s i - ?t i) \<le> ?S i + ?T i) sequentially"
       by (intro always_eventually allI simple_bochner_integral_bounded s t f)
     show "(\<lambda>i. ?S i + ?T i) \<longlonglongrightarrow> ennreal 0"
       using tendsto_add[OF \<open>?S \<longlonglongrightarrow> 0\<close> \<open>?T \<longlonglongrightarrow> 0\<close>] by simp
   qed
   then have "(\<lambda>i. norm (?s i - ?t i)) \<longlonglongrightarrow> 0"
     by (simp flip: ennreal_0)
   ultimately have "norm (x - y) = 0"
     by (rule LIMSEQ_unique)
   then show "x = y" by simp
 qed
 
 lemma has_bochner_integralI_AE:
   assumes f: "has_bochner_integral M f x"
     and g: "g \<in> borel_measurable M"
     and ae: "AE x in M. f x = g x"
   shows "has_bochner_integral M g x"
   using f
 proof (safe intro!: has_bochner_integral.intros elim!: has_bochner_integral.cases)
   fix s assume "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
   also have "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) = (\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (g x - s i x)) \<partial>M)"
     using ae
     by (intro ext nn_integral_cong_AE, eventually_elim) simp
   finally show "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (g x - s i x)) \<partial>M) \<longlonglongrightarrow> 0" .
 qed (auto intro: g)
 
 lemma has_bochner_integral_eq_AE:
   assumes f: "has_bochner_integral M f x"
     and g: "has_bochner_integral M g y"
     and ae: "AE x in M. f x = g x"
   shows "x = y"
 proof -
   from assms have "has_bochner_integral M g x"
     by (auto intro: has_bochner_integralI_AE)
   from this g show "x = y"
     by (rule has_bochner_integral_eq)
 qed
 
 lemma simple_bochner_integrable_restrict_space:
   fixes f :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M"
   shows "simple_bochner_integrable (restrict_space M \<Omega>) f \<longleftrightarrow>
     simple_bochner_integrable M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
   by (simp add: simple_bochner_integrable.simps space_restrict_space
     simple_function_restrict_space[OF \<Omega>] emeasure_restrict_space[OF \<Omega>] Collect_restrict
     indicator_eq_0_iff conj_left_commute)
 
 lemma simple_bochner_integral_restrict_space:
   fixes f :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M"
   assumes f: "simple_bochner_integrable (restrict_space M \<Omega>) f"
   shows "simple_bochner_integral (restrict_space M \<Omega>) f =
     simple_bochner_integral M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
 proof -
   have "finite ((\<lambda>x. indicator \<Omega> x *\<^sub>R f x)`space M)"
     using f simple_bochner_integrable_restrict_space[OF \<Omega>, of f]
     by (simp add: simple_bochner_integrable.simps simple_function_def)
   then show ?thesis
     by (auto simp: space_restrict_space measure_restrict_space[OF \<Omega>(1)] le_infI2
                    simple_bochner_integral_def Collect_restrict
              split: split_indicator split_indicator_asm
              intro!: sum.mono_neutral_cong_left arg_cong2[where f=measure])
 qed
 
 context
   notes [[inductive_internals]]
 begin
 
 inductive integrable for M f where
   "has_bochner_integral M f x \<Longrightarrow> integrable M f"
 
 end
 
 definition\<^marker>\<open>tag important\<close> lebesgue_integral ("integral\<^sup>L") where
   "integral\<^sup>L M f = (if \<exists>x. has_bochner_integral M f x then THE x. has_bochner_integral M f x else 0)"
 
 syntax
   "_lebesgue_integral" :: "pttrn \<Rightarrow> real \<Rightarrow> 'a measure \<Rightarrow> real" ("\<integral>((2 _./ _)/ \<partial>_)" [60,61] 110)
 
 translations
   "\<integral> x. f \<partial>M" == "CONST lebesgue_integral M (\<lambda>x. f)"
 
 syntax
   "_ascii_lebesgue_integral" :: "pttrn \<Rightarrow> 'a measure \<Rightarrow> real \<Rightarrow> real" ("(3LINT (1_)/|(_)./ _)" [0,110,60] 60)
 
 translations
   "LINT x|M. f" == "CONST lebesgue_integral M (\<lambda>x. f)"
 
 lemma has_bochner_integral_integral_eq: "has_bochner_integral M f x \<Longrightarrow> integral\<^sup>L M f = x"
   by (metis the_equality has_bochner_integral_eq lebesgue_integral_def)
 
 lemma has_bochner_integral_integrable:
   "integrable M f \<Longrightarrow> has_bochner_integral M f (integral\<^sup>L M f)"
   by (auto simp: has_bochner_integral_integral_eq integrable.simps)
 
 lemma has_bochner_integral_iff:
   "has_bochner_integral M f x \<longleftrightarrow> integrable M f \<and> integral\<^sup>L M f = x"
   by (metis has_bochner_integral_integrable has_bochner_integral_integral_eq integrable.intros)
 
 lemma simple_bochner_integrable_eq_integral:
   "simple_bochner_integrable M f \<Longrightarrow> simple_bochner_integral M f = integral\<^sup>L M f"
   using has_bochner_integral_simple_bochner_integrable[of M f]
   by (simp add: has_bochner_integral_integral_eq)
 
 lemma not_integrable_integral_eq: "\<not> integrable M f \<Longrightarrow> integral\<^sup>L M f = 0"
   unfolding integrable.simps lebesgue_integral_def by (auto intro!: arg_cong[where f=The])
 
 lemma integral_eq_cases:
   "integrable M f \<longleftrightarrow> integrable N g \<Longrightarrow>
     (integrable M f \<Longrightarrow> integrable N g \<Longrightarrow> integral\<^sup>L M f = integral\<^sup>L N g) \<Longrightarrow>
     integral\<^sup>L M f = integral\<^sup>L N g"
   by (metis not_integrable_integral_eq)
 
 lemma borel_measurable_integrable[measurable_dest]: "integrable M f \<Longrightarrow> f \<in> borel_measurable M"
   by (auto elim: integrable.cases has_bochner_integral.cases)
 
 lemma borel_measurable_integrable'[measurable_dest]:
   "integrable M f \<Longrightarrow> g \<in> measurable N M \<Longrightarrow> (\<lambda>x. f (g x)) \<in> borel_measurable N"
   using borel_measurable_integrable[measurable] by measurable
 
 lemma integrable_cong:
   "M = N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> f x = g x) \<Longrightarrow> integrable M f \<longleftrightarrow> integrable N g"
   by (simp cong: has_bochner_integral_cong add: integrable.simps)
 
 lemma integrable_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> AE x in M. f x = g x \<Longrightarrow>
     integrable M f \<longleftrightarrow> integrable M g"
   unfolding integrable.simps
   by (intro has_bochner_integral_cong_AE arg_cong[where f=Ex] ext)
 
 lemma integrable_cong_AE_imp:
   "integrable M g \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow> (AE x in M. g x = f x) \<Longrightarrow> integrable M f"
   using integrable_cong_AE[of f M g] by (auto simp: eq_commute)
 
 lemma integral_cong:
   "M = N \<Longrightarrow> (\<And>x. x \<in> space N \<Longrightarrow> f x = g x) \<Longrightarrow> integral\<^sup>L M f = integral\<^sup>L N g"
   by (simp cong: has_bochner_integral_cong cong del: if_weak_cong add: lebesgue_integral_def)
 
 lemma integral_cong_AE:
   "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> AE x in M. f x = g x \<Longrightarrow>
     integral\<^sup>L M f = integral\<^sup>L M g"
   unfolding lebesgue_integral_def
   by (rule arg_cong[where x="has_bochner_integral M f"]) (intro has_bochner_integral_cong_AE ext)
 
 lemma integrable_add[simp, intro]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> integrable M (\<lambda>x. f x + g x)"
   by (auto simp: integrable.simps)
 
 lemma integrable_zero[simp, intro]: "integrable M (\<lambda>x. 0)"
   by (metis has_bochner_integral_zero integrable.simps)
 
 lemma integrable_sum[simp, intro]: "(\<And>i. i \<in> I \<Longrightarrow> integrable M (f i)) \<Longrightarrow> integrable M (\<lambda>x. \<Sum>i\<in>I. f i x)"
   by (metis has_bochner_integral_sum integrable.simps)
 
 lemma integrable_indicator[simp, intro]: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
   integrable M (\<lambda>x. indicator A x *\<^sub>R c)"
   by (metis has_bochner_integral_indicator integrable.simps)
 
 lemma integrable_real_indicator[simp, intro]: "A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow>
   integrable M (indicator A :: 'a \<Rightarrow> real)"
   by (metis has_bochner_integral_real_indicator integrable.simps)
 
 lemma integrable_diff[simp, intro]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> integrable M (\<lambda>x. f x - g x)"
   by (auto simp: integrable.simps intro: has_bochner_integral_diff)
 
 lemma integrable_bounded_linear: "bounded_linear T \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. T (f x))"
   by (auto simp: integrable.simps intro: has_bochner_integral_bounded_linear)
 
 lemma integrable_scaleR_left[simp, intro]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x *\<^sub>R c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_scaleR_right[simp, intro]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c *\<^sub>R f x)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_mult_left[simp, intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x * c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_mult_right[simp, intro]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c * f x)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_divide_zero[simp, intro]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x / c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_inner_left[simp, intro]:
   "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. f x \<bullet> c)"
   unfolding integrable.simps by fastforce
 
 lemma integrable_inner_right[simp, intro]:
   "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> integrable M (\<lambda>x. c \<bullet> f x)"
   unfolding integrable.simps by fastforce
 
 lemmas integrable_minus[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_minus[OF bounded_linear_ident]]
 lemmas integrable_divide[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_divide]
 lemmas integrable_Re[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_Re]
 lemmas integrable_Im[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_Im]
 lemmas integrable_cnj[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_cnj]
 lemmas integrable_of_real[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_of_real]
 lemmas integrable_fst[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_fst]
 lemmas integrable_snd[simp, intro] =
   integrable_bounded_linear[OF bounded_linear_snd]
 
 lemma integral_zero[simp]: "integral\<^sup>L M (\<lambda>x. 0) = 0"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_zero)
 
 lemma integral_add[simp]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. f x + g x) = integral\<^sup>L M f + integral\<^sup>L M g"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_add has_bochner_integral_integrable)
 
 lemma integral_diff[simp]: "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. f x - g x) = integral\<^sup>L M f - integral\<^sup>L M g"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_diff has_bochner_integral_integrable)
 
 lemma integral_sum: "(\<And>i. i \<in> I \<Longrightarrow> integrable M (f i)) \<Longrightarrow>
   integral\<^sup>L M (\<lambda>x. \<Sum>i\<in>I. f i x) = (\<Sum>i\<in>I. integral\<^sup>L M (f i))"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_sum has_bochner_integral_integrable)
 
 lemma integral_sum'[simp]: "(\<And>i. i \<in> I =simp=> integrable M (f i)) \<Longrightarrow>
   integral\<^sup>L M (\<lambda>x. \<Sum>i\<in>I. f i x) = (\<Sum>i\<in>I. integral\<^sup>L M (f i))"
   unfolding simp_implies_def by (rule integral_sum)
 
 lemma integral_bounded_linear: "bounded_linear T \<Longrightarrow> integrable M f \<Longrightarrow>
     integral\<^sup>L M (\<lambda>x. T (f x)) = T (integral\<^sup>L M f)"
   by (metis has_bochner_integral_bounded_linear has_bochner_integral_integrable has_bochner_integral_integral_eq)
 
 lemma integral_bounded_linear':
   assumes T: "bounded_linear T" and T': "bounded_linear T'"
   assumes *: "\<not> (\<forall>x. T x = 0) \<Longrightarrow> (\<forall>x. T' (T x) = x)"
   shows "integral\<^sup>L M (\<lambda>x. T (f x)) = T (integral\<^sup>L M f)"
 proof cases
   assume "(\<forall>x. T x = 0)" then show ?thesis
     by simp
 next
   assume **: "\<not> (\<forall>x. T x = 0)"
   show ?thesis
   proof cases
     assume "integrable M f" with T show ?thesis
       by (rule integral_bounded_linear)
   next
     assume not: "\<not> integrable M f"
     moreover have "\<not> integrable M (\<lambda>x. T (f x))"
     proof
       assume "integrable M (\<lambda>x. T (f x))"
       from integrable_bounded_linear[OF T' this] not *[OF **]
       show False
         by auto
     qed
     ultimately show ?thesis
       using T by (simp add: not_integrable_integral_eq linear_simps)
   qed
 qed
 
 lemma integral_scaleR_left[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x *\<^sub>R c \<partial>M) = integral\<^sup>L M f *\<^sub>R c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_scaleR_left)
 
 lemma integral_scaleR_right[simp]: "(\<integral> x. c *\<^sub>R f x \<partial>M) = c *\<^sub>R integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_scaleR_right bounded_linear_scaleR_right[of "1 / c"]]) simp
 
 lemma integral_mult_left[simp]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x * c \<partial>M) = integral\<^sup>L M f * c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_mult_left)
 
 lemma integral_mult_right[simp]:
   fixes c :: "_::{real_normed_algebra,second_countable_topology}"
   shows "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. c * f x \<partial>M) = c * integral\<^sup>L M f"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_mult_right)
 
 lemma integral_mult_left_zero[simp]:
   fixes c :: "_::{real_normed_field,second_countable_topology}"
   shows "(\<integral> x. f x * c \<partial>M) = integral\<^sup>L M f * c"
   by (rule integral_bounded_linear'[OF bounded_linear_mult_left bounded_linear_mult_left[of "1 / c"]]) simp
 
 lemma integral_mult_right_zero[simp]:
   fixes c :: "_::{real_normed_field,second_countable_topology}"
   shows "(\<integral> x. c * f x \<partial>M) = c * integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_mult_right bounded_linear_mult_right[of "1 / c"]]) simp
 
 lemma integral_inner_left[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. f x \<bullet> c \<partial>M) = integral\<^sup>L M f \<bullet> c"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_inner_left)
 
 lemma integral_inner_right[simp]: "(c \<noteq> 0 \<Longrightarrow> integrable M f) \<Longrightarrow> (\<integral> x. c \<bullet> f x \<partial>M) = c \<bullet> integral\<^sup>L M f"
   by (intro has_bochner_integral_integral_eq has_bochner_integral_integrable has_bochner_integral_inner_right)
 
 lemma integral_divide_zero[simp]:
   fixes c :: "_::{real_normed_field, field, second_countable_topology}"
   shows "integral\<^sup>L M (\<lambda>x. f x / c) = integral\<^sup>L M f / c"
   by (rule integral_bounded_linear'[OF bounded_linear_divide bounded_linear_mult_left[of c]]) simp
 
 lemma integral_minus[simp]: "integral\<^sup>L M (\<lambda>x. - f x) = - integral\<^sup>L M f"
   by (rule integral_bounded_linear'[OF bounded_linear_minus[OF bounded_linear_ident] bounded_linear_minus[OF bounded_linear_ident]]) simp
 
 lemma integral_complex_of_real[simp]: "integral\<^sup>L M (\<lambda>x. complex_of_real (f x)) = of_real (integral\<^sup>L M f)"
   by (rule integral_bounded_linear'[OF bounded_linear_of_real bounded_linear_Re]) simp
 
 lemma integral_cnj[simp]: "integral\<^sup>L M (\<lambda>x. cnj (f x)) = cnj (integral\<^sup>L M f)"
   by (rule integral_bounded_linear'[OF bounded_linear_cnj bounded_linear_cnj]) simp
 
 lemmas integral_divide[simp] =
   integral_bounded_linear[OF bounded_linear_divide]
 lemmas integral_Re[simp] =
   integral_bounded_linear[OF bounded_linear_Re]
 lemmas integral_Im[simp] =
   integral_bounded_linear[OF bounded_linear_Im]
 lemmas integral_of_real[simp] =
   integral_bounded_linear[OF bounded_linear_of_real]
 lemmas integral_fst[simp] =
   integral_bounded_linear[OF bounded_linear_fst]
 lemmas integral_snd[simp] =
   integral_bounded_linear[OF bounded_linear_snd]
 
 lemma integral_norm_bound_ennreal:
   "integrable M f \<Longrightarrow> norm (integral\<^sup>L M f) \<le> (\<integral>\<^sup>+x. norm (f x) \<partial>M)"
   by (metis has_bochner_integral_integrable has_bochner_integral_norm_bound)
 
 lemma integrableI_sequence:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M"
   assumes s: "\<And>i. simple_bochner_integrable M (s i)"
   assumes lim: "(\<lambda>i. \<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) \<longlonglongrightarrow> 0" (is "?S \<longlonglongrightarrow> 0")
   shows "integrable M f"
 proof -
   let ?s = "\<lambda>n. simple_bochner_integral M (s n)"
 
   have "\<exists>x. ?s \<longlonglongrightarrow> x"
     unfolding convergent_eq_Cauchy
   proof (rule metric_CauchyI)
     fix e :: real assume "0 < e"
     then have "0 < ennreal (e / 2)" by auto
     from order_tendstoD(2)[OF lim this]
     obtain M where M: "\<And>n. M \<le> n \<Longrightarrow> ?S n < e / 2"
       by (auto simp: eventually_sequentially)
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (?s m) (?s n) < e"
     proof (intro exI allI impI)
       fix m n assume m: "M \<le> m" and n: "M \<le> n"
       have "?S n \<noteq> \<infinity>"
         using M[OF n] by auto
       have "norm (?s n - ?s m) \<le> ?S n + ?S m"
         by (intro simple_bochner_integral_bounded s f)
       also have "\<dots> < ennreal (e / 2) + e / 2"
         by (intro add_strict_mono M n m)
       also have "\<dots> = e" using \<open>0<e\<close> by (simp flip: ennreal_plus)
       finally show "dist (?s n) (?s m) < e"
         using \<open>0<e\<close> by (simp add: dist_norm ennreal_less_iff)
     qed
   qed
   then obtain x where "?s \<longlonglongrightarrow> x" ..
   show ?thesis
     by (rule, rule) fact+
 qed
 
 proposition nn_integral_dominated_convergence_norm:
   fixes u' :: "_ \<Rightarrow> _::{real_normed_vector, second_countable_topology}"
   assumes [measurable]:
        "\<And>i. u i \<in> borel_measurable M" "u' \<in> borel_measurable M" "w \<in> borel_measurable M"
     and bound: "\<And>j. AE x in M. norm (u j x) \<le> w x"
     and w: "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
     and u': "AE x in M. (\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   shows "(\<lambda>i. (\<integral>\<^sup>+x. norm (u' x - u i x) \<partial>M)) \<longlonglongrightarrow> 0"
 proof -
   have "AE x in M. \<forall>j. norm (u j x) \<le> w x"
     unfolding AE_all_countable by rule fact
   with u' have bnd: "AE x in M. \<forall>j. norm (u' x - u j x) \<le> 2 * w x"
   proof (eventually_elim, intro allI)
     fix i x assume "(\<lambda>i. u i x) \<longlonglongrightarrow> u' x" "\<forall>j. norm (u j x) \<le> w x" "\<forall>j. norm (u j x) \<le> w x"
     then have "norm (u' x) \<le> w x" "norm (u i x) \<le> w x"
       by (auto intro: LIMSEQ_le_const2 tendsto_norm)
     then have "norm (u' x) + norm (u i x) \<le> 2 * w x"
       by simp
     also have "norm (u' x - u i x) \<le> norm (u' x) + norm (u i x)"
       by (rule norm_triangle_ineq4)
     finally (xtrans) show "norm (u' x - u i x) \<le> 2 * w x" .
   qed
   have w_nonneg: "AE x in M. 0 \<le> w x"
     using bound[of 0] by (auto intro: order_trans[OF norm_ge_zero])
 
   have "(\<lambda>i. (\<integral>\<^sup>+x. norm (u' x - u i x) \<partial>M)) \<longlonglongrightarrow> (\<integral>\<^sup>+x. 0 \<partial>M)"
   proof (rule nn_integral_dominated_convergence)
     show "(\<integral>\<^sup>+x. 2 * w x \<partial>M) < \<infinity>"
       by (rule nn_integral_mult_bounded_inf[OF _ w, of 2]) (insert w_nonneg, auto simp: ennreal_mult )
     show "AE x in M. (\<lambda>i. ennreal (norm (u' x - u i x))) \<longlonglongrightarrow> 0"
       using u'
     proof eventually_elim
       fix x assume "(\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
       from tendsto_diff[OF tendsto_const[of "u' x"] this]
       show "(\<lambda>i. ennreal (norm (u' x - u i x))) \<longlonglongrightarrow> 0"
         by (simp add: tendsto_norm_zero_iff flip: ennreal_0)
     qed
   qed (insert bnd w_nonneg, auto)
   then show ?thesis by simp
 qed
 
 proposition integrableI_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable M" and fin: "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   shows "integrable M f"
 proof -
   from borel_measurable_implies_sequence_metric[OF f, of 0] obtain s where
     s: "\<And>i. simple_function M (s i)" and
     pointwise: "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x" and
     bound: "\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)"
     by simp metis
 
   show ?thesis
   proof (rule integrableI_sequence)
     { fix i
       have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal (2 * norm (f x)) \<partial>M)"
         by (intro nn_integral_mono) (simp add: bound)
       also have "\<dots> = 2 * (\<integral>\<^sup>+x. ennreal (norm (f x)) \<partial>M)"
         by (simp add: ennreal_mult nn_integral_cmult)
       also have "\<dots> < top"
         using fin by (simp add: ennreal_mult_less_top)
       finally have "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) < \<infinity>"
         by simp }
     note fin_s = this
 
     show "\<And>i. simple_bochner_integrable M (s i)"
       by (rule simple_bochner_integrableI_bounded) fact+
 
     show "(\<lambda>i. \<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) \<partial>M) \<longlonglongrightarrow> 0"
     proof (rule nn_integral_dominated_convergence_norm)
       show "\<And>j. AE x in M. norm (s j x) \<le> 2 * norm (f x)"
         using bound by auto
       show "\<And>i. s i \<in> borel_measurable M" "(\<lambda>x. 2 * norm (f x)) \<in> borel_measurable M"
         using s by (auto intro: borel_measurable_simple_function)
       show "(\<integral>\<^sup>+ x. ennreal (2 * norm (f x)) \<partial>M) < \<infinity>"
         using fin by (simp add: nn_integral_cmult ennreal_mult ennreal_mult_less_top)
       show "AE x in M. (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
         using pointwise by auto
     qed fact
   qed fact
 qed
 
 lemma integrableI_bounded_set:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "A \<in> sets M" "f \<in> borel_measurable M"
   assumes finite: "emeasure M A < \<infinity>"
     and bnd: "AE x in M. x \<in> A \<longrightarrow> norm (f x) \<le> B"
     and null: "AE x in M. x \<notin> A \<longrightarrow> f x = 0"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   { fix x :: 'b have "norm x \<le> B \<Longrightarrow> 0 \<le> B"
       using norm_ge_zero[of x] by arith }
   with bnd null have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (max 0 B) * indicator A x \<partial>M)"
     by (intro nn_integral_mono_AE) (auto split: split_indicator split_max)
   also have "\<dots> < \<infinity>"
     using finite by (subst nn_integral_cmult_indicator) (auto simp: ennreal_mult_less_top)
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed simp
 
 lemma integrableI_bounded_set_indicator:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "A \<in> sets M \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow>
     emeasure M A < \<infinity> \<Longrightarrow> (AE x in M. x \<in> A \<longrightarrow> norm (f x) \<le> B) \<Longrightarrow>
     integrable M (\<lambda>x. indicator A x *\<^sub>R f x)"
   by (rule integrableI_bounded_set[where A=A]) auto
 
 lemma integrableI_nonneg:
   fixes f :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "(\<integral>\<^sup>+x. f x \<partial>M) < \<infinity>"
   shows "integrable M f"
 proof -
   have "(\<integral>\<^sup>+x. norm (f x) \<partial>M) = (\<integral>\<^sup>+x. f x \<partial>M)"
     using assms by (intro nn_integral_cong_AE) auto
   then show ?thesis
     using assms by (intro integrableI_bounded) auto
 qed
 
 lemma integrable_iff_bounded:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "integrable M f \<longleftrightarrow> f \<in> borel_measurable M \<and> (\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
   using integrableI_bounded[of f M] has_bochner_integral_implies_finite_norm[of M f]
   unfolding integrable.simps has_bochner_integral.simps[abs_def] by auto
 
 lemma integrable_bound:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
     and g :: "'a \<Rightarrow> 'c::{banach, second_countable_topology}"
   shows "integrable M f \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. norm (g x) \<le> norm (f x)) \<Longrightarrow>
     integrable M g"
   unfolding integrable_iff_bounded
 proof safe
   assume "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   assume "AE x in M. norm (g x) \<le> norm (f x)"
   then have "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by  (intro nn_integral_mono_AE) auto
   also assume "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) < \<infinity>" .
 qed
 
 lemma integrable_mult_indicator:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "A \<in> sets M \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. indicator A x *\<^sub>R f x)"
   by (rule integrable_bound[of M f]) (auto split: split_indicator)
 
 lemma integrable_real_mult_indicator:
   fixes f :: "'a \<Rightarrow> real"
   shows "A \<in> sets M \<Longrightarrow> integrable M f \<Longrightarrow> integrable M (\<lambda>x. f x * indicator A x)"
   using integrable_mult_indicator[of A M f] by (simp add: mult_ac)
 
 lemma integrable_abs[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes [measurable]: "integrable M f" shows "integrable M (\<lambda>x. \<bar>f x\<bar>)"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm[simp, intro]:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "integrable M f" shows "integrable M (\<lambda>x. norm (f x))"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm_cancel:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "integrable M (\<lambda>x. norm (f x))" "f \<in> borel_measurable M" shows "integrable M f"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_norm_iff:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable M \<Longrightarrow> integrable M (\<lambda>x. norm (f x)) \<longleftrightarrow> integrable M f"
   by (auto intro: integrable_norm_cancel)
 
 lemma integrable_abs_cancel:
   fixes f :: "'a \<Rightarrow> real"
   assumes [measurable]: "integrable M (\<lambda>x. \<bar>f x\<bar>)" "f \<in> borel_measurable M" shows "integrable M f"
   using assms by (rule integrable_bound) auto
 
 lemma integrable_abs_iff:
   fixes f :: "'a \<Rightarrow> real"
   shows "f \<in> borel_measurable M \<Longrightarrow> integrable M (\<lambda>x. \<bar>f x\<bar>) \<longleftrightarrow> integrable M f"
   by (auto intro: integrable_abs_cancel)
 
 lemma integrable_max[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes fg[measurable]: "integrable M f" "integrable M g"
   shows "integrable M (\<lambda>x. max (f x) (g x))"
   using integrable_add[OF integrable_norm[OF fg(1)] integrable_norm[OF fg(2)]]
   by (rule integrable_bound) auto
 
 lemma integrable_min[simp, intro]:
   fixes f :: "'a \<Rightarrow> real"
   assumes fg[measurable]: "integrable M f" "integrable M g"
   shows "integrable M (\<lambda>x. min (f x) (g x))"
   using integrable_add[OF integrable_norm[OF fg(1)] integrable_norm[OF fg(2)]]
   by (rule integrable_bound) auto
 
 lemma integral_minus_iff[simp]:
   "integrable M (\<lambda>x. - f x ::'a::{banach, second_countable_topology}) \<longleftrightarrow> integrable M f"
   unfolding integrable_iff_bounded
   by (auto)
 
 lemma integrable_indicator_iff:
   "integrable M (indicator A::_ \<Rightarrow> real) \<longleftrightarrow> A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>"
   by (simp add: integrable_iff_bounded borel_measurable_indicator_iff ennreal_indicator nn_integral_indicator'
            cong: conj_cong)
 
 lemma integral_indicator[simp]: "integral\<^sup>L M (indicator A) = measure M (A \<inter> space M)"
 proof cases
   assume *: "A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>"
   have "integral\<^sup>L M (indicator A) = integral\<^sup>L M (indicator (A \<inter> space M))"
     by (intro integral_cong) (auto split: split_indicator)
   also have "\<dots> = measure M (A \<inter> space M)"
     using * by (intro has_bochner_integral_integral_eq has_bochner_integral_real_indicator) auto
   finally show ?thesis .
 next
   assume *: "\<not> (A \<inter> space M \<in> sets M \<and> emeasure M (A \<inter> space M) < \<infinity>)"
   have "integral\<^sup>L M (indicator A) = integral\<^sup>L M (indicator (A \<inter> space M) :: _ \<Rightarrow> real)"
     by (intro integral_cong) (auto split: split_indicator)
   also have "\<dots> = 0"
     using * by (subst not_integrable_integral_eq) (auto simp: integrable_indicator_iff)
   also have "\<dots> = measure M (A \<inter> space M)"
     using * by (auto simp: measure_def emeasure_notin_sets not_less top_unique)
   finally show ?thesis .
 qed
 
 lemma integrable_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   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"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "integrable M f \<longleftrightarrow> integrable M g"
   unfolding integrable_iff_bounded
 proof (rule conj_cong)
   { assume "f \<in> borel_measurable M" then have "g \<in> borel_measurable M"
       by (rule measurable_discrete_difference[where X=X]) (auto simp: assms) }
   moreover
   { assume "g \<in> borel_measurable M" then have "f \<in> borel_measurable M"
       by (rule measurable_discrete_difference[where X=X]) (auto simp: assms) }
   ultimately show "f \<in> borel_measurable M \<longleftrightarrow> g \<in> borel_measurable M" ..
 next
   have "AE x in M. x \<notin> X"
     by (rule AE_discrete_difference) fact+
   then have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) = (\<integral>\<^sup>+ x. norm (g x) \<partial>M)"
     by (intro nn_integral_cong_AE) (auto simp: eq)
   then show "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) < \<infinity> \<longleftrightarrow> (\<integral>\<^sup>+ x. norm (g x) \<partial>M) < \<infinity>"
     by simp
 qed
 
 lemma integral_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   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"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "integral\<^sup>L M f = integral\<^sup>L M g"
 proof (rule integral_eq_cases)
   show eq: "integrable M f \<longleftrightarrow> integrable M g"
     by (rule integrable_discrete_difference[where X=X]) fact+
 
   assume f: "integrable M f"
   show "integral\<^sup>L M f = integral\<^sup>L M g"
   proof (rule integral_cong_AE)
     show "f \<in> borel_measurable M" "g \<in> borel_measurable M"
       using f eq by (auto intro: borel_measurable_integrable)
 
     have "AE x in M. x \<notin> X"
       by (rule AE_discrete_difference) fact+
     with AE_space show "AE x in M. f x = g x"
       by eventually_elim fact
   qed
 qed
 
 lemma has_bochner_integral_discrete_difference:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   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"
   assumes eq: "\<And>x. x \<in> space M \<Longrightarrow> x \<notin> X \<Longrightarrow> f x = g x"
   shows "has_bochner_integral M f x \<longleftrightarrow> has_bochner_integral M g x"
   using integrable_discrete_difference[of X M f g, OF assms]
   using integral_discrete_difference[of X M f g, OF assms]
   by (metis has_bochner_integral_iff)
 
 lemma
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "\<And>i. s i \<in> borel_measurable M" "integrable M w"
   assumes lim: "AE x in M. (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
   assumes bound: "\<And>i. AE x in M. norm (s i x) \<le> w x"
   shows integrable_dominated_convergence: "integrable M f"
     and integrable_dominated_convergence2: "\<And>i. integrable M (s i)"
     and integral_dominated_convergence: "(\<lambda>i. integral\<^sup>L M (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"
 proof -
   have w_nonneg: "AE x in M. 0 \<le> w x"
     using bound[of 0] by eventually_elim (auto intro: norm_ge_zero order_trans)
   then have "(\<integral>\<^sup>+x. w x \<partial>M) = (\<integral>\<^sup>+x. norm (w x) \<partial>M)"
     by (intro nn_integral_cong_AE) auto
   with \<open>integrable M w\<close> have w: "w \<in> borel_measurable M" "(\<integral>\<^sup>+x. w x \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by auto
 
   show int_s: "\<And>i. integrable M (s i)"
     unfolding integrable_iff_bounded
   proof
     fix i
     have "(\<integral>\<^sup>+ x. ennreal (norm (s i x)) \<partial>M) \<le> (\<integral>\<^sup>+x. w x \<partial>M)"
       using bound[of i] w_nonneg by (intro nn_integral_mono_AE) auto
     with w show "(\<integral>\<^sup>+ x. ennreal (norm (s i x)) \<partial>M) < \<infinity>" by auto
   qed fact
 
   have all_bound: "AE x in M. \<forall>i. norm (s i x) \<le> w x"
     using bound unfolding AE_all_countable by auto
 
   show int_f: "integrable M f"
     unfolding integrable_iff_bounded
   proof
     have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) \<le> (\<integral>\<^sup>+x. w x \<partial>M)"
       using all_bound lim w_nonneg
     proof (intro nn_integral_mono_AE, eventually_elim)
       fix x assume "\<forall>i. norm (s i x) \<le> w x" "(\<lambda>i. s i x) \<longlonglongrightarrow> f x" "0 \<le> w x"
       then show "ennreal (norm (f x)) \<le> ennreal (w x)"
         by (intro LIMSEQ_le_const2[where X="\<lambda>i. ennreal (norm (s i x))"]) (auto intro: tendsto_intros)
     qed
     with w show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" by auto
   qed fact
 
   have "(\<lambda>n. ennreal (norm (integral\<^sup>L M (s n) - integral\<^sup>L M f))) \<longlonglongrightarrow> ennreal 0" (is "?d \<longlonglongrightarrow> ennreal 0")
   proof (rule tendsto_sandwich)
     show "eventually (\<lambda>n. ennreal 0 \<le> ?d n) sequentially" "(\<lambda>_. ennreal 0) \<longlonglongrightarrow> ennreal 0" by auto
     show "eventually (\<lambda>n. ?d n \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)) sequentially"
     proof (intro always_eventually allI)
       fix n
       have "?d n = norm (integral\<^sup>L M (\<lambda>x. s n x - f x))"
         using int_f int_s by simp
       also have "\<dots> \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)"
         by (intro int_f int_s integrable_diff integral_norm_bound_ennreal)
       finally show "?d n \<le> (\<integral>\<^sup>+x. norm (s n x - f x) \<partial>M)" .
     qed
     show "(\<lambda>n. \<integral>\<^sup>+x. norm (s n x - f x) \<partial>M) \<longlonglongrightarrow> ennreal 0"
       unfolding ennreal_0
       apply (subst norm_minus_commute)
     proof (rule nn_integral_dominated_convergence_norm[where w=w])
       show "\<And>n. s n \<in> borel_measurable M"
         using int_s unfolding integrable_iff_bounded by auto
     qed fact+
   qed
   then have "(\<lambda>n. integral\<^sup>L M (s n) - integral\<^sup>L M f) \<longlonglongrightarrow> 0"
     by (simp add: tendsto_norm_zero_iff del: ennreal_0)
   from tendsto_add[OF this tendsto_const[of "integral\<^sup>L M f"]]
   show "(\<lambda>i. integral\<^sup>L M (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"  by simp
 qed
 
 context
   fixes s :: "real \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
     and f :: "'a \<Rightarrow> 'b" and M
   assumes "f \<in> borel_measurable M" "\<And>t. s t \<in> borel_measurable M" "integrable M w"
   assumes lim: "AE x in M. ((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
   assumes bound: "\<forall>\<^sub>F i in at_top. AE x in M. norm (s i x) \<le> w x"
 begin
 
 lemma integral_dominated_convergence_at_top: "((\<lambda>t. integral\<^sup>L M (s t)) \<longlongrightarrow> integral\<^sup>L M f) at_top"
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume X: "filterlim X at_top sequentially"
   from filterlim_iff[THEN iffD1, OF this, rule_format, OF bound]
   obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s (X n) x) \<le> w x"
     by (auto simp: eventually_sequentially)
 
   show "(\<lambda>n. integral\<^sup>L M (s (X n))) \<longlonglongrightarrow> integral\<^sup>L M f"
   proof (rule LIMSEQ_offset, rule integral_dominated_convergence)
     show "AE x in M. norm (s (X (n + N)) x) \<le> w x" for n
       by (rule w) auto
     show "AE x in M. (\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
       using lim
     proof eventually_elim
       fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
       then show "(\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
         by (intro LIMSEQ_ignore_initial_segment filterlim_compose[OF _ X])
     qed
   qed fact+
 qed
 
 lemma integrable_dominated_convergence_at_top: "integrable M f"
 proof -
   from bound obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s n x) \<le> w x"
     by (auto simp: eventually_at_top_linorder)
   show ?thesis
   proof (rule integrable_dominated_convergence)
     show "AE x in M. norm (s (N + i) x) \<le> w x" for i :: nat
       by (intro w) auto
     show "AE x in M. (\<lambda>i. s (N + real i) x) \<longlonglongrightarrow> f x"
       using lim
     proof eventually_elim
       fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) at_top"
       then show "(\<lambda>n. s (N + n) x) \<longlonglongrightarrow> f x"
         by (rule filterlim_compose)
            (auto intro!: filterlim_tendsto_add_at_top filterlim_real_sequentially)
     qed
   qed fact+
 qed
 
 end
 
 lemma integrable_mult_left_iff [simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M (\<lambda>x. c * f x) \<longleftrightarrow> c = 0 \<or> integrable M f"
   using integrable_mult_left[of c M f] integrable_mult_left[of "1 / c" M "\<lambda>x. c * f x"]
   by (cases "c = 0") auto
 
 lemma integrable_mult_right_iff [simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M (\<lambda>x. f x * c) \<longleftrightarrow> c = 0 \<or> integrable M f"
   using integrable_mult_left_iff [of M c f] by (simp add: mult.commute)
 
 lemma integrableI_nn_integral_finite:
   assumes [measurable]: "f \<in> borel_measurable M"
     and nonneg: "AE x in M. 0 \<le> f x"
     and finite: "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M)"
     using nonneg by (intro nn_integral_cong_AE) auto
   with finite show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
     by auto
 qed simp
 
 lemma integral_nonneg_AE:
   fixes f :: "'a \<Rightarrow> real"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "0 \<le> integral\<^sup>L M f"
 proof cases
   assume f: "integrable M f"
   then have [measurable]: "f \<in> M \<rightarrow>\<^sub>M borel"
     by auto
   have "(\<lambda>x. max 0 (f x)) \<in> M \<rightarrow>\<^sub>M borel" "\<And>x. 0 \<le> max 0 (f x)" "integrable M (\<lambda>x. max 0 (f x))"
     using f by auto
   from this have "0 \<le> integral\<^sup>L M (\<lambda>x. max 0 (f x))"
   proof (induction rule: borel_measurable_induct_real)
     case (add f g)
     then have "integrable M f" "integrable M g"
       by (auto intro!: integrable_bound[OF add.prems])
     with add show ?case
       by (simp add: nn_integral_add)
   next
     case (seq U)
     show ?case
     proof (rule LIMSEQ_le_const)
       have U_le: "x \<in> space M \<Longrightarrow> U i x \<le> max 0 (f x)" for x i
         using seq by (intro incseq_le) (auto simp: incseq_def le_fun_def)
       with seq nonneg show "(\<lambda>i. integral\<^sup>L M (U i)) \<longlonglongrightarrow> LINT x|M. max 0 (f x)"
         by (intro integral_dominated_convergence) auto
       have "integrable M (U i)" for i
         using seq.prems by (rule integrable_bound) (insert U_le seq, auto)
       with seq show "\<exists>N. \<forall>n\<ge>N. 0 \<le> integral\<^sup>L M (U n)"
         by auto
     qed
   qed (auto)
   also have "\<dots> = integral\<^sup>L M f"
     using nonneg by (auto intro!: integral_cong_AE)
   finally show ?thesis .
 qed (simp add: not_integrable_integral_eq)
 
 lemma integral_nonneg[simp]:
   fixes f :: "'a \<Rightarrow> real"
   shows "(\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> 0 \<le> integral\<^sup>L M f"
   by (intro integral_nonneg_AE) auto
 
 proposition nn_integral_eq_integral:
   assumes f: "integrable M f"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "(\<integral>\<^sup>+ x. f x \<partial>M) = integral\<^sup>L M f"
 proof -
   { fix f :: "'a \<Rightarrow> real" assume f: "f \<in> borel_measurable M" "\<And>x. 0 \<le> f x" "integrable M f"
     then have "(\<integral>\<^sup>+ x. f x \<partial>M) = integral\<^sup>L M f"
     proof (induct rule: borel_measurable_induct_real)
       case (set A) then show ?case
         by (simp add: integrable_indicator_iff ennreal_indicator emeasure_eq_ennreal_measure)
     next
       case (mult f c) then show ?case
         by (auto simp add: nn_integral_cmult ennreal_mult integral_nonneg_AE)
     next
       case (add g f)
       then have "integrable M f" "integrable M g"
         by (auto intro!: integrable_bound[OF add.prems])
       with add show ?case
         by (simp add: nn_integral_add integral_nonneg_AE)
     next
       case (seq U)
       show ?case
       proof (rule LIMSEQ_unique)
         have U_le_f: "x \<in> space M \<Longrightarrow> U i x \<le> f x" for x i
           using seq by (intro incseq_le) (auto simp: incseq_def le_fun_def)
         have int_U: "\<And>i. integrable M (U i)"
           using seq f U_le_f by (intro integrable_bound[OF f(3)]) auto
         from U_le_f seq have "(\<lambda>i. integral\<^sup>L M (U i)) \<longlonglongrightarrow> integral\<^sup>L M f"
           by (intro integral_dominated_convergence) auto
         then show "(\<lambda>i. ennreal (integral\<^sup>L M (U i))) \<longlonglongrightarrow> ennreal (integral\<^sup>L M f)"
           using seq f int_U by (simp add: f integral_nonneg_AE)
         have "(\<lambda>i. \<integral>\<^sup>+ x. U i x \<partial>M) \<longlonglongrightarrow> \<integral>\<^sup>+ x. f x \<partial>M"
           using seq U_le_f f
           by (intro nn_integral_dominated_convergence[where w=f]) (auto simp: integrable_iff_bounded)
         then show "(\<lambda>i. \<integral>x. U i x \<partial>M) \<longlonglongrightarrow> \<integral>\<^sup>+x. f x \<partial>M"
           using seq int_U by simp
       qed
     qed }
   from this[of "\<lambda>x. max 0 (f x)"] assms have "(\<integral>\<^sup>+ x. max 0 (f x) \<partial>M) = integral\<^sup>L M (\<lambda>x. max 0 (f x))"
     by simp
   also have "\<dots> = integral\<^sup>L M f"
     using assms by (auto intro!: integral_cong_AE simp: integral_nonneg_AE)
   also have "(\<integral>\<^sup>+ x. max 0 (f x) \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>M)"
     using assms by (auto intro!: nn_integral_cong_AE simp: max_def)
   finally show ?thesis .
 qed
 
 lemma nn_integral_eq_integrable:
   assumes f: "f \<in> M \<rightarrow>\<^sub>M borel" "AE x in M. 0 \<le> f x" and "0 \<le> x"
   shows "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x \<longleftrightarrow> (integrable M f \<and> integral\<^sup>L M f = x)"
 proof (safe intro!: nn_integral_eq_integral assms)
   assume *: "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   with integrableI_nn_integral_finite[OF f this] nn_integral_eq_integral[of M f, OF _ f(2)]
   show "integrable M f" "integral\<^sup>L M f = x"
     by (simp_all add: * assms integral_nonneg_AE)
 qed
 
 lemma
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes integrable[measurable]: "\<And>i. integrable M (f i)"
   and summable: "AE x in M. summable (\<lambda>i. norm (f i x))"
   and sums: "summable (\<lambda>i. (\<integral>x. norm (f i x) \<partial>M))"
   shows integrable_suminf: "integrable M (\<lambda>x. (\<Sum>i. f i x))" (is "integrable M ?S")
     and sums_integral: "(\<lambda>i. integral\<^sup>L M (f i)) sums (\<integral>x. (\<Sum>i. f i x) \<partial>M)" (is "?f sums ?x")
     and integral_suminf: "(\<integral>x. (\<Sum>i. f i x) \<partial>M) = (\<Sum>i. integral\<^sup>L M (f i))"
     and summable_integral: "summable (\<lambda>i. integral\<^sup>L M (f i))"
 proof -
   have 1: "integrable M (\<lambda>x. \<Sum>i. norm (f i x))"
   proof (rule integrableI_bounded)
     have "(\<integral>\<^sup>+ x. ennreal (norm (\<Sum>i. norm (f i x))) \<partial>M) = (\<integral>\<^sup>+ x. (\<Sum>i. ennreal (norm (f i x))) \<partial>M)"
       apply (intro nn_integral_cong_AE)
       using summable
       apply eventually_elim
       apply (simp add: suminf_nonneg ennreal_suminf_neq_top)
       done
     also have "\<dots> = (\<Sum>i. \<integral>\<^sup>+ x. norm (f i x) \<partial>M)"
       by (intro nn_integral_suminf) auto
     also have "\<dots> = (\<Sum>i. ennreal (\<integral>x. norm (f i x) \<partial>M))"
       by (intro arg_cong[where f=suminf] ext nn_integral_eq_integral integrable_norm integrable) auto
     finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<Sum>i. norm (f i x))) \<partial>M) < \<infinity>"
       by (simp add: sums ennreal_suminf_neq_top less_top[symmetric] integral_nonneg_AE)
   qed simp
 
   have 2: "AE x in M. (\<lambda>n. \<Sum>i<n. f i x) \<longlonglongrightarrow> (\<Sum>i. f i x)"
     using summable by eventually_elim (auto intro: summable_LIMSEQ summable_norm_cancel)
 
   have 3: "\<And>j. AE x in M. norm (\<Sum>i<j. f i x) \<le> (\<Sum>i. norm (f i x))"
     using summable
   proof eventually_elim
     fix j x assume [simp]: "summable (\<lambda>i. norm (f i x))"
     have "norm (\<Sum>i<j. f i x) \<le> (\<Sum>i<j. norm (f i x))" by (rule norm_sum)
     also have "\<dots> \<le> (\<Sum>i. norm (f i x))"
       using sum_le_suminf[of "\<lambda>i. norm (f i x)"] unfolding sums_iff by auto
     finally show "norm (\<Sum>i<j. f i x) \<le> (\<Sum>i. norm (f i x))" by simp
   qed
 
   note ibl = integrable_dominated_convergence[OF _ _ 1 2 3]
   note int = integral_dominated_convergence[OF _ _ 1 2 3]
 
   show "integrable M ?S"
     by (rule ibl) measurable
 
   show "?f sums ?x" unfolding sums_def
     using int by (simp add: integrable)
   then show "?x = suminf ?f" "summable ?f"
     unfolding sums_iff by auto
 qed
 
 proposition integral_norm_bound [simp]:
   fixes f :: "_ \<Rightarrow> 'a :: {banach, second_countable_topology}"
   shows "norm (integral\<^sup>L M f) \<le> (\<integral>x. norm (f x) \<partial>M)"
 proof (cases "integrable M f")
   case True then show ?thesis
     using nn_integral_eq_integral[of M "\<lambda>x. norm (f x)"] integral_norm_bound_ennreal[of M f]
     by (simp add: integral_nonneg_AE)
 next
   case False
   then have "norm (integral\<^sup>L M f) = 0" by (simp add: not_integrable_integral_eq)
   moreover have "(\<integral>x. norm (f x) \<partial>M) \<ge> 0" by auto
   ultimately show ?thesis by simp
 qed
 
 proposition integral_abs_bound [simp]:
   fixes f :: "'a \<Rightarrow> real" shows "abs (\<integral>x. f x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> \<partial>M)"
 using integral_norm_bound[of M f] by auto
 
 lemma integral_eq_nn_integral:
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   shows "integral\<^sup>L M f = enn2real (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M)"
 proof cases
   assume *: "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) = \<infinity>"
   also have "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     using nonneg by (intro nn_integral_cong_AE) auto
   finally have "\<not> integrable M f"
     by (auto simp: integrable_iff_bounded)
   then show ?thesis
     by (simp add: * not_integrable_integral_eq)
 next
   assume "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>"
   then have "integrable M f"
     by (cases "\<integral>\<^sup>+ x. ennreal (f x) \<partial>M" rule: ennreal_cases)
        (auto intro!: integrableI_nn_integral_finite assms)
   from nn_integral_eq_integral[OF this] nonneg show ?thesis
     by (simp add: integral_nonneg_AE)
 qed
 
 lemma enn2real_nn_integral_eq_integral:
   assumes eq: "AE x in M. f x = ennreal (g x)" and nn: "AE x in M. 0 \<le> g x"
     and fin: "(\<integral>\<^sup>+x. f x \<partial>M) < top"
     and [measurable]: "g \<in> M \<rightarrow>\<^sub>M borel"
   shows "enn2real (\<integral>\<^sup>+x. f x \<partial>M) = (\<integral>x. g x \<partial>M)"
 proof -
   have "ennreal (enn2real (\<integral>\<^sup>+x. f x \<partial>M)) = (\<integral>\<^sup>+x. f x \<partial>M)"
     using fin by (intro ennreal_enn2real) auto
   also have "\<dots> = (\<integral>\<^sup>+x. g x \<partial>M)"
     using eq by (rule nn_integral_cong_AE)
   also have "\<dots> = (\<integral>x. g x \<partial>M)"
   proof (rule nn_integral_eq_integral)
     show "integrable M g"
     proof (rule integrableI_bounded)
       have "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) = (\<integral>\<^sup>+ x. f x \<partial>M)"
         using eq nn by (auto intro!: nn_integral_cong_AE elim!: eventually_elim2)
       also note fin
       finally show "(\<integral>\<^sup>+ x. ennreal (norm (g x)) \<partial>M) < \<infinity>"
         by simp
     qed simp
   qed fact
   finally show ?thesis
     using nn by (simp add: integral_nonneg_AE)
 qed
 
 lemma has_bochner_integral_nn_integral:
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "0 \<le> x"
   assumes "(\<integral>\<^sup>+x. f x \<partial>M) = ennreal x"
   shows "has_bochner_integral M f x"
   unfolding has_bochner_integral_iff
   using assms by (auto simp: assms integral_eq_nn_integral intro: integrableI_nn_integral_finite)
 
 lemma integrableI_simple_bochner_integrable:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "simple_bochner_integrable M f \<Longrightarrow> integrable M f"
   by (intro integrableI_sequence[where s="\<lambda>_. f"] borel_measurable_simple_function)
      (auto simp: zero_ennreal_def[symmetric] simple_bochner_integrable.simps)
 
 proposition integrable_induct[consumes 1, case_names base add lim, induct pred: integrable]:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "integrable M f"
   assumes base: "\<And>A c. A \<in> sets M \<Longrightarrow> emeasure M A < \<infinity> \<Longrightarrow> P (\<lambda>x. indicator A x *\<^sub>R c)"
   assumes add: "\<And>f g. integrable M f \<Longrightarrow> P f \<Longrightarrow> integrable M g \<Longrightarrow> P g \<Longrightarrow> P (\<lambda>x. f x + g x)"
   assumes lim: "\<And>f s. (\<And>i. integrable M (s i)) \<Longrightarrow> (\<And>i. P (s i)) \<Longrightarrow>
    (\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x) \<Longrightarrow>
    (\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)) \<Longrightarrow> integrable M f \<Longrightarrow> P f"
   shows "P f"
 proof -
   from \<open>integrable M f\<close> have f: "f \<in> borel_measurable M" "(\<integral>\<^sup>+x. norm (f x) \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by auto
   from borel_measurable_implies_sequence_metric[OF f(1)]
   obtain s where s: "\<And>i. simple_function M (s i)" "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. s i x) \<longlonglongrightarrow> f x"
     "\<And>i x. x \<in> space M \<Longrightarrow> norm (s i x) \<le> 2 * norm (f x)"
     unfolding norm_conv_dist by metis
 
   { fix f A
     have [simp]: "P (\<lambda>x. 0)"
       using base[of "{}" undefined] by simp
     have "(\<And>i::'b. i \<in> A \<Longrightarrow> integrable M (f i::'a \<Rightarrow> 'b)) \<Longrightarrow>
     (\<And>i. i \<in> A \<Longrightarrow> P (f i)) \<Longrightarrow> P (\<lambda>x. \<Sum>i\<in>A. f i x)"
     by (induct A rule: infinite_finite_induct) (auto intro!: add) }
   note sum = this
 
   define s' where [abs_def]: "s' i z = indicator (space M) z *\<^sub>R s i z" for i z
   then have s'_eq_s: "\<And>i x. x \<in> space M \<Longrightarrow> s' i x = s i x"
     by simp
 
   have sf[measurable]: "\<And>i. simple_function M (s' i)"
     unfolding s'_def using s(1)
     by (intro simple_function_compose2[where h="(*\<^sub>R)"] simple_function_indicator) auto
 
   { fix i
     have "\<And>z. {y. s' i z = y \<and> y \<in> s' i ` space M \<and> y \<noteq> 0 \<and> z \<in> space M} =
         (if z \<in> space M \<and> s' i z \<noteq> 0 then {s' i z} else {})"
       by (auto simp add: s'_def split: split_indicator)
     then have "\<And>z. s' i = (\<lambda>z. \<Sum>y\<in>s' i`space M - {0}. indicator {x\<in>space M. s' i x = y} z *\<^sub>R y)"
       using sf by (auto simp: fun_eq_iff simple_function_def s'_def) }
   note s'_eq = this
 
   show "P f"
   proof (rule lim)
     fix i
 
     have "(\<integral>\<^sup>+x. norm (s' i x) \<partial>M) \<le> (\<integral>\<^sup>+x. ennreal (2 * norm (f x)) \<partial>M)"
       using s by (intro nn_integral_mono) (auto simp: s'_eq_s)
     also have "\<dots> < \<infinity>"
       using f by (simp add: nn_integral_cmult ennreal_mult_less_top ennreal_mult)
     finally have sbi: "simple_bochner_integrable M (s' i)"
       using sf by (intro simple_bochner_integrableI_bounded) auto
     then show "integrable M (s' i)"
       by (rule integrableI_simple_bochner_integrable)
 
     { fix x assume"x \<in> space M" "s' i x \<noteq> 0"
       then have "emeasure M {y \<in> space M. s' i y = s' i x} \<le> emeasure M {y \<in> space M. s' i y \<noteq> 0}"
         by (intro emeasure_mono) auto
       also have "\<dots> < \<infinity>"
         using sbi by (auto elim: simple_bochner_integrable.cases simp: less_top)
       finally have "emeasure M {y \<in> space M. s' i y = s' i x} \<noteq> \<infinity>" by simp }
     then show "P (s' i)"
       by (subst s'_eq) (auto intro!: sum base simp: less_top)
 
     fix x assume "x \<in> space M" with s show "(\<lambda>i. s' i x) \<longlonglongrightarrow> f x"
       by (simp add: s'_eq_s)
     show "norm (s' i x) \<le> 2 * norm (f x)"
       using \<open>x \<in> space M\<close> s by (simp add: s'_eq_s)
   qed fact
 qed
 
 lemma integral_eq_zero_AE:
   "(AE x in M. f x = 0) \<Longrightarrow> integral\<^sup>L M f = 0"
   using integral_cong_AE[of f M "\<lambda>_. 0"]
   by (cases "integrable M f") (simp_all add: not_integrable_integral_eq)
 
 lemma integral_nonneg_eq_0_iff_AE:
   fixes f :: "_ \<Rightarrow> real"
   assumes f[measurable]: "integrable M f" and nonneg: "AE x in M. 0 \<le> f x"
   shows "integral\<^sup>L M f = 0 \<longleftrightarrow> (AE x in M. f x = 0)"
 proof
   assume "integral\<^sup>L M f = 0"
   then have "integral\<^sup>N M f = 0"
     using nn_integral_eq_integral[OF f nonneg] by simp
   then have "AE x in M. ennreal (f x) \<le> 0"
     by (simp add: nn_integral_0_iff_AE)
   with nonneg show "AE x in M. f x = 0"
     by auto
 qed (auto simp add: integral_eq_zero_AE)
 
 lemma integral_mono_AE:
   fixes f :: "'a \<Rightarrow> real"
   assumes "integrable M f" "integrable M g" "AE x in M. f x \<le> g x"
   shows "integral\<^sup>L M f \<le> integral\<^sup>L M g"
 proof -
   have "0 \<le> integral\<^sup>L M (\<lambda>x. g x - f x)"
     using assms by (intro integral_nonneg_AE integrable_diff assms) auto
   also have "\<dots> = integral\<^sup>L M g - integral\<^sup>L M f"
     by (intro integral_diff assms)
   finally show ?thesis by simp
 qed
 
 lemma integral_mono:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M f \<Longrightarrow> integrable M g \<Longrightarrow> (\<And>x. x \<in> space M \<Longrightarrow> f x \<le> g x) \<Longrightarrow>
     integral\<^sup>L M f \<le> integral\<^sup>L M g"
   by (intro integral_mono_AE) auto
 
 lemma integral_norm_bound_integral:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{banach,second_countable_topology}"
   assumes "integrable M f" "integrable M g" "\<And>x. x \<in> space M \<Longrightarrow> norm(f x) \<le> g x"
   shows "norm (\<integral>x. f x \<partial>M) \<le> (\<integral>x. g x \<partial>M)"
 proof -
   have "norm (\<integral>x. f x \<partial>M) \<le> (\<integral>x. norm (f x) \<partial>M)"
     by (rule integral_norm_bound)
   also have "... \<le> (\<integral>x. g x \<partial>M)"
     using assms integrable_norm integral_mono by blast
   finally show ?thesis .
 qed
 
 lemma integral_abs_bound_integral:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "integrable M f" "integrable M g" "\<And>x. x \<in> space M \<Longrightarrow> \<bar>f x\<bar> \<le> g x"
   shows "\<bar>\<integral>x. f x \<partial>M\<bar> \<le> (\<integral>x. g x \<partial>M)"
   by (metis integral_norm_bound_integral assms real_norm_def)
 
 text \<open>The next two statements are useful to bound Lebesgue integrals, as they avoid one
 integrability assumption. The price to pay is that the upper function has to be nonnegative,
 but this is often true and easy to check in computations.\<close>
 
 lemma integral_mono_AE':
   fixes f::"_ \<Rightarrow> real"
   assumes "integrable M f" "AE x in M. g x \<le> f x" "AE x in M. 0 \<le> f x"
   shows "(\<integral>x. g x \<partial>M) \<le> (\<integral>x. f x \<partial>M)"
 proof (cases "integrable M g")
   case True
   show ?thesis by (rule integral_mono_AE, auto simp add: assms True)
 next
   case False
   then have "(\<integral>x. g x \<partial>M) = 0" by (simp add: not_integrable_integral_eq)
   also have "... \<le> (\<integral>x. f x \<partial>M)" by (simp add: integral_nonneg_AE[OF assms(3)])
   finally show ?thesis by simp
 qed
 
 lemma integral_mono':
   fixes f::"_ \<Rightarrow> real"
   assumes "integrable M f" "\<And>x. x \<in> space M \<Longrightarrow> g x \<le> f x" "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x"
   shows "(\<integral>x. g x \<partial>M) \<le> (\<integral>x. f x \<partial>M)"
 by (rule integral_mono_AE', insert assms, auto)
 
 lemma (in finite_measure) integrable_measure:
   assumes I: "disjoint_family_on X I" "countable I"
   shows "integrable (count_space I) (\<lambda>i. measure M (X i))"
 proof -
   have "(\<integral>\<^sup>+i. measure M (X i) \<partial>count_space I) = (\<integral>\<^sup>+i. measure M (if X i \<in> sets M then X i else {}) \<partial>count_space I)"
     by (auto intro!: nn_integral_cong measure_notin_sets)
   also have "\<dots> = measure M (\<Union>i\<in>I. if X i \<in> sets M then X i else {})"
     using I unfolding emeasure_eq_measure[symmetric]
     by (subst emeasure_UN_countable) (auto simp: disjoint_family_on_def)
   finally show ?thesis
     by (auto intro!: integrableI_bounded)
 qed
 
 lemma integrableI_real_bounded:
   assumes f: "f \<in> borel_measurable M" and ae: "AE x in M. 0 \<le> f x" and fin: "integral\<^sup>N M f < \<infinity>"
   shows "integrable M f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) = \<integral>\<^sup>+ x. ennreal (f x) \<partial>M"
     using ae by (auto intro: nn_integral_cong_AE)
   also note fin
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>" .
 qed fact
 
 lemma nn_integral_nonneg_infinite:
   fixes f::"'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "\<not> integrable M f" "AE x in M. f x \<ge> 0"
   shows "(\<integral>\<^sup>+x. f x \<partial>M) = \<infinity>"
 using assms integrableI_real_bounded less_top by auto
 
 lemma integral_real_bounded:
   assumes "0 \<le> r" "integral\<^sup>N M f \<le> ennreal r"
   shows "integral\<^sup>L M f \<le> r"
 proof cases
   assume [simp]: "integrable M f"
 
   have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) = integral\<^sup>N M (\<lambda>x. max 0 (f x))"
     by (intro nn_integral_eq_integral[symmetric]) auto
   also have "\<dots> = integral\<^sup>N M f"
     by (intro nn_integral_cong) (simp add: max_def ennreal_neg)
   also have "\<dots> \<le> r"
     by fact
   finally have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) \<le> r"
     using \<open>0 \<le> r\<close> by simp
 
   moreover have "integral\<^sup>L M f \<le> integral\<^sup>L M (\<lambda>x. max 0 (f x))"
     by (rule integral_mono_AE) auto
   ultimately show ?thesis
     by simp
 next
   assume "\<not> integrable M f" then show ?thesis
     using \<open>0 \<le> r\<close> by (simp add: not_integrable_integral_eq)
 qed
 
 lemma integrable_MIN:
   fixes f:: "_ \<Rightarrow> _ \<Rightarrow> real"
   shows "\<lbrakk> finite I;  I \<noteq> {}; \<And>i. i \<in> I \<Longrightarrow> integrable M (f i) \<rbrakk>
    \<Longrightarrow> integrable M (\<lambda>x. MIN i\<in>I. f i x)"
 by (induct rule: finite_ne_induct) simp+
 
 lemma integrable_MAX:
   fixes f:: "_ \<Rightarrow> _ \<Rightarrow> real"
   shows "\<lbrakk> finite I;  I \<noteq> {};  \<And>i. i \<in> I \<Longrightarrow> integrable M (f i) \<rbrakk>
   \<Longrightarrow> integrable M (\<lambda>x. MAX i\<in>I. f i x)"
 by (induct rule: finite_ne_induct) simp+
 
 theorem integral_Markov_inequality:
   assumes [measurable]: "integrable M u" and "AE x in M. 0 \<le> u x" "0 < (c::real)"
   shows "(emeasure M) {x\<in>space M. u x \<ge> c} \<le> (1/c) * (\<integral>x. u x \<partial>M)"
 proof -
   have "(\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M) \<le> (\<integral>\<^sup>+ x. u x \<partial>M)"
     by (rule nn_integral_mono_AE, auto simp add: \<open>c>0\<close> less_eq_real_def)
   also have "... = (\<integral>x. u x \<partial>M)"
     by (rule nn_integral_eq_integral, auto simp add: assms)
   finally have *: "(\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M) \<le> (\<integral>x. u x \<partial>M)"
     by simp
 
   have "{x \<in> space M. u x \<ge> c} = {x \<in> space M. ennreal(1/c) * u x \<ge> 1} \<inter> (space M)"
     using \<open>c>0\<close> by (auto simp: ennreal_mult'[symmetric])
   then have "emeasure M {x \<in> space M. u x \<ge> c} = emeasure M ({x \<in> space M. ennreal(1/c) * u x \<ge> 1} \<inter> (space M))"
     by simp
   also have "... \<le> ennreal(1/c) * (\<integral>\<^sup>+ x. ennreal(u x) * indicator (space M) x \<partial>M)"
     by (rule nn_integral_Markov_inequality) (auto simp add: assms)
   also have "... \<le> ennreal(1/c) * (\<integral>x. u x \<partial>M)"
     apply (rule mult_left_mono) using * \<open>c>0\<close> by auto
   finally show ?thesis
     using \<open>0<c\<close> by (simp add: ennreal_mult'[symmetric])
 qed
 
 lemma integral_ineq_eq_0_then_AE:
   fixes f::"_ \<Rightarrow> real"
   assumes "AE x in M. f x \<le> g x" "integrable M f" "integrable M g"
           "(\<integral>x. f x \<partial>M) = (\<integral>x. g x \<partial>M)"
   shows "AE x in M. f x = g x"
 proof -
   define h where "h = (\<lambda>x. g x - f x)"
   have "AE x in M. h x = 0"
     apply (subst integral_nonneg_eq_0_iff_AE[symmetric])
     unfolding h_def using assms by auto
   then show ?thesis unfolding h_def by auto
 qed
 
 lemma not_AE_zero_int_E:
   fixes f::"'a \<Rightarrow> real"
   assumes "AE x in M. f x \<ge> 0" "(\<integral>x. f x \<partial>M) > 0"
       and [measurable]: "f \<in> borel_measurable M"
   shows "\<exists>A e. A \<in> sets M \<and> e>0 \<and> emeasure M A > 0 \<and> (\<forall>x \<in> A. f x \<ge> e)"
 proof (rule not_AE_zero_E, auto simp add: assms)
   assume *: "AE x in M. f x = 0"
   have "(\<integral>x. f x \<partial>M) = (\<integral>x. 0 \<partial>M)" by (rule integral_cong_AE, auto simp add: *)
   then have "(\<integral>x. f x \<partial>M) = 0" by simp
   then show False using assms(2) by simp
 qed
 
 proposition tendsto_L1_int:
   fixes u :: "_ \<Rightarrow> _ \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "\<And>n. integrable M (u n)" "integrable M f"
           and "((\<lambda>n. (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)) \<longlongrightarrow> 0) F"
   shows "((\<lambda>n. (\<integral>x. u n x \<partial>M)) \<longlongrightarrow> (\<integral>x. f x \<partial>M)) F"
 proof -
   have "((\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> (0::ennreal)) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0", where ?h = "\<lambda>n. (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)"], auto simp add: assms)
     {
       fix n
       have "(\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M) = (\<integral>x. u n x - f x \<partial>M)"
         apply (rule Bochner_Integration.integral_diff[symmetric]) using assms by auto
       then have "norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) = norm (\<integral>x. u n x - f x \<partial>M)"
         by auto
       also have "... \<le> (\<integral>x. norm(u n x - f x) \<partial>M)"
         by (rule integral_norm_bound)
       finally have "ennreal(norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<le> (\<integral>x. norm(u n x - f x) \<partial>M)"
         by simp
       also have "... = (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)"
         apply (rule nn_integral_eq_integral[symmetric]) using assms by auto
       finally have "norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) \<le> (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)" by simp
     }
     then show "eventually (\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M)) \<le> (\<integral>\<^sup>+x. norm(u n x - f x) \<partial>M)) F"
       by auto
   qed
   then have "((\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F"
     by (simp flip: ennreal_0)
   then have "((\<lambda>n. ((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F" using tendsto_norm_zero_iff by blast
   then show ?thesis using Lim_null by auto
 qed
 
 text \<open>The next lemma asserts that, if a sequence of functions converges in \<open>L\<^sup>1\<close>, then
 it admits a subsequence that converges almost everywhere.\<close>
 
 proposition tendsto_L1_AE_subseq:
   fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "\<And>n. integrable M (u n)"
       and "(\<lambda>n. (\<integral>x. norm(u n x) \<partial>M)) \<longlonglongrightarrow> 0"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (AE x in M. (\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0)"
 proof -
   {
     fix k
     have "eventually (\<lambda>n. (\<integral>x. norm(u n x) \<partial>M) < (1/2)^k) sequentially"
       using order_tendstoD(2)[OF assms(2)] by auto
     with eventually_elim2[OF eventually_gt_at_top[of k] this]
     have "\<exists>n>k. (\<integral>x. norm(u n x) \<partial>M) < (1/2)^k"
       by (metis eventually_False_sequentially)
   }
   then have "\<exists>r. \<forall>n. True \<and> (r (Suc n) > r n \<and> (\<integral>x. norm(u (r (Suc n)) x) \<partial>M) < (1/2)^(r n))"
     by (intro dependent_nat_choice, auto)
   then obtain r0 where r0: "strict_mono r0" "\<And>n. (\<integral>x. norm(u (r0 (Suc n)) x) \<partial>M) < (1/2)^(r0 n)"
     by (auto simp: strict_mono_Suc_iff)
   define r where "r = (\<lambda>n. r0(n+1))"
   have "strict_mono r" unfolding r_def using r0(1) by (simp add: strict_mono_Suc_iff)
   have I: "(\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M) < ennreal((1/2)^n)" for n
   proof -
     have "r0 n \<ge> n" using \<open>strict_mono r0\<close> by (simp add: seq_suble)
     have "(1/2::real)^(r0 n) \<le> (1/2)^n" by (rule power_decreasing[OF \<open>r0 n \<ge> n\<close>], auto)
     then have "(\<integral>x. norm(u (r0 (Suc n)) x) \<partial>M) < (1/2)^n" 
       using r0(2) less_le_trans by blast
     then have "(\<integral>x. norm(u (r n) x) \<partial>M) < (1/2)^n" 
       unfolding r_def by auto
     moreover have "(\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M) = (\<integral>x. norm(u (r n) x) \<partial>M)"
       by (rule nn_integral_eq_integral, auto simp add: integrable_norm[OF assms(1)[of "r n"]])
     ultimately show ?thesis by (auto intro: ennreal_lessI)
   qed
 
   have "AE x in M. limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
   proof (rule AE_upper_bound_inf_ennreal)
     fix e::real assume "e > 0"
     define A where "A = (\<lambda>n. {x \<in> space M. norm(u (r n) x) \<ge> e})"
     have A_meas [measurable]: "\<And>n. A n \<in> sets M" unfolding A_def by auto
     have A_bound: "emeasure M (A n) < (1/e) * ennreal((1/2)^n)" for n
     proof -
       have *: "indicator (A n) x \<le> (1/e) * ennreal(norm(u (r n) x))" for x
         apply (cases "x \<in> A n") unfolding A_def using \<open>0 < e\<close> by (auto simp: ennreal_mult[symmetric])
       have "emeasure M (A n) = (\<integral>\<^sup>+x. indicator (A n) x \<partial>M)" by auto
       also have "... \<le> (\<integral>\<^sup>+x. (1/e) * ennreal(norm(u (r n) x)) \<partial>M)"
         apply (rule nn_integral_mono) using * by auto
       also have "... = (1/e) * (\<integral>\<^sup>+x. norm(u (r n) x) \<partial>M)"
         apply (rule nn_integral_cmult) using \<open>e > 0\<close> by auto
       also have "... < (1/e) * ennreal((1/2)^n)"
         using I[of n] \<open>e > 0\<close> by (intro ennreal_mult_strict_left_mono) auto
       finally show ?thesis by simp
     qed
     have A_fin: "emeasure M (A n) < \<infinity>" for n
       using \<open>e > 0\<close> A_bound[of n]
       by (auto simp add: ennreal_mult less_top[symmetric])
 
     have A_sum: "summable (\<lambda>n. measure M (A n))"
     proof (rule summable_comparison_test'[of "\<lambda>n. (1/e) * (1/2)^n" 0])
       have "summable (\<lambda>n. (1/(2::real))^n)" by (simp add: summable_geometric)
       then show "summable (\<lambda>n. (1/e) * (1/2)^n)" using summable_mult by blast
       fix n::nat assume "n \<ge> 0"
       have "norm(measure M (A n)) = measure M (A n)" by simp
       also have "... = enn2real(emeasure M (A n))" unfolding measure_def by simp
       also have "... < enn2real((1/e) * (1/2)^n)"
         using A_bound[of n] \<open>emeasure M (A n) < \<infinity>\<close> \<open>0 < e\<close>
         by (auto simp: emeasure_eq_ennreal_measure ennreal_mult[symmetric] ennreal_less_iff)
       also have "... = (1/e) * (1/2)^n"
         using \<open>0<e\<close> by auto
       finally show "norm(measure M (A n)) \<le> (1/e) * (1/2)^n" by simp
     qed
 
     have "AE x in M. eventually (\<lambda>n. x \<in> space M - A n) sequentially"
       by (rule borel_cantelli_AE1[OF A_meas A_fin A_sum])
     moreover
     {
       fix x assume "eventually (\<lambda>n. x \<in> space M - A n) sequentially"
       moreover have "norm(u (r n) x) \<le> ennreal e" if "x \<in> space M - A n" for n
         using that unfolding A_def by (auto intro: ennreal_leI)
       ultimately have "eventually (\<lambda>n. norm(u (r n) x) \<le> ennreal e) sequentially"
         by (simp add: eventually_mono)
       then have "limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> e"
         by (simp add: Limsup_bounded)
     }
     ultimately show "AE x in M. limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0 + ennreal e" by auto
   qed
   moreover
   {
     fix x assume "limsup (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
     moreover then have "liminf (\<lambda>n. ennreal (norm(u (r n) x))) \<le> 0"
       by (rule order_trans[rotated]) (auto intro: Liminf_le_Limsup)
     ultimately have "(\<lambda>n. ennreal (norm(u (r n) x))) \<longlonglongrightarrow> 0"
       using tendsto_Limsup[of sequentially "\<lambda>n. ennreal (norm(u (r n) x))"] by auto
     then have "(\<lambda>n. norm(u (r n) x)) \<longlonglongrightarrow> 0"
       by (simp flip: ennreal_0)
     then have "(\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0"
       by (simp add: tendsto_norm_zero_iff)
   }
   ultimately have "AE x in M. (\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0" by auto
   then show ?thesis using \<open>strict_mono r\<close> by auto
 qed
 
 subsection \<open>Restricted measure spaces\<close>
 
 lemma integrable_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes \<Omega>[simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "integrable (restrict_space M \<Omega>) f \<longleftrightarrow> integrable M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
   unfolding integrable_iff_bounded
     borel_measurable_restrict_space_iff[OF \<Omega>]
     nn_integral_restrict_space[OF \<Omega>]
   by (simp add: ac_simps ennreal_indicator ennreal_mult)
 
 lemma integral_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes \<Omega>[simp]: "\<Omega> \<inter> space M \<in> sets M"
   shows "integral\<^sup>L (restrict_space M \<Omega>) f = integral\<^sup>L M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x)"
 proof (rule integral_eq_cases)
   assume "integrable (restrict_space M \<Omega>) f"
   then show ?thesis
   proof induct
     case (base A c) then show ?case
       by (simp add: indicator_inter_arith[symmetric] sets_restrict_space_iff
                     emeasure_restrict_space Int_absorb1 measure_restrict_space)
   next
     case (add g f) then show ?case
       by (simp add: scaleR_add_right integrable_restrict_space)
   next
     case (lim f s)
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L (restrict_space M \<Omega>) (s i)) \<longlonglongrightarrow> integral\<^sup>L (restrict_space M \<Omega>) f"
         using lim by (intro integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"]) simp_all
 
       show "(\<lambda>i. integral\<^sup>L (restrict_space M \<Omega>) (s i)) \<longlonglongrightarrow> (\<integral> x. indicator \<Omega> x *\<^sub>R f x \<partial>M)"
         unfolding lim
         using lim
         by (intro integral_dominated_convergence[where w="\<lambda>x. 2 * norm (indicator \<Omega> x *\<^sub>R f x)"])
            (auto simp add: space_restrict_space integrable_restrict_space simp del: norm_scaleR
                  split: split_indicator)
     qed
   qed
 qed (simp add: integrable_restrict_space)
 
 lemma integral_empty:
   assumes "space M = {}"
   shows "integral\<^sup>L M f = 0"
 proof -
   have "(\<integral> x. f x \<partial>M) = (\<integral> x. 0 \<partial>M)"
     by(rule integral_cong)(simp_all add: assms)
   thus ?thesis by simp
 qed
 
 subsection \<open>Measure spaces with an associated density\<close>
 
 lemma integrable_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
     and nn: "AE x in M. 0 \<le> g x"
   shows "integrable (density M g) f \<longleftrightarrow> integrable M (\<lambda>x. g x *\<^sub>R f x)"
   unfolding integrable_iff_bounded using nn
   apply (simp add: nn_integral_density less_top[symmetric])
   apply (intro arg_cong2[where f="(=)"] refl nn_integral_cong_AE)
   apply (auto simp: ennreal_mult)
   done
 
 lemma integral_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   assumes f: "f \<in> borel_measurable M"
     and g[measurable]: "g \<in> borel_measurable M" "AE x in M. 0 \<le> g x"
   shows "integral\<^sup>L (density M g) f = integral\<^sup>L M (\<lambda>x. g x *\<^sub>R f x)"
 proof (rule integral_eq_cases)
   assume "integrable (density M g) f"
   then show ?thesis
   proof induct
     case (base A c)
     then have [measurable]: "A \<in> sets M" by auto
 
     have int: "integrable M (\<lambda>x. g x * indicator A x)"
       using g base integrable_density[of "indicator A :: 'a \<Rightarrow> real" M g] by simp
     then have "integral\<^sup>L M (\<lambda>x. g x * indicator A x) = (\<integral>\<^sup>+ x. ennreal (g x * indicator A x) \<partial>M)"
       using g by (subst nn_integral_eq_integral) auto
     also have "\<dots> = (\<integral>\<^sup>+ x. ennreal (g x) * indicator A x \<partial>M)"
       by (intro nn_integral_cong) (auto split: split_indicator)
     also have "\<dots> = emeasure (density M g) A"
       by (rule emeasure_density[symmetric]) auto
     also have "\<dots> = ennreal (measure (density M g) A)"
       using base by (auto intro: emeasure_eq_ennreal_measure)
     also have "\<dots> = integral\<^sup>L (density M g) (indicator A)"
       using base by simp
     finally show ?case
       using base g
       apply (simp add: int integral_nonneg_AE)
       apply (subst (asm) ennreal_inj)
       apply (auto intro!: integral_nonneg_AE)
       done
   next
     case (add f h)
     then have [measurable]: "f \<in> borel_measurable M" "h \<in> borel_measurable M"
       by (auto dest!: borel_measurable_integrable)
     from add g show ?case
       by (simp add: scaleR_add_right integrable_density)
   next
     case (lim f s)
     have [measurable]: "f \<in> borel_measurable M" "\<And>i. s i \<in> borel_measurable M"
       using lim(1,5)[THEN borel_measurable_integrable] by auto
 
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. g x *\<^sub>R s i x)) \<longlonglongrightarrow> integral\<^sup>L M (\<lambda>x. g x *\<^sub>R f x)"
       proof (rule integral_dominated_convergence)
         show "integrable M (\<lambda>x. 2 * norm (g x *\<^sub>R f x))"
           by (intro integrable_mult_right integrable_norm integrable_density[THEN iffD1] lim g) auto
         show "AE x in M. (\<lambda>i. g x *\<^sub>R s i x) \<longlonglongrightarrow> g x *\<^sub>R f x"
           using lim(3) by (auto intro!: tendsto_scaleR AE_I2[of M])
         show "\<And>i. AE x in M. norm (g x *\<^sub>R s i x) \<le> 2 * norm (g x *\<^sub>R f x)"
           using lim(4) g by (auto intro!: AE_I2[of M] mult_left_mono simp: field_simps)
       qed auto
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. g x *\<^sub>R s i x)) \<longlonglongrightarrow> integral\<^sup>L (density M g) f"
         unfolding lim(2)[symmetric]
         by (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
            (insert lim(3-5), auto)
     qed
   qed
 qed (simp add: f g integrable_density)
 
 lemma
   fixes g :: "'a \<Rightarrow> real"
   assumes "f \<in> borel_measurable M" "AE x in M. 0 \<le> f x" "g \<in> borel_measurable M"
   shows integral_real_density: "integral\<^sup>L (density M f) g = (\<integral> x. f x * g x \<partial>M)"
     and integrable_real_density: "integrable (density M f) g \<longleftrightarrow> integrable M (\<lambda>x. f x * g x)"
   using assms integral_density[of g M f] integrable_density[of g M f] by auto
 
 lemma has_bochner_integral_density:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and g :: "'a \<Rightarrow> real"
   shows "f \<in> borel_measurable M \<Longrightarrow> g \<in> borel_measurable M \<Longrightarrow> (AE x in M. 0 \<le> g x) \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. g x *\<^sub>R f x) x \<Longrightarrow> has_bochner_integral (density M g) f x"
   by (simp add: has_bochner_integral_iff integrable_density integral_density)
 
 subsection \<open>Distributions\<close>
 
 lemma integrable_distr_eq:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes [measurable]: "g \<in> measurable M N" "f \<in> borel_measurable N"
   shows "integrable (distr M N g) f \<longleftrightarrow> integrable M (\<lambda>x. f (g x))"
   unfolding integrable_iff_bounded by (simp_all add: nn_integral_distr)
 
 lemma integrable_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "T \<in> measurable M M' \<Longrightarrow> integrable (distr M M' T) f \<Longrightarrow> integrable M (\<lambda>x. f (T x))"
   by (subst integrable_distr_eq[symmetric, where g=T])
      (auto dest: borel_measurable_integrable)
 
 lemma integral_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g[measurable]: "g \<in> measurable M N" and f: "f \<in> borel_measurable N"
   shows "integral\<^sup>L (distr M N g) f = integral\<^sup>L M (\<lambda>x. f (g x))"
 proof (rule integral_eq_cases)
   assume "integrable (distr M N g) f"
   then show ?thesis
   proof induct
     case (base A c)
     then have [measurable]: "A \<in> sets N" by auto
     from base have int: "integrable (distr M N g) (\<lambda>a. indicator A a *\<^sub>R c)"
       by (intro integrable_indicator)
 
     have "integral\<^sup>L (distr M N g) (\<lambda>a. indicator A a *\<^sub>R c) = measure (distr M N g) A *\<^sub>R c"
       using base by auto
     also have "\<dots> = measure M (g -` A \<inter> space M) *\<^sub>R c"
       by (subst measure_distr) auto
     also have "\<dots> = integral\<^sup>L M (\<lambda>a. indicator (g -` A \<inter> space M) a *\<^sub>R c)"
       using base by (auto simp: emeasure_distr)
     also have "\<dots> = integral\<^sup>L M (\<lambda>a. indicator A (g a) *\<^sub>R c)"
       using int base by (intro integral_cong_AE) (auto simp: emeasure_distr split: split_indicator)
     finally show ?case .
   next
     case (add f h)
     then have [measurable]: "f \<in> borel_measurable N" "h \<in> borel_measurable N"
       by (auto dest!: borel_measurable_integrable)
     from add g show ?case
       by (simp add: scaleR_add_right integrable_distr_eq)
   next
     case (lim f s)
     have [measurable]: "f \<in> borel_measurable N" "\<And>i. s i \<in> borel_measurable N"
       using lim(1,5)[THEN borel_measurable_integrable] by auto
 
     show ?case
     proof (rule LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. s i (g x))) \<longlonglongrightarrow> integral\<^sup>L M (\<lambda>x. f (g x))"
       proof (rule integral_dominated_convergence)
         show "integrable M (\<lambda>x. 2 * norm (f (g x)))"
           using lim by (auto simp: integrable_distr_eq)
         show "AE x in M. (\<lambda>i. s i (g x)) \<longlonglongrightarrow> f (g x)"
           using lim(3) g[THEN measurable_space] by auto
         show "\<And>i. AE x in M. norm (s i (g x)) \<le> 2 * norm (f (g x))"
           using lim(4) g[THEN measurable_space] by auto
       qed auto
       show "(\<lambda>i. integral\<^sup>L M (\<lambda>x. s i (g x))) \<longlonglongrightarrow> integral\<^sup>L (distr M N g) f"
         unfolding lim(2)[symmetric]
         by (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
            (insert lim(3-5), auto)
     qed
   qed
 qed (simp add: f g integrable_distr_eq)
 
 lemma has_bochner_integral_distr:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable N \<Longrightarrow> g \<in> measurable M N \<Longrightarrow>
     has_bochner_integral M (\<lambda>x. f (g x)) x \<Longrightarrow> has_bochner_integral (distr M N g) f x"
   by (simp add: has_bochner_integral_iff integrable_distr_eq integral_distr)
 
 subsection \<open>Lebesgue integration on \<^const>\<open>count_space\<close>\<close>
 
 lemma integrable_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach,second_countable_topology}"
   shows "finite X \<Longrightarrow> integrable (count_space X) f"
   by (auto simp: nn_integral_count_space integrable_iff_bounded)
 
 lemma measure_count_space[simp]:
   "B \<subseteq> A \<Longrightarrow> finite B \<Longrightarrow> measure (count_space A) B = card B"
   unfolding measure_def by (subst emeasure_count_space ) auto
 
 lemma lebesgue_integral_count_space_finite_support:
   assumes f: "finite {a\<in>A. f a \<noteq> 0}"
   shows "(\<integral>x. f x \<partial>count_space A) = (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. f a)"
 proof -
   have eq: "\<And>x. x \<in> A \<Longrightarrow> (\<Sum>a | x = a \<and> a \<in> A \<and> f a \<noteq> 0. f a) = (\<Sum>x\<in>{x}. f x)"
     by (intro sum.mono_neutral_cong_left) auto
 
   have "(\<integral>x. f x \<partial>count_space A) = (\<integral>x. (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. indicator {a} x *\<^sub>R f a) \<partial>count_space A)"
     by (intro integral_cong refl) (simp add: f eq)
   also have "\<dots> = (\<Sum>a | a \<in> A \<and> f a \<noteq> 0. measure (count_space A) {a} *\<^sub>R f a)"
     by (subst integral_sum) (auto intro!: sum.cong)
   finally show ?thesis
     by auto
 qed
 
 lemma lebesgue_integral_count_space_finite: "finite A \<Longrightarrow> (\<integral>x. f x \<partial>count_space A) = (\<Sum>a\<in>A. f a)"
   by (subst lebesgue_integral_count_space_finite_support)
      (auto intro!: sum.mono_neutral_cong_left)
 
 lemma integrable_count_space_nat_iff:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "integrable (count_space UNIV) f \<longleftrightarrow> summable (\<lambda>x. norm (f x))"
   by (auto simp add: integrable_iff_bounded nn_integral_count_space_nat ennreal_suminf_neq_top
            intro:  summable_suminf_not_top)
 
 lemma sums_integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   assumes *: "integrable (count_space UNIV) f"
   shows "f sums (integral\<^sup>L (count_space UNIV) f)"
 proof -
   let ?f = "\<lambda>n i. indicator {n} i *\<^sub>R f i"
   have f': "\<And>n i. ?f n i = indicator {n} i *\<^sub>R f n"
     by (auto simp: fun_eq_iff split: split_indicator)
 
   have "(\<lambda>i. \<integral>n. ?f i n \<partial>count_space UNIV) sums \<integral> n. (\<Sum>i. ?f i n) \<partial>count_space UNIV"
   proof (rule sums_integral)
     show "\<And>i. integrable (count_space UNIV) (?f i)"
       using * by (intro integrable_mult_indicator) auto
     show "AE n in count_space UNIV. summable (\<lambda>i. norm (?f i n))"
       using summable_finite[of "{n}" "\<lambda>i. norm (?f i n)" for n] by simp
     show "summable (\<lambda>i. \<integral> n. norm (?f i n) \<partial>count_space UNIV)"
       using * by (subst f') (simp add: integrable_count_space_nat_iff)
   qed
   also have "(\<integral> n. (\<Sum>i. ?f i n) \<partial>count_space UNIV) = (\<integral>n. f n \<partial>count_space UNIV)"
     using suminf_finite[of "{n}" "\<lambda>i. ?f i n" for n] by (auto intro!: integral_cong)
   also have "(\<lambda>i. \<integral>n. ?f i n \<partial>count_space UNIV) = f"
     by (subst f') simp
   finally show ?thesis .
 qed
 
 lemma integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "integrable (count_space UNIV) f \<Longrightarrow> integral\<^sup>L (count_space UNIV) f = (\<Sum>x. f x)"
   using sums_integral_count_space_nat by (rule sums_unique)
 
 lemma integrable_bij_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g: "bij_betw g A B"
   shows "integrable (count_space A) (\<lambda>x. f (g x)) \<longleftrightarrow> integrable (count_space B) f"
   unfolding integrable_iff_bounded by (subst nn_integral_bij_count_space[OF g]) auto
 
 lemma integral_bij_count_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes g: "bij_betw g A B"
   shows "integral\<^sup>L (count_space A) (\<lambda>x. f (g x)) = integral\<^sup>L (count_space B) f"
   using g[THEN bij_betw_imp_funcset]
   apply (subst distr_bij_count_space[OF g, symmetric])
   apply (intro integral_distr[symmetric])
   apply auto
   done
 
 lemma has_bochner_integral_count_space_nat:
   fixes f :: "nat \<Rightarrow> _::{banach,second_countable_topology}"
   shows "has_bochner_integral (count_space UNIV) f x \<Longrightarrow> f sums x"
   unfolding has_bochner_integral_iff by (auto intro!: sums_integral_count_space_nat)
 
 subsection \<open>Point measure\<close>
 
 lemma lebesgue_integral_point_measure_finite:
   fixes g :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   shows "finite A \<Longrightarrow> (\<And>a. a \<in> A \<Longrightarrow> 0 \<le> f a) \<Longrightarrow>
     integral\<^sup>L (point_measure A f) g = (\<Sum>a\<in>A. f a *\<^sub>R g a)"
   by (simp add: lebesgue_integral_count_space_finite AE_count_space integral_density point_measure_def)
 
 proposition integrable_point_measure_finite:
   fixes g :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}" and f :: "'a \<Rightarrow> real"
   shows "finite A \<Longrightarrow> integrable (point_measure A f) g"
   unfolding point_measure_def
   apply (subst density_cong[where f'="\<lambda>x. ennreal (max 0 (f x))"])
   apply (auto split: split_max simp: ennreal_neg)
   apply (subst integrable_density)
   apply (auto simp: AE_count_space integrable_count_space)
   done
 
 subsection \<open>Lebesgue integration on \<^const>\<open>null_measure\<close>\<close>
 
 lemma has_bochner_integral_null_measure_iff[iff]:
   "has_bochner_integral (null_measure M) f 0 \<longleftrightarrow> f \<in> borel_measurable M"
   by (auto simp add: has_bochner_integral.simps simple_bochner_integral_def[abs_def]
            intro!: exI[of _ "\<lambda>n x. 0"] simple_bochner_integrable.intros)
 
 lemma integrable_null_measure_iff[iff]: "integrable (null_measure M) f \<longleftrightarrow> f \<in> borel_measurable M"
   by (auto simp add: integrable.simps)
 
 lemma integral_null_measure[simp]: "integral\<^sup>L (null_measure M) f = 0"
   by (cases "integrable (null_measure M) f")
      (auto simp add: not_integrable_integral_eq has_bochner_integral_integral_eq)
 
 subsection \<open>Legacy lemmas for the real-valued Lebesgue integral\<close>
 theorem real_lebesgue_integral_def:
   assumes f[measurable]: "integrable M f"
   shows "integral\<^sup>L M f = enn2real (\<integral>\<^sup>+x. f x \<partial>M) - enn2real (\<integral>\<^sup>+x. ennreal (- f x) \<partial>M)"
 proof -
   have "integral\<^sup>L M f = integral\<^sup>L M (\<lambda>x. max 0 (f x) - max 0 (- f x))"
     by (auto intro!: arg_cong[where f="integral\<^sup>L M"])
   also have "\<dots> = integral\<^sup>L M (\<lambda>x. max 0 (f x)) - integral\<^sup>L M (\<lambda>x. max 0 (- f x))"
     by (intro integral_diff integrable_max integrable_minus integrable_zero f)
   also have "integral\<^sup>L M (\<lambda>x. max 0 (f x)) = enn2real (\<integral>\<^sup>+x. ennreal (f x) \<partial>M)"
     by (subst integral_eq_nn_integral) (auto intro!: arg_cong[where f=enn2real] nn_integral_cong simp: max_def ennreal_neg)
   also have "integral\<^sup>L M (\<lambda>x. max 0 (- f x)) = enn2real (\<integral>\<^sup>+x. ennreal (- f x) \<partial>M)"
     by (subst integral_eq_nn_integral) (auto intro!: arg_cong[where f=enn2real] nn_integral_cong simp: max_def ennreal_neg)
   finally show ?thesis .
 qed
 
 theorem real_integrable_def:
   "integrable M f \<longleftrightarrow> f \<in> borel_measurable M \<and>
     (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity> \<and> (\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   unfolding integrable_iff_bounded
 proof (safe del: notI)
   assume *: "(\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M) < \<infinity>"
   have "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by (intro nn_integral_mono) auto
   also note *
   finally show "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>"
     by simp
   have "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>M)"
     by (intro nn_integral_mono) auto
   also note *
   finally show "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
     by simp
 next
   assume [measurable]: "f \<in> borel_measurable M"
   assume fin: "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>" "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) = (\<integral>\<^sup>+ x. ennreal (f x) + ennreal (- f x) \<partial>M)"
     by (intro nn_integral_cong) (auto simp: abs_real_def ennreal_neg)
   also have"\<dots> = (\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) + (\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M)"
     by (intro nn_integral_add) auto
   also have "\<dots> < \<infinity>"
     using fin by (auto simp: less_top)
   finally show "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) < \<infinity>" .
 qed
 
 lemma integrableD[dest]:
   assumes "integrable M f"
   shows "f \<in> borel_measurable M" "(\<integral>\<^sup>+ x. ennreal (f x) \<partial>M) \<noteq> \<infinity>" "(\<integral>\<^sup>+ x. ennreal (- f x) \<partial>M) \<noteq> \<infinity>"
   using assms unfolding real_integrable_def by auto
 
 lemma integrableE:
   assumes "integrable M f"
   obtains r q where "0 \<le> r" "0 \<le> q"
     "(\<integral>\<^sup>+x. ennreal (f x)\<partial>M) = ennreal r"
     "(\<integral>\<^sup>+x. ennreal (-f x)\<partial>M) = ennreal q"
     "f \<in> borel_measurable M" "integral\<^sup>L M f = r - q"
   using assms unfolding real_integrable_def real_lebesgue_integral_def[OF assms]
   by (cases rule: ennreal2_cases[of "(\<integral>\<^sup>+x. ennreal (-f x)\<partial>M)" "(\<integral>\<^sup>+x. ennreal (f x)\<partial>M)"]) auto
 
 lemma integral_monotone_convergence_nonneg:
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes i: "\<And>i. integrable M (f i)" and mono: "AE x in M. mono (\<lambda>n. f n x)"
     and pos: "\<And>i. AE x in M. 0 \<le> f i x"
     and lim: "AE x in M. (\<lambda>i. f i x) \<longlonglongrightarrow> u x"
     and ilim: "(\<lambda>i. integral\<^sup>L M (f i)) \<longlonglongrightarrow> x"
     and u: "u \<in> borel_measurable M"
   shows "integrable M u"
   and "integral\<^sup>L M u = x"
 proof -
   have nn: "AE x in M. \<forall>i. 0 \<le> f i x"
     using pos unfolding AE_all_countable by auto
   with lim have u_nn: "AE x in M. 0 \<le> u x"
     by eventually_elim (auto intro: LIMSEQ_le_const)
   have [simp]: "0 \<le> x"
     by (intro LIMSEQ_le_const[OF ilim] allI exI impI integral_nonneg_AE pos)
   have "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = (SUP n. (\<integral>\<^sup>+ x. ennreal (f n x) \<partial>M))"
   proof (subst nn_integral_monotone_convergence_SUP_AE[symmetric])
     fix i
     from mono nn show "AE x in M. ennreal (f i x) \<le> ennreal (f (Suc i) x)"
       by eventually_elim (auto simp: mono_def)
     show "(\<lambda>x. ennreal (f i x)) \<in> borel_measurable M"
       using i by auto
   next
     show "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = \<integral>\<^sup>+ x. (SUP i. ennreal (f i x)) \<partial>M"
       apply (rule nn_integral_cong_AE)
       using lim mono nn u_nn
       apply eventually_elim
       apply (simp add: LIMSEQ_unique[OF _ LIMSEQ_SUP] incseq_def)
       done
   qed
   also have "\<dots> = ennreal x"
     using mono i nn unfolding nn_integral_eq_integral[OF i pos]
     by (subst LIMSEQ_unique[OF LIMSEQ_SUP]) (auto simp: mono_def integral_nonneg_AE pos intro!: integral_mono_AE ilim)
   finally have "(\<integral>\<^sup>+ x. ennreal (u x) \<partial>M) = ennreal x" .
   moreover have "(\<integral>\<^sup>+ x. ennreal (- u x) \<partial>M) = 0"
     using u u_nn by (subst nn_integral_0_iff_AE) (auto simp add: ennreal_neg)
   ultimately show "integrable M u" "integral\<^sup>L M u = x"
     by (auto simp: real_integrable_def real_lebesgue_integral_def u)
 qed
 
 lemma
   fixes f :: "nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes f: "\<And>i. integrable M (f i)" and mono: "AE x in M. mono (\<lambda>n. f n x)"
   and lim: "AE x in M. (\<lambda>i. f i x) \<longlonglongrightarrow> u x"
   and ilim: "(\<lambda>i. integral\<^sup>L M (f i)) \<longlonglongrightarrow> x"
   and u: "u \<in> borel_measurable M"
   shows integrable_monotone_convergence: "integrable M u"
     and integral_monotone_convergence: "integral\<^sup>L M u = x"
     and has_bochner_integral_monotone_convergence: "has_bochner_integral M u x"
 proof -
   have 1: "\<And>i. integrable M (\<lambda>x. f i x - f 0 x)"
     using f by auto
   have 2: "AE x in M. mono (\<lambda>n. f n x - f 0 x)"
     using mono by (auto simp: mono_def le_fun_def)
   have 3: "\<And>n. AE x in M. 0 \<le> f n x - f 0 x"
     using mono by (auto simp: field_simps mono_def le_fun_def)
   have 4: "AE x in M. (\<lambda>i. f i x - f 0 x) \<longlonglongrightarrow> u x - f 0 x"
     using lim by (auto intro!: tendsto_diff)
   have 5: "(\<lambda>i. (\<integral>x. f i x - f 0 x \<partial>M)) \<longlonglongrightarrow> x - integral\<^sup>L M (f 0)"
     using f ilim by (auto intro!: tendsto_diff)
   have 6: "(\<lambda>x. u x - f 0 x) \<in> borel_measurable M"
     using f[of 0] u by auto
   note diff = integral_monotone_convergence_nonneg[OF 1 2 3 4 5 6]
   have "integrable M (\<lambda>x. (u x - f 0 x) + f 0 x)"
     using diff(1) f by (rule integrable_add)
   with diff(2) f show "integrable M u" "integral\<^sup>L M u = x"
     by auto
   then show "has_bochner_integral M u x"
     by (metis has_bochner_integral_integrable)
 qed
 
 lemma integral_norm_eq_0_iff:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable M f"
   shows "(\<integral>x. norm (f x) \<partial>M) = 0 \<longleftrightarrow> emeasure M {x\<in>space M. f x \<noteq> 0} = 0"
 proof -
   have "(\<integral>\<^sup>+x. norm (f x) \<partial>M) = (\<integral>x. norm (f x) \<partial>M)"
     using f by (intro nn_integral_eq_integral integrable_norm) auto
   then have "(\<integral>x. norm (f x) \<partial>M) = 0 \<longleftrightarrow> (\<integral>\<^sup>+x. norm (f x) \<partial>M) = 0"
     by simp
   also have "\<dots> \<longleftrightarrow> emeasure M {x\<in>space M. ennreal (norm (f x)) \<noteq> 0} = 0"
     by (intro nn_integral_0_iff) auto
   finally show ?thesis
     by simp
 qed
 
 lemma integral_0_iff:
   fixes f :: "'a \<Rightarrow> real"
   shows "integrable M f \<Longrightarrow> (\<integral>x. \<bar>f x\<bar> \<partial>M) = 0 \<longleftrightarrow> emeasure M {x\<in>space M. f x \<noteq> 0} = 0"
   using integral_norm_eq_0_iff[of M f] by simp
 
 lemma (in finite_measure) integrable_const[intro!, simp]: "integrable M (\<lambda>x. a)"
   using integrable_indicator[of "space M" M a] by (simp cong: integrable_cong add: less_top[symmetric])
 
 lemma lebesgue_integral_const[simp]:
   fixes a :: "'a :: {banach, second_countable_topology}"
   shows "(\<integral>x. a \<partial>M) = measure M (space M) *\<^sub>R a"
 proof -
   { assume "emeasure M (space M) = \<infinity>" "a \<noteq> 0"
     then have ?thesis
       by (auto simp add: not_integrable_integral_eq ennreal_mult_less_top measure_def integrable_iff_bounded) }
   moreover
   { assume "a = 0" then have ?thesis by simp }
   moreover
   { assume "emeasure M (space M) \<noteq> \<infinity>"
     interpret finite_measure M
       proof qed fact
     have "(\<integral>x. a \<partial>M) = (\<integral>x. indicator (space M) x *\<^sub>R a \<partial>M)"
       by (intro integral_cong) auto
     also have "\<dots> = measure M (space M) *\<^sub>R a"
       by (simp add: less_top[symmetric])
     finally have ?thesis . }
   ultimately show ?thesis by blast
 qed
 
 lemma (in finite_measure) integrable_const_bound:
   fixes f :: "'a \<Rightarrow> 'b::{banach,second_countable_topology}"
   shows "AE x in M. norm (f x) \<le> B \<Longrightarrow> f \<in> borel_measurable M \<Longrightarrow> integrable M f"
   apply (rule integrable_bound[OF integrable_const[of B], of f])
   apply assumption
   apply (cases "0 \<le> B")
   apply auto
   done
 
 lemma (in finite_measure) integral_bounded_eq_bound_then_AE:
   assumes "AE x in M. f x \<le> (c::real)"
     "integrable M f" "(\<integral>x. f x \<partial>M) = c * measure M (space M)"
   shows "AE x in M. f x = c"
   apply (rule integral_ineq_eq_0_then_AE) using assms by auto
 
 lemma integral_indicator_finite_real:
   fixes f :: "'a \<Rightarrow> real"
   assumes [simp]: "finite A"
   assumes [measurable]: "\<And>a. a \<in> A \<Longrightarrow> {a} \<in> sets M"
   assumes finite: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} < \<infinity>"
   shows "(\<integral>x. f x * indicator A x \<partial>M) = (\<Sum>a\<in>A. f a * measure M {a})"
 proof -
   have "(\<integral>x. f x * indicator A x \<partial>M) = (\<integral>x. (\<Sum>a\<in>A. f a * indicator {a} x) \<partial>M)"
   proof (intro integral_cong refl)
     fix x show "f x * indicator A x = (\<Sum>a\<in>A. f a * indicator {a} x)"
       by (auto split: split_indicator simp: eq_commute[of x] cong: conj_cong)
   qed
   also have "\<dots> = (\<Sum>a\<in>A. f a * measure M {a})"
     using finite by (subst integral_sum) (auto)
   finally show ?thesis .
 qed
 
 lemma (in finite_measure) ennreal_integral_real:
   assumes [measurable]: "f \<in> borel_measurable M"
   assumes ae: "AE x in M. f x \<le> ennreal B" "0 \<le> B"
   shows "ennreal (\<integral>x. enn2real (f x) \<partial>M) = (\<integral>\<^sup>+x. f x \<partial>M)"
 proof (subst nn_integral_eq_integral[symmetric])
   show "integrable M (\<lambda>x. enn2real (f x))"
     using ae by (intro integrable_const_bound[where B=B]) (auto simp: enn2real_leI)
   show "(\<integral>\<^sup>+ x. ennreal (enn2real (f x)) \<partial>M) = integral\<^sup>N M f"
     using ae by (intro nn_integral_cong_AE) (auto simp: le_less_trans[OF _ ennreal_less_top])
 qed auto
 
 lemma (in finite_measure) integral_less_AE:
   fixes X Y :: "'a \<Rightarrow> real"
   assumes int: "integrable M X" "integrable M Y"
   assumes A: "(emeasure M) A \<noteq> 0" "A \<in> sets M" "AE x in M. x \<in> A \<longrightarrow> X x \<noteq> Y x"
   assumes gt: "AE x in M. X x \<le> Y x"
   shows "integral\<^sup>L M X < integral\<^sup>L M Y"
 proof -
   have "integral\<^sup>L M X \<le> integral\<^sup>L M Y"
     using gt int by (intro integral_mono_AE) auto
   moreover
   have "integral\<^sup>L M X \<noteq> integral\<^sup>L M Y"
   proof
     assume eq: "integral\<^sup>L M X = integral\<^sup>L M Y"
     have "integral\<^sup>L M (\<lambda>x. \<bar>Y x - X x\<bar>) = integral\<^sup>L M (\<lambda>x. Y x - X x)"
       using gt int by (intro integral_cong_AE) auto
     also have "\<dots> = 0"
       using eq int by simp
     finally have "(emeasure M) {x \<in> space M. Y x - X x \<noteq> 0} = 0"
       using int by (simp add: integral_0_iff)
     moreover
     have "(\<integral>\<^sup>+x. indicator A x \<partial>M) \<le> (\<integral>\<^sup>+x. indicator {x \<in> space M. Y x - X x \<noteq> 0} x \<partial>M)"
       using A by (intro nn_integral_mono_AE) auto
     then have "(emeasure M) A \<le> (emeasure M) {x \<in> space M. Y x - X x \<noteq> 0}"
       using int A by (simp add: integrable_def)
     ultimately have "emeasure M A = 0"
       by simp
     with \<open>(emeasure M) A \<noteq> 0\<close> show False by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma (in finite_measure) integral_less_AE_space:
   fixes X Y :: "'a \<Rightarrow> real"
   assumes int: "integrable M X" "integrable M Y"
   assumes gt: "AE x in M. X x < Y x" "emeasure M (space M) \<noteq> 0"
   shows "integral\<^sup>L M X < integral\<^sup>L M Y"
   using gt by (intro integral_less_AE[OF int, where A="space M"]) auto
 
 lemma tendsto_integral_at_top:
   fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   assumes [measurable_cong]: "sets M = sets borel" and f[measurable]: "integrable M f"
   shows "((\<lambda>y. \<integral> x. indicator {.. y} x *\<^sub>R f x \<partial>M) \<longlongrightarrow> \<integral> x. f x \<partial>M) at_top"
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   show "(\<lambda>n. \<integral>x. indicator {..X n} x *\<^sub>R f x \<partial>M) \<longlonglongrightarrow> integral\<^sup>L M f"
   proof (rule integral_dominated_convergence)
     show "integrable M (\<lambda>x. norm (f x))"
       by (rule integrable_norm) fact
     show "AE x in M. (\<lambda>n. indicator {..X n} x *\<^sub>R f x) \<longlonglongrightarrow> f x"
     proof
       fix x
       from \<open>filterlim X at_top sequentially\<close>
       have "eventually (\<lambda>n. x \<le> X n) sequentially"
         unfolding filterlim_at_top_ge[where c=x] by auto
       then show "(\<lambda>n. indicator {..X n} x *\<^sub>R f x) \<longlonglongrightarrow> f x"
         by (intro tendsto_eventually) (auto split: split_indicator elim!: eventually_mono)
     qed
     fix n show "AE x in M. norm (indicator {..X n} x *\<^sub>R f x) \<le> norm (f x)"
       by (auto split: split_indicator)
   qed auto
 qed
 
 lemma
   fixes f :: "real \<Rightarrow> real"
   assumes M: "sets M = sets borel"
   assumes nonneg: "AE x in M. 0 \<le> f x"
   assumes borel: "f \<in> borel_measurable borel"
   assumes int: "\<And>y. integrable M (\<lambda>x. f x * indicator {.. y} x)"
   assumes conv: "((\<lambda>y. \<integral> x. f x * indicator {.. y} x \<partial>M) \<longlongrightarrow> x) at_top"
   shows has_bochner_integral_monotone_convergence_at_top: "has_bochner_integral M f x"
     and integrable_monotone_convergence_at_top: "integrable M f"
     and integral_monotone_convergence_at_top:"integral\<^sup>L M f = x"
 proof -
   from nonneg have "AE x in M. mono (\<lambda>n::nat. f x * indicator {..real n} x)"
     by (auto split: split_indicator intro!: monoI)
   { fix x have "eventually (\<lambda>n. f x * indicator {..real n} x = f x) sequentially"
       by (rule eventually_sequentiallyI[of "nat \<lceil>x\<rceil>"])
          (auto split: split_indicator simp: nat_le_iff ceiling_le_iff) }
   from filterlim_cong[OF refl refl this]
   have "AE x in M. (\<lambda>i. f x * indicator {..real i} x) \<longlonglongrightarrow> f x"
     by simp
   have "(\<lambda>i. \<integral> x. f x * indicator {..real i} x \<partial>M) \<longlonglongrightarrow> x"
     using conv filterlim_real_sequentially by (rule filterlim_compose)
   have M_measure[simp]: "borel_measurable M = borel_measurable borel"
     using M by (simp add: sets_eq_imp_space_eq measurable_def)
   have "f \<in> borel_measurable M"
     using borel by simp
   show "has_bochner_integral M f x"
     by (rule has_bochner_integral_monotone_convergence) fact+
   then show "integrable M f" "integral\<^sup>L M f = x"
     by (auto simp: _has_bochner_integral_iff)
 qed
 
 subsection \<open>Product measure\<close>
 
 lemma (in sigma_finite_measure) borel_measurable_lebesgue_integrable[measurable (raw)]:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes [measurable]: "case_prod f \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
   shows "Measurable.pred N (\<lambda>x. integrable M (f x))"
 proof -
   have [simp]: "\<And>x. x \<in> space N \<Longrightarrow> integrable M (f x) \<longleftrightarrow> (\<integral>\<^sup>+y. norm (f x y) \<partial>M) < \<infinity>"
     unfolding integrable_iff_bounded by simp
   show ?thesis
     by (simp cong: measurable_cong)
 qed
 
 lemma (in sigma_finite_measure) measurable_measure[measurable (raw)]:
   "(\<And>x. x \<in> space N \<Longrightarrow> A x \<subseteq> space M) \<Longrightarrow>
     {x \<in> space (N \<Otimes>\<^sub>M M). snd x \<in> A (fst x)} \<in> sets (N \<Otimes>\<^sub>M M) \<Longrightarrow>
     (\<lambda>x. measure M (A x)) \<in> borel_measurable N"
   unfolding measure_def by (intro measurable_emeasure borel_measurable_enn2real) auto
 
 proposition (in sigma_finite_measure) borel_measurable_lebesgue_integral[measurable (raw)]:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "case_prod f \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
   shows "(\<lambda>x. \<integral>y. f x y \<partial>M) \<in> borel_measurable N"
 proof -
   from borel_measurable_implies_sequence_metric[OF f, of 0] guess s ..
   then have s: "\<And>i. simple_function (N \<Otimes>\<^sub>M M) (s i)"
     "\<And>x y. x \<in> space N \<Longrightarrow> y \<in> space M \<Longrightarrow> (\<lambda>i. s i (x, y)) \<longlonglongrightarrow> f x y"
     "\<And>i x y. x \<in> space N \<Longrightarrow> y \<in> space M \<Longrightarrow> norm (s i (x, y)) \<le> 2 * norm (f x y)"
     by (auto simp: space_pair_measure)
 
   have [measurable]: "\<And>i. s i \<in> borel_measurable (N \<Otimes>\<^sub>M M)"
     by (rule borel_measurable_simple_function) fact
 
   have "\<And>i. s i \<in> measurable (N \<Otimes>\<^sub>M M) (count_space UNIV)"
     by (rule measurable_simple_function) fact
 
   define f' where [abs_def]: "f' i x =
     (if integrable M (f x) then simple_bochner_integral M (\<lambda>y. s i (x, y)) else 0)" for i x
 
   { fix i x assume "x \<in> space N"
     then have "simple_bochner_integral M (\<lambda>y. s i (x, y)) =
       (\<Sum>z\<in>s i ` (space N \<times> space M). measure M {y \<in> space M. s i (x, y) = z} *\<^sub>R z)"
       using s(1)[THEN simple_functionD(1)]
       unfolding simple_bochner_integral_def
       by (intro sum.mono_neutral_cong_left)
          (auto simp: eq_commute space_pair_measure image_iff cong: conj_cong) }
   note eq = this
 
   show ?thesis
   proof (rule borel_measurable_LIMSEQ_metric)
     fix i show "f' i \<in> borel_measurable N"
       unfolding f'_def by (simp_all add: eq cong: measurable_cong if_cong)
   next
     fix x assume x: "x \<in> space N"
     { assume int_f: "integrable M (f x)"
       have int_2f: "integrable M (\<lambda>y. 2 * norm (f x y))"
         by (intro integrable_norm integrable_mult_right int_f)
       have "(\<lambda>i. integral\<^sup>L M (\<lambda>y. s i (x, y))) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
       proof (rule integral_dominated_convergence)
         from int_f show "f x \<in> borel_measurable M" by auto
         show "\<And>i. (\<lambda>y. s i (x, y)) \<in> borel_measurable M"
           using x by simp
         show "AE xa in M. (\<lambda>i. s i (x, xa)) \<longlonglongrightarrow> f x xa"
           using x s(2) by auto
         show "\<And>i. AE xa in M. norm (s i (x, xa)) \<le> 2 * norm (f x xa)"
           using x s(3) by auto
       qed fact
       moreover
       { fix i
         have "simple_bochner_integrable M (\<lambda>y. s i (x, y))"
         proof (rule simple_bochner_integrableI_bounded)
           have "(\<lambda>y. s i (x, y)) ` space M \<subseteq> s i ` (space N \<times> space M)"
             using x by auto
           then show "simple_function M (\<lambda>y. s i (x, y))"
             using simple_functionD(1)[OF s(1), of i] x
             by (intro simple_function_borel_measurable)
                (auto simp: space_pair_measure dest: finite_subset)
           have "(\<integral>\<^sup>+ y. ennreal (norm (s i (x, y))) \<partial>M) \<le> (\<integral>\<^sup>+ y. 2 * norm (f x y) \<partial>M)"
             using x s by (intro nn_integral_mono) auto
           also have "(\<integral>\<^sup>+ y. 2 * norm (f x y) \<partial>M) < \<infinity>"
             using int_2f unfolding integrable_iff_bounded by simp
           finally show "(\<integral>\<^sup>+ xa. ennreal (norm (s i (x, xa))) \<partial>M) < \<infinity>" .
         qed
         then have "integral\<^sup>L M (\<lambda>y. s i (x, y)) = simple_bochner_integral M (\<lambda>y. s i (x, y))"
           by (rule simple_bochner_integrable_eq_integral[symmetric]) }
       ultimately have "(\<lambda>i. simple_bochner_integral M (\<lambda>y. s i (x, y))) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
         by simp }
     then
     show "(\<lambda>i. f' i x) \<longlonglongrightarrow> integral\<^sup>L M (f x)"
       unfolding f'_def
       by (cases "integrable M (f x)") (simp_all add: not_integrable_integral_eq)
   qed
 qed
 
 lemma (in pair_sigma_finite) integrable_product_swap:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x))"
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
   show ?thesis unfolding *
     by (rule integrable_distr[OF measurable_pair_swap'])
        (simp add: distr_pair_swap[symmetric] assms)
 qed
 
 lemma (in pair_sigma_finite) integrable_product_swap_iff:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   shows "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x,y). f (y,x)) \<longleftrightarrow> integrable (M1 \<Otimes>\<^sub>M M2) f"
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   from Q.integrable_product_swap[of "\<lambda>(x,y). f (y,x)"] integrable_product_swap[of f]
   show ?thesis by auto
 qed
 
 lemma (in pair_sigma_finite) integral_product_swap:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
   shows "(\<integral>(x,y). f (y,x) \<partial>(M2 \<Otimes>\<^sub>M M1)) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
 proof -
   have *: "(\<lambda>(x,y). f (y,x)) = (\<lambda>x. f (case x of (x,y)\<Rightarrow>(y,x)))" by (auto simp: fun_eq_iff)
   show ?thesis unfolding *
     by (simp add: integral_distr[symmetric, OF measurable_pair_swap' f] distr_pair_swap[symmetric])
 qed
 
 theorem (in pair_sigma_finite) Fubini_integrable:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     and integ1: "integrable M1 (\<lambda>x. \<integral> y. norm (f (x, y)) \<partial>M2)"
     and integ2: "AE x in M1. integrable M2 (\<lambda>y. f (x, y))"
   shows "integrable (M1 \<Otimes>\<^sub>M M2) f"
 proof (rule integrableI_bounded)
   have "(\<integral>\<^sup>+ p. norm (f p) \<partial>(M1 \<Otimes>\<^sub>M M2)) = (\<integral>\<^sup>+ x. (\<integral>\<^sup>+ y. norm (f (x, y)) \<partial>M2) \<partial>M1)"
     by (simp add: M2.nn_integral_fst [symmetric])
   also have "\<dots> = (\<integral>\<^sup>+ x. \<bar>\<integral>y. norm (f (x, y)) \<partial>M2\<bar> \<partial>M1)"
     apply (intro nn_integral_cong_AE)
     using integ2
   proof eventually_elim
     fix x assume "integrable M2 (\<lambda>y. f (x, y))"
     then have f: "integrable M2 (\<lambda>y. norm (f (x, y)))"
       by simp
     then have "(\<integral>\<^sup>+y. ennreal (norm (f (x, y))) \<partial>M2) = ennreal (LINT y|M2. norm (f (x, y)))"
       by (rule nn_integral_eq_integral) simp
     also have "\<dots> = ennreal \<bar>LINT y|M2. norm (f (x, y))\<bar>"
       using f by simp
     finally show "(\<integral>\<^sup>+y. ennreal (norm (f (x, y))) \<partial>M2) = ennreal \<bar>LINT y|M2. norm (f (x, y))\<bar>" .
   qed
   also have "\<dots> < \<infinity>"
     using integ1 by (simp add: integrable_iff_bounded integral_nonneg_AE)
   finally show "(\<integral>\<^sup>+ p. norm (f p) \<partial>(M1 \<Otimes>\<^sub>M M2)) < \<infinity>" .
 qed fact
 
 lemma (in pair_sigma_finite) emeasure_pair_measure_finite:
   assumes A: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" and finite: "emeasure (M1 \<Otimes>\<^sub>M M2) A < \<infinity>"
   shows "AE x in M1. emeasure M2 {y\<in>space M2. (x, y) \<in> A} < \<infinity>"
 proof -
   from M2.emeasure_pair_measure_alt[OF A] finite
   have "(\<integral>\<^sup>+ x. emeasure M2 (Pair x -` A) \<partial>M1) \<noteq> \<infinity>"
     by simp
   then have "AE x in M1. emeasure M2 (Pair x -` A) \<noteq> \<infinity>"
     by (rule nn_integral_PInf_AE[rotated]) (intro M2.measurable_emeasure_Pair A)
   moreover have "\<And>x. x \<in> space M1 \<Longrightarrow> Pair x -` A = {y\<in>space M2. (x, y) \<in> A}"
     using sets.sets_into_space[OF A] by (auto simp: space_pair_measure)
   ultimately show ?thesis by (auto simp: less_top)
 qed
 
 lemma (in pair_sigma_finite) AE_integrable_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "AE x in M1. integrable M2 (\<lambda>y. f (x, y))"
 proof -
   have "(\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1) = (\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (rule M2.nn_integral_fst) simp
   also have "(\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2)) \<noteq> \<infinity>"
     using f unfolding integrable_iff_bounded by simp
   finally have "AE x in M1. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<noteq> \<infinity>"
     by (intro nn_integral_PInf_AE M2.borel_measurable_nn_integral )
        (auto simp: measurable_split_conv)
   with AE_space show ?thesis
     by eventually_elim
        (auto simp: integrable_iff_bounded measurable_compose[OF _ borel_measurable_integrable[OF f]] less_top)
 qed
 
 lemma (in pair_sigma_finite) integrable_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "integrable M1 (\<lambda>x. \<integral>y. f (x, y) \<partial>M2)"
   unfolding integrable_iff_bounded
 proof
   show "(\<lambda>x. \<integral> y. f (x, y) \<partial>M2) \<in> borel_measurable M1"
     by (rule M2.borel_measurable_lebesgue_integral) simp
   have "(\<integral>\<^sup>+ x. ennreal (norm (\<integral> y. f (x, y) \<partial>M2)) \<partial>M1) \<le> (\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1)"
     using AE_integrable_fst'[OF f] by (auto intro!: nn_integral_mono_AE integral_norm_bound_ennreal)
   also have "(\<integral>\<^sup>+x. (\<integral>\<^sup>+y. norm (f (x, y)) \<partial>M2) \<partial>M1) = (\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2))"
     by (rule M2.nn_integral_fst) simp
   also have "(\<integral>\<^sup>+x. norm (f x) \<partial>(M1 \<Otimes>\<^sub>M M2)) < \<infinity>"
     using f unfolding integrable_iff_bounded by simp
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<integral> y. f (x, y) \<partial>M2)) \<partial>M1) < \<infinity>" .
 qed
 
 proposition (in pair_sigma_finite) integral_fst':
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) f"
   shows "(\<integral>x. (\<integral>y. f (x, y) \<partial>M2) \<partial>M1) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
 using f proof induct
   case (base A c)
   have A[measurable]: "A \<in> sets (M1 \<Otimes>\<^sub>M M2)" by fact
 
   have eq: "\<And>x y. x \<in> space M1 \<Longrightarrow> indicator A (x, y) = indicator {y\<in>space M2. (x, y) \<in> A} y"
     using sets.sets_into_space[OF A] by (auto split: split_indicator simp: space_pair_measure)
 
   have int_A: "integrable (M1 \<Otimes>\<^sub>M M2) (indicator A :: _ \<Rightarrow> real)"
     using base by (rule integrable_real_indicator)
 
   have "(\<integral> x. \<integral> y. indicator A (x, y) *\<^sub>R c \<partial>M2 \<partial>M1) = (\<integral>x. measure M2 {y\<in>space M2. (x, y) \<in> A} *\<^sub>R c \<partial>M1)"
   proof (intro integral_cong_AE, simp, simp)
     from AE_integrable_fst'[OF int_A] AE_space
     show "AE x in M1. (\<integral>y. indicator A (x, y) *\<^sub>R c \<partial>M2) = measure M2 {y\<in>space M2. (x, y) \<in> A} *\<^sub>R c"
       by eventually_elim (simp add: eq integrable_indicator_iff)
   qed
   also have "\<dots> = measure (M1 \<Otimes>\<^sub>M M2) A *\<^sub>R c"
   proof (subst integral_scaleR_left)
     have "(\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1) =
       (\<integral>\<^sup>+x. emeasure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1)"
       using emeasure_pair_measure_finite[OF base]
       by (intro nn_integral_cong_AE, eventually_elim) (simp add: emeasure_eq_ennreal_measure)
     also have "\<dots> = emeasure (M1 \<Otimes>\<^sub>M M2) A"
       using sets.sets_into_space[OF A]
       by (subst M2.emeasure_pair_measure_alt)
          (auto intro!: nn_integral_cong arg_cong[where f="emeasure M2"] simp: space_pair_measure)
     finally have *: "(\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1) = emeasure (M1 \<Otimes>\<^sub>M M2) A" .
 
     from base * show "integrable M1 (\<lambda>x. measure M2 {y \<in> space M2. (x, y) \<in> A})"
       by (simp add: integrable_iff_bounded)
     then have "(\<integral>x. measure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1) =
       (\<integral>\<^sup>+x. ennreal (measure M2 {y \<in> space M2. (x, y) \<in> A}) \<partial>M1)"
       by (rule nn_integral_eq_integral[symmetric]) simp
     also note *
     finally show "(\<integral>x. measure M2 {y \<in> space M2. (x, y) \<in> A} \<partial>M1) *\<^sub>R c = measure (M1 \<Otimes>\<^sub>M M2) A *\<^sub>R c"
       using base by (simp add: emeasure_eq_ennreal_measure)
   qed
   also have "\<dots> = (\<integral> a. indicator A a *\<^sub>R c \<partial>(M1 \<Otimes>\<^sub>M M2))"
     using base by simp
   finally show ?case .
 next
   case (add f g)
   then have [measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)" "g \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     by auto
   have "(\<integral> x. \<integral> y. f (x, y) + g (x, y) \<partial>M2 \<partial>M1) =
     (\<integral> x. (\<integral> y. f (x, y) \<partial>M2) + (\<integral> y. g (x, y) \<partial>M2) \<partial>M1)"
     apply (rule integral_cong_AE)
     apply simp_all
     using AE_integrable_fst'[OF add(1)] AE_integrable_fst'[OF add(3)]
     apply eventually_elim
     apply simp
     done
   also have "\<dots> = (\<integral> x. f x \<partial>(M1 \<Otimes>\<^sub>M M2)) + (\<integral> x. g x \<partial>(M1 \<Otimes>\<^sub>M M2))"
     using integrable_fst'[OF add(1)] integrable_fst'[OF add(3)] add(2,4) by simp
   finally show ?case
     using add by simp
 next
   case (lim f s)
   then have [measurable]: "f \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)" "\<And>i. s i \<in> borel_measurable (M1 \<Otimes>\<^sub>M M2)"
     by auto
 
   show ?case
   proof (rule LIMSEQ_unique)
     show "(\<lambda>i. integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (s i)) \<longlonglongrightarrow> integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) f"
     proof (rule integral_dominated_convergence)
       show "integrable (M1 \<Otimes>\<^sub>M M2) (\<lambda>x. 2 * norm (f x))"
         using lim(5) by auto
     qed (insert lim, auto)
     have "(\<lambda>i. \<integral> x. \<integral> y. s i (x, y) \<partial>M2 \<partial>M1) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>M2 \<partial>M1"
     proof (rule integral_dominated_convergence)
       have "AE x in M1. \<forall>i. integrable M2 (\<lambda>y. s i (x, y))"
         unfolding AE_all_countable using AE_integrable_fst'[OF lim(1)] ..
       with AE_space AE_integrable_fst'[OF lim(5)]
       show "AE x in M1. (\<lambda>i. \<integral> y. s i (x, y) \<partial>M2) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>M2"
       proof eventually_elim
         fix x assume x: "x \<in> space M1" and
           s: "\<forall>i. integrable M2 (\<lambda>y. s i (x, y))" and f: "integrable M2 (\<lambda>y. f (x, y))"
         show "(\<lambda>i. \<integral> y. s i (x, y) \<partial>M2) \<longlonglongrightarrow> \<integral> y. f (x, y) \<partial>M2"
         proof (rule integral_dominated_convergence)
           show "integrable M2 (\<lambda>y. 2 * norm (f (x, y)))"
              using f by auto
           show "AE xa in M2. (\<lambda>i. s i (x, xa)) \<longlonglongrightarrow> f (x, xa)"
             using x lim(3) by (auto simp: space_pair_measure)
           show "\<And>i. AE xa in M2. norm (s i (x, xa)) \<le> 2 * norm (f (x, xa))"
             using x lim(4) by (auto simp: space_pair_measure)
         qed (insert x, measurable)
       qed
       show "integrable M1 (\<lambda>x. (\<integral> y. 2 * norm (f (x, y)) \<partial>M2))"
         by (intro integrable_mult_right integrable_norm integrable_fst' lim)
       fix i show "AE x in M1. norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>M2)"
         using AE_space AE_integrable_fst'[OF lim(1), of i] AE_integrable_fst'[OF lim(5)]
       proof eventually_elim
         fix x assume x: "x \<in> space M1"
           and s: "integrable M2 (\<lambda>y. s i (x, y))" and f: "integrable M2 (\<lambda>y. f (x, y))"
         from s have "norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral>\<^sup>+y. norm (s i (x, y)) \<partial>M2)"
           by (rule integral_norm_bound_ennreal)
         also have "\<dots> \<le> (\<integral>\<^sup>+y. 2 * norm (f (x, y)) \<partial>M2)"
           using x lim by (auto intro!: nn_integral_mono simp: space_pair_measure)
         also have "\<dots> = (\<integral>y. 2 * norm (f (x, y)) \<partial>M2)"
           using f by (intro nn_integral_eq_integral) auto
         finally show "norm (\<integral> y. s i (x, y) \<partial>M2) \<le> (\<integral> y. 2 * norm (f (x, y)) \<partial>M2)"
           by simp
       qed
     qed simp_all
     then show "(\<lambda>i. integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (s i)) \<longlonglongrightarrow> \<integral> x. \<integral> y. f (x, y) \<partial>M2 \<partial>M1"
       using lim by simp
   qed
 qed
 
 lemma (in pair_sigma_finite)
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows AE_integrable_fst: "AE x in M1. integrable M2 (\<lambda>y. f x y)" (is "?AE")
     and integrable_fst: "integrable M1 (\<lambda>x. \<integral>y. f x y \<partial>M2)" (is "?INT")
     and integral_fst: "(\<integral>x. (\<integral>y. f x y \<partial>M2) \<partial>M1) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (\<lambda>(x, y). f x y)" (is "?EQ")
   using AE_integrable_fst'[OF f] integrable_fst'[OF f] integral_fst'[OF f] by auto
 
 lemma (in pair_sigma_finite)
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes f[measurable]: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows AE_integrable_snd: "AE y in M2. integrable M1 (\<lambda>x. f x y)" (is "?AE")
     and integrable_snd: "integrable M2 (\<lambda>y. \<integral>x. f x y \<partial>M1)" (is "?INT")
     and integral_snd: "(\<integral>y. (\<integral>x. f x y \<partial>M1) \<partial>M2) = integral\<^sup>L (M1 \<Otimes>\<^sub>M M2) (case_prod f)" (is "?EQ")
 proof -
   interpret Q: pair_sigma_finite M2 M1 ..
   have Q_int: "integrable (M2 \<Otimes>\<^sub>M M1) (\<lambda>(x, y). f y x)"
     using f unfolding integrable_product_swap_iff[symmetric] by simp
   show ?AE  using Q.AE_integrable_fst'[OF Q_int] by simp
   show ?INT using Q.integrable_fst'[OF Q_int] by simp
   show ?EQ using Q.integral_fst'[OF Q_int]
     using integral_product_swap[of "case_prod f"] by simp
 qed
 
 proposition (in pair_sigma_finite) Fubini_integral:
   fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: {banach, second_countable_topology}"
   assumes f: "integrable (M1 \<Otimes>\<^sub>M M2) (case_prod f)"
   shows "(\<integral>y. (\<integral>x. f x y \<partial>M1) \<partial>M2) = (\<integral>x. (\<integral>y. f x y \<partial>M2) \<partial>M1)"
   unfolding integral_snd[OF assms] integral_fst[OF assms] ..
 
 lemma (in product_sigma_finite) product_integral_singleton:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   shows "f \<in> borel_measurable (M i) \<Longrightarrow> (\<integral>x. f (x i) \<partial>Pi\<^sub>M {i} M) = integral\<^sup>L (M i) f"
   apply (subst distr_singleton[symmetric])
   apply (subst integral_distr)
   apply simp_all
   done
 
 lemma (in product_sigma_finite) product_integral_fold:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes IJ[simp]: "I \<inter> J = {}" and fin: "finite I" "finite J"
   and f: "integrable (Pi\<^sub>M (I \<union> J) M) f"
   shows "integral\<^sup>L (Pi\<^sub>M (I \<union> J) M) f = (\<integral>x. (\<integral>y. f (merge I J (x, y)) \<partial>Pi\<^sub>M J M) \<partial>Pi\<^sub>M I M)"
 proof -
   interpret I: finite_product_sigma_finite M I by standard fact
   interpret J: finite_product_sigma_finite M J by standard fact
   have "finite (I \<union> J)" using fin by auto
   interpret IJ: finite_product_sigma_finite M "I \<union> J" by standard fact
   interpret P: pair_sigma_finite "Pi\<^sub>M I M" "Pi\<^sub>M J M" ..
   let ?M = "merge I J"
   let ?f = "\<lambda>x. f (?M x)"
   from f have f_borel: "f \<in> borel_measurable (Pi\<^sub>M (I \<union> J) M)"
     by auto
   have P_borel: "(\<lambda>x. f (merge I J x)) \<in> borel_measurable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M)"
     using measurable_comp[OF measurable_merge f_borel] by (simp add: comp_def)
   have f_int: "integrable (Pi\<^sub>M I M \<Otimes>\<^sub>M Pi\<^sub>M J M) ?f"
     by (rule integrable_distr[OF measurable_merge]) (simp add: distr_merge[OF IJ fin] f)
   show ?thesis
     apply (subst distr_merge[symmetric, OF IJ fin])
     apply (subst integral_distr[OF measurable_merge f_borel])
     apply (subst P.integral_fst'[symmetric, OF f_int])
     apply simp
     done
 qed
 
 lemma (in product_sigma_finite) product_integral_insert:
   fixes f :: "_ \<Rightarrow> _::{banach, second_countable_topology}"
   assumes I: "finite I" "i \<notin> I"
     and f: "integrable (Pi\<^sub>M (insert i I) M) f"
   shows "integral\<^sup>L (Pi\<^sub>M (insert i I) M) f = (\<integral>x. (\<integral>y. f (x(i:=y)) \<partial>M i) \<partial>Pi\<^sub>M I M)"
 proof -
   have "integral\<^sup>L (Pi\<^sub>M (insert i I) M) f = integral\<^sup>L (Pi\<^sub>M (I \<union> {i}) M) f"
     by simp
   also have "\<dots> = (\<integral>x. (\<integral>y. f (merge I {i} (x,y)) \<partial>Pi\<^sub>M {i} M) \<partial>Pi\<^sub>M I M)"
     using f I by (intro product_integral_fold) auto
   also have "\<dots> = (\<integral>x. (\<integral>y. f (x(i := y)) \<partial>M i) \<partial>Pi\<^sub>M I M)"
   proof (rule integral_cong[OF refl], subst product_integral_singleton[symmetric])
     fix x assume x: "x \<in> space (Pi\<^sub>M I M)"
     have f_borel: "f \<in> borel_measurable (Pi\<^sub>M (insert i I) M)"
       using f by auto
     show "(\<lambda>y. f (x(i := y))) \<in> borel_measurable (M i)"
       using measurable_comp[OF measurable_component_update f_borel, OF x \<open>i \<notin> I\<close>]
       unfolding comp_def .
     from x I show "(\<integral> y. f (merge I {i} (x,y)) \<partial>Pi\<^sub>M {i} M) = (\<integral> xa. f (x(i := xa i)) \<partial>Pi\<^sub>M {i} M)"
       by (auto intro!: integral_cong arg_cong[where f=f] simp: merge_def space_PiM extensional_def PiE_def)
   qed
   finally show ?thesis .
 qed
 
 lemma (in product_sigma_finite) product_integrable_prod:
   fixes f :: "'i \<Rightarrow> 'a \<Rightarrow> _::{real_normed_field,banach,second_countable_topology}"
   assumes [simp]: "finite I" and integrable: "\<And>i. i \<in> I \<Longrightarrow> integrable (M i) (f i)"
   shows "integrable (Pi\<^sub>M I M) (\<lambda>x. (\<Prod>i\<in>I. f i (x i)))" (is "integrable _ ?f")
 proof (unfold integrable_iff_bounded, intro conjI)
   interpret finite_product_sigma_finite M I by standard fact
 
   show "?f \<in> borel_measurable (Pi\<^sub>M I M)"
     using assms by simp
   have "(\<integral>\<^sup>+ x. ennreal (norm (\<Prod>i\<in>I. f i (x i))) \<partial>Pi\<^sub>M I M) =
       (\<integral>\<^sup>+ x. (\<Prod>i\<in>I. ennreal (norm (f i (x i)))) \<partial>Pi\<^sub>M I M)"
     by (simp add: prod_norm prod_ennreal)
   also have "\<dots> = (\<Prod>i\<in>I. \<integral>\<^sup>+ x. ennreal (norm (f i x)) \<partial>M i)"
     using assms by (intro product_nn_integral_prod) auto
   also have "\<dots> < \<infinity>"
     using integrable by (simp add: less_top[symmetric] ennreal_prod_eq_top integrable_iff_bounded)
   finally show "(\<integral>\<^sup>+ x. ennreal (norm (\<Prod>i\<in>I. f i (x i))) \<partial>Pi\<^sub>M I M) < \<infinity>" .
 qed
 
 lemma (in product_sigma_finite) product_integral_prod:
   fixes f :: "'i \<Rightarrow> 'a \<Rightarrow> _::{real_normed_field,banach,second_countable_topology}"
   assumes "finite I" and integrable: "\<And>i. i \<in> I \<Longrightarrow> integrable (M i) (f i)"
   shows "(\<integral>x. (\<Prod>i\<in>I. f i (x i)) \<partial>Pi\<^sub>M I M) = (\<Prod>i\<in>I. integral\<^sup>L (M i) (f i))"
 using assms proof induct
   case empty
   interpret finite_measure "Pi\<^sub>M {} M"
     by rule (simp add: space_PiM)
   show ?case by (simp add: space_PiM measure_def)
 next
   case (insert i I)
   then have iI: "finite (insert i I)" by auto
   then have prod: "\<And>J. J \<subseteq> insert i I \<Longrightarrow>
     integrable (Pi\<^sub>M J M) (\<lambda>x. (\<Prod>i\<in>J. f i (x i)))"
     by (intro product_integrable_prod insert(4)) (auto intro: finite_subset)
   interpret I: finite_product_sigma_finite M I by standard fact
   have *: "\<And>x y. (\<Prod>j\<in>I. f j (if j = i then y else x j)) = (\<Prod>j\<in>I. f j (x j))"
     using \<open>i \<notin> I\<close> by (auto intro!: prod.cong)
   show ?case
     unfolding product_integral_insert[OF insert(1,2) prod[OF subset_refl]]
     by (simp add: * insert prod subset_insertI)
 qed
 
 lemma integrable_subalgebra:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes borel: "f \<in> borel_measurable N"
   and N: "sets N \<subseteq> sets M" "space N = space M" "\<And>A. A \<in> sets N \<Longrightarrow> emeasure N A = emeasure M A"
   shows "integrable N f \<longleftrightarrow> integrable M f" (is ?P)
 proof -
   have "f \<in> borel_measurable M"
     using assms by (auto simp: measurable_def)
   with assms show ?thesis
     using assms by (auto simp: integrable_iff_bounded nn_integral_subalgebra)
 qed
 
 lemma integral_subalgebra:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes borel: "f \<in> borel_measurable N"
   and N: "sets N \<subseteq> sets M" "space N = space M" "\<And>A. A \<in> sets N \<Longrightarrow> emeasure N A = emeasure M A"
   shows "integral\<^sup>L N f = integral\<^sup>L M f"
 proof cases
   assume "integrable N f"
   then show ?thesis
   proof induct
     case base with assms show ?case by (auto simp: subset_eq measure_def)
   next
     case (add f g)
     then have "(\<integral> a. f a + g a \<partial>N) = integral\<^sup>L M f + integral\<^sup>L M g"
       by simp
     also have "\<dots> = (\<integral> a. f a + g a \<partial>M)"
       using add integrable_subalgebra[OF _ N, of f] integrable_subalgebra[OF _ N, of g] by simp
     finally show ?case .
   next
     case (lim f s)
     then have M: "\<And>i. integrable M (s i)" "integrable M f"
       using integrable_subalgebra[OF _ N, of f] integrable_subalgebra[OF _ N, of "s i" for i] by simp_all
     show ?case
     proof (intro LIMSEQ_unique)
       show "(\<lambda>i. integral\<^sup>L N (s i)) \<longlonglongrightarrow> integral\<^sup>L N f"
         apply (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
         using lim
         apply auto
         done
       show "(\<lambda>i. integral\<^sup>L N (s i)) \<longlonglongrightarrow> integral\<^sup>L M f"
         unfolding lim
         apply (rule integral_dominated_convergence[where w="\<lambda>x. 2 * norm (f x)"])
         using lim M N(2)
         apply auto
         done
     qed
   qed
 qed (simp add: not_integrable_integral_eq integrable_subalgebra[OF assms])
 
 hide_const (open) simple_bochner_integral
 hide_const (open) simple_bochner_integrable
 
 end
diff --git a/src/HOL/Analysis/Finite_Cartesian_Product.thy b/src/HOL/Analysis/Finite_Cartesian_Product.thy
--- a/src/HOL/Analysis/Finite_Cartesian_Product.thy
+++ b/src/HOL/Analysis/Finite_Cartesian_Product.thy
@@ -1,1284 +1,1284 @@
 (*  Title:      HOL/Analysis/Finite_Cartesian_Product.thy
     Author:     Amine Chaieb, University of Cambridge
 *)
 
 section \<open>Definition of Finite Cartesian Product Type\<close>
 
 theory Finite_Cartesian_Product
 imports
   Euclidean_Space
   L2_Norm
   "HOL-Library.Numeral_Type"
   "HOL-Library.Countable_Set"
   "HOL-Library.FuncSet"
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Finite Cartesian products, with indexing and lambdas\<close>
 
 typedef ('a, 'b) vec = "UNIV :: ('b::finite \<Rightarrow> 'a) set"
   morphisms vec_nth vec_lambda ..
 
 declare vec_lambda_inject [simplified, simp]
 
 bundle vec_syntax begin
 notation
   vec_nth (infixl "$" 90) and
   vec_lambda (binder "\<chi>" 10)
 end
 
 bundle no_vec_syntax begin
 no_notation
   vec_nth (infixl "$" 90) and
   vec_lambda (binder "\<chi>" 10)
 end
 
 unbundle vec_syntax
 
 text \<open>
   Concrete syntax for \<open>('a, 'b) vec\<close>:
     \<^item> \<open>'a^'b\<close> becomes \<open>('a, 'b::finite) vec\<close>
     \<^item> \<open>'a^'b::_\<close> becomes \<open>('a, 'b) vec\<close> without extra sort-constraint
 \<close>
 syntax "_vec_type" :: "type \<Rightarrow> type \<Rightarrow> type" (infixl "^" 15)
 parse_translation \<open>
   let
     fun vec t u = Syntax.const \<^type_syntax>\<open>vec\<close> $ t $ u;
     fun finite_vec_tr [t, u] =
       (case Term_Position.strip_positions u of
         v as Free (x, _) =>
           if Lexicon.is_tid x then
             vec t (Syntax.const \<^syntax_const>\<open>_ofsort\<close> $ v $
               Syntax.const \<^class_syntax>\<open>finite\<close>)
           else vec t u
       | _ => vec t u)
   in
     [(\<^syntax_const>\<open>_vec_type\<close>, K finite_vec_tr)]
   end
 \<close>
 
 lemma vec_eq_iff: "(x = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
   by (simp add: vec_nth_inject [symmetric] fun_eq_iff)
 
 lemma vec_lambda_beta [simp]: "vec_lambda g $ i = g i"
   by (simp add: vec_lambda_inverse)
 
 lemma vec_lambda_unique: "(\<forall>i. f$i = g i) \<longleftrightarrow> vec_lambda g = f"
   by (auto simp add: vec_eq_iff)
 
 lemma vec_lambda_eta [simp]: "(\<chi> i. (g$i)) = g"
   by (simp add: vec_eq_iff)
 
 subsection \<open>Cardinality of vectors\<close>
 
 instance vec :: (finite, finite) finite
 proof
   show "finite (UNIV :: ('a, 'b) vec set)"
   proof (subst bij_betw_finite)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "finite (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro finite_PiE) auto
     also have "(PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set)) = Pi UNIV (\<lambda>_. UNIV)"
       by auto
     finally show "finite \<dots>" .
   qed
 qed
 
 lemma countable_PiE:
   "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> countable (F i)) \<Longrightarrow> countable (Pi\<^sub>E I F)"
   by (induct I arbitrary: F rule: finite_induct) (auto simp: PiE_insert_eq)
 
 instance vec :: (countable, finite) countable
 proof
   have "countable (UNIV :: ('a, 'b) vec set)"
   proof (rule countableI_bij2)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "countable (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro countable_PiE) auto
     also have "(PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set)) = Pi UNIV (\<lambda>_. UNIV)"
       by auto
     finally show "countable \<dots>" .
   qed
   thus "\<exists>t::('a, 'b) vec \<Rightarrow> nat. inj t"
     by (auto elim!: countableE)
 qed
 
 lemma infinite_UNIV_vec:
   assumes "infinite (UNIV :: 'a set)"
   shows   "infinite (UNIV :: ('a^'b) set)"
 proof (subst bij_betw_finite)
   show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
     by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
   have "infinite (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))" (is "infinite ?A")
   proof
     assume "finite ?A"
     hence "finite ((\<lambda>f. f undefined) ` ?A)"
       by (rule finite_imageI)
     also have "(\<lambda>f. f undefined) ` ?A = UNIV"
       by auto
     finally show False 
       using \<open>infinite (UNIV :: 'a set)\<close> by contradiction
   qed
   also have "?A = Pi UNIV (\<lambda>_. UNIV)" 
     by auto
   finally show "infinite (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))" .
 qed
 
 proposition CARD_vec [simp]:
   "CARD('a^'b) = CARD('a) ^ CARD('b)"
 proof (cases "finite (UNIV :: 'a set)")
   case True
   show ?thesis
   proof (subst bij_betw_same_card)
     show "bij_betw vec_nth UNIV (Pi (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       by (intro bij_betwI[of _ _ _ vec_lambda]) (auto simp: vec_eq_iff)
     have "CARD('a) ^ CARD('b) = card (PiE (UNIV :: 'b set) (\<lambda>_. UNIV :: 'a set))"
       (is "_ = card ?A")
       by (subst card_PiE) (auto)
     also have "?A = Pi UNIV (\<lambda>_. UNIV)" 
       by auto
     finally show "card \<dots> = CARD('a) ^ CARD('b)" ..
   qed
 qed (simp_all add: infinite_UNIV_vec)
 
 lemma countable_vector:
   fixes B:: "'n::finite \<Rightarrow> 'a set"
   assumes "\<And>i. countable (B i)"
   shows "countable {V. \<forall>i::'n::finite. V $ i \<in> B i}"
 proof -
   have "f \<in> ($) ` {V. \<forall>i. V $ i \<in> B i}" if "f \<in> Pi\<^sub>E UNIV B" for f
   proof -
     have "\<exists>W. (\<forall>i. W $ i \<in> B i) \<and> ($) W = f"
       by (metis that PiE_iff UNIV_I vec_lambda_inverse)
     then show "f \<in> ($) ` {v. \<forall>i. v $ i \<in> B i}"
       by blast
   qed
   then have "Pi\<^sub>E UNIV B = vec_nth ` {V. \<forall>i::'n. V $ i \<in> B i}"
     by blast
   then have "countable (vec_nth ` {V. \<forall>i. V $ i \<in> B i})"
     by (metis finite_class.finite_UNIV countable_PiE assms)
   then have "countable (vec_lambda ` vec_nth ` {V. \<forall>i. V $ i \<in> B i})"
     by auto
   then show ?thesis
     by (simp add: image_comp o_def vec_nth_inverse)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Group operations and class instances\<close>
 
 instantiation vec :: (zero, finite) zero
 begin
   definition "0 \<equiv> (\<chi> i. 0)"
   instance ..
 end
 
 instantiation vec :: (plus, finite) plus
 begin
   definition "(+) \<equiv> (\<lambda> x y. (\<chi> i. x$i + y$i))"
   instance ..
 end
 
 instantiation vec :: (minus, finite) minus
 begin
   definition "(-) \<equiv> (\<lambda> x y. (\<chi> i. x$i - y$i))"
   instance ..
 end
 
 instantiation vec :: (uminus, finite) uminus
 begin
   definition "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
   instance ..
 end
 
 lemma zero_index [simp]: "0 $ i = 0"
   unfolding zero_vec_def by simp
 
 lemma vector_add_component [simp]: "(x + y)$i = x$i + y$i"
   unfolding plus_vec_def by simp
 
 lemma vector_minus_component [simp]: "(x - y)$i = x$i - y$i"
   unfolding minus_vec_def by simp
 
 lemma vector_uminus_component [simp]: "(- x)$i = - (x$i)"
   unfolding uminus_vec_def by simp
 
 instance vec :: (semigroup_add, finite) semigroup_add
   by standard (simp add: vec_eq_iff add.assoc)
 
 instance vec :: (ab_semigroup_add, finite) ab_semigroup_add
   by standard (simp add: vec_eq_iff add.commute)
 
 instance vec :: (monoid_add, finite) monoid_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (comm_monoid_add, finite) comm_monoid_add
   by standard (simp add: vec_eq_iff)
 
 instance vec :: (cancel_semigroup_add, finite) cancel_semigroup_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (cancel_ab_semigroup_add, finite) cancel_ab_semigroup_add
   by standard (simp_all add: vec_eq_iff diff_diff_eq)
 
 instance vec :: (cancel_comm_monoid_add, finite) cancel_comm_monoid_add ..
 
 instance vec :: (group_add, finite) group_add
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (ab_group_add, finite) ab_group_add
   by standard (simp_all add: vec_eq_iff)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic componentwise operations on vectors\<close>
 
 instantiation vec :: (times, finite) times
 begin
 
 definition "(*) \<equiv> (\<lambda> x y.  (\<chi> i. (x$i) * (y$i)))"
 instance ..
 
 end
 
 instantiation vec :: (one, finite) one
 begin
 
 definition "1 \<equiv> (\<chi> i. 1)"
 instance ..
 
 end
 
 instantiation vec :: (ord, finite) ord
 begin
 
 definition "x \<le> y \<longleftrightarrow> (\<forall>i. x$i \<le> y$i)"
 definition "x < (y::'a^'b) \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
 instance ..
 
 end
 
 text\<open>The ordering on one-dimensional vectors is linear.\<close>
 
 instance vec:: (order, finite) order
   by standard (auto simp: less_eq_vec_def less_vec_def vec_eq_iff
       intro: order.trans order.antisym order.strict_implies_order)
 
 instance vec :: (linorder, CARD_1) linorder
 proof
   obtain a :: 'b where all: "\<And>P. (\<forall>i. P i) \<longleftrightarrow> P a"
   proof -
     have "CARD ('b) = 1" by (rule CARD_1)
     then obtain b :: 'b where "UNIV = {b}" by (auto iff: card_Suc_eq)
     then have "\<And>P. (\<forall>i\<in>UNIV. P i) \<longleftrightarrow> P b" by auto
     then show thesis by (auto intro: that)
   qed
   fix x y :: "'a^'b::CARD_1"
   note [simp] = less_eq_vec_def less_vec_def all vec_eq_iff field_simps
   show "x \<le> y \<or> y \<le> x" by auto
 qed
 
 text\<open>Constant Vectors\<close>
 
 definition "vec x = (\<chi> i. x)"
 
 text\<open>Also the scalar-vector multiplication.\<close>
 
 definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
   where "c *s x = (\<chi> i. c * (x$i))"
 
 text \<open>scalar product\<close>
 
 definition scalar_product :: "'a :: semiring_1 ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" where
   "scalar_product v w = (\<Sum> i \<in> UNIV. v $ i * w $ i)"
 
 
 subsection \<open>Real vector space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_vector, finite) real_vector
 begin
 
 definition\<^marker>\<open>tag important\<close> "scaleR \<equiv> (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
 
 lemma vector_scaleR_component [simp]: "(scaleR r x)$i = scaleR r (x$i)"
   unfolding scaleR_vec_def by simp
 
 instance\<^marker>\<open>tag unimportant\<close>
   by standard (simp_all add: vec_eq_iff scaleR_left_distrib scaleR_right_distrib)
 
 end
 
 
 subsection \<open>Topological space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (topological_space, finite) topological_space
 begin
 
 definition\<^marker>\<open>tag important\<close> [code del]:
   "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
     (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
       (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   show "open (UNIV :: ('a ^ 'b) set)"
     unfolding open_vec_def by auto
 next
   fix S T :: "('a ^ 'b) set"
   assume "open S" "open T" thus "open (S \<inter> T)"
     unfolding open_vec_def
     apply clarify
     apply (drule (1) bspec)+
     apply (clarify, rename_tac Sa Ta)
     apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
     apply (simp add: open_Int)
     done
 next
   fix K :: "('a ^ 'b) set set"
   assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
     unfolding open_vec_def
     apply clarify
     apply (drule (1) bspec)
     apply (drule (1) bspec)
     apply clarify
     apply (rule_tac x=A in exI)
     apply fast
     done
 qed
 
 end
 
 lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
   unfolding open_vec_def by auto
 
 lemma open_vimage_vec_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
   unfolding open_vec_def
   apply clarify
   apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
   done
 
 lemma closed_vimage_vec_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_vec_nth)
 
 lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
 proof -
   have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
   thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
     by (simp add: closed_INT closed_vimage_vec_nth)
 qed
 
 lemma tendsto_vec_nth [tendsto_intros]:
   assumes "((\<lambda>x. f x) \<longlongrightarrow> a) net"
   shows "((\<lambda>x. f x $ i) \<longlongrightarrow> a $ i) net"
 proof (rule topological_tendstoI)
   fix S assume "open S" "a $ i \<in> S"
   then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
     by (simp_all add: open_vimage_vec_nth)
   with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. f x $ i \<in> S) net"
     by simp
 qed
 
 lemma isCont_vec_nth [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. f x $ i) a"
   unfolding isCont_def by (rule tendsto_vec_nth)
 
 lemma vec_tendstoI:
   assumes "\<And>i. ((\<lambda>x. f x $ i) \<longlongrightarrow> a $ i) net"
   shows "((\<lambda>x. f x) \<longlongrightarrow> a) net"
 proof (rule topological_tendstoI)
   fix S assume "open S" and "a \<in> S"
   then obtain A where A: "\<And>i. open (A i)" "\<And>i. a $ i \<in> A i"
     and S: "\<And>y. \<forall>i. y $ i \<in> A i \<Longrightarrow> y \<in> S"
     unfolding open_vec_def by metis
   have "\<And>i. eventually (\<lambda>x. f x $ i \<in> A i) net"
     using assms A by (rule topological_tendstoD)
   hence "eventually (\<lambda>x. \<forall>i. f x $ i \<in> A i) net"
     by (rule eventually_all_finite)
   thus "eventually (\<lambda>x. f x \<in> S) net"
     by (rule eventually_mono, simp add: S)
 qed
 
 lemma tendsto_vec_lambda [tendsto_intros]:
   assumes "\<And>i. ((\<lambda>x. f x i) \<longlongrightarrow> a i) net"
   shows "((\<lambda>x. \<chi> i. f x i) \<longlongrightarrow> (\<chi> i. a i)) net"
   using assms by (simp add: vec_tendstoI)
 
 lemma open_image_vec_nth: assumes "open S" shows "open ((\<lambda>x. x $ i) ` S)"
 proof (rule openI)
   fix a assume "a \<in> (\<lambda>x. x $ i) ` S"
   then obtain z where "a = z $ i" and "z \<in> S" ..
   then obtain A where A: "\<forall>i. open (A i) \<and> z $ i \<in> A i"
     and S: "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
     using \<open>open S\<close> unfolding open_vec_def by auto
   hence "A i \<subseteq> (\<lambda>x. x $ i) ` S"
     by (clarsimp, rule_tac x="\<chi> j. if j = i then x else z $ j" in image_eqI,
       simp_all)
   hence "open (A i) \<and> a \<in> A i \<and> A i \<subseteq> (\<lambda>x. x $ i) ` S"
     using A \<open>a = z $ i\<close> by simp
   then show "\<exists>T. open T \<and> a \<in> T \<and> T \<subseteq> (\<lambda>x. x $ i) ` S" by - (rule exI)
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> vec :: (perfect_space, finite) perfect_space
 proof
   fix x :: "'a ^ 'b" show "\<not> open {x}"
   proof
     assume "open {x}"
     hence "\<forall>i. open ((\<lambda>x. x $ i) ` {x})" by (fast intro: open_image_vec_nth)
     hence "\<forall>i. open {x $ i}" by simp
     thus "False" by (simp add: not_open_singleton)
   qed
 qed
 
 
 subsection \<open>Metric space\<close>
 (* TODO: Product of uniform spaces and compatibility with metric_spaces! *)
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) dist
 begin
 
 definition\<^marker>\<open>tag important\<close>
   "dist x y = L2_set (\<lambda>i. dist (x$i) (y$i)) UNIV"
 
 instance ..
 end
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) uniformity_dist
 begin
 
 definition\<^marker>\<open>tag important\<close> [code del]:
   "(uniformity :: (('a^'b::_) \<times> ('a^'b::_)) filter) =
     (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 instance\<^marker>\<open>tag unimportant\<close>
   by standard (rule uniformity_vec_def)
 end
 
 declare uniformity_Abort[where 'a="'a :: metric_space ^ 'b :: finite", code]
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (metric_space, finite) metric_space
 begin
 
 proposition dist_vec_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
   unfolding dist_vec_def by (rule member_le_L2_set) simp_all
 
 instance proof
   fix x y :: "'a ^ 'b"
   show "dist x y = 0 \<longleftrightarrow> x = y"
     unfolding dist_vec_def
     by (simp add: L2_set_eq_0_iff vec_eq_iff)
 next
   fix x y z :: "'a ^ 'b"
   show "dist x y \<le> dist x z + dist y z"
     unfolding dist_vec_def
     apply (rule order_trans [OF _ L2_set_triangle_ineq])
     apply (simp add: L2_set_mono dist_triangle2)
     done
 next
   fix S :: "('a ^ 'b) set"
   have *: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
   proof
     assume "open S" show "\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S"
     proof
       fix x assume "x \<in> S"
       obtain A where A: "\<forall>i. open (A i)" "\<forall>i. x $ i \<in> A i"
         and S: "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
         using \<open>open S\<close> and \<open>x \<in> S\<close> unfolding open_vec_def by metis
       have "\<forall>i\<in>UNIV. \<exists>r>0. \<forall>y. dist y (x $ i) < r \<longrightarrow> y \<in> A i"
         using A unfolding open_dist by simp
       hence "\<exists>r. \<forall>i\<in>UNIV. 0 < r i \<and> (\<forall>y. dist y (x $ i) < r i \<longrightarrow> y \<in> A i)"
         by (rule finite_set_choice [OF finite])
       then obtain r where r1: "\<forall>i. 0 < r i"
         and r2: "\<forall>i y. dist y (x $ i) < r i \<longrightarrow> y \<in> A i" by fast
       have "0 < Min (range r) \<and> (\<forall>y. dist y x < Min (range r) \<longrightarrow> y \<in> S)"
         by (simp add: r1 r2 S le_less_trans [OF dist_vec_nth_le])
       thus "\<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S" ..
     qed
   next
     assume *: "\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S" show "open S"
     proof (unfold open_vec_def, rule)
       fix x assume "x \<in> S"
       then obtain e where "0 < e" and S: "\<forall>y. dist y x < e \<longrightarrow> y \<in> S"
         using * by fast
       define r where [abs_def]: "r i = e / sqrt (of_nat CARD('b))" for i :: 'b
       from \<open>0 < e\<close> have r: "\<forall>i. 0 < r i"
         unfolding r_def by simp_all
       from \<open>0 < e\<close> have e: "e = L2_set r UNIV"
         unfolding r_def by (simp add: L2_set_constant)
       define A where "A i = {y. dist (x $ i) y < r i}" for i
       have "\<forall>i. open (A i) \<and> x $ i \<in> A i"
         unfolding A_def by (simp add: open_ball r)
       moreover have "\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S"
         by (simp add: A_def S dist_vec_def e L2_set_strict_mono dist_commute)
       ultimately show "\<exists>A. (\<forall>i. open (A i) \<and> x $ i \<in> A i) \<and>
         (\<forall>y. (\<forall>i. y $ i \<in> A i) \<longrightarrow> y \<in> S)" by metis
     qed
   qed
   show "open S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)"
     unfolding * eventually_uniformity_metric
     by (simp del: split_paired_All add: dist_vec_def dist_commute)
 qed
 
 end
 
 lemma Cauchy_vec_nth:
   "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
   unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_vec_nth_le])
 
 lemma vec_CauchyI:
   fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n"
   assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
   shows "Cauchy (\<lambda>n. X n)"
 proof (rule metric_CauchyI)
   fix r :: real assume "0 < r"
   hence "0 < r / of_nat CARD('n)" (is "0 < ?s") by simp
   define N where "N i = (LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s)" for i
   define M where "M = Max (range N)"
   have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
     using X \<open>0 < ?s\<close> by (rule metric_CauchyD)
   hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
     unfolding N_def by (rule LeastI_ex)
   hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
     unfolding M_def by simp
   {
     fix m n :: nat
     assume "M \<le> m" "M \<le> n"
     have "dist (X m) (X n) = L2_set (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
       unfolding dist_vec_def ..
     also have "\<dots> \<le> sum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
       by (rule L2_set_le_sum [OF zero_le_dist])
     also have "\<dots> < sum (\<lambda>i::'n. ?s) UNIV"
       by (rule sum_strict_mono, simp_all add: M \<open>M \<le> m\<close> \<open>M \<le> n\<close>)
     also have "\<dots> = r"
       by simp
     finally have "dist (X m) (X n) < r" .
   }
   hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
     by simp
   then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> vec :: (complete_space, finite) complete_space
 proof
   fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
   have "\<And>i. (\<lambda>n. X n $ i) \<longlonglongrightarrow> lim (\<lambda>n. X n $ i)"
     using Cauchy_vec_nth [OF \<open>Cauchy X\<close>]
     by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
   hence "X \<longlonglongrightarrow> vec_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
     by (simp add: vec_tendstoI)
   then show "convergent X"
     by (rule convergentI)
 qed
 
 
 subsection \<open>Normed vector space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_normed_vector, finite) real_normed_vector
 begin
 
 definition\<^marker>\<open>tag important\<close> "norm x = L2_set (\<lambda>i. norm (x$i)) UNIV"
 
 definition\<^marker>\<open>tag important\<close> "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   fix a :: real and x y :: "'a ^ 'b"
   show "norm x = 0 \<longleftrightarrow> x = 0"
     unfolding norm_vec_def
     by (simp add: L2_set_eq_0_iff vec_eq_iff)
   show "norm (x + y) \<le> norm x + norm y"
     unfolding norm_vec_def
     apply (rule order_trans [OF _ L2_set_triangle_ineq])
     apply (simp add: L2_set_mono norm_triangle_ineq)
     done
   show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
     unfolding norm_vec_def
     by (simp add: L2_set_right_distrib)
   show "sgn x = scaleR (inverse (norm x)) x"
     by (rule sgn_vec_def)
   show "dist x y = norm (x - y)"
     unfolding dist_vec_def norm_vec_def
     by (simp add: dist_norm)
 qed
 
 end
 
 lemma norm_nth_le: "norm (x $ i) \<le> norm x"
 unfolding norm_vec_def
 by (rule member_le_L2_set) simp_all
 
 lemma norm_le_componentwise_cart:
   fixes x :: "'a::real_normed_vector^'n"
   assumes "\<And>i. norm(x$i) \<le> norm(y$i)"
   shows "norm x \<le> norm y"
   unfolding norm_vec_def
   by (rule L2_set_mono) (auto simp: assms)
 
 lemma component_le_norm_cart: "\<bar>x$i\<bar> \<le> norm x"
   apply (simp add: norm_vec_def)
   apply (rule member_le_L2_set, simp_all)
   done
 
 lemma norm_bound_component_le_cart: "norm x \<le> e ==> \<bar>x$i\<bar> \<le> e"
   by (metis component_le_norm_cart order_trans)
 
 lemma norm_bound_component_lt_cart: "norm x < e ==> \<bar>x$i\<bar> < e"
   by (metis component_le_norm_cart le_less_trans)
 
 lemma norm_le_l1_cart: "norm x \<le> sum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
   by (simp add: norm_vec_def L2_set_le_sum)
 
 lemma bounded_linear_vec_nth[intro]: "bounded_linear (\<lambda>x. x $ i)"
 apply standard
 apply (rule vector_add_component)
 apply (rule vector_scaleR_component)
 apply (rule_tac x="1" in exI, simp add: norm_nth_le)
 done
 
 instance vec :: (banach, finite) banach ..
 
 
 subsection \<open>Inner product space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (real_inner, finite) real_inner
 begin
 
 definition\<^marker>\<open>tag important\<close> "inner x y = sum (\<lambda>i. inner (x$i) (y$i)) UNIV"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   fix r :: real and x y z :: "'a ^ 'b"
   show "inner x y = inner y x"
     unfolding inner_vec_def
     by (simp add: inner_commute)
   show "inner (x + y) z = inner x z + inner y z"
     unfolding inner_vec_def
     by (simp add: inner_add_left sum.distrib)
   show "inner (scaleR r x) y = r * inner x y"
     unfolding inner_vec_def
     by (simp add: sum_distrib_left)
   show "0 \<le> inner x x"
     unfolding inner_vec_def
     by (simp add: sum_nonneg)
   show "inner x x = 0 \<longleftrightarrow> x = 0"
     unfolding inner_vec_def
     by (simp add: vec_eq_iff sum_nonneg_eq_0_iff)
   show "norm x = sqrt (inner x x)"
     unfolding inner_vec_def norm_vec_def L2_set_def
     by (simp add: power2_norm_eq_inner)
 qed
 
 end
 
 
 subsection \<open>Euclidean space\<close>
 
 text \<open>Vectors pointing along a single axis.\<close>
 
 definition\<^marker>\<open>tag important\<close> "axis k x = (\<chi> i. if i = k then x else 0)"
 
 lemma axis_nth [simp]: "axis i x $ i = x"
   unfolding axis_def by simp
 
 lemma axis_eq_axis: "axis i x = axis j y \<longleftrightarrow> x = y \<and> i = j \<or> x = 0 \<and> y = 0"
   unfolding axis_def vec_eq_iff by auto
 
 lemma inner_axis_axis:
   "inner (axis i x) (axis j y) = (if i = j then inner x y else 0)"
   unfolding inner_vec_def
   apply (cases "i = j")
   apply clarsimp
   apply (subst sum.remove [of _ j], simp_all)
   apply (rule sum.neutral, simp add: axis_def)
   apply (rule sum.neutral, simp add: axis_def)
   done
 
 lemma inner_axis: "inner x (axis i y) = inner (x $ i) y"
   by (simp add: inner_vec_def axis_def sum.remove [where x=i])
 
 lemma inner_axis': "inner(axis i y) x = inner y (x $ i)"
   by (simp add: inner_axis inner_commute)
 
 instantiation\<^marker>\<open>tag unimportant\<close> vec :: (euclidean_space, finite) euclidean_space
 begin
 
 definition\<^marker>\<open>tag important\<close> "Basis = (\<Union>i. \<Union>u\<in>Basis. {axis i u})"
 
 instance\<^marker>\<open>tag unimportant\<close> proof
   show "(Basis :: ('a ^ 'b) set) \<noteq> {}"
     unfolding Basis_vec_def by simp
 next
   show "finite (Basis :: ('a ^ 'b) set)"
     unfolding Basis_vec_def by simp
 next
   fix u v :: "'a ^ 'b"
   assume "u \<in> Basis" and "v \<in> Basis"
   thus "inner u v = (if u = v then 1 else 0)"
     unfolding Basis_vec_def
     by (auto simp add: inner_axis_axis axis_eq_axis inner_Basis)
 next
   fix x :: "'a ^ 'b"
   show "(\<forall>u\<in>Basis. inner x u = 0) \<longleftrightarrow> x = 0"
     unfolding Basis_vec_def
     by (simp add: inner_axis euclidean_all_zero_iff vec_eq_iff)
 qed
 
 proposition DIM_cart [simp]: "DIM('a^'b) = CARD('b) * DIM('a)"
 proof -
   have "card (\<Union>i::'b. \<Union>u::'a\<in>Basis. {axis i u}) = (\<Sum>i::'b\<in>UNIV. card (\<Union>u::'a\<in>Basis. {axis i u}))"
     by (rule card_UN_disjoint) (auto simp: axis_eq_axis) 
   also have "... = CARD('b) * DIM('a)"
     by (subst card_UN_disjoint) (auto simp: axis_eq_axis)
   finally show ?thesis
     by (simp add: Basis_vec_def)
 qed
 
 end
 
 lemma norm_axis_1 [simp]: "norm (axis m (1::real)) = 1"
   by (simp add: inner_axis' norm_eq_1)
 
 lemma sum_norm_allsubsets_bound_cart:
   fixes f:: "'a \<Rightarrow> real ^'n"
   assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (sum f Q) \<le> e"
   shows "sum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) *  e"
   using sum_norm_allsubsets_bound[OF assms]
   by simp
 
 lemma cart_eq_inner_axis: "a $ i = inner a (axis i 1)"
   by (simp add: inner_axis)
 
 lemma axis_eq_0_iff [simp]:
   shows "axis m x = 0 \<longleftrightarrow> x = 0"
   by (simp add: axis_def vec_eq_iff)
 
 lemma axis_in_Basis_iff [simp]: "axis i a \<in> Basis \<longleftrightarrow> a \<in> Basis"
   by (auto simp: Basis_vec_def axis_eq_axis)
 
 text\<open>Mapping each basis element to the corresponding finite index\<close>
 definition axis_index :: "('a::comm_ring_1)^'n \<Rightarrow> 'n" where "axis_index v \<equiv> SOME i. v = axis i 1"
 
 lemma axis_inverse:
   fixes v :: "real^'n"
   assumes "v \<in> Basis"
   shows "\<exists>i. v = axis i 1"
 proof -
   have "v \<in> (\<Union>n. \<Union>r\<in>Basis. {axis n r})"
     using assms Basis_vec_def by blast
   then show ?thesis
     by (force simp add: vec_eq_iff)
 qed
 
 lemma axis_index:
   fixes v :: "real^'n"
   assumes "v \<in> Basis"
   shows "v = axis (axis_index v) 1"
   by (metis (mono_tags) assms axis_inverse axis_index_def someI_ex)
 
 lemma axis_index_axis [simp]:
   fixes UU :: "real^'n"
   shows "(axis_index (axis u 1 :: real^'n)) = (u::'n)"
   by (simp add: axis_eq_axis axis_index_def)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space\<close>
 
 lemma sum_cong_aux:
   "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> sum f A = sum g A"
   by (auto intro: sum.cong)
 
 hide_fact (open) sum_cong_aux
 
 method_setup vector = \<open>
 let
   val ss1 =
     simpset_of (put_simpset HOL_basic_ss \<^context>
       addsimps [@{thm sum.distrib} RS sym,
       @{thm sum_subtractf} RS sym, @{thm sum_distrib_left},
       @{thm sum_distrib_right}, @{thm sum_negf} RS sym])
   val ss2 =
     simpset_of (\<^context> addsimps
              [@{thm plus_vec_def}, @{thm times_vec_def},
               @{thm minus_vec_def}, @{thm uminus_vec_def},
               @{thm one_vec_def}, @{thm zero_vec_def}, @{thm vec_def},
               @{thm scaleR_vec_def}, @{thm vector_scalar_mult_def}])
   fun vector_arith_tac ctxt ths =
     simp_tac (put_simpset ss1 ctxt)
     THEN' (fn i => resolve_tac ctxt @{thms Finite_Cartesian_Product.sum_cong_aux} i
          ORELSE resolve_tac ctxt @{thms sum.neutral} i
          ORELSE simp_tac (put_simpset HOL_basic_ss ctxt addsimps [@{thm vec_eq_iff}]) i)
     (* THEN' TRY o clarify_tac HOL_cs  THEN' (TRY o rtac @{thm iffI}) *)
     THEN' asm_full_simp_tac (put_simpset ss2 ctxt addsimps ths)
 in
   Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (vector_arith_tac ctxt ths))
 end
 \<close> "lift trivial vector statements to real arith statements"
 
 lemma vec_0[simp]: "vec 0 = 0" by vector
 lemma vec_1[simp]: "vec 1 = 1" by vector
 
 lemma vec_inj[simp]: "vec x = vec y \<longleftrightarrow> x = y" by vector
 
 lemma vec_in_image_vec: "vec x \<in> (vec ` S) \<longleftrightarrow> x \<in> S" by auto
 
 lemma vec_add: "vec(x + y) = vec x + vec y"  by vector
 lemma vec_sub: "vec(x - y) = vec x - vec y" by vector
 lemma vec_cmul: "vec(c * x) = c *s vec x " by vector
 lemma vec_neg: "vec(- x) = - vec x " by vector
 
 lemma vec_scaleR: "vec(c * x) = c *\<^sub>R vec x"
   by vector
 
 lemma vec_sum:
   assumes "finite S"
   shows "vec(sum f S) = sum (vec \<circ> f) S"
   using assms
 proof induct
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case by (auto simp add: vec_add)
 qed
 
 text\<open>Obvious "component-pushing".\<close>
 
 lemma vec_component [simp]: "vec x $ i = x"
   by vector
 
 lemma vector_mult_component [simp]: "(x * y)$i = x$i * y$i"
   by vector
 
 lemma vector_smult_component [simp]: "(c *s y)$i = c * (y$i)"
   by vector
 
 lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
 
 lemmas\<^marker>\<open>tag unimportant\<close> vector_component =
   vec_component vector_add_component vector_mult_component
   vector_smult_component vector_minus_component vector_uminus_component
   vector_scaleR_component cond_component
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some frequently useful arithmetic lemmas over vectors\<close>
 
 instance vec :: (semigroup_mult, finite) semigroup_mult
   by standard (vector mult.assoc)
 
 instance vec :: (monoid_mult, finite) monoid_mult
   by standard vector+
 
 instance vec :: (ab_semigroup_mult, finite) ab_semigroup_mult
   by standard (vector mult.commute)
 
 instance vec :: (comm_monoid_mult, finite) comm_monoid_mult
   by standard vector
 
 instance vec :: (semiring, finite) semiring
   by standard (vector field_simps)+
 
 instance vec :: (semiring_0, finite) semiring_0
   by standard (vector field_simps)+
 instance vec :: (semiring_1, finite) semiring_1
   by standard vector
 instance vec :: (comm_semiring, finite) comm_semiring
   by standard (vector field_simps)+
 
 instance vec :: (comm_semiring_0, finite) comm_semiring_0 ..
 instance vec :: (semiring_0_cancel, finite) semiring_0_cancel ..
 instance vec :: (comm_semiring_0_cancel, finite) comm_semiring_0_cancel ..
 instance vec :: (ring, finite) ring ..
 instance vec :: (semiring_1_cancel, finite) semiring_1_cancel ..
 instance vec :: (comm_semiring_1, finite) comm_semiring_1 ..
 
 instance vec :: (ring_1, finite) ring_1 ..
 
 instance vec :: (real_algebra, finite) real_algebra
   by standard (simp_all add: vec_eq_iff)
 
 instance vec :: (real_algebra_1, finite) real_algebra_1 ..
 
 lemma of_nat_index: "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
 proof (induct n)
   case 0
   then show ?case by vector
 next
   case Suc
   then show ?case by vector
 qed
 
 lemma one_index [simp]: "(1 :: 'a :: one ^ 'n) $ i = 1"
   by vector
 
 lemma neg_one_index [simp]: "(- 1 :: 'a :: {one, uminus} ^ 'n) $ i = - 1"
   by vector
 
 instance vec :: (semiring_char_0, finite) semiring_char_0
 proof
   fix m n :: nat
   show "inj (of_nat :: nat \<Rightarrow> 'a ^ 'b)"
     by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
 qed
 
 instance vec :: (numeral, finite) numeral ..
 instance vec :: (semiring_numeral, finite) semiring_numeral ..
 
 lemma numeral_index [simp]: "numeral w $ i = numeral w"
   by (induct w) (simp_all only: numeral.simps vector_add_component one_index)
 
 lemma neg_numeral_index [simp]: "- numeral w $ i = - numeral w"
   by (simp only: vector_uminus_component numeral_index)
 
 instance vec :: (comm_ring_1, finite) comm_ring_1 ..
 instance vec :: (ring_char_0, finite) ring_char_0 ..
 
 lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
   by (vector mult.assoc)
 lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
   by (vector field_simps)
 lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
   by (vector field_simps)
 lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
 lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
 lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
   by (vector field_simps)
 lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
 lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
 lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
 lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
 lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   by (vector field_simps)
 
 lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
   by (simp add: vec_eq_iff)
 
 lemma Vector_Spaces_linear_vec [simp]: "Vector_Spaces.linear (*) vector_scalar_mult vec"
   by unfold_locales (vector algebra_simps)+
 
 lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
   by vector
 
 lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::'a::field) \<or> x = y"
   by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
 
 lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::'a::field) = b \<or> x = 0"
-  by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
+  by (subst eq_iff_diff_eq_0, subst vector_sub_rdistrib [symmetric]) simp
 
 lemma scalar_mult_eq_scaleR [abs_def]: "c *s x = c *\<^sub>R x"
   unfolding scaleR_vec_def vector_scalar_mult_def by simp
 
 lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
   unfolding dist_norm scalar_mult_eq_scaleR
   unfolding scaleR_right_diff_distrib[symmetric] by simp
 
 lemma sum_component [simp]:
   fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
   shows "(sum f S)$i = sum (\<lambda>x. (f x)$i) S"
 proof (cases "finite S")
   case True
   then show ?thesis by induct simp_all
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma sum_eq: "sum f S = (\<chi> i. sum (\<lambda>x. (f x)$i ) S)"
   by (simp add: vec_eq_iff)
 
 lemma sum_cmul:
   fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
   shows "sum (\<lambda>x. c *s f x) S = c *s sum f S"
   by (simp add: vec_eq_iff sum_distrib_left)
 
 lemma linear_vec [simp]: "linear vec"
   using Vector_Spaces_linear_vec
   apply (auto )
   by unfold_locales (vector algebra_simps)+
 
 subsection \<open>Matrix operations\<close>
 
 text\<open>Matrix notation. NB: an MxN matrix is of type \<^typ>\<open>'a^'n^'m\<close>, not \<^typ>\<open>'a^'m^'n\<close>\<close>
 
 definition\<^marker>\<open>tag important\<close> map_matrix::"('a \<Rightarrow> 'b) \<Rightarrow> (('a, 'i::finite)vec, 'j::finite) vec \<Rightarrow> (('b, 'i)vec, 'j) vec" where
   "map_matrix f x = (\<chi> i j. f (x $ i $ j))"
 
 lemma nth_map_matrix[simp]: "map_matrix f x $ i $ j = f (x $ i $ j)"
   by (simp add: map_matrix_def)
 
 definition\<^marker>\<open>tag important\<close> matrix_matrix_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m"
     (infixl "**" 70)
   where "m ** m' == (\<chi> i j. sum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
 
 definition\<^marker>\<open>tag important\<close> matrix_vector_mult :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm"
     (infixl "*v" 70)
   where "m *v x \<equiv> (\<chi> i. sum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
 
 definition\<^marker>\<open>tag important\<close> vector_matrix_mult :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n "
     (infixl "v*" 70)
   where "v v* m == (\<chi> j. sum (\<lambda>i. ((m$i)$j) * (v$i)) (UNIV :: 'm set)) :: 'a^'n"
 
 definition\<^marker>\<open>tag unimportant\<close> "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
 definition\<^marker>\<open>tag unimportant\<close> transpose where
   "(transpose::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
 definition\<^marker>\<open>tag unimportant\<close> "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
 definition\<^marker>\<open>tag unimportant\<close> "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
 definition\<^marker>\<open>tag unimportant\<close> "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
 definition\<^marker>\<open>tag unimportant\<close> "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
 
 lemma times0_left [simp]: "(0::'a::semiring_1^'n^'m) ** (A::'a ^'p^'n) = 0" 
   by (simp add: matrix_matrix_mult_def zero_vec_def)
 
 lemma times0_right [simp]: "(A::'a::semiring_1^'n^'m) ** (0::'a ^'p^'n) = 0" 
   by (simp add: matrix_matrix_mult_def zero_vec_def)
 
 lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
 lemma matrix_add_ldistrib: "(A ** (B + C)) = (A ** B) + (A ** C)"
   by (vector matrix_matrix_mult_def sum.distrib[symmetric] field_simps)
 
 lemma matrix_mul_lid [simp]:
   fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
   shows "mat 1 ** A = A"
   apply (simp add: matrix_matrix_mult_def mat_def)
   apply vector
   apply (auto simp only: if_distrib if_distribR sum.delta'[OF finite]
     mult_1_left mult_zero_left if_True UNIV_I)
   done
 
 lemma matrix_mul_rid [simp]:
   fixes A :: "'a::semiring_1 ^ 'm ^ 'n"
   shows "A ** mat 1 = A"
   apply (simp add: matrix_matrix_mult_def mat_def)
   apply vector
   apply (auto simp only: if_distrib if_distribR sum.delta[OF finite]
     mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
   done
 
 proposition matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
   apply (vector matrix_matrix_mult_def sum_distrib_left sum_distrib_right mult.assoc)
   apply (subst sum.swap)
   apply simp
   done
 
 proposition matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
   apply (vector matrix_matrix_mult_def matrix_vector_mult_def
     sum_distrib_left sum_distrib_right mult.assoc)
   apply (subst sum.swap)
   apply simp
   done
 
 proposition scalar_matrix_assoc:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   shows "k *\<^sub>R (A ** B) = (k *\<^sub>R A) ** B"
   by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff scaleR_sum_right)
 
 proposition matrix_scalar_ac:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   shows "A ** (k *\<^sub>R B) = k *\<^sub>R A ** B"
   by (simp add: matrix_matrix_mult_def sum_distrib_left mult_ac vec_eq_iff)
 
 lemma matrix_vector_mul_lid [simp]: "mat 1 *v x = (x::'a::semiring_1 ^ 'n)"
   apply (vector matrix_vector_mult_def mat_def)
   apply (simp add: if_distrib if_distribR cong del: if_weak_cong)
   done
 
 lemma matrix_transpose_mul:
     "transpose(A ** B) = transpose B ** transpose (A::'a::comm_semiring_1^_^_)"
   by (simp add: matrix_matrix_mult_def transpose_def vec_eq_iff mult.commute)
 
 lemma matrix_mult_transpose_dot_column:
   shows "transpose A ** A = (\<chi> i j. inner (column i A) (column j A))"
   by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def column_def inner_vec_def)
 
 lemma matrix_mult_transpose_dot_row:
   shows "A ** transpose A = (\<chi> i j. inner (row i A) (row j A))"
   by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def row_def inner_vec_def)
 
 lemma matrix_eq:
   fixes A B :: "'a::semiring_1 ^ 'n ^ 'm"
   shows "A = B \<longleftrightarrow>  (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
   apply auto
   apply (subst vec_eq_iff)
   apply clarify
   apply (clarsimp simp add: matrix_vector_mult_def if_distrib if_distribR vec_eq_iff cong del: if_weak_cong)
   apply (erule_tac x="axis ia 1" in allE)
   apply (erule_tac x="i" in allE)
   apply (auto simp add: if_distrib if_distribR axis_def
     sum.delta[OF finite] cong del: if_weak_cong)
   done
 
 lemma matrix_vector_mul_component: "(A *v x)$k = inner (A$k) x"
   by (simp add: matrix_vector_mult_def inner_vec_def)
 
 lemma dot_lmul_matrix: "inner ((x::real ^_) v* A) y = inner x (A *v y)"
   apply (simp add: inner_vec_def matrix_vector_mult_def vector_matrix_mult_def sum_distrib_right sum_distrib_left ac_simps)
   apply (subst sum.swap)
   apply simp
   done
 
 lemma transpose_mat [simp]: "transpose (mat n) = mat n"
   by (vector transpose_def mat_def)
 
 lemma transpose_transpose [simp]: "transpose(transpose A) = A"
   by (vector transpose_def)
 
 lemma row_transpose [simp]: "row i (transpose A) = column i A"
   by (simp add: row_def column_def transpose_def vec_eq_iff)
 
 lemma column_transpose [simp]: "column i (transpose A) = row i A"
   by (simp add: row_def column_def transpose_def vec_eq_iff)
 
 lemma rows_transpose [simp]: "rows(transpose A) = columns A"
   by (auto simp add: rows_def columns_def intro: set_eqI)
 
 lemma columns_transpose [simp]: "columns(transpose A) = rows A"
   by (metis transpose_transpose rows_transpose)
 
 lemma transpose_scalar: "transpose (k *\<^sub>R A) = k *\<^sub>R transpose A"
   unfolding transpose_def
   by (simp add: vec_eq_iff)
 
 lemma transpose_iff [iff]: "transpose A = transpose B \<longleftrightarrow> A = B"
   by (metis transpose_transpose)
 
 lemma matrix_mult_sum:
   "(A::'a::comm_semiring_1^'n^'m) *v x = sum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
   by (simp add: matrix_vector_mult_def vec_eq_iff column_def mult.commute)
 
 lemma vector_componentwise:
   "(x::'a::ring_1^'n) = (\<chi> j. \<Sum>i\<in>UNIV. (x$i) * (axis i 1 :: 'a^'n) $ j)"
   by (simp add: axis_def if_distrib sum.If_cases vec_eq_iff)
 
 lemma basis_expansion: "sum (\<lambda>i. (x$i) *s axis i 1) UNIV = (x::('a::ring_1) ^'n)"
   by (auto simp add: axis_def vec_eq_iff if_distrib sum.If_cases cong del: if_weak_cong)
 
 
 text\<open>Correspondence between matrices and linear operators.\<close>
 
 definition\<^marker>\<open>tag important\<close> matrix :: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
   where "matrix f = (\<chi> i j. (f(axis j 1))$i)"
 
 lemma matrix_id_mat_1: "matrix id = mat 1"
   by (simp add: mat_def matrix_def axis_def)
 
 lemma matrix_scaleR: "(matrix ((*\<^sub>R) r)) = mat r"
   by (simp add: mat_def matrix_def axis_def if_distrib cong: if_cong)
 
 lemma matrix_vector_mul_linear[intro, simp]: "linear (\<lambda>x. A *v (x::'a::real_algebra_1 ^ _))"
   by (simp add: linear_iff matrix_vector_mult_def vec_eq_iff field_simps sum_distrib_left
       sum.distrib scaleR_right.sum)
 
 lemma vector_matrix_left_distrib [algebra_simps]:
   shows "(x + y) v* A = x v* A + y v* A"
   unfolding vector_matrix_mult_def
   by (simp add: algebra_simps sum.distrib vec_eq_iff)
 
 lemma matrix_vector_right_distrib [algebra_simps]:
   "A *v (x + y) = A *v x + A *v y"
   by (vector matrix_vector_mult_def sum.distrib distrib_left)
 
 lemma matrix_vector_mult_diff_distrib [algebra_simps]:
   fixes A :: "'a::ring_1^'n^'m"
   shows "A *v (x - y) = A *v x - A *v y"
   by (vector matrix_vector_mult_def sum_subtractf right_diff_distrib)
 
 lemma matrix_vector_mult_scaleR[algebra_simps]:
   fixes A :: "real^'n^'m"
   shows "A *v (c *\<^sub>R x) = c *\<^sub>R (A *v x)"
   using linear_iff matrix_vector_mul_linear by blast
 
 lemma matrix_vector_mult_0_right [simp]: "A *v 0 = 0"
   by (simp add: matrix_vector_mult_def vec_eq_iff)
 
 lemma matrix_vector_mult_0 [simp]: "0 *v w = 0"
   by (simp add: matrix_vector_mult_def vec_eq_iff)
 
 lemma matrix_vector_mult_add_rdistrib [algebra_simps]:
   "(A + B) *v x = (A *v x) + (B *v x)"
   by (vector matrix_vector_mult_def sum.distrib distrib_right)
 
 lemma matrix_vector_mult_diff_rdistrib [algebra_simps]:
   fixes A :: "'a :: ring_1^'n^'m"
   shows "(A - B) *v x = (A *v x) - (B *v x)"
   by (vector matrix_vector_mult_def sum_subtractf left_diff_distrib)
 
 lemma matrix_vector_column:
   "(A::'a::comm_semiring_1^'n^_) *v x = sum (\<lambda>i. (x$i) *s ((transpose A)$i)) (UNIV:: 'n set)"
   by (simp add: matrix_vector_mult_def transpose_def vec_eq_iff mult.commute)
 
 subsection\<open>Inverse matrices  (not necessarily square)\<close>
 
 definition\<^marker>\<open>tag important\<close>
   "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
 
 definition\<^marker>\<open>tag important\<close>
   "matrix_inv(A:: 'a::semiring_1^'n^'m) =
     (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
 
 lemma inj_matrix_vector_mult:
   fixes A::"'a::field^'n^'m"
   assumes "invertible A"
   shows "inj ((*v) A)"
   by (metis assms inj_on_inverseI invertible_def matrix_vector_mul_assoc matrix_vector_mul_lid)
 
 lemma scalar_invertible:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   assumes "k \<noteq> 0" and "invertible A"
   shows "invertible (k *\<^sub>R A)"
 proof -
   obtain A' where "A ** A' = mat 1" and "A' ** A = mat 1"
     using assms unfolding invertible_def by auto
   with \<open>k \<noteq> 0\<close>
   have "(k *\<^sub>R A) ** ((1/k) *\<^sub>R A') = mat 1" "((1/k) *\<^sub>R A') ** (k *\<^sub>R A) = mat 1"
     by (simp_all add: assms matrix_scalar_ac)
   thus "invertible (k *\<^sub>R A)"
     unfolding invertible_def by auto
 qed
 
 proposition scalar_invertible_iff:
   fixes A :: "('a::real_algebra_1)^'m^'n"
   assumes "k \<noteq> 0" and "invertible A"
   shows "invertible (k *\<^sub>R A) \<longleftrightarrow> k \<noteq> 0 \<and> invertible A"
   by (simp add: assms scalar_invertible)
 
 lemma vector_transpose_matrix [simp]: "x v* transpose A = A *v x"
   unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   by simp
 
 lemma transpose_matrix_vector [simp]: "transpose A *v x = x v* A"
   unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   by simp
 
 lemma vector_scalar_commute:
   fixes A :: "'a::{field}^'m^'n"
   shows "A *v (c *s x) = c *s (A *v x)"
   by (simp add: vector_scalar_mult_def matrix_vector_mult_def mult_ac sum_distrib_left)
 
 lemma scalar_vector_matrix_assoc:
   fixes k :: "'a::{field}" and x :: "'a::{field}^'n" and A :: "'a^'m^'n"
   shows "(k *s x) v* A = k *s (x v* A)"
   by (metis transpose_matrix_vector vector_scalar_commute)
  
 lemma vector_matrix_mult_0 [simp]: "0 v* A = 0"
   unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
 
 lemma vector_matrix_mult_0_right [simp]: "x v* 0 = 0"
   unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
 
 lemma vector_matrix_mul_rid [simp]:
   fixes v :: "('a::semiring_1)^'n"
   shows "v v* mat 1 = v"
   by (metis matrix_vector_mul_lid transpose_mat vector_transpose_matrix)
 
 lemma scaleR_vector_matrix_assoc:
   fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   shows "(k *\<^sub>R x) v* A = k *\<^sub>R (x v* A)"
   by (metis matrix_vector_mult_scaleR transpose_matrix_vector)
 
 proposition vector_scaleR_matrix_ac:
   fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   shows "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
 proof -
   have "x v* (k *\<^sub>R A) = (k *\<^sub>R x) v* A"
     unfolding vector_matrix_mult_def
     by (simp add: algebra_simps)
   with scaleR_vector_matrix_assoc
   show "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
     by auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Further_Topology.thy b/src/HOL/Analysis/Further_Topology.thy
--- a/src/HOL/Analysis/Further_Topology.thy
+++ b/src/HOL/Analysis/Further_Topology.thy
@@ -1,5706 +1,5706 @@
 section \<open>Extending Continous Maps, Invariance of Domain, etc\<close> (*FIX rename? *)
 
 text\<open>Ported from HOL Light (moretop.ml) by L C Paulson\<close>
 
 theory Further_Topology
   imports Weierstrass_Theorems Polytope Complex_Transcendental Equivalence_Lebesgue_Henstock_Integration Retracts
 begin
 
 subsection\<open>A map from a sphere to a higher dimensional sphere is nullhomotopic\<close>
 
 lemma spheremap_lemma1:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "subspace S" "subspace T" and dimST: "dim S < dim T"
       and "S \<subseteq> T"
       and diff_f: "f differentiable_on sphere 0 1 \<inter> S"
     shows "f ` (sphere 0 1 \<inter> S) \<noteq> sphere 0 1 \<inter> T"
 proof
   assume fim: "f ` (sphere 0 1 \<inter> S) = sphere 0 1 \<inter> T"
   have inS: "\<And>x. \<lbrakk>x \<in> S; x \<noteq> 0\<rbrakk> \<Longrightarrow> (x /\<^sub>R norm x) \<in> S"
     using subspace_mul \<open>subspace S\<close> by blast
   have subS01: "(\<lambda>x. x /\<^sub>R norm x) ` (S - {0}) \<subseteq> sphere 0 1 \<inter> S"
     using \<open>subspace S\<close> subspace_mul by fastforce
   then have diff_f': "f differentiable_on (\<lambda>x. x /\<^sub>R norm x) ` (S - {0})"
     by (rule differentiable_on_subset [OF diff_f])
   define g where "g \<equiv> \<lambda>x. norm x *\<^sub>R f(inverse(norm x) *\<^sub>R x)"
   have gdiff: "g differentiable_on S - {0}"
     unfolding g_def
     by (rule diff_f' derivative_intros differentiable_on_compose [where f=f] | force)+
   have geq: "g ` (S - {0}) = T - {0}"
   proof
     have "\<And>u. \<lbrakk>u \<in> S; norm u *\<^sub>R f (u /\<^sub>R norm u) \<notin> T\<rbrakk> \<Longrightarrow> u = 0"
       by (metis (mono_tags, lifting) DiffI subS01 subspace_mul [OF \<open>subspace T\<close>] fim image_subset_iff inf_le2 singletonD)
     then have "g ` (S - {0}) \<subseteq> T"
       using g_def by blast
     moreover have "g ` (S - {0}) \<subseteq> UNIV - {0}"
     proof (clarsimp simp: g_def)
       fix y
       assume "y \<in> S" and f0: "f (y /\<^sub>R norm y) = 0"
       then have "y \<noteq> 0 \<Longrightarrow> y /\<^sub>R norm y \<in> sphere 0 1 \<inter> S"
         by (auto simp: subspace_mul [OF \<open>subspace S\<close>])
       then show "y = 0"
         by (metis fim f0 Int_iff image_iff mem_sphere_0 norm_eq_zero zero_neq_one)
     qed
     ultimately show "g ` (S - {0}) \<subseteq> T - {0}"
       by auto
   next
     have *: "sphere 0 1 \<inter> T \<subseteq> f ` (sphere 0 1 \<inter> S)"
       using fim by (simp add: image_subset_iff)
     have "x \<in> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
           if "x \<in> T" "x \<noteq> 0" for x
     proof -
       have "x /\<^sub>R norm x \<in> T"
         using \<open>subspace T\<close> subspace_mul that by blast
       then obtain u where u: "f u \<in> T" "x /\<^sub>R norm x = f u" "norm u = 1" "u \<in> S"
         using * [THEN subsetD, of "x /\<^sub>R norm x"] \<open>x \<noteq> 0\<close> by auto
       with that have [simp]: "norm x *\<^sub>R f u = x"
         by (metis divideR_right norm_eq_zero)
       moreover have "norm x *\<^sub>R u \<in> S - {0}"
         using \<open>subspace S\<close> subspace_scale that(2) u by auto
       with u show ?thesis
         by (simp add: image_eqI [where x="norm x *\<^sub>R u"])
     qed
     then have "T - {0} \<subseteq> (\<lambda>x. norm x *\<^sub>R f (x /\<^sub>R norm x)) ` (S - {0})"
       by force
     then show "T - {0} \<subseteq> g ` (S - {0})"
       by (simp add: g_def)
   qed
   define T' where "T' \<equiv> {y. \<forall>x \<in> T. orthogonal x y}"
   have "subspace T'"
     by (simp add: subspace_orthogonal_to_vectors T'_def)
   have dim_eq: "dim T' + dim T = DIM('a)"
     using dim_subspace_orthogonal_to_vectors [of T UNIV] \<open>subspace T\<close>
     by (simp add: T'_def)
   have "\<exists>v1 v2. v1 \<in> span T \<and> (\<forall>w \<in> span T. orthogonal v2 w) \<and> x = v1 + v2" for x
     by (force intro: orthogonal_subspace_decomp_exists [of T x])
   then obtain p1 p2 where p1span: "p1 x \<in> span T"
                       and "\<And>w. w \<in> span T \<Longrightarrow> orthogonal (p2 x) w"
                       and eq: "p1 x + p2 x = x" for x
     by metis
   then have p1: "\<And>z. p1 z \<in> T" and ortho: "\<And>w. w \<in> T \<Longrightarrow> orthogonal (p2 x) w" for x
     using span_eq_iff \<open>subspace T\<close> by blast+
   then have p2: "\<And>z. p2 z \<in> T'"
     by (simp add: T'_def orthogonal_commute)
   have p12_eq: "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p1(x + y) = x \<and> p2(x + y) = y"
   proof (rule orthogonal_subspace_decomp_unique [OF eq p1span, where T=T'])
     show "\<And>x y. \<lbrakk>x \<in> T; y \<in> T'\<rbrakk> \<Longrightarrow> p2 (x + y) \<in> span T'"
       using span_eq_iff p2 \<open>subspace T'\<close> by blast
     show "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
       using T'_def by blast
   qed (auto simp: span_base)
   then have "\<And>c x. p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
   proof -
     fix c :: real and x :: 'a
     have f1: "c *\<^sub>R x = c *\<^sub>R p1 x + c *\<^sub>R p2 x"
       by (metis eq pth_6)
     have f2: "c *\<^sub>R p2 x \<in> T'"
       by (simp add: \<open>subspace T'\<close> p2 subspace_scale)
     have "c *\<^sub>R p1 x \<in> T"
       by (metis (full_types) assms(2) p1span span_eq_iff subspace_scale)
     then show "p1 (c *\<^sub>R x) = c *\<^sub>R p1 x \<and> p2 (c *\<^sub>R x) = c *\<^sub>R p2 x"
       using f2 f1 p12_eq by presburger
   qed
   moreover have lin_add: "\<And>x y. p1 (x + y) = p1 x + p1 y \<and> p2 (x + y) = p2 x + p2 y"
   proof (rule orthogonal_subspace_decomp_unique [OF _ p1span, where T=T'])
     show "\<And>x y. p1 (x + y) + p2 (x + y) = p1 x + p1 y + (p2 x + p2 y)"
       by (simp add: add.assoc add.left_commute eq)
     show  "\<And>a b. \<lbrakk>a \<in> T; b \<in> T'\<rbrakk> \<Longrightarrow> orthogonal a b"
       using T'_def by blast
   qed (auto simp: p1span p2 span_base span_add)
   ultimately have "linear p1" "linear p2"
     by unfold_locales auto
   have "g differentiable_on p1 ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     using p12_eq \<open>S \<subseteq> T\<close>  by (force intro: differentiable_on_subset [OF gdiff])
   then have "(\<lambda>z. g (p1 z)) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (rule differentiable_on_compose [OF linear_imp_differentiable_on [OF \<open>linear p1\<close>]])
   then have diff: "(\<lambda>x. g (p1 x) + p2 x) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (intro derivative_intros linear_imp_differentiable_on [OF \<open>linear p2\<close>])
   have "dim {x + y |x y. x \<in> S - {0} \<and> y \<in> T'} \<le> dim {x + y |x y. x \<in> S  \<and> y \<in> T'}"
     by (blast intro: dim_subset)
   also have "... = dim S + dim T' - dim (S \<inter> T')"
     using dim_sums_Int [OF \<open>subspace S\<close> \<open>subspace T'\<close>]
     by (simp add: algebra_simps)
   also have "... < DIM('a)"
     using dimST dim_eq by auto
   finally have neg: "negligible {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     by (rule negligible_lowdim)
   have "negligible ((\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'})"
     by (rule negligible_differentiable_image_negligible [OF order_refl neg diff])
   then have "negligible {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   proof (rule negligible_subset)
     have "\<lbrakk>t' \<in> T'; s \<in> S; s \<noteq> 0\<rbrakk>
           \<Longrightarrow> g s + t' \<in> (\<lambda>x. g (p1 x) + p2 x) `
                          {x + t' |x t'. x \<in> S \<and> x \<noteq> 0 \<and> t' \<in> T'}" for t' s
       apply (rule_tac x="s + t'" in image_eqI)
       using \<open>S \<subseteq> T\<close> p12_eq by auto
     then show "{x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}
           \<subseteq> (\<lambda>x. g (p1 x) + p2 x) ` {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
       by auto
   qed
   moreover have "- T' \<subseteq> {x + y |x y. x \<in> g ` (S - {0}) \<and> y \<in> T'}"
   proof clarsimp
     fix z assume "z \<notin> T'"
     show "\<exists>x y. z = x + y \<and> x \<in> g ` (S - {0}) \<and> y \<in> T'"
       by (metis Diff_iff \<open>z \<notin> T'\<close> add.left_neutral eq geq p1 p2 singletonD)
   qed
   ultimately have "negligible (-T')"
     using negligible_subset by blast
   moreover have "negligible T'"
     using negligible_lowdim
     by (metis add.commute assms(3) diff_add_inverse2 diff_self_eq_0 dim_eq le_add1 le_antisym linordered_semidom_class.add_diff_inverse not_less0)
   ultimately have  "negligible (-T' \<union> T')"
     by (metis negligible_Un_eq)
   then show False
     using negligible_Un_eq non_negligible_UNIV by simp
 qed
 
 
 lemma spheremap_lemma2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes ST: "subspace S" "subspace T" "dim S < dim T"
       and "S \<subseteq> T"
       and contf: "continuous_on (sphere 0 1 \<inter> S) f"
       and fim: "f ` (sphere 0 1 \<inter> S) \<subseteq> sphere 0 1 \<inter> T"
     shows "\<exists>c. homotopic_with_canon (\<lambda>x. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) f (\<lambda>x. c)"
 proof -
   have [simp]: "\<And>x. \<lbrakk>norm x = 1; x \<in> S\<rbrakk> \<Longrightarrow> norm (f x) = 1"
     using fim by (simp add: image_subset_iff)
   have "compact (sphere 0 1 \<inter> S)"
     by (simp add: \<open>subspace S\<close> closed_subspace compact_Int_closed)
   then obtain g where pfg: "polynomial_function g" and gim: "g ` (sphere 0 1 \<inter> S) \<subseteq> T"
                 and g12: "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> norm(f x - g x) < 1/2"
     apply (rule Stone_Weierstrass_polynomial_function_subspace [OF _ contf _ \<open>subspace T\<close>, of "1/2"])
     using fim by auto
   have gnz: "g x \<noteq> 0" if "x \<in> sphere 0 1 \<inter> S" for x
   proof -
     have "norm (f x) = 1"
       using fim that by (simp add: image_subset_iff)
     then show ?thesis
       using g12 [OF that] by auto
   qed
   have diffg: "g differentiable_on sphere 0 1 \<inter> S"
     by (metis pfg differentiable_on_polynomial_function)
   define h where "h \<equiv> \<lambda>x. inverse(norm(g x)) *\<^sub>R g x"
   have h: "x \<in> sphere 0 1 \<inter> S \<Longrightarrow> h x \<in> sphere 0 1 \<inter> T" for x
     unfolding h_def
     using gnz [of x]
     by (auto simp: subspace_mul [OF \<open>subspace T\<close>] subsetD [OF gim])
   have diffh: "h differentiable_on sphere 0 1 \<inter> S"
     unfolding h_def using gnz
     by (fastforce intro: derivative_intros diffg differentiable_on_compose [OF diffg])
   have homfg: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) f g"
   proof (rule homotopic_with_linear [OF contf])
     show "continuous_on (sphere 0 1 \<inter> S) g"
       using pfg by (simp add: differentiable_imp_continuous_on diffg)
   next
     have non0fg: "0 \<notin> closed_segment (f x) (g x)" if "norm x = 1" "x \<in> S" for x
     proof -
       have "f x \<in> sphere 0 1"
         using fim that by (simp add: image_subset_iff)
       moreover have "norm(f x - g x) < 1/2"
         using g12 that by auto
       ultimately show ?thesis
         by (auto simp: norm_minus_commute dest: segment_bound)
     qed
     show "closed_segment (f x) (g x) \<subseteq> T - {0}" if "x \<in> sphere 0 1 \<inter> S" for x
     proof -
       have "convex T"
         by (simp add: \<open>subspace T\<close> subspace_imp_convex)
       then have "convex hull {f x, g x} \<subseteq> T"
         by (metis IntD2 closed_segment_subset fim gim image_subset_iff segment_convex_hull that)
       then show ?thesis
         using that non0fg segment_convex_hull by fastforce
     qed
   qed
   obtain d where d: "d \<in> (sphere 0 1 \<inter> T) - h ` (sphere 0 1 \<inter> S)"
     using h spheremap_lemma1 [OF ST \<open>S \<subseteq> T\<close> diffh] by force
   then have non0hd: "0 \<notin> closed_segment (h x) (- d)" if "norm x = 1" "x \<in> S" for x
     using midpoint_between [of 0 "h x" "-d"] that h [of x]
     by (auto simp: between_mem_segment midpoint_def)
   have conth: "continuous_on (sphere 0 1 \<inter> S) h"
     using differentiable_imp_continuous_on diffh by blast
   have hom_hd: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (T - {0}) h (\<lambda>x. -d)"
   proof (rule homotopic_with_linear [OF conth continuous_on_const])
     fix x
     assume x: "x \<in> sphere 0 1 \<inter> S"
     have "convex hull {h x, - d} \<subseteq> T"
     proof (rule hull_minimal)
       show "{h x, - d} \<subseteq> T"
         using h d x by (force simp: subspace_neg [OF \<open>subspace T\<close>])
     qed (simp add: subspace_imp_convex [OF \<open>subspace T\<close>])
     with x segment_convex_hull show "closed_segment (h x) (- d) \<subseteq> T - {0}"
       by (auto simp add: subset_Diff_insert non0hd)
   qed
   have conT0: "continuous_on (T - {0}) (\<lambda>y. inverse(norm y) *\<^sub>R y)"
     by (intro continuous_intros) auto
   have sub0T: "(\<lambda>y. y /\<^sub>R norm y) ` (T - {0}) \<subseteq> sphere 0 1 \<inter> T"
     by (fastforce simp: assms(2) subspace_mul)
   obtain c where homhc: "homotopic_with_canon (\<lambda>z. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) h (\<lambda>x. c)"
     apply (rule_tac c="-d" in that)
     apply (rule homotopic_with_eq)
        apply (rule homotopic_with_compose_continuous_left [OF hom_hd conT0 sub0T])
     using d apply (auto simp: h_def)
     done
   have "homotopic_with_canon (\<lambda>x. True) (sphere 0 1 \<inter> S) (sphere 0 1 \<inter> T) f h"
     apply (rule homotopic_with_eq [OF homotopic_with_compose_continuous_left [OF homfg conT0 sub0T]])
     by (auto simp: h_def)
   then show ?thesis
     by (metis homotopic_with_trans [OF _ homhc])
 qed
 
 
 lemma spheremap_lemma3:
   assumes "bounded S" "convex S" "subspace U" and affSU: "aff_dim S \<le> dim U"
   obtains T where "subspace T" "T \<subseteq> U" "S \<noteq> {} \<Longrightarrow> aff_dim T = aff_dim S"
                   "(rel_frontier S) homeomorphic (sphere 0 1 \<inter> T)"
 proof (cases "S = {}")
   case True
   with \<open>subspace U\<close> subspace_0 show ?thesis
     by (rule_tac T = "{0}" in that) auto
 next
   case False
   then obtain a where "a \<in> S"
     by auto
   then have affS: "aff_dim S = int (dim ((\<lambda>x. -a+x) ` S))"
     by (metis hull_inc aff_dim_eq_dim)
   with affSU have "dim ((\<lambda>x. -a+x) ` S) \<le> dim U"
     by linarith
   with choose_subspace_of_subspace
   obtain T where "subspace T" "T \<subseteq> span U" and dimT: "dim T = dim ((\<lambda>x. -a+x) ` S)" .
   show ?thesis
   proof (rule that [OF \<open>subspace T\<close>])
     show "T \<subseteq> U"
       using span_eq_iff \<open>subspace U\<close> \<open>T \<subseteq> span U\<close> by blast
     show "aff_dim T = aff_dim S"
       using dimT \<open>subspace T\<close> affS aff_dim_subspace by fastforce
     show "rel_frontier S homeomorphic sphere 0 1 \<inter> T"
     proof -
       have "aff_dim (ball 0 1 \<inter> T) = aff_dim (T)"
         by (metis IntI interior_ball \<open>subspace T\<close> aff_dim_convex_Int_nonempty_interior centre_in_ball empty_iff inf_commute subspace_0 subspace_imp_convex zero_less_one)
       then have affS_eq: "aff_dim S = aff_dim (ball 0 1 \<inter> T)"
         using \<open>aff_dim T = aff_dim S\<close> by simp
       have "rel_frontier S homeomorphic rel_frontier(ball 0 1 \<inter> T)"
       proof (rule homeomorphic_rel_frontiers_convex_bounded_sets [OF \<open>convex S\<close> \<open>bounded S\<close>])
         show "convex (ball 0 1 \<inter> T)"
           by (simp add: \<open>subspace T\<close> convex_Int subspace_imp_convex)
         show "bounded (ball 0 1 \<inter> T)"
           by (simp add: bounded_Int)
         show "aff_dim S = aff_dim (ball 0 1 \<inter> T)"
           by (rule affS_eq)
       qed
       also have "... = frontier (ball 0 1) \<inter> T"
       proof (rule convex_affine_rel_frontier_Int [OF convex_ball])
         show "affine T"
           by (simp add: \<open>subspace T\<close> subspace_imp_affine)
         show "interior (ball 0 1) \<inter> T \<noteq> {}"
           using \<open>subspace T\<close> subspace_0 by force
       qed
       also have "... = sphere 0 1 \<inter> T"
         by auto
       finally show ?thesis .
     qed
   qed
 qed
 
 
 proposition inessential_spheremap_lowdim_gen:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "convex S" "bounded S" "convex T" "bounded T"
       and affST: "aff_dim S < aff_dim T"
       and contf: "continuous_on (rel_frontier S) f"
       and fim: "f ` (rel_frontier S) \<subseteq> rel_frontier T"
   obtains c where "homotopic_with_canon (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: that)
 next
   case False
   then show ?thesis
   proof (cases "T = {}")
     case True
     then show ?thesis
       using fim that by auto
   next
     case False
     obtain T':: "'a set"
       where "subspace T'" and affT': "aff_dim T' = aff_dim T"
         and homT: "rel_frontier T homeomorphic sphere 0 1 \<inter> T'"
       apply (rule spheremap_lemma3 [OF \<open>bounded T\<close> \<open>convex T\<close> subspace_UNIV, where 'b='a])
        apply (simp add: aff_dim_le_DIM)
       using \<open>T \<noteq> {}\<close> by blast
     with homeomorphic_imp_homotopy_eqv
     have relT: "sphere 0 1 \<inter> T'  homotopy_eqv rel_frontier T"
       using homotopy_equivalent_space_sym by blast
     have "aff_dim S \<le> int (dim T')"
       using affT' \<open>subspace T'\<close> affST aff_dim_subspace by force
     with spheremap_lemma3 [OF \<open>bounded S\<close> \<open>convex S\<close> \<open>subspace T'\<close>] \<open>S \<noteq> {}\<close>
     obtain S':: "'a set" where "subspace S'" "S' \<subseteq> T'"
        and affS': "aff_dim S' = aff_dim S"
        and homT: "rel_frontier S homeomorphic sphere 0 1 \<inter> S'"
         by metis
     with homeomorphic_imp_homotopy_eqv
     have relS: "sphere 0 1 \<inter> S'  homotopy_eqv rel_frontier S"
       using homotopy_equivalent_space_sym by blast
     have dimST': "dim S' < dim T'"
       by (metis \<open>S' \<subseteq> T'\<close> \<open>subspace S'\<close> \<open>subspace T'\<close> affS' affST affT' less_irrefl not_le subspace_dim_equal)
     have "\<exists>c. homotopic_with_canon (\<lambda>z. True) (rel_frontier S) (rel_frontier T) f (\<lambda>x. c)"
       apply (rule homotopy_eqv_homotopic_triviality_null_imp [OF relT contf fim])
       apply (rule homotopy_eqv_cohomotopic_triviality_null[OF relS, THEN iffD1, rule_format])
        apply (metis dimST' \<open>subspace S'\<close>  \<open>subspace T'\<close>  \<open>S' \<subseteq> T'\<close> spheremap_lemma2, blast)
       done
     with that show ?thesis by blast
   qed
 qed
 
 lemma inessential_spheremap_lowdim:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes
    "DIM('M) < DIM('a)" and f: "continuous_on (sphere a r) f" "f ` (sphere a r) \<subseteq> (sphere b s)"
    obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
 proof (cases "s \<le> 0")
   case True then show ?thesis
     by (meson nullhomotopic_into_contractible f contractible_sphere that)
 next
   case False
   show ?thesis
   proof (cases "r \<le> 0")
     case True then show ?thesis
       by (meson f nullhomotopic_from_contractible contractible_sphere that)
   next
     case False
     with \<open>\<not> s \<le> 0\<close> have "r > 0" "s > 0" by auto
     show thesis
       apply (rule inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
       using  \<open>0 < r\<close> \<open>0 < s\<close> assms(1) that
       by (simp_all add: f aff_dim_cball inessential_spheremap_lowdim_gen [of "cball a r" "cball b s" f])
   qed
 qed
 
 
 
 subsection\<open> Some technical lemmas about extending maps from cell complexes\<close>
 
 lemma extending_maps_Union_aux:
   assumes fin: "finite \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
       and "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>; S \<noteq> T\<rbrakk> \<Longrightarrow> S \<inter> T \<subseteq> K"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
    shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
 using assms
 proof (induction \<F>)
   case empty show ?case by simp
 next
   case (insert S \<F>)
   then obtain f where contf: "continuous_on (S) f" and fim: "f ` S \<subseteq> T" and feq: "\<forall>x \<in> S \<inter> K. f x = h x"
     by (meson insertI1)
   obtain g where contg: "continuous_on (\<Union>\<F>) g" and gim: "g ` \<Union>\<F> \<subseteq> T" and geq: "\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x"
     using insert by auto
   have fg: "f x = g x" if "x \<in> T" "T \<in> \<F>" "x \<in> S" for x T
   proof -
     have "T \<inter> S \<subseteq> K \<or> S = T"
       using that by (metis (no_types) insert.prems(2) insertCI)
     then show ?thesis
       using UnionI feq geq \<open>S \<notin> \<F>\<close> subsetD that by fastforce
   qed
   show ?case
     apply (rule_tac x="\<lambda>x. if x \<in> S then f x else g x" in exI, simp)
     apply (intro conjI continuous_on_cases)
     using fim gim feq geq
     apply (force simp: insert closed_Union contf contg inf_commute intro: fg)+
     done
 qed
 
 lemma extending_maps_Union:
   assumes fin: "finite \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>g. continuous_on S g \<and> g ` S \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
       and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
     shows "\<exists>g. continuous_on (\<Union>\<F>) g \<and> g ` (\<Union>\<F>) \<subseteq> T \<and> (\<forall>x \<in> \<Union>\<F> \<inter> K. g x = h x)"
 apply (simp add: Union_maximal_sets [OF fin, symmetric])
 apply (rule extending_maps_Union_aux)
 apply (simp_all add: Union_maximal_sets [OF fin] assms)
 by (metis K psubsetI)
 
 
 lemma extend_map_lemma:
   assumes "finite \<F>" "\<G> \<subseteq> \<F>" "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X < aff_dim T"
       and face: "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S"
       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
   obtains g where "continuous_on (\<Union>\<F>) g" "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
 proof (cases "\<F> - \<G> = {}")
   case True
   show ?thesis
   proof
     show "continuous_on (\<Union> \<F>) f"
       using True \<open>\<G> \<subseteq> \<F>\<close> contf by auto
     show "f ` \<Union> \<F> \<subseteq> rel_frontier T"
       using True fim by auto
   qed auto
 next
   case False
   then have "0 \<le> aff_dim T"
     by (metis aff aff_dim_empty aff_dim_geq aff_dim_negative_iff all_not_in_conv not_less)
   then obtain i::nat where i: "int i = aff_dim T"
     by (metis nonneg_eq_int)
   have Union_empty_eq: "\<Union>{D. D = {} \<and> P D} = {}" for P :: "'a set \<Rightarrow> bool"
     by auto
   have face': "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
     by (metis face inf_commute)
   have extendf: "\<exists>g. continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) g \<and>
                      g ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i})) \<subseteq> rel_frontier T \<and>
                      (\<forall>x \<in> \<Union>\<G>. g x = f x)"
        if "i \<le> aff_dim T" for i::nat
   using that
   proof (induction i)
     case 0
     show ?case
       using 0 contf fim by (auto simp add: Union_empty_eq)
   next
     case (Suc p)
     with \<open>bounded T\<close> have "rel_frontier T \<noteq> {}"
       by (auto simp: rel_frontier_eq_empty affine_bounded_eq_lowdim [of T])
     then obtain t where t: "t \<in> rel_frontier T" by auto
     have ple: "int p \<le> aff_dim T" using Suc.prems by force
     obtain h where conth: "continuous_on (\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})) h"
                and him: "h ` (\<Union> (\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}))
                          \<subseteq> rel_frontier T"
                and heq: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x"
       using Suc.IH [OF ple] by auto
     let ?Faces = "{D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D \<le> p}"
     have extendh: "\<exists>g. continuous_on D g \<and>
                        g ` D \<subseteq> rel_frontier T \<and>
                        (\<forall>x \<in> D \<inter> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
       if D: "D \<in> \<G> \<union> ?Faces" for D
     proof (cases "D \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p})")
       case True
       have "continuous_on D h"
         using True conth continuous_on_subset by blast
       moreover have "h ` D \<subseteq> rel_frontier T"
         using True him by blast
       ultimately show ?thesis
         by blast
     next
       case False
       note notDsub = False
       show ?thesis
       proof (cases "\<exists>a. D = {a}")
         case True
         then obtain a where "D = {a}" by auto
         with notDsub t show ?thesis
           by (rule_tac x="\<lambda>x. t" in exI) simp
       next
         case False
         have "D \<noteq> {}" using notDsub by auto
         have Dnotin: "D \<notin> \<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
           using notDsub by auto
         then have "D \<notin> \<G>" by simp
         have "D \<in> ?Faces - {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < p}"
           using Dnotin that by auto
         then obtain C where "C \<in> \<F>" "D face_of C" and affD: "aff_dim D = int p"
           by auto
         then have "bounded D"
           using face_of_polytope_polytope poly polytope_imp_bounded by blast
         then have [simp]: "\<not> affine D"
           using affine_bounded_eq_trivial False \<open>D \<noteq> {}\<close> \<open>bounded D\<close> by blast
         have "{F. F facet_of D} \<subseteq> {E. E face_of C \<and> aff_dim E < int p}"
           by clarify (metis \<open>D face_of C\<close> affD eq_iff face_of_trans facet_of_def zle_diff1_eq)
         moreover have "polyhedron D"
           using \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face_of_polytope_polytope poly polytope_imp_polyhedron by auto
         ultimately have relf_sub: "rel_frontier D \<subseteq> \<Union> {E. E face_of C \<and> aff_dim E < p}"
           by (simp add: rel_frontier_of_polyhedron Union_mono)
         then have him_relf: "h ` rel_frontier D \<subseteq> rel_frontier T"
           using \<open>C \<in> \<F>\<close> him by blast
         have "convex D"
           by (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex)
         have affD_lessT: "aff_dim D < aff_dim T"
           using Suc.prems affD by linarith
         have contDh: "continuous_on (rel_frontier D) h"
           using \<open>C \<in> \<F>\<close> relf_sub by (blast intro: continuous_on_subset [OF conth])
         then have *: "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (rel_frontier D) (rel_frontier T) h (\<lambda>x. c)) =
                       (\<exists>g. continuous_on UNIV g \<and>  range g \<subseteq> rel_frontier T \<and>
                            (\<forall>x\<in>rel_frontier D. g x = h x))"
           apply (rule nullhomotopic_into_rel_frontier_extension [OF closed_rel_frontier])
           apply (simp_all add: assms rel_frontier_eq_empty him_relf)
           done
         have "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (rel_frontier D)
               (rel_frontier T) h (\<lambda>x. c))"
           by (metis inessential_spheremap_lowdim_gen
                  [OF \<open>convex D\<close> \<open>bounded D\<close> \<open>convex T\<close> \<open>bounded T\<close> affD_lessT contDh him_relf])
         then obtain g where contg: "continuous_on UNIV g"
                         and gim: "range g \<subseteq> rel_frontier T"
                         and gh: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> g x = h x"
           by (metis *)
         have "D \<inter> E \<subseteq> rel_frontier D"
              if "E \<in> \<G> \<union> {D. Bex \<F> ((face_of) D) \<and> aff_dim D < int p}" for E
         proof (rule face_of_subset_rel_frontier)
           show "D \<inter> E face_of D"
             using that
           proof safe
             assume "E \<in> \<G>"
             then show "D \<inter> E face_of D"
               by (meson \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> assms(2) face' face_of_Int_subface face_of_refl_eq poly polytope_imp_convex subsetD)
           next
             fix x
             assume "aff_dim E < int p" "x \<in> \<F>" "E face_of x"
             then show "D \<inter> E face_of D"
               by (meson \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face' face_of_Int_subface that)
           qed
           show "D \<inter> E \<noteq> D"
             using that notDsub by auto
         qed
         moreover have "continuous_on D g"
           using contg continuous_on_subset by blast
         ultimately show ?thesis
           by (rule_tac x=g in exI) (use gh gim in fastforce)
       qed
     qed
     have intle: "i < 1 + int j \<longleftrightarrow> i \<le> int j" for i j
       by auto
     have "finite \<G>"
       using \<open>finite \<F>\<close> \<open>\<G> \<subseteq> \<F>\<close> rev_finite_subset by blast
     moreover have "finite (?Faces)"
     proof -
       have \<section>: "finite (\<Union> {{D. D face_of C} |C. C \<in> \<F>})"
         by (auto simp: \<open>finite \<F>\<close> finite_polytope_faces poly)
       show ?thesis
         by (auto intro: finite_subset [OF _ \<section>])
     qed
     ultimately have fin: "finite (\<G> \<union> ?Faces)"
       by simp
     have clo: "closed S" if "S \<in> \<G> \<union> ?Faces" for S
       using that \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly polytope_imp_closed by blast
     have K: "X \<inter> Y \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int p})"
                 if "X \<in> \<G> \<union> ?Faces" "Y \<in> \<G> \<union> ?Faces" "\<not> Y \<subseteq> X" for X Y
     proof -
       have ff: "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
         if XY: "X face_of D" "Y face_of E" and DE: "D \<in> \<F>" "E \<in> \<F>" for D E
         by (rule face_of_Int_subface [OF _ _ XY]) (auto simp: face' DE)
       show ?thesis
         using that
         apply auto
         apply (drule_tac x="X \<inter> Y" in spec, safe)
         using ff face_of_imp_convex [of X] face_of_imp_convex [of Y]
         apply (fastforce dest: face_of_aff_dim_lt)
         by (meson face_of_trans ff)
     qed
     obtain g where "continuous_on (\<Union>(\<G> \<union> ?Faces)) g"
                    "g ` \<Union>(\<G> \<union> ?Faces) \<subseteq> rel_frontier T"
                    "(\<forall>x \<in> \<Union>(\<G> \<union> ?Faces) \<inter>
                           \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < p}). g x = h x)"
       by (rule exE [OF extending_maps_Union [OF fin extendh clo K]], blast+)
     then show ?case
       by (simp add: intle local.heq [symmetric], blast)
   qed
   have eq: "\<Union>(\<G> \<union> {D. \<exists>C \<in> \<F>. D face_of C \<and> aff_dim D < i}) = \<Union>\<F>"
   proof
     show "\<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int i}) \<subseteq> \<Union>\<F>"
       using \<open>\<G> \<subseteq> \<F>\<close> face_of_imp_subset by fastforce
     show "\<Union>\<F> \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < i})"
     proof (rule Union_mono)
       show "\<F> \<subseteq> \<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < int i}"
         using face by (fastforce simp: aff i)
     qed
   qed
   have "int i \<le> aff_dim T" by (simp add: i)
   then show ?thesis
     using extendf [of i] unfolding eq by (metis that)
 qed
 
 lemma extend_map_lemma_cofinite0:
   assumes "finite \<F>"
       and "pairwise (\<lambda>S T. S \<inter> T \<subseteq> K) \<F>"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
     shows "\<exists>C g. finite C \<and> disjnt C U \<and> card C \<le> card \<F> \<and>
                  continuous_on (\<Union>\<F> - C) g \<and> g ` (\<Union>\<F> - C) \<subseteq> T
                   \<and> (\<forall>x \<in> (\<Union>\<F> - C) \<inter> K. g x = h x)"
   using assms
 proof induction
   case empty then show ?case
     by force
 next
   case (insert X \<F>)
   then have "closed X" and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
         and \<F>: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (S - {a}) g \<and> g ` (S - {a}) \<subseteq> T \<and> (\<forall>x \<in> S \<inter> K. g x = h x)"
         and pwX: "\<And>Y. Y \<in> \<F> \<and> Y \<noteq> X \<longrightarrow> X \<inter> Y \<subseteq> K \<and> Y \<inter> X \<subseteq> K"
         and pwF: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) \<F>"
     by (simp_all add: pairwise_insert)
   obtain C g where C: "finite C" "disjnt C U" "card C \<le> card \<F>"
                and contg: "continuous_on (\<Union>\<F> - C) g"
                and gim: "g ` (\<Union>\<F> - C) \<subseteq> T"
                and gh:  "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
     using insert.IH [OF pwF \<F> clo] by auto
   obtain a f where "a \<notin> U"
                and contf: "continuous_on (X - {a}) f"
                and fim: "f ` (X - {a}) \<subseteq> T"
                and fh: "(\<forall>x \<in> X \<inter> K. f x = h x)"
     using insert.prems by (meson insertI1)
   show ?case
   proof (intro exI conjI)
     show "finite (insert a C)"
       by (simp add: C)
     show "disjnt (insert a C) U"
       using C \<open>a \<notin> U\<close> by simp
     show "card (insert a C) \<le> card (insert X \<F>)"
       by (simp add: C card_insert_if insert.hyps le_SucI)
     have "closed (\<Union>\<F>)"
       using clo insert.hyps by blast
     have "continuous_on (X - insert a C) f"
       using contf by (force simp: elim: continuous_on_subset)
     moreover have "continuous_on (\<Union> \<F> - insert a C) g"
       using contg by (force simp: elim: continuous_on_subset)
     ultimately
     have "continuous_on (X - insert a C \<union> (\<Union>\<F> - insert a C)) (\<lambda>x. if x \<in> X then f x else g x)"
       apply (intro continuous_on_cases_local; simp add: closedin_closed)
         using \<open>closed X\<close> apply blast
         using \<open>closed (\<Union>\<F>)\<close> apply blast
         using fh gh insert.hyps pwX by fastforce
     then show "continuous_on (\<Union>(insert X \<F>) - insert a C) (\<lambda>a. if a \<in> X then f a else g a)"
       by (blast intro: continuous_on_subset)
     show "\<forall>x\<in>(\<Union>(insert X \<F>) - insert a C) \<inter> K. (if x \<in> X then f x else g x) = h x"
       using gh by (auto simp: fh)
     show "(\<lambda>a. if a \<in> X then f a else g a) ` (\<Union>(insert X \<F>) - insert a C) \<subseteq> T"
       using fim gim by auto force
   qed
 qed
 
 
 lemma extend_map_lemma_cofinite1:
 assumes "finite \<F>"
     and \<F>: "\<And>X. X \<in> \<F> \<Longrightarrow> \<exists>a g. a \<notin> U \<and> continuous_on (X - {a}) g \<and> g ` (X - {a}) \<subseteq> T \<and> (\<forall>x \<in> X \<inter> K. g x = h x)"
     and clo: "\<And>X. X \<in> \<F> \<Longrightarrow> closed X"
     and K: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>; \<not> X \<subseteq> Y; \<not> Y \<subseteq> X\<rbrakk> \<Longrightarrow> X \<inter> Y \<subseteq> K"
   obtains C g where "finite C" "disjnt C U" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
                     "g ` (\<Union>\<F> - C) \<subseteq> T"
                     "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> K \<Longrightarrow> g x = h x"
 proof -
   let ?\<F> = "{X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y}"
   have [simp]: "\<Union>?\<F> = \<Union>\<F>"
     by (simp add: Union_maximal_sets assms)
   have fin: "finite ?\<F>"
     by (force intro: finite_subset [OF _ \<open>finite \<F>\<close>])
   have pw: "pairwise (\<lambda> S T. S \<inter> T \<subseteq> K) ?\<F>"
     by (simp add: pairwise_def) (metis K psubsetI)
   have "card {X \<in> \<F>. \<forall>Y\<in>\<F>. \<not> X \<subset> Y} \<le> card \<F>"
     by (simp add: \<open>finite \<F>\<close> card_mono)
   moreover
   obtain C g where "finite C \<and> disjnt C U \<and> card C \<le> card ?\<F> \<and>
                  continuous_on (\<Union>?\<F> - C) g \<and> g ` (\<Union>?\<F> - C) \<subseteq> T
                   \<and> (\<forall>x \<in> (\<Union>?\<F> - C) \<inter> K. g x = h x)"
     using extend_map_lemma_cofinite0 [OF fin pw, of U T h] by (fastforce intro!: clo \<F>)
   ultimately show ?thesis
     by (rule_tac C=C and g=g in that) auto
 qed
 
 
 lemma extend_map_lemma_cofinite:
   assumes "finite \<F>" "\<G> \<subseteq> \<F>" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and contf: "continuous_on (\<Union>\<G>) f" and fim: "f ` (\<Union>\<G>) \<subseteq> rel_frontier T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and aff: "\<And>X. X \<in> \<F> - \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
   obtains C g where
      "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
      "g ` (\<Union> \<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> g x = f x"
 proof -
   define \<H> where "\<H> \<equiv> \<G> \<union> {D. \<exists>C \<in> \<F> - \<G>. D face_of C \<and> aff_dim D < aff_dim T}"
   have "finite \<G>"
     using assms finite_subset by blast
   have *: "finite (\<Union>{{D. D face_of C} |C. C \<in> \<F>})"
     using finite_polytope_faces poly \<open>finite \<F>\<close> by force
   then have "finite \<H>"
     by (auto simp: \<H>_def \<open>finite \<G>\<close> intro: finite_subset [OF _ *])
   have face': "\<And>S T. \<lbrakk>S \<in> \<F>; T \<in> \<F>\<rbrakk> \<Longrightarrow> (S \<inter> T) face_of S \<and> (S \<inter> T) face_of T"
     by (metis face inf_commute)
   have *: "\<And>X Y. \<lbrakk>X \<in> \<H>; Y \<in> \<H>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
     unfolding \<H>_def
     using subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] apply (auto simp add: face)
     apply (meson face' face_of_Int_subface face_of_refl_eq poly polytope_imp_convex)+
     done
   obtain h where conth: "continuous_on (\<Union>\<H>) h" and him: "h ` (\<Union>\<H>) \<subseteq> rel_frontier T"
              and hf: "\<And>x. x \<in> \<Union>\<G> \<Longrightarrow> h x = f x" 
   proof (rule extend_map_lemma [OF \<open>finite \<H>\<close> [unfolded \<H>_def] Un_upper1 T])
     show "\<And>X. \<lbrakk>X \<in> \<G> \<union> {D. \<exists>C\<in>\<F> - \<G>. D face_of C \<and> aff_dim D < aff_dim T}\<rbrakk> \<Longrightarrow> polytope X"
       using \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly by fastforce
   qed (use * \<H>_def contf fim in auto)
   have "bounded (\<Union>\<G>)"
     using \<open>finite \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> poly polytope_imp_bounded by blast
   then have "\<Union>\<G> \<noteq> UNIV"
     by auto
   then obtain a where a: "a \<notin> \<Union>\<G>"
     by blast
   have \<F>: "\<exists>a g. a \<notin> \<Union>\<G> \<and> continuous_on (D - {a}) g \<and>
                   g ` (D - {a}) \<subseteq> rel_frontier T \<and> (\<forall>x \<in> D \<inter> \<Union>\<H>. g x = h x)"
        if "D \<in> \<F>" for D
   proof (cases "D \<subseteq> \<Union>\<H>")
     case True
     then show ?thesis
       apply (rule_tac x=a in exI)
       apply (rule_tac x=h in exI)
       using him apply (blast intro!: \<open>a \<notin> \<Union>\<G>\<close> continuous_on_subset [OF conth]) +
       done
   next
     case False
     note D_not_subset = False
     show ?thesis
     proof (cases "D \<in> \<G>")
       case True
       with D_not_subset show ?thesis
         by (auto simp: \<H>_def)
     next
       case False
       then have affD: "aff_dim D \<le> aff_dim T"
         by (simp add: \<open>D \<in> \<F>\<close> aff)
       show ?thesis
       proof (cases "rel_interior D = {}")
         case True
         with \<open>D \<in> \<F>\<close> poly a show ?thesis
           by (force simp: rel_interior_eq_empty polytope_imp_convex)
       next
         case False
         then obtain b where brelD: "b \<in> rel_interior D"
           by blast
         have "polyhedron D"
           by (simp add: poly polytope_imp_polyhedron that)
         have "rel_frontier D retract_of affine hull D - {b}"
           by (simp add: rel_frontier_retract_of_punctured_affine_hull poly polytope_imp_bounded polytope_imp_convex that brelD)
         then obtain r where relfD: "rel_frontier D \<subseteq> affine hull D - {b}"
                         and contr: "continuous_on (affine hull D - {b}) r"
                         and rim: "r ` (affine hull D - {b}) \<subseteq> rel_frontier D"
                         and rid: "\<And>x. x \<in> rel_frontier D \<Longrightarrow> r x = x"
           by (auto simp: retract_of_def retraction_def)
         show ?thesis
         proof (intro exI conjI ballI)
           show "b \<notin> \<Union>\<G>"
           proof clarify
             fix E
             assume "b \<in> E" "E \<in> \<G>"
             then have "E \<inter> D face_of E \<and> E \<inter> D face_of D"
               using \<open>\<G> \<subseteq> \<F>\<close> face' that by auto
             with face_of_subset_rel_frontier \<open>E \<in> \<G>\<close> \<open>b \<in> E\<close> brelD rel_interior_subset [of D]
                  D_not_subset rel_frontier_def \<H>_def
             show False
               by blast
           qed
           have "r ` (D - {b}) \<subseteq> r ` (affine hull D - {b})"
             by (simp add: Diff_mono hull_subset image_mono)
           also have "... \<subseteq> rel_frontier D"
             by (rule rim)
           also have "... \<subseteq> \<Union>{E. E face_of D \<and> aff_dim E < aff_dim T}"
             using affD
             by (force simp: rel_frontier_of_polyhedron [OF \<open>polyhedron D\<close>] facet_of_def)
           also have "... \<subseteq> \<Union>(\<H>)"
             using D_not_subset \<H>_def that by fastforce
           finally have rsub: "r ` (D - {b}) \<subseteq> \<Union>(\<H>)" .
           show "continuous_on (D - {b}) (h \<circ> r)"
             apply (intro conjI \<open>b \<notin> \<Union>\<G>\<close> continuous_on_compose)
                apply (rule continuous_on_subset [OF contr])
             apply (simp add: Diff_mono hull_subset)
             apply (rule continuous_on_subset [OF conth rsub])
             done
           show "(h \<circ> r) ` (D - {b}) \<subseteq> rel_frontier T"
             using brelD him rsub by fastforce
           show "(h \<circ> r) x = h x" if x: "x \<in> D \<inter> \<Union>\<H>" for x
           proof -
             consider A where "x \<in> D" "A \<in> \<G>" "x \<in> A"
                  | A B where "x \<in> D" "A face_of B" "B \<in> \<F>" "B \<notin> \<G>" "aff_dim A < aff_dim T" "x \<in> A"
               using x by (auto simp: \<H>_def)
             then have xrel: "x \<in> rel_frontier D"
             proof cases
               case 1 show ?thesis
               proof (rule face_of_subset_rel_frontier [THEN subsetD])
                 show "D \<inter> A face_of D"
                   using \<open>A \<in> \<G>\<close> \<open>\<G> \<subseteq> \<F>\<close> face \<open>D \<in> \<F>\<close> by blast
                 show "D \<inter> A \<noteq> D"
                   using \<open>A \<in> \<G>\<close> D_not_subset \<H>_def by blast
               qed (auto simp: 1)
             next
               case 2 show ?thesis
               proof (rule face_of_subset_rel_frontier [THEN subsetD])
                 have "D face_of D"
                   by (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex face_of_refl)
                 then show "D \<inter> A face_of D"
                   by (meson "2"(2) "2"(3) \<open>D \<in> \<F>\<close> face' face_of_Int_Int face_of_face)
                 show "D \<inter> A \<noteq> D"
                   using "2" D_not_subset \<H>_def by blast
               qed (auto simp: 2)
             qed
             show ?thesis
               by (simp add: rid xrel)
           qed
         qed
       qed
     qed
   qed
   have clo: "\<And>S. S \<in> \<F> \<Longrightarrow> closed S"
     by (simp add: poly polytope_imp_closed)
   obtain C g where "finite C" "disjnt C (\<Union>\<G>)" "card C \<le> card \<F>" "continuous_on (\<Union>\<F> - C) g"
                    "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
                and gh: "\<And>x. x \<in> (\<Union>\<F> - C) \<inter> \<Union>\<H> \<Longrightarrow> g x = h x"
   proof (rule extend_map_lemma_cofinite1 [OF \<open>finite \<F>\<close> \<F> clo])
     show "X \<inter> Y \<subseteq> \<Union>\<H>" if XY: "X \<in> \<F>" "Y \<in> \<F>" and "\<not> X \<subseteq> Y" "\<not> Y \<subseteq> X" for X Y
     proof (cases "X \<in> \<G>")
       case True
       then show ?thesis
         by (auto simp: \<H>_def)
     next
       case False
       have "X \<inter> Y \<noteq> X"
         using \<open>\<not> X \<subseteq> Y\<close> by blast
       with XY
       show ?thesis
         by (clarsimp simp: \<H>_def)
            (metis Diff_iff Int_iff aff antisym_conv face face_of_aff_dim_lt face_of_refl
                   not_le poly polytope_imp_convex)
     qed
   qed (blast)+
   with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis
     apply (rule_tac C=C and g=g in that)
      apply (auto simp: disjnt_def hf [symmetric] \<H>_def intro!: gh)
     done
 qed
 
 text\<open>The next two proofs are similar\<close>
 theorem extend_map_cell_complex_to_sphere:
   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X < aff_dim T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   obtains g where "continuous_on (\<Union>\<F>) g"
      "g ` (\<Union>\<F>) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   have "compact S"
     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
   proof (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly _ face])
     show "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T - 1"
       by (simp add: aff)
   qed auto
   obtain h where conth: "continuous_on (\<Union>\<G>) h" and him: "h ` \<Union>\<G> \<subseteq> rel_frontier T" and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   proof (rule extend_map_lemma [of \<G> "\<G> \<inter> Pow V" T g])
     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
   qed (use \<open>finite \<G>\<close> T polyG affG faceG gim in fastforce)+
   show ?thesis
   proof
     show "continuous_on (\<Union>\<F>) h"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
     show "h ` \<Union>\<F> \<subseteq> rel_frontier T"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
     show "h x = f x" if "x \<in> S" for x
     proof -
       have "x \<in> \<Union>\<G>"
         using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> that by auto
       then obtain X where "x \<in> X" "X \<in> \<G>" by blast
       then have "diameter X < d" "bounded X"
         by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
       then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
         by fastforce
       have "h x = g x"
         apply (rule hg)
         using \<open>X \<in> \<G>\<close> \<open>X \<subseteq> V\<close> \<open>x \<in> X\<close> by blast
       also have "... = f x"
         by (simp add: gf that)
       finally show "h x = f x" .
     qed
   qed
 qed
 
 
 theorem extend_map_cell_complex_to_sphere_cofinite:
   assumes "finite \<F>" and S: "S \<subseteq> \<Union>\<F>" "closed S" and T: "convex T" "bounded T"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> aff_dim T"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> rel_frontier T"
   obtains C g where "finite C" "disjnt C S" "continuous_on (\<Union>\<F> - C) g"
      "g ` (\<Union>\<F> - C) \<subseteq> rel_frontier T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain V g where "S \<subseteq> V" "open V" "continuous_on V g" and gim: "g ` V \<subseteq> rel_frontier T" and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     using neighbourhood_extension_into_ANR [OF contf fim _ \<open>closed S\<close>] ANR_rel_frontier_convex T by blast
   have "compact S"
     by (meson assms compact_Union poly polytope_imp_compact seq_compact_closed_subset seq_compact_eq_compact)
   then obtain d where "d > 0" and d: "\<And>x y. \<lbrakk>x \<in> S; y \<in> - V\<rbrakk> \<Longrightarrow> d \<le> dist x y"
     using separate_compact_closed [of S "-V"] \<open>open V\<close> \<open>S \<subseteq> V\<close> by force
   obtain \<G> where "finite \<G>" "\<Union>\<G> = \<Union>\<F>"
              and diaG: "\<And>X. X \<in> \<G> \<Longrightarrow> diameter X < d"
              and polyG: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
              and affG: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> aff_dim T"
              and faceG: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
     by (rule cell_complex_subdivision_exists [OF \<open>d>0\<close> \<open>finite \<F>\<close> poly aff face]) auto
   obtain C h where "finite C" and dis: "disjnt C (\<Union>(\<G> \<inter> Pow V))"
                and card: "card C \<le> card \<G>" and conth: "continuous_on (\<Union>\<G> - C) h"
                and him: "h ` (\<Union>\<G> - C) \<subseteq> rel_frontier T"
                and hg: "\<And>x. x \<in> \<Union>(\<G> \<inter> Pow V) \<Longrightarrow> h x = g x"
   proof (rule extend_map_lemma_cofinite [of \<G> "\<G> \<inter> Pow V" T g])
     show "continuous_on (\<Union>(\<G> \<inter> Pow V)) g"
       by (metis Union_Int_subset Union_Pow_eq \<open>continuous_on V g\<close> continuous_on_subset le_inf_iff)
     show "g ` \<Union>(\<G> \<inter> Pow V) \<subseteq> rel_frontier T"
       using gim by force
   qed (auto intro: \<open>finite \<G>\<close> T polyG affG dest: faceG)
   have Ssub: "S \<subseteq> \<Union>(\<G> \<inter> Pow V)"
   proof
     fix x
     assume "x \<in> S"
     then have "x \<in> \<Union>\<G>"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> \<open>S \<subseteq> \<Union>\<F>\<close> by auto
     then obtain X where "x \<in> X" "X \<in> \<G>" by blast
     then have "diameter X < d" "bounded X"
       by (auto simp: diaG \<open>X \<in> \<G>\<close> polyG polytope_imp_bounded)
     then have "X \<subseteq> V" using d [OF \<open>x \<in> S\<close>] diameter_bounded_bound [OF \<open>bounded X\<close> \<open>x \<in> X\<close>]
       by fastforce
     then show "x \<in> \<Union>(\<G> \<inter> Pow V)"
       using \<open>X \<in> \<G>\<close> \<open>x \<in> X\<close> by blast
   qed
   show ?thesis
   proof
     show "continuous_on (\<Union>\<F>-C) h"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> conth by auto
     show "h ` (\<Union>\<F> - C) \<subseteq> rel_frontier T"
       using \<open>\<Union>\<G> = \<Union>\<F>\<close> him by auto
     show "h x = f x" if "x \<in> S" for x
     proof -
       have "h x = g x"
         using Ssub hg that by blast
       also have "... = f x"
         by (simp add: gf that)
       finally show "h x = f x" .
     qed
     show "disjnt C S"
       using dis Ssub  by (meson disjnt_iff subset_eq)
   qed (intro \<open>finite C\<close>)
 qed
 
 
 
 subsection\<open> Special cases and corollaries involving spheres\<close>
 
 lemma disjnt_Diff1: "X \<subseteq> Y' \<Longrightarrow> disjnt (X - Y) (X' - Y')"
   by (auto simp: disjnt_def)
 
 proposition extend_map_affine_to_sphere_cofinite_simple:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact S" "convex U" "bounded U"
       and aff: "aff_dim T \<le> aff_dim U"
       and "S \<subseteq> T" and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
  obtains K g where "finite K" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                    "g ` (T - K) \<subseteq> rel_frontier U"
                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   have "\<exists>K g. finite K \<and> disjnt K S \<and> continuous_on (T - K) g \<and>
               g ` (T - K) \<subseteq> rel_frontier U \<and> (\<forall>x \<in> S. g x = f x)"
        if "affine T" "S \<subseteq> T" and aff: "aff_dim T \<le> aff_dim U"  for T
   proof (cases "S = {}")
     case True
     show ?thesis
     proof (cases "rel_frontier U = {}")
       case True
       with \<open>bounded U\<close> have "aff_dim U \<le> 0"
         using affine_bounded_eq_lowdim rel_frontier_eq_empty by auto
       with aff have "aff_dim T \<le> 0" by auto
       then obtain a where "T \<subseteq> {a}"
         using \<open>affine T\<close> affine_bounded_eq_lowdim affine_bounded_eq_trivial by auto
       then show ?thesis
         using \<open>S = {}\<close> fim
         by (metis Diff_cancel contf disjnt_empty2 finite.emptyI finite_insert finite_subset)
     next
       case False
       then obtain a where "a \<in> rel_frontier U"
         by auto
       then show ?thesis
         using continuous_on_const [of _ a] \<open>S = {}\<close> by force
     qed
   next
     case False
     have "bounded S"
       by (simp add: \<open>compact S\<close> compact_imp_bounded)
     then obtain b where b: "S \<subseteq> cbox (-b) b"
       using bounded_subset_cbox_symmetric by blast
     define bbox where "bbox \<equiv> cbox (-(b+One)) (b+One)"
     have "cbox (-b) b \<subseteq> bbox"
       by (auto simp: bbox_def algebra_simps intro!: subset_box_imp)
     with b \<open>S \<subseteq> T\<close> have "S \<subseteq> bbox \<inter> T"
       by auto
     then have Ssub: "S \<subseteq> \<Union>{bbox \<inter> T}"
       by auto
     then have "aff_dim (bbox \<inter> T) \<le> aff_dim U"
       by (metis aff aff_dim_subset inf_commute inf_le1 order_trans)
     obtain K g where K: "finite K" "disjnt K S"
                  and contg: "continuous_on (\<Union>{bbox \<inter> T} - K) g"
                  and gim: "g ` (\<Union>{bbox \<inter> T} - K) \<subseteq> rel_frontier U"
                  and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     proof (rule extend_map_cell_complex_to_sphere_cofinite
               [OF _ Ssub _ \<open>convex U\<close> \<open>bounded U\<close> _ _ _ contf fim])
       show "closed S"
         using \<open>compact S\<close> compact_eq_bounded_closed by auto
       show poly: "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> polytope X"
         by (simp add: polytope_Int_polyhedron bbox_def polytope_interval affine_imp_polyhedron \<open>affine T\<close>)
       show "\<And>X Y. \<lbrakk>X \<in> {bbox \<inter> T}; Y \<in> {bbox \<inter> T}\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
         by (simp add:poly face_of_refl polytope_imp_convex)
       show "\<And>X. X \<in> {bbox \<inter> T} \<Longrightarrow> aff_dim X \<le> aff_dim U"
         by (simp add: \<open>aff_dim (bbox \<inter> T) \<le> aff_dim U\<close>)
     qed auto
     define fro where "fro \<equiv> \<lambda>d. frontier(cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
     obtain d where d12: "1/2 \<le> d" "d \<le> 1" and dd: "disjnt K (fro d)"
     proof (rule disjoint_family_elem_disjnt [OF _ \<open>finite K\<close>])
       show "infinite {1/2..1::real}"
         by (simp add: infinite_Icc)
       have dis1: "disjnt (fro x) (fro y)" if "x<y" for x y
         by (auto simp: algebra_simps that subset_box_imp disjnt_Diff1 frontier_def fro_def)
       then show "disjoint_family_on fro {1/2..1}"
         by (auto simp: disjoint_family_on_def disjnt_def neq_iff)
     qed auto
     define c where "c \<equiv> b + d *\<^sub>R One"
     have cbsub: "cbox (-b) b \<subseteq> box (-c) c"  "cbox (-b) b \<subseteq> cbox (-c) c"  "cbox (-c) c \<subseteq> bbox"
       using d12 by (auto simp: algebra_simps subset_box_imp c_def bbox_def)
     have clo_cbT: "closed (cbox (- c) c \<inter> T)"
       by (simp add: affine_closed closed_Int closed_cbox \<open>affine T\<close>)
     have cpT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
       using \<open>S \<noteq> {}\<close> b cbsub(2) \<open>S \<subseteq> T\<close> by fastforce
     have "closest_point (cbox (- c) c \<inter> T) x \<notin> K" if "x \<in> T" "x \<notin> K" for x
     proof (cases "x \<in> cbox (-c) c")
       case True with that show ?thesis
         by (simp add: closest_point_self)
     next
       case False
       have int_ne: "interior (cbox (-c) c) \<inter> T \<noteq> {}"
         using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b \<open>cbox (- b) b \<subseteq> box (- c) c\<close> by force
       have "convex T"
         by (meson \<open>affine T\<close> affine_imp_convex)
       then have "x \<in> affine hull (cbox (- c) c \<inter> T)"
           by (metis Int_commute Int_iff \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> cbsub(1) \<open>x \<in> T\<close> affine_hull_convex_Int_nonempty_interior all_not_in_conv b hull_inc inf.orderE interior_cbox)
       then have "x \<in> affine hull (cbox (- c) c \<inter> T) - rel_interior (cbox (- c) c \<inter> T)"
         by (meson DiffI False Int_iff rel_interior_subset subsetCE)
       then have "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
         by (rule closest_point_in_rel_frontier [OF clo_cbT cpT_ne])
       moreover have "(rel_frontier (cbox (- c) c \<inter> T)) \<subseteq> fro d"
         apply (subst convex_affine_rel_frontier_Int [OF _  \<open>affine T\<close> int_ne])
          apply (auto simp: fro_def c_def)
         done
       ultimately show ?thesis
         using dd  by (force simp: disjnt_def)
     qed
     then have cpt_subset: "closest_point (cbox (- c) c \<inter> T) ` (T - K) \<subseteq> \<Union>{bbox \<inter> T} - K"
       using closest_point_in_set [OF clo_cbT cpT_ne] cbsub(3) by force
     show ?thesis
     proof (intro conjI ballI exI)
       have "continuous_on (T - K) (closest_point (cbox (- c) c \<inter> T))"
         apply (rule continuous_on_closest_point)
         using \<open>S \<noteq> {}\<close> cbsub(2) b that
         by (auto simp: affine_imp_convex convex_Int affine_closed closed_Int closed_cbox \<open>affine T\<close>)
       then show "continuous_on (T - K) (g \<circ> closest_point (cbox (- c) c \<inter> T))"
         by (metis continuous_on_compose continuous_on_subset [OF contg cpt_subset])
       have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> g ` (\<Union>{bbox \<inter> T} - K)"
         by (metis image_comp image_mono cpt_subset)
       also have "... \<subseteq> rel_frontier U"
         by (rule gim)
       finally show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K) \<subseteq> rel_frontier U" .
       show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x" if "x \<in> S" for x
       proof -
         have "(g \<circ> closest_point (cbox (- c) c \<inter> T)) x = g x"
           unfolding o_def
           by (metis IntI \<open>S \<subseteq> T\<close> b cbsub(2) closest_point_self subset_eq that)
         also have "... = f x"
           by (simp add: that gf)
         finally show ?thesis .
       qed
     qed (auto simp: K)
   qed
   then obtain K g where "finite K" "disjnt K S"
                and contg: "continuous_on (affine hull T - K) g"
                and gim:  "g ` (affine hull T - K) \<subseteq> rel_frontier U"
                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     by (metis aff affine_affine_hull aff_dim_affine_hull
               order_trans [OF \<open>S \<subseteq> T\<close> hull_subset [of T affine]])
   then obtain K g where "finite K" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim:  "g ` (T - K) \<subseteq> rel_frontier U"
                and gf:   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     by (rule_tac K=K and g=g in that) (auto simp: hull_inc elim: continuous_on_subset)
   then show ?thesis
     by (rule_tac K="K \<inter> T" and g=g in that) (auto simp: disjnt_iff Diff_Int contg)
 qed
 
 subsection\<open>Extending maps to spheres\<close>
 
 (*Up to extend_map_affine_to_sphere_cofinite_gen*)
 
 lemma extend_map_affine_to_sphere1:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::topological_space"
   assumes "finite K" "affine U" and contf: "continuous_on (U - K) f"
       and fim: "f ` (U - K) \<subseteq> T"
       and comps: "\<And>C. \<lbrakk>C \<in> components(U - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
       and clo: "closedin (top_of_set U) S" and K: "disjnt K S" "K \<subseteq> U"
   obtains g where "continuous_on (U - L) g" "g ` (U - L) \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "K = {}")
   case True
   then show ?thesis
     by (metis Diff_empty Diff_subset contf fim continuous_on_subset image_subsetI rev_image_eqI subset_iff that)
 next
   case False
   have "S \<subseteq> U"
     using clo closedin_limpt by blast
   then have "(U - S) \<inter> K \<noteq> {}"
     by (metis Diff_triv False Int_Diff K disjnt_def inf.absorb_iff2 inf_commute)
   then have "\<Union>(components (U - S)) \<inter> K \<noteq> {}"
     using Union_components by simp
   then obtain C0 where C0: "C0 \<in> components (U - S)" "C0 \<inter> K \<noteq> {}"
     by blast
   have "convex U"
     by (simp add: affine_imp_convex \<open>affine U\<close>)
   then have "locally connected U"
     by (rule convex_imp_locally_connected)
   have "\<exists>a g. a \<in> C \<and> a \<in> L \<and> continuous_on (S \<union> (C - {a})) g \<and>
               g ` (S \<union> (C - {a})) \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x)"
        if C: "C \<in> components (U - S)" and CK: "C \<inter> K \<noteq> {}" for C
   proof -
     have "C \<subseteq> U-S" "C \<inter> L \<noteq> {}"
       by (simp_all add: in_components_subset comps that)
     then obtain a where a: "a \<in> C" "a \<in> L" by auto
     have opeUC: "openin (top_of_set U) C"
     proof (rule openin_trans)
       show "openin (top_of_set (U-S)) C"
         by (simp add: \<open>locally connected U\<close> clo locally_diff_closed openin_components_locally_connected [OF _ C])
       show "openin (top_of_set U) (U - S)"
         by (simp add: clo openin_diff)
     qed
     then obtain d where "C \<subseteq> U" "0 < d" and d: "cball a d \<inter> U \<subseteq> C"
       using openin_contains_cball by (metis \<open>a \<in> C\<close>)
     then have "ball a d \<inter> U \<subseteq> C"
       by auto
     obtain h k where homhk: "homeomorphism (S \<union> C) (S \<union> C) h k"
                  and subC: "{x. (\<not> (h x = x \<and> k x = x))} \<subseteq> C"
                  and bou: "bounded {x. (\<not> (h x = x \<and> k x = x))}"
                  and hin: "\<And>x. x \<in> C \<inter> K \<Longrightarrow> h x \<in> ball a d \<inter> U"
     proof (rule homeomorphism_grouping_points_exists_gen [of C "ball a d \<inter> U" "C \<inter> K" "S \<union> C"])
       show "openin (top_of_set C) (ball a d \<inter> U)"
         by (metis open_ball \<open>C \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> inf.absorb_iff2 inf.orderE inf_assoc open_openin openin_subtopology)
       show "openin (top_of_set (affine hull C)) C"
         by (metis \<open>a \<in> C\<close> \<open>openin (top_of_set U) C\<close> affine_hull_eq affine_hull_openin all_not_in_conv \<open>affine U\<close>)
       show "ball a d \<inter> U \<noteq> {}"
         using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by force
       show "finite (C \<inter> K)"
         by (simp add: \<open>finite K\<close>)
       show "S \<union> C \<subseteq> affine hull C"
         by (metis \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> opeUC affine_hull_eq affine_hull_openin all_not_in_conv assms(2) sup.bounded_iff)
       show "connected C"
         by (metis C in_components_connected)
     qed auto
     have a_BU: "a \<in> ball a d \<inter> U"
       using \<open>0 < d\<close> \<open>C \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
     have "rel_frontier (cball a d \<inter> U) retract_of (affine hull (cball a d \<inter> U) - {a})"
       apply (rule rel_frontier_retract_of_punctured_affine_hull)
         apply (auto simp: \<open>convex U\<close> convex_Int)
       by (metis \<open>affine U\<close> convex_cball empty_iff interior_cball a_BU rel_interior_convex_Int_affine)
     moreover have "rel_frontier (cball a d \<inter> U) = frontier (cball a d) \<inter> U"
       apply (rule convex_affine_rel_frontier_Int)
       using a_BU by (force simp: \<open>affine U\<close>)+
     moreover have "affine hull (cball a d \<inter> U) = U"
       by (metis \<open>convex U\<close> a_BU affine_hull_convex_Int_nonempty_interior affine_hull_eq \<open>affine U\<close> equals0D inf.commute interior_cball)
     ultimately have "frontier (cball a d) \<inter> U retract_of (U - {a})"
       by metis
     then obtain r where contr: "continuous_on (U - {a}) r"
                     and rim: "r ` (U - {a}) \<subseteq> sphere a d"  "r ` (U - {a}) \<subseteq> U"
                     and req: "\<And>x. x \<in> sphere a d \<inter> U \<Longrightarrow> r x = x"
       using \<open>affine U\<close> by (auto simp: retract_of_def retraction_def hull_same)
     define j where "j \<equiv> \<lambda>x. if x \<in> ball a d then r x else x"
     have kj: "\<And>x. x \<in> S \<Longrightarrow> k (j x) = x"
       using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def subC by auto
     have Uaeq: "U - {a} = (cball a d - {a}) \<inter> U \<union> (U - ball a d)"
       using \<open>0 < d\<close> by auto
     have jim: "j ` (S \<union> (C - {a})) \<subseteq> (S \<union> C) - ball a d"
     proof clarify
       fix y  assume "y \<in> S \<union> (C - {a})"
       then have "y \<in> U - {a}"
         using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by auto
       then have "r y \<in> sphere a d"
         using rim by auto
       then show "j y \<in> S \<union> C - ball a d"
         apply (simp add: j_def)
         using \<open>r y \<in> sphere a d\<close> \<open>y \<in> U - {a}\<close> \<open>y \<in> S \<union> (C - {a})\<close> d rim by fastforce
     qed
     have contj: "continuous_on (U - {a}) j"
       unfolding j_def Uaeq
     proof (intro continuous_on_cases_local continuous_on_id, simp_all add: req closedin_closed Uaeq [symmetric])
       show "\<exists>T. closed T \<and> (cball a d - {a}) \<inter> U = (U - {a}) \<inter> T"
           apply (rule_tac x="(cball a d) \<inter> U" in exI)
         using affine_closed \<open>affine U\<close> by blast
       show "\<exists>T. closed T \<and> U - ball a d = (U - {a}) \<inter> T"
          apply (rule_tac x="U - ball a d" in exI)
         using \<open>0 < d\<close>  by (force simp: affine_closed \<open>affine U\<close> closed_Diff)
       show "continuous_on ((cball a d - {a}) \<inter> U) r"
         by (force intro: continuous_on_subset [OF contr])
     qed
     have fT: "x \<in> U - K \<Longrightarrow> f x \<in> T" for x
       using fim by blast
     show ?thesis
     proof (intro conjI exI)
       show "continuous_on (S \<union> (C - {a})) (f \<circ> k \<circ> j)"
       proof (intro continuous_on_compose)
         show "continuous_on (S \<union> (C - {a})) j"
           apply (rule continuous_on_subset [OF contj])
           using \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>a \<in> C\<close> by force
         show "continuous_on (j ` (S \<union> (C - {a}))) k"
           apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
-          using jim \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def by fastforce
+          using jim \<open>C \<subseteq> U - S\<close> \<open>S \<subseteq> U\<close> \<open>ball a d \<inter> U \<subseteq> C\<close> j_def by blast
         show "continuous_on (k ` j ` (S \<union> (C - {a}))) f"
         proof (clarify intro!: continuous_on_subset [OF contf])
           fix y  assume "y \<in> S \<union> (C - {a})"
           have ky: "k y \<in> S \<union> C"
             using homeomorphism_image2 [OF homhk] \<open>y \<in> S \<union> (C - {a})\<close> by blast
           have jy: "j y \<in> S \<union> C - ball a d"
             using Un_iff \<open>y \<in> S \<union> (C - {a})\<close> jim by auto
           show "k (j y) \<in> U - K"
             apply safe
             using \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close>  homeomorphism_image2 [OF homhk] jy apply blast
             by (metis DiffD1 DiffD2 Int_iff Un_iff \<open>disjnt K S\<close> disjnt_def empty_iff hin homeomorphism_apply2 homeomorphism_image2 homhk imageI jy)
         qed
       qed
       have ST: "\<And>x. x \<in> S \<Longrightarrow> (f \<circ> k \<circ> j) x \<in> T"
         apply (simp add: kj)
         apply (metis DiffI \<open>S \<subseteq> U\<close> \<open>disjnt K S\<close> subsetD disjnt_iff fim image_subset_iff)
         done
       moreover have "(f \<circ> k \<circ> j) x \<in> T" if "x \<in> C" "x \<noteq> a" "x \<notin> S" for x
       proof -
         have rx: "r x \<in> sphere a d"
           using \<open>C \<subseteq> U\<close> rim that by fastforce
         have jj: "j x \<in> S \<union> C - ball a d"
           using jim that by blast
         have "k (j x) = j x \<longrightarrow> k (j x) \<in> C \<or> j x \<in> C"
           by (metis Diff_iff Int_iff Un_iff \<open>S \<subseteq> U\<close> subsetD d j_def jj rx sphere_cball that(1))
         then have "k (j x) \<in> C"
           using homeomorphism_apply2 [OF homhk, of "j x"]   \<open>C \<subseteq> U\<close> \<open>S \<subseteq> U\<close> a rx
           by (metis (mono_tags, lifting) Diff_iff subsetD jj mem_Collect_eq subC)
         with jj \<open>C \<subseteq> U\<close> show ?thesis
           apply safe
           using ST j_def apply fastforce
           apply (auto simp: not_less intro!: fT)
           by (metis DiffD1 DiffD2 Int_iff hin homeomorphism_apply2 [OF homhk] jj)
       qed
       ultimately show "(f \<circ> k \<circ> j) ` (S \<union> (C - {a})) \<subseteq> T"
         by force
       show "\<forall>x\<in>S. (f \<circ> k \<circ> j) x = f x" using kj by simp
     qed (auto simp: a)
   qed
   then obtain a h where
     ah: "\<And>C. \<lbrakk>C \<in> components (U - S); C \<inter> K \<noteq> {}\<rbrakk>
            \<Longrightarrow> a C \<in> C \<and> a C \<in> L \<and> continuous_on (S \<union> (C - {a C})) (h C) \<and>
                h C ` (S \<union> (C - {a C})) \<subseteq> T \<and> (\<forall>x \<in> S. h C x = f x)"
     using that by metis
   define F where "F \<equiv> {C \<in> components (U - S). C \<inter> K \<noteq> {}}"
   define G where "G \<equiv> {C \<in> components (U - S). C \<inter> K = {}}"
   define UF where "UF \<equiv> (\<Union>C\<in>F. C - {a C})"
   have "C0 \<in> F"
     by (auto simp: F_def C0)
   have "finite F"
   proof (subst finite_image_iff [of "\<lambda>C. C \<inter> K" F, symmetric])
     show "inj_on (\<lambda>C. C \<inter> K) F"
       unfolding F_def inj_on_def
       using components_nonoverlap by blast
     show "finite ((\<lambda>C. C \<inter> K) ` F)"
       unfolding F_def
       by (rule finite_subset [of _ "Pow K"]) (auto simp: \<open>finite K\<close>)
   qed
   obtain g where contg: "continuous_on (S \<union> UF) g"
              and gh: "\<And>x i. \<lbrakk>i \<in> F; x \<in> (S \<union> UF) \<inter> (S \<union> (i - {a i}))\<rbrakk>
                             \<Longrightarrow> g x = h i x"
   proof (rule pasting_lemma_exists_closed [OF \<open>finite F\<close>])
     let ?X = "top_of_set (S \<union> UF)"
     show "topspace ?X \<subseteq> (\<Union>C\<in>F. S \<union> (C - {a C}))"
       using \<open>C0 \<in> F\<close> by (force simp: UF_def)
     show "closedin (top_of_set (S \<union> UF)) (S \<union> (C - {a C}))"
          if "C \<in> F" for C
     proof (rule closedin_closed_subset [of U "S \<union> C"])
       show "closedin (top_of_set U) (S \<union> C)"
         apply (rule closedin_Un_complement_component [OF \<open>locally connected U\<close> clo])
         using F_def that by blast
     next
       have "x = a C'" if "C' \<in> F"  "x \<in> C'" "x \<notin> U" for x C'
       proof -
         have "\<forall>A. x \<in> \<Union>A \<or> C' \<notin> A"
           using \<open>x \<in> C'\<close> by blast
         with that show "x = a C'"
           by (metis (lifting) DiffD1 F_def Union_components mem_Collect_eq)
       qed
       then show "S \<union> UF \<subseteq> U"
         using \<open>S \<subseteq> U\<close> by (force simp: UF_def)
     next
       show "S \<union> (C - {a C}) = (S \<union> C) \<inter> (S \<union> UF)"
         using F_def UF_def components_nonoverlap that by auto
     qed
     show "continuous_map (subtopology ?X (S \<union> (C' - {a C'}))) euclidean (h C')" if "C' \<in> F" for C'
     proof -
       have C': "C' \<in> components (U - S)" "C' \<inter> K \<noteq> {}"
         using F_def that by blast+
       show ?thesis
         using ah [OF C'] by (auto simp: F_def subtopology_subtopology intro: continuous_on_subset)
     qed
     show "\<And>i j x. \<lbrakk>i \<in> F; j \<in> F;
                    x \<in> topspace ?X \<inter> (S \<union> (i - {a i})) \<inter> (S \<union> (j - {a j}))\<rbrakk>
                   \<Longrightarrow> h i x = h j x"
       using components_eq by (fastforce simp: components_eq F_def ah)
   qed auto
   have SU': "S \<union> \<Union>G \<union> (S \<union> UF) \<subseteq> U"
     using \<open>S \<subseteq> U\<close> in_components_subset by (auto simp: F_def G_def UF_def)
   have clo1: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> \<Union>G)"
   proof (rule closedin_closed_subset [OF _ SU'])
     have *: "\<And>C. C \<in> F \<Longrightarrow> openin (top_of_set U) C"
       unfolding F_def
       by clarify (metis (no_types, lifting) \<open>locally connected U\<close> clo closedin_def locally_diff_closed openin_components_locally_connected openin_trans topspace_euclidean_subtopology)
     show "closedin (top_of_set U) (U - UF)"
       unfolding UF_def
       by (force intro: openin_delete *)
     show "S \<union> \<Union>G = (U - UF) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
         apply (metis Diff_iff UnionI Union_components)
        apply (metis DiffD1 UnionI Union_components)
       by (metis (no_types, lifting) IntI components_nonoverlap empty_iff)
   qed
   have clo2: "closedin (top_of_set (S \<union> \<Union>G \<union> (S \<union> UF))) (S \<union> UF)"
   proof (rule closedin_closed_subset [OF _ SU'])
     show "closedin (top_of_set U) (\<Union>C\<in>F. S \<union> C)"
       apply (rule closedin_Union)
        apply (simp add: \<open>finite F\<close>)
       using F_def \<open>locally connected U\<close> clo closedin_Un_complement_component by blast
     show "S \<union> UF = (\<Union>C\<in>F. S \<union> C) \<inter> (S \<union> \<Union>G \<union> (S \<union> UF))"
       using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def)
       using C0 apply blast
       by (metis components_nonoverlap disjnt_def disjnt_iff)
   qed
   have SUG: "S \<union> \<Union>G \<subseteq> U - K"
     using \<open>S \<subseteq> U\<close> K apply (auto simp: G_def disjnt_iff)
     by (meson Diff_iff subsetD in_components_subset)
   then have contf': "continuous_on (S \<union> \<Union>G) f"
     by (rule continuous_on_subset [OF contf])
   have contg': "continuous_on (S \<union> UF) g"
     apply (rule continuous_on_subset [OF contg])
     using \<open>S \<subseteq> U\<close> by (auto simp: F_def G_def)
   have  "\<And>x. \<lbrakk>S \<subseteq> U; x \<in> S\<rbrakk> \<Longrightarrow> f x = g x"
     by (subst gh) (auto simp: ah C0 intro: \<open>C0 \<in> F\<close>)
   then have f_eq_g: "\<And>x. x \<in> S \<union> UF \<and> x \<in> S \<union> \<Union>G \<Longrightarrow> f x = g x"
     using \<open>S \<subseteq> U\<close> apply (auto simp: F_def G_def UF_def dest: in_components_subset)
     using components_eq by blast
   have cont: "continuous_on (S \<union> \<Union>G \<union> (S \<union> UF)) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
     by (blast intro: continuous_on_cases_local [OF clo1 clo2 contf' contg' f_eq_g, of "\<lambda>x. x \<in> S \<union> \<Union>G"])
   show ?thesis
   proof
     have UF: "\<Union>F - L \<subseteq> UF"
       unfolding F_def UF_def using ah by blast
     have "U - S - L = \<Union>(components (U - S)) - L"
       by simp
     also have "... = \<Union>F \<union> \<Union>G - L"
       unfolding F_def G_def by blast
     also have "... \<subseteq> UF \<union> \<Union>G"
       using UF by blast
     finally have "U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)"
       by blast
     then show "continuous_on (U - L) (\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x)"
       by (rule continuous_on_subset [OF cont])
     have "((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq>  ((U - L) \<inter> (-S \<inter> UF))"
       using \<open>U - L \<subseteq> S \<union> \<Union>G \<union> (S \<union> UF)\<close> by auto
     moreover have "g ` ((U - L) \<inter> (-S \<inter> UF)) \<subseteq> T"
     proof -
       have "g x \<in> T" if "x \<in> U" "x \<notin> L" "x \<notin> S" "C \<in> F" "x \<in> C" "x \<noteq> a C" for x C
       proof (subst gh)
         show "x \<in> (S \<union> UF) \<inter> (S \<union> (C - {a C}))"
           using that by (auto simp: UF_def)
         show "h C x \<in> T"
           using ah that by (fastforce simp add: F_def)
       qed (rule that)
       then show ?thesis
         by (force simp: UF_def)
     qed
     ultimately have "g ` ((U - L) \<inter> {x. x \<notin> S \<and> (\<forall>xa\<in>G. x \<notin> xa)}) \<subseteq> T"
       using image_mono order_trans by blast
     moreover have "f ` ((U - L) \<inter> (S \<union> \<Union>G)) \<subseteq> T"
       using fim SUG by blast
     ultimately show "(\<lambda>x. if x \<in> S \<union> \<Union>G then f x else g x) ` (U - L) \<subseteq> T"
        by force
     show "\<And>x. x \<in> S \<Longrightarrow> (if x \<in> S \<union> \<Union>G then f x else g x) = f x"
       by (simp add: F_def G_def)
   qed
 qed
 
 
 lemma extend_map_affine_to_sphere2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
       and affTU: "aff_dim T \<le> aff_dim U"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
       and ovlap: "\<And>C. C \<in> components(T - S) \<Longrightarrow> C \<inter> L \<noteq> {}"
     obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S"
                       "continuous_on (T - K) g" "g ` (T - K) \<subseteq> rel_frontier U"
                       "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   obtain K g where K: "finite K" "K \<subseteq> T" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
      using assms extend_map_affine_to_sphere_cofinite_simple by metis
   have "(\<exists>y C. C \<in> components (T - S) \<and> x \<in> C \<and> y \<in> C \<and> y \<in> L)" if "x \<in> K" for x
   proof -
     have "x \<in> T-S"
       using \<open>K \<subseteq> T\<close> \<open>disjnt K S\<close> disjnt_def that by fastforce
     then obtain C where "C \<in> components(T - S)" "x \<in> C"
       by (metis UnionE Union_components)
     with ovlap [of C] show ?thesis
       by blast
   qed
   then obtain \<xi> where \<xi>: "\<And>x. x \<in> K \<Longrightarrow> \<exists>C. C \<in> components (T - S) \<and> x \<in> C \<and> \<xi> x \<in> C \<and> \<xi> x \<in> L"
     by metis
   obtain h where conth: "continuous_on (T - \<xi> ` K) h"
              and him: "h ` (T - \<xi> ` K) \<subseteq> rel_frontier U"
              and hg: "\<And>x. x \<in> S \<Longrightarrow> h x = g x"
   proof (rule extend_map_affine_to_sphere1 [OF \<open>finite K\<close> \<open>affine T\<close> contg gim, of S "\<xi> ` K"])
     show cloTS: "closedin (top_of_set T) S"
       by (simp add: \<open>compact S\<close> \<open>S \<subseteq> T\<close> closed_subset compact_imp_closed)
     show "\<And>C. \<lbrakk>C \<in> components (T - S); C \<inter> K \<noteq> {}\<rbrakk> \<Longrightarrow> C \<inter> \<xi> ` K \<noteq> {}"
       using \<xi> components_eq by blast
   qed (use K in auto)
   show ?thesis
   proof
     show *: "\<xi> ` K \<subseteq> L"
       using \<xi> by blast
     show "finite (\<xi> ` K)"
       by (simp add: K)
     show "\<xi> ` K \<subseteq> T"
       by clarify (meson \<xi> Diff_iff contra_subsetD in_components_subset)
     show "continuous_on (T - \<xi> ` K) h"
       by (rule conth)
     show "disjnt (\<xi> ` K) S"
       using K
       apply (auto simp: disjnt_def)
       by (metis \<xi> DiffD2 UnionI Union_components)
   qed (simp_all add: him hg gf)
 qed
 
 
 proposition extend_map_affine_to_sphere_cofinite_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes SUT: "compact S" "convex U" "bounded U" "affine T" "S \<subseteq> T"
       and aff: "aff_dim T \<le> aff_dim U"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> rel_frontier U"
       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
  obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                    "g ` (T - K) \<subseteq> rel_frontier U"
                    "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "S = {}")
   case True
   show ?thesis
   proof (cases "rel_frontier U = {}")
     case True
     with aff have "aff_dim T \<le> 0"
       apply (simp add: rel_frontier_eq_empty)
       using affine_bounded_eq_lowdim \<open>bounded U\<close> order_trans by auto
     with aff_dim_geq [of T] consider "aff_dim T = -1" |  "aff_dim T = 0"
       by linarith
     then show ?thesis
     proof cases
       assume "aff_dim T = -1"
       then have "T = {}"
         by (simp add: aff_dim_empty)
       then show ?thesis
         by (rule_tac K="{}" in that) auto
     next
       assume "aff_dim T = 0"
       then obtain a where "T = {a}"
         using aff_dim_eq_0 by blast
       then have "a \<in> L"
         using dis [of "{a}"] \<open>S = {}\<close> by (auto simp: in_components_self)
       with \<open>S = {}\<close> \<open>T = {a}\<close> show ?thesis
         by (rule_tac K="{a}" and g=f in that) auto
     qed
   next
     case False
     then obtain y where "y \<in> rel_frontier U"
       by auto
     with \<open>S = {}\<close> show ?thesis
       by (rule_tac K="{}" and g="\<lambda>x. y" in that)  (auto)
   qed
 next
   case False
   have "bounded S"
     by (simp add: assms compact_imp_bounded)
   then obtain b where b: "S \<subseteq> cbox (-b) b"
     using bounded_subset_cbox_symmetric by blast
   define LU where "LU \<equiv> L \<union> (\<Union> {C \<in> components (T - S). \<not>bounded C} - cbox (-(b+One)) (b+One))"
   obtain K g where "finite K" "K \<subseteq> LU" "K \<subseteq> T" "disjnt K S"
                and contg: "continuous_on (T - K) g"
                and gim: "g ` (T - K) \<subseteq> rel_frontier U"
                and gf:  "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   proof (rule extend_map_affine_to_sphere2 [OF SUT aff contf fim])
     show "C \<inter> LU \<noteq> {}" if "C \<in> components (T - S)" for C
     proof (cases "bounded C")
       case True
       with dis that show ?thesis
         unfolding LU_def by fastforce
     next
       case False
       then have "\<not> bounded (\<Union>{C \<in> components (T - S). \<not> bounded C})"
         by (metis (no_types, lifting) Sup_upper bounded_subset mem_Collect_eq that)
       then show ?thesis
         apply (clarsimp simp: LU_def Int_Un_distrib Diff_Int_distrib Int_UN_distrib)
         by (metis (no_types, lifting) False Sup_upper bounded_cbox bounded_subset inf.orderE mem_Collect_eq that)
     qed
   qed blast
   have *: False if "x \<in> cbox (- b - m *\<^sub>R One) (b + m *\<^sub>R One)"
                    "x \<notin> box (- b - n *\<^sub>R One) (b + n *\<^sub>R One)"
                    "0 \<le> m" "m < n" "n \<le> 1" for m n x
     using that by (auto simp: mem_box algebra_simps)
   have "disjoint_family_on (\<lambda>d. frontier (cbox (- b - d *\<^sub>R One) (b + d *\<^sub>R One))) {1 / 2..1}"
     by (auto simp: disjoint_family_on_def neq_iff frontier_def dest: *)
   then obtain d where d12: "1/2 \<le> d" "d \<le> 1"
                   and ddis: "disjnt K (frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One)))"
     using disjoint_family_elem_disjnt [of "{1/2..1::real}" K "\<lambda>d. frontier (cbox (-(b + d *\<^sub>R One)) (b + d *\<^sub>R One))"]
     by (auto simp: \<open>finite K\<close>)
   define c where "c \<equiv> b + d *\<^sub>R One"
   have cbsub: "cbox (-b) b \<subseteq> box (-c) c"
               "cbox (-b) b \<subseteq> cbox (-c) c"
               "cbox (-c) c \<subseteq> cbox (-(b+One)) (b+One)"
     using d12 by (simp_all add: subset_box c_def inner_diff_left inner_left_distrib)
   have clo_cT: "closed (cbox (- c) c \<inter> T)"
     using affine_closed \<open>affine T\<close> by blast
   have cT_ne: "cbox (- c) c \<inter> T \<noteq> {}"
     using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub by fastforce
   have S_sub_cc: "S \<subseteq> cbox (- c) c"
     using \<open>cbox (- b) b \<subseteq> cbox (- c) c\<close> b by auto
   show ?thesis
   proof
     show "finite (K \<inter> cbox (-(b+One)) (b+One))"
       using \<open>finite K\<close> by blast
     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> L"
       using \<open>K \<subseteq> LU\<close> by (auto simp: LU_def)
     show "K \<inter> cbox (- (b + One)) (b + One) \<subseteq> T"
       using \<open>K \<subseteq> T\<close> by auto
     show "disjnt (K \<inter> cbox (- (b + One)) (b + One)) S"
       using \<open>disjnt K S\<close>  by (simp add: disjnt_def disjoint_eq_subset_Compl inf.coboundedI1)
     have cloTK: "closest_point (cbox (- c) c \<inter> T) x \<in> T - K"
                 if "x \<in> T" and Knot: "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
     proof (cases "x \<in> cbox (- c) c")
       case True
       with \<open>x \<in> T\<close> show ?thesis
         using cbsub(3) Knot  by (force simp: closest_point_self)
     next
       case False
       have clo_in_rf: "closest_point (cbox (- c) c \<inter> T) x \<in> rel_frontier (cbox (- c) c \<inter> T)"
       proof (intro closest_point_in_rel_frontier [OF clo_cT cT_ne] DiffI notI)
         have "T \<inter> interior (cbox (- c) c) \<noteq> {}"
           using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
         then show "x \<in> affine hull (cbox (- c) c \<inter> T)"
           by (simp add: Int_commute affine_hull_affine_Int_nonempty_interior \<open>affine T\<close> hull_inc that(1))
       next
         show "False" if "x \<in> rel_interior (cbox (- c) c \<inter> T)"
         proof -
           have "interior (cbox (- c) c) \<inter> T \<noteq> {}"
             using \<open>S \<noteq> {}\<close> \<open>S \<subseteq> T\<close> b cbsub(1) by fastforce
           then have "affine hull (T \<inter> cbox (- c) c) = T"
             using affine_hull_convex_Int_nonempty_interior [of T "cbox (- c) c"]
             by (simp add: affine_imp_convex \<open>affine T\<close> inf_commute)
           then show ?thesis
             by (meson subsetD le_inf_iff rel_interior_subset that False)
         qed
       qed
       have "closest_point (cbox (- c) c \<inter> T) x \<notin> K"
       proof
         assume inK: "closest_point (cbox (- c) c \<inter> T) x \<in> K"
         have "\<And>x. x \<in> K \<Longrightarrow> x \<notin> frontier (cbox (- (b + d *\<^sub>R One)) (b + d *\<^sub>R One))"
           by (metis ddis disjnt_iff)
         then show False
           by (metis DiffI Int_iff \<open>affine T\<close> cT_ne c_def clo_cT clo_in_rf closest_point_in_set
                     convex_affine_rel_frontier_Int convex_box(1) empty_iff frontier_cbox inK interior_cbox)
       qed
       then show ?thesis
         using cT_ne clo_cT closest_point_in_set by blast
     qed
     show "continuous_on (T - K \<inter> cbox (- (b + One)) (b + One)) (g \<circ> closest_point (cbox (-c) c \<inter> T))"
       apply (intro continuous_on_compose continuous_on_closest_point continuous_on_subset [OF contg])
          apply (simp_all add: clo_cT affine_imp_convex \<open>affine T\<close> convex_Int cT_ne)
       using cloTK by blast
     have "g (closest_point (cbox (- c) c \<inter> T) x) \<in> rel_frontier U"
          if "x \<in> T" "x \<in> K \<longrightarrow> x \<notin> cbox (- b - One) (b + One)" for x
       apply (rule gim [THEN subsetD])
       using that cloTK by blast
     then show "(g \<circ> closest_point (cbox (- c) c \<inter> T)) ` (T - K \<inter> cbox (- (b + One)) (b + One))
                \<subseteq> rel_frontier U"
       by force
     show "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> closest_point (cbox (- c) c \<inter> T)) x = f x"
       by simp (metis (mono_tags, lifting) IntI \<open>S \<subseteq> T\<close> cT_ne clo_cT closest_point_refl gf subsetD S_sub_cc)
   qed
 qed
 
 
 corollary extend_map_affine_to_sphere_cofinite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes SUT: "compact S" "affine T" "S \<subseteq> T"
       and aff: "aff_dim T \<le> DIM('b)" and "0 \<le> r"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> sphere a r"
       and dis: "\<And>C. \<lbrakk>C \<in> components(T - S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
   obtains K g where "finite K" "K \<subseteq> L" "K \<subseteq> T" "disjnt K S" "continuous_on (T - K) g"
                     "g ` (T - K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "r = 0")
   case True
   with fim show ?thesis
     by (rule_tac K="{}" and g = "\<lambda>x. a" in that) (auto)
 next
   case False
   with assms have "0 < r" by auto
   then have "aff_dim T \<le> aff_dim (cball a r)"
     by (simp add: aff aff_dim_cball)
   then show ?thesis
     apply (rule extend_map_affine_to_sphere_cofinite_gen
             [OF \<open>compact S\<close> convex_cball bounded_cball \<open>affine T\<close> \<open>S \<subseteq> T\<close> _ contf])
     using fim apply (auto simp: assms False that dest: dis)
     done
 qed
 
 corollary extend_map_UNIV_to_sphere_cofinite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
       and SUT: "compact S"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> sphere a r"
       and dis: "\<And>C. \<lbrakk>C \<in> components(- S); bounded C\<rbrakk> \<Longrightarrow> C \<inter> L \<noteq> {}"
   obtains K g where "finite K" "K \<subseteq> L" "disjnt K S" "continuous_on (- K) g"
                     "g ` (- K) \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 apply (rule extend_map_affine_to_sphere_cofinite
         [OF \<open>compact S\<close> affine_UNIV subset_UNIV _ \<open>0 \<le> r\<close> contf fim dis])
  apply (auto simp: assms that Compl_eq_Diff_UNIV [symmetric])
 done
 
 corollary extend_map_UNIV_to_sphere_no_bounded_component:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes aff: "DIM('a) \<le> DIM('b)" and "0 \<le> r"
       and SUT: "compact S"
       and contf: "continuous_on S f"
       and fim: "f ` S \<subseteq> sphere a r"
       and dis: "\<And>C. C \<in> components(- S) \<Longrightarrow> \<not> bounded C"
   obtains g where "continuous_on UNIV g" "g ` UNIV \<subseteq> sphere a r" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 apply (rule extend_map_UNIV_to_sphere_cofinite [OF aff \<open>0 \<le> r\<close> \<open>compact S\<close> contf fim, of "{}"])
    apply (auto simp: that dest: dis)
 done
 
 theorem Borsuk_separation_theorem_gen:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S"
     shows "(\<forall>c \<in> components(- S). \<not>bounded c) \<longleftrightarrow>
            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
        (is "?lhs = ?rhs")
 proof
   assume L [rule_format]: ?lhs
   show ?rhs
   proof clarify
     fix f :: "'a \<Rightarrow> 'a"
     assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> sphere 0 1"
     obtain g where contg: "continuous_on UNIV g" and gim: "range g \<subseteq> sphere 0 1"
                and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
       by (rule extend_map_UNIV_to_sphere_no_bounded_component [OF _ _ \<open>compact S\<close> contf fim L]) auto
     then obtain c where c: "homotopic_with_canon (\<lambda>h. True) UNIV (sphere 0 1) g (\<lambda>x. c)"
       using contractible_UNIV nullhomotopic_from_contractible by blast
     then show "\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)"
       by (metis assms compact_imp_closed contf contg contractible_empty fim gf gim nullhomotopic_from_contractible nullhomotopic_into_sphere_extension)
   qed
 next
   assume R [rule_format]: ?rhs
   show ?lhs
     unfolding components_def
   proof clarify
     fix a
     assume "a \<notin> S" and a: "bounded (connected_component_set (- S) a)"
     have cont: "continuous_on S (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))"
       apply (intro continuous_intros)
       using \<open>a \<notin> S\<close> by auto
     have im: "(\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) ` S \<subseteq> sphere 0 1"
       by clarsimp (metis \<open>a \<notin> S\<close> eq_iff_diff_eq_0 left_inverse norm_eq_zero)
     show False
       using R cont im Borsuk_map_essential_bounded_component [OF \<open>compact S\<close> \<open>a \<notin> S\<close>] a by blast
   qed
 qed
 
 
 corollary Borsuk_separation_theorem:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and 2: "2 \<le> DIM('a)"
     shows "connected(- S) \<longleftrightarrow>
            (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::'a) 1
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f (\<lambda>x. c)))"
        (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (cases "S = {}")
     case True
     then show ?thesis by auto
   next
     case False
     then have "(\<forall>c\<in>components (- S). \<not> bounded c)"
       by (metis L assms(1) bounded_empty cobounded_imp_unbounded compact_imp_bounded in_components_maximal order_refl)
     then show ?thesis
       by (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>])
   qed
 next
   assume R: ?rhs
   then show ?lhs
     apply (simp add: Borsuk_separation_theorem_gen [OF \<open>compact S\<close>, symmetric])
     apply (auto simp: components_def connected_iff_eq_connected_component_set)
     using connected_component_in apply fastforce
     using cobounded_unique_unbounded_component [OF _ 2, of "-S"] \<open>compact S\<close> compact_eq_bounded_closed by fastforce
 qed
 
 
 lemma homotopy_eqv_separation:
   fixes S :: "'a::euclidean_space set" and T :: "'a set"
   assumes "S homotopy_eqv T" and "compact S" and "compact T"
   shows "connected(- S) \<longleftrightarrow> connected(- T)"
 proof -
   consider "DIM('a) = 1" | "2 \<le> DIM('a)"
     by (metis DIM_ge_Suc0 One_nat_def Suc_1 dual_order.antisym not_less_eq_eq)
   then show ?thesis
   proof cases
     case 1
     then show ?thesis
       using bounded_connected_Compl_1 compact_imp_bounded homotopy_eqv_empty1 homotopy_eqv_empty2 assms by metis
   next
     case 2
     with assms show ?thesis
       by (simp add: Borsuk_separation_theorem homotopy_eqv_cohomotopic_triviality_null)
   qed
 qed
 
 proposition Jordan_Brouwer_separation:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes hom: "S homeomorphic sphere a r" and "0 < r"
     shows "\<not> connected(- S)"
 proof -
   have "- sphere a r \<inter> ball a r \<noteq> {}"
     using \<open>0 < r\<close> by (simp add: Int_absorb1 subset_eq)
   moreover
   have eq: "- sphere a r - ball a r = - cball a r"
     by auto
   have "- cball a r \<noteq> {}"
   proof -
     have "frontier (cball a r) \<noteq> {}"
       using \<open>0 < r\<close> by auto
     then show ?thesis
       by (metis frontier_complement frontier_empty)
   qed
   with eq have "- sphere a r - ball a r \<noteq> {}"
     by auto
   moreover
   have "connected (- S) = connected (- sphere a r)"
   proof (rule homotopy_eqv_separation)
     show "S homotopy_eqv sphere a r"
       using hom homeomorphic_imp_homotopy_eqv by blast
     show "compact (sphere a r)"
       by simp
     then show " compact S"
       using hom homeomorphic_compactness by blast
   qed
   ultimately show ?thesis
     using connected_Int_frontier [of "- sphere a r" "ball a r"] by (auto simp: \<open>0 < r\<close>)
 qed
 
 
 proposition Jordan_Brouwer_frontier:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes S: "S homeomorphic sphere a r" and T: "T \<in> components(- S)" and 2: "2 \<le> DIM('a)"
     shows "frontier T = S"
 proof (cases r rule: linorder_cases)
   assume "r < 0"
   with S T show ?thesis by auto
 next
   assume "r = 0"
   with S T card_eq_SucD obtain b where "S = {b}"
     by (auto simp: homeomorphic_finite [of "{a}" S])
   have "components (- {b}) = { -{b}}"
     using T \<open>S = {b}\<close> by (auto simp: components_eq_sing_iff connected_punctured_universe 2)
   with T show ?thesis
     by (metis \<open>S = {b}\<close> cball_trivial frontier_cball frontier_complement singletonD sphere_trivial)
 next
   assume "r > 0"
   have "compact S"
     using homeomorphic_compactness compact_sphere S by blast
   show ?thesis
   proof (rule frontier_minimal_separating_closed)
     show "closed S"
       using \<open>compact S\<close> compact_eq_bounded_closed by blast
     show "\<not> connected (- S)"
       using Jordan_Brouwer_separation S \<open>0 < r\<close> by blast
     obtain f g where hom: "homeomorphism S (sphere a r) f g"
       using S by (auto simp: homeomorphic_def)
     show "connected (- T)" if "closed T" "T \<subset> S" for T
     proof -
       have "f ` T \<subseteq> sphere a r"
         using \<open>T \<subset> S\<close> hom homeomorphism_image1 by blast
       moreover have "f ` T \<noteq> sphere a r"
         using \<open>T \<subset> S\<close> hom
         by (metis homeomorphism_image2 homeomorphism_of_subsets order_refl psubsetE)
       ultimately have "f ` T \<subset> sphere a r" by blast
       then have "connected (- f ` T)"
         by (rule psubset_sphere_Compl_connected [OF _ \<open>0 < r\<close> 2])
       moreover have "compact T"
         using \<open>compact S\<close> bounded_subset compact_eq_bounded_closed that by blast
       moreover then have "compact (f ` T)"
         by (meson compact_continuous_image continuous_on_subset hom homeomorphism_def psubsetE \<open>T \<subset> S\<close>)
       moreover have "T homotopy_eqv f ` T"
         by (meson \<open>f ` T \<subseteq> sphere a r\<close> dual_order.strict_implies_order hom homeomorphic_def homeomorphic_imp_homotopy_eqv homeomorphism_of_subsets \<open>T \<subset> S\<close>)
       ultimately show ?thesis
         using homotopy_eqv_separation [of T "f`T"] by blast
     qed
   qed (rule T)
 qed
 
 proposition Jordan_Brouwer_nonseparation:
   fixes S :: "'a::euclidean_space set" and a::'a
   assumes S: "S homeomorphic sphere a r" and "T \<subset> S" and 2: "2 \<le> DIM('a)"
     shows "connected(- T)"
 proof -
   have *: "connected(C \<union> (S - T))" if "C \<in> components(- S)" for C
   proof (rule connected_intermediate_closure)
     show "connected C"
       using in_components_connected that by auto
     have "S = frontier C"
       using "2" Jordan_Brouwer_frontier S that by blast
     with closure_subset show "C \<union> (S - T) \<subseteq> closure C"
       by (auto simp: frontier_def)
   qed auto
   have "components(- S) \<noteq> {}"
     by (metis S bounded_empty cobounded_imp_unbounded compact_eq_bounded_closed compact_sphere
               components_eq_empty homeomorphic_compactness)
   then have "- T = (\<Union>C \<in> components(- S). C \<union> (S - T))"
     using Union_components [of "-S"] \<open>T \<subset> S\<close> by auto
   then show ?thesis
     apply (rule ssubst)
     apply (rule connected_Union)
     using \<open>T \<subset> S\<close> apply (auto simp: *)
     done
 qed
 
 subsection\<open> Invariance of domain and corollaries\<close>
 
 lemma invariance_of_domain_ball:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on (cball a r) f" and "0 < r"
      and inj: "inj_on f (cball a r)"
    shows "open(f ` ball a r)"
 proof (cases "DIM('a) = 1")
   case True
   obtain h::"'a\<Rightarrow>real" and k
         where "linear h" "linear k" "h ` UNIV = UNIV" "k ` UNIV = UNIV"
               "\<And>x. norm(h x) = norm x" "\<And>x. norm(k x) = norm x"
               "\<And>x. k(h x) = x" "\<And>x. h(k x) = x"
     apply (rule isomorphisms_UNIV_UNIV [where 'M='a and 'N=real])
       using True
        apply force
       by (metis UNIV_I UNIV_eq_I imageI)
     have cont: "continuous_on S h"  "continuous_on T k" for S T
       by (simp_all add: \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_linear)
     have "continuous_on (h ` cball a r) (h \<circ> f \<circ> k)"
       apply (intro continuous_on_compose cont continuous_on_subset [OF contf])
       apply (auto simp: \<open>\<And>x. k (h x) = x\<close>)
       done
     moreover have "is_interval (h ` cball a r)"
       by (simp add: is_interval_connected_1 \<open>linear h\<close> linear_continuous_on linear_linear connected_continuous_image)
     moreover have "inj_on (h \<circ> f \<circ> k) (h ` cball a r)"
       using inj by (simp add: inj_on_def) (metis \<open>\<And>x. k (h x) = x\<close>)
     ultimately have *: "\<And>T. \<lbrakk>open T; T \<subseteq> h ` cball a r\<rbrakk> \<Longrightarrow> open ((h \<circ> f \<circ> k) ` T)"
       using injective_eq_1d_open_map_UNIV by blast
     have "open ((h \<circ> f \<circ> k) ` (h ` ball a r))"
       by (rule *) (auto simp: \<open>linear h\<close> \<open>range h = UNIV\<close> open_surjective_linear_image)
     then have "open ((h \<circ> f) ` ball a r)"
       by (simp add: image_comp \<open>\<And>x. k (h x) = x\<close> cong: image_cong)
     then show ?thesis
       apply (simp only: image_comp [symmetric])
 
       apply (metis open_bijective_linear_image_eq \<open>linear h\<close> \<open>\<And>x. k (h x) = x\<close> \<open>range h = UNIV\<close> bijI inj_on_def)
       done
 next
   case False
   then have 2: "DIM('a) \<ge> 2"
     by (metis DIM_ge_Suc0 One_nat_def Suc_1 antisym not_less_eq_eq)
   have fimsub: "f ` ball a r \<subseteq> - f ` sphere a r"
     using inj  by clarsimp (metis inj_onD less_eq_real_def mem_cball order_less_irrefl)
   have hom: "f ` sphere a r homeomorphic sphere a r"
     by (meson compact_sphere contf continuous_on_subset homeomorphic_compact homeomorphic_sym inj inj_on_subset sphere_cball)
   then have nconn: "\<not> connected (- f ` sphere a r)"
     by (rule Jordan_Brouwer_separation) (auto simp: \<open>0 < r\<close>)
   obtain C where C: "C \<in> components (- f ` sphere a r)" and "bounded C"
     apply (rule cobounded_has_bounded_component [OF _ nconn])
       apply (simp_all add: 2)
     by (meson compact_imp_bounded compact_continuous_image_eq compact_sphere contf inj sphere_cball)
   moreover have "f ` (ball a r) = C"
   proof
     have "C \<noteq> {}"
       by (rule in_components_nonempty [OF C])
     show "C \<subseteq> f ` ball a r"
     proof (rule ccontr)
       assume nonsub: "\<not> C \<subseteq> f ` ball a r"
       have "- f ` cball a r \<subseteq> C"
       proof (rule components_maximal [OF C])
         have "f ` cball a r homeomorphic cball a r"
           using compact_cball contf homeomorphic_compact homeomorphic_sym inj by blast
         then show "connected (- f ` cball a r)"
           by (auto intro: connected_complement_homeomorphic_convex_compact 2)
         show "- f ` cball a r \<subseteq> - f ` sphere a r"
           by auto
         then show "C \<inter> - f ` cball a r \<noteq> {}"
           using \<open>C \<noteq> {}\<close> in_components_subset [OF C] nonsub
           using image_iff by fastforce
       qed
       then have "bounded (- f ` cball a r)"
         using bounded_subset \<open>bounded C\<close> by auto
       then have "\<not> bounded (f ` cball a r)"
         using cobounded_imp_unbounded by blast
       then show "False"
         using compact_continuous_image [OF contf] compact_cball compact_imp_bounded by blast
     qed
     with \<open>C \<noteq> {}\<close> have "C \<inter> f ` ball a r \<noteq> {}"
       by (simp add: inf.absorb_iff1)
     then show "f ` ball a r \<subseteq> C"
       by (metis components_maximal [OF C _ fimsub] connected_continuous_image ball_subset_cball connected_ball contf continuous_on_subset)
   qed
   moreover have "open (- f ` sphere a r)"
     using hom compact_eq_bounded_closed compact_sphere homeomorphic_compactness by blast
   ultimately show ?thesis
     using open_components by blast
 qed
 
 
 text\<open>Proved by L. E. J. Brouwer (1912)\<close>
 theorem invariance_of_domain:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes "continuous_on S f" "open S" "inj_on f S"
     shows "open(f ` S)"
   unfolding open_subopen [of "f`S"]
 proof clarify
   fix a
   assume "a \<in> S"
   obtain \<delta> where "\<delta> > 0" and \<delta>: "cball a \<delta> \<subseteq> S"
     using \<open>open S\<close> \<open>a \<in> S\<close> open_contains_cball_eq by blast
   show "\<exists>T. open T \<and> f a \<in> T \<and> T \<subseteq> f ` S"
   proof (intro exI conjI)
     show "open (f ` (ball a \<delta>))"
       by (meson \<delta> \<open>0 < \<delta>\<close> assms continuous_on_subset inj_on_subset invariance_of_domain_ball)
     show "f a \<in> f ` ball a \<delta>"
       by (simp add: \<open>0 < \<delta>\<close>)
     show "f ` ball a \<delta> \<subseteq> f ` S"
       using \<delta> ball_subset_cball by blast
   qed
 qed
 
 lemma inv_of_domain_ss0:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
       and "subspace S" and dimS: "dim S = DIM('b::euclidean_space)"
       and ope: "openin (top_of_set S) U"
     shows "openin (top_of_set S) (f ` U)"
 proof -
   have "U \<subseteq> S"
     using ope openin_imp_subset by blast
   have "(UNIV::'b set) homeomorphic S"
     by (simp add: \<open>subspace S\<close> dimS homeomorphic_subspaces)
   then obtain h k where homhk: "homeomorphism (UNIV::'b set) S h k"
     using homeomorphic_def by blast
   have homkh: "homeomorphism S (k ` S) k h"
     using homhk homeomorphism_image2 homeomorphism_sym by fastforce
   have "open ((k \<circ> f \<circ> h) ` k ` U)"
   proof (rule invariance_of_domain)
     show "continuous_on (k ` U) (k \<circ> f \<circ> h)"
     proof (intro continuous_intros)
       show "continuous_on (k ` U) h"
         by (meson continuous_on_subset [OF homeomorphism_cont1 [OF homhk]] top_greatest)
       show "continuous_on (h ` k ` U) f"
         apply (rule continuous_on_subset [OF contf], clarify)
         apply (metis homhk homeomorphism_def ope openin_imp_subset rev_subsetD)
         done
       show "continuous_on (f ` h ` k ` U) k"
         apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF homhk]])
         using fim homhk homeomorphism_apply2 ope openin_subset by fastforce
     qed
     have ope_iff: "\<And>T. open T \<longleftrightarrow> openin (top_of_set (k ` S)) T"
       using homhk homeomorphism_image2 open_openin by fastforce
     show "open (k ` U)"
       by (simp add: ope_iff homeomorphism_imp_open_map [OF homkh ope])
     show "inj_on (k \<circ> f \<circ> h) (k ` U)"
       apply (clarsimp simp: inj_on_def)
       by (metis subsetD fim homeomorphism_apply2 [OF homhk] image_subset_iff inj_on_eq_iff injf \<open>U \<subseteq> S\<close>)
   qed
   moreover
   have eq: "f ` U = h ` (k \<circ> f \<circ> h \<circ> k) ` U"
     unfolding image_comp [symmetric] using \<open>U \<subseteq> S\<close> fim
     by (metis homeomorphism_image2 homeomorphism_of_subsets homkh subset_image_iff)
   ultimately show ?thesis
     by (metis (no_types, hide_lams) homeomorphism_imp_open_map homhk image_comp open_openin subtopology_UNIV)
 qed
 
 lemma inv_of_domain_ss1:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes contf: "continuous_on U f" and injf: "inj_on f U" and fim: "f ` U \<subseteq> S"
       and "subspace S"
       and ope: "openin (top_of_set S) U"
     shows "openin (top_of_set S) (f ` U)"
 proof -
   define S' where "S' \<equiv> {y. \<forall>x \<in> S. orthogonal x y}"
   have "subspace S'"
     by (simp add: S'_def subspace_orthogonal_to_vectors)
   define g where "g \<equiv> \<lambda>z::'a*'a. ((f \<circ> fst)z, snd z)"
   have "openin (top_of_set (S \<times> S')) (g ` (U \<times> S'))"
   proof (rule inv_of_domain_ss0)
     show "continuous_on (U \<times> S') g"
       apply (simp add: g_def)
       apply (intro continuous_intros continuous_on_compose2 [OF contf continuous_on_fst], auto)
       done
     show "g ` (U \<times> S') \<subseteq> S \<times> S'"
       using fim  by (auto simp: g_def)
     show "inj_on g (U \<times> S')"
       using injf by (auto simp: g_def inj_on_def)
     show "subspace (S \<times> S')"
       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> subspace_Times)
     show "openin (top_of_set (S \<times> S')) (U \<times> S')"
       by (simp add: openin_Times [OF ope])
     have "dim (S \<times> S') = dim S + dim S'"
       by (simp add: \<open>subspace S'\<close> \<open>subspace S\<close> dim_Times)
     also have "... = DIM('a)"
       using dim_subspace_orthogonal_to_vectors [OF \<open>subspace S\<close> subspace_UNIV]
       by (simp add: add.commute S'_def)
     finally show "dim (S \<times> S') = DIM('a)" .
   qed
   moreover have "g ` (U \<times> S') = f ` U \<times> S'"
     by (auto simp: g_def image_iff)
   moreover have "0 \<in> S'"
     using \<open>subspace S'\<close> subspace_affine by blast
   ultimately show ?thesis
     by (auto simp: openin_Times_eq)
 qed
 
 
 corollary invariance_of_domain_subspaces:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and "subspace U" "subspace V" and VU: "dim V \<le> dim U"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S"
     shows "openin (top_of_set V) (f ` S)"
 proof -
   obtain V' where "subspace V'" "V' \<subseteq> U" "dim V' = dim V"
     using choose_subspace_of_subspace [OF VU]
     by (metis span_eq_iff \<open>subspace U\<close>)
   then have "V homeomorphic V'"
     by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
   then obtain h k where homhk: "homeomorphism V V' h k"
     using homeomorphic_def by blast
   have eq: "f ` S = k ` (h \<circ> f) ` S"
   proof -
     have "k ` h ` f ` S = f ` S"
       by (meson fim homeomorphism_def homeomorphism_of_subsets homhk subset_refl)
     then show ?thesis
       by (simp add: image_comp)
   qed
   show ?thesis
     unfolding eq
   proof (rule homeomorphism_imp_open_map)
     show homkh: "homeomorphism V' V k h"
       by (simp add: homeomorphism_symD homhk)
     have hfV': "(h \<circ> f) ` S \<subseteq> V'"
       using fim homeomorphism_image1 homhk by fastforce
     moreover have "openin (top_of_set U) ((h \<circ> f) ` S)"
     proof (rule inv_of_domain_ss1)
       show "continuous_on S (h \<circ> f)"
         by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
       show "inj_on (h \<circ> f) S"
         apply (clarsimp simp: inj_on_def)
         by (metis fim homeomorphism_apply2 [OF homkh] image_subset_iff inj_onD injf)
       show "(h \<circ> f) ` S \<subseteq> U"
         using \<open>V' \<subseteq> U\<close> hfV' by auto
       qed (auto simp: assms)
     ultimately show "openin (top_of_set V') ((h \<circ> f) ` S)"
       using openin_subset_trans \<open>V' \<subseteq> U\<close> by force
   qed
 qed
 
 corollary invariance_of_dimension_subspaces:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and "subspace U" "subspace V"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "dim U \<le> dim V"
 proof -
   have "False" if "dim V < dim U"
   proof -
     obtain T where "subspace T" "T \<subseteq> U" "dim T = dim V"
       using choose_subspace_of_subspace [of "dim V" U]
       by (metis \<open>dim V < dim U\<close> assms(2) order.strict_implies_order span_eq_iff)
     then have "V homeomorphic T"
       by (simp add: \<open>subspace V\<close> homeomorphic_subspaces)
     then obtain h k where homhk: "homeomorphism V T h k"
       using homeomorphic_def  by blast
     have "continuous_on S (h \<circ> f)"
       by (meson contf continuous_on_compose continuous_on_subset fim homeomorphism_cont1 homhk)
     moreover have "(h \<circ> f) ` S \<subseteq> U"
       using \<open>T \<subseteq> U\<close> fim homeomorphism_image1 homhk by fastforce
     moreover have "inj_on (h \<circ> f) S"
       apply (clarsimp simp: inj_on_def)
       by (metis fim homeomorphism_apply1 homhk image_subset_iff inj_onD injf)
     ultimately have ope_hf: "openin (top_of_set U) ((h \<circ> f) ` S)"
       using invariance_of_domain_subspaces [OF ope \<open>subspace U\<close> \<open>subspace U\<close>] by blast
     have "(h \<circ> f) ` S \<subseteq> T"
       using fim homeomorphism_image1 homhk by fastforce
     then have "dim ((h \<circ> f) ` S) \<le> dim T"
       by (rule dim_subset)
     also have "dim ((h \<circ> f) ` S) = dim U"
       using \<open>S \<noteq> {}\<close> \<open>subspace U\<close>
       by (blast intro: dim_openin ope_hf)
     finally show False
       using \<open>dim V < dim U\<close> \<open>dim T = dim V\<close> by simp
   qed
   then show ?thesis
     using not_less by blast
 qed
 
 corollary invariance_of_domain_affine_sets:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and aff: "affine U" "affine V" "aff_dim V \<le> aff_dim U"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S"
     shows "openin (top_of_set V) (f ` S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by auto
 next
   case False
   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
     using False fim ope openin_contains_cball by fastforce
   have "openin (top_of_set ((+) (- b) ` V)) (((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S)"
   proof (rule invariance_of_domain_subspaces)
     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
     show "subspace ((+) (- a) ` U)"
       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
     show "subspace ((+) (- b) ` V)"
       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
     show "dim ((+) (- b) ` V) \<le> dim ((+) (- a) ` U)"
       by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
       using fim by auto
     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
       by (auto simp: inj_on_def) (meson inj_onD injf)
   qed
   then show ?thesis
     by (metis (no_types, lifting) homeomorphism_imp_open_map homeomorphism_translation image_comp translation_galois)
 qed
 
 corollary invariance_of_dimension_affine_sets:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes ope: "openin (top_of_set U) S"
       and aff: "affine U" "affine V"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> V"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "aff_dim U \<le> aff_dim V"
 proof -
   obtain a b where "a \<in> S" "a \<in> U" "b \<in> V"
     using \<open>S \<noteq> {}\<close> fim ope openin_contains_cball by fastforce
   have "dim ((+) (- a) ` U) \<le> dim ((+) (- b) ` V)"
   proof (rule invariance_of_dimension_subspaces)
     show "openin (top_of_set ((+) (- a) ` U)) ((+) (- a) ` S)"
       by (metis ope homeomorphism_imp_open_map homeomorphism_translation translation_galois)
     show "subspace ((+) (- a) ` U)"
       by (simp add: \<open>a \<in> U\<close> affine_diffs_subspace_subtract \<open>affine U\<close> cong: image_cong_simp)
     show "subspace ((+) (- b) ` V)"
       by (simp add: \<open>b \<in> V\<close> affine_diffs_subspace_subtract \<open>affine V\<close> cong: image_cong_simp)
     show "continuous_on ((+) (- a) ` S) ((+) (- b) \<circ> f \<circ> (+) a)"
       by (metis contf continuous_on_compose homeomorphism_cont2 homeomorphism_translation translation_galois)
     show "((+) (- b) \<circ> f \<circ> (+) a) ` (+) (- a) ` S \<subseteq> (+) (- b) ` V"
       using fim by auto
     show "inj_on ((+) (- b) \<circ> f \<circ> (+) a) ((+) (- a) ` S)"
       by (auto simp: inj_on_def) (meson inj_onD injf)
   qed (use \<open>S \<noteq> {}\<close> in auto)
   then show ?thesis
     by (metis \<open>a \<in> U\<close> \<open>b \<in> V\<close> aff_dim_eq_dim affine_hull_eq aff of_nat_le_iff)
 qed
 
 corollary invariance_of_dimension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and "open S"
       and injf: "inj_on f S" and "S \<noteq> {}"
     shows "DIM('a) \<le> DIM('b)"
   using invariance_of_dimension_subspaces [of UNIV S UNIV f] assms
   by auto
 
 
 corollary continuous_injective_image_subspace_dim_le:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "subspace S" "subspace T"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
       and injf: "inj_on f S"
     shows "dim S \<le> dim T"
   apply (rule invariance_of_dimension_subspaces [of S S _ f])
   using assms by (auto simp: subspace_affine)
 
 lemma invariance_of_dimension_convex_domain:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "convex S"
       and contf: "continuous_on S f" and fim: "f ` S \<subseteq> affine hull T"
       and injf: "inj_on f S"
     shows "aff_dim S \<le> aff_dim T"
 proof (cases "S = {}")
   case True
   then show ?thesis by (simp add: aff_dim_geq)
 next
   case False
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
   proof (rule invariance_of_dimension_affine_sets)
     show "openin (top_of_set (affine hull S)) (rel_interior S)"
       by (simp add: openin_rel_interior)
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "f ` rel_interior S \<subseteq> affine hull T"
       using fim rel_interior_subset by blast
     show "inj_on f (rel_interior S)"
       using inj_on_subset injf rel_interior_subset by blast
     show "rel_interior S \<noteq> {}"
       by (simp add: False \<open>convex S\<close> rel_interior_eq_empty)
   qed auto
   then show ?thesis
     by simp
 qed
 
 
 lemma homeomorphic_convex_sets_le:
   assumes "convex S" "S homeomorphic T"
   shows "aff_dim S \<le> aff_dim T"
 proof -
   obtain h k where homhk: "homeomorphism S T h k"
     using homeomorphic_def assms  by blast
   show ?thesis
   proof (rule invariance_of_dimension_convex_domain [OF \<open>convex S\<close>])
     show "continuous_on S h"
       using homeomorphism_def homhk by blast
     show "h ` S \<subseteq> affine hull T"
       by (metis homeomorphism_def homhk hull_subset)
     show "inj_on h S"
       by (meson homeomorphism_apply1 homhk inj_on_inverseI)
   qed
 qed
 
 lemma homeomorphic_convex_sets:
   assumes "convex S" "convex T" "S homeomorphic T"
   shows "aff_dim S = aff_dim T"
   by (meson assms dual_order.antisym homeomorphic_convex_sets_le homeomorphic_sym)
 
 lemma homeomorphic_convex_compact_sets_eq:
   assumes "convex S" "compact S" "convex T" "compact T"
   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
   by (meson assms homeomorphic_convex_compact_sets homeomorphic_convex_sets)
 
 lemma invariance_of_domain_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
     shows "open(f ` S)"
   using invariance_of_domain_subspaces [of UNIV S UNIV f] assms by auto
 
 lemma injective_into_1d_imp_open_map_UNIV:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "open T" "continuous_on S f" "inj_on f S" "T \<subseteq> S"
     shows "open (f ` T)"
   apply (rule invariance_of_domain_gen [OF \<open>open T\<close>])
   using assms apply (auto simp: elim: continuous_on_subset subset_inj_on)
   done
 
 lemma continuous_on_inverse_open:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" and gf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
     shows "continuous_on (f ` S) g"
 proof (clarsimp simp add: continuous_openin_preimage_eq)
   fix T :: "'a set"
   assume "open T"
   have eq: "f ` S \<inter> g -` T = f ` (S \<inter> T)"
     by (auto simp: gf)
   show "openin (top_of_set (f ` S)) (f ` S \<inter> g -` T)"
     apply (subst eq)
     apply (rule open_openin_trans)
       apply (rule invariance_of_domain_gen)
     using assms
          apply auto
     using inj_on_inverseI apply auto[1]
     by (metis \<open>open T\<close> continuous_on_subset inj_onI inj_on_subset invariance_of_domain_gen openin_open openin_open_eq)
 qed
 
 lemma invariance_of_domain_homeomorphism:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
   obtains g where "homeomorphism S (f ` S) f g"
 proof
   show "homeomorphism S (f ` S) f (inv_into S f)"
     by (simp add: assms continuous_on_inverse_open homeomorphism_def)
 qed
 
 corollary invariance_of_domain_homeomorphic:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "open S" "continuous_on S f" "DIM('b) \<le> DIM('a)" "inj_on f S"
   shows "S homeomorphic (f ` S)"
   using invariance_of_domain_homeomorphism [OF assms]
   by (meson homeomorphic_def)
 
 lemma continuous_image_subset_interior:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "continuous_on S f" "inj_on f S" "DIM('b) \<le> DIM('a)"
   shows "f ` (interior S) \<subseteq> interior(f ` S)"
   apply (rule interior_maximal)
    apply (simp add: image_mono interior_subset)
   apply (rule invariance_of_domain_gen)
   using assms
      apply (auto simp: subset_inj_on interior_subset continuous_on_subset)
   done
 
 lemma homeomorphic_interiors_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and dimeq: "DIM('a) = DIM('b)"
   shows "(interior S) homeomorphic (interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` interior S \<subseteq> interior T"
     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
   have gim: "g ` interior T \<subseteq> interior S"
     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
   show "homeomorphism (interior S) (interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show "\<And>x. x \<in> interior S \<Longrightarrow> g (f x) = x"
       by (meson \<open>\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x\<close> subsetD interior_subset)
     have "interior T \<subseteq> f ` interior S"
     proof
       fix x assume "x \<in> interior T"
       then have "g x \<in> interior S"
         using gim by blast
       then show "x \<in> f ` interior S"
         by (metis T \<open>x \<in> interior T\<close> image_iff interior_subset subsetCE)
     qed
     then show "f ` interior S = interior T"
       using fim by blast
     show "continuous_on (interior S) f"
       by (metis interior_subset continuous_on_subset contf)
     show "\<And>y. y \<in> interior T \<Longrightarrow> f (g y) = y"
       by (meson T subsetD interior_subset)
     have "interior S \<subseteq> g ` interior T"
     proof
       fix x assume "x \<in> interior S"
       then have "f x \<in> interior T"
         using fim by blast
       then show "x \<in> g ` interior T"
         by (metis S \<open>x \<in> interior S\<close> image_iff interior_subset subsetCE)
     qed
     then show "g ` interior T = interior S"
       using gim by blast
     show "continuous_on (interior T) g"
       by (metis interior_subset continuous_on_subset contg)
   qed
 qed
 
 lemma homeomorphic_open_imp_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "open S" "S \<noteq> {}" "open T" "T \<noteq> {}"
   shows "DIM('a) = DIM('b)"
     using assms
     apply (simp add: homeomorphic_minimal)
     apply (rule order_antisym; metis inj_onI invariance_of_dimension)
     done
 
 proposition homeomorphic_interiors:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "interior S = {} \<longleftrightarrow> interior T = {}"
     shows "(interior S) homeomorphic (interior T)"
 proof (cases "interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
   then have "DIM('a) = DIM('b)"
     using assms
     apply (simp add: homeomorphic_minimal)
     apply (rule order_antisym; metis continuous_on_subset inj_onI inj_on_subset interior_subset invariance_of_dimension open_interior)
     done
   then show ?thesis
     by (rule homeomorphic_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 lemma homeomorphic_frontiers_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "closed S" "closed T" and dimeq: "DIM('a) = DIM('b)"
   shows "(frontier S) homeomorphic (frontier T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have "g ` interior T \<subseteq> interior S"
     using continuous_image_subset_interior [OF contg \<open>inj_on g T\<close>] dimeq gTS by simp
   then have fim: "f ` frontier S \<subseteq> frontier T"
     apply (simp add: frontier_def)
     using continuous_image_subset_interior assms(2) assms(3) S by auto
   have "f ` interior S \<subseteq> interior T"
     using continuous_image_subset_interior [OF contf \<open>inj_on f S\<close>] dimeq fST by simp
   then have gim: "g ` frontier T \<subseteq> frontier S"
     apply (simp add: frontier_def)
     using continuous_image_subset_interior T assms(2) assms(3) by auto
   show "homeomorphism (frontier S) (frontier T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> frontier S \<Longrightarrow> g (f x) = x"
       by (simp add: S assms(2) frontier_def)
     show fg: "\<And>y. y \<in> frontier T \<Longrightarrow> f (g y) = y"
       by (simp add: T assms(3) frontier_def)
     have "frontier T \<subseteq> f ` frontier S"
     proof
       fix x assume "x \<in> frontier T"
       then have "g x \<in> frontier S"
         using gim by blast
       then show "x \<in> f ` frontier S"
         by (metis fg \<open>x \<in> frontier T\<close> imageI)
     qed
     then show "f ` frontier S = frontier T"
       using fim by blast
     show "continuous_on (frontier S) f"
       by (metis Diff_subset assms(2) closure_eq contf continuous_on_subset frontier_def)
     have "frontier S \<subseteq> g ` frontier T"
     proof
       fix x assume "x \<in> frontier S"
       then have "f x \<in> frontier T"
         using fim by blast
       then show "x \<in> g ` frontier T"
         by (metis gf \<open>x \<in> frontier S\<close> imageI)
     qed
     then show "g ` frontier T = frontier S"
       using gim by blast
     show "continuous_on (frontier T) g"
       by (metis Diff_subset assms(3) closure_closed contg continuous_on_subset frontier_def)
   qed
 qed
 
 lemma homeomorphic_frontiers:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "closed S" "closed T"
           "interior S = {} \<longleftrightarrow> interior T = {}"
     shows "(frontier S) homeomorphic (frontier T)"
 proof (cases "interior T = {}")
   case True
   then show ?thesis
     by (metis Diff_empty assms closure_eq frontier_def)
 next
   case False
   show ?thesis
     apply (rule homeomorphic_frontiers_same_dimension)
        apply (simp_all add: assms)
     using False assms homeomorphic_interiors homeomorphic_open_imp_same_dimension by blast
 qed
 
 lemma continuous_image_subset_rel_interior:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and TS: "aff_dim T \<le> aff_dim S"
   shows "f ` (rel_interior S) \<subseteq> rel_interior(f ` S)"
 proof (rule rel_interior_maximal)
   show "f ` rel_interior S \<subseteq> f ` S"
     by(simp add: image_mono rel_interior_subset)
   show "openin (top_of_set (affine hull f ` S)) (f ` rel_interior S)"
   proof (rule invariance_of_domain_affine_sets)
     show "openin (top_of_set (affine hull S)) (rel_interior S)"
       by (simp add: openin_rel_interior)
     show "aff_dim (affine hull f ` S) \<le> aff_dim (affine hull S)"
       by (metis aff_dim_affine_hull aff_dim_subset fim TS order_trans)
     show "f ` rel_interior S \<subseteq> affine hull f ` S"
       by (meson \<open>f ` rel_interior S \<subseteq> f ` S\<close> hull_subset order_trans)
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "inj_on f (rel_interior S)"
       using inj_on_subset injf rel_interior_subset by blast
   qed auto
 qed
 
 lemma homeomorphic_rel_interiors_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
   shows "(rel_interior S) homeomorphic (rel_interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
   show "homeomorphism (rel_interior S) (rel_interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> rel_interior S \<Longrightarrow> g (f x) = x"
       using S rel_interior_subset by blast
     show fg: "\<And>y. y \<in> rel_interior T \<Longrightarrow> f (g y) = y"
       using T mem_rel_interior_ball by blast
     have "rel_interior T \<subseteq> f ` rel_interior S"
     proof
       fix x assume "x \<in> rel_interior T"
       then have "g x \<in> rel_interior S"
         using gim by blast
       then show "x \<in> f ` rel_interior S"
         by (metis fg \<open>x \<in> rel_interior T\<close> imageI)
     qed
     moreover have "f ` rel_interior S \<subseteq> rel_interior T"
       by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
     ultimately show "f ` rel_interior S = rel_interior T"
       by blast
     show "continuous_on (rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     have "rel_interior S \<subseteq> g ` rel_interior T"
     proof
       fix x assume "x \<in> rel_interior S"
       then have "f x \<in> rel_interior T"
         using fim by blast
       then show "x \<in> g ` rel_interior T"
         by (metis gf \<open>x \<in> rel_interior S\<close> imageI)
     qed
     then show "g ` rel_interior T = rel_interior S"
       using gim by blast
     show "continuous_on (rel_interior T) g"
       using contg continuous_on_subset rel_interior_subset by blast
   qed
 qed
 
 lemma homeomorphic_rel_interiors:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
     shows "(rel_interior S) homeomorphic (rel_interior T)"
 proof (cases "rel_interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
   obtain f g
     where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
       and contf: "continuous_on S f" and contg: "continuous_on T g"
     using  assms [unfolded homeomorphic_minimal] by auto
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
           apply (simp_all add: openin_rel_interior False assms)
     using contf continuous_on_subset rel_interior_subset apply blast
       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
     done
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
           apply (simp_all add: openin_rel_interior False assms)
     using contg continuous_on_subset rel_interior_subset apply blast
       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
     done
   ultimately have "aff_dim S = aff_dim T" by force
   then show ?thesis
     by (rule homeomorphic_rel_interiors_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 
 lemma homeomorphic_rel_boundaries_same_dimension:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" and aff: "aff_dim S = aff_dim T"
   shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
   using assms [unfolded homeomorphic_minimal]
   unfolding homeomorphic_def
 proof (clarify elim!: ex_forward)
   fix f g
   assume S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
      and contf: "continuous_on S f" and contg: "continuous_on T g"
   then have fST: "f ` S = T" and gTS: "g ` T = S" and "inj_on f S" "inj_on g T"
     by (auto simp: inj_on_def intro: rev_image_eqI) metis+
   have fim: "f ` rel_interior S \<subseteq> rel_interior T"
     by (metis \<open>inj_on f S\<close> aff contf continuous_image_subset_rel_interior fST order_refl)
   have gim: "g ` rel_interior T \<subseteq> rel_interior S"
     by (metis \<open>inj_on g T\<close> aff contg continuous_image_subset_rel_interior gTS order_refl)
   show "homeomorphism (S - rel_interior S) (T - rel_interior T) f g"
     unfolding homeomorphism_def
   proof (intro conjI ballI)
     show gf: "\<And>x. x \<in> S - rel_interior S \<Longrightarrow> g (f x) = x"
       using S rel_interior_subset by blast
     show fg: "\<And>y. y \<in> T - rel_interior T \<Longrightarrow> f (g y) = y"
       using T mem_rel_interior_ball by blast
     show "f ` (S - rel_interior S) = T - rel_interior T"
       using S fST fim gim by auto
     show "continuous_on (S - rel_interior S) f"
       using contf continuous_on_subset rel_interior_subset by blast
     show "g ` (T - rel_interior T) = S - rel_interior S"
       using T gTS gim fim by auto
     show "continuous_on (T - rel_interior T) g"
       using contg continuous_on_subset rel_interior_subset by blast
   qed
 qed
 
 lemma homeomorphic_rel_boundaries:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T" "rel_interior S = {} \<longleftrightarrow> rel_interior T = {}"
     shows "(S - rel_interior S) homeomorphic (T - rel_interior T)"
 proof (cases "rel_interior T = {}")
   case True
   with assms show ?thesis by auto
 next
   case False
   obtain f g
     where S: "\<forall>x\<in>S. f x \<in> T \<and> g (f x) = x" and T: "\<forall>y\<in>T. g y \<in> S \<and> f (g y) = y"
       and contf: "continuous_on S f" and contg: "continuous_on T g"
     using  assms [unfolded homeomorphic_minimal] by auto
   have "aff_dim (affine hull S) \<le> aff_dim (affine hull T)"
     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior S" _ f])
           apply (simp_all add: openin_rel_interior False assms)
     using contf continuous_on_subset rel_interior_subset apply blast
       apply (meson S hull_subset image_subsetI rel_interior_subset rev_subsetD)
     apply (metis S inj_on_inverseI inj_on_subset rel_interior_subset)
     done
   moreover have "aff_dim (affine hull T) \<le> aff_dim (affine hull S)"
     apply (rule invariance_of_dimension_affine_sets [of _ "rel_interior T" _ g])
           apply (simp_all add: openin_rel_interior False assms)
     using contg continuous_on_subset rel_interior_subset apply blast
       apply (meson T hull_subset image_subsetI rel_interior_subset rev_subsetD)
     apply (metis T inj_on_inverseI inj_on_subset rel_interior_subset)
     done
   ultimately have "aff_dim S = aff_dim T" by force
   then show ?thesis
     by (rule homeomorphic_rel_boundaries_same_dimension [OF \<open>S homeomorphic T\<close>])
 qed
 
 proposition uniformly_continuous_homeomorphism_UNIV_trivial:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes contf: "uniformly_continuous_on S f" and hom: "homeomorphism S UNIV f g"
   shows "S = UNIV"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (metis UNIV_I hom empty_iff homeomorphism_def image_eqI)
 next
   case False
   have "inj g"
     by (metis UNIV_I hom homeomorphism_apply2 injI)
   then have "open (g ` UNIV)"
     by (blast intro: invariance_of_domain hom homeomorphism_cont2)
   then have "open S"
     using hom homeomorphism_image2 by blast
   moreover have "complete S"
     unfolding complete_def
   proof clarify
     fix \<sigma>
     assume \<sigma>: "\<forall>n. \<sigma> n \<in> S" and "Cauchy \<sigma>"
     have "Cauchy (f o \<sigma>)"
       using uniformly_continuous_imp_Cauchy_continuous \<open>Cauchy \<sigma>\<close> \<sigma> contf by blast
     then obtain l where "(f \<circ> \<sigma>) \<longlonglongrightarrow> l"
       by (auto simp: convergent_eq_Cauchy [symmetric])
     show "\<exists>l\<in>S. \<sigma> \<longlonglongrightarrow> l"
     proof
       show "g l \<in> S"
         using hom homeomorphism_image2 by blast
       have "(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l"
         by (meson UNIV_I \<open>(f \<circ> \<sigma>) \<longlonglongrightarrow> l\<close> continuous_on_sequentially hom homeomorphism_cont2)
       then show "\<sigma> \<longlonglongrightarrow> g l"
       proof -
         have "\<forall>n. \<sigma> n = (g \<circ> (f \<circ> \<sigma>)) n"
           by (metis (no_types) \<sigma> comp_eq_dest_lhs hom homeomorphism_apply1)
         then show ?thesis
           by (metis (no_types) LIMSEQ_iff \<open>(g \<circ> (f \<circ> \<sigma>)) \<longlonglongrightarrow> g l\<close>)
       qed
     qed
   qed
   then have "closed S"
     by (simp add: complete_eq_closed)
   ultimately show ?thesis
     using clopen [of S] False  by simp
 qed
 
 subsection\<open>Formulation of loop homotopy in terms of maps out of type complex\<close>
 
 lemma homotopic_circlemaps_imp_homotopic_loops:
   assumes "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
    shows "homotopic_loops S (f \<circ> exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))
                             (g \<circ> exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))"
 proof -
   have "homotopic_with_canon (\<lambda>f. True) {z. cmod z = 1} S f g"
     using assms by (auto simp: sphere_def)
   moreover have "continuous_on {0..1} (exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>))"
      by (intro continuous_intros)
   moreover have "(exp \<circ> (\<lambda>t. 2 * of_real pi * of_real t * \<i>)) ` {0..1} \<subseteq> {z. cmod z = 1}"
     by (auto simp: norm_mult)
   ultimately
   show ?thesis
     apply (simp add: homotopic_loops_def comp_assoc)
     apply (rule homotopic_with_compose_continuous_right)
       apply (auto simp: pathstart_def pathfinish_def)
     done
 qed
 
 lemma homotopic_loops_imp_homotopic_circlemaps:
   assumes "homotopic_loops S p q"
     shows "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S
                           (p \<circ> (\<lambda>z. (Arg2pi z / (2 * pi))))
                           (q \<circ> (\<lambda>z. (Arg2pi z / (2 * pi))))"
 proof -
   obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
              and him: "h ` ({0..1} \<times> {0..1}) \<subseteq> S"
              and h0: "(\<forall>x. h (0, x) = p x)"
              and h1: "(\<forall>x. h (1, x) = q x)"
              and h01: "(\<forall>t\<in>{0..1}. h (t, 1) = h (t, 0)) "
     using assms
     by (auto simp: homotopic_loops_def sphere_def homotopic_with_def pathstart_def pathfinish_def)
   define j where "j \<equiv> \<lambda>z. if 0 \<le> Im (snd z)
                           then h (fst z, Arg2pi (snd z) / (2 * pi))
                           else h (fst z, 1 - Arg2pi (cnj (snd z)) / (2 * pi))"
   have Arg2pi_eq: "1 - Arg2pi (cnj y) / (2 * pi) = Arg2pi y / (2 * pi) \<or> Arg2pi y = 0 \<and> Arg2pi (cnj y) = 0" if "cmod y = 1" for y
     using that Arg2pi_eq_0_pi Arg2pi_eq_pi by (force simp: Arg2pi_cnj field_split_simps)
   show ?thesis
   proof (simp add: homotopic_with; intro conjI ballI exI)
     show "continuous_on ({0..1} \<times> sphere 0 1) (\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi)))"
     proof (rule continuous_on_eq)
       show j: "j x = h (fst x, Arg2pi (snd x) / (2 * pi))" if "x \<in> {0..1} \<times> sphere 0 1" for x
         using Arg2pi_eq that h01 by (force simp: j_def)
       have eq:  "S = S \<inter> (UNIV \<times> {z. 0 \<le> Im z}) \<union> S \<inter> (UNIV \<times> {z. Im z \<le> 0})" for S :: "(real*complex)set"
         by auto
       have c1: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. 0 \<le> Im z}) (\<lambda>x. h (fst x, Arg2pi (snd x) / (2 * pi)))"
         apply (intro continuous_intros continuous_on_compose2 [OF conth]  continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
             apply (auto simp: Arg2pi)
         apply (meson Arg2pi_lt_2pi linear not_le)
         done
       have c2: "continuous_on ({0..1} \<times> sphere 0 1 \<inter> UNIV \<times> {z. Im z \<le> 0}) (\<lambda>x. h (fst x, 1 - Arg2pi (cnj (snd x)) / (2 * pi)))"
         apply (intro continuous_intros continuous_on_compose2 [OF conth]  continuous_on_compose2 [OF continuous_on_upperhalf_Arg2pi])
             apply (auto simp: Arg2pi)
         apply (meson Arg2pi_lt_2pi linear not_le)
         done
       show "continuous_on ({0..1} \<times> sphere 0 1) j"
         apply (simp add: j_def)
         apply (subst eq)
         apply (rule continuous_on_cases_local)
             apply (simp_all add: eq [symmetric] closedin_closed_Int closed_Times closed_halfspace_Im_le closed_halfspace_Im_ge c1 c2)
         using Arg2pi_eq h01
         by force
     qed
     have "(\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi))) ` ({0..1} \<times> sphere 0 1) \<subseteq> h ` ({0..1} \<times> {0..1})"
       by (auto simp: Arg2pi_ge_0 Arg2pi_lt_2pi less_imp_le)
     also have "... \<subseteq> S"
       using him by blast
     finally show "(\<lambda>w. h (fst w, Arg2pi (snd w) / (2 * pi))) ` ({0..1} \<times> sphere 0 1) \<subseteq> S" .
   qed (auto simp: h0 h1)
 qed
 
 lemma simply_connected_homotopic_loops:
   "simply_connected S \<longleftrightarrow>
        (\<forall>p q. homotopic_loops S p p \<and> homotopic_loops S q q \<longrightarrow> homotopic_loops S p q)"
 unfolding simply_connected_def using homotopic_loops_refl by metis
 
 
 lemma simply_connected_eq_homotopic_circlemaps1:
   fixes f :: "complex \<Rightarrow> 'a::topological_space" and g :: "complex \<Rightarrow> 'a"
   assumes S: "simply_connected S"
       and contf: "continuous_on (sphere 0 1) f" and fim: "f ` (sphere 0 1) \<subseteq> S"
       and contg: "continuous_on (sphere 0 1) g" and gim: "g ` (sphere 0 1) \<subseteq> S"
     shows "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
 proof -
   have "homotopic_loops S (f \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi * t) * \<i>)) (g \<circ> exp \<circ> (\<lambda>t. of_real(2 * pi *  t) * \<i>))"
     apply (rule S [unfolded simply_connected_homotopic_loops, rule_format])
     apply (simp add: homotopic_circlemaps_imp_homotopic_loops contf fim contg gim)
     done
   then show ?thesis
     apply (rule homotopic_with_eq [OF homotopic_loops_imp_homotopic_circlemaps])
       apply (auto simp: o_def complex_norm_eq_1_exp mult.commute)
     done
 qed
 
 lemma simply_connected_eq_homotopic_circlemaps2a:
   fixes h :: "complex \<Rightarrow> 'a::topological_space"
   assumes conth: "continuous_on (sphere 0 1) h" and him: "h ` (sphere 0 1) \<subseteq> S"
       and hom: "\<And>f g::complex \<Rightarrow> 'a.
                 \<lbrakk>continuous_on (sphere 0 1) f; f ` (sphere 0 1) \<subseteq> S;
                 continuous_on (sphere 0 1) g; g ` (sphere 0 1) \<subseteq> S\<rbrakk>
                 \<Longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
             shows "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S h (\<lambda>x. a)"
     apply (rule_tac x="h 1" in exI)
     apply (rule hom)
     using assms by (auto)
 
 lemma simply_connected_eq_homotopic_circlemaps2b:
   fixes S :: "'a::real_normed_vector set"
   assumes "\<And>f g::complex \<Rightarrow> 'a.
                 \<lbrakk>continuous_on (sphere 0 1) f; f ` (sphere 0 1) \<subseteq> S;
                 continuous_on (sphere 0 1) g; g ` (sphere 0 1) \<subseteq> S\<rbrakk>
                 \<Longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g"
   shows "path_connected S"
 proof (clarsimp simp add: path_connected_eq_homotopic_points)
   fix a b
   assume "a \<in> S" "b \<in> S"
   then show "homotopic_loops S (linepath a a) (linepath b b)"
     using homotopic_circlemaps_imp_homotopic_loops [OF assms [of "\<lambda>x. a" "\<lambda>x. b"]]
     by (auto simp: o_def linepath_def)
 qed
 
 lemma simply_connected_eq_homotopic_circlemaps3:
   fixes h :: "complex \<Rightarrow> 'a::real_normed_vector"
   assumes "path_connected S"
       and hom: "\<And>f::complex \<Rightarrow> 'a.
                   \<lbrakk>continuous_on (sphere 0 1) f; f `(sphere 0 1) \<subseteq> S\<rbrakk>
                   \<Longrightarrow> \<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f (\<lambda>x. a)"
     shows "simply_connected S"
 proof (clarsimp simp add: simply_connected_eq_contractible_loop_some assms)
   fix p
   assume p: "path p" "path_image p \<subseteq> S" "pathfinish p = pathstart p"
   then have "homotopic_loops S p p"
     by (simp add: homotopic_loops_refl)
   then obtain a where homp: "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S (p \<circ> (\<lambda>z. Arg2pi z / (2 * pi))) (\<lambda>x. a)"
     by (metis homotopic_with_imp_subset2 homotopic_loops_imp_homotopic_circlemaps homotopic_with_imp_continuous hom)
   show "\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)"
   proof (intro exI conjI)
     show "a \<in> S"
       using homotopic_with_imp_subset2 [OF homp]
       by (metis dist_0_norm image_subset_iff mem_sphere norm_one)
     have teq: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk>
                \<Longrightarrow> t = Arg2pi (exp (2 * of_real pi * of_real t * \<i>)) / (2 * pi) \<or> t=1 \<and> Arg2pi (exp (2 * of_real pi * of_real t * \<i>)) = 0"
       apply (rule disjCI)
       using Arg2pi_of_real [of 1] apply (auto simp: Arg2pi_exp)
       done
     have "homotopic_loops S p (p \<circ> (\<lambda>z. Arg2pi z / (2 * pi)) \<circ> exp \<circ> (\<lambda>t. 2 * complex_of_real pi * complex_of_real t * \<i>))"
       apply (rule homotopic_loops_eq [OF p])
       using p teq apply (fastforce simp: pathfinish_def pathstart_def)
       done
     then
     show "homotopic_loops S p (linepath a a)"
       by (simp add: linepath_refl  homotopic_loops_trans [OF _ homotopic_circlemaps_imp_homotopic_loops [OF homp, simplified K_record_comp]])
   qed
 qed
 
 
 proposition simply_connected_eq_homotopic_circlemaps:
   fixes S :: "'a::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          (\<forall>f g::complex \<Rightarrow> 'a.
               continuous_on (sphere 0 1) f \<and> f ` (sphere 0 1) \<subseteq> S \<and>
               continuous_on (sphere 0 1) g \<and> g ` (sphere 0 1) \<subseteq> S
               \<longrightarrow> homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f g)"
   apply (rule iffI)
    apply (blast elim: dest: simply_connected_eq_homotopic_circlemaps1)
   by (simp add: simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b simply_connected_eq_homotopic_circlemaps3)
 
 proposition simply_connected_eq_contractible_circlemap:
   fixes S :: "'a::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          path_connected S \<and>
          (\<forall>f::complex \<Rightarrow> 'a.
               continuous_on (sphere 0 1) f \<and> f `(sphere 0 1) \<subseteq> S
               \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) S f (\<lambda>x. a)))"
   apply (rule iffI)
    apply (simp add: simply_connected_eq_homotopic_circlemaps1 simply_connected_eq_homotopic_circlemaps2a simply_connected_eq_homotopic_circlemaps2b)
   using simply_connected_eq_homotopic_circlemaps3 by blast
 
 corollary homotopy_eqv_simple_connectedness:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homotopy_eqv T \<Longrightarrow> simply_connected S \<longleftrightarrow> simply_connected T"
   by (simp add: simply_connected_eq_homotopic_circlemaps homotopy_eqv_homotopic_triviality)
 
 
 subsection\<open>Homeomorphism of simple closed curves to circles\<close>
 
 proposition homeomorphic_simple_path_image_circle:
   fixes a :: complex and \<gamma> :: "real \<Rightarrow> 'a::t2_space"
   assumes "simple_path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and "0 < r"
   shows "(path_image \<gamma>) homeomorphic sphere a r"
 proof -
   have "homotopic_loops (path_image \<gamma>) \<gamma> \<gamma>"
     by (simp add: assms homotopic_loops_refl simple_path_imp_path)
   then have hom: "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (path_image \<gamma>)
                (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi)))"
     by (rule homotopic_loops_imp_homotopic_circlemaps)
   have "\<exists>g. homeomorphism (sphere 0 1) (path_image \<gamma>) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) g"
   proof (rule homeomorphism_compact)
     show "continuous_on (sphere 0 1) (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi)))"
       using hom homotopic_with_imp_continuous by blast
     show "inj_on (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) (sphere 0 1)"
     proof
       fix x y
       assume xy: "x \<in> sphere 0 1" "y \<in> sphere 0 1"
          and eq: "(\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) x = (\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) y"
       then have "(Arg2pi x / (2*pi)) = (Arg2pi y / (2*pi))"
       proof -
         have "(Arg2pi x / (2*pi)) \<in> {0..1}" "(Arg2pi y / (2*pi)) \<in> {0..1}"
           using Arg2pi_ge_0 Arg2pi_lt_2pi dual_order.strict_iff_order by fastforce+
         with eq show ?thesis
           using \<open>simple_path \<gamma>\<close> Arg2pi_lt_2pi unfolding simple_path_def o_def
           by (metis eq_divide_eq_1 not_less_iff_gr_or_eq)
       qed
       with xy show "x = y"
         by (metis is_Arg_def Arg2pi Arg2pi_0 dist_0_norm divide_cancel_right dual_order.strict_iff_order mem_sphere)
     qed
     have "\<And>z. cmod z = 1 \<Longrightarrow> \<exists>x\<in>{0..1}. \<gamma> (Arg2pi z / (2*pi)) = \<gamma> x"
        by (metis Arg2pi_ge_0 Arg2pi_lt_2pi atLeastAtMost_iff divide_less_eq_1 less_eq_real_def zero_less_mult_iff pi_gt_zero zero_le_divide_iff zero_less_numeral)
      moreover have "\<exists>z\<in>sphere 0 1. \<gamma> x = \<gamma> (Arg2pi z / (2*pi))" if "0 \<le> x" "x \<le> 1" for x
      proof (cases "x=1")
        case True
        with Arg2pi_of_real [of 1] loop show ?thesis
          by (rule_tac x=1 in bexI) (auto simp: pathfinish_def pathstart_def \<open>0 \<le> x\<close>)
      next
        case False
        then have *: "(Arg2pi (exp (\<i>*(2* of_real pi* of_real x))) / (2*pi)) = x"
          using that by (auto simp: Arg2pi_exp field_split_simps)
        show ?thesis
          by (rule_tac x="exp(\<i> * of_real(2*pi*x))" in bexI) (auto simp: *)
     qed
     ultimately show "(\<gamma> \<circ> (\<lambda>z. Arg2pi z / (2*pi))) ` sphere 0 1 = path_image \<gamma>"
       by (auto simp: path_image_def image_iff)
     qed auto
     then have "path_image \<gamma> homeomorphic sphere (0::complex) 1"
       using homeomorphic_def homeomorphic_sym by blast
   also have "... homeomorphic sphere a r"
     by (simp add: assms homeomorphic_spheres)
   finally show ?thesis .
 qed
 
 lemma homeomorphic_simple_path_images:
   fixes \<gamma>1 :: "real \<Rightarrow> 'a::t2_space" and \<gamma>2 :: "real \<Rightarrow> 'b::t2_space"
   assumes "simple_path \<gamma>1" and loop: "pathfinish \<gamma>1 = pathstart \<gamma>1"
   assumes "simple_path \<gamma>2" and loop: "pathfinish \<gamma>2 = pathstart \<gamma>2"
   shows "(path_image \<gamma>1) homeomorphic (path_image \<gamma>2)"
   by (meson assms homeomorphic_simple_path_image_circle homeomorphic_sym homeomorphic_trans loop pi_gt_zero)
 
 subsection\<open>Dimension-based conditions for various homeomorphisms\<close>
 
 lemma homeomorphic_subspaces_eq:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "subspace S" "subspace T"
   shows "S homeomorphic T \<longleftrightarrow> dim S = dim T"
 proof
   assume "S homeomorphic T"
   then obtain f g where hom: "homeomorphism S T f g"
     using homeomorphic_def by blast
   show "dim S = dim T"
   proof (rule order_antisym)
     show "dim S \<le> dim T"
       by (metis assms dual_order.refl inj_onI homeomorphism_cont1 [OF hom] homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom] continuous_injective_image_subspace_dim_le)
     show "dim T \<le> dim S"
       by (metis assms dual_order.refl inj_onI homeomorphism_cont2 [OF hom] homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom] continuous_injective_image_subspace_dim_le)
   qed
 next
   assume "dim S = dim T"
   then show "S homeomorphic T"
     by (simp add: assms homeomorphic_subspaces)
 qed
 
 lemma homeomorphic_affine_sets_eq:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "affine S" "affine T"
   shows "S homeomorphic T \<longleftrightarrow> aff_dim S = aff_dim T"
 proof (cases "S = {} \<or> T = {}")
   case True
   then show ?thesis
     using assms homeomorphic_affine_sets by force
 next
   case False
   then obtain a b where "a \<in> S" "b \<in> T"
     by blast
   then have "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
     using affine_diffs_subspace assms by blast+
   then show ?thesis
     by (metis affine_imp_convex assms homeomorphic_affine_sets homeomorphic_convex_sets)
 qed
 
 lemma homeomorphic_hyperplanes_eq:
   fixes a :: "'a::euclidean_space" and c :: "'b::euclidean_space"
   assumes "a \<noteq> 0" "c \<noteq> 0"
   shows "({x. a \<bullet> x = b} homeomorphic {x. c \<bullet> x = d} \<longleftrightarrow> DIM('a) = DIM('b))"
   apply (auto simp: homeomorphic_affine_sets_eq affine_hyperplane assms)
   by (metis DIM_positive Suc_pred)
 
 lemma homeomorphic_UNIV_UNIV:
   shows "(UNIV::'a set) homeomorphic (UNIV::'b set) \<longleftrightarrow>
     DIM('a::euclidean_space) = DIM('b::euclidean_space)"
   by (simp add: homeomorphic_subspaces_eq)
 
 lemma simply_connected_sphere_gen:
    assumes "convex S" "bounded S" and 3: "3 \<le> aff_dim S"
    shows "simply_connected(rel_frontier S)"
 proof -
   have pa: "path_connected (rel_frontier S)"
     using assms by (simp add: path_connected_sphere_gen)
   show ?thesis
   proof (clarsimp simp add: simply_connected_eq_contractible_circlemap pa)
     fix f
     assume f: "continuous_on (sphere (0::complex) 1) f" "f ` sphere 0 1 \<subseteq> rel_frontier S"
     have eq: "sphere (0::complex) 1 = rel_frontier(cball 0 1)"
       by simp
     have "convex (cball (0::complex) 1)"
       by (rule convex_cball)
     then obtain c where "homotopic_with_canon (\<lambda>z. True) (sphere (0::complex) 1) (rel_frontier S) f (\<lambda>x. c)"
       apply (rule inessential_spheremap_lowdim_gen [OF _ bounded_cball \<open>convex S\<close> \<open>bounded S\<close>, where f=f])
       using f 3
          apply (auto simp: aff_dim_cball)
       done
     then show "\<exists>a. homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (rel_frontier S) f (\<lambda>x. a)"
       by blast
   qed
 qed
 
 subsection\<open>more invariance of domain\<close>(*FIX ME title? *)
 
 proposition invariance_of_domain_sphere_affine_set_gen:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and U: "bounded U" "convex U"
       and "affine T" and affTU: "aff_dim T < aff_dim U"
       and ope: "openin (top_of_set (rel_frontier U)) S"
    shows "openin (top_of_set T) (f ` S)"
 proof (cases "rel_frontier U = {}")
   case True
   then show ?thesis
     using ope openin_subset by force
 next
   case False
   obtain b c where b: "b \<in> rel_frontier U" and c: "c \<in> rel_frontier U" and "b \<noteq> c"
     using \<open>bounded U\<close> rel_frontier_not_sing [of U] subset_singletonD False  by fastforce
   obtain V :: "'a set" where "affine V" and affV: "aff_dim V = aff_dim U - 1"
   proof (rule choose_affine_subset [OF affine_UNIV])
     show "- 1 \<le> aff_dim U - 1"
       by (metis aff_dim_empty aff_dim_geq aff_dim_negative_iff affTU diff_0 diff_right_mono not_le)
     show "aff_dim U - 1 \<le> aff_dim (UNIV::'a set)"
       by (metis aff_dim_UNIV aff_dim_le_DIM le_cases not_le zle_diff1_eq)
   qed auto
   have SU: "S \<subseteq> rel_frontier U"
     using ope openin_imp_subset by auto
   have homb: "rel_frontier U - {b} homeomorphic V"
    and homc: "rel_frontier U - {c} homeomorphic V"
     using homeomorphic_punctured_sphere_affine_gen [of U _ V]
     by (simp_all add: \<open>affine V\<close> affV U b c)
   then obtain g h j k
            where gh: "homeomorphism (rel_frontier U - {b}) V g h"
              and jk: "homeomorphism (rel_frontier U - {c}) V j k"
     by (auto simp: homeomorphic_def)
   with SU have hgsub: "(h ` g ` (S - {b})) \<subseteq> S" and kjsub: "(k ` j ` (S - {c})) \<subseteq> S"
     by (simp_all add: homeomorphism_def subset_eq)
   have [simp]: "aff_dim T \<le> aff_dim V"
     by (simp add: affTU affV)
   have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}))"
   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
     show "openin (top_of_set V) (g ` (S - {b}))"
       apply (rule homeomorphism_imp_open_map [OF gh])
       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
     show "continuous_on (g ` (S - {b})) (f \<circ> h)"
        apply (rule continuous_on_compose)
         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets gh set_eq_subset)
       using contf continuous_on_subset hgsub by blast
     show "inj_on (f \<circ> h) (g ` (S - {b}))"
       using kjsub
       apply (clarsimp simp add: inj_on_def)
       by (metis SU b homeomorphism_def inj_onD injf insert_Diff insert_iff gh rev_subsetD)
     show "(f \<circ> h) ` g ` (S - {b}) \<subseteq> T"
       by (metis fim image_comp image_mono hgsub subset_trans)
   qed (auto simp: assms)
   moreover
   have "openin (top_of_set T) ((f \<circ> k) ` j ` (S - {c}))"
   proof (rule invariance_of_domain_affine_sets [OF _ \<open>affine V\<close>])
     show "openin (top_of_set V) (j ` (S - {c}))"
       apply (rule homeomorphism_imp_open_map [OF jk])
       by (meson Diff_mono Diff_subset SU ope openin_delete openin_subset_trans order_refl)
     show "continuous_on (j ` (S - {c})) (f \<circ> k)"
        apply (rule continuous_on_compose)
         apply (meson Diff_mono SU homeomorphism_def homeomorphism_of_subsets jk set_eq_subset)
       using contf continuous_on_subset kjsub by blast
     show "inj_on (f \<circ> k) (j ` (S - {c}))"
       using kjsub
       apply (clarsimp simp add: inj_on_def)
       by (metis SU c homeomorphism_def inj_onD injf insert_Diff insert_iff jk rev_subsetD)
     show "(f \<circ> k) ` j ` (S - {c}) \<subseteq> T"
       by (metis fim image_comp image_mono kjsub subset_trans)
   qed (auto simp: assms)
   ultimately have "openin (top_of_set T) ((f \<circ> h) ` g ` (S - {b}) \<union> ((f \<circ> k) ` j ` (S - {c})))"
     by (rule openin_Un)
   moreover have "(f \<circ> h) ` g ` (S - {b}) = f ` (S - {b})"
   proof -
     have "h ` g ` (S - {b}) = (S - {b})"
     proof
       show "h ` g ` (S - {b}) \<subseteq> S - {b}"
         using homeomorphism_apply1 [OF gh] SU
         by (fastforce simp add: image_iff image_subset_iff)
       show "S - {b} \<subseteq> h ` g ` (S - {b})"
         apply clarify
         by  (metis SU subsetD homeomorphism_apply1 [OF gh] image_iff member_remove remove_def)
     qed
     then show ?thesis
       by (metis image_comp)
   qed
   moreover have "(f \<circ> k) ` j ` (S - {c}) = f ` (S - {c})"
   proof -
     have "k ` j ` (S - {c}) = (S - {c})"
     proof
       show "k ` j ` (S - {c}) \<subseteq> S - {c}"
         using homeomorphism_apply1 [OF jk] SU
         by (fastforce simp add: image_iff image_subset_iff)
       show "S - {c} \<subseteq> k ` j ` (S - {c})"
         apply clarify
         by  (metis SU subsetD homeomorphism_apply1 [OF jk] image_iff member_remove remove_def)
     qed
     then show ?thesis
       by (metis image_comp)
   qed
   moreover have "f ` (S - {b}) \<union> f ` (S - {c}) = f ` (S)"
     using \<open>b \<noteq> c\<close> by blast
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma invariance_of_domain_sphere_affine_set:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and injf: "inj_on f S" and fim: "f ` S \<subseteq> T"
       and "r \<noteq> 0" "affine T" and affTU: "aff_dim T < DIM('a)"
       and ope: "openin (top_of_set (sphere a r)) S"
    shows "openin (top_of_set T) (f ` S)"
 proof (cases "sphere a r = {}")
   case True
   then show ?thesis
     using ope openin_subset by force
 next
   case False
   show ?thesis
   proof (rule invariance_of_domain_sphere_affine_set_gen [OF contf injf fim bounded_cball convex_cball \<open>affine T\<close>])
     show "aff_dim T < aff_dim (cball a r)"
       by (metis False affTU aff_dim_cball assms(4) linorder_cases sphere_empty)
     show "openin (top_of_set (rel_frontier (cball a r))) S"
       by (simp add: \<open>r \<noteq> 0\<close> ope)
   qed
 qed
 
 lemma no_embedding_sphere_lowdim:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on (sphere a r) f" and injf: "inj_on f (sphere a r)" and "r > 0"
    shows "DIM('a) \<le> DIM('b)"
 proof -
   have "False" if "DIM('a) > DIM('b)"
   proof -
     have "compact (f ` sphere a r)"
       using compact_continuous_image
       by (simp add: compact_continuous_image contf)
     then have "\<not> open (f ` sphere a r)"
       using compact_open
       by (metis assms(3) image_is_empty not_less_iff_gr_or_eq sphere_eq_empty)
     then show False
       using invariance_of_domain_sphere_affine_set [OF contf injf subset_UNIV] \<open>r > 0\<close>
       by (metis aff_dim_UNIV affine_UNIV less_irrefl of_nat_less_iff open_openin openin_subtopology_self subtopology_UNIV that)
   qed
   then show ?thesis
     using not_less by blast
 qed
 
 lemma simply_connected_sphere:
   fixes a :: "'a::euclidean_space"
   assumes "3 \<le> DIM('a)"
     shows "simply_connected(sphere a r)"
 proof (cases rule: linorder_cases [of r 0])
   case less
   then show ?thesis by simp
 next
   case equal
   then show ?thesis  by (auto simp: convex_imp_simply_connected)
 next
   case greater
   then show ?thesis
     using simply_connected_sphere_gen [of "cball a r"] assms
     by (simp add: aff_dim_cball)
 qed
 
 lemma simply_connected_sphere_eq:
   fixes a :: "'a::euclidean_space"
   shows "simply_connected(sphere a r) \<longleftrightarrow> 3 \<le> DIM('a) \<or> r \<le> 0"  (is "?lhs = ?rhs")
 proof (cases "r \<le> 0")
   case True
   have "simply_connected (sphere a r)"
     apply (rule convex_imp_simply_connected)
     using True less_eq_real_def by auto
   with True show ?thesis by auto
 next
   case False
   show ?thesis
   proof
     assume L: ?lhs
     have "False" if "DIM('a) = 1 \<or> DIM('a) = 2"
       using that
     proof
       assume "DIM('a) = 1"
       with L show False
         using connected_sphere_eq simply_connected_imp_connected
         by (metis False Suc_1 not_less_eq_eq order_refl)
     next
       assume "DIM('a) = 2"
       then have "sphere a r homeomorphic sphere (0::complex) 1"
         by (metis DIM_complex False homeomorphic_spheres_gen not_less zero_less_one)
       then have "simply_connected(sphere (0::complex) 1)"
         using L homeomorphic_simply_connected_eq by blast
       then obtain a::complex where "homotopic_with_canon (\<lambda>h. True) (sphere 0 1) (sphere 0 1) id (\<lambda>x. a)"
         apply (simp add: simply_connected_eq_contractible_circlemap)
         by (metis continuous_on_id' id_apply image_id subset_refl)
       then show False
         using contractible_sphere contractible_def not_one_le_zero by blast
     qed
     with False show ?rhs
       apply simp
       by (metis DIM_ge_Suc0 le_antisym not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
   next
     assume ?rhs
     with False show ?lhs by (simp add: simply_connected_sphere)
   qed
 qed
 
 
 lemma simply_connected_punctured_universe_eq:
   fixes a :: "'a::euclidean_space"
   shows "simply_connected(- {a}) \<longleftrightarrow> 3 \<le> DIM('a)"
 proof -
   have [simp]: "a \<in> rel_interior (cball a 1)"
     by (simp add: rel_interior_nonempty_interior)
   have [simp]: "affine hull cball a 1 - {a} = -{a}"
     by (metis Compl_eq_Diff_UNIV aff_dim_cball aff_dim_lt_full not_less_iff_gr_or_eq zero_less_one)
   have "simply_connected(- {a}) \<longleftrightarrow> simply_connected(sphere a 1)"
     apply (rule sym)
     apply (rule homotopy_eqv_simple_connectedness)
     using homotopy_eqv_rel_frontier_punctured_affine_hull [of "cball a 1" a] apply auto
     done
   also have "...  \<longleftrightarrow> 3 \<le> DIM('a)"
     by (simp add: simply_connected_sphere_eq)
   finally show ?thesis .
 qed
 
 lemma not_simply_connected_circle:
   fixes a :: complex
   shows "0 < r \<Longrightarrow> \<not> simply_connected(sphere a r)"
 by (simp add: simply_connected_sphere_eq)
 
 
 proposition simply_connected_punctured_convex:
   fixes a :: "'a::euclidean_space"
   assumes "convex S" and 3: "3 \<le> aff_dim S"
     shows "simply_connected(S - {a})"
 proof (cases "a \<in> rel_interior S")
   case True
   then obtain e where "a \<in> S" "0 < e" and e: "cball a e \<inter> affine hull S \<subseteq> S"
     by (auto simp: rel_interior_cball)
   have con: "convex (cball a e \<inter> affine hull S)"
     by (simp add: convex_Int)
   have bo: "bounded (cball a e \<inter> affine hull S)"
     by (simp add: bounded_Int)
   have "affine hull S \<inter> interior (cball a e) \<noteq> {}"
     using \<open>0 < e\<close> \<open>a \<in> S\<close> hull_subset by fastforce
   then have "3 \<le> aff_dim (affine hull S \<inter> cball a e)"
     by (simp add: 3 aff_dim_convex_Int_nonempty_interior [OF convex_affine_hull])
   also have "... = aff_dim (cball a e \<inter> affine hull S)"
     by (simp add: Int_commute)
   finally have "3 \<le> aff_dim (cball a e \<inter> affine hull S)" .
   moreover have "rel_frontier (cball a e \<inter> affine hull S) homotopy_eqv S - {a}"
   proof (rule homotopy_eqv_rel_frontier_punctured_convex)
     show "a \<in> rel_interior (cball a e \<inter> affine hull S)"
       by (meson IntI Int_mono \<open>a \<in> S\<close> \<open>0 < e\<close> e \<open>cball a e \<inter> affine hull S \<subseteq> S\<close> ball_subset_cball centre_in_cball dual_order.strict_implies_order hull_inc hull_mono mem_rel_interior_ball)
     have "closed (cball a e \<inter> affine hull S)"
       by blast
     then show "rel_frontier (cball a e \<inter> affine hull S) \<subseteq> S"
       apply (simp add: rel_frontier_def)
       using e by blast
     show "S \<subseteq> affine hull (cball a e \<inter> affine hull S)"
       by (metis (no_types, lifting) IntI \<open>a \<in> S\<close> \<open>0 < e\<close> affine_hull_convex_Int_nonempty_interior centre_in_ball convex_affine_hull empty_iff hull_subset inf_commute interior_cball subsetCE subsetI)
     qed (auto simp: assms con bo)
   ultimately show ?thesis
     using homotopy_eqv_simple_connectedness simply_connected_sphere_gen [OF con bo]
     by blast
 next
   case False
   show ?thesis
     apply (rule contractible_imp_simply_connected)
     apply (rule contractible_convex_tweak_boundary_points [OF \<open>convex S\<close>])
      apply (simp add: False rel_interior_subset subset_Diff_insert)
     by (meson Diff_subset closure_subset subset_trans)
 qed
 
 corollary simply_connected_punctured_universe:
   fixes a :: "'a::euclidean_space"
   assumes "3 \<le> DIM('a)"
   shows "simply_connected(- {a})"
 proof -
   have [simp]: "affine hull cball a 1 = UNIV"
     apply auto
     by (metis UNIV_I aff_dim_cball aff_dim_lt_full zero_less_one not_less_iff_gr_or_eq)
   have "simply_connected (rel_frontier (cball a 1)) = simply_connected (affine hull cball a 1 - {a})"
     apply (rule homotopy_eqv_simple_connectedness)
     apply (rule homotopy_eqv_rel_frontier_punctured_affine_hull)
       apply (force simp: rel_interior_cball intro: homotopy_eqv_simple_connectedness homotopy_eqv_rel_frontier_punctured_affine_hull)+
     done
   then show ?thesis
     using simply_connected_sphere [of a 1, OF assms] by (auto simp: Compl_eq_Diff_UNIV)
 qed
 
 
 subsection\<open>The power, squaring and exponential functions as covering maps\<close>
 
 proposition covering_space_power_punctured_plane:
   assumes "0 < n"
     shows "covering_space (- {0}) (\<lambda>z::complex. z^n) (- {0})"
 proof -
   consider "n = 1" | "2 \<le> n" using assms by linarith
   then obtain e where "0 < e"
                 and e: "\<And>w z. cmod(w - z) < e * cmod z \<Longrightarrow> (w^n = z^n \<longleftrightarrow> w = z)"
   proof cases
     assume "n = 1" then show ?thesis
       by (rule_tac e=1 in that) auto
   next
     assume "2 \<le> n"
     have eq_if_pow_eq:
          "w = z" if lt: "cmod (w - z) < 2 * sin (pi / real n) * cmod z"
                  and eq: "w^n = z^n" for w z
     proof (cases "z = 0")
       case True with eq assms show ?thesis by (auto simp: power_0_left)
     next
       case False
       then have "z \<noteq> 0" by auto
       have "(w/z)^n = 1"
         by (metis False divide_self_if eq power_divide power_one)
       then obtain j where j: "w / z = exp (2 * of_real pi * \<i> * j / n)" and "j < n"
         using Suc_leI assms \<open>2 \<le> n\<close> complex_roots_unity [THEN eqset_imp_iff, of n "w/z"]
         by force
       have "cmod (w/z - 1) < 2 * sin (pi / real n)"
         using lt assms \<open>z \<noteq> 0\<close> by (simp add: field_split_simps norm_divide)
       then have "cmod (exp (\<i> * of_real (2 * pi * j / n)) - 1) < 2 * sin (pi / real n)"
         by (simp add: j field_simps)
       then have "2 * \<bar>sin((2 * pi * j / n) / 2)\<bar> < 2 * sin (pi / real n)"
         by (simp only: dist_exp_i_1)
       then have sin_less: "sin((pi * j / n)) < sin (pi / real n)"
         by (simp add: field_simps)
       then have "w / z = 1"
       proof (cases "j = 0")
         case True then show ?thesis by (auto simp: j)
       next
         case False
         then have "sin (pi / real n) \<le> sin((pi * j / n))"
         proof (cases "j / n \<le> 1/2")
           case True
           show ?thesis
             apply (rule sin_monotone_2pi_le)
             using \<open>j \<noteq> 0 \<close> \<open>j < n\<close> True
             apply (auto simp: field_simps intro: order_trans [of _ 0])
             done
         next
           case False
           then have seq: "sin(pi * j / n) = sin(pi * (n - j) / n)"
             using \<open>j < n\<close> by (simp add: algebra_simps diff_divide_distrib of_nat_diff)
           show ?thesis
             apply (simp only: seq)
             apply (rule sin_monotone_2pi_le)
             using \<open>j < n\<close> False
             apply (auto simp: field_simps intro: order_trans [of _ 0])
             done
         qed
         with sin_less show ?thesis by force
       qed
       then show ?thesis by simp
     qed
     show ?thesis
       apply (rule_tac e = "2 * sin(pi / n)" in that)
        apply (force simp: \<open>2 \<le> n\<close> sin_pi_divide_n_gt_0)
       apply (meson eq_if_pow_eq)
       done
   qed
   have zn1: "continuous_on (- {0}) (\<lambda>z::complex. z^n)"
     by (rule continuous_intros)+
   have zn2: "(\<lambda>z::complex. z^n) ` (- {0}) = - {0}"
     using assms by (auto simp: image_def elim: exists_complex_root_nonzero [where n = n])
   have zn3: "\<exists>T. z^n \<in> T \<and> open T \<and> 0 \<notin> T \<and>
                (\<exists>v. \<Union>v = -{0} \<inter> (\<lambda>z. z ^ n) -` T \<and>
                     (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
                     pairwise disjnt v \<and>
                     (\<forall>u\<in>v. Ex (homeomorphism u T (\<lambda>z. z^n))))"
            if "z \<noteq> 0" for z::complex
   proof -
     define d where "d \<equiv> min (1/2) (e/4) * norm z"
     have "0 < d"
       by (simp add: d_def \<open>0 < e\<close> \<open>z \<noteq> 0\<close>)
     have iff_x_eq_y: "x^n = y^n \<longleftrightarrow> x = y"
          if eq: "w^n = z^n" and x: "x \<in> ball w d" and y: "y \<in> ball w d" for w x y
     proof -
       have [simp]: "norm z = norm w" using that
         by (simp add: assms power_eq_imp_eq_norm)
       show ?thesis
       proof (cases "w = 0")
         case True with \<open>z \<noteq> 0\<close> assms eq
         show ?thesis by (auto simp: power_0_left)
       next
         case False
         have "cmod (x - y) < 2*d"
           using x y
           by (simp add: dist_norm [symmetric]) (metis dist_commute mult_2 dist_triangle_less_add)
         also have "... \<le> 2 * e / 4 * norm w"
           using \<open>e > 0\<close> by (simp add: d_def min_mult_distrib_right)
         also have "... = e * (cmod w / 2)"
           by simp
         also have "... \<le> e * cmod y"
           apply (rule mult_left_mono)
           using \<open>e > 0\<close> y
            apply (simp_all add: dist_norm d_def min_mult_distrib_right del: divide_const_simps)
           apply (metis dist_0_norm dist_complex_def dist_triangle_half_l linorder_not_less order_less_irrefl)
           done
         finally have "cmod (x - y) < e * cmod y" .
         then show ?thesis by (rule e)
       qed
     qed
     then have inj: "inj_on (\<lambda>w. w^n) (ball z d)"
       by (simp add: inj_on_def)
     have cont: "continuous_on (ball z d) (\<lambda>w. w ^ n)"
       by (intro continuous_intros)
     have noncon: "\<not> (\<lambda>w::complex. w^n) constant_on UNIV"
       by (metis UNIV_I assms constant_on_def power_one zero_neq_one zero_power)
     have im_eq: "(\<lambda>w. w^n) ` ball z' d = (\<lambda>w. w^n) ` ball z d"
                 if z': "z'^n = z^n" for z'
     proof -
       have nz': "norm z' = norm z" using that assms power_eq_imp_eq_norm by blast
       have "(w \<in> (\<lambda>w. w^n) ` ball z' d) = (w \<in> (\<lambda>w. w^n) ` ball z d)" for w
       proof (cases "w=0")
         case True with assms show ?thesis
           by (simp add: image_def ball_def nz')
       next
         case False
         have "z' \<noteq> 0" using \<open>z \<noteq> 0\<close> nz' by force
         have [simp]: "(z*x / z')^n = x^n" if "x \<noteq> 0" for x
           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
         have [simp]: "cmod (z - z * x / z') = cmod (z' - x)" if "x \<noteq> 0" for x
         proof -
           have "cmod (z - z * x / z') = cmod z * cmod (1 - x / z')"
             by (metis (no_types) ab_semigroup_mult_class.mult_ac(1) divide_complex_def mult.right_neutral norm_mult right_diff_distrib')
           also have "... = cmod z' * cmod (1 - x / z')"
             by (simp add: nz')
           also have "... = cmod (z' - x)"
             by (simp add: \<open>z' \<noteq> 0\<close> diff_divide_eq_iff norm_divide)
           finally show ?thesis .
         qed
         have [simp]: "(z'*x / z)^n = x^n" if "x \<noteq> 0" for x
           using z' that by (simp add: field_simps \<open>z \<noteq> 0\<close>)
         have [simp]: "cmod (z' - z' * x / z) = cmod (z - x)" if "x \<noteq> 0" for x
         proof -
           have "cmod (z * (1 - x * inverse z)) = cmod (z - x)"
             by (metis \<open>z \<noteq> 0\<close> diff_divide_distrib divide_complex_def divide_self_if nonzero_eq_divide_eq semiring_normalization_rules(7))
           then show ?thesis
             by (metis (no_types) mult.assoc divide_complex_def mult.right_neutral norm_mult nz' right_diff_distrib')
         qed
         show ?thesis
           unfolding image_def ball_def
           apply safe
           apply simp_all
           apply (rule_tac x="z/z' * x" in exI)
           using assms False apply (simp add: dist_norm)
           apply (rule_tac x="z'/z * x" in exI)
           using assms False apply (simp add: dist_norm)
           done
       qed
       then show ?thesis by blast
     qed
 
     have ex_ball: "\<exists>B. (\<exists>z'. B = ball z' d \<and> z'^n = z^n) \<and> x \<in> B"
                   if "x \<noteq> 0" and eq: "x^n = w^n" and dzw: "dist z w < d" for x w
     proof -
       have "w \<noteq> 0" by (metis assms power_eq_0_iff that(1) that(2))
       have [simp]: "cmod x = cmod w"
         using assms power_eq_imp_eq_norm eq by blast
       have [simp]: "cmod (x * z / w - x) = cmod (z - w)"
       proof -
         have "cmod (x * z / w - x) = cmod x * cmod (z / w - 1)"
           by (metis (no_types) mult.right_neutral norm_mult right_diff_distrib' times_divide_eq_right)
         also have "... = cmod w * cmod (z / w - 1)"
           by simp
         also have "... = cmod (z - w)"
           by (simp add: \<open>w \<noteq> 0\<close> divide_diff_eq_iff nonzero_norm_divide)
         finally show ?thesis .
       qed
       show ?thesis
         apply (rule_tac x="ball (z / w * x) d" in exI)
         using \<open>d > 0\<close> that
         apply (simp add: ball_eq_ball_iff)
         apply (simp add: \<open>z \<noteq> 0\<close> \<open>w \<noteq> 0\<close> field_simps)
         apply (simp add: dist_norm)
         done
     qed
 
     show ?thesis
     proof (rule exI, intro conjI)
       show "z ^ n \<in> (\<lambda>w. w ^ n) ` ball z d"
         using \<open>d > 0\<close> by simp
       show "open ((\<lambda>w. w ^ n) ` ball z d)"
         by (rule invariance_of_domain [OF cont open_ball inj])
       show "0 \<notin> (\<lambda>w. w ^ n) ` ball z d"
         using \<open>z \<noteq> 0\<close> assms by (force simp: d_def)
       show "\<exists>v. \<Union>v = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d \<and>
                 (\<forall>u\<in>v. open u \<and> 0 \<notin> u) \<and>
                 disjoint v \<and>
                 (\<forall>u\<in>v. Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n)))"
       proof (rule exI, intro ballI conjI)
         show "\<Union>{ball z' d |z'. z'^n = z^n} = - {0} \<inter> (\<lambda>z. z ^ n) -` (\<lambda>w. w ^ n) ` ball z d" (is "?l = ?r")
         proof 
           show "?l \<subseteq> ?r"
             apply auto
              apply (simp add: assms d_def power_eq_imp_eq_norm that)
             by (metis im_eq image_eqI mem_ball)
           show "?r \<subseteq> ?l"
             by auto (meson ex_ball)
         qed
         show "\<And>u. u \<in> {ball z' d |z'. z' ^ n = z ^ n} \<Longrightarrow> 0 \<notin> u"
           by (force simp add: assms d_def power_eq_imp_eq_norm that)
 
         show "disjoint {ball z' d |z'. z' ^ n = z ^ n}"
         proof (clarsimp simp add: pairwise_def disjnt_iff)
           fix \<xi> \<zeta> x
           assume "\<xi>^n = z^n" "\<zeta>^n = z^n" "ball \<xi> d \<noteq> ball \<zeta> d"
             and "dist \<xi> x < d" "dist \<zeta> x < d"
           then have "dist \<xi> \<zeta> < d+d"
             using dist_triangle_less_add by blast
           then have "cmod (\<xi> - \<zeta>) < 2*d"
             by (simp add: dist_norm)
           also have "... \<le> e * cmod z"
             using mult_right_mono \<open>0 < e\<close> that by (auto simp: d_def)
           finally have "cmod (\<xi> - \<zeta>) < e * cmod z" .
           with e have "\<xi> = \<zeta>"
             by (metis \<open>\<xi>^n = z^n\<close> \<open>\<zeta>^n = z^n\<close> assms power_eq_imp_eq_norm)
           then show "False"
             using \<open>ball \<xi> d \<noteq> ball \<zeta> d\<close> by blast
         qed
         show "Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
           if "u \<in> {ball z' d |z'. z' ^ n = z ^ n}" for u
         proof (rule invariance_of_domain_homeomorphism [of "u" "\<lambda>z. z^n"])
           show "open u"
             using that by auto
           show "continuous_on u (\<lambda>z. z ^ n)"
             by (intro continuous_intros)
           show "inj_on (\<lambda>z. z ^ n) u"
             using that by (auto simp: iff_x_eq_y inj_on_def)
           show "\<And>g. homeomorphism u ((\<lambda>z. z ^ n) ` u) (\<lambda>z. z ^ n) g \<Longrightarrow> Ex (homeomorphism u ((\<lambda>w. w ^ n) ` ball z d) (\<lambda>z. z ^ n))"
             using im_eq that by clarify metis
         qed auto
       qed auto
     qed
   qed
   show ?thesis
     using assms
     apply (simp add: covering_space_def zn1 zn2)
     apply (subst zn2 [symmetric])
     apply (simp add: openin_open_eq open_Compl)
     apply (blast intro: zn3)
     done
 qed
 
 corollary covering_space_square_punctured_plane:
   "covering_space (- {0}) (\<lambda>z::complex. z^2) (- {0})"
   by (simp add: covering_space_power_punctured_plane)
 
 
 proposition covering_space_exp_punctured_plane:
   "covering_space UNIV (\<lambda>z::complex. exp z) (- {0})"
 proof (simp add: covering_space_def, intro conjI ballI)
   show "continuous_on UNIV (\<lambda>z::complex. exp z)"
     by (rule continuous_on_exp [OF continuous_on_id])
   show "range exp = - {0::complex}"
     by auto (metis exp_Ln range_eqI)
   show "\<exists>T. z \<in> T \<and> openin (top_of_set (- {0})) T \<and>
              (\<exists>v. \<Union>v = exp -` T \<and> (\<forall>u\<in>v. open u) \<and> disjoint v \<and>
                   (\<forall>u\<in>v. \<exists>q. homeomorphism u T exp q))"
         if "z \<in> - {0::complex}" for z
   proof -
     have "z \<noteq> 0"
       using that by auto
     have inj_exp: "inj_on exp (ball (Ln z) 1)"
       apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
       using pi_ge_two by (simp add: ball_subset_ball_iff)
     define \<V> where "\<V> \<equiv> range (\<lambda>n. (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1))"
     show ?thesis
     proof (intro exI conjI)
       show "z \<in> exp ` (ball(Ln z) 1)"
         by (metis \<open>z \<noteq> 0\<close> centre_in_ball exp_Ln rev_image_eqI zero_less_one)
       have "open (- {0::complex})"
         by blast
       moreover have "inj_on exp (ball (Ln z) 1)"
         apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
         using pi_ge_two by (simp add: ball_subset_ball_iff)
       ultimately show "openin (top_of_set (- {0})) (exp ` ball (Ln z) 1)"
         by (auto simp: openin_open_eq invariance_of_domain continuous_on_exp [OF continuous_on_id])
       show "\<Union>\<V> = exp -` exp ` ball (Ln z) 1"
         by (force simp: \<V>_def Complex_Transcendental.exp_eq image_iff)
       show "\<forall>V\<in>\<V>. open V"
         by (auto simp: \<V>_def inj_on_def continuous_intros invariance_of_domain)
       have xy: "2 \<le> cmod (2 * of_int x * of_real pi * \<i> - 2 * of_int y * of_real pi * \<i>)"
                if "x < y" for x y
       proof -
         have "1 \<le> abs (x - y)"
           using that by linarith
         then have "1 \<le> cmod (of_int x - of_int y) * 1"
           by (metis mult.right_neutral norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
         also have "... \<le> cmod (of_int x - of_int y) * of_real pi"
           apply (rule mult_left_mono)
           using pi_ge_two by auto
         also have "... \<le> cmod ((of_int x - of_int y) * of_real pi * \<i>)"
           by (simp add: norm_mult)
         also have "... \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)"
           by (simp add: algebra_simps)
         finally have "1 \<le> cmod (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>)" .
         then have "2 * 1 \<le> cmod (2 * (of_int x * of_real pi * \<i> - of_int y * of_real pi * \<i>))"
           by (metis mult_le_cancel_left_pos norm_mult_numeral1 zero_less_numeral)
         then show ?thesis
           by (simp add: algebra_simps)
       qed
       show "disjoint \<V>"
         apply (clarsimp simp add: \<V>_def pairwise_def disjnt_def add.commute [of _ "x*y" for x y]
                         ball_eq_ball_iff)
         apply (rule disjoint_ballI)
         apply (auto simp: dist_norm neq_iff)
         by (metis norm_minus_commute xy)+
       show "\<forall>u\<in>\<V>. \<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
       proof
         fix u
         assume "u \<in> \<V>"
         then obtain n where n: "u = (\<lambda>x. x + of_real (2 * of_int n * pi) * \<i>) ` (ball(Ln z) 1)"
           by (auto simp: \<V>_def)
         have "compact (cball (Ln z) 1)"
           by simp
         moreover have "continuous_on (cball (Ln z) 1) exp"
           by (rule continuous_on_exp [OF continuous_on_id])
         moreover have "inj_on exp (cball (Ln z) 1)"
           apply (rule inj_on_subset [OF inj_on_exp_pi [of "Ln z"]])
           using pi_ge_two by (simp add: cball_subset_ball_iff)
         ultimately obtain \<gamma> where hom: "homeomorphism (cball (Ln z) 1) (exp ` cball (Ln z) 1) exp \<gamma>"
           using homeomorphism_compact  by blast
         have eq1: "exp ` u = exp ` ball (Ln z) 1"
           unfolding n
           apply (auto simp: algebra_simps)
           apply (rename_tac w)
           apply (rule_tac x = "w + \<i> * (of_int n * (of_real pi * 2))" in image_eqI)
           apply (auto simp: image_iff)
           done
         have \<gamma>exp: "\<gamma> (exp x) + 2 * of_int n * of_real pi * \<i> = x" if "x \<in> u" for x
         proof -
           have "exp x = exp (x - 2 * of_int n * of_real pi * \<i>)"
             by (simp add: exp_eq)
           then have "\<gamma> (exp x) = \<gamma> (exp (x - 2 * of_int n * of_real pi * \<i>))"
             by simp
           also have "... = x - 2 * of_int n * of_real pi * \<i>"
             apply (rule homeomorphism_apply1 [OF hom])
             using \<open>x \<in> u\<close> by (auto simp: n)
           finally show ?thesis
             by simp
         qed
         have exp2n: "exp (\<gamma> (exp x) + 2 * of_int n * complex_of_real pi * \<i>) = exp x"
                 if "dist (Ln z) x < 1" for x
           using that by (auto simp: exp_eq homeomorphism_apply1 [OF hom])
         have cont: "continuous_on (exp ` ball (Ln z) 1) (\<lambda>x. \<gamma> x + 2 * of_int n * complex_of_real pi * \<i>)"
           apply (intro continuous_intros)
           apply (rule continuous_on_subset [OF homeomorphism_cont2 [OF hom]])
           apply (force simp:)
           done
         show "\<exists>q. homeomorphism u (exp ` ball (Ln z) 1) exp q"
           apply (rule_tac x="(\<lambda>x. x + of_real(2 * n * pi) * \<i>) \<circ> \<gamma>" in exI)
           unfolding homeomorphism_def
           apply (intro conjI ballI eq1 continuous_on_exp [OF continuous_on_id])
              apply (auto simp: \<gamma>exp exp2n cont n)
            apply (simp add:  homeomorphism_apply1 [OF hom])
           using hom homeomorphism_apply1  apply (force simp: image_iff)
           done
       qed
     qed
   qed
 qed
 
 
 subsection\<open>Hence the Borsukian results about mappings into circles\<close>(*FIX ME title *)
 
 lemma inessential_eq_continuous_logarithm:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x)))"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs thus ?rhs
     by (metis covering_space_lift_inessential_function covering_space_exp_punctured_plane)
 next
   assume ?rhs
   then obtain g where contg: "continuous_on S g" and f: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     by metis
   obtain a where "homotopic_with_canon (\<lambda>h. True) S (- {of_real 0}) (exp \<circ> g) (\<lambda>x. a)"
   proof (rule nullhomotopic_through_contractible [OF contg subset_UNIV _ _ contractible_UNIV])
     show "continuous_on (UNIV::complex set) exp"
       by (intro continuous_intros)
     show "range exp \<subseteq> - {0}"
       by auto
   qed force
   then have "homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
     using f homotopic_with_eq by fastforce
   then show ?lhs ..
 qed
 
 corollary inessential_imp_continuous_logarithm_circle:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
   obtains g where "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
 proof -
   have "homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>t. a)"
     using assms homotopic_with_subset_right by fastforce
   then show ?thesis
     by (metis inessential_eq_continuous_logarithm that)
 qed
 
 
 lemma inessential_eq_continuous_logarithm_circle:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x))))"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume L: ?lhs
   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using inessential_imp_continuous_logarithm_circle by blast
   have "f ` S \<subseteq> sphere 0 1"
     by (metis L homotopic_with_imp_subset1)
   then have "\<And>x. x \<in> S \<Longrightarrow> Re (g x) = 0"
     using g by auto
   then show ?rhs
     apply (rule_tac x="Im \<circ> g" in exI)
      apply (intro conjI contg continuous_intros)
     apply (auto simp: Euler g)
     done
 next
   assume ?rhs
   then obtain g where contg: "continuous_on S g" and g: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(\<i>* of_real(g x))"
     by metis
   obtain a where "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) ((exp \<circ> (\<lambda>z. \<i>*z)) \<circ> (of_real \<circ> g)) (\<lambda>x. a)"
   proof (rule nullhomotopic_through_contractible)
     show "continuous_on S (complex_of_real \<circ> g)"
       by (intro conjI contg continuous_intros)
     show "(complex_of_real \<circ> g) ` S \<subseteq> \<real>"
       by auto
     show "continuous_on \<real> (exp \<circ> (*)\<i>)"
       by (intro continuous_intros)
     show "(exp \<circ> (*)\<i>) ` \<real> \<subseteq> sphere 0 1"
       by (auto simp: complex_is_Real_iff)
   qed (auto simp: convex_Reals convex_imp_contractible)
   moreover have "\<And>x. x \<in> S \<Longrightarrow> (exp \<circ> (*)\<i> \<circ> (complex_of_real \<circ> g)) x = f x"
     by (simp add: g)
   ultimately have "homotopic_with_canon (\<lambda>h. True) S (sphere 0 1) f (\<lambda>t. a)"
     using homotopic_with_eq by force
   then show ?lhs ..
 qed
 
 proposition homotopic_with_sphere_times:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes hom: "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g" and conth: "continuous_on S h"
       and hin: "\<And>x. x \<in> S \<Longrightarrow> h x \<in> sphere 0 1"
     shows "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x * h x) (\<lambda>x. g x * h x)"
 proof -
   obtain k where contk: "continuous_on ({0..1::real} \<times> S) k"
              and kim: "k ` ({0..1} \<times> S) \<subseteq> sphere 0 1"
              and k0:  "\<And>x. k(0, x) = f x"
              and k1: "\<And>x. k(1, x) = g x"
     using hom by (auto simp: homotopic_with_def)
   show ?thesis
     apply (simp add: homotopic_with)
     apply (rule_tac x="\<lambda>z. k z*(h \<circ> snd)z" in exI)
     apply (intro conjI contk continuous_intros)
        apply (simp add: conth)
     using kim hin apply (force simp: norm_mult k0 k1)+
     done
 qed
 
 proposition homotopic_circlemaps_divide:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
     shows "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
            (\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c))"
 proof -
   have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
        if "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)" for c
   proof -
     have "S = {} \<or> path_component (sphere 0 1) 1 c"
       using homotopic_with_imp_subset2 [OF that] path_connected_sphere [of "0::complex" 1]
       by (auto simp: path_connected_component)
     then have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. 1) (\<lambda>x. c)"
       by (simp add: homotopic_constant_maps)
     then show ?thesis
       using homotopic_with_symD homotopic_with_trans that by blast
   qed
   then have *: "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. c)) \<longleftrightarrow>
                 homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
     by auto
   have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) f g \<longleftrightarrow>
            continuous_on S f \<and> f ` S \<subseteq> sphere 0 1 \<and>
            continuous_on S g \<and> g ` S \<subseteq> sphere 0 1 \<and>
            homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
         (is "?lhs \<longleftrightarrow> ?rhs")
   proof
     assume L: ?lhs
     have geq1 [simp]: "\<And>x. x \<in> S \<Longrightarrow> cmod (g x) = 1"
       using homotopic_with_imp_subset2 [OF L]
       by (simp add: image_subset_iff)
     have cont: "continuous_on S (inverse \<circ> g)"
       apply (rule continuous_intros)
       using homotopic_with_imp_continuous [OF L] apply blast
       apply (rule continuous_on_subset [of "sphere 0 1", OF continuous_on_inverse])
         apply (auto)
       done
     have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. f x / g x) (\<lambda>x. 1)"
       using homotopic_with_sphere_times [OF L cont]
       apply (rule homotopic_with_eq)
          apply (auto simp: division_ring_class.divide_inverse norm_inverse)
       by (metis geq1 norm_zero right_inverse zero_neq_one)
     with L show ?rhs
       by (auto simp: homotopic_with_imp_continuous dest: homotopic_with_imp_subset1 homotopic_with_imp_subset2)
   next
     assume ?rhs then show ?lhs
       by (elim conjE homotopic_with_eq [OF homotopic_with_sphere_times]; force)
   qed
   then show ?thesis
     by (simp add: *)
 qed
 
 subsection\<open>Upper and lower hemicontinuous functions\<close>
 
 text\<open>And relation in the case of preimage map to open and closed maps, and fact that upper and lower
 hemicontinuity together imply continuity in the sense of the Hausdorff metric (at points where the
 function gives a bounded and nonempty set).\<close>
 
 
 text\<open>Many similar proofs below.\<close>
 lemma upper_hemicontinuous:
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
     shows "((\<forall>U. openin (top_of_set T) U
                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
             (\<forall>U. closedin (top_of_set T) U
                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "closedin (top_of_set T) U"
   then have "openin (top_of_set T) (T - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set S) {x \<in> S. f x \<subseteq> T - U}"
     using * [of "T-U"] by blast
   moreover have "S - {x \<in> S. f x \<subseteq> T - U} = {x \<in> S. f x \<inter> U \<noteq> {}}"
     using assms by blast
   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and "openin (top_of_set T) U"
   then have "closedin (top_of_set T) (T - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
     using * [of "T-U"] by blast
   moreover have "{x \<in> S. f x \<inter> (T - U) \<noteq> {}} = S - {x \<in> S. f x \<subseteq> U}"
     using assms by auto
   ultimately show "openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 qed
 
 lemma lower_hemicontinuous:
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
     shows "((\<forall>U. closedin (top_of_set T) U
                  \<longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}) \<longleftrightarrow>
             (\<forall>U. openin (top_of_set T) U
                  \<longrightarrow> openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "openin (top_of_set T) U"
   then have "closedin (top_of_set T) (T - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set S) {x \<in> S. f x \<subseteq> T-U}"
     using * [of "T-U"] by blast
   moreover have "{x \<in> S. f x \<subseteq> T-U} = S - {x \<in> S. f x \<inter> U \<noteq> {}}"
     using assms by auto
   ultimately show "openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and "closedin (top_of_set T) U"
   then have "openin (top_of_set T) (T - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set S) {x \<in> S. f x \<inter> (T - U) \<noteq> {}}"
     using * [of "T-U"] by blast
   moreover have "S - {x \<in> S. f x \<inter> (T - U) \<noteq> {}} = {x \<in> S. f x \<subseteq> U}"
     using assms by blast
   ultimately show "closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 qed
 
 lemma open_map_iff_lower_hemicontinuous_preimage:
   assumes "f ` S \<subseteq> T"
     shows "((\<forall>U. openin (top_of_set S) U
                  \<longrightarrow> openin (top_of_set T) (f ` U)) \<longleftrightarrow>
             (\<forall>U. closedin (top_of_set S) U
                  \<longrightarrow> closedin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and "closedin (top_of_set S) U"
   then have "openin (top_of_set S) (S - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set T) (f ` (S - U))"
     using * [of "S-U"] by blast
   moreover have "T - (f ` (S - U)) = {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
     using assms by blast
   ultimately show "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> U}"
     by (simp add: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and opeSU: "openin (top_of_set S) U"
   then have "closedin (top_of_set S) (S - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using * [of "S-U"] by blast
   moreover have "{y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U} = T - (f ` U)"
     using assms openin_imp_subset [OF opeSU] by auto
   ultimately show "openin (top_of_set T) (f ` U)"
     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
 qed
 
 lemma closed_map_iff_upper_hemicontinuous_preimage:
   assumes "f ` S \<subseteq> T"
     shows "((\<forall>U. closedin (top_of_set S) U
                  \<longrightarrow> closedin (top_of_set T) (f ` U)) \<longleftrightarrow>
             (\<forall>U. openin (top_of_set S) U
                  \<longrightarrow> openin (top_of_set T) {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}))"
           (is "?lhs = ?rhs")
 proof (intro iffI allI impI)
   fix U
   assume * [rule_format]: ?lhs and opeSU: "openin (top_of_set S) U"
   then have "closedin (top_of_set S) (S - U)"
     by (simp add: closedin_diff)
   then have "closedin (top_of_set T) (f ` (S - U))"
     using * [of "S-U"] by blast
   moreover have "f ` (S - U) = T -  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
     using assms openin_imp_subset [OF opeSU] by auto
   ultimately show "openin (top_of_set T)  {y \<in> T. {x. x \<in> S \<and> f x = y} \<subseteq> U}"
     using assms openin_imp_subset [OF opeSU] by (force simp: openin_closedin_eq)
 next
   fix U
   assume * [rule_format]: ?rhs and cloSU: "closedin (top_of_set S) U"
   then have "openin (top_of_set S) (S - U)"
     by (simp add: openin_diff)
   then have "openin (top_of_set T) {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using * [of "S-U"] by blast
   moreover have "(f ` U) = T - {y \<in> T. {x \<in> S. f x = y} \<subseteq> S - U}"
     using assms closedin_imp_subset [OF cloSU]  by auto
   ultimately show "closedin (top_of_set T) (f ` U)"
     by (simp add: openin_closedin_eq)
 qed
 
 proposition upper_lower_hemicontinuous_explicit:
   fixes T :: "('b::{real_normed_vector,heine_borel}) set"
   assumes fST: "\<And>x. x \<in> S \<Longrightarrow> f x \<subseteq> T"
       and ope: "\<And>U. openin (top_of_set T) U
                      \<Longrightarrow> openin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
       and clo: "\<And>U. closedin (top_of_set T) U
                      \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x \<subseteq> U}"
       and "x \<in> S" "0 < e" and bofx: "bounded(f x)" and fx_ne: "f x \<noteq> {}"
   obtains d where "0 < d"
              "\<And>x'. \<lbrakk>x' \<in> S; dist x x' < d\<rbrakk>
                            \<Longrightarrow> (\<forall>y \<in> f x. \<exists>y'. y' \<in> f x' \<and> dist y y' < e) \<and>
                                (\<forall>y' \<in> f x'. \<exists>y. y \<in> f x \<and> dist y' y < e)"
 proof -
   have "openin (top_of_set T) (T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b}))"
     by (auto simp: open_sums openin_open_Int)
   with ope have "openin (top_of_set S)
                     {u \<in> S. f u \<subseteq> T \<inter> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})}" by blast
   with \<open>0 < e\<close> \<open>x \<in> S\<close> obtain d1 where "d1 > 0" and
          d1: "\<And>x'. \<lbrakk>x' \<in> S; dist x' x < d1\<rbrakk> \<Longrightarrow> f x' \<subseteq> T \<and> f x' \<subseteq> (\<Union>a \<in> f x. \<Union>b \<in> ball 0 e. {a + b})"
     by (force simp: openin_euclidean_subtopology_iff dest: fST)
   have oo: "\<And>U. openin (top_of_set T) U \<Longrightarrow>
                  openin (top_of_set S) {x \<in> S. f x \<inter> U \<noteq> {}}"
     apply (rule lower_hemicontinuous [THEN iffD1, rule_format])
     using fST clo by auto
   have "compact (closure(f x))"
     by (simp add: bofx)
   moreover have "closure(f x) \<subseteq> (\<Union>a \<in> f x. ball a (e/2))"
     using \<open>0 < e\<close> by (force simp: closure_approachable simp del: divide_const_simps)
   ultimately obtain C where "C \<subseteq> f x" "finite C" "closure(f x) \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
     apply (rule compactE, force)
     by (metis finite_subset_image)
   then have fx_cover: "f x \<subseteq> (\<Union>a \<in> C. ball a (e/2))"
     by (meson closure_subset order_trans)
   with fx_ne have "C \<noteq> {}"
     by blast
   have xin: "x \<in> (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
     using \<open>x \<in> S\<close> \<open>0 < e\<close> fST \<open>C \<subseteq> f x\<close> by force
   have "openin (top_of_set S) {x \<in> S. f x \<inter> (T \<inter> ball a (e/2)) \<noteq> {}}" for a
     by (simp add: openin_open_Int oo)
   then have "openin (top_of_set S) (\<Inter>a \<in> C. {x \<in> S. f x \<inter> T \<inter> ball a (e/2) \<noteq> {}})"
     by (simp add: Int_assoc openin_INT2 [OF \<open>finite C\<close> \<open>C \<noteq> {}\<close>])
   with xin obtain d2 where "d2>0"
               and d2: "\<And>u v. \<lbrakk>u \<in> S; dist u x < d2; v \<in> C\<rbrakk> \<Longrightarrow> f u \<inter> T \<inter> ball v (e/2) \<noteq> {}"
     unfolding openin_euclidean_subtopology_iff using xin by fastforce
   show ?thesis
   proof (intro that conjI ballI)
     show "0 < min d1 d2"
       using \<open>0 < d1\<close> \<open>0 < d2\<close> by linarith
   next
     fix x' y
     assume "x' \<in> S" "dist x x' < min d1 d2" "y \<in> f x"
     then have dd2: "dist x' x < d2"
       by (auto simp: dist_commute)
     obtain a where "a \<in> C" "y \<in> ball a (e/2)"
       using fx_cover \<open>y \<in> f x\<close> by auto
     then show "\<exists>y'. y' \<in> f x' \<and> dist y y' < e"
       using d2 [OF \<open>x' \<in> S\<close> dd2] dist_triangle_half_r by fastforce
   next
     fix x' y'
     assume "x' \<in> S" "dist x x' < min d1 d2" "y' \<in> f x'"
     then have "dist x' x < d1"
       by (auto simp: dist_commute)
     then have "y' \<in> (\<Union>a\<in>f x. \<Union>b\<in>ball 0 e. {a + b})"
       using d1 [OF \<open>x' \<in> S\<close>] \<open>y' \<in> f x'\<close> by force
     then show "\<exists>y. y \<in> f x \<and> dist y' y < e"
       apply auto
       by (metis add_diff_cancel_left' dist_norm)
   qed
 qed
 
 
 subsection\<open>Complex logs exist on various "well-behaved" sets\<close>
 
 lemma continuous_logarithm_on_contractible:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on S f" "contractible S" "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
 proof -
   obtain c where hom: "homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>x. c)"
     using nullhomotopic_from_contractible assms
     by (metis imageE subset_Compl_singleton)
   then show ?thesis
     by (metis inessential_eq_continuous_logarithm that)
 qed
 
 lemma continuous_logarithm_on_simply_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
   using covering_space_lift [OF covering_space_exp_punctured_plane S contf]
   by (metis (full_types) f imageE subset_Compl_singleton)
 
 lemma continuous_logarithm_on_cball:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on (cball a r) f" and "\<And>z. z \<in> cball a r \<Longrightarrow> f z \<noteq> 0"
     obtains h where "continuous_on (cball a r) h" "\<And>z. z \<in> cball a r \<Longrightarrow> f z = exp(h z)"
   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
 
 lemma continuous_logarithm_on_ball:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on (ball a r) f" and "\<And>z. z \<in> ball a r \<Longrightarrow> f z \<noteq> 0"
   obtains h where "continuous_on (ball a r) h" "\<And>z. z \<in> ball a r \<Longrightarrow> f z = exp(h z)"
   using assms continuous_logarithm_on_contractible convex_imp_contractible by blast
 
 lemma continuous_sqrt_on_contractible:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes "continuous_on S f" "contractible S"
       and "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
 proof -
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using continuous_logarithm_on_contractible [OF assms] by blast
   show ?thesis
   proof
     show "continuous_on S (\<lambda>z. exp (g z / 2))"
       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
   qed
 qed
 
 lemma continuous_sqrt_on_simply_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> complex"
   assumes contf: "continuous_on S f" and S: "simply_connected S" "locally path_connected S"
       and f: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "continuous_on S g" "\<And>x. x \<in> S \<Longrightarrow> f x = (g x) ^ 2"
 proof -
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using continuous_logarithm_on_simply_connected [OF assms] by blast
   show ?thesis
   proof
     show "continuous_on S (\<lambda>z. exp (g z / 2))"
       by (rule continuous_on_compose2 [of UNIV exp]; intro continuous_intros contg subset_UNIV) auto
     show "\<And>x. x \<in> S \<Longrightarrow> f x = (exp (g x / 2))\<^sup>2"
       by (metis exp_double feq nonzero_mult_div_cancel_left times_divide_eq_right zero_neq_numeral)
   qed
 qed
 
 
 subsection\<open>Another simple case where sphere maps are nullhomotopic\<close>
 
 lemma inessential_spheremap_2_aux:
   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
   assumes 2: "2 < DIM('a)" and contf: "continuous_on (sphere a r) f" 
       and fim: "f `(sphere a r) \<subseteq> (sphere 0 1)" 
   obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere 0 1) f (\<lambda>x. c)"
 proof -
   obtain g where contg: "continuous_on (sphere a r) g" 
              and feq: "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = exp(g x)"
   proof (rule continuous_logarithm_on_simply_connected [OF contf])
     show "simply_connected (sphere a r)"
       using 2 by (simp add: simply_connected_sphere_eq)
     show "locally path_connected (sphere a r)"
       by (simp add: locally_path_connected_sphere)
     show "\<And>z.  z \<in> sphere a r \<Longrightarrow> f z \<noteq> 0"
       using fim by force
   qed auto
   have "\<exists>g. continuous_on (sphere a r) g \<and> (\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real (g x)))"
   proof (intro exI conjI)
     show "continuous_on (sphere a r) (Im \<circ> g)"
       by (intro contg continuous_intros continuous_on_compose)
     show "\<forall>x\<in>sphere a r. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
       using exp_eq_polar feq fim norm_exp_eq_Re by auto
   qed
   with inessential_eq_continuous_logarithm_circle that show ?thesis 
     by metis
 qed
 
 lemma inessential_spheremap_2:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes a2: "2 < DIM('a)" and b2: "DIM('b) = 2" 
       and contf: "continuous_on (sphere a r) f" and fim: "f `(sphere a r) \<subseteq> (sphere b s)"
   obtains c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. c)"
 proof (cases "s \<le> 0")
   case True
   then show ?thesis
     using contf contractible_sphere fim nullhomotopic_into_contractible that by blast
 next
   case False
   then have "sphere b s homeomorphic sphere (0::complex) 1"
     using assms by (simp add: homeomorphic_spheres_gen)
   then obtain h k where hk: "homeomorphism (sphere b s) (sphere (0::complex) 1) h k"
     by (auto simp: homeomorphic_def)
   then have conth: "continuous_on (sphere b s) h"
        and  contk: "continuous_on (sphere 0 1) k"
        and  him: "h ` sphere b s \<subseteq> sphere 0 1"
        and  kim: "k ` sphere 0 1 \<subseteq> sphere b s"
     by (simp_all add: homeomorphism_def)
   obtain c where "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere 0 1) (h \<circ> f) (\<lambda>x. c)"
   proof (rule inessential_spheremap_2_aux [OF a2])
     show "continuous_on (sphere a r) (h \<circ> f)"
       by (meson continuous_on_compose [OF contf] conth continuous_on_subset fim)
     show "(h \<circ> f) ` sphere a r \<subseteq> sphere 0 1"
       using fim him by force
   qed auto
   then have "homotopic_with_canon (\<lambda>f. True) (sphere a r) (sphere b s) (k \<circ> (h \<circ> f)) (k \<circ> (\<lambda>x. c))"
     by (rule homotopic_with_compose_continuous_left [OF _ contk kim])
   then have "homotopic_with_canon (\<lambda>z. True) (sphere a r) (sphere b s) f (\<lambda>x. k c)"
     apply (rule homotopic_with_eq, auto)
     by (metis fim hk homeomorphism_def image_subset_iff mem_sphere)
   then show ?thesis
     by (metis that)
 qed
 
 
 subsection\<open>Holomorphic logarithms and square roots\<close>
 
 lemma contractible_imp_holomorphic_log:
   assumes holf: "f holomorphic_on S"
       and S: "contractible S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
 proof -
   have contf: "continuous_on S f"
     by (simp add: holf holomorphic_on_imp_continuous_on)
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
     by (metis continuous_logarithm_on_contractible [OF contf S fnz])
   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
   proof -
     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
     have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
           (at z within S)"
     proof (rule tendsto_compose_at)
       show "(g \<longlongrightarrow> g z) (at z within S)"
         using contg continuous_on \<open>z \<in> S\<close> by blast
       show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
         apply (subst Lim_at_zero)
         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
         done
       qed auto
     then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
       by (simp add: o_def)
     have "continuous (at z within S) g"
       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
       by (simp add: continuous_within tendsto_iff)
     then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
       apply (rule eventually_mono)
       apply (auto simp: exp_eq dist_norm norm_mult)
       done
     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
       by (auto intro!: Lim_transform_eventually [OF tendsto_divide [OF ee dd]])
     then show ?thesis
       by (auto simp: field_differentiable_def has_field_derivative_iff)
   qed
   then have "g holomorphic_on S"
     using holf holomorphic_on_def by auto
   then show ?thesis
     using feq that by auto
 qed
 
 (*Identical proofs*)
 lemma simply_connected_imp_holomorphic_log:
   assumes holf: "f holomorphic_on S"
       and S: "simply_connected S" "locally path_connected S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
 proof -
   have contf: "continuous_on S f"
     by (simp add: holf holomorphic_on_imp_continuous_on)
   obtain g where contg: "continuous_on S g" and feq: "\<And>x. x \<in> S \<Longrightarrow> f x = exp (g x)"
     by (metis continuous_logarithm_on_simply_connected [OF contf S fnz])
   have "g field_differentiable at z within S" if "f field_differentiable at z within S" "z \<in> S" for z
   proof -
     obtain f' where f': "((\<lambda>y. (f y - f z) / (y - z)) \<longlongrightarrow> f') (at z within S)"
       using \<open>f field_differentiable at z within S\<close> by (auto simp: field_differentiable_def has_field_derivative_iff)
     then have ee: "((\<lambda>x. (exp(g x) - exp(g z)) / (x - z)) \<longlongrightarrow> f') (at z within S)"
       by (simp add: feq \<open>z \<in> S\<close> Lim_transform_within [OF _ zero_less_one])
     have "(((\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<circ> g) \<longlongrightarrow> exp (g z))
           (at z within S)"
     proof (rule tendsto_compose_at)
       show "(g \<longlongrightarrow> g z) (at z within S)"
         using contg continuous_on \<open>z \<in> S\<close> by blast
       show "(\<lambda>y. if y = g z then exp (g z) else (exp y - exp (g z)) / (y - g z)) \<midarrow>g z\<rightarrow> exp (g z)"
         apply (subst Lim_at_zero)
         apply (simp add: DERIV_D cong: if_cong Lim_cong_within)
         done
       qed auto
     then have dd: "((\<lambda>x. if g x = g z then exp(g z) else (exp(g x) - exp(g z)) / (g x - g z)) \<longlongrightarrow> exp(g z)) (at z within S)"
       by (simp add: o_def)
     have "continuous (at z within S) g"
       using contg continuous_on_eq_continuous_within \<open>z \<in> S\<close> by blast
     then have "(\<forall>\<^sub>F x in at z within S. dist (g x) (g z) < 2*pi)"
       by (simp add: continuous_within tendsto_iff)
     then have "\<forall>\<^sub>F x in at z within S. exp (g x) = exp (g z) \<longrightarrow> g x \<noteq> g z \<longrightarrow> x = z"
       apply (rule eventually_mono)
       apply (auto simp: exp_eq dist_norm norm_mult)
       done
     then have "((\<lambda>y. (g y - g z) / (y - z)) \<longlongrightarrow> f' / exp (g z)) (at z within S)"
       by (auto intro!: Lim_transform_eventually [OF tendsto_divide [OF ee dd]])
     then show ?thesis
       by (auto simp: field_differentiable_def has_field_derivative_iff)
   qed
   then have "g holomorphic_on S"
     using holf holomorphic_on_def by auto
   then show ?thesis
     using feq that by auto
 qed
 
 
 lemma contractible_imp_holomorphic_sqrt:
   assumes holf: "f holomorphic_on S"
       and S: "contractible S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
     using contractible_imp_holomorphic_log [OF assms] by blast
   show ?thesis
   proof
     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
       by (intro holomorphic_on_compose holg holomorphic_intros) auto
     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
       apply (auto simp: feq)
       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
   qed
 qed
 
 lemma simply_connected_imp_holomorphic_sqrt:
   assumes holf: "f holomorphic_on S"
       and S: "simply_connected S" "locally path_connected S"
       and fnz: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = g z ^ 2"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = exp(g z)"
     using simply_connected_imp_holomorphic_log [OF assms] by blast
   show ?thesis
   proof
     show "exp \<circ> (\<lambda>z. z / 2) \<circ> g holomorphic_on S"
       by (intro holomorphic_on_compose holg holomorphic_intros) auto
     show "\<And>z. z \<in> S \<Longrightarrow> f z = ((exp \<circ> (\<lambda>z. z / 2) \<circ> g) z)\<^sup>2"
       apply (auto simp: feq)
       by (metis eq_divide_eq_numeral1(1) exp_double mult.commute zero_neq_numeral)
   qed
 qed
 
 text\<open> Related theorems about holomorphic inverse cosines.\<close>
 
 lemma contractible_imp_holomorphic_arccos:
   assumes holf: "f holomorphic_on S" and S: "contractible S"
       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
   obtains g where "g holomorphic_on S" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
 proof -
   have hol1f: "(\<lambda>z. 1 - f z ^ 2) holomorphic_on S"
     by (intro holomorphic_intros holf)
   obtain g where holg: "g holomorphic_on S" and eq: "\<And>z. z \<in> S \<Longrightarrow> 1 - (f z)\<^sup>2 = (g z)\<^sup>2"
     using contractible_imp_holomorphic_sqrt [OF hol1f S]
     by (metis eq_iff_diff_eq_0 non1 power2_eq_1_iff)
   have holfg: "(\<lambda>z. f z + \<i>*g z) holomorphic_on S"
     by (intro holf holg holomorphic_intros)
   have "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z \<noteq> 0"
     by (metis Arccos_body_lemma eq add.commute add.inverse_unique complex_i_mult_minus power2_csqrt power2_eq_iff)
   then obtain h where holh: "h holomorphic_on S" and fgeq: "\<And>z. z \<in> S \<Longrightarrow> f z + \<i>*g z = exp (h z)"
     using contractible_imp_holomorphic_log [OF holfg S] by metis
   show ?thesis
   proof
     show "(\<lambda>z. -\<i>*h z) holomorphic_on S"
       by (intro holh holomorphic_intros)
     show "f z = cos (- \<i>*h z)" if "z \<in> S" for z
     proof -
       have "(f z + \<i>*g z)*(f z - \<i>*g z) = 1"
         using that eq by (auto simp: algebra_simps power2_eq_square)
       then have "f z - \<i>*g z = inverse (f z + \<i>*g z)"
         using inverse_unique by force
       also have "... = exp (- h z)"
         by (simp add: exp_minus fgeq that)
       finally have "f z = exp (- h z) + \<i>*g z"
         by (simp add: diff_eq_eq)
       then show ?thesis
         apply (simp add: cos_exp_eq)
         by (metis fgeq add.assoc mult_2_right that)
     qed
   qed
 qed
 
 
 lemma contractible_imp_holomorphic_arccos_bounded:
   assumes holf: "f holomorphic_on S" and S: "contractible S" and "a \<in> S"
       and non1: "\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 1 \<and> f z \<noteq> -1"
   obtains g where "g holomorphic_on S" "norm(g a) \<le> pi + norm(f a)" "\<And>z. z \<in> S \<Longrightarrow> f z = cos(g z)"
 proof -
   obtain g where holg: "g holomorphic_on S" and feq: "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z)"
     using contractible_imp_holomorphic_arccos [OF holf S non1] by blast
   obtain b where "cos b = f a" "norm b \<le> pi + norm (f a)"
     using cos_Arccos norm_Arccos_bounded by blast
   then have "cos b = cos (g a)"
     by (simp add: \<open>a \<in> S\<close> feq)
   then consider n where "n \<in> \<int>" "b = g a + of_real(2*n*pi)" | n where "n \<in> \<int>" "b = -g a + of_real(2*n*pi)"
     by (auto simp: complex_cos_eq)
   then show ?thesis
   proof cases
     case 1
     show ?thesis
     proof
       show "(\<lambda>z. g z + of_real(2*n*pi)) holomorphic_on S"
         by (intro holomorphic_intros holg)
       show "cmod (g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
         using "1" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (g z + complex_of_real (2*n*pi))"
         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
     qed
   next
     case 2
     show ?thesis
     proof
       show "(\<lambda>z. -g z + of_real(2*n*pi)) holomorphic_on S"
         by (intro holomorphic_intros holg)
       show "cmod (-g a + of_real(2*n*pi)) \<le> pi + cmod (f a)"
         using "2" \<open>cmod b \<le> pi + cmod (f a)\<close> by blast
       show "\<And>z. z \<in> S \<Longrightarrow> f z = cos (-g z + complex_of_real (2*n*pi))"
         by (metis \<open>n \<in> \<int>\<close> complex_cos_eq feq)
     qed
   qed
 qed
 
 
 subsection\<open>The "Borsukian" property of sets\<close>
 
 text\<open>This doesn't have a standard name. Kuratowski uses ``contractible with respect to \<open>[S\<^sup>1]\<close>''
  while Whyburn uses ``property b''. It's closely related to unicoherence.\<close>
 
 definition\<^marker>\<open>tag important\<close> Borsukian where
     "Borsukian S \<equiv>
         \<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
             \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) S (- {0}) f (\<lambda>x. a))"
 
 lemma Borsukian_retraction_gen:
   assumes "Borsukian S" "continuous_on S h" "h ` S = T"
           "continuous_on T k"  "k ` T \<subseteq> S"  "\<And>y. y \<in> T \<Longrightarrow> h(k y) = y"
     shows "Borsukian T"
 proof -
   interpret R: Retracts S h T k
     using assms by (simp add: Retracts.intro)
   show ?thesis
     using assms
     apply (simp add: Borsukian_def, clarify)
     apply (rule R.cohomotopically_trivial_retraction_null_gen [OF TrueI TrueI refl, of "-{0}"], auto)
     done
 qed
 
 lemma retract_of_Borsukian: "\<lbrakk>Borsukian T; S retract_of T\<rbrakk> \<Longrightarrow> Borsukian S"
   apply (auto simp: retract_of_def retraction_def)
   apply (erule (1) Borsukian_retraction_gen)
   apply (meson retraction retraction_def)
     apply (auto)
     done
 
 lemma homeomorphic_Borsukian: "\<lbrakk>Borsukian S; S homeomorphic T\<rbrakk> \<Longrightarrow> Borsukian T"
   using Borsukian_retraction_gen order_refl
   by (fastforce simp add: homeomorphism_def homeomorphic_def)
 
 lemma homeomorphic_Borsukian_eq:
    "S homeomorphic T \<Longrightarrow> Borsukian S \<longleftrightarrow> Borsukian T"
   by (meson homeomorphic_Borsukian homeomorphic_sym)
 
 lemma Borsukian_translation:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian (image (\<lambda>x. a + x) S) \<longleftrightarrow> Borsukian S"
   apply (rule homeomorphic_Borsukian_eq)
     using homeomorphic_translation homeomorphic_sym by blast
 
 lemma Borsukian_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "Borsukian(f ` S) \<longleftrightarrow> Borsukian S"
   apply (rule homeomorphic_Borsukian_eq)
   using assms homeomorphic_sym linear_homeomorphic_image by blast
 
 lemma homotopy_eqv_Borsukianness:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
    assumes "S homotopy_eqv T"
      shows "(Borsukian S \<longleftrightarrow> Borsukian T)"
   by (meson Borsukian_def assms homotopy_eqv_cohomotopic_triviality_null)
 
 lemma Borsukian_alt:
   fixes S :: "'a::real_normed_vector set"
   shows
    "Borsukian S \<longleftrightarrow>
         (\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> -{0} \<and>
                continuous_on S g \<and> g ` S \<subseteq> -{0}
                \<longrightarrow> homotopic_with_canon (\<lambda>h. True) S (- {0::complex}) f g)"
   unfolding Borsukian_def homotopic_triviality
   by (simp add: path_connected_punctured_universe)
 
 lemma Borsukian_continuous_logarithm:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
             (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> (- {0::complex})
                  \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
   by (simp add: Borsukian_def inessential_eq_continuous_logarithm)
 
 lemma Borsukian_continuous_logarithm_circle:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
              (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
                   \<longrightarrow> (\<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (force simp: Borsukian_continuous_logarithm)
 next
   assume RHS [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp: Borsukian_continuous_logarithm)
     fix f :: "'a \<Rightarrow> complex"
     assume contf: "continuous_on S f" and 0: "0 \<notin> f ` S"
     then have "continuous_on S (\<lambda>x. f x / complex_of_real (cmod (f x)))"
       by (intro continuous_intros) auto
     moreover have "(\<lambda>x. f x / complex_of_real (cmod (f x))) ` S \<subseteq> sphere 0 1"
       using 0 by (auto simp: norm_divide)
     ultimately obtain g where contg: "continuous_on S g"
                   and fg: "\<forall>x \<in> S. f x / complex_of_real (cmod (f x)) = exp(g x)"
       using RHS [of "\<lambda>x. f x / of_real(norm(f x))"] by auto
     show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
     proof (intro exI ballI conjI)
       show "continuous_on S (\<lambda>x. (Ln \<circ> of_real \<circ> norm \<circ> f)x + g x)"
         by (intro continuous_intros contf contg conjI) (use "0" in auto)
       show "f x = exp ((Ln \<circ> complex_of_real \<circ> cmod \<circ> f) x + g x)" if "x \<in> S" for x
         using 0 that
         apply (clarsimp simp: exp_add)
         apply (subst exp_Ln, force)
         by (metis eq_divide_eq exp_not_eq_zero fg mult.commute)
     qed
   qed
 qed
 
 
 lemma Borsukian_continuous_logarithm_circle_real:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
               \<longrightarrow> (\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x \<in> S. f x = exp(\<i> * of_real(g x)))))"
    (is "?lhs = ?rhs")
 proof
   assume LHS: ?lhs
   show ?rhs
   proof (clarify)
     fix f :: "'a \<Rightarrow> complex"
     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
     then obtain g where contg: "continuous_on S g" and "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
       using LHS by (auto simp: Borsukian_continuous_logarithm_circle)
     then have "\<forall>x\<in>S. f x = exp (\<i> * complex_of_real ((Im \<circ> g) x))"
       using f01 apply (simp add: image_iff subset_iff)
         by (metis cis_conv_exp exp_eq_polar mult.left_neutral norm_exp_eq_Re of_real_1)
     then show "\<exists>g. continuous_on S (complex_of_real \<circ> g) \<and> (\<forall>x\<in>S. f x = exp (\<i> * complex_of_real (g x)))"
       by (rule_tac x="Im \<circ> g" in exI) (force intro: continuous_intros contg)
   qed
 next
   assume RHS [rule_format]: ?rhs
   show ?lhs
   proof (clarsimp simp: Borsukian_continuous_logarithm_circle)
     fix f :: "'a \<Rightarrow> complex"
     assume "continuous_on S f" and f01: "f ` S \<subseteq> sphere 0 1"
     then obtain g where contg: "continuous_on S (complex_of_real \<circ> g)" and "\<And>x. x \<in> S \<Longrightarrow> f x =  exp(\<i> * of_real(g x))"
       by (metis RHS)
     then show "\<exists>g. continuous_on S g \<and> (\<forall>x\<in>S. f x = exp (g x))"
       by (rule_tac x="\<lambda>x. \<i>* of_real(g x)" in exI) (auto simp: continuous_intros contg)
   qed
 qed
 
 lemma Borsukian_circle:
   fixes S :: "'a::real_normed_vector set"
   shows "Borsukian S \<longleftrightarrow>
          (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> sphere (0::complex) 1
               \<longrightarrow> (\<exists>a. homotopic_with_canon (\<lambda>h. True) S (sphere (0::complex) 1) f (\<lambda>x. a)))"
 by (simp add: inessential_eq_continuous_logarithm_circle Borsukian_continuous_logarithm_circle_real)
 
 lemma contractible_imp_Borsukian: "contractible S \<Longrightarrow> Borsukian S"
   by (meson Borsukian_def nullhomotopic_from_contractible)
 
 lemma simply_connected_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows  "\<lbrakk>simply_connected S; locally path_connected S\<rbrakk> \<Longrightarrow> Borsukian S"
   apply (simp add: Borsukian_continuous_logarithm)
   by (metis (no_types, lifting) continuous_logarithm_on_simply_connected image_iff)
 
 lemma starlike_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> Borsukian S"
   by (simp add: contractible_imp_Borsukian starlike_imp_contractible)
 
 lemma Borsukian_empty: "Borsukian {}"
   by (auto simp: contractible_imp_Borsukian)
 
 lemma Borsukian_UNIV: "Borsukian (UNIV :: 'a::real_normed_vector set)"
   by (auto simp: contractible_imp_Borsukian)
 
 lemma convex_imp_Borsukian:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> Borsukian S"
   by (meson Borsukian_def convex_imp_contractible nullhomotopic_from_contractible)
 
 proposition Borsukian_sphere:
   fixes a :: "'a::euclidean_space"
   shows "3 \<le> DIM('a) \<Longrightarrow> Borsukian (sphere a r)"
   apply (rule simply_connected_imp_Borsukian)
   using simply_connected_sphere apply blast
   using ENR_imp_locally_path_connected ENR_sphere by blast
 
 proposition Borsukian_open_Un:
   fixes S :: "'a::real_normed_vector set"
   assumes opeS: "openin (top_of_set (S \<union> T)) S"
       and opeT: "openin (top_of_set (S \<union> T)) T"
       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
     shows "Borsukian(S \<union> T)"
 proof (clarsimp simp add: Borsukian_continuous_logarithm)
   fix f :: "'a \<Rightarrow> complex"
   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
     using continuous_on_subset by auto
   have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
     using BS by (auto simp: Borsukian_continuous_logarithm)
   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using "0" contfS by blast
   have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
     using BT by (auto simp: Borsukian_continuous_logarithm)
   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
     using "0" contfT by blast
   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
   proof (cases "S \<inter> T = {}")
     case True
     show ?thesis
     proof (intro exI conjI)
       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
         apply (rule continuous_on_cases_local_open [OF opeS opeT contg conth])
         using True by blast
       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
         using fg fh by auto
     qed
   next
     case False
     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
     proof (rule continuous_discrete_range_constant [OF ST])
       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
         apply (intro continuous_intros)
         apply (meson contg continuous_on_subset inf_le1)
         by (meson conth continuous_on_subset inf_sup_ord(2))
       show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
            if "x \<in> S \<inter> T" for x
       proof -
         have "g y - g x = h y - h x"
               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
         proof (rule exp_complex_eqI)
           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
             by (metis abs_Im_le_cmod minus_complex.simps(2))
           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
             using that by linarith
           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
           then show "exp (g y - g x) = exp (h y - h x)"
             by (simp add: exp_diff)
         qed
         then show ?thesis
           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
       qed
     qed 
     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
       by (auto simp: constant_on_def)
     with False have "exp a = 1"
       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
     with a show ?thesis
       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
       apply (intro continuous_on_cases_local_open opeS opeT contg conth continuous_intros conjI)
        apply (auto simp: algebra_simps fg fh exp_add)
       done
   qed
 qed
 
 text\<open>The proof is a duplicate of that of \<open>Borsukian_open_Un\<close>.\<close>
 lemma Borsukian_closed_Un:
   fixes S :: "'a::real_normed_vector set"
   assumes cloS: "closedin (top_of_set (S \<union> T)) S"
       and cloT: "closedin (top_of_set (S \<union> T)) T"
       and BS: "Borsukian S" and BT: "Borsukian T" and ST: "connected(S \<inter> T)"
     shows "Borsukian(S \<union> T)"
 proof (clarsimp simp add: Borsukian_continuous_logarithm)
   fix f :: "'a \<Rightarrow> complex"
   assume contf: "continuous_on (S \<union> T) f" and 0: "0 \<notin> f ` (S \<union> T)"
   then have contfS: "continuous_on S f" and contfT: "continuous_on T f"
     using continuous_on_subset by auto
   have "\<lbrakk>continuous_on S f; f ` S \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on S g \<and> (\<forall>x \<in> S. f x = exp(g x))"
     using BS by (auto simp: Borsukian_continuous_logarithm)
   then obtain g where contg: "continuous_on S g" and fg: "\<And>x. x \<in> S \<Longrightarrow> f x = exp(g x)"
     using "0" contfS by blast
   have "\<lbrakk>continuous_on T f; f ` T \<subseteq> -{0}\<rbrakk> \<Longrightarrow> \<exists>g. continuous_on T g \<and> (\<forall>x \<in> T. f x = exp(g x))"
     using BT by (auto simp: Borsukian_continuous_logarithm)
   then obtain h where conth: "continuous_on T h" and fh: "\<And>x. x \<in> T \<Longrightarrow> f x = exp(h x)"
     using "0" contfT by blast
   show "\<exists>g. continuous_on (S \<union> T) g \<and> (\<forall>x\<in>S \<union> T. f x = exp (g x))"
   proof (cases "S \<inter> T = {}")
     case True
     show ?thesis
     proof (intro exI conjI)
       show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
         apply (rule continuous_on_cases_local [OF cloS cloT contg conth])
         using True by blast
       show "\<forall>x\<in>S \<union> T. f x = exp (if x \<in> S then g x else h x)"
         using fg fh by auto
     qed
   next
     case False
     have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
     proof (rule continuous_discrete_range_constant [OF ST])
       show "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
         apply (intro continuous_intros)
         apply (meson contg continuous_on_subset inf_le1)
         by (meson conth continuous_on_subset inf_sup_ord(2))
       show "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> cmod (g y - h y - (g x - h x))"
            if "x \<in> S \<inter> T" for x
       proof -
         have "g y - g x = h y - h x"
               if "y \<in> S" "y \<in> T" "cmod (g y - g x - (h y - h x)) < 2 * pi" for y
         proof (rule exp_complex_eqI)
           have "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> \<le> cmod (g y - g x - (h y - h x))"
             by (metis abs_Im_le_cmod minus_complex.simps(2))
           then show "\<bar>Im (g y - g x) - Im (h y - h x)\<bar> < 2 * pi"
             using that by linarith
           have "exp (g x) = exp (h x)" "exp (g y) = exp (h y)"
             using fg fh that \<open>x \<in> S \<inter> T\<close> by fastforce+
           then show "exp (g y - g x) = exp (h y - h x)"
             by (simp add: exp_diff)
         qed
         then show ?thesis
           by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
       qed
     qed
     then obtain a where a: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = a"
       by (auto simp: constant_on_def)
     with False have "exp a = 1"
       by (metis IntI disjoint_iff_not_equal divide_self_if exp_diff exp_not_eq_zero fg fh)
     with a show ?thesis
       apply (rule_tac x="\<lambda>x. if x \<in> S then g x else a + h x" in exI)
       apply (intro continuous_on_cases_local cloS cloT contg conth continuous_intros conjI)
        apply (auto simp: algebra_simps fg fh exp_add)
       done
   qed
 qed
 
 lemma Borsukian_separation_compact:
   fixes S :: "complex set"
   assumes "compact S"
     shows "Borsukian S \<longleftrightarrow> connected(- S)"
   by (simp add: Borsuk_separation_theorem Borsukian_circle assms)
 
 lemma Borsukian_monotone_image_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T"
       and "compact S" and conn: "\<And>y. y \<in> T \<Longrightarrow> connected {x. x \<in> S \<and> f x = y}"
     shows "Borsukian T"
 proof (clarsimp simp add: Borsukian_continuous_logarithm)
   fix g :: "'b \<Rightarrow> complex"
   assume contg: "continuous_on T g" and 0: "0 \<notin> g ` T"
   have "continuous_on S (g \<circ> f)"
     using contf contg continuous_on_compose fim by blast
   moreover have "(g \<circ> f) ` S \<subseteq> -{0}"
     using fim 0 by auto
   ultimately obtain h where conth: "continuous_on S h" and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(h x)"
     using \<open>Borsukian S\<close> by (auto simp: Borsukian_continuous_logarithm)
   have "\<And>y. \<exists>x. y \<in> T \<longrightarrow> x \<in> S \<and> f x = y"
     using fim by auto
   then obtain f' where f': "\<And>y. y \<in> T \<longrightarrow> f' y \<in> S \<and> f (f' y) = y"
     by metis
   have *: "(\<lambda>x. h x - h(f' y)) constant_on {x. x \<in> S \<and> f x = y}" if "y \<in> T" for y
   proof (rule continuous_discrete_range_constant [OF conn [OF that], of "\<lambda>x. h x - h (f' y)"], simp_all add: algebra_simps)
     show "continuous_on {x \<in> S. f x = y} (\<lambda>x. h x - h (f' y))"
       by (intro continuous_intros continuous_on_subset [OF conth]) auto
     show "\<exists>e>0. \<forall>u. u \<in> S \<and> f u = y \<and> h u \<noteq> h x \<longrightarrow> e \<le> cmod (h u - h x)"
       if x: "x \<in> S \<and> f x = y" for x
     proof -
       have "h u = h x" if "u \<in> S" "f u = y" "cmod (h u - h x) < 2 * pi" for u
       proof (rule exp_complex_eqI)
         have "\<bar>Im (h u) - Im (h x)\<bar> \<le> cmod (h u - h x)"
           by (metis abs_Im_le_cmod minus_complex.simps(2))
         then show "\<bar>Im (h u) - Im (h x)\<bar> < 2 * pi"
           using that by linarith
         show "exp (h u) = exp (h x)"
           by (simp add: gfh [symmetric] x that)
       qed
       then show ?thesis
         by (rule_tac x="2*pi" in exI) (fastforce simp add: algebra_simps)
     qed
   qed 
   have "h x = h (f' (f x))" if "x \<in> S" for x
     using * [of "f x"] fim that unfolding constant_on_def by clarsimp (metis f' imageI right_minus_eq)
   moreover have "\<And>x. x \<in> T \<Longrightarrow> \<exists>u. u \<in> S \<and> x = f u \<and> h (f' x) = h u"
     using f' by fastforce
   ultimately
   have eq: "((\<lambda>x. (x, (h \<circ> f') x)) ` T) =
             {p. \<exists>x. x \<in> S \<and> (x, p) \<in> (S \<times> UNIV) \<inter> ((\<lambda>z. snd z - ((f \<circ> fst) z, (h \<circ> fst) z)) -` {0})}"
     using fim by (auto simp: image_iff)
   show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (h x))"
   proof (intro exI conjI)
     show "continuous_on T (h \<circ> f')"
     proof (rule continuous_from_closed_graph [of "h ` S"])
       show "compact (h ` S)"
         by (simp add: \<open>compact S\<close> compact_continuous_image conth)
       show "(h \<circ> f') ` T \<subseteq> h ` S"
         by (auto simp: f')
       show "closed ((\<lambda>x. (x, (h \<circ> f') x)) ` T)"
         apply (subst eq)
         apply (intro closed_compact_projection [OF \<open>compact S\<close>] continuous_closed_preimage
                      continuous_intros continuous_on_subset [OF contf] continuous_on_subset [OF conth])
            apply (auto simp: \<open>compact S\<close> closed_Times compact_imp_closed)
         done
     qed
   qed (use f' gfh in fastforce)
 qed
 
 
 lemma Borsukian_open_map_image_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "Borsukian S" and contf: "continuous_on S f" and fim: "f ` S = T" and "compact S"
       and ope: "\<And>U. openin (top_of_set S) U
                      \<Longrightarrow> openin (top_of_set T) (f ` U)"
     shows "Borsukian T"
 proof (clarsimp simp add: Borsukian_continuous_logarithm_circle_real)
   fix g :: "'b \<Rightarrow> complex"
   assume contg: "continuous_on T g" and gim: "g ` T \<subseteq> sphere 0 1"
   have "continuous_on S (g \<circ> f)"
     using contf contg continuous_on_compose fim by blast
   moreover have "(g \<circ> f) ` S \<subseteq> sphere 0 1"
     using fim gim by auto
   ultimately obtain h where cont_cxh: "continuous_on S (complex_of_real \<circ> h)"
                        and gfh: "\<And>x. x \<in> S \<Longrightarrow> (g \<circ> f) x = exp(\<i> * of_real(h x))"
     using \<open>Borsukian S\<close> Borsukian_continuous_logarithm_circle_real  by metis
   then have conth: "continuous_on S h"
     by simp
   have "\<exists>x. x \<in> S \<and> f x = y \<and> (\<forall>x' \<in> S. f x' = y \<longrightarrow> h x \<le> h x')" if "y \<in> T" for y
   proof -
     have 1: "compact (h ` {x \<in> S. f x = y})"
     proof (rule compact_continuous_image)
       show "continuous_on {x \<in> S. f x = y} h"
         by (rule continuous_on_subset [OF conth]) auto
       have "compact (S \<inter> f -` {y})"
         by (rule proper_map_from_compact [OF contf _ \<open>compact S\<close>, of T]) (simp_all add: fim that)
       then show "compact {x \<in> S. f x = y}" 
         by (auto simp: vimage_def Int_def)
     qed
     have 2: "h ` {x \<in> S. f x = y} \<noteq> {}"
       using fim that by auto
     have "\<exists>s \<in> h ` {x \<in> S. f x = y}. \<forall>t \<in> h ` {x \<in> S. f x = y}. s \<le> t"
       using compact_attains_inf [OF 1 2] by blast
     then show ?thesis by auto
   qed
   then obtain k where kTS: "\<And>y. y \<in> T \<Longrightarrow> k y \<in> S"
                   and fk:  "\<And>y. y \<in> T \<Longrightarrow> f (k y) = y "
                   and hle: "\<And>x' y. \<lbrakk>y \<in> T; x' \<in> S; f x' = y\<rbrakk> \<Longrightarrow> h (k y) \<le> h x'"
     by metis
   have "continuous_on T (h \<circ> k)"
   proof (clarsimp simp add: continuous_on_iff)
     fix y and e::real
     assume "y \<in> T" "0 < e"
     moreover have "uniformly_continuous_on S (complex_of_real \<circ> h)"
       using \<open>compact S\<close> cont_cxh compact_uniformly_continuous by blast
     ultimately obtain d where "0 < d"
                   and d: "\<And>x x'. \<lbrakk>x\<in>S; x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> dist (h x') (h x) < e"
       by (force simp: uniformly_continuous_on_def)
     obtain \<delta> where "0 < \<delta>" and \<delta>:
       "\<And>x'. \<lbrakk>x' \<in> T; dist y x' < \<delta>\<rbrakk>
                \<Longrightarrow> (\<forall>v \<in> {z \<in> S. f z = y}. \<exists>v'. v' \<in> {z \<in> S. f z = x'} \<and> dist v v' < d) \<and>
                    (\<forall>v' \<in> {z \<in> S. f z = x'}. \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d)"
     proof (rule upper_lower_hemicontinuous_explicit [of T "\<lambda>y. {z \<in> S. f z = y}" S])
       show "\<And>U. openin (top_of_set S) U
                  \<Longrightarrow> openin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
         using closed_map_iff_upper_hemicontinuous_preimage [OF fim [THEN equalityD1]]
         by (simp add: Abstract_Topology_2.continuous_imp_closed_map \<open>compact S\<close> contf fim)
       show "\<And>U. closedin (top_of_set S) U \<Longrightarrow>
                  closedin (top_of_set T) {x \<in> T. {z \<in> S. f z = x} \<subseteq> U}"
         using  ope open_map_iff_lower_hemicontinuous_preimage [OF fim [THEN equalityD1]]
         by meson
       show "bounded {z \<in> S. f z = y}"
         by (metis (no_types, lifting) compact_imp_bounded [OF \<open>compact S\<close>] bounded_subset mem_Collect_eq subsetI)
     qed (use \<open>y \<in> T\<close> \<open>0 < d\<close> fk kTS in \<open>force+\<close>)
     have "dist (h (k y')) (h (k y)) < e" if "y' \<in> T" "dist y y' < \<delta>" for y'
     proof -
       have k1: "k y \<in> S" "f (k y) = y" and k2: "k y' \<in> S" "f (k y') = y'"
         by (auto simp: \<open>y \<in> T\<close> \<open>y' \<in> T\<close> kTS fk)
       have 1: "\<And>v. \<lbrakk>v \<in> S; f v = y\<rbrakk> \<Longrightarrow> \<exists>v'. v' \<in> {z \<in> S. f z = y'} \<and> dist v v' < d"
        and 2: "\<And>v'. \<lbrakk>v' \<in> S; f v' = y'\<rbrakk> \<Longrightarrow> \<exists>v. v \<in> {z \<in> S. f z = y} \<and> dist v' v < d"
         using \<delta> [OF that] by auto
       then obtain w' w where "w' \<in> S" "f w' = y'" "dist (k y) w' < d"
         and "w \<in> S" "f w = y" "dist (k y') w < d"
         using 1 [OF k1] 2 [OF k2] by auto
       then show ?thesis
         using d [of w "k y'"] d [of w' "k y"] k1 k2 \<open>y' \<in> T\<close>  \<open>y \<in> T\<close> hle
         by (fastforce simp: dist_norm abs_diff_less_iff algebra_simps)
     qed
     then show "\<exists>d>0. \<forall>x'\<in>T. dist x' y < d \<longrightarrow> dist (h (k x')) (h (k y)) < e"
       using  \<open>0 < \<delta>\<close> by (auto simp: dist_commute)
   qed
   then show "\<exists>h. continuous_on T h \<and> (\<forall>x\<in>T. g x = exp (\<i> * complex_of_real (h x)))"
     using fk gfh kTS by force
 qed
 
 
 text\<open>If two points are separated by a closed set, there's a minimal one.\<close>
 proposition closed_irreducible_separator:
   fixes a :: "'a::real_normed_vector"
   assumes "closed S" and ab: "\<not> connected_component (- S) a b"
   obtains T where "T \<subseteq> S" "closed T" "T \<noteq> {}" "\<not> connected_component (- T) a b"
                   "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
 proof (cases "a \<in> S \<or> b \<in> S")
   case True
   then show ?thesis
   proof
     assume *: "a \<in> S"
     show ?thesis
     proof
       show "{a} \<subseteq> S"
         using * by blast
       show "\<not> connected_component (- {a}) a b"
         using connected_component_in by auto
       show "\<And>U. U \<subset> {a} \<Longrightarrow> connected_component (- U) a b"
         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
     qed auto
   next
     assume *: "b \<in> S"
     show ?thesis
     proof
       show "{b} \<subseteq> S"
         using * by blast
       show "\<not> connected_component (- {b}) a b"
         using connected_component_in by auto
       show "\<And>U. U \<subset> {b} \<Longrightarrow> connected_component (- U) a b"
         by (metis connected_component_UNIV UNIV_I compl_bot_eq connected_component_eq_eq less_le_not_le subset_singletonD)
     qed auto
   qed
 next
   case False
   define A where "A \<equiv> connected_component_set (- S) a"
   define B where "B \<equiv> connected_component_set (- (closure A)) b"
   have "a \<in> A"
     using False A_def by auto
   have "b \<in> B"
     unfolding A_def B_def closure_Un_frontier
     using ab False \<open>closed S\<close> frontier_complement frontier_of_connected_component_subset frontier_subset_closed by force
   have "frontier B \<subseteq> frontier (connected_component_set (- closure A) b)"
     using B_def by blast
   also have frsub: "... \<subseteq> frontier A"
   proof -
     have "\<And>A. closure (- closure (- A)) \<subseteq> closure A"
       by (metis (no_types) closure_mono closure_subset compl_le_compl_iff double_compl)
     then show ?thesis
       by (metis (no_types) closure_closure double_compl frontier_closures frontier_of_connected_component_subset le_inf_iff subset_trans)
   qed
   finally have frBA: "frontier B \<subseteq> frontier A" .
   show ?thesis
   proof
     show "frontier B \<subseteq> S"
     proof -
       have "frontier S \<subseteq> S"
         by (simp add: \<open>closed S\<close> frontier_subset_closed)
       then show ?thesis
         using frsub frontier_complement frontier_of_connected_component_subset
         unfolding A_def B_def by blast
     qed
     show "closed (frontier B)"
       by simp
     show "\<not> connected_component (- frontier B) a b"
       unfolding connected_component_def
     proof clarify
       fix T
       assume "connected T" and TB: "T \<subseteq> - frontier B" and "a \<in> T" and "b \<in> T"
       have "a \<notin> B"
         by (metis A_def B_def ComplD \<open>a \<in> A\<close> assms(1) closed_open connected_component_subset in_closure_connected_component subsetD)
       have "T \<inter> B \<noteq> {}"
         using \<open>b \<in> B\<close> \<open>b \<in> T\<close> by blast
       moreover have "T - B \<noteq> {}"
         using \<open>a \<notin> B\<close> \<open>a \<in> T\<close> by blast
       ultimately show "False"
         using connected_Int_frontier [of T B] TB \<open>connected T\<close> by blast
     qed
     moreover have "connected_component (- frontier B) a b" if "frontier B = {}"
       apply (simp add: that)
       using connected_component_eq_UNIV by blast
     ultimately show "frontier B \<noteq> {}"
       by blast
     show "connected_component (- U) a b" if "U \<subset> frontier B" for U
     proof -
       obtain p where Usub: "U \<subseteq> frontier B" and p: "p \<in> frontier B" "p \<notin> U"
         using \<open>U \<subset> frontier B\<close> by blast
       show ?thesis
         unfolding connected_component_def
       proof (intro exI conjI)
         have "connected ((insert p A) \<union> (insert p B))"
         proof (rule connected_Un)
           show "connected (insert p A)"
             by (metis A_def IntD1 frBA \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subsetCE subset_insertI)
           show "connected (insert p B)"
             by (metis B_def IntD1 \<open>p \<in> frontier B\<close> closure_insert closure_subset connected_connected_component connected_intermediate_closure frontier_closures insert_absorb subset_insertI)
         qed blast
         then show "connected (insert p (B \<union> A))"
           by (simp add: sup.commute)
         have "A \<subseteq> - U"
           using A_def Usub \<open>frontier B \<subseteq> S\<close> connected_component_subset by fastforce
         moreover have "B \<subseteq> - U"
           using B_def Usub connected_component_subset frBA frontier_closures by fastforce
         ultimately show "insert p (B \<union> A) \<subseteq> - U"
           using p by auto
       qed (auto simp: \<open>a \<in> A\<close> \<open>b \<in> B\<close>)
     qed
   qed
 qed
 
 lemma frontier_minimal_separating_closed_pointwise:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" "a \<notin> S" and nconn: "\<not> connected_component (- S) a b"
       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected_component (- T) a b"
     shows "frontier(connected_component_set (- S) a) = S" (is "?F = S")
 proof -
   have "?F \<subseteq> S"
     by (simp add: S componentsI frontier_of_components_closed_complement)
   moreover have False if "?F \<subset> S"
   proof -
     have "connected_component (- ?F) a b"
       by (simp add: conn that)
     then obtain T where "connected T" "T \<subseteq> -?F" "a \<in> T" "b \<in> T"
       by (auto simp: connected_component_def)
     moreover have "T \<inter> ?F \<noteq> {}"
     proof (rule connected_Int_frontier [OF \<open>connected T\<close>])
       show "T \<inter> connected_component_set (- S) a \<noteq> {}"
         using \<open>a \<notin> S\<close> \<open>a \<in> T\<close> by fastforce
       show "T - connected_component_set (- S) a \<noteq> {}"
         using \<open>b \<in> T\<close> nconn by blast
     qed
     ultimately show ?thesis
       by blast
   qed
   ultimately show ?thesis
     by blast
 qed
 
 
 subsection\<open>Unicoherence (closed)\<close>
 
 definition\<^marker>\<open>tag important\<close> unicoherent where
   "unicoherent U \<equiv>
   \<forall>S T. connected S \<and> connected T \<and> S \<union> T = U \<and>
         closedin (top_of_set U) S \<and> closedin (top_of_set U) T
         \<longrightarrow> connected (S \<inter> T)"
 
 lemma unicoherentI [intro?]:
   assumes "\<And>S T. \<lbrakk>connected S; connected T; U = S \<union> T; closedin (top_of_set U) S; closedin (top_of_set U) T\<rbrakk>
           \<Longrightarrow> connected (S \<inter> T)"
   shows "unicoherent U"
   using assms unfolding unicoherent_def by blast
 
 lemma unicoherentD:
   assumes "unicoherent U" "connected S" "connected T" "U = S \<union> T" "closedin (top_of_set U) S" "closedin (top_of_set U) T"
   shows "connected (S \<inter> T)"
   using assms unfolding unicoherent_def by blast
 
 proposition homeomorphic_unicoherent:
   assumes ST: "S homeomorphic T" and S: "unicoherent S"
   shows "unicoherent T"
 proof -
   obtain f g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x" and fim: "T = f ` S" and gfim: "g ` f ` S = S"
     and contf: "continuous_on S f" and contg: "continuous_on (f ` S) g"
     using ST by (auto simp: homeomorphic_def homeomorphism_def)
   show ?thesis
   proof
     fix U V
     assume "connected U" "connected V" and T: "T = U \<union> V"
       and cloU: "closedin (top_of_set T) U"
       and cloV: "closedin (top_of_set T) V"
     have "f ` (g ` U \<inter> g ` V) \<subseteq> U" "f ` (g ` U \<inter> g ` V) \<subseteq> V"
       using gf fim T by auto (metis UnCI image_iff)+
     moreover have "U \<inter> V \<subseteq> f ` (g ` U \<inter> g ` V)"
       using gf fim by (force simp: image_iff T)
     ultimately have "U \<inter> V = f ` (g ` U \<inter> g ` V)" by blast
     moreover have "connected (f ` (g ` U \<inter> g ` V))"
     proof (rule connected_continuous_image)
       show "continuous_on (g ` U \<inter> g ` V) f"
         apply (rule continuous_on_subset [OF contf])
         using T fim gfim by blast
       show "connected (g ` U \<inter> g ` V)"
       proof (intro conjI unicoherentD [OF S])
         show "connected (g ` U)" "connected (g ` V)"
           using \<open>connected U\<close> cloU \<open>connected V\<close> cloV
           by (metis Topological_Spaces.connected_continuous_image closedin_imp_subset contg continuous_on_subset fim)+
         show "S = g ` U \<union> g ` V"
           using T fim gfim by auto
         have hom: "homeomorphism T S g f"
           by (simp add: contf contg fim gf gfim homeomorphism_def)
         have "closedin (top_of_set T) U" "closedin (top_of_set T) V"
           by (simp_all add: cloU cloV)
         then show "closedin (top_of_set S) (g ` U)"
                   "closedin (top_of_set S) (g ` V)"
           by (blast intro: homeomorphism_imp_closed_map [OF hom])+
       qed
     qed
     ultimately show "connected (U \<inter> V)" by metis
   qed
 qed
 
 
 lemma homeomorphic_unicoherent_eq:
    "S homeomorphic T \<Longrightarrow> (unicoherent S \<longleftrightarrow> unicoherent T)"
   by (meson homeomorphic_sym homeomorphic_unicoherent)
 
 lemma unicoherent_translation:
   fixes S :: "'a::real_normed_vector set"
   shows
    "unicoherent (image (\<lambda>x. a + x) S) \<longleftrightarrow> unicoherent S"
   using homeomorphic_translation homeomorphic_unicoherent_eq by blast
 
 lemma unicoherent_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   shows "(unicoherent(f ` S) \<longleftrightarrow> unicoherent S)"
   using assms homeomorphic_unicoherent_eq linear_homeomorphic_image by blast
 
 
 lemma Borsukian_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "Borsukian U"  shows "unicoherent U"
   unfolding unicoherent_def
 proof clarify
   fix S T
   assume "connected S" "connected T" "U = S \<union> T"
      and cloS: "closedin (top_of_set (S \<union> T)) S"
      and cloT: "closedin (top_of_set (S \<union> T)) T"
   show "connected (S \<inter> T)"
     unfolding connected_closedin_eq
   proof clarify
     fix V W
     assume "closedin (top_of_set (S \<inter> T)) V"
        and "closedin (top_of_set (S \<inter> T)) W"
        and VW: "V \<union> W = S \<inter> T" "V \<inter> W = {}" and "V \<noteq> {}" "W \<noteq> {}"
     then have cloV: "closedin (top_of_set U) V" and cloW: "closedin (top_of_set U) W"
       using \<open>U = S \<union> T\<close> cloS cloT closedin_trans by blast+
     obtain q where contq: "continuous_on U q"
          and q01: "\<And>x. x \<in> U \<Longrightarrow> q x \<in> {0..1::real}"
          and qV: "\<And>x. x \<in> V \<Longrightarrow> q x = 0" and qW: "\<And>x. x \<in> W \<Longrightarrow> q x = 1"
       by (rule Urysohn_local [OF cloV cloW \<open>V \<inter> W = {}\<close>, of 0 1])
          (fastforce simp: closed_segment_eq_real_ivl)
     let ?h = "\<lambda>x. if x \<in> S then exp(pi * \<i> * q x) else 1 / exp(pi * \<i> * q x)"
     have eqST: "exp(pi * \<i> * q x) = 1 / exp(pi * \<i> * q x)" if "x \<in> S \<inter> T" for x
     proof -
       have "x \<in> V \<union> W"
         using that \<open>V \<union> W = S \<inter> T\<close> by blast
       with qV qW show ?thesis by force
     qed
     obtain g where contg: "continuous_on U g"
       and circle: "g ` U \<subseteq> sphere 0 1"
       and S: "\<And>x. x \<in> S \<Longrightarrow> g x = exp(pi * \<i> * q x)"
       and T: "\<And>x. x \<in> T \<Longrightarrow> g x = 1 / exp(pi * \<i> * q x)"
     proof
       show "continuous_on U ?h"
         unfolding \<open>U = S \<union> T\<close>
       proof (rule continuous_on_cases_local [OF cloS cloT])
         show "continuous_on S (\<lambda>x. exp (pi * \<i> * q x))"
           apply (intro continuous_intros)
           using \<open>U = S \<union> T\<close> continuous_on_subset contq by blast
         show "continuous_on T (\<lambda>x. 1 / exp (pi * \<i> * q x))"
           apply (intro continuous_intros)
           using \<open>U = S \<union> T\<close> continuous_on_subset contq by auto
       qed (use eqST in auto)
     qed (use eqST in \<open>auto simp: norm_divide\<close>)
     then obtain h where conth: "continuous_on U h" and heq: "\<And>x. x \<in> U \<Longrightarrow> g x = exp (h x)"
       by (metis Borsukian_continuous_logarithm_circle assms)
     obtain v w where "v \<in> V" "w \<in> W"
       using \<open>V \<noteq> {}\<close> \<open>W \<noteq> {}\<close> by blast
     then have vw: "v \<in> S \<inter> T" "w \<in> S \<inter> T"
       using VW by auto
     have iff: "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
           \<longleftrightarrow> 1 \<le> abs (m - n)" for m n
     proof -
       have "2 * pi \<le> cmod (2 * of_int m * of_real pi * \<i> - 2 * of_int n * of_real pi * \<i>)
             \<longleftrightarrow> 2 * pi \<le> cmod ((2 * pi * \<i>) * (of_int m - of_int n))"
         by (simp add: algebra_simps)
       also have "... \<longleftrightarrow> 2 * pi \<le> 2 * pi * cmod (of_int m - of_int n)"
         by (simp add: norm_mult)
       also have "... \<longleftrightarrow> 1 \<le> abs (m - n)"
         by simp (metis norm_of_int of_int_1_le_iff of_int_abs of_int_diff)
       finally show ?thesis .
     qed
     have *: "\<exists>n::int. h x - (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>" if "x \<in> S" for x
       using that S \<open>U = S \<union> T\<close> heq exp_eq [symmetric] by (simp add: algebra_simps)
     moreover have "(\<lambda>x. h x - (pi * \<i> * q x)) constant_on S"
     proof (rule continuous_discrete_range_constant [OF \<open>connected S\<close>])
       have "continuous_on S h" "continuous_on S q"
         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
       then show "continuous_on S (\<lambda>x. h x - (pi * \<i> * q x))"
         by (intro continuous_intros)
       have "2*pi \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
         if "x \<in> S" "y \<in> S" and ne: "h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x)" for x y
         using * [OF \<open>x \<in> S\<close>] * [OF \<open>y \<in> S\<close>] ne by (auto simp: iff)
       then show "\<And>x. x \<in> S \<Longrightarrow>
          \<exists>e>0. \<forall>y. y \<in> S \<and> h y - (pi * \<i> * q y) \<noteq> h x - (pi * \<i> * q x) \<longrightarrow>
                    e \<le> cmod (h y - (pi * \<i> * q y) - (h x - (pi * \<i> * q x)))"
         by (rule_tac x="2*pi" in exI) auto
     qed
     ultimately
     obtain m where m: "\<And>x. x \<in> S \<Longrightarrow> h x - (pi * \<i> * q x) = (of_int(2*m) * pi) * \<i>"
       using vw by (force simp: constant_on_def)
     have *: "\<exists>n::int. h x = - (pi * \<i> * q x) + (of_int(2*n) * pi) * \<i>" if "x \<in> T" for x
       unfolding exp_eq [symmetric]
       using that T \<open>U = S \<union> T\<close> by (simp add: exp_minus field_simps  heq [symmetric])
     moreover have "(\<lambda>x. h x + (pi * \<i> * q x)) constant_on T"
     proof (rule continuous_discrete_range_constant [OF \<open>connected T\<close>])
       have "continuous_on T h" "continuous_on T q"
         using \<open>U = S \<union> T\<close> continuous_on_subset conth contq by blast+
       then show "continuous_on T (\<lambda>x. h x + (pi * \<i> * q x))"
         by (intro continuous_intros)
       have "2*pi \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
         if "x \<in> T" "y \<in> T" and ne: "h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x)" for x y
         using * [OF \<open>x \<in> T\<close>] * [OF \<open>y \<in> T\<close>] ne by (auto simp: iff)
       then show "\<And>x. x \<in> T \<Longrightarrow>
          \<exists>e>0. \<forall>y. y \<in> T \<and> h y + (pi * \<i> * q y) \<noteq> h x + (pi * \<i> * q x) \<longrightarrow>
                    e \<le> cmod (h y + (pi * \<i> * q y) - (h x + (pi * \<i> * q x)))"
         by (rule_tac x="2*pi" in exI) auto
     qed
     ultimately
     obtain n where n: "\<And>x. x \<in> T \<Longrightarrow> h x + (pi * \<i> * q x) = (of_int(2*n) * pi) * \<i>"
       using vw by (force simp: constant_on_def)
     show "False"
       using m [of v] m [of w] n [of v] n [of w] vw
       by (auto simp: algebra_simps \<open>v \<in> V\<close> \<open>w \<in> W\<close> qV qW)
   qed
 qed
 
 
 corollary contractible_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "contractible U"  shows "unicoherent U"
   by (simp add: Borsukian_imp_unicoherent assms contractible_imp_Borsukian)
 
 corollary convex_imp_unicoherent:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U"  shows "unicoherent U"
   by (simp add: Borsukian_imp_unicoherent assms convex_imp_Borsukian)
 
 text\<open>If the type class constraint can be relaxed, I don't know how!\<close>
 corollary unicoherent_UNIV: "unicoherent (UNIV :: 'a :: euclidean_space set)"
   by (simp add: convex_imp_unicoherent)
 
 
 lemma unicoherent_monotone_image_compact:
   fixes T :: "'b :: t2_space set"
   assumes S: "unicoherent S" "compact S" and contf: "continuous_on S f" and fim: "f ` S = T"
   and conn: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
   shows "unicoherent T"
 proof
   fix U V
   assume UV: "connected U" "connected V" "T = U \<union> V"
      and cloU: "closedin (top_of_set T) U"
      and cloV: "closedin (top_of_set T) V"
   moreover have "compact T"
     using \<open>compact S\<close> compact_continuous_image contf fim by blast
   ultimately have "closed U" "closed V"
     by (auto simp: closedin_closed_eq compact_imp_closed)
   let ?SUV = "(S \<inter> f -` U) \<inter> (S \<inter> f -` V)"
   have UV_eq: "f ` ?SUV = U \<inter> V"
     using \<open>T = U \<union> V\<close> fim by force+
   have "connected (f ` ?SUV)"
   proof (rule connected_continuous_image)
     show "continuous_on ?SUV f"
       by (meson contf continuous_on_subset inf_le1)
     show "connected ?SUV"
     proof (rule unicoherentD [OF \<open>unicoherent S\<close>, of "S \<inter> f -` U" "S \<inter> f -` V"])
       have "\<And>C. closedin (top_of_set S) C \<Longrightarrow> closedin (top_of_set T) (f ` C)"
         by (metis \<open>compact S\<close> closed_subset closedin_compact closedin_imp_subset compact_continuous_image compact_imp_closed contf continuous_on_subset fim image_mono)
       then show "connected (S \<inter> f -` U)" "connected (S \<inter> f -` V)"
         using UV by (auto simp: conn intro: connected_closed_monotone_preimage [OF contf fim])
       show "S = (S \<inter> f -` U) \<union> (S \<inter> f -` V)"
         using UV fim by blast
       show "closedin (top_of_set S) (S \<inter> f -` U)"
             "closedin (top_of_set S) (S \<inter> f -` V)"
         by (auto simp: continuous_on_imp_closedin cloU cloV contf fim)
     qed
   qed
   with UV_eq show "connected (U \<inter> V)"
     by simp
 qed
 
 
 subsection\<open>Several common variants of unicoherence\<close>
 
 lemma connected_frontier_simple:
   fixes S :: "'a :: euclidean_space set"
   assumes "connected S" "connected(- S)" shows "connected(frontier S)"
   unfolding frontier_closures
   apply (rule unicoherentD [OF unicoherent_UNIV])
       apply (simp_all add: assms connected_imp_connected_closure)
   by (simp add: closure_def)
 
 lemma connected_frontier_component_complement:
   fixes S :: "'a :: euclidean_space set"
   assumes "connected S" and C: "C \<in> components(- S)" shows "connected(frontier C)"
   apply (rule connected_frontier_simple)
   using C in_components_connected apply blast
   by (metis assms component_complement_connected)
 
 lemma connected_frontier_disjoint:
   fixes S :: "'a :: euclidean_space set"
   assumes "connected S" "connected T" "disjnt S T" and ST: "frontier S \<subseteq> frontier T"
   shows "connected(frontier S)"
 proof (cases "S = UNIV")
   case True then show ?thesis
     by simp
 next
   case False
   then have "-S \<noteq> {}"
     by blast
   then obtain C where C: "C \<in> components(- S)" and "T \<subseteq> C"
     by (metis ComplI disjnt_iff subsetI exists_component_superset \<open>disjnt S T\<close> \<open>connected T\<close>)
   moreover have "frontier S = frontier C"
   proof -
     have "frontier C \<subseteq> frontier S"
       using C frontier_complement frontier_of_components_subset by blast
     moreover have "x \<in> frontier C" if "x \<in> frontier S" for x
     proof -
       have "x \<in> closure C"
         using that unfolding frontier_def
         by (metis (no_types) Diff_eq ST \<open>T \<subseteq> C\<close> closure_mono contra_subsetD frontier_def le_inf_iff that)
       moreover have "x \<notin> interior C"
         using that unfolding frontier_def
         by (metis C Compl_eq_Diff_UNIV Diff_iff subsetD in_components_subset interior_diff interior_mono)
       ultimately show ?thesis
         by (auto simp: frontier_def)
     qed
     ultimately show ?thesis
       by blast
   qed
   ultimately show ?thesis
     using \<open>connected S\<close> connected_frontier_component_complement by auto
 qed
 
 
 subsection\<open>Some separation results\<close>
 
 lemma separation_by_component_closed_pointwise:
   fixes S :: "'a :: euclidean_space set"
   assumes "closed S" "\<not> connected_component (- S) a b"
   obtains C where "C \<in> components S" "\<not> connected_component(- C) a b"
 proof (cases "a \<in> S \<or> b \<in> S")
   case True
   then show ?thesis
     using connected_component_in componentsI that by fastforce
 next
   case False
   obtain T where "T \<subseteq> S" "closed T" "T \<noteq> {}"
              and nab: "\<not> connected_component (- T) a b"
              and conn: "\<And>U. U \<subset> T \<Longrightarrow> connected_component (- U) a b"
     using closed_irreducible_separator [OF assms] by metis
   moreover have "connected T"
   proof -
     have ab: "frontier(connected_component_set (- T) a) = T" "frontier(connected_component_set (- T) b) = T"
       using frontier_minimal_separating_closed_pointwise
       by (metis False \<open>T \<subseteq> S\<close> \<open>closed T\<close> connected_component_sym conn connected_component_eq_empty connected_component_intermediate_subset empty_subsetI nab)+
     have "connected (frontier (connected_component_set (- T) a))"
     proof (rule connected_frontier_disjoint)
       show "disjnt (connected_component_set (- T) a) (connected_component_set (- T) b)"
         unfolding disjnt_iff
         by (metis connected_component_eq connected_component_eq_empty connected_component_idemp mem_Collect_eq nab)
       show "frontier (connected_component_set (- T) a) \<subseteq> frontier (connected_component_set (- T) b)"
         by (simp add: ab)
     qed auto
     with ab \<open>closed T\<close> show ?thesis
       by simp
   qed
   ultimately obtain C where "C \<in> components S" "T \<subseteq> C"
     using exists_component_superset [of T S] by blast
   then show ?thesis
     by (meson Compl_anti_mono connected_component_of_subset nab that)
 qed
 
 
 lemma separation_by_component_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes "closed S" "\<not> connected(- S)"
   obtains C where "C \<in> components S" "\<not> connected(- C)"
 proof -
   obtain x y where "closed S" "x \<notin> S" "y \<notin> S" and "\<not> connected_component (- S) x y"
     using assms by (auto simp: connected_iff_connected_component)
   then obtain C where "C \<in> components S" "\<not> connected_component(- C) x y"
     using separation_by_component_closed_pointwise by metis
   then show "thesis"
     apply (clarify elim!: componentsE)
     by (metis Compl_iff \<open>C \<in> components S\<close> \<open>x \<notin> S\<close> \<open>y \<notin> S\<close> connected_component_eq connected_component_eq_eq connected_iff_connected_component that)
 qed
 
 lemma separation_by_Un_closed_pointwise:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
       and conS: "connected_component (- S) a b" and conT: "connected_component (- T) a b"
     shows "connected_component (- (S \<union> T)) a b"
 proof (rule ccontr)
   have "a \<notin> S" "b \<notin> S" "a \<notin> T" "b \<notin> T"
     using conS conT connected_component_in by auto
   assume "\<not> connected_component (- (S \<union> T)) a b"
   then obtain C where "C \<in> components (S \<union> T)" and C: "\<not> connected_component(- C) a b"
     using separation_by_component_closed_pointwise assms by blast
   then have "C \<subseteq> S \<or> C \<subseteq> T"
   proof -
     have "connected C" "C \<subseteq> S \<union> T"
       using \<open>C \<in> components (S \<union> T)\<close> in_components_subset by (blast elim: componentsE)+
     moreover then have "C \<inter> T = {} \<or> C \<inter> S = {}"
       by (metis Int_empty_right ST inf.commute connected_closed)
     ultimately show ?thesis
       by blast
   qed
   then show False
     by (meson Compl_anti_mono C conS conT connected_component_of_subset)
 qed
 
 lemma separation_by_Un_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}" and conS: "connected(- S)" and conT: "connected(- T)"
   shows "connected(- (S \<union> T))"
   using assms separation_by_Un_closed_pointwise
   by (fastforce simp add: connected_iff_connected_component)
 
 lemma open_unicoherent_UNIV:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "open T" "connected S" "connected T" "S \<union> T = UNIV"
   shows "connected(S \<inter> T)"
 proof -
   have "connected(- (-S \<union> -T))"
     by (metis closed_Compl compl_sup compl_top_eq double_compl separation_by_Un_closed assms)
   then show ?thesis
     by simp
 qed
 
 lemma separation_by_component_open_aux:
   fixes S :: "'a :: euclidean_space set"
   assumes ST: "closed S" "closed T" "S \<inter> T = {}"
       and "S \<noteq> {}" "T \<noteq> {}"
   obtains C where "C \<in> components(-(S \<union> T))" "C \<noteq> {}" "frontier C \<inter> S \<noteq> {}" "frontier C \<inter> T \<noteq> {}"
 proof (rule ccontr)
   let ?S = "S \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> S}"
   let ?T = "T \<union> \<Union>{C \<in> components(- (S \<union> T)). frontier C \<subseteq> T}"
   assume "\<not> thesis"
   with that have *: "frontier C \<inter> S = {} \<or> frontier C \<inter> T = {}"
             if C: "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
     using C by blast
   have "\<exists>A B::'a set. closed A \<and> closed B \<and> UNIV \<subseteq> A \<union> B \<and> A \<inter> B = {} \<and> A \<noteq> {} \<and> B \<noteq> {}"
   proof (intro exI conjI)
     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> S}) \<subseteq> S"
       apply (rule subset_trans [OF frontier_Union_subset_closure])
       by (metis (no_types, lifting) SUP_least \<open>closed S\<close> closure_minimal mem_Collect_eq)
     then have "frontier ?S \<subseteq> S"
       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
     then show "closed ?S"
       using frontier_subset_eq by fastforce
     have "frontier (\<Union>{C \<in> components (- S \<inter> - T). frontier C \<subseteq> T}) \<subseteq> T"
       apply (rule subset_trans [OF frontier_Union_subset_closure])
       by (metis (no_types, lifting) SUP_least \<open>closed T\<close> closure_minimal mem_Collect_eq)
     then have "frontier ?T \<subseteq> T"
       by (simp add: frontier_subset_eq assms  subset_trans [OF frontier_Un_subset])
     then show "closed ?T"
       using frontier_subset_eq by fastforce
     have "UNIV \<subseteq> (S \<union> T) \<union> \<Union>(components(- (S \<union> T)))"
       using Union_components by blast
     also have "...  \<subseteq> ?S \<union> ?T"
     proof -
       have "C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> S \<or>
             C \<in> components (-(S \<union> T)) \<and> frontier C \<subseteq> T"
         if "C \<in> components (- (S \<union> T))" "C \<noteq> {}" for C
         using * [OF that] that
         by clarify (metis (no_types, lifting) UnE \<open>closed S\<close> \<open>closed T\<close> closed_Un disjoint_iff_not_equal frontier_of_components_closed_complement subsetCE)
       then show ?thesis
         by blast
     qed
     finally show "UNIV \<subseteq> ?S \<union> ?T" .
     have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<union>
           \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} \<subseteq> - (S \<union> T)"
       using in_components_subset by fastforce
     moreover have "\<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> S} \<inter>
                    \<Union>{C \<in> components (- (S \<union> T)). frontier C \<subseteq> T} = {}"
     proof -
       have "C \<inter> C' = {}" if "C \<in> components (- (S \<union> T))" "frontier C \<subseteq> S"
                             "C' \<in> components (- (S \<union> T))" "frontier C' \<subseteq> T" for C C'
       proof -
         have NUN: "- S \<inter> - T \<noteq> UNIV"
           using \<open>T \<noteq> {}\<close> by blast
         have "C \<noteq> C'"
         proof
           assume "C = C'"
           with that have "frontier C' \<subseteq> S \<inter> T"
             by simp
           also have "... = {}"
             using \<open>S \<inter> T = {}\<close> by blast
           finally have "C' = {} \<or> C' = UNIV"
             using frontier_eq_empty by auto
           then show False
             using \<open>C = C'\<close> NUN that by (force simp: dest: in_components_nonempty in_components_subset)
         qed
         with that show ?thesis
           by (simp add: components_nonoverlap [of _ "-(S \<union> T)"])
       qed
       then show ?thesis
         by blast
     qed
     ultimately show "?S \<inter> ?T = {}"
       using ST by blast
     show "?S \<noteq> {}" "?T \<noteq> {}"
       using \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> by blast+
   qed
     then show False
       by (metis Compl_disjoint connected_UNIV compl_bot_eq compl_unique connected_closedD inf_sup_absorb sup_compl_top_left1 top.extremum_uniqueI)
 qed
 
 
 proposition separation_by_component_open:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" and non: "\<not> connected(- S)"
   obtains C where "C \<in> components S" "\<not> connected(- C)"
 proof -
   obtain T U
     where "closed T" "closed U" and TU: "T \<union> U = - S" "T \<inter> U = {}" "T \<noteq> {}" "U \<noteq> {}"
     using assms by (auto simp: connected_closed_set closed_def)
   then obtain C where C: "C \<in> components(-(T \<union> U))" "C \<noteq> {}"
           and "frontier C \<inter> T \<noteq> {}" "frontier C \<inter> U \<noteq> {}"
     using separation_by_component_open_aux [OF \<open>closed T\<close> \<open>closed U\<close> \<open>T \<inter> U = {}\<close>] by force
   show "thesis"
   proof
     show "C \<in> components S"
       using C(1) TU(1) by auto
     show "\<not> connected (- C)"
     proof
       assume "connected (- C)"
       then have "connected (frontier C)"
         using connected_frontier_simple [of C] \<open>C \<in> components S\<close> in_components_connected by blast
       then show False
         unfolding connected_closed
         by (metis C(1) TU(2) \<open>closed T\<close> \<open>closed U\<close> \<open>frontier C \<inter> T \<noteq> {}\<close> \<open>frontier C \<inter> U \<noteq> {}\<close> closed_Un frontier_of_components_closed_complement inf_bot_right inf_commute)
     qed
   qed
 qed
 
 lemma separation_by_Un_open:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "open T" "S \<inter> T = {}" and cS: "connected(-S)" and cT: "connected(-T)"
     shows "connected(- (S \<union> T))"
   using assms unicoherent_UNIV unfolding unicoherent_def by force
 
 
 lemma nonseparation_by_component_eq:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S \<or> closed S"
   shows "((\<forall>C \<in> components S. connected(-C)) \<longleftrightarrow> connected(- S))" (is "?lhs = ?rhs")
 proof
   assume ?lhs with assms show ?rhs
     by (meson separation_by_component_closed separation_by_component_open)
 next
   assume ?rhs with assms show ?lhs
     using component_complement_connected by force
 qed
 
 
 text\<open>Another interesting equivalent of an inessential mapping into C-{0}\<close>
 proposition inessential_eq_extensible:
   fixes f :: "'a::euclidean_space \<Rightarrow> complex"
   assumes "closed S"
   shows "(\<exists>a. homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)) \<longleftrightarrow>
          (\<exists>g. continuous_on UNIV g \<and> (\<forall>x \<in> S. g x = f x) \<and> (\<forall>x. g x \<noteq> 0))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain a where a: "homotopic_with_canon (\<lambda>h. True) S (-{0}) f (\<lambda>t. a)" ..
   show ?rhs
   proof (cases "S = {}")
     case True
     with a show ?thesis by force
   next
     case False
     have anr: "ANR (-{0::complex})"
       by (simp add: ANR_delete open_Compl open_imp_ANR)
     obtain g where contg: "continuous_on UNIV g" and gim: "g ` UNIV \<subseteq> -{0}"
                    and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     proof (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ homotopic_with_symD [OF a]])
       show "closedin (top_of_set UNIV) S"
         using assms by auto
       show "range (\<lambda>t. a) \<subseteq> - {0}"
         using a homotopic_with_imp_subset2 False by blast
     qed (use anr that in \<open>force+\<close>)
     then show ?thesis
       by force
   qed
 next
   assume ?rhs
   then obtain g where contg: "continuous_on UNIV g"
           and gf: "\<And>x. x \<in> S \<Longrightarrow> g x = f x" and non0: "\<And>x. g x \<noteq> 0"
     by metis
   obtain h k::"'a\<Rightarrow>'a" where hk: "homeomorphism (ball 0 1) UNIV h k"
     using homeomorphic_ball01_UNIV homeomorphic_def by blast
   then have "continuous_on (ball 0 1) (g \<circ> h)"
     by (meson contg continuous_on_compose continuous_on_subset homeomorphism_cont1 top_greatest)
   then obtain j where contj: "continuous_on (ball 0 1) j"
                   and j: "\<And>z. z \<in> ball 0 1 \<Longrightarrow> exp(j z) = (g \<circ> h) z"
     by (metis (mono_tags, hide_lams) continuous_logarithm_on_ball comp_apply non0)
   have [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (k x) = x"
     using hk homeomorphism_apply2 by blast
   have "\<exists>\<zeta>. continuous_on S \<zeta>\<and> (\<forall>x\<in>S. f x = exp (\<zeta> x))"
   proof (intro exI conjI ballI)
     show "continuous_on S (j \<circ> k)"
     proof (rule continuous_on_compose)
       show "continuous_on S k"
         by (meson continuous_on_subset hk homeomorphism_cont2 top_greatest)
       show "continuous_on (k ` S) j"
         apply (rule continuous_on_subset [OF contj])
         using homeomorphism_image2 [OF hk] continuous_on_subset [OF contj] by blast
     qed
     show "f x = exp ((j \<circ> k) x)" if "x \<in> S" for x
     proof -
       have "f x = (g \<circ> h) (k x)"
         by (simp add: gf that)
       also have "... = exp (j (k x))"
         by (metis rangeI homeomorphism_image2 [OF hk] j)
       finally show ?thesis by simp
     qed
   qed
   then show ?lhs
     by (simp add: inessential_eq_continuous_logarithm)
 qed
 
 lemma inessential_on_clopen_Union:
   fixes \<F> :: "'a::euclidean_space set set"
   assumes T: "path_connected T"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
       and "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
       and hom: "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>a. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. a)"
   obtains a where "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
 proof (cases "\<Union>\<F> = {}")
   case True
   with that show ?thesis
     by force
 next
   case False
   then obtain C where "C \<in> \<F>" "C \<noteq> {}"
     by blast
   then obtain a where clo: "closedin (top_of_set (\<Union>\<F>)) C"
     and ope: "openin (top_of_set (\<Union>\<F>)) C"
     and "homotopic_with_canon (\<lambda>x. True) C T f (\<lambda>x. a)"
     using assms by blast
   with \<open>C \<noteq> {}\<close> have "f ` C \<subseteq> T" "a \<in> T"
     using homotopic_with_imp_subset1 homotopic_with_imp_subset2 by blast+
   have "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f (\<lambda>x. a)"
   proof (rule homotopic_on_clopen_Union)
     show "\<And>S. S \<in> \<F> \<Longrightarrow> closedin (top_of_set (\<Union>\<F>)) S"
          "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set (\<Union>\<F>)) S"
       by (simp_all add: assms)
     show "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. a)" if "S \<in> \<F>" for S
     proof (cases "S = {}")
       case True
       then show ?thesis
         by auto
     next
       case False
       then obtain b where "b \<in> S"
         by blast
       obtain c where c: "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)"
         using \<open>S \<in> \<F>\<close> hom by blast
       then have "c \<in> T"
         using \<open>b \<in> S\<close> homotopic_with_imp_subset2 by blast
       then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. c)"
         using T \<open>a \<in> T\<close> homotopic_constant_maps path_connected_component
         by (simp add: homotopic_constant_maps path_connected_component)
       then show ?thesis
         using c homotopic_with_symD homotopic_with_trans by blast
     qed
   qed
   then show ?thesis ..
 qed
 
 proposition Janiszewski_dual:
   fixes S :: "complex set"
   assumes
    "compact S" "compact T" "connected S" "connected T" "connected(- (S \<union> T))"
  shows "connected(S \<inter> T)"
 proof -
   have ST: "compact (S \<union> T)"
     by (simp add: assms compact_Un)
   with Borsukian_imp_unicoherent [of "S \<union> T"] ST assms
   show ?thesis
     by (auto simp: closed_subset compact_imp_closed Borsukian_separation_compact unicoherent_def)
 qed
 
 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,3883 +1,3885 @@
 (*  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 (insert assms, simp)
   ultimately show ?thesis using assms
     by (subst suminf_eq_SUP) (auto simp: indicator_def)
 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
   thus ?thesis
     unfolding indicator_def
     by (simp add: if_distrib sum.If_cases[OF \<open>finite P\<close>])
 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 "... \<longlonglongrightarrow> f A + f B" by (rule tendsto_const)
   ultimately
   have "(\<lambda>n. \<Sum>i< Suc (Suc n). f (binaryset A B i)) \<longlonglongrightarrow> f A + f B"
     by metis
   hence "(\<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)"
     by (simp add: sums_def LIMSEQ_binaryset [where f=f, OF f] atLeast0LessThan)
 
 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. range A \<subseteq> M \<Longrightarrow> disjoint_family A \<Longrightarrow> (\<Union>i. A i) \<in> M \<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 "... = f (x \<union> (y-x))" using addf
     by (auto simp add: additive_def) (metis Diff_disjoint Un_Diff_cancel Diff xy(1,2))
   also have "... = 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 (auto simp: increasing_def intro: add_left_mono)
   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))" using insert by simp
 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 "... \<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\<in>{i. F i \<noteq> {}}. \<exists>x. x \<in> F i" by auto
   from bchoice[OF this] obtain f where f: "\<And>i. F i \<noteq> {} \<Longrightarrow> f i \<in> F i" by auto
 
   have inj_f: "inj_on f {i. F i \<noteq> {}}"
   proof (rule inj_onI, simp)
     fix i j a b assume *: "f i = f j" "F i \<noteq> {}" "F j \<noteq> {}"
     then have "f i \<in> F i" "f j \<in> F j" using f by force+
     with disj * show "i = j" by (auto simp: disjoint_family_on_def)
   qed
   have "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 (rule finite_subset) fact
   qed fact
   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))"
     using f(1)[unfolded positive_def] dA
     by (auto intro!: 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: "\<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 "(\<lambda>n. f (\<Union>i<n. A i)) \<longlonglongrightarrow> f (\<Union>i. A i)"
   proof (unfold *[symmetric], intro cont[rule_format])
     show "range (\<lambda>i. \<Union>i<i. A i) \<subseteq> M" "(\<Union>i. \<Union>i<i. A i) \<in> M"
       using A * by auto
   qed (force intro!: 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, of _ A, symmetric])
        (auto intro: disjoint_family_on_mono[where B=UNIV])
   ultimately
   have "(\<lambda>i. f (A i)) sums f (\<Union>i. A i)"
     unfolding sums_def by simp
   from sums_unique[OF this]
   show "(\<Sum>i. f (A i)) = f (\<Union>i. A i)" by simp
 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: "(\<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[THEN spec, of A] show "(\<lambda>i. f (A i)) \<longlonglongrightarrow> 0"
     using \<open>positive M f\<close>[unfolded positive_def] by auto
 next
   assume cont: "\<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)
   { fix i
     have "f (A i - (\<Inter>i. A i)) \<le> f (A i)" using A by (auto intro!: f_mono)
     then have "f (A i - (\<Inter>i. A i)) \<noteq> \<infinity>"
       using A by (auto simp: top_unique) }
   note f_fin = this
   have "(\<lambda>i. f (A i - (\<Inter>i. A i))) \<longlonglongrightarrow> 0"
   proof (intro cont[rule_format, 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
   from INF_Lim[OF decseq_f this]
   have "(INF n. f (A n - (\<Inter>i. A i))) = 0" .
   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
     by (subst INF_ennreal_add_const) (auto simp: decseq_f)
   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 f(3)[rule_format, of "A i"] A by (auto simp: ennreal_add_diff_cancel subset_eq) }
   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 finite: "emeasure M B \<noteq> \<infinity>"
   and [measurable]: "A \<in> sets M" "B \<in> sets M" and "B \<subseteq> A"
   shows "emeasure M (A - B) = emeasure M A - emeasure M B"
 proof -
   have "(A - B) \<union> B = A" using \<open>B \<subseteq> A\<close> by auto
   then have "emeasure M A = emeasure M ((A - B) \<union> B)" by simp
   also have "\<dots> = emeasure M (A - B) + emeasure M B"
     by (subst plus_emeasure[symmetric]) auto
   finally show "emeasure M (A - B) = emeasure M A - emeasure M B"
     using finite by simp
 qed
 
 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 (rule ennreal_minus_cancel[rotated 3])
        (insert finite A, auto intro: INF_lower emeasure_mono)
 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 (intro bexI[of _ i'] emeasure_mono decseqD[OF \<open>decseq A\<close>] A) auto
   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 g=f and f=F and P="Measurable.pred N", 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[abs_def]
     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[abs_def] 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_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" "{x\<in>space M. P x} \<in> sets M"
   shows "emeasure M {x\<in>space M. \<not> P x} = 0" (is "emeasure M ?P = 0")
 proof -
   have "{x\<in>space M. \<not> P x} = space M - {x\<in>space M. P x}" by auto
   with AE_iff_null[of M P] assms show ?thesis by auto
 qed
 
 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"
 proof -
   from AE_P obtain A where P: "{x\<in>space M. \<not> P x} \<subseteq> A"
     and A: "A \<in> sets M" "emeasure M A = 0"
     by (auto elim!: AE_E)
 
   from AE_imp obtain B where imp: "{x\<in>space M. P x \<and> \<not> Q x} \<subseteq> B"
     and B: "B \<in> sets M" "emeasure M B = 0"
     by (auto elim!: AE_E)
 
   show ?thesis
   proof (intro AE_I)
     have "emeasure M (A \<union> B) \<le> 0"
       using emeasure_subadditive[of A M B] A B by auto
     then show "A \<union> B \<in> sets M" "emeasure M (A \<union> B) = 0"
       using A B by auto
     show "{x\<in>space M. \<not> Q x} \<subseteq> A \<union> B"
       using P imp by auto
   qed
 qed
 
 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...]\<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] guess N . note N = this
   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] guess N .
   with f show ?thesis
     unfolding eventually_ae_filter
     by (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 disjoint_family_on_insert:
   "i \<notin> I \<Longrightarrow> disjoint_family_on A (insert i I) \<longleftrightarrow> A i \<inter> (\<Union>i\<in>I. A i) = {} \<and> disjoint_family_on A I"
   by (fastforce simp: disjoint_family_on_def)
 
 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)"
     using emeasure_subadditive[OF measurable] fin
     apply simp
     apply (subst (asm) (2 3 4) emeasure_eq_ennreal_measure)
     apply (auto simp flip: ennreal_plus)
     done
 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 -
   from fin have **: "\<And>i. emeasure M (A i) \<noteq> top"
     using ennreal_suminf_lessD[of "\<lambda>i. emeasure M (A i)"] by (simp add: less_top)
   { have "emeasure M (\<Union>i. A i) \<le> (\<Sum>i. emeasure M (A i))"
       using emeasure_subadditive_countably[OF A] .
     also have "\<dots> < \<infinity>"
       using fin by (simp add: less_top)
     finally have "emeasure M (\<Union>i. A i) \<noteq> top" by simp }
   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
     apply (rule ennreal_le_iff[THEN iffD1, rotated])
     apply (intro suminf_nonneg allI measure_nonneg summable_suminf_not_top)
     using fin
     apply (simp add: emeasure_eq_ennreal_measure[OF **])
     done
 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) \<le> measure M (F i) + measure M (\<Union>i\<in>I. F i)"
-    by (auto intro!: measure_Un_le)
+  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\<in>{..<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\<in>{..<N}. emeasure M (A n))"
       unfolding B_def by (rule emeasure_subadditive_finite, auto)
     also have "... = (\<Sum>n\<in>{..<N}. ennreal(measure M (A n)))"
       using assms(2) by (simp add: emeasure_eq_ennreal_measure less_top)
     also have "... = ennreal (\<Sum>n\<in>{..<N}. measure M (A n))"
       by auto
     also have "... \<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 "... = emeasure M (\<Union>k. A (k+n))"
         using I by auto
       also have "... \<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
   {
     fix x assume "x \<notin> limsup A"
     then obtain N where "x \<notin> (\<Union>n\<in>{N..}. A n)" unfolding limsup_INF_SUP by blast
     then have "eventually (\<lambda>n. x \<notin> A n) sequentially" using eventually_sequentially by auto
   }
   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 g=f and f=F 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[abs_def]
     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
 
 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 guess i .. note i = this
       { fix j from i \<open>incseq F\<close> have "F j \<subseteq> F i"
           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 guess k .. note k = this
           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)
   then guess Y ..
   then show ?thesis
     apply (intro bexI[of _ Y] conjI ballI conjI)
     apply (simp_all add: sets_restrict_space emeasure_restrict_space)
     apply safe
     subgoal for X Z
       by (erule ballE[of _ _ X]) (auto simp add: Int_absorb1)
     subgoal for X Z
       by (erule ballE[of _ _ X])  (auto simp add: Int_absorb1 ac_simps)
     apply auto
     done
 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)"
   apply -
   apply (auto simp: le_measure_iff le_fun_def dest: sets_eq_imp_space_eq)
   subgoal for X
     by (cases "X \<in> sets M") (auto simp: emeasure_notin_sets)
   done
 
 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
         by (auto intro: disjoint_family_on_bisimulation [OF \<open>disjoint_family X\<close>, simplified])
       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
           proof
             assume "emeasure A (X i) = top" then show ?thesis
               by (intro bexI[of _ "X i"]) auto
           next
             assume "emeasure B (X i) = top" then show ?thesis
               by (intro bexI[of _ "{}"]) auto
           qed
         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[of _ Y] 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
         proof safe
           fix x j assume "x \<in> X i" "x \<in> C j"
           moreover have "i = j \<or> X i \<inter> X j = {}"
             using \<open>disjoint_family X\<close> by (auto simp: disjoint_family_on_def)
           ultimately show "x \<in> C i"
             using \<open>C i \<subseteq> X i\<close> \<open>C j \<subseteq> X j\<close> by auto
         qed auto
         have **: "X i \<inter> - (\<Union>i. C i) = X i \<inter> - C i" for i
         proof safe
           fix x j assume "x \<in> X i" "x \<notin> C i" "x \<in> C j"
           moreover have "i = j \<or> X i \<inter> X j = {}"
             using \<open>disjoint_family X\<close> by (auto simp: disjoint_family_on_def)
           ultimately show False
             using \<open>C i \<subseteq> X i\<close> \<open>C j \<subseteq> X j\<close> by auto
         qed auto
         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"
           apply (intro bexI[of _ "\<Union>i. C i"])
           unfolding * **
           apply (intro C ballI conjI)
           apply auto
           done
       qed
       also have "\<dots> = ?S (\<Union>i. X i)"
         apply (simp only: UN_extend_simps(4))
         apply (rule arg_cong [of _ _ Sup])
         apply (rule image_cong)
          apply (fact refl)
         using disjoint
         apply (auto simp add: suminf_add [symmetric] Diff_eq [symmetric] image_subset_iff suminf_emeasure simp del: UN_simps)
         done
       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
             apply (intro suminf_emeasure \<open>disjoint_family F\<close>)
             apply (subst sets_sup_measure_F[OF _ _ sets_eq])
             apply auto
             done
         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)"
   unfolding Sup_measure_def
   apply (intro Sup_lexord[where P="\<lambda>x. space x = _"])
   apply (subst space_Sup_measure'2)
   apply auto []
   apply (subst space_measure_of[OF UN_space_closed])
   apply auto
   done
 
 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
   apply (rule Sup_lexord1)
   apply fact
   apply (simp add: assms)
   apply (rule Sup_lexord)
   subgoal premises that for a S
     unfolding that(3) that(2)[symmetric]
     using that(1)
     apply (subst sets_Sup_measure'2)
     apply (intro arg_cong2[where f=sigma_sets])
     apply (auto simp: *)
     done
   apply (subst sets_measure_of[OF UN_space_closed])
   apply (simp add:  assms)
   done
 
 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]
   apply (intro Sup_lexord_rel[where R="\<lambda>x y. sets x = sets y"])
   apply simp
   apply simp
   apply (simp add: sets_Sup_measure'2)
   apply (intro arg_cong2[where f="\<lambda>x y. sets (sigma x y)"])
   apply auto
   done
 
 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 "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)"
     apply (intro measurable_cong_sets refl)
     apply (subst sets_Sup_eq[OF space_eq M])
     apply simp
     apply (subst sets_measure_of[OF UN_space_closed])
     apply (simp add: space_eq M)
     done
   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 show "sets (SUP m\<in>M. sigma \<Omega> m) = sets (sigma \<Omega> (\<Union>M))"
     apply (subst sets_Sup_eq[where X="\<Omega>"])
     apply (auto simp add: M) []
     apply auto []
     apply (simp add: space_measure_of_conv M Union_least)
     apply (rule sigma_sets_eqI)
     apply auto
     done
 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)"
       using sets_Sup_sigma[OF assms] sets_Sup_sigma[OF assms, THEN sets_eq_imp_space_eq]
       by auto
   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 "?IS = ?SI")
 proof
   show "?IS \<subseteq> ?SI"
     apply (intro sets_image_in_sets measurable_Sup2)
     apply (simp add: space_Sup_eq_UN *)
     apply (simp add: *)
     apply (intro measurable_Sup1)
     apply (rule imageI)
     apply assumption
     apply (rule measurable_vimage_algebra1)
     apply (auto simp: *)
     done
   show "?SI \<subseteq> ?IS"
     apply (intro sets_Sup_in_sets)
     apply (auto simp: *) []
     apply (auto simp: *) []
     apply (elim imageE)
     apply simp
     apply (rule sets_image_in_sets)
     apply simp
     apply (simp add: measurable_def)
     apply (simp add: * space_Sup_eq_UN sets_vimage_algebra2)
     apply (auto intro: in_sets_Sup[OF *(3)])
     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)"
 proof -
   have *: "{f -` A \<inter> space M |A. A \<in> sets N} \<subseteq> Pow (space M)"
     by auto
   show ?thesis
     unfolding measurable_def
     by (auto simp add: vimage_algebra_def sigma_le_sets[OF *])
 qed
 
 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 (insert N M, 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) (insert a, 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
   apply (subst (asm) space_measure_of)
   apply auto []
   apply (subst sigma_le_sets)
   apply auto
   done
 
 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"
   apply safe
   apply (intro measure_eqI)
   apply auto
   done
 
 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"
   with bounded_measure measure_le_0_iff have "{x. measure M {x} \<noteq> 0} = {}"
     by auto
   then show ?thesis
     by simp
 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)
     from this(3) 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/Polytope.thy b/src/HOL/Analysis/Polytope.thy
--- a/src/HOL/Analysis/Polytope.thy
+++ b/src/HOL/Analysis/Polytope.thy
@@ -1,3999 +1,3998 @@
 section \<open>Faces, Extreme Points, Polytopes, Polyhedra etc\<close>
 
 text\<open>Ported from HOL Light by L C Paulson\<close>
 
 theory Polytope
 imports Cartesian_Euclidean_Space Path_Connected
 begin
 
 subsection \<open>Faces of a (usually convex) set\<close>
 
 definition\<^marker>\<open>tag important\<close> face_of :: "['a::real_vector set, 'a set] \<Rightarrow> bool" (infixr "(face'_of)" 50)
   where
   "T face_of S \<longleftrightarrow>
         T \<subseteq> S \<and> convex T \<and>
         (\<forall>a \<in> S. \<forall>b \<in> S. \<forall>x \<in> T. x \<in> open_segment a b \<longrightarrow> a \<in> T \<and> b \<in> T)"
 
 lemma face_ofD: "\<lbrakk>T face_of S; x \<in> open_segment a b; a \<in> S; b \<in> S; x \<in> T\<rbrakk> \<Longrightarrow> a \<in> T \<and> b \<in> T"
   unfolding face_of_def by blast
 
 lemma face_of_translation_eq [simp]:
     "((+) a ` T face_of (+) a ` S) \<longleftrightarrow> T face_of S"
 proof -
   have *: "\<And>a T S. T face_of S \<Longrightarrow> ((+) a ` T face_of (+) a ` S)"
     apply (simp add: face_of_def Ball_def, clarify)
     by (meson imageI open_segment_translation_eq)
   show ?thesis
     apply (rule iffI)
     apply (force simp: image_comp o_def dest: * [where a = "-a"])
     apply (blast intro: *)
     done
 qed
 
 lemma face_of_linear_image:
   assumes "linear f" "inj f"
     shows "(f ` c face_of f ` S) \<longleftrightarrow> c face_of S"
 by (simp add: face_of_def inj_image_subset_iff inj_image_mem_iff open_segment_linear_image assms)
 
 lemma face_of_refl: "convex S \<Longrightarrow> S face_of S"
   by (auto simp: face_of_def)
 
 lemma face_of_refl_eq: "S face_of S \<longleftrightarrow> convex S"
   by (auto simp: face_of_def)
 
 lemma empty_face_of [iff]: "{} face_of S"
   by (simp add: face_of_def)
 
 lemma face_of_empty [simp]: "S face_of {} \<longleftrightarrow> S = {}"
   by (meson empty_face_of face_of_def subset_empty)
 
 lemma face_of_trans [trans]: "\<lbrakk>S face_of T; T face_of u\<rbrakk> \<Longrightarrow> S face_of u"
   unfolding face_of_def by (safe; blast)
 
 lemma face_of_face: "T face_of S \<Longrightarrow> (f face_of T \<longleftrightarrow> f face_of S \<and> f \<subseteq> T)"
   unfolding face_of_def by (safe; blast)
 
 lemma face_of_subset: "\<lbrakk>F face_of S; F \<subseteq> T; T \<subseteq> S\<rbrakk> \<Longrightarrow> F face_of T"
   unfolding face_of_def by (safe; blast)
 
 lemma face_of_slice: "\<lbrakk>F face_of S; convex T\<rbrakk> \<Longrightarrow> (F \<inter> T) face_of (S \<inter> T)"
   unfolding face_of_def by (blast intro: convex_Int)
 
 lemma face_of_Int: "\<lbrakk>t1 face_of S; t2 face_of S\<rbrakk> \<Longrightarrow> (t1 \<inter> t2) face_of S"
   unfolding face_of_def by (blast intro: convex_Int)
 
 lemma face_of_Inter: "\<lbrakk>A \<noteq> {}; \<And>T. T \<in> A \<Longrightarrow> T face_of S\<rbrakk> \<Longrightarrow> (\<Inter> A) face_of S"
   unfolding face_of_def by (blast intro: convex_Inter)
 
 lemma face_of_Int_Int: "\<lbrakk>F face_of T; F' face_of t'\<rbrakk> \<Longrightarrow> (F \<inter> F') face_of (T \<inter> t')"
   unfolding face_of_def by (blast intro: convex_Int)
 
 lemma face_of_imp_subset: "T face_of S \<Longrightarrow> T \<subseteq> S"
   unfolding face_of_def by blast
 
 proposition face_of_imp_eq_affine_Int:
   fixes S :: "'a::euclidean_space set"
   assumes S: "convex S"  and T: "T face_of S"
   shows "T = (affine hull T) \<inter> S"
 proof -
   have "convex T" using T by (simp add: face_of_def)
   have *: False if x: "x \<in> affine hull T" and "x \<in> S" "x \<notin> T" and y: "y \<in> rel_interior T" for x y
   proof -
     obtain e where "e>0" and e: "cball y e \<inter> affine hull T \<subseteq> T"
       using y by (auto simp: rel_interior_cball)
     have "y \<noteq> x" "y \<in> S" "y \<in> T"
       using face_of_imp_subset rel_interior_subset T that by blast+
     then have zne: "\<And>u. \<lbrakk>u \<in> {0<..<1}; (1 - u) *\<^sub>R y + u *\<^sub>R x \<in> T\<rbrakk> \<Longrightarrow>  False"
       using \<open>x \<in> S\<close> \<open>x \<notin> T\<close> \<open>T face_of S\<close> unfolding face_of_def
       apply clarify
       apply (drule_tac x=x in bspec, assumption)
       apply (drule_tac x=y in bspec, assumption)
       apply (subst (asm) open_segment_commute)
       apply (force simp: open_segment_image_interval image_def)
       done
     have in01: "min (1/2) (e / norm (x - y)) \<in> {0<..<1}"
       using \<open>y \<noteq> x\<close> \<open>e > 0\<close> by simp
     show ?thesis
       apply (rule zne [OF in01])
       apply (rule e [THEN subsetD])
       apply (rule IntI)
         using \<open>y \<noteq> x\<close> \<open>e > 0\<close>
         apply (simp add: cball_def dist_norm algebra_simps)
         apply (simp add: Real_Vector_Spaces.scaleR_diff_right [symmetric] norm_minus_commute min_mult_distrib_right)
       apply (rule mem_affine [OF affine_affine_hull _ x])
       using \<open>y \<in> T\<close>  apply (auto simp: hull_inc)
       done
   qed
   show ?thesis
     apply (rule subset_antisym)
     using assms apply (simp add: hull_subset face_of_imp_subset)
     apply (cases "T={}", simp)
     apply (force simp: rel_interior_eq_empty [symmetric] \<open>convex T\<close> intro: *)
     done
 qed
 
 lemma face_of_imp_closed:
      fixes S :: "'a::euclidean_space set"
      assumes "convex S" "closed S" "T face_of S" shows "closed T"
   by (metis affine_affine_hull affine_closed closed_Int face_of_imp_eq_affine_Int assms)
 
 lemma face_of_Int_supporting_hyperplane_le_strong:
     assumes "convex(S \<inter> {x. a \<bullet> x = b})" and aleb: "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b"
       shows "(S \<inter> {x. a \<bullet> x = b}) face_of S"
 proof -
   have *: "a \<bullet> u = a \<bullet> x" if "x \<in> open_segment u v" "u \<in> S" "v \<in> S" and b: "b = a \<bullet> x"
           for u v x
   proof (rule antisym)
     show "a \<bullet> u \<le> a \<bullet> x"
       using aleb \<open>u \<in> S\<close> \<open>b = a \<bullet> x\<close> by blast
   next
     obtain \<xi> where "b = a \<bullet> ((1 - \<xi>) *\<^sub>R u + \<xi> *\<^sub>R v)" "0 < \<xi>" "\<xi> < 1"
       using \<open>b = a \<bullet> x\<close> \<open>x \<in> open_segment u v\<close> in_segment
       by (auto simp: open_segment_image_interval split: if_split_asm)
     then have "b + \<xi> * (a \<bullet> u) \<le> a \<bullet> u + \<xi> * b"
       using aleb [OF \<open>v \<in> S\<close>] by (simp add: algebra_simps)
     then have "(1 - \<xi>) * b \<le> (1 - \<xi>) * (a \<bullet> u)"
       by (simp add: algebra_simps)
     then have "b \<le> a \<bullet> u"
       using \<open>\<xi> < 1\<close> by auto
     with b show "a \<bullet> x \<le> a \<bullet> u" by simp
   qed
   show ?thesis
     apply (simp add: face_of_def assms)
     using "*" open_segment_commute by blast
 qed
 
 lemma face_of_Int_supporting_hyperplane_ge_strong:
    "\<lbrakk>convex(S \<inter> {x. a \<bullet> x = b}); \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk>
     \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   using face_of_Int_supporting_hyperplane_le_strong [of S "-a" "-b"] by simp
 
 lemma face_of_Int_supporting_hyperplane_le:
     "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   by (simp add: convex_Int convex_hyperplane face_of_Int_supporting_hyperplane_le_strong)
 
 lemma face_of_Int_supporting_hyperplane_ge:
     "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   by (simp add: convex_Int convex_hyperplane face_of_Int_supporting_hyperplane_ge_strong)
 
 lemma face_of_imp_convex: "T face_of S \<Longrightarrow> convex T"
   using face_of_def by blast
 
 lemma face_of_imp_compact:
     fixes S :: "'a::euclidean_space set"
     shows "\<lbrakk>convex S; compact S; T face_of S\<rbrakk> \<Longrightarrow> compact T"
   by (meson bounded_subset compact_eq_bounded_closed face_of_imp_closed face_of_imp_subset)
 
 lemma face_of_Int_subface:
      "\<lbrakk>A \<inter> B face_of A; A \<inter> B face_of B; C face_of A; D face_of B\<rbrakk>
       \<Longrightarrow> (C \<inter> D) face_of C \<and> (C \<inter> D) face_of D"
   by (meson face_of_Int_Int face_of_face inf_le1 inf_le2)
 
 lemma subset_of_face_of:
     fixes S :: "'a::real_normed_vector set"
     assumes "T face_of S" "u \<subseteq> S" "T \<inter> (rel_interior u) \<noteq> {}"
       shows "u \<subseteq> T"
 proof
   fix c
   assume "c \<in> u"
   obtain b where "b \<in> T" "b \<in> rel_interior u" using assms by auto
   then obtain e where "e>0" "b \<in> u" and e: "cball b e \<inter> affine hull u \<subseteq> u"
     by (auto simp: rel_interior_cball)
   show "c \<in> T"
   proof (cases "b=c")
     case True with \<open>b \<in> T\<close> show ?thesis by blast
   next
     case False
     define d where "d = b + (e / norm(b - c)) *\<^sub>R (b - c)"
     have "d \<in> cball b e \<inter> affine hull u"
       using \<open>e > 0\<close> \<open>b \<in> u\<close> \<open>c \<in> u\<close>
       by (simp add: d_def dist_norm hull_inc mem_affine_3_minus False)
     with e have "d \<in> u" by blast
     have nbc: "norm (b - c) + e > 0" using \<open>e > 0\<close>
       by (metis add.commute le_less_trans less_add_same_cancel2 norm_ge_zero)
     then have [simp]: "d \<noteq> c" using False scaleR_cancel_left [of "1 + (e / norm (b - c))" b c]
       by (simp add: algebra_simps d_def) (simp add: field_split_simps)
     have [simp]: "((e - e * e / (e + norm (b - c))) / norm (b - c)) = (e / (e + norm (b - c)))"
       using False nbc
       by (simp add: divide_simps) (simp add: algebra_simps)
     have "b \<in> open_segment d c"
       apply (simp add: open_segment_image_interval)
       apply (simp add: d_def algebra_simps image_def)
       apply (rule_tac x="e / (e + norm (b - c))" in bexI)
       using False nbc \<open>0 < e\<close>
       apply (auto simp: algebra_simps)
       done
     then have "d \<in> T \<and> c \<in> T"
       apply (rule face_ofD [OF \<open>T face_of S\<close>])
       using \<open>d \<in> u\<close>  \<open>c \<in> u\<close> \<open>u \<subseteq> S\<close>  \<open>b \<in> T\<close>  apply auto
       done
     then show ?thesis ..
   qed
 qed
 
 lemma face_of_eq:
     fixes S :: "'a::real_normed_vector set"
     assumes "T face_of S" "u face_of S" "(rel_interior T) \<inter> (rel_interior u) \<noteq> {}"
       shows "T = u"
   apply (rule subset_antisym)
   apply (metis assms disjoint_iff_not_equal face_of_imp_subset rel_interior_subset subsetCE subset_of_face_of)
   by (metis assms disjoint_iff_not_equal face_of_imp_subset rel_interior_subset subset_iff subset_of_face_of)
 
 lemma face_of_disjoint_rel_interior:
       fixes S :: "'a::real_normed_vector set"
       assumes "T face_of S" "T \<noteq> S"
         shows "T \<inter> rel_interior S = {}"
   by (meson assms subset_of_face_of face_of_imp_subset order_refl subset_antisym)
 
 lemma face_of_disjoint_interior:
       fixes S :: "'a::real_normed_vector set"
       assumes "T face_of S" "T \<noteq> S"
         shows "T \<inter> interior S = {}"
 proof -
   have "T \<inter> interior S \<subseteq> rel_interior S"
     by (meson inf_sup_ord(2) interior_subset_rel_interior order.trans)
   thus ?thesis
     by (metis (no_types) Int_greatest assms face_of_disjoint_rel_interior inf_sup_ord(1) subset_empty)
 qed
 
 lemma face_of_subset_rel_boundary:
   fixes S :: "'a::real_normed_vector set"
   assumes "T face_of S" "T \<noteq> S"
     shows "T \<subseteq> (S - rel_interior S)"
 by (meson DiffI assms disjoint_iff_not_equal face_of_disjoint_rel_interior face_of_imp_subset rev_subsetD subsetI)
 
 lemma face_of_subset_rel_frontier:
     fixes S :: "'a::real_normed_vector set"
     assumes "T face_of S" "T \<noteq> S"
       shows "T \<subseteq> rel_frontier S"
   using assms closure_subset face_of_disjoint_rel_interior face_of_imp_subset rel_frontier_def by fastforce
 
 lemma face_of_aff_dim_lt:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "T face_of S" "T \<noteq> S"
     shows "aff_dim T < aff_dim S"
 proof -
   have "aff_dim T \<le> aff_dim S"
     by (simp add: face_of_imp_subset aff_dim_subset assms)
   moreover have "aff_dim T \<noteq> aff_dim S"
   proof (cases "T = {}")
     case True then show ?thesis
       by (metis aff_dim_empty \<open>T \<noteq> S\<close>)
   next case False then show ?thesis
     by (metis Set.set_insert assms convex_rel_frontier_aff_dim dual_order.irrefl face_of_imp_convex face_of_subset_rel_frontier insert_not_empty subsetI)
   qed
   ultimately show ?thesis
     by simp
 qed
 
 lemma subset_of_face_of_affine_hull:
     fixes S :: "'a::euclidean_space set"
   assumes T: "T face_of S" and "convex S" "U \<subseteq> S" and dis: "\<not> disjnt (affine hull T) (rel_interior U)"
   shows "U \<subseteq> T"
   apply (rule subset_of_face_of [OF T \<open>U \<subseteq> S\<close>])
   using face_of_imp_eq_affine_Int [OF \<open>convex S\<close> T]
   using rel_interior_subset [of U] dis
   using \<open>U \<subseteq> S\<close> disjnt_def by fastforce
 
 lemma affine_hull_face_of_disjoint_rel_interior:
     fixes S :: "'a::euclidean_space set"
   assumes "convex S" "F face_of S" "F \<noteq> S"
   shows "affine hull F \<inter> rel_interior S = {}"
   by (metis assms disjnt_def face_of_imp_subset order_refl subset_antisym subset_of_face_of_affine_hull)
 
 lemma affine_diff_divide:
     assumes "affine S" "k \<noteq> 0" "k \<noteq> 1" and xy: "x \<in> S" "y /\<^sub>R (1 - k) \<in> S"
       shows "(x - y) /\<^sub>R k \<in> S"
 proof -
   have "inverse(k) *\<^sub>R (x - y) = (1 - inverse k) *\<^sub>R inverse(1 - k) *\<^sub>R y + inverse(k) *\<^sub>R x"
     using assms
     by (simp add: algebra_simps) (simp add: scaleR_left_distrib [symmetric] field_split_simps)
   then show ?thesis
     using \<open>affine S\<close> xy by (auto simp: affine_alt)
 qed
 
 proposition face_of_convex_hulls:
       assumes S: "finite S" "T \<subseteq> S" and disj: "affine hull T \<inter> convex hull (S - T) = {}"
       shows  "(convex hull T) face_of (convex hull S)"
 proof -
   have fin: "finite T" "finite (S - T)" using assms
     by (auto simp: finite_subset)
   have *: "x \<in> convex hull T"
           if x: "x \<in> convex hull S" and y: "y \<in> convex hull S" and w: "w \<in> convex hull T" "w \<in> open_segment x y"
           for x y w
   proof -
     have waff: "w \<in> affine hull T"
       using convex_hull_subset_affine_hull w by blast
     obtain a b where a: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> a i" and asum: "sum a S = 1" and aeqx: "(\<Sum>i\<in>S. a i *\<^sub>R i) = x"
                  and b: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> b i" and bsum: "sum b S = 1" and beqy: "(\<Sum>i\<in>S. b i *\<^sub>R i) = y"
       using x y by (auto simp: assms convex_hull_finite)
     obtain u where "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> convex hull T" "x \<noteq> y" and weq: "w = (1 - u) *\<^sub>R x + u *\<^sub>R y"
                and u01: "0 < u" "u < 1"
       using w by (auto simp: open_segment_image_interval split: if_split_asm)
     define c where "c i = (1 - u) * a i + u * b i" for i
     have cge0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> c i"
       using a b u01 by (simp add: c_def)
     have sumc1: "sum c S = 1"
       by (simp add: c_def sum.distrib sum_distrib_left [symmetric] asum bsum)
     have sumci_xy: "(\<Sum>i\<in>S. c i *\<^sub>R i) = (1 - u) *\<^sub>R x + u *\<^sub>R y"
       apply (simp add: c_def sum.distrib scaleR_left_distrib)
       by (simp only: scaleR_scaleR [symmetric] Real_Vector_Spaces.scaleR_right.sum [symmetric] aeqx beqy)
     show ?thesis
     proof (cases "sum c (S - T) = 0")
       case True
       have ci0: "\<And>i. i \<in> (S - T) \<Longrightarrow> c i = 0"
         using True cge0 fin(2) sum_nonneg_eq_0_iff by auto
       have a0: "a i = 0" if "i \<in> (S - T)" for i
         using ci0 [OF that] u01 a [of i] b [of i] that
         by (simp add: c_def Groups.ordered_comm_monoid_add_class.add_nonneg_eq_0_iff)
       have [simp]: "sum a T = 1"
         using assms by (metis sum.mono_neutral_cong_right a0 asum)
       show ?thesis
         apply (simp add: convex_hull_finite \<open>finite T\<close>)
         apply (rule_tac x=a in exI)
         using a0 assms
         apply (auto simp: cge0 a aeqx [symmetric] sum.mono_neutral_right)
         done
     next
       case False
       define k where "k = sum c (S - T)"
       have "k > 0" using False
         unfolding k_def by (metis DiffD1 antisym_conv cge0 sum_nonneg not_less)
       have weq_sumsum: "w = sum (\<lambda>x. c x *\<^sub>R x) T + sum (\<lambda>x. c x *\<^sub>R x) (S - T)"
         by (metis (no_types) add.commute S(1) S(2) sum.subset_diff sumci_xy weq)
       show ?thesis
       proof (cases "k = 1")
         case True
         then have "sum c T = 0"
           by (simp add: S k_def sum_diff sumc1)
         then have [simp]: "sum c (S - T) = 1"
           by (simp add: S sum_diff sumc1)
         have ci0: "\<And>i. i \<in> T \<Longrightarrow> c i = 0"
           by (meson \<open>finite T\<close> \<open>sum c T = 0\<close> \<open>T \<subseteq> S\<close> cge0 sum_nonneg_eq_0_iff subsetCE)
         then have [simp]: "(\<Sum>i\<in>S-T. c i *\<^sub>R i) = w"
           by (simp add: weq_sumsum)
         have "w \<in> convex hull (S - T)"
           apply (simp add: convex_hull_finite fin)
           apply (rule_tac x=c in exI)
           apply (auto simp: cge0 weq True k_def)
           done
         then show ?thesis
           using disj waff by blast
       next
         case False
         then have sumcf: "sum c T = 1 - k"
           by (simp add: S k_def sum_diff sumc1)
         have "(\<Sum>i\<in>T. c i *\<^sub>R i) /\<^sub>R (1 - k) \<in> convex hull T"
           apply (simp add: convex_hull_finite fin)
           apply (rule_tac x="\<lambda>i. inverse (1-k) * c i" in exI)
           apply auto
           apply (metis sumcf cge0 inverse_nonnegative_iff_nonnegative mult_nonneg_nonneg S(2) sum_nonneg subsetCE)
           apply (metis False mult.commute right_inverse right_minus_eq sum_distrib_left sumcf)
           by (metis (mono_tags, lifting) scaleR_right.sum scaleR_scaleR sum.cong)
         with \<open>0 < k\<close>  have "inverse(k) *\<^sub>R (w - sum (\<lambda>i. c i *\<^sub>R i) T) \<in> affine hull T"
           by (simp add: affine_diff_divide [OF affine_affine_hull] False waff convex_hull_subset_affine_hull [THEN subsetD])
         moreover have "inverse(k) *\<^sub>R (w - sum (\<lambda>x. c x *\<^sub>R x) T) \<in> convex hull (S - T)"
           apply (simp add: weq_sumsum convex_hull_finite fin)
           apply (rule_tac x="\<lambda>i. inverse k * c i" in exI)
           using \<open>k > 0\<close> cge0
           apply (auto simp: scaleR_right.sum sum_distrib_left [symmetric] k_def [symmetric])
           done
         ultimately show ?thesis
           using disj by blast
       qed
     qed
   qed
   have [simp]: "convex hull T \<subseteq> convex hull S"
     by (simp add: \<open>T \<subseteq> S\<close> hull_mono)
   show ?thesis
     using open_segment_commute by (auto simp: face_of_def intro: *)
 qed
 
 proposition face_of_convex_hull_insert:
    "\<lbrakk>finite S; a \<notin> affine hull S; T face_of convex hull S\<rbrakk> \<Longrightarrow> T face_of convex hull insert a S"
   apply (rule face_of_trans, blast)
   apply (rule face_of_convex_hulls; force simp: insert_Diff_if)
   done
 
 proposition face_of_affine_trivial:
     assumes "affine S" "T face_of S"
     shows "T = {} \<or> T = S"
 proof (rule ccontr, clarsimp)
   assume "T \<noteq> {}" "T \<noteq> S"
   then obtain a where "a \<in> T" by auto
   then have "a \<in> S"
     using \<open>T face_of S\<close> face_of_imp_subset by blast
   have "S \<subseteq> T"
   proof
     fix b  assume "b \<in> S"
     show "b \<in> T"
     proof (cases "a = b")
       case True with \<open>a \<in> T\<close> show ?thesis by auto
     next
       case False
       then have "a \<in> open_segment (2 *\<^sub>R a - b) b"
         apply (auto simp: open_segment_def closed_segment_def)
         apply (rule_tac x="1/2" in exI)
         apply (simp add: algebra_simps)
         by (simp add: scaleR_2)
       moreover have "2 *\<^sub>R a - b \<in> S"
         by (rule mem_affine [OF \<open>affine S\<close> \<open>a \<in> S\<close> \<open>b \<in> S\<close>, of 2 "-1", simplified])
       moreover note \<open>b \<in> S\<close> \<open>a \<in> T\<close>
       ultimately show ?thesis
         by (rule face_ofD [OF \<open>T face_of S\<close>, THEN conjunct2])
     qed
   qed
   then show False
     using \<open>T \<noteq> S\<close> \<open>T face_of S\<close> face_of_imp_subset by blast
 qed
 
 
 lemma face_of_affine_eq:
    "affine S \<Longrightarrow> (T face_of S \<longleftrightarrow> T = {} \<or> T = S)"
 using affine_imp_convex face_of_affine_trivial face_of_refl by auto
 
 
 proposition Inter_faces_finite_altbound:
     fixes T :: "'a::euclidean_space set set"
     assumes cfaI: "\<And>c. c \<in> T \<Longrightarrow> c face_of S"
     shows "\<exists>F'. finite F' \<and> F' \<subseteq> T \<and> card F' \<le> DIM('a) + 2 \<and> \<Inter>F' = \<Inter>T"
 proof (cases "\<forall>F'. finite F' \<and> F' \<subseteq> T \<and> card F' \<le> DIM('a) + 2 \<longrightarrow> (\<exists>c. c \<in> T \<and> c \<inter> (\<Inter>F') \<subset> (\<Inter>F'))")
   case True
   then obtain c where c:
        "\<And>F'. \<lbrakk>finite F'; F' \<subseteq> T; card F' \<le> DIM('a) + 2\<rbrakk> \<Longrightarrow> c F' \<in> T \<and> c F' \<inter> (\<Inter>F') \<subset> (\<Inter>F')"
     by metis
   define d where "d = rec_nat {c{}} (\<lambda>n r. insert (c r) r)"
   have [simp]: "d 0 = {c {}}"
     by (simp add: d_def)
   have dSuc [simp]: "\<And>n. d (Suc n) = insert (c (d n)) (d n)"
     by (simp add: d_def)
   have dn_notempty: "d n \<noteq> {}" for n
     by (induction n) auto
   have dn_le_Suc: "d n \<subseteq> T \<and> finite(d n) \<and> card(d n) \<le> Suc n" if "n \<le> DIM('a) + 2" for n
   using that
   proof (induction n)
     case 0
     then show ?case by (simp add: c)
   next
     case (Suc n)
     then show ?case by (auto simp: c card_insert_if)
   qed
   have aff_dim_le: "aff_dim(\<Inter>(d n)) \<le> DIM('a) - int n" if "n \<le> DIM('a) + 2" for n
   using that
   proof (induction n)
     case 0
     then show ?case
       by (simp add: aff_dim_le_DIM)
   next
     case (Suc n)
     have fs: "\<Inter>(d (Suc n)) face_of S"
       by (meson Suc.prems cfaI dn_le_Suc dn_notempty face_of_Inter subsetCE)
     have condn: "convex (\<Inter>(d n))"
       using Suc.prems nat_le_linear not_less_eq_eq
       by (blast intro: face_of_imp_convex cfaI convex_Inter dest: dn_le_Suc)
     have fdn: "\<Inter>(d (Suc n)) face_of \<Inter>(d n)"
       by (metis (no_types, lifting) Inter_anti_mono Suc.prems dSuc cfaI dn_le_Suc dn_notempty face_of_Inter face_of_imp_subset face_of_subset subset_iff subset_insertI)
     have ne: "\<Inter>(d (Suc n)) \<noteq> \<Inter>(d n)"
       by (metis (no_types, lifting) Suc.prems Suc_leD c complete_lattice_class.Inf_insert dSuc dn_le_Suc less_irrefl order.trans)
     have *: "\<And>m::int. \<And>d. \<And>d'::int. d < d' \<and> d' \<le> m - n \<Longrightarrow> d \<le> m - of_nat(n+1)"
       by arith
     have "aff_dim (\<Inter>(d (Suc n))) < aff_dim (\<Inter>(d n))"
       by (rule face_of_aff_dim_lt [OF condn fdn ne])
     moreover have "aff_dim (\<Inter>(d n)) \<le> int (DIM('a)) - int n"
       using Suc by auto
     ultimately
     have "aff_dim (\<Inter>(d (Suc n))) \<le> int (DIM('a)) - (n+1)" by arith
     then show ?case by linarith
   qed
   have "aff_dim (\<Inter>(d (DIM('a) + 2))) \<le> -2"
       using aff_dim_le [OF order_refl] by simp
   with aff_dim_geq [of "\<Inter>(d (DIM('a) + 2))"] show ?thesis
     using order.trans by fastforce
 next
   case False
   then show ?thesis
     apply simp
     apply (erule ex_forward)
     by blast
 qed
 
 lemma faces_of_translation:
    "{F. F face_of image (\<lambda>x. a + x) S} = image (image (\<lambda>x. a + x)) {F. F face_of S}"
 apply (rule subset_antisym, clarify)
 apply (auto simp: image_iff)
 apply (metis face_of_imp_subset face_of_translation_eq subset_imageE)
 done
 
 proposition face_of_Times:
   assumes "F face_of S" and "F' face_of S'"
     shows "(F \<times> F') face_of (S \<times> S')"
 proof -
   have "F \<times> F' \<subseteq> S \<times> S'"
     using assms [unfolded face_of_def] by blast
   moreover
   have "convex (F \<times> F')"
     using assms [unfolded face_of_def] by (blast intro: convex_Times)
   moreover
     have "a \<in> F \<and> a' \<in> F' \<and> b \<in> F \<and> b' \<in> F'"
        if "a \<in> S" "b \<in> S" "a' \<in> S'" "b' \<in> S'" "x \<in> F \<times> F'" "x \<in> open_segment (a,a') (b,b')"
        for a b a' b' x
   proof (cases "b=a \<or> b'=a'")
     case True with that show ?thesis
       using assms
       by (force simp: in_segment dest: face_ofD)
   next
     case False with assms [unfolded face_of_def] that show ?thesis
       by (blast dest!: open_segment_PairD)
   qed
   ultimately show ?thesis
     unfolding face_of_def by blast
 qed
 
 corollary face_of_Times_decomp:
     fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
     shows "c face_of (S \<times> S') \<longleftrightarrow> (\<exists>F F'. F face_of S \<and> F' face_of S' \<and> c = F \<times> F')"
      (is "?lhs = ?rhs")
 proof
   assume c: ?lhs
   show ?rhs
   proof (cases "c = {}")
     case True then show ?thesis by auto
   next
     case False
     have 1: "fst ` c \<subseteq> S" "snd ` c \<subseteq> S'"
       using c face_of_imp_subset by fastforce+
     have "convex c"
       using c by (metis face_of_imp_convex)
     have conv: "convex (fst ` c)" "convex (snd ` c)"
       by (simp_all add: \<open>convex c\<close> convex_linear_image linear_fst linear_snd)
     have fstab: "a \<in> fst ` c \<and> b \<in> fst ` c"
             if "a \<in> S" "b \<in> S" "x \<in> open_segment a b" "(x,x') \<in> c" for a b x x'
     proof -
       have *: "(x,x') \<in> open_segment (a,x') (b,x')"
         using that by (auto simp: in_segment)
       show ?thesis
         using face_ofD [OF c *] that face_of_imp_subset [OF c] by force
     qed
     have fst: "fst ` c face_of S"
       by (force simp: face_of_def 1 conv fstab)
     have sndab: "a' \<in> snd ` c \<and> b' \<in> snd ` c"
             if "a' \<in> S'" "b' \<in> S'" "x' \<in> open_segment a' b'" "(x,x') \<in> c" for a' b' x x'
     proof -
       have *: "(x,x') \<in> open_segment (x,a') (x,b')"
         using that by (auto simp: in_segment)
       show ?thesis
         using face_ofD [OF c *] that face_of_imp_subset [OF c] by force
     qed
     have snd: "snd ` c face_of S'"
       by (force simp: face_of_def 1 conv sndab)
     have cc: "rel_interior c \<subseteq> rel_interior (fst ` c) \<times> rel_interior (snd ` c)"
       by (force simp: face_of_Times rel_interior_Times conv fst snd \<open>convex c\<close> linear_fst linear_snd rel_interior_convex_linear_image [symmetric])
     have "c = fst ` c \<times> snd ` c"
       apply (rule face_of_eq [OF c])
       apply (simp_all add: face_of_Times rel_interior_Times conv fst snd)
       using False rel_interior_eq_empty \<open>convex c\<close> cc
       apply blast
       done
     with fst snd show ?thesis by metis
   qed
 next
   assume ?rhs with face_of_Times show ?lhs by auto
 qed
 
 lemma face_of_Times_eq:
     fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
     shows "(F \<times> F') face_of (S \<times> S') \<longleftrightarrow>
            F = {} \<or> F' = {} \<or> F face_of S \<and> F' face_of S'"
 by (auto simp: face_of_Times_decomp times_eq_iff)
 
 lemma hyperplane_face_of_halfspace_le: "{x. a \<bullet> x = b} face_of {x. a \<bullet> x \<le> b}"
 proof -
   have "{x. a \<bullet> x \<le> b} \<inter> {x. a \<bullet> x = b} = {x. a \<bullet> x = b}"
     by auto
   with face_of_Int_supporting_hyperplane_le [OF convex_halfspace_le [of a b], of a b]
   show ?thesis by auto
 qed
 
 lemma hyperplane_face_of_halfspace_ge: "{x. a \<bullet> x = b} face_of {x. a \<bullet> x \<ge> b}"
 proof -
   have "{x. a \<bullet> x \<ge> b} \<inter> {x. a \<bullet> x = b} = {x. a \<bullet> x = b}"
     by auto
   with face_of_Int_supporting_hyperplane_ge [OF convex_halfspace_ge [of b a], of b a]
   show ?thesis by auto
 qed
 
 lemma face_of_halfspace_le:
   fixes a :: "'n::euclidean_space"
   shows "F face_of {x. a \<bullet> x \<le> b} \<longleftrightarrow>
          F = {} \<or> F = {x. a \<bullet> x = b} \<or> F = {x. a \<bullet> x \<le> b}"
      (is "?lhs = ?rhs")
 proof (cases "a = 0")
   case True then show ?thesis
     using face_of_affine_eq affine_UNIV by auto
 next
   case False
   then have ine: "interior {x. a \<bullet> x \<le> b} \<noteq> {}"
     using halfspace_eq_empty_lt interior_halfspace_le by blast
   show ?thesis
   proof
     assume L: ?lhs
     have "F \<noteq> {x. a \<bullet> x \<le> b} \<Longrightarrow> F face_of {x. a \<bullet> x = b}"
       using False
       apply (simp add: frontier_halfspace_le [symmetric] rel_frontier_nonempty_interior [OF ine, symmetric])
       apply (rule face_of_subset [OF L])
       apply (simp add: face_of_subset_rel_frontier [OF L])
       apply (force simp: rel_frontier_def closed_halfspace_le)
       done
     with L show ?rhs
       using affine_hyperplane face_of_affine_eq by blast
   next
     assume ?rhs
     then show ?lhs
       by (metis convex_halfspace_le empty_face_of face_of_refl hyperplane_face_of_halfspace_le)
   qed
 qed
 
 lemma face_of_halfspace_ge:
   fixes a :: "'n::euclidean_space"
   shows "F face_of {x. a \<bullet> x \<ge> b} \<longleftrightarrow>
          F = {} \<or> F = {x. a \<bullet> x = b} \<or> F = {x. a \<bullet> x \<ge> b}"
 using face_of_halfspace_le [of F "-a" "-b"] by simp
 
 subsection\<open>Exposed faces\<close>
 
 text\<open>That is, faces that are intersection with supporting hyperplane\<close>
 
 definition\<^marker>\<open>tag important\<close> exposed_face_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"
                                (infixr "(exposed'_face'_of)" 50)
   where "T exposed_face_of S \<longleftrightarrow>
          T face_of S \<and> (\<exists>a b. S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b})"
 
 lemma empty_exposed_face_of [iff]: "{} exposed_face_of S"
   apply (simp add: exposed_face_of_def)
   apply (rule_tac x=0 in exI)
   apply (rule_tac x=1 in exI, force)
   done
 
 lemma exposed_face_of_refl_eq [simp]: "S exposed_face_of S \<longleftrightarrow> convex S"
   apply (simp add: exposed_face_of_def face_of_refl_eq, auto)
   apply (rule_tac x=0 in exI)+
   apply force
   done
 
 lemma exposed_face_of_refl: "convex S \<Longrightarrow> S exposed_face_of S"
   by simp
 
 lemma exposed_face_of:
     "T exposed_face_of S \<longleftrightarrow>
      T face_of S \<and>
      (T = {} \<or> T = S \<or>
       (\<exists>a b. a \<noteq> 0 \<and> S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b}))"
 proof (cases "T = {}")
   case True then show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof (cases "T = S")
     case True then show ?thesis
       by (simp add: face_of_refl_eq)
   next
     case False
     with \<open>T \<noteq> {}\<close> show ?thesis
       apply (auto simp: exposed_face_of_def)
       apply (metis inner_zero_left)
       done
   qed
 qed
 
 lemma exposed_face_of_Int_supporting_hyperplane_le:
    "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) exposed_face_of S"
 by (force simp: exposed_face_of_def face_of_Int_supporting_hyperplane_le)
 
 lemma exposed_face_of_Int_supporting_hyperplane_ge:
    "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) exposed_face_of S"
 using exposed_face_of_Int_supporting_hyperplane_le [of S "-a" "-b"] by simp
 
 proposition exposed_face_of_Int:
   assumes "T exposed_face_of S"
       and "u exposed_face_of S"
     shows "(T \<inter> u) exposed_face_of S"
 proof -
   obtain a b where T: "S \<inter> {x. a \<bullet> x = b} face_of S"
                and S: "S \<subseteq> {x. a \<bullet> x \<le> b}"
                and teq: "T = S \<inter> {x. a \<bullet> x = b}"
     using assms by (auto simp: exposed_face_of_def)
   obtain a' b' where u: "S \<inter> {x. a' \<bullet> x = b'} face_of S"
                  and s': "S \<subseteq> {x. a' \<bullet> x \<le> b'}"
                  and ueq: "u = S \<inter> {x. a' \<bullet> x = b'}"
     using assms by (auto simp: exposed_face_of_def)
   have tu: "T \<inter> u face_of S"
     using T teq u ueq by (simp add: face_of_Int)
   have ss: "S \<subseteq> {x. (a + a') \<bullet> x \<le> b + b'}"
     using S s' by (force simp: inner_left_distrib)
   show ?thesis
     apply (simp add: exposed_face_of_def tu)
     apply (rule_tac x="a+a'" in exI)
     apply (rule_tac x="b+b'" in exI)
     using S s'
     apply (fastforce simp: ss inner_left_distrib teq ueq)
     done
 qed
 
 proposition exposed_face_of_Inter:
     fixes P :: "'a::euclidean_space set set"
   assumes "P \<noteq> {}"
       and "\<And>T. T \<in> P \<Longrightarrow> T exposed_face_of S"
     shows "\<Inter>P exposed_face_of S"
 proof -
   obtain Q where "finite Q" and QsubP: "Q \<subseteq> P" "card Q \<le> DIM('a) + 2" and IntQ: "\<Inter>Q = \<Inter>P"
     using Inter_faces_finite_altbound [of P S] assms [unfolded exposed_face_of]
     by force
   show ?thesis
   proof (cases "Q = {}")
     case True then show ?thesis
       by (metis IntQ Inter_UNIV_conv(2) assms(1) assms(2) ex_in_conv)
   next
     case False
     have "Q \<subseteq> {T. T exposed_face_of S}"
       using QsubP assms by blast
     moreover have "Q \<subseteq> {T. T exposed_face_of S} \<Longrightarrow> \<Inter>Q exposed_face_of S"
       using \<open>finite Q\<close> False
       apply (induction Q rule: finite_induct)
       using exposed_face_of_Int apply fastforce+
       done
     ultimately show ?thesis
       by (simp add: IntQ)
   qed
 qed
 
 proposition exposed_face_of_sums:
   assumes "convex S" and "convex T"
       and "F exposed_face_of {x + y | x y. x \<in> S \<and> y \<in> T}"
           (is "F exposed_face_of ?ST")
   obtains k l
     where "k exposed_face_of S" "l exposed_face_of T"
           "F = {x + y | x y. x \<in> k \<and> y \<in> l}"
 proof (cases "F = {}")
   case True then show ?thesis
     using that by blast
 next
   case False
   show ?thesis
   proof (cases "F = ?ST")
     case True then show ?thesis
       using assms exposed_face_of_refl_eq that by blast
   next
     case False
     obtain p where "p \<in> F" using \<open>F \<noteq> {}\<close> by blast
     moreover
     obtain u z where T: "?ST \<inter> {x. u \<bullet> x = z} face_of ?ST"
                  and S: "?ST \<subseteq> {x. u \<bullet> x \<le> z}"
                  and feq: "F = ?ST \<inter> {x. u \<bullet> x = z}"
       using assms by (auto simp: exposed_face_of_def)
     ultimately obtain a0 b0
             where p: "p = a0 + b0" and "a0 \<in> S" "b0 \<in> T" and z: "u \<bullet> p = z"
       by auto
     have lez: "u \<bullet> (x + y) \<le> z" if "x \<in> S" "y \<in> T" for x y
       using S that by auto
     have sef: "S \<inter> {x. u \<bullet> x = u \<bullet> a0} exposed_face_of S"
       apply (rule exposed_face_of_Int_supporting_hyperplane_le [OF \<open>convex S\<close>])
       apply (metis p z add_le_cancel_right inner_right_distrib lez [OF _ \<open>b0 \<in> T\<close>])
       done
     have tef: "T \<inter> {x. u \<bullet> x = u \<bullet> b0} exposed_face_of T"
       apply (rule exposed_face_of_Int_supporting_hyperplane_le [OF \<open>convex T\<close>])
       apply (metis p z add.commute add_le_cancel_right inner_right_distrib lez [OF \<open>a0 \<in> S\<close>])
       done
     have "{x + y |x y. x \<in> S \<and> u \<bullet> x = u \<bullet> a0 \<and> y \<in> T \<and> u \<bullet> y = u \<bullet> b0} \<subseteq> F"
       by (auto simp: feq) (metis inner_right_distrib p z)
     moreover have "F \<subseteq> {x + y |x y. x \<in> S \<and> u \<bullet> x = u \<bullet> a0 \<and> y \<in> T \<and> u \<bullet> y = u \<bullet> b0}"
       apply (auto simp: feq)
       apply (rename_tac x y)
       apply (rule_tac x=x in exI)
       apply (rule_tac x=y in exI, simp)
       using z p \<open>a0 \<in> S\<close> \<open>b0 \<in> T\<close>
       apply clarify
       apply (simp add: inner_right_distrib)
       apply (metis add_le_cancel_right antisym lez [unfolded inner_right_distrib] add.commute)
       done
     ultimately have "F = {x + y |x y. x \<in> S \<inter> {x. u \<bullet> x = u \<bullet> a0} \<and> y \<in> T \<inter> {x. u \<bullet> x = u \<bullet> b0}}"
       by blast
     then show ?thesis
       by (rule that [OF sef tef])
   qed
 qed
 
 proposition exposed_face_of_parallel:
    "T exposed_face_of S \<longleftrightarrow>
          T face_of S \<and>
          (\<exists>a b. S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b} \<and>
                 (T \<noteq> {} \<longrightarrow> T \<noteq> S \<longrightarrow> a \<noteq> 0) \<and>
                 (T \<noteq> S \<longrightarrow> (\<forall>w \<in> affine hull S. (w + a) \<in> affine hull S)))"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
   proof (clarsimp simp: exposed_face_of_def)
     fix a b
     assume faceS: "S \<inter> {x. a \<bullet> x = b} face_of S" and Ssub: "S \<subseteq> {x. a \<bullet> x \<le> b}" 
     show "\<exists>c d. S \<subseteq> {x. c \<bullet> x \<le> d} \<and>
                 S \<inter> {x. a \<bullet> x = b} = S \<inter> {x. c \<bullet> x = d} \<and>
                 (S \<inter> {x. a \<bullet> x = b} \<noteq> {} \<longrightarrow> S \<inter> {x. a \<bullet> x = b} \<noteq> S \<longrightarrow> c \<noteq> 0) \<and>
                 (S \<inter> {x. a \<bullet> x = b} \<noteq> S \<longrightarrow> (\<forall>w \<in> affine hull S. w + c \<in> affine hull S))"
     proof (cases "affine hull S \<inter> {x. -a \<bullet> x \<le> -b} = {} \<or> affine hull S \<subseteq> {x. - a \<bullet> x \<le> - b}")
       case True
       then show ?thesis
       proof
         assume "affine hull S \<inter> {x. - a \<bullet> x \<le> - b} = {}"
        then show ?thesis
          apply (rule_tac x="0" in exI)
          apply (rule_tac x="1" in exI)
          using hull_subset by fastforce
     next
       assume "affine hull S \<subseteq> {x. - a \<bullet> x \<le> - b}"
       then show ?thesis
          apply (rule_tac x="0" in exI)
          apply (rule_tac x="0" in exI)
         using Ssub hull_subset by fastforce
     qed
   next
     case False
     then obtain a' b' where "a' \<noteq> 0" 
       and le: "affine hull S \<inter> {x. a' \<bullet> x \<le> b'} = affine hull S \<inter> {x. - a \<bullet> x \<le> - b}" 
       and eq: "affine hull S \<inter> {x. a' \<bullet> x = b'} = affine hull S \<inter> {x. - a \<bullet> x = - b}" 
       and mem: "\<And>w. w \<in> affine hull S \<Longrightarrow> w + a' \<in> affine hull S"
       using affine_parallel_slice affine_affine_hull by metis 
     show ?thesis
     proof (intro conjI impI allI ballI exI)
       have *: "S \<subseteq> - (affine hull S \<inter> {x. P x}) \<union> affine hull S \<inter> {x. Q x} \<Longrightarrow> S \<subseteq> {x. \<not> P x \<or> Q x}" 
         for P Q 
         using hull_subset by fastforce  
       have "S \<subseteq> {x. \<not> (a' \<bullet> x \<le> b') \<or> a' \<bullet> x = b'}"
         apply (rule *)
         apply (simp only: le eq)
         using Ssub by auto
       then show "S \<subseteq> {x. - a' \<bullet> x \<le> - b'}"
         by auto 
       show "S \<inter> {x. a \<bullet> x = b} = S \<inter> {x. - a' \<bullet> x = - b'}"
         using eq hull_subset [of S affine] by force
       show "\<lbrakk>S \<inter> {x. a \<bullet> x = b} \<noteq> {}; S \<inter> {x. a \<bullet> x = b} \<noteq> S\<rbrakk> \<Longrightarrow> - a' \<noteq> 0"
         using \<open>a' \<noteq> 0\<close> by auto
       show "w + - a' \<in> affine hull S"
         if "S \<inter> {x. a \<bullet> x = b} \<noteq> S" "w \<in> affine hull S" for w
       proof -
         have "w + 1 *\<^sub>R (w - (w + a')) \<in> affine hull S"
           using affine_affine_hull mem mem_affine_3_minus that(2) by blast
         then show ?thesis  by simp
       qed
     qed
   qed
 qed
 next
   assume ?rhs then show ?lhs
     unfolding exposed_face_of_def by blast
 qed
 
 subsection\<open>Extreme points of a set: its singleton faces\<close>
 
 definition\<^marker>\<open>tag important\<close> extreme_point_of :: "['a::real_vector, 'a set] \<Rightarrow> bool"
                                (infixr "(extreme'_point'_of)" 50)
   where "x extreme_point_of S \<longleftrightarrow>
          x \<in> S \<and> (\<forall>a \<in> S. \<forall>b \<in> S. x \<notin> open_segment a b)"
 
 lemma extreme_point_of_stillconvex:
    "convex S \<Longrightarrow> (x extreme_point_of S \<longleftrightarrow> x \<in> S \<and> convex(S - {x}))"
   by (fastforce simp add: convex_contains_segment extreme_point_of_def open_segment_def)
 
 lemma face_of_singleton:
    "{x} face_of S \<longleftrightarrow> x extreme_point_of S"
 by (fastforce simp add: extreme_point_of_def face_of_def)
 
 lemma extreme_point_not_in_REL_INTERIOR:
     fixes S :: "'a::real_normed_vector set"
     shows "\<lbrakk>x extreme_point_of S; S \<noteq> {x}\<rbrakk> \<Longrightarrow> x \<notin> rel_interior S"
 apply (simp add: face_of_singleton [symmetric])
 apply (blast dest: face_of_disjoint_rel_interior)
 done
 
 lemma extreme_point_not_in_interior:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "x extreme_point_of S \<Longrightarrow> x \<notin> interior S"
 apply (case_tac "S = {x}")
 apply (simp add: empty_interior_finite)
 by (meson contra_subsetD extreme_point_not_in_REL_INTERIOR interior_subset_rel_interior)
 
 lemma extreme_point_of_face:
      "F face_of S \<Longrightarrow> v extreme_point_of F \<longleftrightarrow> v extreme_point_of S \<and> v \<in> F"
   by (meson empty_subsetI face_of_face face_of_singleton insert_subset)
 
 lemma extreme_point_of_convex_hull:
    "x extreme_point_of (convex hull S) \<Longrightarrow> x \<in> S"
 apply (simp add: extreme_point_of_stillconvex)
 using hull_minimal [of S "(convex hull S) - {x}" convex]
 using hull_subset [of S convex]
 apply blast
 done
 
 proposition extreme_points_of_convex_hull:
    "{x. x extreme_point_of (convex hull S)} \<subseteq> S"
   using extreme_point_of_convex_hull by auto
 
 lemma extreme_point_of_empty [simp]: "\<not> (x extreme_point_of {})"
   by (simp add: extreme_point_of_def)
 
 lemma extreme_point_of_singleton [iff]: "x extreme_point_of {a} \<longleftrightarrow> x = a"
   using extreme_point_of_stillconvex by auto
 
 lemma extreme_point_of_translation_eq:
    "(a + x) extreme_point_of (image (\<lambda>x. a + x) S) \<longleftrightarrow> x extreme_point_of S"
 by (auto simp: extreme_point_of_def)
 
 lemma extreme_points_of_translation:
    "{x. x extreme_point_of (image (\<lambda>x. a + x) S)} =
     (\<lambda>x. a + x) ` {x. x extreme_point_of S}"
   using extreme_point_of_translation_eq
   by auto (metis (no_types, lifting) image_iff mem_Collect_eq minus_add_cancel)
 
 lemma extreme_points_of_translation_subtract:
    "{x. x extreme_point_of (image (\<lambda>x. x - a) S)} =
     (\<lambda>x. x - a) ` {x. x extreme_point_of S}"
   using extreme_points_of_translation [of "- a" S]
   by simp
 
 lemma extreme_point_of_Int:
    "\<lbrakk>x extreme_point_of S; x extreme_point_of T\<rbrakk> \<Longrightarrow> x extreme_point_of (S \<inter> T)"
 by (simp add: extreme_point_of_def)
 
 lemma extreme_point_of_Int_supporting_hyperplane_le:
    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> c extreme_point_of S"
 apply (simp add: face_of_singleton [symmetric])
 by (metis face_of_Int_supporting_hyperplane_le_strong convex_singleton)
 
 lemma extreme_point_of_Int_supporting_hyperplane_ge:
    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> c extreme_point_of S"
 apply (simp add: face_of_singleton [symmetric])
 by (metis face_of_Int_supporting_hyperplane_ge_strong convex_singleton)
 
 lemma exposed_point_of_Int_supporting_hyperplane_le:
    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> {c} exposed_face_of S"
 apply (simp add: exposed_face_of_def face_of_singleton)
 apply (force simp: extreme_point_of_Int_supporting_hyperplane_le)
 done
 
 lemma exposed_point_of_Int_supporting_hyperplane_ge:
     "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> {c} exposed_face_of S"
 using exposed_point_of_Int_supporting_hyperplane_le [of S "-a" "-b" c]
 by simp
 
 lemma extreme_point_of_convex_hull_insert:
    "\<lbrakk>finite S; a \<notin> convex hull S\<rbrakk> \<Longrightarrow> a extreme_point_of (convex hull (insert a S))"
 apply (case_tac "a \<in> S")
 apply (simp add: hull_inc)
 using face_of_convex_hulls [of "insert a S" "{a}"]
 apply (auto simp: face_of_singleton hull_same)
 done
 
 subsection\<open>Facets\<close>
 
 definition\<^marker>\<open>tag important\<close> facet_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"
                     (infixr "(facet'_of)" 50)
   where "F facet_of S \<longleftrightarrow> F face_of S \<and> F \<noteq> {} \<and> aff_dim F = aff_dim S - 1"
 
 lemma facet_of_empty [simp]: "\<not> S facet_of {}"
   by (simp add: facet_of_def)
 
 lemma facet_of_irrefl [simp]: "\<not> S facet_of S "
   by (simp add: facet_of_def)
 
 lemma facet_of_imp_face_of: "F facet_of S \<Longrightarrow> F face_of S"
   by (simp add: facet_of_def)
 
 lemma facet_of_imp_subset: "F facet_of S \<Longrightarrow> F \<subseteq> S"
   by (simp add: face_of_imp_subset facet_of_def)
 
 lemma hyperplane_facet_of_halfspace_le:
    "a \<noteq> 0 \<Longrightarrow> {x. a \<bullet> x = b} facet_of {x. a \<bullet> x \<le> b}"
 unfolding facet_of_def hyperplane_eq_empty
 by (auto simp: hyperplane_face_of_halfspace_ge hyperplane_face_of_halfspace_le
            Suc_leI of_nat_diff aff_dim_halfspace_le)
 
 lemma hyperplane_facet_of_halfspace_ge:
     "a \<noteq> 0 \<Longrightarrow> {x. a \<bullet> x = b} facet_of {x. a \<bullet> x \<ge> b}"
 unfolding facet_of_def hyperplane_eq_empty
 by (auto simp: hyperplane_face_of_halfspace_le hyperplane_face_of_halfspace_ge
            Suc_leI of_nat_diff aff_dim_halfspace_ge)
 
 lemma facet_of_halfspace_le:
     "F facet_of {x. a \<bullet> x \<le> b} \<longleftrightarrow> a \<noteq> 0 \<and> F = {x. a \<bullet> x = b}"
     (is "?lhs = ?rhs")
 proof
   assume c: ?lhs
   with c facet_of_irrefl show ?rhs
     by (force simp: aff_dim_halfspace_le facet_of_def face_of_halfspace_le cong: conj_cong split: if_split_asm)
 next
   assume ?rhs then show ?lhs
     by (simp add: hyperplane_facet_of_halfspace_le)
 qed
 
 lemma facet_of_halfspace_ge:
     "F facet_of {x. a \<bullet> x \<ge> b} \<longleftrightarrow> a \<noteq> 0 \<and> F = {x. a \<bullet> x = b}"
 using facet_of_halfspace_le [of F "-a" "-b"] by simp
 
 subsection \<open>Edges: faces of affine dimension 1\<close> (*FIXME too small subsection, rearrange? *)
 
 definition\<^marker>\<open>tag important\<close> edge_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"  (infixr "(edge'_of)" 50)
   where "e edge_of S \<longleftrightarrow> e face_of S \<and> aff_dim e = 1"
 
 lemma edge_of_imp_subset:
    "S edge_of T \<Longrightarrow> S \<subseteq> T"
 by (simp add: edge_of_def face_of_imp_subset)
 
 subsection\<open>Existence of extreme points\<close>
 
 proposition different_norm_3_collinear_points:
   fixes a :: "'a::euclidean_space"
   assumes "x \<in> open_segment a b" "norm(a) = norm(b)" "norm(x) = norm(b)"
   shows False
 proof -
   obtain u where "norm ((1 - u) *\<^sub>R a + u *\<^sub>R b) = norm b"
              and "a \<noteq> b"
              and u01: "0 < u" "u < 1"
     using assms by (auto simp: open_segment_image_interval if_splits)
   then have "(1 - u) *\<^sub>R a \<bullet> (1 - u) *\<^sub>R a + ((1 - u) * 2) *\<^sub>R a \<bullet> u *\<^sub>R b =
              (1 - u * u) *\<^sub>R (a \<bullet> a)"
     using assms by (simp add: norm_eq algebra_simps inner_commute)
   then have "(1 - u) *\<^sub>R ((1 - u) *\<^sub>R a \<bullet> a + (2 * u) *\<^sub>R  a \<bullet> b) =
              (1 - u) *\<^sub>R ((1 + u) *\<^sub>R (a \<bullet> a))"
     by (simp add: algebra_simps)
   then have "(1 - u) *\<^sub>R (a \<bullet> a) + (2 * u) *\<^sub>R (a \<bullet> b) = (1 + u) *\<^sub>R (a \<bullet> a)"
     using u01 by auto
   then have "a \<bullet> b = a \<bullet> a"
     using u01 by (simp add: algebra_simps)
   then have "a = b"
     using \<open>norm(a) = norm(b)\<close> norm_eq vector_eq by fastforce
   then show ?thesis
     using \<open>a \<noteq> b\<close> by force
 qed
 
 proposition extreme_point_exists_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "convex S" "S \<noteq> {}"
   obtains x where "x extreme_point_of S"
 proof -
   obtain x where "x \<in> S" and xsup: "\<And>y. y \<in> S \<Longrightarrow> norm y \<le> norm x"
     using distance_attains_sup [of S 0] assms by auto
   have False if "a \<in> S" "b \<in> S" and x: "x \<in> open_segment a b" for a b
   proof -
     have noax: "norm a \<le> norm x" and nobx: "norm b \<le> norm x" using xsup that by auto
     have "a \<noteq> b"
       using empty_iff open_segment_idem x by auto
     have *: "(1 - u) * na + u * nb < norm x" if "na < norm x"  "nb \<le> norm x" "0 < u" "u < 1" for na nb u
     proof -
       have "(1 - u) * na + u * nb < (1 - u) * norm x + u * nb"
         by (simp add: that)
       also have "... \<le> (1 - u) * norm x + u * norm x"
         by (simp add: that)
       finally have "(1 - u) * na + u * nb < (1 - u) * norm x + u * norm x" .
       then show ?thesis
       using scaleR_collapse [symmetric, of "norm x" u] by auto
     qed
     have "norm x < norm x" if "norm a < norm x"
       using x
       apply (clarsimp simp only: open_segment_image_interval \<open>a \<noteq> b\<close> if_False)
       apply (rule norm_triangle_lt)
       apply (simp add: norm_mult)
       using * [of "norm a" "norm b"] nobx that
         apply blast
       done
     moreover have "norm x < norm x" if "norm b < norm x"
       using x
       apply (clarsimp simp only: open_segment_image_interval \<open>a \<noteq> b\<close> if_False)
       apply (rule norm_triangle_lt)
       apply (simp add: norm_mult)
       using * [of "norm b" "norm a" "1-u" for u] noax that
         apply (simp add: add.commute)
       done
     ultimately have "\<not> (norm a < norm x) \<and> \<not> (norm b < norm x)"
       by auto
     then show ?thesis
       using different_norm_3_collinear_points noax nobx that(3) by fastforce
   qed
   then show ?thesis
     apply (rule_tac x=x in that)
     apply (force simp: extreme_point_of_def \<open>x \<in> S\<close>)
     done
 qed
 
 subsection\<open>Krein-Milman, the weaker form\<close>
 
 proposition Krein_Milman:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "convex S"
     shows "S = closure(convex hull {x. x extreme_point_of S})"
 proof (cases "S = {}")
   case True then show ?thesis   by simp
 next
   case False
   have "closed S"
     by (simp add: \<open>compact S\<close> compact_imp_closed)
   have "closure (convex hull {x. x extreme_point_of S}) \<subseteq> S"
     apply (rule closure_minimal [OF hull_minimal \<open>closed S\<close>])
     using assms
     apply (auto simp: extreme_point_of_def)
     done
   moreover have "u \<in> closure (convex hull {x. x extreme_point_of S})"
                 if "u \<in> S" for u
   proof (rule ccontr)
     assume unot: "u \<notin> closure(convex hull {x. x extreme_point_of S})"
     then obtain a b where "a \<bullet> u < b"
           and ab: "\<And>x. x \<in> closure(convex hull {x. x extreme_point_of S}) \<Longrightarrow> b < a \<bullet> x"
       using separating_hyperplane_closed_point [of "closure(convex hull {x. x extreme_point_of S})"]
       by blast
     have "continuous_on S ((\<bullet>) a)"
       by (rule continuous_intros)+
     then obtain m where "m \<in> S" and m: "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> m \<le> a \<bullet> y"
       using continuous_attains_inf [of S "\<lambda>x. a \<bullet> x"] \<open>compact S\<close> \<open>u \<in> S\<close>
       by auto
     define T where "T = S \<inter> {x. a \<bullet> x = a \<bullet> m}"
     have "m \<in> T"
       by (simp add: T_def \<open>m \<in> S\<close>)
     moreover have "compact T"
       by (simp add: T_def compact_Int_closed [OF \<open>compact S\<close> closed_hyperplane])
     moreover have "convex T"
       by (simp add: T_def convex_Int [OF \<open>convex S\<close> convex_hyperplane])
     ultimately obtain v where v: "v extreme_point_of T"
       using extreme_point_exists_convex [of T] by auto
     then have "{v} face_of T"
       by (simp add: face_of_singleton)
     also have "T face_of S"
       by (simp add: T_def m face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
     finally have "v extreme_point_of S"
       by (simp add: face_of_singleton)
     then have "b < a \<bullet> v"
       using closure_subset by (simp add: closure_hull hull_inc ab)
     then show False
       using \<open>a \<bullet> u < b\<close> \<open>{v} face_of T\<close> face_of_imp_subset m T_def that by fastforce
   qed
   ultimately show ?thesis
     by blast
 qed
 
 text\<open>Now the sharper form.\<close>
 
 lemma Krein_Milman_Minkowski_aux:
   fixes S :: "'a::euclidean_space set"
   assumes n: "dim S = n" and S: "compact S" "convex S" "0 \<in> S"
     shows "0 \<in> convex hull {x. x extreme_point_of S}"
 using n S
 proof (induction n arbitrary: S rule: less_induct)
   case (less n S) show ?case
   proof (cases "0 \<in> rel_interior S")
     case True with Krein_Milman show ?thesis
       by (metis subsetD convex_convex_hull convex_rel_interior_closure less.prems(2) less.prems(3) rel_interior_subset)
   next
     case False
     have "rel_interior S \<noteq> {}"
       by (simp add: rel_interior_convex_nonempty_aux less)
     then obtain c where c: "c \<in> rel_interior S" by blast
     obtain a where "a \<noteq> 0"
               and le_ay: "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> 0 \<le> a \<bullet> y"
               and less_ay: "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> 0 < a \<bullet> y"
       by (blast intro: supporting_hyperplane_rel_boundary intro!: less False)
     have face: "S \<inter> {x. a \<bullet> x = 0} face_of S"
       apply (rule face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
       using le_ay by auto
     then have co: "compact (S \<inter> {x. a \<bullet> x = 0})" "convex (S \<inter> {x. a \<bullet> x = 0})"
       using less.prems by (blast intro: face_of_imp_compact face_of_imp_convex)+
     have "a \<bullet> y = 0" if "y \<in> span (S \<inter> {x. a \<bullet> x = 0})" for y
     proof -
       have "y \<in> span {x. a \<bullet> x = 0}"
         by (metis inf.cobounded2 span_mono subsetCE that)
       then show ?thesis
         by (blast intro: span_induct [OF _ subspace_hyperplane])
     qed
     then have "dim (S \<inter> {x. a \<bullet> x = 0}) < n"
       by (metis (no_types) less_ay c subsetD dim_eq_span inf.strict_order_iff
            inf_le1 \<open>dim S = n\<close> not_le rel_interior_subset span_0 span_base)
     then have "0 \<in> convex hull {x. x extreme_point_of (S \<inter> {x. a \<bullet> x = 0})}"
       by (rule less.IH) (auto simp: co less.prems)
     then show ?thesis
       by (metis (mono_tags, lifting) Collect_mono_iff \<open>S \<inter> {x. a \<bullet> x = 0} face_of S\<close> extreme_point_of_face hull_mono subset_iff)
   qed
 qed
 
 
 theorem Krein_Milman_Minkowski:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "convex S"
     shows "S = convex hull {x. x extreme_point_of S}"
 proof
   show "S \<subseteq> convex hull {x. x extreme_point_of S}"
   proof
     fix a assume [simp]: "a \<in> S"
     have 1: "compact ((+) (- a) ` S)"
       by (simp add: \<open>compact S\<close> compact_translation_subtract cong: image_cong_simp)
     have 2: "convex ((+) (- a) ` S)"
       by (simp add: \<open>convex S\<close> compact_translation_subtract)
     show a_invex: "a \<in> convex hull {x. x extreme_point_of S}"
       using Krein_Milman_Minkowski_aux [OF refl 1 2]
             convex_hull_translation [of "-a"]
       by (auto simp: extreme_points_of_translation_subtract translation_assoc cong: image_cong_simp)
     qed
 next
   show "convex hull {x. x extreme_point_of S} \<subseteq> S"
   proof -
     have "{a. a extreme_point_of S} \<subseteq> S"
       using extreme_point_of_def by blast
     then show ?thesis
       by (simp add: \<open>convex S\<close> hull_minimal)
   qed
 qed
 
 
 subsection\<open>Applying it to convex hulls of explicitly indicated finite sets\<close>
 
 corollary Krein_Milman_polytope:
   fixes S :: "'a::euclidean_space set"
   shows
    "finite S
        \<Longrightarrow> convex hull S =
            convex hull {x. x extreme_point_of (convex hull S)}"
   by (simp add: Krein_Milman_Minkowski finite_imp_compact_convex_hull)
 
 lemma extreme_points_of_convex_hull_eq:
   fixes S :: "'a::euclidean_space set"
   shows
    "\<lbrakk>compact S; \<And>T. T \<subset> S \<Longrightarrow> convex hull T \<noteq> convex hull S\<rbrakk>
         \<Longrightarrow> {x. x extreme_point_of (convex hull S)} = S"
 by (metis (full_types) Krein_Milman_Minkowski compact_convex_hull convex_convex_hull extreme_points_of_convex_hull psubsetI)
 
 
 lemma extreme_point_of_convex_hull_eq:
   fixes S :: "'a::euclidean_space set"
   shows
    "\<lbrakk>compact S; \<And>T. T \<subset> S \<Longrightarrow> convex hull T \<noteq> convex hull S\<rbrakk>
     \<Longrightarrow> (x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
 using extreme_points_of_convex_hull_eq by auto
 
 lemma extreme_point_of_convex_hull_convex_independent:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and S: "\<And>a. a \<in> S \<Longrightarrow> a \<notin> convex hull (S - {a})"
   shows "(x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
 proof -
   have "convex hull T \<noteq> convex hull S" if "T \<subset> S" for T
   proof -
     obtain a where  "T \<subseteq> S" "a \<in> S" "a \<notin> T" using \<open>T \<subset> S\<close> by blast
     then show ?thesis
       by (metis (full_types) Diff_eq_empty_iff Diff_insert0 S hull_mono hull_subset insert_Diff_single subsetCE)
   qed
   then show ?thesis
     by (rule extreme_point_of_convex_hull_eq [OF \<open>compact S\<close>])
 qed
 
 lemma extreme_point_of_convex_hull_affine_independent:
   fixes S :: "'a::euclidean_space set"
   shows
    "\<not> affine_dependent S
          \<Longrightarrow> (x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
 by (metis aff_independent_finite affine_dependent_def affine_hull_convex_hull extreme_point_of_convex_hull_convex_independent finite_imp_compact hull_inc)
 
 text\<open>Elementary proofs exist, not requiring Euclidean spaces and all this development\<close>
 lemma extreme_point_of_convex_hull_2:
   fixes x :: "'a::euclidean_space"
   shows "x extreme_point_of (convex hull {a,b}) \<longleftrightarrow> x = a \<or> x = b"
 proof -
   have "x extreme_point_of (convex hull {a,b}) \<longleftrightarrow> x \<in> {a,b}"
     by (intro extreme_point_of_convex_hull_affine_independent affine_independent_2)
   then show ?thesis
     by simp
 qed
 
 lemma extreme_point_of_segment:
   fixes x :: "'a::euclidean_space"
   shows
    "x extreme_point_of closed_segment a b \<longleftrightarrow> x = a \<or> x = b"
 by (simp add: extreme_point_of_convex_hull_2 segment_convex_hull)
 
 lemma face_of_convex_hull_subset:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and T: "T face_of (convex hull S)"
   obtains s' where "s' \<subseteq> S" "T = convex hull s'"
 apply (rule_tac s' = "{x. x extreme_point_of T}" in that)
 using T extreme_point_of_convex_hull extreme_point_of_face apply blast
 by (metis (no_types) Krein_Milman_Minkowski assms compact_convex_hull convex_convex_hull face_of_imp_compact face_of_imp_convex)
 
 
 lemma face_of_convex_hull_aux:
   assumes eq: "x *\<^sub>R p = u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c"
     and x: "u + v + w = x" "x \<noteq> 0" and S: "affine S" "a \<in> S" "b \<in> S" "c \<in> S"
   shows "p \<in> S"
 proof -
   have "p = (u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c) /\<^sub>R x"
     by (metis \<open>x \<noteq> 0\<close> eq mult.commute right_inverse scaleR_one scaleR_scaleR)
   moreover have "affine hull {a,b,c} \<subseteq> S"
     by (simp add: S hull_minimal)
   moreover have "(u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c) /\<^sub>R x \<in> affine hull {a,b,c}"
     apply (simp add: affine_hull_3)
     apply (rule_tac x="u/x" in exI)
     apply (rule_tac x="v/x" in exI)
     apply (rule_tac x="w/x" in exI)
     using x apply (auto simp: field_split_simps)
     done
   ultimately show ?thesis by force
 qed
 
 proposition face_of_convex_hull_insert_eq:
   fixes a :: "'a :: euclidean_space"
   assumes "finite S" and a: "a \<notin> affine hull S"
   shows "(F face_of (convex hull (insert a S)) \<longleftrightarrow>
           F face_of (convex hull S) \<or>
           (\<exists>F'. F' face_of (convex hull S) \<and> F = convex hull (insert a F')))"
          (is "F face_of ?CAS \<longleftrightarrow> _")
 proof safe
   assume F: "F face_of ?CAS"
     and *: "\<nexists>F'. F' face_of convex hull S \<and> F = convex hull insert a F'"
   obtain T where T: "T \<subseteq> insert a S" and FeqT: "F = convex hull T"
     by (metis F \<open>finite S\<close> compact_insert finite_imp_compact face_of_convex_hull_subset)
   show "F face_of convex hull S"
   proof (cases "a \<in> T")
     case True
     have "F = convex hull insert a (convex hull T \<inter> convex hull S)"
     proof
       have "T \<subseteq> insert a (convex hull T \<inter> convex hull S)"
         using T hull_subset by fastforce
       then show "F \<subseteq> convex hull insert a (convex hull T \<inter> convex hull S)"
         by (simp add: FeqT hull_mono)
       show "convex hull insert a (convex hull T \<inter> convex hull S) \<subseteq> F"
         apply (rule hull_minimal)
         using True by (auto simp: \<open>F = convex hull T\<close> hull_inc)
     qed
     moreover have "convex hull T \<inter> convex hull S face_of convex hull S"
       by (metis F FeqT convex_convex_hull face_of_slice hull_mono inf.absorb_iff2 subset_insertI)
     ultimately show ?thesis
       using * by force
   next
     case False
     then show ?thesis
       by (metis FeqT F T face_of_subset hull_mono subset_insert subset_insertI)
   qed
 next
   assume "F face_of convex hull S"
   show "F face_of ?CAS"
     by (simp add: \<open>F face_of convex hull S\<close> a face_of_convex_hull_insert \<open>finite S\<close>)
 next
   fix F
   assume F: "F face_of convex hull S"
   show "convex hull insert a F face_of ?CAS"
   proof (cases "S = {}")
     case True
     then show ?thesis
       using F face_of_affine_eq by auto
   next
     case False
     have anotc: "a \<notin> convex hull S"
       by (metis (no_types) a affine_hull_convex_hull hull_inc)
     show ?thesis
     proof (cases "F = {}")
       case True show ?thesis
         using anotc by (simp add: \<open>F = {}\<close> \<open>finite S\<close> extreme_point_of_convex_hull_insert face_of_singleton)
     next
       case False
       have "convex hull insert a F \<subseteq> ?CAS"
         by (simp add: F a \<open>finite S\<close> convex_hull_subset face_of_convex_hull_insert face_of_imp_subset hull_inc)
       moreover
       have "(\<exists>y v. (1 - ub) *\<^sub>R a + ub *\<^sub>R b = (1 - v) *\<^sub>R a + v *\<^sub>R y \<and>
                    0 \<le> v \<and> v \<le> 1 \<and> y \<in> F) \<and>
             (\<exists>x u. (1 - uc) *\<^sub>R a + uc *\<^sub>R c = (1 - u) *\<^sub>R a + u *\<^sub>R x \<and>
                    0 \<le> u \<and> u \<le> 1 \<and> x \<in> F)"
         if *: "(1 - ux) *\<^sub>R a + ux *\<^sub>R x
                \<in> open_segment ((1 - ub) *\<^sub>R a + ub *\<^sub>R b) ((1 - uc) *\<^sub>R a + uc *\<^sub>R c)"
           and "0 \<le> ub" "ub \<le> 1" "0 \<le> uc" "uc \<le> 1" "0 \<le> ux" "ux \<le> 1"
           and b: "b \<in> convex hull S" and c: "c \<in> convex hull S" and "x \<in> F"
         for b c ub uc ux x
       proof -
         obtain v where ne: "(1 - ub) *\<^sub>R a + ub *\<^sub>R b \<noteq> (1 - uc) *\<^sub>R a + uc *\<^sub>R c"
           and eq: "(1 - ux) *\<^sub>R a + ux *\<^sub>R x =
                     (1 - v) *\<^sub>R ((1 - ub) *\<^sub>R a + ub *\<^sub>R b) + v *\<^sub>R ((1 - uc) *\<^sub>R a + uc *\<^sub>R c)"
           and "0 < v" "v < 1"
           using * by (auto simp: in_segment)
         then have 0: "((1 - ux) - ((1 - v) * (1 - ub) + v * (1 - uc))) *\<^sub>R a +
                       (ux *\<^sub>R x - (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c)) = 0"
           by (auto simp: algebra_simps)
         then have "((1 - ux) - ((1 - v) * (1 - ub) + v * (1 - uc))) *\<^sub>R a =
                    ((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c + (-ux) *\<^sub>R x"
           by (auto simp: algebra_simps)
         then have "a \<in> affine hull S" if "1 - ux - ((1 - v) * (1 - ub) + v * (1 - uc)) \<noteq> 0"
           apply (rule face_of_convex_hull_aux)
           using b c that apply (auto simp: algebra_simps)
           using F convex_hull_subset_affine_hull face_of_imp_subset \<open>x \<in> F\<close> apply blast+
           done
         then have "1 - ux - ((1 - v) * (1 - ub) + v * (1 - uc)) = 0"
           using a by blast
         with 0 have equx: "(1 - v) * ub + v * uc = ux"
           and uxx: "ux *\<^sub>R x = (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c)"
           by auto (auto simp: algebra_simps)
         show ?thesis
         proof (cases "uc = 0")
           case True
           then show ?thesis
             using equx 0 \<open>0 \<le> ub\<close> \<open>ub \<le> 1\<close> \<open>v < 1\<close> \<open>x \<in> F\<close>
             apply (auto simp: algebra_simps)
              apply (rule_tac x=x in exI, simp)
              apply (rule_tac x=ub in exI, auto)
              apply (metis add.left_neutral diff_eq_eq less_irrefl mult.commute mult_cancel_right1 real_vector.scale_cancel_left real_vector.scale_left_diff_distrib)
             using \<open>x \<in> F\<close> \<open>uc \<le> 1\<close> apply blast
             done
         next
           case False
           show ?thesis
           proof (cases "ub = 0")
             case True
             then show ?thesis
               using equx 0 \<open>0 \<le> uc\<close> \<open>uc \<le> 1\<close> \<open>0 < v\<close> \<open>x \<in> F\<close> \<open>uc \<noteq> 0\<close> by (force simp: algebra_simps)
           next
             case False
             then have "0 < ub" "0 < uc"
               using \<open>uc \<noteq> 0\<close> \<open>0 \<le> ub\<close> \<open>0 \<le> uc\<close> by auto
             then have "ux \<noteq> 0"
               by (metis \<open>0 < v\<close> \<open>v < 1\<close> diff_ge_0_iff_ge dual_order.strict_implies_order equx leD le_add_same_cancel2 zero_le_mult_iff zero_less_mult_iff)
             have "b \<in> F \<and> c \<in> F"
             proof (cases "b = c")
               case True
               then show ?thesis
                 by (metis \<open>ux \<noteq> 0\<close> equx real_vector.scale_cancel_left scaleR_add_left uxx \<open>x \<in> F\<close>)
             next
               case False
               have "x = (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c) /\<^sub>R ux"
                 by (metis \<open>ux \<noteq> 0\<close> uxx mult.commute right_inverse scaleR_one scaleR_scaleR)
               also have "... = (1 - v * uc / ux) *\<^sub>R b + (v * uc / ux) *\<^sub>R c"
                 using \<open>ux \<noteq> 0\<close> equx apply (auto simp: field_split_simps)
                 by (metis add.commute add_diff_eq add_divide_distrib diff_add_cancel scaleR_add_left)
               finally have "x = (1 - v * uc / ux) *\<^sub>R b + (v * uc / ux) *\<^sub>R c" .
               then have "x \<in> open_segment b c"
                 apply (simp add: in_segment \<open>b \<noteq> c\<close>)
                 apply (rule_tac x="(v * uc) / ux" in exI)
                 using \<open>0 \<le> ux\<close> \<open>ux \<noteq> 0\<close> \<open>0 < uc\<close> \<open>0 < v\<close> \<open>0 < ub\<close> \<open>v < 1\<close> equx
                 apply (force simp: field_split_simps)
                 done
               then show ?thesis
                 by (rule face_ofD [OF F _ b c \<open>x \<in> F\<close>])
             qed
             with \<open>0 \<le> ub\<close> \<open>ub \<le> 1\<close> \<open>0 \<le> uc\<close> \<open>uc \<le> 1\<close> show ?thesis by blast
           qed
         qed
       qed
       moreover have "convex hull F = F"
         by (meson F convex_hull_eq face_of_imp_convex)
       ultimately show ?thesis
         unfolding face_of_def by (fastforce simp: convex_hull_insert_alt \<open>S \<noteq> {}\<close> \<open>F \<noteq> {}\<close>)
     qed
   qed
 qed
 
 lemma face_of_convex_hull_insert2:
   fixes a :: "'a :: euclidean_space"
   assumes S: "finite S" and a: "a \<notin> affine hull S" and F: "F face_of convex hull S"
   shows "convex hull (insert a F) face_of convex hull (insert a S)"
   by (metis F face_of_convex_hull_insert_eq [OF S a])
 
 proposition face_of_convex_hull_affine_independent:
   fixes S :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent S"
     shows "(T face_of (convex hull S) \<longleftrightarrow> (\<exists>c. c \<subseteq> S \<and> T = convex hull c))"
           (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (meson \<open>T face_of convex hull S\<close> aff_independent_finite assms face_of_convex_hull_subset finite_imp_compact)
 next
   assume ?rhs
   then obtain c where "c \<subseteq> S" and T: "T = convex hull c"
     by blast
   have "affine hull c \<inter> affine hull (S - c) = {}"
     apply (rule disjoint_affine_hull [OF assms \<open>c \<subseteq> S\<close>], auto)
     done
   then have "affine hull c \<inter> convex hull (S - c) = {}"
     using convex_hull_subset_affine_hull by fastforce
   then show ?lhs
     by (metis face_of_convex_hulls \<open>c \<subseteq> S\<close> aff_independent_finite assms T)
 qed
 
 lemma facet_of_convex_hull_affine_independent:
   fixes S :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent S"
     shows "T facet_of (convex hull S) \<longleftrightarrow>
            T \<noteq> {} \<and> (\<exists>u. u \<in> S \<and> T = convex hull (S - {u}))"
           (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "T face_of (convex hull S)" "T \<noteq> {}"
         and afft: "aff_dim T = aff_dim (convex hull S) - 1"
     by (auto simp: facet_of_def)
   then obtain c where "c \<subseteq> S" and c: "T = convex hull c"
     by (auto simp: face_of_convex_hull_affine_independent [OF assms])
   then have affs: "aff_dim S = aff_dim c + 1"
     by (metis aff_dim_convex_hull afft eq_diff_eq)
   have "\<not> affine_dependent c"
     using \<open>c \<subseteq> S\<close> affine_dependent_subset assms by blast
   with affs have "card (S - c) = 1"
     apply (simp add: aff_dim_affine_independent [symmetric] aff_dim_convex_hull)
     by (metis aff_dim_affine_independent aff_independent_finite One_nat_def \<open>c \<subseteq> S\<close> add.commute
                 add_diff_cancel_right' assms card_Diff_subset card_mono of_nat_1 of_nat_diff of_nat_eq_iff)
   then obtain u where u: "u \<in> S - c"
     by (metis DiffI \<open>c \<subseteq> S\<close> aff_independent_finite assms cancel_comm_monoid_add_class.diff_cancel
                 card_Diff_subset subsetI subset_antisym zero_neq_one)
   then have u: "S = insert u c"
     by (metis Diff_subset \<open>c \<subseteq> S\<close> \<open>card (S - c) = 1\<close> card_1_singletonE double_diff insert_Diff insert_subset singletonD)
   have "T = convex hull (c - {u})"
     by (metis Diff_empty Diff_insert0 \<open>T facet_of convex hull S\<close> c facet_of_irrefl insert_absorb u)
   with \<open>T \<noteq> {}\<close> show ?rhs
     using c u by auto
 next
   assume ?rhs
   then obtain u where "T \<noteq> {}" "u \<in> S" and u: "T = convex hull (S - {u})"
     by (force simp: facet_of_def)
   then have "\<not> S \<subseteq> {u}"
     using \<open>T \<noteq> {}\<close> u by auto
   have [simp]: "aff_dim (convex hull (S - {u})) = aff_dim (convex hull S) - 1"
     using assms \<open>u \<in> S\<close>
     apply (simp add: aff_dim_convex_hull affine_dependent_def)
     apply (drule bspec, assumption)
     by (metis add_diff_cancel_right' aff_dim_insert insert_Diff [of u S])
   show ?lhs
     apply (subst u)
     apply (simp add: \<open>\<not> S \<subseteq> {u}\<close> facet_of_def face_of_convex_hull_affine_independent [OF assms], blast)
     done
 qed
 
 lemma facet_of_convex_hull_affine_independent_alt:
   fixes S :: "'a::euclidean_space set"
   shows
    "\<not>affine_dependent S
         \<Longrightarrow> (T facet_of (convex hull S) \<longleftrightarrow>
              2 \<le> card S \<and> (\<exists>u. u \<in> S \<and> T = convex hull (S - {u})))"
 apply (simp add: facet_of_convex_hull_affine_independent)
 apply (auto simp: Set.subset_singleton_iff)
 apply (metis Diff_cancel Int_empty_right Int_insert_right_if1  aff_independent_finite card_eq_0_iff card_insert_if card_mono card_subset_eq convex_hull_eq_empty eq_iff equals0D finite_insert finite_subset inf.absorb_iff2 insert_absorb insert_not_empty  not_less_eq_eq numeral_2_eq_2)
 done
 
 lemma segment_face_of:
   assumes "(closed_segment a b) face_of S"
   shows "a extreme_point_of S" "b extreme_point_of S"
 proof -
   have as: "{a} face_of S"
     by (metis (no_types) assms convex_hull_singleton empty_iff extreme_point_of_convex_hull_insert face_of_face face_of_singleton finite.emptyI finite.insertI insert_absorb insert_iff segment_convex_hull)
   moreover have "{b} face_of S"
   proof -
     have "b \<in> convex hull {a} \<or> b extreme_point_of convex hull {b, a}"
       by (meson extreme_point_of_convex_hull_insert finite.emptyI finite.insertI)
     moreover have "closed_segment a b = convex hull {b, a}"
       using closed_segment_commute segment_convex_hull by blast
     ultimately show ?thesis
       by (metis as assms face_of_face convex_hull_singleton empty_iff face_of_singleton insertE)
     qed
   ultimately show "a extreme_point_of S" "b extreme_point_of S"
     using face_of_singleton by blast+
 qed
 
 
 proposition Krein_Milman_frontier:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "compact S"
     shows "S = convex hull (frontier S)"
           (is "?lhs = ?rhs")
 proof
   have "?lhs \<subseteq> convex hull {x. x extreme_point_of S}"
     using Krein_Milman_Minkowski assms by blast
   also have "... \<subseteq> ?rhs"
     apply (rule hull_mono)
     apply (auto simp: frontier_def extreme_point_not_in_interior)
     using closure_subset apply (force simp: extreme_point_of_def)
     done
   finally show "?lhs \<subseteq> ?rhs" .
 next
   have "?rhs \<subseteq> convex hull S"
     by (metis Diff_subset \<open>compact S\<close> closure_closed compact_eq_bounded_closed frontier_def hull_mono)
   also have "... \<subseteq> ?lhs"
     by (simp add: \<open>convex S\<close> hull_same)
   finally show "?rhs \<subseteq> ?lhs" .
 qed
 
 subsection\<open>Polytopes\<close>
 
 definition\<^marker>\<open>tag important\<close> polytope where
  "polytope S \<equiv> \<exists>v. finite v \<and> S = convex hull v"
 
 lemma polytope_translation_eq: "polytope (image (\<lambda>x. a + x) S) \<longleftrightarrow> polytope S"
 apply (simp add: polytope_def, safe)
 apply (metis convex_hull_translation finite_imageI translation_galois)
 by (metis convex_hull_translation finite_imageI)
 
 lemma polytope_linear_image: "\<lbrakk>linear f; polytope p\<rbrakk> \<Longrightarrow> polytope(image f p)"
   unfolding polytope_def using convex_hull_linear_image by blast
 
 lemma polytope_empty: "polytope {}"
   using convex_hull_empty polytope_def by blast
 
 lemma polytope_convex_hull: "finite S \<Longrightarrow> polytope(convex hull S)"
   using polytope_def by auto
 
 lemma polytope_Times: "\<lbrakk>polytope S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<times> T)"
   unfolding polytope_def
   by (metis finite_cartesian_product convex_hull_Times)
 
 lemma face_of_polytope_polytope:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>polytope S; F face_of S\<rbrakk> \<Longrightarrow> polytope F"
 unfolding polytope_def
 by (meson face_of_convex_hull_subset finite_imp_compact finite_subset)
 
 lemma finite_polytope_faces:
   fixes S :: "'a::euclidean_space set"
   assumes "polytope S"
   shows "finite {F. F face_of S}"
 proof -
   obtain v where "finite v" "S = convex hull v"
     using assms polytope_def by auto
   have "finite ((hull) convex ` {T. T \<subseteq> v})"
     by (simp add: \<open>finite v\<close>)
   moreover have "{F. F face_of S} \<subseteq> ((hull) convex ` {T. T \<subseteq> v})"
     by (metis (no_types, lifting) \<open>finite v\<close> \<open>S = convex hull v\<close> face_of_convex_hull_subset finite_imp_compact image_eqI mem_Collect_eq subsetI)
   ultimately show ?thesis
     by (blast intro: finite_subset)
 qed
 
 lemma finite_polytope_facets:
   assumes "polytope S"
   shows "finite {T. T facet_of S}"
 by (simp add: assms facet_of_def finite_polytope_faces)
 
 lemma polytope_scaling:
   assumes "polytope S"  shows "polytope (image (\<lambda>x. c *\<^sub>R x) S)"
 by (simp add: assms polytope_linear_image)
 
 lemma polytope_imp_compact:
   fixes S :: "'a::real_normed_vector set"
   shows "polytope S \<Longrightarrow> compact S"
 by (metis finite_imp_compact_convex_hull polytope_def)
 
 lemma polytope_imp_convex: "polytope S \<Longrightarrow> convex S"
   by (metis convex_convex_hull polytope_def)
 
 lemma polytope_imp_closed:
   fixes S :: "'a::real_normed_vector set"
   shows "polytope S \<Longrightarrow> closed S"
 by (simp add: compact_imp_closed polytope_imp_compact)
 
 lemma polytope_imp_bounded:
   fixes S :: "'a::real_normed_vector set"
   shows "polytope S \<Longrightarrow> bounded S"
 by (simp add: compact_imp_bounded polytope_imp_compact)
 
 lemma polytope_interval: "polytope(cbox a b)"
   unfolding polytope_def by (meson closed_interval_as_convex_hull)
 
 lemma polytope_sing: "polytope {a}"
   using polytope_def by force
 
 lemma face_of_polytope_insert:
      "\<lbrakk>polytope S; a \<notin> affine hull S; F face_of S\<rbrakk> \<Longrightarrow> F face_of convex hull (insert a S)"
   by (metis (no_types, lifting) affine_hull_convex_hull face_of_convex_hull_insert hull_insert polytope_def)
 
 proposition face_of_polytope_insert2:
   fixes a :: "'a :: euclidean_space"
   assumes "polytope S" "a \<notin> affine hull S" "F face_of S"
   shows "convex hull (insert a F) face_of convex hull (insert a S)"
 proof -
   obtain V where "finite V" "S = convex hull V"
     using assms by (auto simp: polytope_def)
   then have "convex hull (insert a F) face_of convex hull (insert a V)"
     using affine_hull_convex_hull assms face_of_convex_hull_insert2 by blast
   then show ?thesis
     by (metis \<open>S = convex hull V\<close> hull_insert)
 qed
 
 
 subsection\<open>Polyhedra\<close>
 
 definition\<^marker>\<open>tag important\<close> polyhedron where
  "polyhedron S \<equiv>
         \<exists>F. finite F \<and>
             S = \<Inter> F \<and>
             (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b})"
 
 lemma polyhedron_Int [intro,simp]:
    "\<lbrakk>polyhedron S; polyhedron T\<rbrakk> \<Longrightarrow> polyhedron (S \<inter> T)"
   apply (simp add: polyhedron_def, clarify)
   apply (rename_tac F G)
   apply (rule_tac x="F \<union> G" in exI, auto)
   done
 
 lemma polyhedron_UNIV [iff]: "polyhedron UNIV"
   unfolding polyhedron_def
   by (rule_tac x="{}" in exI) auto
 
 lemma polyhedron_Inter [intro,simp]:
    "\<lbrakk>finite F; \<And>S. S \<in> F \<Longrightarrow> polyhedron S\<rbrakk> \<Longrightarrow> polyhedron(\<Inter>F)"
 by (induction F rule: finite_induct) auto
 
 
 lemma polyhedron_empty [iff]: "polyhedron ({} :: 'a :: euclidean_space set)"
 proof -
   have "\<exists>a. a \<noteq> 0 \<and>
              (\<exists>b. {x. (SOME i. i \<in> Basis) \<bullet> x \<le> - 1} = {x. a \<bullet> x \<le> b})"
     by (rule_tac x="(SOME i. i \<in> Basis)" in exI) (force simp: SOME_Basis nonzero_Basis)
   moreover have "\<exists>a b. a \<noteq> 0 \<and>
                        {x. - (SOME i. i \<in> Basis) \<bullet> x \<le> - 1} = {x. a \<bullet> x \<le> b}"
       apply (rule_tac x="-(SOME i. i \<in> Basis)" in exI)
       apply (rule_tac x="-1" in exI)
       apply (simp add: SOME_Basis nonzero_Basis)
       done
   ultimately show ?thesis
     unfolding polyhedron_def
     apply (rule_tac x="{{x. (SOME i. i \<in> Basis) \<bullet> x \<le> -1},
                         {x. -(SOME i. i \<in> Basis) \<bullet> x \<le> -1}}" in exI)
     apply force
     done
 qed
 
 lemma polyhedron_halfspace_le:
   fixes a :: "'a :: euclidean_space"
   shows "polyhedron {x. a \<bullet> x \<le> b}"
 proof (cases "a = 0")
   case True then show ?thesis by auto
 next
   case False
   then show ?thesis
     unfolding polyhedron_def
     by (rule_tac x="{{x. a \<bullet> x \<le> b}}" in exI) auto
 qed
 
 lemma polyhedron_halfspace_ge:
   fixes a :: "'a :: euclidean_space"
   shows "polyhedron {x. a \<bullet> x \<ge> b}"
 using polyhedron_halfspace_le [of "-a" "-b"] by simp
 
 lemma polyhedron_hyperplane:
   fixes a :: "'a :: euclidean_space"
   shows "polyhedron {x. a \<bullet> x = b}"
 proof -
   have "{x. a \<bullet> x = b} = {x. a \<bullet> x \<le> b} \<inter> {x. a \<bullet> x \<ge> b}"
     by force
   then show ?thesis
     by (simp add: polyhedron_halfspace_ge polyhedron_halfspace_le)
 qed
 
 lemma affine_imp_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   shows "affine S \<Longrightarrow> polyhedron S"
 by (metis affine_hull_eq polyhedron_Inter polyhedron_hyperplane affine_hull_finite_intersection_hyperplanes [of S])
 
 lemma polyhedron_imp_closed:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<Longrightarrow> closed S"
 apply (simp add: polyhedron_def)
 using closed_halfspace_le by fastforce
 
 lemma polyhedron_imp_convex:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<Longrightarrow> convex S"
 apply (simp add: polyhedron_def)
 using convex_Inter convex_halfspace_le by fastforce
 
 lemma polyhedron_affine_hull:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron(affine hull S)"
 by (simp add: affine_imp_polyhedron)
 
 
 subsection\<open>Canonical polyhedron representation making facial structure explicit\<close>
 
 proposition polyhedron_Int_affine:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow>
            (\<exists>F. finite F \<and> S = (affine hull S) \<inter> \<Inter>F \<and>
                 (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     apply (simp add: polyhedron_def)
     apply (erule ex_forward)
     using hull_subset apply force
     done
 next
   assume ?rhs then show ?lhs
     apply clarify
     apply (erule ssubst)
     apply (force intro: polyhedron_affine_hull polyhedron_halfspace_le)
     done
 qed
 
 proposition rel_interior_polyhedron_explicit:
   assumes "finite F"
       and seq: "S = affine hull S \<inter> \<Inter>F"
       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
     shows "rel_interior S = {x \<in> S. \<forall>h \<in> F. a h \<bullet> x < b h}"
 proof -
   have rels: "\<And>x. x \<in> rel_interior S \<Longrightarrow> x \<in> S"
     by (meson IntE mem_rel_interior)
   moreover have "a i \<bullet> x < b i" if x: "x \<in> rel_interior S" and "i \<in> F" for x i
   proof -
     have fif: "F - {i} \<subset> F"
       using \<open>i \<in> F\<close> Diff_insert_absorb Diff_subset set_insert psubsetI by blast
     then have "S \<subset> affine hull S \<inter> \<Inter>(F - {i})"
       by (rule psub)
     then obtain z where ssub: "S \<subseteq> \<Inter>(F - {i})" and zint: "z \<in> \<Inter>(F - {i})"
                     and "z \<notin> S" and zaff: "z \<in> affine hull S"
       by auto
     have "z \<noteq> x"
       using \<open>z \<notin> S\<close> rels x by blast
     have "z \<notin> affine hull S \<inter> \<Inter>F"
       using \<open>z \<notin> S\<close> seq by auto
     then have aiz: "a i \<bullet> z > b i"
       using faceq zint zaff by fastforce
     obtain e where "e > 0" "x \<in> S" and e: "ball x e \<inter> affine hull S \<subseteq> S"
       using x by (auto simp: mem_rel_interior_ball)
     then have ins: "\<And>y. \<lbrakk>norm (x - y) < e; y \<in> affine hull S\<rbrakk> \<Longrightarrow> y \<in> S"
       by (metis IntI subsetD dist_norm mem_ball)
     define \<xi> where "\<xi> = min (1/2) (e / 2 / norm(z - x))"
     have "norm (\<xi> *\<^sub>R x - \<xi> *\<^sub>R z) = norm (\<xi> *\<^sub>R (x - z))"
       by (simp add: \<xi>_def algebra_simps norm_mult)
     also have "... = \<xi> * norm (x - z)"
       using \<open>e > 0\<close> by (simp add: \<xi>_def)
     also have "... < e"
       using \<open>z \<noteq> x\<close> \<open>e > 0\<close> by (simp add: \<xi>_def min_def field_split_simps norm_minus_commute)
     finally have lte: "norm (\<xi> *\<^sub>R x - \<xi> *\<^sub>R z) < e" .
     have \<xi>_aff: "\<xi> *\<^sub>R z + (1 - \<xi>) *\<^sub>R x \<in> affine hull S"
       by (metis \<open>x \<in> S\<close> add.commute affine_affine_hull diff_add_cancel hull_inc mem_affine zaff)
     have "\<xi> *\<^sub>R z + (1 - \<xi>) *\<^sub>R x \<in> S"
       apply (rule ins [OF _ \<xi>_aff])
       apply (simp add: algebra_simps lte)
       done
     then obtain l where l: "0 < l" "l < 1" and ls: "(l *\<^sub>R z + (1 - l) *\<^sub>R x) \<in> S"
       apply (rule_tac l = \<xi> in that)
       using \<open>e > 0\<close> \<open>z \<noteq> x\<close>  apply (auto simp: \<xi>_def)
       done
     then have i: "l *\<^sub>R z + (1 - l) *\<^sub>R x \<in> i"
       using seq \<open>i \<in> F\<close> by auto
     have "b i * l + (a i \<bullet> x) * (1 - l) < a i \<bullet> (l *\<^sub>R z + (1 - l) *\<^sub>R x)"
       using l by (simp add: algebra_simps aiz)
     also have "\<dots> \<le> b i" using i l
       using faceq mem_Collect_eq \<open>i \<in> F\<close> by blast
     finally have "(a i \<bullet> x) * (1 - l) < b i * (1 - l)"
       by (simp add: algebra_simps)
     with l show ?thesis
       by simp
   qed
   moreover have "x \<in> rel_interior S"
            if "x \<in> S" and less: "\<And>h. h \<in> F \<Longrightarrow> a h \<bullet> x < b h" for x
   proof -
     have 1: "\<And>h. h \<in> F \<Longrightarrow> x \<in> interior h"
       by (metis interior_halfspace_le mem_Collect_eq less faceq)
     have 2: "\<And>y. \<lbrakk>\<forall>h\<in>F. y \<in> interior h; y \<in> affine hull S\<rbrakk> \<Longrightarrow> y \<in> S"
       by (metis IntI Inter_iff contra_subsetD interior_subset seq)
     show ?thesis
       apply (simp add: rel_interior \<open>x \<in> S\<close>)
       apply (rule_tac x="\<Inter>h\<in>F. interior h" in exI)
       apply (auto simp: \<open>finite F\<close> open_INT 1 2)
       done
   qed
   ultimately show ?thesis by blast
 qed
 
 
 lemma polyhedron_Int_affine_parallel:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow>
          (\<exists>F. finite F \<and>
               S = (affine hull S) \<inter> (\<Inter>F) \<and>
               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)))"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain F where "finite F" and seq: "S = (affine hull S) \<inter> \<Inter>F"
                   and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
     by (fastforce simp add: polyhedron_Int_affine)
   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
     by metis
   show ?rhs
   proof -
     have "\<exists>a' b'. a' \<noteq> 0 \<and>
                   affine hull S \<inter> {x. a' \<bullet> x \<le> b'} = affine hull S \<inter> h \<and>
                   (\<forall>w \<in> affine hull S. (w + a') \<in> affine hull S)"
         if "h \<in> F" "\<not>(affine hull S \<subseteq> h)" for h
     proof -
       have "a h \<noteq> 0" and "h = {x. a h \<bullet> x \<le> b h}" "h \<inter> \<Inter>F = \<Inter>F"
         using \<open>h \<in> F\<close> ab by auto
       then have "(affine hull S) \<inter> {x. a h \<bullet> x \<le> b h} \<noteq> {}"
         by (metis (no_types) affine_hull_eq_empty inf.absorb_iff2 inf_assoc inf_bot_right inf_commute seq that(2))
       moreover have "\<not> (affine hull S \<subseteq> {x. a h \<bullet> x \<le> b h})"
         using \<open>h = {x. a h \<bullet> x \<le> b h}\<close> that(2) by blast
       ultimately show ?thesis
         using affine_parallel_slice [of "affine hull S"]
         by (metis \<open>h = {x. a h \<bullet> x \<le> b h}\<close> affine_affine_hull)
     qed
     then obtain a b
          where ab: "\<And>h. \<lbrakk>h \<in> F; \<not> (affine hull S \<subseteq> h)\<rbrakk>
              \<Longrightarrow> a h \<noteq> 0 \<and>
                   affine hull S \<inter> {x. a h \<bullet> x \<le> b h} = affine hull S \<inter> h \<and>
                   (\<forall>w \<in> affine hull S. (w + a h) \<in> affine hull S)"
       by metis
     have seq2: "S = affine hull S \<inter> (\<Inter>h\<in>{h \<in> F. \<not> affine hull S \<subseteq> h}. {x. a h \<bullet> x \<le> b h})"
       by (subst seq) (auto simp: ab INT_extend_simps)
     show ?thesis
       apply (rule_tac x="(\<lambda>h. {x. a h \<bullet> x \<le> b h}) ` {h. h \<in> F \<and> \<not>(affine hull S \<subseteq> h)}" in exI)
       apply (intro conjI seq2)
         using \<open>finite F\<close> apply force
        using ab apply blast
        done
   qed
 next
   assume ?rhs then show ?lhs
     apply (simp add: polyhedron_Int_affine)
     by metis
 qed
 
 
 proposition polyhedron_Int_affine_parallel_minimal:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow>
          (\<exists>F. finite F \<and>
               S = (affine hull S) \<inter> (\<Inter>F) \<and>
               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)) \<and>
               (\<forall>F'. F' \<subset> F \<longrightarrow> S \<subset> (affine hull S) \<inter> (\<Inter>F')))"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain f0
            where f0: "finite f0"
                  "S = (affine hull S) \<inter> (\<Inter>f0)"
                    (is "?P f0")
                  "\<forall>h \<in> f0. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)"
                    (is "?Q f0")
     by (force simp: polyhedron_Int_affine_parallel)
   define n where "n = (LEAST n. \<exists>F. card F = n \<and> finite F \<and> ?P F \<and> ?Q F)"
   have nf: "\<exists>F. card F = n \<and> finite F \<and> ?P F \<and> ?Q F"
     apply (simp add: n_def)
     apply (rule LeastI [where k = "card f0"])
     using f0 apply auto
     done
   then obtain F where F: "card F = n" "finite F" and seq: "?P F" and aff: "?Q F"
     by blast
   then have "\<not> (finite g \<and> ?P g \<and> ?Q g)" if "card g < n" for g
     using that by (auto simp: n_def dest!: not_less_Least)
   then have *: "\<not> (?P g \<and> ?Q g)" if "g \<subset> F" for g
     using that \<open>finite F\<close> psubset_card_mono \<open>card F = n\<close>
     by (metis finite_Int inf.strict_order_iff)
   have 1: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subseteq> affine hull S \<inter> \<Inter>F'"
     by (subst seq) blast
   have 2: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<noteq> affine hull S \<inter> \<Inter>F'"
     apply (frule *)
     by (metis aff subsetCE subset_iff_psubset_eq)
   show ?rhs
     by (metis \<open>finite F\<close> seq aff psubsetI 1 2)
 next
   assume ?rhs then show ?lhs
     by (auto simp: polyhedron_Int_affine_parallel)
 qed
 
 
 lemma polyhedron_Int_affine_minimal:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow>
          (\<exists>F. finite F \<and> S = (affine hull S) \<inter> \<Inter>F \<and>
               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}) \<and>
               (\<forall>F'. F' \<subset> F \<longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'))"
 apply (rule iffI)
  apply (force simp: polyhedron_Int_affine_parallel_minimal elim!: ex_forward)
 apply (auto simp: polyhedron_Int_affine elim!: ex_forward)
 done
 
 proposition facet_of_polyhedron_explicit:
   assumes "finite F"
       and seq: "S = affine hull S \<inter> \<Inter>F"
       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
     shows "c facet_of S \<longleftrightarrow> (\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h})"
 proof (cases "S = {}")
   case True with psub show ?thesis by force
 next
   case False
   have "polyhedron S"
     apply (simp add: polyhedron_Int_affine)
     apply (rule_tac x=F in exI)
     using assms  apply force
     done
   then have "convex S"
     by (rule polyhedron_imp_convex)
   with False rel_interior_eq_empty have "rel_interior S \<noteq> {}" by blast
   then obtain x where "x \<in> rel_interior S" by auto
   then obtain T where "open T" "x \<in> T" "x \<in> S" "T \<inter> affine hull S \<subseteq> S"
     by (force simp: mem_rel_interior)
   then have xaff: "x \<in> affine hull S" and xint: "x \<in> \<Inter>F"
     using seq hull_inc by auto
   have "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
   with \<open>x \<in> rel_interior S\<close>
   have [simp]: "\<And>h. h\<in>F \<Longrightarrow> a h \<bullet> x < b h" by blast
   have *: "(S \<inter> {x. a h \<bullet> x = b h}) facet_of S" if "h \<in> F" for h
   proof -
     have "S \<subset> affine hull S \<inter> \<Inter>(F - {h})"
       using psub that by (metis Diff_disjoint Diff_subset insert_disjoint(2) psubsetI)
     then obtain z where zaff: "z \<in> affine hull S" and zint: "z \<in> \<Inter>(F - {h})" and "z \<notin> S"
       by force
     then have "z \<noteq> x" "z \<notin> h" using seq \<open>x \<in> S\<close> by auto
     have "x \<in> h" using that xint by auto
     then have able: "a h \<bullet> x \<le> b h"
       using faceq that by blast
     also have "... < a h \<bullet> z" using \<open>z \<notin> h\<close> faceq [OF that] xint by auto
     finally have xltz: "a h \<bullet> x < a h \<bullet> z" .
     define l where "l = (b h - a h \<bullet> x) / (a h \<bullet> z - a h \<bullet> x)"
     define w where "w = (1 - l) *\<^sub>R x + l *\<^sub>R z"
     have "0 < l" "l < 1"
       using able xltz \<open>b h < a h \<bullet> z\<close> \<open>h \<in> F\<close>
       by (auto simp: l_def field_split_simps)
     have awlt: "a i \<bullet> w < b i" if "i \<in> F" "i \<noteq> h" for i
     proof -
       have "(1 - l) * (a i \<bullet> x) < (1 - l) * b i"
         by (simp add: \<open>l < 1\<close> \<open>i \<in> F\<close>)
       moreover have "l * (a i \<bullet> z) \<le> l * b i"
         apply (rule mult_left_mono)
         apply (metis Diff_insert_absorb Inter_iff Set.set_insert \<open>h \<in> F\<close> faceq insertE mem_Collect_eq that zint)
         using \<open>0 < l\<close>
         apply simp
         done
       ultimately show ?thesis by (simp add: w_def algebra_simps)
     qed
     have weq: "a h \<bullet> w = b h"
       using xltz unfolding w_def l_def
       by (simp add: algebra_simps) (simp add: field_simps)
     have "w \<in> affine hull S"
       by (simp add: w_def mem_affine xaff zaff)
     moreover have "w \<in> \<Inter>F"
       using \<open>a h \<bullet> w = b h\<close> awlt faceq less_eq_real_def by blast
     ultimately have "w \<in> S"
       using seq by blast
     with weq have "S \<inter> {x. a h \<bullet> x = b h} \<noteq> {}" by blast
     moreover have "S \<inter> {x. a h \<bullet> x = b h} face_of S"
       apply (rule face_of_Int_supporting_hyperplane_le)
       apply (rule \<open>convex S\<close>)
       apply (subst (asm) seq)
       using faceq that apply fastforce
       done
     moreover have "affine hull (S \<inter> {x. a h \<bullet> x = b h}) =
                    (affine hull S) \<inter> {x. a h \<bullet> x = b h}"
     proof
       show "affine hull (S \<inter> {x. a h \<bullet> x = b h}) \<subseteq> affine hull S \<inter> {x. a h \<bullet> x = b h}"
         apply (intro Int_greatest hull_mono Int_lower1)
         apply (metis affine_hull_eq affine_hyperplane hull_mono inf_le2)
         done
     next
       show "affine hull S \<inter> {x. a h \<bullet> x = b h} \<subseteq> affine hull (S \<inter> {x. a h \<bullet> x = b h})"
       proof
         fix y
         assume yaff: "y \<in> affine hull S \<inter> {y. a h \<bullet> y = b h}"
         obtain T where "0 < T"
                  and T: "\<And>j. \<lbrakk>j \<in> F; j \<noteq> h\<rbrakk> \<Longrightarrow> T * (a j \<bullet> y - a j \<bullet> w) \<le> b j - a j \<bullet> w"
         proof (cases "F - {h} = {}")
           case True then show ?thesis
             by (rule_tac T=1 in that) auto
         next
           case False
           then obtain h' where h': "h' \<in> F - {h}" by auto
           let ?body = "(\<lambda>j. if 0 < a j \<bullet> y - a j \<bullet> w
               then (b j - a j \<bullet> w) / (a j \<bullet> y - a j \<bullet> w)
               else 1) ` (F - {h})"
           define inff where "inff = Inf ?body"
           from \<open>finite F\<close> have "finite ?body"
             by blast
           moreover from h' have "?body \<noteq> {}"
             by blast
           moreover have "j > 0" if "j \<in> ?body" for j
           proof -
             from that obtain x where "x \<in> F" and "x \<noteq> h" and *: "j =
               (if 0 < a x \<bullet> y - a x \<bullet> w
                 then (b x - a x \<bullet> w) / (a x \<bullet> y - a x \<bullet> w) else 1)"
               by blast
             with awlt [of x] have "a x \<bullet> w < b x"
               by simp
             with * show ?thesis
               by simp
           qed
           ultimately have "0 < inff"
             by (simp_all add: finite_less_Inf_iff inff_def)
           moreover have "inff * (a j \<bullet> y - a j \<bullet> w) \<le> b j - a j \<bullet> w"
                         if "j \<in> F" "j \<noteq> h" for j
           proof (cases "a j \<bullet> w < a j \<bullet> y")
             case True
             then have "inff \<le> (b j - a j \<bullet> w) / (a j \<bullet> y - a j \<bullet> w)"
               apply (simp add: inff_def)
               apply (rule cInf_le_finite)
               using \<open>finite F\<close> apply blast
               apply (simp add: that split: if_split_asm)
               done
             then show ?thesis
               using \<open>0 < inff\<close> awlt [OF that] mult_strict_left_mono
               by (fastforce simp add: field_split_simps split: if_split_asm)
           next
             case False
             with \<open>0 < inff\<close> have "inff * (a j \<bullet> y - a j \<bullet> w) \<le> 0"
               by (simp add: mult_le_0_iff)
             also have "... < b j - a j \<bullet> w"
               by (simp add: awlt that)
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             by (blast intro: that)
         qed
         define c where "c = (1 - T) *\<^sub>R w + T *\<^sub>R y"
         have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> j" if "j \<in> F" for j
         proof (cases "j = h")
           case True
           have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> {x. a h \<bullet> x \<le> b h}"
             using weq yaff by (auto simp: algebra_simps)
           with True faceq [OF that] show ?thesis by metis
         next
           case False
           with T that have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> {x. a j \<bullet> x \<le> b j}"
             by (simp add: algebra_simps)
           with faceq [OF that] show ?thesis by simp
         qed
         moreover have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> affine hull S"
           apply (rule affine_affine_hull [simplified affine_alt, rule_format])
           apply (simp add: \<open>w \<in> affine hull S\<close>)
           using yaff apply blast
           done
         ultimately have "c \<in> S"
           using seq by (force simp: c_def)
         moreover have "a h \<bullet> c = b h"
           using yaff by (force simp: c_def algebra_simps weq)
         ultimately have caff: "c \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
           by (simp add: hull_inc)
         have waff: "w \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
           using \<open>w \<in> S\<close> weq by (blast intro: hull_inc)
         have yeq: "y = (1 - inverse T) *\<^sub>R w + c /\<^sub>R T"
           using \<open>0 < T\<close> by (simp add: c_def algebra_simps)
         show "y \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
           by (metis yeq affine_affine_hull [simplified affine_alt, rule_format, OF waff caff])
       qed
     qed
     ultimately show ?thesis
       apply (simp add: facet_of_def)
       apply (subst aff_dim_affine_hull [symmetric])
       using  \<open>b h < a h \<bullet> z\<close> zaff
       apply (force simp: aff_dim_affine_Int_hyperplane)
       done
   qed
   show ?thesis
   proof
     show "\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h} \<Longrightarrow> c facet_of S"
       using * by blast
   next
     assume "c facet_of S"
     then have "c face_of S" "convex c" "c \<noteq> {}" and affc: "aff_dim c = aff_dim S - 1"
       by (auto simp: facet_of_def face_of_imp_convex)
     then obtain x where x: "x \<in> rel_interior c"
       by (force simp: rel_interior_eq_empty)
     then have "x \<in> c"
       by (meson subsetD rel_interior_subset)
     then have "x \<in> S"
       using \<open>c facet_of S\<close> facet_of_imp_subset by blast
     have rels: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
       by (rule rel_interior_polyhedron_explicit [OF assms])
     have "c \<noteq> S"
       using \<open>c facet_of S\<close> facet_of_irrefl by blast
     then have "x \<notin> rel_interior S"
       by (metis IntI empty_iff \<open>x \<in> c\<close> \<open>c \<noteq> S\<close> \<open>c face_of S\<close> face_of_disjoint_rel_interior)
     with rels \<open>x \<in> S\<close> obtain i where "i \<in> F" and i: "a i \<bullet> x \<ge> b i"
       by force
     have "x \<in> {u. a i \<bullet> u \<le> b i}"
       by (metis IntD2 InterE \<open>i \<in> F\<close> \<open>x \<in> S\<close> faceq seq)
     then have "a i \<bullet> x \<le> b i" by simp
     then have "a i \<bullet> x = b i" using i by auto
     have "c \<subseteq> S \<inter> {x. a i \<bullet> x = b i}"
       apply (rule subset_of_face_of [of _ S])
         apply (simp add: "*" \<open>i \<in> F\<close> facet_of_imp_face_of)
        apply (simp add: \<open>c face_of S\<close> face_of_imp_subset)
       using \<open>a i \<bullet> x = b i\<close> \<open>x \<in> S\<close> x by blast
     then have cface: "c face_of (S \<inter> {x. a i \<bullet> x = b i})"
       by (meson \<open>c face_of S\<close> face_of_subset inf_le1)
     have con: "convex (S \<inter> {x. a i \<bullet> x = b i})"
       by (simp add: \<open>convex S\<close> convex_Int convex_hyperplane)
     show "\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h}"
       apply (rule_tac x=i in exI)
       apply (simp add: \<open>i \<in> F\<close>)
       by (metis (no_types) * \<open>i \<in> F\<close> affc facet_of_def less_irrefl face_of_aff_dim_lt [OF con cface])
   qed
 qed
 
 
 lemma face_of_polyhedron_subset_explicit:
   fixes S :: "'a :: euclidean_space set"
   assumes "finite F"
       and seq: "S = affine hull S \<inter> \<Inter>F"
       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
       and c: "c face_of S" and "c \<noteq> {}" "c \<noteq> S"
    obtains h where "h \<in> F" "c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}"
 proof -
   have "c \<subseteq> S" using \<open>c face_of S\<close>
     by (simp add: face_of_imp_subset)
   have "polyhedron S"
     apply (simp add: polyhedron_Int_affine)
     by (metis \<open>finite F\<close> faceq seq)
   then have "convex S"
     by (simp add: polyhedron_imp_convex)
   then have *: "(S \<inter> {x. a h \<bullet> x = b h}) face_of S" if "h \<in> F" for h
     apply (rule face_of_Int_supporting_hyperplane_le)
     using faceq seq that by fastforce
   have "rel_interior c \<noteq> {}"
     using c \<open>c \<noteq> {}\<close> face_of_imp_convex rel_interior_eq_empty by blast
   then obtain x where "x \<in> rel_interior c" by auto
   have rels: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
   then have xnot: "x \<notin> rel_interior S"
     by (metis IntI \<open>x \<in> rel_interior c\<close> c \<open>c \<noteq> S\<close> contra_subsetD empty_iff face_of_disjoint_rel_interior rel_interior_subset)
   then have "x \<in> S"
     using \<open>c \<subseteq> S\<close> \<open>x \<in> rel_interior c\<close> rel_interior_subset by auto
   then have xint: "x \<in> \<Inter>F"
     using seq by blast
   have "F \<noteq> {}" using assms
     by (metis affine_Int affine_Inter affine_affine_hull ex_in_conv face_of_affine_trivial)
   then obtain i where "i \<in> F" "\<not> (a i \<bullet> x < b i)"
     using \<open>x \<in> S\<close> rels xnot by auto
   with xint have "a i \<bullet> x = b i"
     by (metis eq_iff mem_Collect_eq not_le Inter_iff faceq)
   have face: "S \<inter> {x. a i \<bullet> x = b i} face_of S"
     by (simp add: "*" \<open>i \<in> F\<close>)
   show ?thesis
     apply (rule_tac h = i in that)
      apply (rule \<open>i \<in> F\<close>)
     apply (rule subset_of_face_of [OF face \<open>c \<subseteq> S\<close>])
     using \<open>a i \<bullet> x = b i\<close> \<open>x \<in> rel_interior c\<close> \<open>x \<in> S\<close> apply blast
     done
 qed
 
 text\<open>Initial part of proof duplicates that above\<close>
 proposition face_of_polyhedron_explicit:
   fixes S :: "'a :: euclidean_space set"
   assumes "finite F"
       and seq: "S = affine hull S \<inter> \<Inter>F"
       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
       and c: "c face_of S" and "c \<noteq> {}" "c \<noteq> S"
     shows "c = \<Inter>{S \<inter> {x. a h \<bullet> x = b h} | h. h \<in> F \<and> c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}}"
 proof -
   let ?ab = "\<lambda>h. {x. a h \<bullet> x = b h}"
   have "c \<subseteq> S" using \<open>c face_of S\<close>
     by (simp add: face_of_imp_subset)
   have "polyhedron S"
     apply (simp add: polyhedron_Int_affine)
     by (metis \<open>finite F\<close> faceq seq)
   then have "convex S"
     by (simp add: polyhedron_imp_convex)
   then have *: "(S \<inter> ?ab h) face_of S" if "h \<in> F" for h
     apply (rule face_of_Int_supporting_hyperplane_le)
     using faceq seq that by fastforce
   have "rel_interior c \<noteq> {}"
     using c \<open>c \<noteq> {}\<close> face_of_imp_convex rel_interior_eq_empty by blast
   then obtain z where z: "z \<in> rel_interior c" by auto
   have rels: "rel_interior S = {z \<in> S. \<forall>h\<in>F. a h \<bullet> z < b h}"
     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
   then have xnot: "z \<notin> rel_interior S"
     by (metis IntI \<open>z \<in> rel_interior c\<close> c \<open>c \<noteq> S\<close> contra_subsetD empty_iff face_of_disjoint_rel_interior rel_interior_subset)
   then have "z \<in> S"
     using \<open>c \<subseteq> S\<close> \<open>z \<in> rel_interior c\<close> rel_interior_subset by auto
   with seq have xint: "z \<in> \<Inter>F" by blast
   have "open (\<Inter>h\<in>{h \<in> F. a h \<bullet> z < b h}. {w. a h \<bullet> w < b h})"
     by (auto simp: \<open>finite F\<close> open_halfspace_lt open_INT)
   then obtain e where "0 < e"
                  "ball z e \<subseteq> (\<Inter>h\<in>{h \<in> F. a h \<bullet> z < b h}. {w. a h \<bullet> w < b h})"
     by (auto intro: openE [of _ z])
   then have e: "\<And>h. \<lbrakk>h \<in> F; a h \<bullet> z < b h\<rbrakk> \<Longrightarrow> ball z e \<subseteq> {w. a h \<bullet> w < b h}"
     by blast
   have "c \<subseteq> (S \<inter> ?ab h) \<longleftrightarrow> z \<in> S \<inter> ?ab h" if "h \<in> F" for h
   proof
     show "z \<in> S \<inter> ?ab h \<Longrightarrow> c \<subseteq> S \<inter> ?ab h"
       apply (rule subset_of_face_of [of _ S])
       using that \<open>c \<subseteq> S\<close> \<open>z \<in> rel_interior c\<close>
       using facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub]
             unfolding facet_of_def
       apply auto
       done
   next
     show "c \<subseteq> S \<inter> ?ab h \<Longrightarrow> z \<in> S \<inter> ?ab h"
       using \<open>z \<in> rel_interior c\<close> rel_interior_subset by force
   qed
   then have **: "{S \<inter> ?ab h | h. h \<in> F \<and> c \<subseteq> S \<and> c \<subseteq> ?ab h} =
                  {S \<inter> ?ab h |h. h \<in> F \<and> z \<in> S \<inter> ?ab h}"
     by blast
   have bsub: "ball z e \<inter> affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
              \<subseteq> affine hull S \<inter> \<Inter>F \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
             if "i \<in> F" and i: "a i \<bullet> z = b i" for i
   proof -
     have sub: "ball z e \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> j"
              if "j \<in> F" for j
     proof -
       have "a j \<bullet> z \<le> b j" using faceq that xint by auto
       then consider "a j \<bullet> z < b j" | "a j \<bullet> z = b j" by linarith
       then have "\<exists>G. G \<in> {?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<and> ball z e \<inter> G \<subseteq> j"
       proof cases
         assume "a j \<bullet> z < b j"
         then have "ball z e \<inter> {x. a i \<bullet> x = b i} \<subseteq> j"
           using e [OF \<open>j \<in> F\<close>] faceq that
           by (fastforce simp: ball_def)
         then show ?thesis
           by (rule_tac x="{x. a i \<bullet> x = b i}" in exI) (force simp: \<open>i \<in> F\<close> i)
       next
         assume eq: "a j \<bullet> z = b j"
         with faceq that show ?thesis
           by (rule_tac x="{x. a j \<bullet> x = b j}" in exI) (fastforce simp add: \<open>j \<in> F\<close>)
       qed
       then show ?thesis  by blast
     qed
     have 1: "affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> affine hull S"
       apply (rule hull_mono)
       using that \<open>z \<in> S\<close> by auto
     have 2: "affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
           \<subseteq> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
       by (rule hull_minimal) (auto intro: affine_hyperplane)
     have 3: "ball z e \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> \<Inter>F"
       by (iprover intro: sub Inter_greatest)
     have *: "\<lbrakk>A \<subseteq> (B :: 'a set); A \<subseteq> C; E \<inter> C \<subseteq> D\<rbrakk> \<Longrightarrow> E \<inter> A \<subseteq> (B \<inter> D) \<inter> C"
              for A B C D E  by blast
     show ?thesis by (intro * 1 2 3)
   qed
   have "\<exists>h. h \<in> F \<and> c \<subseteq> ?ab h"
     apply (rule face_of_polyhedron_subset_explicit [OF \<open>finite F\<close> seq faceq psub])
     using assms by auto
   then have fac: "\<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> c \<subseteq> S \<inter> ?ab h} face_of S"
     using * by (force simp: \<open>c \<subseteq> S\<close> intro: face_of_Inter)
   have red:
      "(\<And>a. P a \<Longrightarrow> T \<subseteq> S \<inter> \<Inter>{F x |x. P x}) \<Longrightarrow> T \<subseteq> \<Inter>{S \<inter> F x |x. P x}"
      for P T F   by blast
   have "ball z e \<inter> affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
         \<subseteq> \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
     apply (rule red)
     apply (metis seq bsub)
     done
   with \<open>0 < e\<close> have zinrel: "z \<in> rel_interior
                     (\<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> z \<in> S \<and> a h \<bullet> z = b h})"
     by (auto simp: mem_rel_interior_ball \<open>z \<in> S\<close>)
   show ?thesis
     apply (rule face_of_eq [OF c fac])
     using z zinrel apply (force simp: **)
     done
 qed
 
 
 subsection\<open>More general corollaries from the explicit representation\<close>
 
 corollary facet_of_polyhedron:
   assumes "polyhedron S" and "c facet_of S"
   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x \<le> b}" "c = S \<inter> {x. a \<bullet> x = b}"
 proof -
   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
     using assms by (simp add: polyhedron_Int_affine_minimal) meson
   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
     by metis
   obtain i where "i \<in> F" and c: "c = S \<inter> {x. a i \<bullet> x = b i}"
     using facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min] assms
     by force
   moreover have ssub: "S \<subseteq> {x. a i \<bullet> x \<le> b i}"
      apply (subst seq)
      using \<open>i \<in> F\<close> ab by auto
   ultimately show ?thesis
     by (rule_tac a = "a i" and b = "b i" in that) (simp_all add: ab)
 qed
 
 corollary face_of_polyhedron:
   assumes "polyhedron S" and "c face_of S" and "c \<noteq> {}" and "c \<noteq> S"
     shows "c = \<Inter>{F. F facet_of S \<and> c \<subseteq> F}"
 proof -
   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
     using assms by (simp add: polyhedron_Int_affine_minimal) meson
   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
     by metis
   show ?thesis
     apply (subst face_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
     apply (auto simp: assms facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min] cong: Collect_cong)
     done
 qed
 
 lemma face_of_polyhedron_subset_facet:
   assumes "polyhedron S" and "c face_of S" and "c \<noteq> {}" and "c \<noteq> S"
   obtains F where "F facet_of S" "c \<subseteq> F"
 using face_of_polyhedron assms
 by (metis (no_types, lifting) Inf_greatest antisym_conv face_of_imp_subset mem_Collect_eq)
 
 
 lemma exposed_face_of_polyhedron:
   assumes "polyhedron S"
     shows "F exposed_face_of S \<longleftrightarrow> F face_of S"
 proof
   show "F exposed_face_of S \<Longrightarrow> F face_of S"
     by (simp add: exposed_face_of_def)
 next
   assume "F face_of S"
   show "F exposed_face_of S"
   proof (cases "F = {} \<or> F = S")
     case True then show ?thesis
       using \<open>F face_of S\<close> exposed_face_of by blast
   next
     case False
     then have "{g. g facet_of S \<and> F \<subseteq> g} \<noteq> {}"
       by (metis Collect_empty_eq_bot \<open>F face_of S\<close> assms empty_def face_of_polyhedron_subset_facet)
     moreover have "\<And>T. \<lbrakk>T facet_of S; F \<subseteq> T\<rbrakk> \<Longrightarrow> T exposed_face_of S"
       by (metis assms exposed_face_of facet_of_imp_face_of facet_of_polyhedron)
     ultimately have "\<Inter>{fa.
        fa facet_of S \<and> F \<subseteq> fa} exposed_face_of S"
       by (metis (no_types, lifting) mem_Collect_eq exposed_face_of_Inter)
     then show ?thesis
       using False
       apply (subst face_of_polyhedron [OF assms \<open>F face_of S\<close>], auto)
       done
   qed
 qed
 
 lemma face_of_polyhedron_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S" "c face_of S" shows "polyhedron c"
 by (metis assms face_of_imp_eq_affine_Int polyhedron_Int polyhedron_affine_hull polyhedron_imp_convex)
 
 lemma finite_polyhedron_faces:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S"
     shows "finite {F. F face_of S}"
 proof -
   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
              and min:   "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
     using assms by (simp add: polyhedron_Int_affine_minimal) meson
   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
     by metis
   have "finite {\<Inter>{S \<inter> {x. a h \<bullet> x = b h} |h. h \<in> F'}| F'. F' \<in> Pow F}"
     by (simp add: \<open>finite F\<close>)
   moreover have "{F. F face_of S} - {{}, S} \<subseteq> {\<Inter>{S \<inter> {x. a h \<bullet> x = b h} |h. h \<in> F'}| F'. F' \<in> Pow F}"
     apply clarify
     apply (rename_tac c)
     apply (drule face_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min, simplified], simp_all)
     apply (erule ssubst)
     apply (rule_tac x="{h \<in> F. c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}}" in exI, auto)
     done
   ultimately show ?thesis
     by (meson finite.emptyI finite.insertI finite_Diff2 finite_subset)
 qed
 
 lemma finite_polyhedron_exposed_faces:
    "polyhedron S \<Longrightarrow> finite {F. F exposed_face_of S}"
 using exposed_face_of_polyhedron finite_polyhedron_faces by fastforce
 
 lemma finite_polyhedron_extreme_points:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<Longrightarrow> finite {v. v extreme_point_of S}"
 apply (simp add: face_of_singleton [symmetric])
 apply (rule finite_subset [OF _ finite_vimageI [OF finite_polyhedron_faces]], auto)
 done
 
 lemma finite_polyhedron_facets:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<Longrightarrow> finite {F. F facet_of S}"
 unfolding facet_of_def
 by (blast intro: finite_subset [OF _ finite_polyhedron_faces])
 
 
 proposition rel_interior_of_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S"
     shows "rel_interior S = S - \<Union>{F. F facet_of S}"
 proof -
   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
     using assms by (simp add: polyhedron_Int_affine_minimal) meson
   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
     by metis
   have facet: "(c facet_of S) \<longleftrightarrow> (\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h})" for c
     by (rule facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
   have rel: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
   have "a h \<bullet> x < b h" if "x \<in> S" "h \<in> F" and xnot: "x \<notin> \<Union>{F. F facet_of S}" for x h
   proof -
     have "x \<in> \<Inter>F" using seq that by force
     with \<open>h \<in> F\<close> ab have "a h \<bullet> x \<le> b h" by auto
     then consider "a h \<bullet> x < b h" | "a h \<bullet> x = b h" by linarith
     then show ?thesis
     proof cases
       case 1 then show ?thesis .
     next
       case 2
       have "Collect ((\<in>) x) \<notin> Collect ((\<in>) (\<Union>{A. A facet_of S}))"
         using xnot by fastforce
       then have "F \<notin> Collect ((\<in>) h)"
         using 2 \<open>x \<in> S\<close> facet by blast
       with \<open>h \<in> F\<close> have "\<Inter>F \<subseteq> S \<inter> {x. a h \<bullet> x = b h}" by blast
       with 2 that \<open>x \<in> \<Inter>F\<close> show ?thesis
         apply simp
         apply (drule_tac x="\<Inter>F" in spec)
         apply (simp add: facet)
         apply (drule_tac x=h in spec)
         using seq by auto
       qed
   qed
   moreover have "\<exists>h\<in>F. a h \<bullet> x \<ge> b h" if "x \<in> \<Union>{F. F facet_of S}" for x
     using that by (force simp: facet)
   ultimately show ?thesis
     by (force simp: rel)
 qed
 
 lemma rel_boundary_of_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S"
     shows "S - rel_interior S = \<Union> {F. F facet_of S}"
 using facet_of_imp_subset by (fastforce simp add: rel_interior_of_polyhedron assms)
 
 lemma rel_frontier_of_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S"
     shows "rel_frontier S = \<Union> {F. F facet_of S}"
 by (simp add: assms rel_frontier_def polyhedron_imp_closed rel_boundary_of_polyhedron)
 
 lemma rel_frontier_of_polyhedron_alt:
   fixes S :: "'a :: euclidean_space set"
   assumes "polyhedron S"
     shows "rel_frontier S = \<Union> {F. F face_of S \<and> (F \<noteq> S)}"
 apply (rule subset_antisym)
   apply (force simp: rel_frontier_of_polyhedron facet_of_def assms)
 using face_of_subset_rel_frontier by fastforce
 
 
 text\<open>A characterization of polyhedra as having finitely many faces\<close>
 
 proposition polyhedron_eq_finite_exposed_faces:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow> closed S \<and> convex S \<and> finite {F. F exposed_face_of S}"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: polyhedron_imp_closed polyhedron_imp_convex finite_polyhedron_exposed_faces)
 next
   assume ?rhs
   then have "closed S" "convex S" and fin: "finite {F. F exposed_face_of S}" by auto
   show ?lhs
   proof (cases "S = {}")
     case True then show ?thesis by auto
   next
     case False
     define F where "F = {h. h exposed_face_of S \<and> h \<noteq> {} \<and> h \<noteq> S}"
     have "finite F" by (simp add: fin F_def)
     have hface: "h face_of S"
       and "\<exists>a b. a \<noteq> 0 \<and> S \<subseteq> {x. a \<bullet> x \<le> b} \<and> h = S \<inter> {x. a \<bullet> x = b}"
       if "h \<in> F" for h
-      using exposed_face_of F_def that by simp_all auto
+      using exposed_face_of F_def that by blast+
     then obtain a b where ab:
       "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> S \<subseteq> {x. a h \<bullet> x \<le> b h} \<and> h = S \<inter> {x. a h \<bullet> x = b h}"
       by metis
     have *: "False"
       if paff: "p \<in> affine hull S" and "p \<notin> S"
       and pint: "p \<in> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F}" for p
     proof -
       have "rel_interior S \<noteq> {}"
         by (simp add: \<open>S \<noteq> {}\<close> \<open>convex S\<close> rel_interior_eq_empty)
       then obtain c where c: "c \<in> rel_interior S" by auto
       with rel_interior_subset have "c \<in> S"  by blast
       have ccp: "closed_segment c p \<subseteq> affine hull S"
         by (meson affine_affine_hull affine_imp_convex c closed_segment_subset hull_subset paff rel_interior_subset subsetCE)
       obtain x where xcl: "x \<in> closed_segment c p" and "x \<in> S" and xnot: "x \<notin> rel_interior S"
         using connected_openin [of "closed_segment c p"]
         apply simp
         apply (drule_tac x="closed_segment c p \<inter> rel_interior S" in spec)
         apply (erule impE)
          apply (force simp: openin_rel_interior openin_Int intro: openin_subtopology_Int_subset [OF _ ccp])
         apply (drule_tac x="closed_segment c p \<inter> (- S)" in spec)
         using rel_interior_subset \<open>closed S\<close> c \<open>p \<notin> S\<close> apply blast
         done
       then obtain \<mu> where "0 \<le> \<mu>" "\<mu> \<le> 1" and xeq: "x = (1 - \<mu>) *\<^sub>R c + \<mu> *\<^sub>R p"
         by (auto simp: in_segment)
       show False
       proof (cases "\<mu>=0 \<or> \<mu>=1")
         case True with xeq c xnot \<open>x \<in> S\<close> \<open>p \<notin> S\<close>
         show False by auto
       next
         case False
         then have xos: "x \<in> open_segment c p"
           using \<open>x \<in> S\<close> c open_segment_def that(2) xcl xnot by auto
         have xclo: "x \<in> closure S"
           using \<open>x \<in> S\<close> closure_subset by blast
         obtain d where "d \<noteq> 0"
               and dle: "\<And>y. y \<in> closure S \<Longrightarrow> d \<bullet> x \<le> d \<bullet> y"
               and dless: "\<And>y. y \<in> rel_interior S \<Longrightarrow> d \<bullet> x < d \<bullet> y"
           by (metis supporting_hyperplane_relative_frontier [OF \<open>convex S\<close> xclo xnot])
         have sex: "S \<inter> {y. d \<bullet> y = d \<bullet> x} exposed_face_of S"
           by (simp add: \<open>closed S\<close> dle exposed_face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
         have sne: "S \<inter> {y. d \<bullet> y = d \<bullet> x} \<noteq> {}"
           using \<open>x \<in> S\<close> by blast
         have sns: "S \<inter> {y. d \<bullet> y = d \<bullet> x} \<noteq> S"
           by (metis (mono_tags) Int_Collect c subsetD dless not_le order_refl rel_interior_subset)
         obtain h where "h \<in> F" "x \<in> h"
           apply (rule_tac h="S \<inter> {y. d \<bullet> y = d \<bullet> x}" in that)
           apply (simp_all add: F_def sex sne sns \<open>x \<in> S\<close>)
           done
         have abface: "{y. a h \<bullet> y = b h} face_of {y. a h \<bullet> y \<le> b h}"
           using hyperplane_face_of_halfspace_le by blast
         then have "c \<in> h"
           using face_ofD [OF abface xos] \<open>c \<in> S\<close> \<open>h \<in> F\<close> ab pint \<open>x \<in> h\<close> by blast
         with c have "h \<inter> rel_interior S \<noteq> {}" by blast
         then show False
           using \<open>h \<in> F\<close> F_def face_of_disjoint_rel_interior hface by auto
       qed
     qed
     have "S \<subseteq> affine hull S \<inter> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F}"
       using ab by (auto simp: hull_subset)
     moreover have "affine hull S \<inter> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F} \<subseteq> S"
       using * by blast
     ultimately have "S = affine hull S \<inter> \<Inter> {{x. a h \<bullet> x \<le> b h} |h. h \<in> F}" ..
     then show ?thesis
       apply (rule ssubst)
       apply (force intro: polyhedron_affine_hull polyhedron_halfspace_le simp: \<open>finite F\<close>)
       done
   qed
 qed
 
 corollary polyhedron_eq_finite_faces:
   fixes S :: "'a :: euclidean_space set"
   shows "polyhedron S \<longleftrightarrow> closed S \<and> convex S \<and> finite {F. F face_of S}"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (simp add: finite_polyhedron_faces polyhedron_imp_closed polyhedron_imp_convex)
 next
   assume ?rhs
   then show ?lhs
     by (force simp: polyhedron_eq_finite_exposed_faces exposed_face_of intro: finite_subset)
 qed
 
 lemma polyhedron_linear_image_eq:
   fixes h :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   assumes "linear h" "bij h"
     shows "polyhedron (h ` S) \<longleftrightarrow> polyhedron S"
 proof -
   have *: "{f. P f} = (image h) ` {f. P (h ` f)}" for P
     apply safe
     apply (rule_tac x="inv h ` x" in image_eqI)
     apply (auto simp: \<open>bij h\<close> bij_is_surj image_f_inv_f)
     done
   have "inj h" using bij_is_inj assms by blast
   then have injim: "inj_on ((`) h) A" for A
     by (simp add: inj_on_def inj_image_eq_iff)
   show ?thesis
     using \<open>linear h\<close> \<open>inj h\<close>
     apply (simp add: polyhedron_eq_finite_faces closed_injective_linear_image_eq)
     apply (simp add: * face_of_linear_image [of h _ S, symmetric] finite_image_iff injim)
     done
 qed
 
 lemma polyhedron_negations:
   fixes S :: "'a :: euclidean_space set"
   shows   "polyhedron S \<Longrightarrow> polyhedron(image uminus S)"
   by (subst polyhedron_linear_image_eq)
     (auto simp: bij_uminus intro!: linear_uminus)
 
 subsection\<open>Relation between polytopes and polyhedra\<close>
 
 proposition polytope_eq_bounded_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   shows "polytope S \<longleftrightarrow> polyhedron S \<and> bounded S"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (simp add: finite_polytope_faces polyhedron_eq_finite_faces
                   polytope_imp_closed polytope_imp_convex polytope_imp_bounded)
 next
   assume ?rhs then show ?lhs
     unfolding polytope_def
     apply (rule_tac x="{v. v extreme_point_of S}" in exI)
     apply (simp add: finite_polyhedron_extreme_points Krein_Milman_Minkowski compact_eq_bounded_closed polyhedron_imp_closed polyhedron_imp_convex)
     done
 qed
 
 lemma polytope_Int:
   fixes S :: "'a :: euclidean_space set"
   shows "\<lbrakk>polytope S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
 by (simp add: polytope_eq_bounded_polyhedron bounded_Int)
 
 
 lemma polytope_Int_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   shows "\<lbrakk>polytope S; polyhedron T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
   by (simp add: bounded_Int polytope_eq_bounded_polyhedron)
 
 lemma polyhedron_Int_polytope:
   fixes S :: "'a :: euclidean_space set"
   shows "\<lbrakk>polyhedron S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
   by (simp add: bounded_Int polytope_eq_bounded_polyhedron)
 
 lemma polytope_imp_polyhedron:
   fixes S :: "'a :: euclidean_space set"
   shows "polytope S \<Longrightarrow> polyhedron S"
   by (simp add: polytope_eq_bounded_polyhedron)
 
 lemma polytope_facet_exists:
   fixes p :: "'a :: euclidean_space set"
   assumes "polytope p" "0 < aff_dim p"
   obtains F where "F facet_of p"
 proof (cases "p = {}")
   case True with assms show ?thesis by auto
 next
   case False
   then obtain v where "v extreme_point_of p"
     using extreme_point_exists_convex
     by (blast intro: \<open>polytope p\<close> polytope_imp_compact polytope_imp_convex)
   then
   show ?thesis
     by (metis face_of_polyhedron_subset_facet polytope_imp_polyhedron aff_dim_sing
        all_not_in_conv assms face_of_singleton less_irrefl singletonI that)
 qed
 
 lemma polyhedron_interval [iff]: "polyhedron(cbox a b)"
 by (metis polytope_imp_polyhedron polytope_interval)
 
 lemma polyhedron_convex_hull:
   fixes S :: "'a :: euclidean_space set"
   shows "finite S \<Longrightarrow> polyhedron(convex hull S)"
 by (simp add: polytope_convex_hull polytope_imp_polyhedron)
 
 
 subsection\<open>Relative and absolute frontier of a polytope\<close>
 
 lemma rel_boundary_of_convex_hull:
     fixes S :: "'a::euclidean_space set"
     assumes "\<not> affine_dependent S"
       shows "(convex hull S) - rel_interior(convex hull S) = (\<Union>a\<in>S. convex hull (S - {a}))"
 proof -
   have "finite S" by (metis assms aff_independent_finite)
   then consider "card S = 0" | "card S = 1" | "2 \<le> card S" by arith
   then show ?thesis
   proof cases
     case 1 then have "S = {}" by (simp add: \<open>finite S\<close>)
     then show ?thesis by simp
   next
     case 2 show ?thesis
       by (auto intro: card_1_singletonE [OF \<open>card S = 1\<close>])
   next
     case 3
     with assms show ?thesis
       by (auto simp: polyhedron_convex_hull rel_boundary_of_polyhedron facet_of_convex_hull_affine_independent_alt \<open>finite S\<close>)
   qed
 qed
 
 proposition frontier_of_convex_hull:
     fixes S :: "'a::euclidean_space set"
     assumes "card S = Suc (DIM('a))"
       shows "frontier(convex hull S) = \<Union> {convex hull (S - {a}) | a. a \<in> S}"
 proof (cases "affine_dependent S")
   case True
     have [iff]: "finite S"
       using assms using card_infinite by force
     then have ccs: "closed (convex hull S)"
       by (simp add: compact_imp_closed finite_imp_compact_convex_hull)
     { fix x T
       assume "finite T" "T \<subseteq> S" "int (card T) \<le> aff_dim S + 1" "x \<in> convex hull T"
       then have "S \<noteq> T"
         using True \<open>finite S\<close> aff_dim_le_card affine_independent_iff_card by fastforce
       then obtain a where "a \<in> S" "a \<notin> T"
         using \<open>T \<subseteq> S\<close> by blast
       then have "x \<in> (\<Union>a\<in>S. convex hull (S - {a}))"
         using True affine_independent_iff_card [of S]
         apply simp
         apply (metis (no_types, hide_lams) Diff_eq_empty_iff Diff_insert0 \<open>a \<notin> T\<close> \<open>T \<subseteq> S\<close> \<open>x \<in> convex hull T\<close>  hull_mono insert_Diff_single   subsetCE)
         done
     } note * = this
     have 1: "convex hull S \<subseteq> (\<Union> a\<in>S. convex hull (S - {a}))"
       apply (subst caratheodory_aff_dim)
       apply (blast intro: *)
       done
     have 2: "\<Union>((\<lambda>a. convex hull (S - {a})) ` S) \<subseteq> convex hull S"
       by (rule Union_least) (metis (no_types, lifting)  Diff_subset hull_mono imageE)
     show ?thesis using True
       apply (simp add: segment_convex_hull frontier_def)
       using interior_convex_hull_eq_empty [OF assms]
       apply (simp add: closure_closed [OF ccs])
       apply (rule subset_antisym)
       using 1 apply blast
       using 2 apply blast
       done
 next
   case False
   then have "frontier (convex hull S) = (convex hull S) - rel_interior(convex hull S)"
     apply (simp add: rel_boundary_of_convex_hull [symmetric] frontier_def)
     by (metis aff_independent_finite assms closure_convex_hull finite_imp_compact_convex_hull hull_hull interior_convex_hull_eq_empty rel_interior_nonempty_interior)
   also have "... = \<Union>{convex hull (S - {a}) |a. a \<in> S}"
   proof -
     have "convex hull S - rel_interior (convex hull S) = rel_frontier (convex hull S)"
       by (simp add: False aff_independent_finite polyhedron_convex_hull rel_boundary_of_polyhedron rel_frontier_of_polyhedron)
     then show ?thesis
       by (simp add: False rel_frontier_convex_hull_cases)
   qed
   finally show ?thesis .
 qed
 
 subsection\<open>Special case of a triangle\<close>
 
 proposition frontier_of_triangle:
     fixes a :: "'a::euclidean_space"
     assumes "DIM('a) = 2"
     shows "frontier(convex hull {a,b,c}) = closed_segment a b \<union> closed_segment b c \<union> closed_segment c a"
           (is "?lhs = ?rhs")
 proof (cases "b = a \<or> c = a \<or> c = b")
   case True then show ?thesis
     by (auto simp: assms segment_convex_hull frontier_def empty_interior_convex_hull insert_commute card_insert_le_m1 hull_inc insert_absorb)
 next
   case False then have [simp]: "card {a, b, c} = Suc (DIM('a))"
     by (simp add: card_insert Set.insert_Diff_if assms)
   show ?thesis
   proof
     show "?lhs \<subseteq> ?rhs"
       using False
       by (force simp: segment_convex_hull frontier_of_convex_hull insert_Diff_if insert_commute split: if_split_asm)
     show "?rhs \<subseteq> ?lhs"
       using False
       apply (simp add: frontier_of_convex_hull segment_convex_hull)
       apply (intro conjI subsetI)
         apply (rule_tac X="convex hull {a,b}" in UnionI; force simp: Set.insert_Diff_if)
        apply (rule_tac X="convex hull {b,c}" in UnionI; force)
       apply (rule_tac X="convex hull {a,c}" in UnionI; force simp: insert_commute Set.insert_Diff_if)
       done
   qed
 qed
 
 corollary inside_of_triangle:
     fixes a :: "'a::euclidean_space"
     assumes "DIM('a) = 2"
     shows "inside (closed_segment a b \<union> closed_segment b c \<union> closed_segment c a) = interior(convex hull {a,b,c})"
 by (metis assms frontier_of_triangle bounded_empty bounded_insert convex_convex_hull inside_frontier_eq_interior bounded_convex_hull)
 
 corollary interior_of_triangle:
     fixes a :: "'a::euclidean_space"
     assumes "DIM('a) = 2"
     shows "interior(convex hull {a,b,c}) =
            convex hull {a,b,c} - (closed_segment a b \<union> closed_segment b c \<union> closed_segment c a)"
   using interior_subset
   by (force simp: frontier_of_triangle [OF assms, symmetric] frontier_def Diff_Diff_Int)
 
 subsection\<open>Subdividing a cell complex\<close>
 
 lemma subdivide_interval:
   fixes x::real
   assumes "a < \<bar>x - y\<bar>" "0 < a"
   obtains n where "n \<in> \<int>" "x < n * a \<and> n * a < y \<or> y <  n * a \<and> n * a < x"
 proof -
   consider "a + x < y" | "a + y < x"
     using assms by linarith
   then show ?thesis
   proof cases
     case 1
     let ?n = "of_int (floor (x/a)) + 1"
     have x: "x < ?n * a"
       by (meson \<open>0 < a\<close> divide_less_eq floor_eq_iff)
     have "?n * a \<le> a + x"
       apply (simp add: algebra_simps)
       by (metis \<open>0 < a\<close> floor_correct less_irrefl nonzero_mult_div_cancel_left real_mult_le_cancel_iff2 times_divide_eq_right)
     also have "... < y"
       by (rule 1)
     finally have "?n * a < y" .
     with x show ?thesis
       using Ints_1 Ints_add Ints_of_int that by blast
   next
     case 2
     let ?n = "of_int (floor (y/a)) + 1"
     have y: "y < ?n * a"
       by (meson \<open>0 < a\<close> divide_less_eq floor_eq_iff)
     have "?n * a \<le> a + y"
       apply (simp add: algebra_simps)
       by (metis \<open>0 < a\<close> floor_correct less_irrefl nonzero_mult_div_cancel_left real_mult_le_cancel_iff2 times_divide_eq_right)
     also have "... < x"
       by (rule 2)
     finally have "?n * a < x" .
     then show ?thesis
       using Ints_1 Ints_add Ints_of_int that y by blast
   qed
 qed
 
 lemma cell_subdivision_lemma:
   assumes "finite \<F>"
       and "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> d"
       and "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X"
       and "finite I"
     shows "\<exists>\<G>. \<Union>\<G> = \<Union>\<F> \<and>
                  finite \<G> \<and>
                  (\<forall>C \<in> \<G>. \<exists>D. D \<in> \<F> \<and> C \<subseteq> D) \<and>
                  (\<forall>C \<in> \<F>. \<forall>x \<in> C. \<exists>D. D \<in> \<G> \<and> x \<in> D \<and> D \<subseteq> C) \<and>
                  (\<forall>X \<in> \<G>. polytope X) \<and>
                  (\<forall>X \<in> \<G>. aff_dim X \<le> d) \<and>
                  (\<forall>X \<in> \<G>. \<forall>Y \<in> \<G>. X \<inter> Y face_of X) \<and>
                  (\<forall>X \<in> \<G>. \<forall>x \<in> X. \<forall>y \<in> X. \<forall>a b.
                           (a,b) \<in> I \<longrightarrow> a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or>
                                         a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b)"
   using \<open>finite I\<close>
 proof induction
   case empty
   then show ?case
     by (rule_tac x="\<F>" in exI) (auto simp: assms)
 next
   case (insert ab I)
   then obtain \<G> where eq: "\<Union>\<G> = \<Union>\<F>" and "finite \<G>"
                    and sub1: "\<And>C. C \<in> \<G> \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
                    and sub2: "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<G> \<and> x \<in> D \<and> D \<subseteq> C"
                    and poly: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
                    and aff: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> d"
                    and face: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
                    and I: "\<And>X x y a b.  \<lbrakk>X \<in> \<G>; x \<in> X; y \<in> X; (a,b) \<in> I\<rbrakk> \<Longrightarrow>
                                     a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or> a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
     by (auto simp: that)
   obtain a b where "ab = (a,b)"
     by fastforce
   let ?\<G> = "(\<lambda>X. X \<inter> {x. a \<bullet> x \<le> b}) ` \<G> \<union> (\<lambda>X. X \<inter> {x. a \<bullet> x \<ge> b}) ` \<G>"
   have eqInt: "(S \<inter> Collect P) \<inter> (T \<inter> Collect Q) = (S \<inter> T) \<inter> (Collect P \<inter> Collect Q)" for S T::"'a set" and P Q
     by blast
   show ?case
   proof (intro conjI exI)
     show "\<Union>?\<G> = \<Union>\<F>"
       by (force simp: eq [symmetric])
     show "finite ?\<G>"
       using \<open>finite \<G>\<close> by force
     show "\<forall>X \<in> ?\<G>. polytope X"
       by (force simp: poly polytope_Int_polyhedron polyhedron_halfspace_le polyhedron_halfspace_ge)
     show "\<forall>X \<in> ?\<G>. aff_dim X \<le> d"
       by (auto; metis order_trans aff aff_dim_subset inf_le1)
     show "\<forall>X \<in> ?\<G>. \<forall>x \<in> X. \<forall>y \<in> X. \<forall>a b.
                           (a,b) \<in> insert ab I \<longrightarrow> a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or>
                                                   a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
       using \<open>ab = (a, b)\<close> I by fastforce
     show "\<forall>X \<in> ?\<G>. \<forall>Y \<in> ?\<G>. X \<inter> Y face_of X"
       by (auto simp: eqInt halfspace_Int_eq face_of_Int_Int face face_of_halfspace_le face_of_halfspace_ge)
     show "\<forall>C \<in> ?\<G>. \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
       using sub1 by force
     show "\<forall>C\<in>\<F>. \<forall>x\<in>C. \<exists>D. D \<in> ?\<G> \<and> x \<in> D \<and> D \<subseteq> C"
     proof (intro ballI)
       fix C z
       assume "C \<in> \<F>" "z \<in> C"
       with sub2 obtain D where D: "D \<in> \<G>" "z \<in> D" "D \<subseteq> C" by blast
       have "D \<in> \<G> \<and> z \<in> D \<inter> {x. a \<bullet> x \<le> b} \<and> D \<inter> {x. a \<bullet> x \<le> b} \<subseteq> C \<or>
             D \<in> \<G> \<and> z \<in> D \<inter> {x. a \<bullet> x \<ge> b} \<and> D \<inter> {x. a \<bullet> x \<ge> b} \<subseteq> C"
         using linorder_class.linear [of "a \<bullet> z" b] D by blast
       then show "\<exists>D. D \<in> ?\<G> \<and> z \<in> D \<and> D \<subseteq> C"
         by blast
     qed
   qed
 qed
 
 
 proposition cell_complex_subdivision_exists:
   fixes \<F> :: "'a::euclidean_space set set"
   assumes "0 < e" "finite \<F>"
       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> d"
       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
   obtains "\<F>'" where "finite \<F>'" "\<Union>\<F>' = \<Union>\<F>" "\<And>X. X \<in> \<F>' \<Longrightarrow> diameter X < e"
                 "\<And>X. X \<in> \<F>' \<Longrightarrow> polytope X" "\<And>X. X \<in> \<F>' \<Longrightarrow> aff_dim X \<le> d"
                 "\<And>X Y. \<lbrakk>X \<in> \<F>'; Y \<in> \<F>'\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
                 "\<And>C. C \<in> \<F>' \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
                 "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<F>' \<and> x \<in> D \<and> D \<subseteq> C"
 proof -
   have "bounded(\<Union>\<F>)"
     by (simp add: \<open>finite \<F>\<close> poly bounded_Union polytope_imp_bounded)
   then obtain B where "B > 0" and B: "\<And>x. x \<in> \<Union>\<F> \<Longrightarrow> norm x < B"
     by (meson bounded_pos_less)
   define C where "C \<equiv> {z \<in> \<int>. \<bar>z * e / 2 / real DIM('a)\<bar> \<le> B}"
   define I where "I \<equiv> \<Union>i \<in> Basis. \<Union>j \<in> C. { (i::'a, j * e / 2 / DIM('a)) }"
   have "finite C"
     using finite_int_segment [of "-B / (e / 2 / DIM('a))" "B / (e / 2 / DIM('a))"]
     apply (simp add: C_def)
     apply (erule rev_finite_subset)
     using \<open>0 < e\<close>
     apply (auto simp: field_split_simps)
     done
   then have "finite I"
     by (simp add: I_def)
   obtain \<F>' where eq: "\<Union>\<F>' = \<Union>\<F>" and "finite \<F>'"
               and poly: "\<And>X. X \<in> \<F>' \<Longrightarrow> polytope X"
               and aff: "\<And>X. X \<in> \<F>' \<Longrightarrow> aff_dim X \<le> d"
               and face: "\<And>X Y. \<lbrakk>X \<in> \<F>'; Y \<in> \<F>'\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
               and I: "\<And>X x y a b.  \<lbrakk>X \<in> \<F>'; x \<in> X; y \<in> X; (a,b) \<in> I\<rbrakk> \<Longrightarrow>
                                      a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or> a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
               and sub1: "\<And>C. C \<in> \<F>' \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
               and sub2: "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<F>' \<and> x \<in> D \<and> D \<subseteq> C"
     apply (rule exE [OF cell_subdivision_lemma])
     using assms \<open>finite I\<close> apply auto
     done
   show ?thesis
   proof (rule_tac \<F>'="\<F>'" in that)
     show "diameter X < e" if "X \<in> \<F>'" for X
     proof -
       have "diameter X \<le> e/2"
       proof (rule diameter_le)
         show "norm (x - y) \<le> e / 2" if "x \<in> X" "y \<in> X" for x y
         proof -
           have "norm x < B" "norm y < B"
-            using B \<open>X \<in> \<F>'\<close> eq that by fastforce+
+            using B \<open>X \<in> \<F>'\<close> eq that by blast+
           have "norm (x - y) \<le> (\<Sum>b\<in>Basis. \<bar>(x-y) \<bullet> b\<bar>)"
             by (rule norm_le_l1)
           also have "... \<le> of_nat (DIM('a)) * (e / 2 / DIM('a))"
           proof (rule sum_bounded_above)
             fix i::'a
             assume "i \<in> Basis"
             then have I': "\<And>z b. \<lbrakk>z \<in> C; b = z * e / (2 * real DIM('a))\<rbrakk> \<Longrightarrow> i \<bullet> x \<le> b \<and> i \<bullet> y \<le> b \<or> i \<bullet> x \<ge> b \<and> i \<bullet> y \<ge> b"
-              using I \<open>X \<in> \<F>'\<close> that
-              by (fastforce simp: I_def)
+              using I[of X x y] \<open>X \<in> \<F>'\<close> that unfolding I_def by auto
             show "\<bar>(x - y) \<bullet> i\<bar> \<le> e / 2 / real DIM('a)"
             proof (rule ccontr)
               assume "\<not> \<bar>(x - y) \<bullet> i\<bar> \<le> e / 2 / real DIM('a)"
               then have xyi: "\<bar>i \<bullet> x - i \<bullet> y\<bar> > e / 2 / real DIM('a)"
                 by (simp add: inner_commute inner_diff_right)
               obtain n where "n \<in> \<int>" and n: "i \<bullet> x < n * (e / 2 / real DIM('a)) \<and> n * (e / 2 / real DIM('a)) < i \<bullet> y \<or> i \<bullet> y < n * (e / 2 / real DIM('a)) \<and> n * (e / 2 / real DIM('a)) < i \<bullet> x"
                 using subdivide_interval [OF xyi] DIM_positive \<open>0 < e\<close>
                 by (auto simp: zero_less_divide_iff)
               have "\<bar>i \<bullet> x\<bar> < B"
                 by (metis \<open>i \<in> Basis\<close> \<open>norm x < B\<close> inner_commute norm_bound_Basis_lt)
               have "\<bar>i \<bullet> y\<bar> < B"
                 by (metis \<open>i \<in> Basis\<close> \<open>norm y < B\<close> inner_commute norm_bound_Basis_lt)
               have *: "\<bar>n * e\<bar> \<le> B * (2 * real DIM('a))"
                       if "\<bar>ix\<bar> < B" "\<bar>iy\<bar> < B"
                          and ix: "ix * (2 * real DIM('a)) < n * e"
                          and iy: "n * e < iy * (2 * real DIM('a))" for ix iy
               proof (rule abs_leI)
                 have "iy * (2 * real DIM('a)) \<le> B * (2 * real DIM('a))"
                   by (rule mult_right_mono) (use \<open>\<bar>iy\<bar> < B\<close> in linarith)+
                 then show "n * e \<le> B * (2 * real DIM('a))"
                   using iy by linarith
               next
                 have "- ix * (2 * real DIM('a)) \<le> B * (2 * real DIM('a))"
                   by (rule mult_right_mono) (use \<open>\<bar>ix\<bar> < B\<close> in linarith)+
                 then show "- (n * e) \<le> B * (2 * real DIM('a))"
                   using ix by linarith
               qed
               have "n \<in> C"
                 using \<open>n \<in> \<int>\<close> n  by (auto simp: C_def divide_simps intro: * \<open>\<bar>i \<bullet> x\<bar> < B\<close> \<open>\<bar>i \<bullet> y\<bar> < B\<close>)
               show False
                 using  I' [OF \<open>n \<in> C\<close> refl] n  by auto
             qed
           qed
           also have "... = e / 2"
             by simp
           finally show ?thesis .
         qed
       qed (use \<open>0 < e\<close> in force)
       also have "... < e"
         by (simp add: \<open>0 < e\<close>)
       finally show ?thesis .
     qed
   qed (auto simp: eq poly aff face sub1 sub2 \<open>finite \<F>'\<close>)
 qed
 
 
 subsection\<open>Simplexes\<close>
 
 text\<open>The notion of n-simplex for integer \<^term>\<open>n \<ge> -1\<close>\<close>
 
 definition\<^marker>\<open>tag important\<close> simplex :: "int \<Rightarrow> 'a::euclidean_space set \<Rightarrow> bool" (infix "simplex" 50)
   where "n simplex S \<equiv> \<exists>C. \<not> affine_dependent C \<and> int(card C) = n + 1 \<and> S = convex hull C"
 
 lemma simplex:
     "n simplex S \<longleftrightarrow> (\<exists>C. finite C \<and>
                        \<not> affine_dependent C \<and>
                        int(card C) = n + 1 \<and>
                        S = convex hull C)"
   by (auto simp add: simplex_def intro: aff_independent_finite)
 
 lemma simplex_convex_hull:
    "\<not> affine_dependent C \<and> int(card C) = n + 1 \<Longrightarrow> n simplex (convex hull C)"
   by (auto simp add: simplex_def)
 
 lemma convex_simplex: "n simplex S \<Longrightarrow> convex S"
   by (metis convex_convex_hull simplex_def)
 
 lemma compact_simplex: "n simplex S \<Longrightarrow> compact S"
   unfolding simplex
   using finite_imp_compact_convex_hull by blast
 
 lemma closed_simplex: "n simplex S \<Longrightarrow> closed S"
   by (simp add: compact_imp_closed compact_simplex)
 
 lemma simplex_imp_polytope:
    "n simplex S \<Longrightarrow> polytope S"
   unfolding simplex_def polytope_def
   using aff_independent_finite by blast
 
 lemma simplex_imp_polyhedron:
    "n simplex S \<Longrightarrow> polyhedron S"
   by (simp add: polytope_imp_polyhedron simplex_imp_polytope)
 
 lemma simplex_dim_ge: "n simplex S \<Longrightarrow> -1 \<le> n"
   by (metis (no_types, hide_lams) aff_dim_geq affine_independent_iff_card diff_add_cancel diff_diff_eq2 simplex_def)
 
 lemma simplex_empty [simp]: "n simplex {} \<longleftrightarrow> n = -1"
 proof
   assume "n simplex {}"
   then show "n = -1"
     unfolding simplex by (metis card_empty convex_hull_eq_empty diff_0 diff_eq_eq of_nat_0)
 next
   assume "n = -1" then show "n simplex {}"
     by (fastforce simp: simplex)
 qed
 
 lemma simplex_minus_1 [simp]: "-1 simplex S \<longleftrightarrow> S = {}"
   by (metis simplex cancel_comm_monoid_add_class.diff_cancel card_0_eq diff_minus_eq_add of_nat_eq_0_iff simplex_empty)
 
 
 lemma aff_dim_simplex:
    "n simplex S \<Longrightarrow> aff_dim S = n"
   by (metis simplex add.commute add_diff_cancel_left' aff_dim_convex_hull affine_independent_iff_card)
 
 lemma zero_simplex_sing: "0 simplex {a}"
   apply (simp add: simplex_def)
   by (metis affine_independent_1 card_empty card_insert_disjoint convex_hull_singleton empty_iff finite.emptyI)
 
 lemma simplex_sing [simp]: "n simplex {a} \<longleftrightarrow> n = 0"
   using aff_dim_simplex aff_dim_sing zero_simplex_sing by blast
 
 lemma simplex_zero: "0 simplex S \<longleftrightarrow> (\<exists>a. S = {a})"
 apply (auto simp: )
   using aff_dim_eq_0 aff_dim_simplex by blast
 
 lemma one_simplex_segment: "a \<noteq> b \<Longrightarrow> 1 simplex closed_segment a b"
   apply (simp add: simplex_def)
   apply (rule_tac x="{a,b}" in exI)
   apply (auto simp: segment_convex_hull)
   done
 
 lemma simplex_segment_cases:
    "(if a = b then 0 else 1) simplex closed_segment a b"
   by (auto simp: one_simplex_segment)
 
 lemma simplex_segment:
    "\<exists>n. n simplex closed_segment a b"
   using simplex_segment_cases by metis
 
 lemma polytope_lowdim_imp_simplex:
   assumes "polytope P" "aff_dim P \<le> 1"
   obtains n where "n simplex P"
 proof (cases "P = {}")
   case True
   then show ?thesis
     by (simp add: that)
 next
   case False
   then show ?thesis
     by (metis assms compact_convex_collinear_segment collinear_aff_dim polytope_imp_compact polytope_imp_convex simplex_segment_cases that)
 qed
 
 lemma simplex_insert_dimplus1:
   fixes n::int
   assumes "n simplex S" and a: "a \<notin> affine hull S"
   shows "(n+1) simplex (convex hull (insert a S))"
 proof -
   obtain C where C: "finite C" "\<not> affine_dependent C" "int(card C) = n+1" and S: "S = convex hull C"
     using assms unfolding simplex by force
   show ?thesis
     unfolding simplex
   proof (intro exI conjI)
       have "aff_dim S = n"
         using aff_dim_simplex assms(1) by blast
       moreover have "a \<notin> affine hull C"
         using S a affine_hull_convex_hull by blast
       moreover have "a \<notin> C"
           using S a hull_inc by fastforce
       ultimately show "\<not> affine_dependent (insert a C)"
         by (simp add: C S aff_dim_convex_hull aff_dim_insert affine_independent_iff_card)
   next
     have "a \<notin> C"
       using S a hull_inc by fastforce
     then show "int (card (insert a C)) = n + 1 + 1"
       by (simp add: C)
   next
     show "convex hull insert a S = convex hull (insert a C)"
       by (simp add: S convex_hull_insert_segments)
   qed (use C in auto)
 qed
 
 subsection \<open>Simplicial complexes and triangulations\<close>
 
 definition\<^marker>\<open>tag important\<close> simplicial_complex where
  "simplicial_complex \<C> \<equiv>
         finite \<C> \<and>
         (\<forall>S \<in> \<C>. \<exists>n. n simplex S) \<and>
         (\<forall>F S. S \<in> \<C> \<and> F face_of S \<longrightarrow> F \<in> \<C>) \<and>
         (\<forall>S S'. S \<in> \<C> \<and> S' \<in> \<C> \<longrightarrow> (S \<inter> S') face_of S)"
 
 definition\<^marker>\<open>tag important\<close> triangulation where
  "triangulation \<T> \<equiv>
         finite \<T> \<and>
         (\<forall>T \<in> \<T>. \<exists>n. n simplex T) \<and>
         (\<forall>T T'. T \<in> \<T> \<and> T' \<in> \<T> \<longrightarrow> (T \<inter> T') face_of T)"
 
 
 subsection\<open>Refining a cell complex to a simplicial complex\<close>
 
 proposition convex_hull_insert_Int_eq:
   fixes z :: "'a :: euclidean_space"
   assumes z: "z \<in> rel_interior S"
       and T: "T \<subseteq> rel_frontier S"
       and U: "U \<subseteq> rel_frontier S"
       and "convex S" "convex T" "convex U"
   shows "convex hull (insert z T) \<inter> convex hull (insert z U) = convex hull (insert z (T \<inter> U))"
     (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
   proof (cases "T={} \<or> U={}")
     case True then show ?thesis by auto
   next
     case False
     then have "T \<noteq> {}" "U \<noteq> {}" by auto
     have TU: "convex (T \<inter> U)"
       by (simp add: \<open>convex T\<close> \<open>convex U\<close> convex_Int)
     have "(\<Union>x\<in>T. closed_segment z x) \<inter> (\<Union>x\<in>U. closed_segment z x)
           \<subseteq> (if T \<inter> U = {} then {z} else \<Union>((closed_segment z) ` (T \<inter> U)))" (is "_ \<subseteq> ?IF")
     proof clarify
       fix x t u
       assume xt: "x \<in> closed_segment z t"
         and xu: "x \<in> closed_segment z u"
         and "t \<in> T" "u \<in> U"
       then have ne: "t \<noteq> z" "u \<noteq> z"
         using T U z unfolding rel_frontier_def by blast+
       show "x \<in> ?IF"
       proof (cases "x = z")
         case True then show ?thesis by auto
       next
         case False
         have t: "t \<in> closure S"
           using T \<open>t \<in> T\<close> rel_frontier_def by auto
         have u: "u \<in> closure S"
           using U \<open>u \<in> U\<close> rel_frontier_def by auto
         show ?thesis
         proof (cases "t = u")
           case True
           then show ?thesis
             using \<open>t \<in> T\<close> \<open>u \<in> U\<close> xt by auto
         next
           case False
           have tnot: "t \<notin> closed_segment u z"
           proof -
             have "t \<in> closure S - rel_interior S"
               using T \<open>t \<in> T\<close> rel_frontier_def by blast
             then have "t \<notin> open_segment z u"
               by (meson DiffD2 rel_interior_closure_convex_segment [OF \<open>convex S\<close> z u] subsetD)
             then show ?thesis
               by (simp add: \<open>t \<noteq> u\<close> \<open>t \<noteq> z\<close> open_segment_commute open_segment_def)
           qed
           moreover have "u \<notin> closed_segment z t"
             using rel_interior_closure_convex_segment [OF \<open>convex S\<close> z t] \<open>u \<in> U\<close> \<open>u \<noteq> z\<close>
               U [unfolded rel_frontier_def] tnot
             by (auto simp: closed_segment_eq_open)
           ultimately
           have "\<not>(between (t,u) z | between (u,z) t | between (z,t) u)" if "x \<noteq> z"
             using that xt xu
             apply (simp add: between_mem_segment [symmetric])
             by (metis between_commute between_trans_2 between_antisym)
           then have "\<not> collinear {t, z, u}" if "x \<noteq> z"
             by (auto simp: that collinear_between_cases between_commute)
           moreover have "collinear {t, z, x}"
             by (metis closed_segment_commute collinear_2 collinear_closed_segment collinear_triples ends_in_segment(1) insert_absorb insert_absorb2 xt)
           moreover have "collinear {z, x, u}"
             by (metis closed_segment_commute collinear_2 collinear_closed_segment collinear_triples ends_in_segment(1) insert_absorb insert_absorb2 xu)
           ultimately have False
             using collinear_3_trans [of t z x u] \<open>x \<noteq> z\<close> by blast
           then show ?thesis by metis
         qed
       qed
     qed
     then show ?thesis
       using False \<open>convex T\<close> \<open>convex U\<close> TU
       by (simp add: convex_hull_insert_segments hull_same split: if_split_asm)
   qed
   show "?rhs \<subseteq> ?lhs"
     by (metis inf_greatest hull_mono inf.cobounded1 inf.cobounded2 insert_mono)
 qed
 
 lemma simplicial_subdivision_aux:
   assumes "finite \<M>"
       and "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
       and "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> of_nat n"
       and "\<And>C F. \<lbrakk>C \<in> \<M>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<M>"
       and "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
     shows "\<exists>\<T>. simplicial_complex \<T> \<and>
                 (\<forall>K \<in> \<T>. aff_dim K \<le> of_nat n) \<and>
                 \<Union>\<T> = \<Union>\<M> \<and>
                 (\<forall>C \<in> \<M>. \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
                 (\<forall>K \<in> \<T>. \<exists>C. C \<in> \<M> \<and> K \<subseteq> C)"
   using assms
 proof (induction n arbitrary: \<M> rule: less_induct)
   case (less n)
   then have poly\<M>: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
     and aff\<M>:    "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> of_nat n"
     and face\<M>:   "\<And>C F. \<lbrakk>C \<in> \<M>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<M>"
     and intface\<M>: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
     by metis+
   show ?case
   proof (cases "n \<le> 1")
     case True
     have "\<And>s. \<lbrakk>n \<le> 1; s \<in> \<M>\<rbrakk> \<Longrightarrow> \<exists>m. m simplex s"
       using poly\<M> aff\<M> by (force intro: polytope_lowdim_imp_simplex)
     then show ?thesis
       unfolding simplicial_complex_def
       apply (rule_tac x="\<M>" in exI)
       using True by (auto simp: less.prems)
   next
     case False
     define \<S> where "\<S> \<equiv> {C \<in> \<M>. aff_dim C < n}"
     have "finite \<S>" "\<And>C. C \<in> \<S> \<Longrightarrow> polytope C" "\<And>C. C \<in> \<S> \<Longrightarrow> aff_dim C \<le> int (n - 1)"
       "\<And>C F. \<lbrakk>C \<in> \<S>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<S>"
       "\<And>C1 C2. \<lbrakk>C1 \<in> \<S>; C2 \<in> \<S>\<rbrakk>  \<Longrightarrow> C1 \<inter> C2 face_of C1"
       using less.prems
           apply (auto simp: \<S>_def)
       by (metis aff_dim_subset face_of_imp_subset less_le not_le)
     with less.IH [of "n-1" \<S>] False
     obtain \<U> where "simplicial_complex \<U>"
       and aff_dim\<U>: "\<And>K. K \<in> \<U> \<Longrightarrow> aff_dim K \<le> int (n - 1)"
       and        "\<Union>\<U> = \<Union>\<S>"
       and fin\<U>:  "\<And>C. C \<in> \<S> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<U> \<and> C = \<Union>F"
       and C\<U>:    "\<And>K. K \<in> \<U> \<Longrightarrow> \<exists>C. C \<in> \<S> \<and> K \<subseteq> C"
       by auto
     then have "finite \<U>"
       and simpl\<U>: "\<And>S. S \<in> \<U> \<Longrightarrow> \<exists>n. n simplex S"
       and face\<U>:  "\<And>F S. \<lbrakk>S \<in> \<U>; F face_of S\<rbrakk> \<Longrightarrow> F \<in> \<U>"
       and faceI\<U>: "\<And>S S'. \<lbrakk>S \<in> \<U>; S' \<in> \<U>\<rbrakk> \<Longrightarrow> (S \<inter> S') face_of S"
       by (auto simp: simplicial_complex_def)
     define \<N> where "\<N> \<equiv> {C \<in> \<M>. aff_dim C = n}"
     have "finite \<N>"
       by (simp add: \<N>_def less.prems(1))
     have poly\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> polytope C"
       and convex\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> convex C"
       and closed\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> closed C"
       by (auto simp: \<N>_def poly\<M> polytope_imp_convex polytope_imp_closed)
     have in_rel_interior: "(SOME z. z \<in> rel_interior C) \<in> rel_interior C" if "C \<in> \<N>" for C
       using that poly\<M> polytope_imp_convex rel_interior_aff_dim some_in_eq by (fastforce simp: \<N>_def)
     have *: "\<exists>T. \<not> affine_dependent T \<and> card T \<le> n \<and> aff_dim K < n \<and> K = convex hull T"
       if "K \<in> \<U>" for K
     proof -
       obtain r where r: "r simplex K"
         using \<open>K \<in> \<U>\<close> simpl\<U> by blast
       have "r = aff_dim K"
         using \<open>r simplex K\<close> aff_dim_simplex by blast
       with r
       show ?thesis
         unfolding simplex_def
         using False \<open>\<And>K. K \<in> \<U> \<Longrightarrow> aff_dim K \<le> int (n - 1)\<close> that by fastforce
     qed
     have ahK_C_disjoint: "affine hull K \<inter> rel_interior C = {}"
       if "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C" for C K
     proof -
       have "convex C" "closed C"
         by (auto simp: convex\<N> closed\<N> \<open>C \<in> \<N>\<close>)
       obtain F where F: "F face_of C" and "F \<noteq> C" "K \<subseteq> F"
       proof -
         obtain L where "L \<in> \<S>" "K \<subseteq> L"
           using \<open>K \<in> \<U>\<close> C\<U> by blast
         have "K \<le> rel_frontier C"
           by (simp add: \<open>K \<subseteq> rel_frontier C\<close>)
         also have "... \<le> C"
           by (simp add: \<open>closed C\<close> rel_frontier_def subset_iff)
         finally have "K \<subseteq> C" .
         have "L \<inter> C face_of C"
           using \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close> intface\<M> by (simp add: inf_commute)
         moreover have "L \<inter> C \<noteq> C"
           using \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close>
           apply (clarsimp simp: \<N>_def \<S>_def)
           by (metis aff_dim_subset inf_le1 not_le)
         moreover have "K \<subseteq> L \<inter> C"
           using \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close> \<open>K \<subseteq> C\<close> \<open>K \<subseteq> L\<close>
           by (auto simp: \<N>_def \<S>_def)
         ultimately show ?thesis using that by metis
       qed
       have "affine hull F \<inter> rel_interior C = {}"
         by (rule affine_hull_face_of_disjoint_rel_interior [OF \<open>convex C\<close> F \<open>F \<noteq> C\<close>])
       with hull_mono [OF \<open>K \<subseteq> F\<close>]
       show "affine hull K \<inter> rel_interior C = {}"
         by fastforce
     qed
     let ?\<T> = "(\<Union>C \<in> \<N>. \<Union>K \<in> \<U> \<inter> Pow (rel_frontier C).
                      {convex hull (insert (SOME z. z \<in> rel_interior C) K)})"
     have "\<exists>\<T>. simplicial_complex \<T> \<and>
               (\<forall>K \<in> \<T>. aff_dim K \<le> of_nat n) \<and>
               (\<forall>C \<in> \<M>. \<exists>F. F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
               (\<forall>K \<in> \<T>. \<exists>C. C \<in> \<M> \<and> K \<subseteq> C)"
     proof (rule exI, intro conjI ballI)
       show "simplicial_complex (\<U> \<union> ?\<T>)"
         unfolding simplicial_complex_def
       proof (intro conjI impI ballI allI)
         show "finite (\<U> \<union> ?\<T>)"
           using \<open>finite \<U>\<close> \<open>finite \<N>\<close> by simp
         show "\<exists>n. n simplex S" if "S \<in> \<U> \<union> ?\<T>" for S
           using that ahK_C_disjoint in_rel_interior simpl\<U> simplex_insert_dimplus1 by fastforce
         show "F \<in> \<U> \<union> ?\<T>" if S: "S \<in> \<U> \<union> ?\<T> \<and> F face_of S" for F S
         proof -
           have "F \<in> \<U>" if "S \<in> \<U>"
             using S face\<U> that by blast
           moreover have "F \<in> \<U> \<union> ?\<T>"
             if "F face_of S" "C \<in> \<N>" "K \<in> \<U>" and "K \<subseteq> rel_frontier C"
               and S: "S = convex hull insert (SOME z. z \<in> rel_interior C) K" for C K
           proof -
             let ?z = "SOME z. z \<in> rel_interior C"
             have "?z \<in> rel_interior C"
               by (simp add: in_rel_interior \<open>C \<in> \<N>\<close>)
             moreover
             obtain I where "\<not> affine_dependent I" "card I \<le> n" "aff_dim K < int n" "K = convex hull I"
               using * [OF \<open>K \<in> \<U>\<close>] by auto
             ultimately have "?z \<notin> affine hull I"
               using ahK_C_disjoint affine_hull_convex_hull that by blast
             have "compact I" "finite I"
               by (auto simp: \<open>\<not> affine_dependent I\<close> aff_independent_finite finite_imp_compact)
             moreover have "F face_of convex hull insert ?z I"
               by (metis S \<open>F face_of S\<close> \<open>K = convex hull I\<close> convex_hull_eq_empty convex_hull_insert_segments hull_hull)
             ultimately obtain J where "J \<subseteq> insert ?z I" "F = convex hull J"
               using face_of_convex_hull_subset [of "insert ?z I" F] by auto
             show ?thesis
             proof (cases "?z \<in> J")
               case True
               have "F \<in> (\<Union>K\<in>\<U> \<inter> Pow (rel_frontier C). {convex hull insert ?z K})"
               proof
                 have "convex hull (J - {?z}) face_of K"
                   by (metis True \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> \<open>\<not> affine_dependent I\<close> face_of_convex_hull_affine_independent subset_insert_iff)
                 then have "convex hull (J - {?z}) \<in> \<U>"
                   by (rule face\<U> [OF \<open>K \<in> \<U>\<close>])
                 moreover
                 have "\<And>x. x \<in> convex hull (J - {?z}) \<Longrightarrow> x \<in> rel_frontier C"
                   by (metis True \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> subsetD hull_mono subset_insert_iff that(4))
                 ultimately show "convex hull (J - {?z}) \<in> \<U> \<inter> Pow (rel_frontier C)" by auto
                 let ?F = "convex hull insert ?z (convex hull (J - {?z}))"
                 have "F \<subseteq> ?F"
                   apply (clarsimp simp: \<open>F = convex hull J\<close>)
                   by (metis True subsetD hull_mono hull_subset subset_insert_iff)
                 moreover have "?F \<subseteq> F"
                   apply (clarsimp simp: \<open>F = convex hull J\<close>)
                   by (metis (no_types, lifting) True convex_hull_eq_empty convex_hull_insert_segments hull_hull insert_Diff)
                 ultimately
                 show "F \<in> {?F}" by auto
               qed
               with \<open>C\<in>\<N>\<close> show ?thesis by auto
             next
               case False
               then have "F \<in> \<U>"
                 using face_of_convex_hull_affine_independent [OF \<open>\<not> affine_dependent I\<close>]
                 by (metis Int_absorb2 Int_insert_right_if0 \<open>F = convex hull J\<close> \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> face\<U> inf_le2 \<open>K \<in> \<U>\<close>)
               then show "F \<in> \<U> \<union> ?\<T>"
                 by blast
             qed
           qed
           ultimately show ?thesis
             using that by auto
         qed
         have \<section>: "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
           if XY: "X \<in> \<U>" "Y \<in> ?\<T>" for X Y
         proof -
           obtain C K
             where "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C"
               and Y: "Y = convex hull insert (SOME z. z \<in> rel_interior C) K"
             using XY by blast
           have "convex C"
             by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
           have "K \<subseteq> C"
             by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed rel_frontier_def subset_iff)
           let ?z = "(SOME z. z \<in> rel_interior C)"
           have z: "?z \<in> rel_interior C"
             using \<open>C \<in> \<N>\<close> in_rel_interior by blast
           obtain D where "D \<in> \<S>" "X \<subseteq> D"
             using C\<U> \<open>X \<in> \<U>\<close> by blast
           have "D \<inter> rel_interior C = (C \<inter> D) \<inter> rel_interior C"
             using rel_interior_subset by blast
           also have "(C \<inter> D) \<inter> rel_interior C = {}"
           proof (rule face_of_disjoint_rel_interior)
             show "C \<inter> D face_of C"
               using \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<S>\<close> intface\<M> by blast
             show "C \<inter> D \<noteq> C"
               by (metis (mono_tags, lifting) Int_lower2 \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<S>\<close> aff_dim_subset mem_Collect_eq not_le)
           qed
           finally have DC: "D \<inter> rel_interior C = {}" .
           have eq: "X \<inter> convex hull (insert ?z K) = X \<inter> convex hull K"
             apply (rule Int_convex_hull_insert_rel_exterior [OF \<open>convex C\<close> \<open>K \<subseteq> C\<close> z])
             using DC by (meson \<open>X \<subseteq> D\<close> disjnt_def disjnt_subset1)
           obtain I where I: "\<not> affine_dependent I"
             and Keq: "K = convex hull I" and [simp]: "convex hull K = K"
             using "*" \<open>K \<in> \<U>\<close> by force
           then have "?z \<notin> affine hull I"
             using ahK_C_disjoint \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>K \<subseteq> rel_frontier C\<close> affine_hull_convex_hull z by blast
           have "X \<inter> K face_of K"
             by (simp add: XY(1) \<open>K \<in> \<U>\<close> faceI\<U> inf_commute)
           also have "... face_of convex hull insert ?z K"
             by (metis I Keq \<open>?z \<notin> affine hull I\<close> aff_independent_finite convex_convex_hull face_of_convex_hull_insert face_of_refl hull_insert)
           finally have "X \<inter> K face_of convex hull insert ?z K" .
           then show ?thesis
             by (simp add: XY(1) Y \<open>K \<in> \<U>\<close> eq faceI\<U>)
         qed
 
         show "S \<inter> S' face_of S"
           if "S \<in> \<U> \<union> ?\<T> \<and> S' \<in> \<U> \<union> ?\<T>" for S S'
           using that
         proof (elim conjE UnE)
           fix X Y
           assume "X \<in> \<U>" and "Y \<in> \<U>"
           then show "X \<inter> Y face_of X"
             by (simp add: faceI\<U>)
         next
           fix X Y
           assume XY: "X \<in> \<U>" "Y \<in> ?\<T>"
           then show "X \<inter> Y face_of X" "Y \<inter> X face_of Y"
             using \<section> [OF XY] by (auto simp: Int_commute)
         next
           fix X Y
           assume XY: "X \<in> ?\<T>" "Y \<in> ?\<T>"
           show "X \<inter> Y face_of X"
           proof -
             obtain C K D L
               where "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C"
                 and X: "X = convex hull insert (SOME z. z \<in> rel_interior C) K"
                 and "D \<in> \<N>" "L \<in> \<U>" "L \<subseteq> rel_frontier D"
                 and Y: "Y = convex hull insert (SOME z. z \<in> rel_interior D) L"
               using XY by blast
             let ?z = "(SOME z. z \<in> rel_interior C)"
             have z: "?z \<in> rel_interior C"
               using \<open>C \<in> \<N>\<close> in_rel_interior by blast
             have "convex C"
               by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
             have "convex K"
               using "*" \<open>K \<in> \<U>\<close> by blast
             have "convex L"
               by (meson \<open>L \<in> \<U>\<close> convex_simplex simpl\<U>)
             show ?thesis
             proof (cases "D=C")
               case True
               then have "L \<subseteq> rel_frontier C"
                 using \<open>L \<subseteq> rel_frontier D\<close> by auto
               show ?thesis
                 apply (simp add: X Y True)
                 apply (simp add: convex_hull_insert_Int_eq [OF z] \<open>K \<subseteq> rel_frontier C\<close> \<open>L \<subseteq> rel_frontier C\<close> \<open>convex C\<close> \<open>convex K\<close> \<open>convex L\<close>)
                 using face_of_polytope_insert2
                 by (metis "*" IntI \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close>\<open>K \<subseteq> rel_frontier C\<close> \<open>L \<subseteq> rel_frontier C\<close> aff_independent_finite ahK_C_disjoint empty_iff faceI\<U> polytope_convex_hull z)
             next
               case False
               have "convex D"
                 by (simp add: \<open>D \<in> \<N>\<close> convex\<N>)
               have "K \<subseteq> C"
                 by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed rel_frontier_def subset_eq)
               have "L \<subseteq> D"
                 by (metis DiffE \<open>D \<in> \<N>\<close> \<open>L \<subseteq> rel_frontier D\<close> closed\<N> closure_closed rel_frontier_def subset_eq)
               let ?w = "(SOME w. w \<in> rel_interior D)"
               have w: "?w \<in> rel_interior D"
                 using \<open>D \<in> \<N>\<close> in_rel_interior by blast
               have "C \<inter> rel_interior D = (D \<inter> C) \<inter> rel_interior D"
                 using rel_interior_subset by blast
               also have "(D \<inter> C) \<inter> rel_interior D = {}"
               proof (rule face_of_disjoint_rel_interior)
                 show "D \<inter> C face_of D"
                   using \<N>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<N>\<close> intface\<M> by blast
                 have "D \<in> \<M> \<and> aff_dim D = int n"
                   using \<N>_def \<open>D \<in> \<N>\<close> by blast
                 moreover have "C \<in> \<M> \<and> aff_dim C = int n"
                   using \<N>_def \<open>C \<in> \<N>\<close> by blast
                 ultimately show "D \<inter> C \<noteq> D"
                   by (metis Int_commute False face_of_aff_dim_lt inf.idem inf_le1 intface\<M> not_le poly\<M> polytope_imp_convex)
               qed
               finally have CD: "C \<inter> (rel_interior D) = {}" .
               have zKC: "(convex hull insert ?z K) \<subseteq> C"
                 by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed convex\<N> hull_minimal insert_subset rel_frontier_def rel_interior_subset subset_iff z)
               have eq: "convex hull (insert ?z K) \<inter> convex hull (insert ?w L) =
                           convex hull (insert ?z K) \<inter> convex hull L"
                 apply (rule Int_convex_hull_insert_rel_exterior [OF \<open>convex D\<close> \<open>L \<subseteq> D\<close> w])
                 using zKC CD apply (force simp: disjnt_def)
                 done
               have ch_id: "convex hull K = K" "convex hull L = L"
                 using "*" \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> hull_same by auto
               have "convex C"
                 by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
               have "convex hull (insert ?z K) \<inter> L = L \<inter> convex hull (insert ?z K)"
                 by blast
               also have "... = convex hull K \<inter> L"
               proof (subst Int_convex_hull_insert_rel_exterior [OF \<open>convex C\<close> \<open>K \<subseteq> C\<close> z])
                 have "(C \<inter> D) \<inter> rel_interior C = {}"
                 proof (rule face_of_disjoint_rel_interior)
                   show "C \<inter> D face_of C"
                     using \<N>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<N>\<close> intface\<M> by blast
                   have "D \<in> \<M>" "aff_dim D = int n"
                     using \<N>_def \<open>D \<in> \<N>\<close> by fastforce+
                   moreover have "C \<in> \<M>" "aff_dim C = int n"
                     using \<N>_def \<open>C \<in> \<N>\<close> by fastforce+
                   ultimately have "aff_dim D + - 1 * aff_dim C \<le> 0"
                     by fastforce
                   then have "\<not> C face_of D"
                     using False \<open>convex D\<close> face_of_aff_dim_lt by fastforce
                   show "C \<inter> D \<noteq> C"
                     by (metis inf_commute \<open>C \<in> \<M>\<close> \<open>D \<in> \<M>\<close> \<open>\<not> C face_of D\<close> intface\<M>)
                 qed
                 then have "D \<inter> rel_interior C = {}"
                   by (metis inf.absorb_iff2 inf_assoc inf_sup_aci(1) rel_interior_subset)
                 then show "disjnt L (rel_interior C)"
                   by (meson \<open>L \<subseteq> D\<close> disjnt_def disjnt_subset1)
               next
                 show "L \<inter> convex hull K = convex hull K \<inter> L"
                   by force
               qed
               finally have chKL: "convex hull (insert ?z K) \<inter> L = convex hull K \<inter> L" .
               have "convex hull insert ?z K \<inter> convex hull L face_of K"
                 by (simp add: \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> ch_id chKL faceI\<U>)
               also have "... face_of convex hull insert ?z K"
               proof -
                 obtain I where I: "\<not> affine_dependent I" "K = convex hull I"
                   using * [OF \<open>K \<in> \<U>\<close>] by auto
                 then have "\<And>a. a \<notin> rel_interior C \<or> a \<notin> affine hull I"
                   using ahK_C_disjoint \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>K \<subseteq> rel_frontier C\<close> affine_hull_convex_hull by blast
                 then show ?thesis
                   by (metis I affine_independent_insert face_of_convex_hull_affine_independent hull_insert subset_insertI z)
               qed
               finally have 1: "convex hull insert ?z K \<inter> convex hull L face_of convex hull insert ?z K" .
               have "convex hull insert ?z K \<inter> convex hull L face_of L"
                 by (metis \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> chKL ch_id faceI\<U> inf_commute)
               also have "... face_of convex hull insert ?w L"
               proof -
                 obtain I where I: "\<not> affine_dependent I" "L = convex hull I"
                   using * [OF \<open>L \<in> \<U>\<close>] by auto
                 then have "\<And>a. a \<notin> rel_interior D \<or> a \<notin> affine hull I"
                   using \<open>D \<in> \<N>\<close> \<open>L \<in> \<U>\<close> \<open>L \<subseteq> rel_frontier D\<close> affine_hull_convex_hull ahK_C_disjoint by blast
                 then show ?thesis
                   by (metis I aff_independent_finite convex_convex_hull face_of_convex_hull_insert face_of_refl hull_insert w)
               qed
               finally have 2: "convex hull insert ?z K \<inter> convex hull L face_of convex hull insert ?w L" .
               show ?thesis
                 by (simp add: X Y eq 1 2)
             qed
           qed
         qed 
       qed
       show "\<exists>F \<subseteq> \<U> \<union> ?\<T>. C = \<Union>F" if "C \<in> \<M>" for C
       proof (cases "C \<in> \<S>")
         case True
         then show ?thesis
           by (meson UnCI fin\<U> subsetD subsetI)
       next
         case False
         then have "C \<in> \<N>"
           by (simp add: \<N>_def \<S>_def aff\<M> less_le that)
         let ?z = "SOME z. z \<in> rel_interior C"
         have z: "?z \<in> rel_interior C"
           using \<open>C \<in> \<N>\<close> in_rel_interior by blast
         let ?F = "\<Union>K \<in> \<U> \<inter> Pow (rel_frontier C). {convex hull (insert ?z K)}"
         have "?F \<subseteq> ?\<T>"
           using \<open>C \<in> \<N>\<close> by blast
         moreover have "C \<subseteq> \<Union>?F"
         proof
           fix x
           assume "x \<in> C"
           have "convex C"
             using \<open>C \<in> \<N>\<close> convex\<N> by blast
           have "bounded C"
             using \<open>C \<in> \<N>\<close> by (simp add: poly\<M> polytope_imp_bounded that)
           have "polytope C"
             using \<open>C \<in> \<N>\<close> poly\<N> by auto
           have "\<not> (?z = x \<and> C = {?z})"
             using \<open>C \<in> \<N>\<close> aff_dim_sing [of ?z] \<open>\<not> n \<le> 1\<close> by (force simp: \<N>_def)
           then obtain y where y: "y \<in> rel_frontier C" and xzy: "x \<in> closed_segment ?z y"
             and sub: "open_segment ?z y \<subseteq> rel_interior C"
             by (blast intro: segment_to_rel_frontier [OF \<open>convex C\<close> \<open>bounded C\<close> z \<open>x \<in> C\<close>])
           then obtain F where "y \<in> F" "F face_of C" "F \<noteq> C"
             by (auto simp: rel_frontier_of_polyhedron_alt [OF polytope_imp_polyhedron [OF \<open>polytope C\<close>]])
           then obtain \<G> where "finite \<G>" "\<G> \<subseteq> \<U>" "F = \<Union>\<G>"
             by (metis (mono_tags, lifting) \<S>_def \<open>C \<in> \<M>\<close> \<open>convex C\<close> aff\<M> face\<M> face_of_aff_dim_lt fin\<U> le_less_trans mem_Collect_eq not_less)
           then obtain K where "y \<in> K" "K \<in> \<G>"
             using \<open>y \<in> F\<close> by blast
           moreover have x: "x \<in> convex hull {?z,y}"
             using segment_convex_hull xzy by auto
           moreover have "convex hull {?z,y} \<subseteq> convex hull insert ?z K"
             by (metis (full_types) \<open>y \<in> K\<close> hull_mono empty_subsetI insertCI insert_subset)
           moreover have "K \<in> \<U>"
             using \<open>K \<in> \<G>\<close> \<open>\<G> \<subseteq> \<U>\<close> by blast
           moreover have "K \<subseteq> rel_frontier C"
             using \<open>F = \<Union>\<G>\<close> \<open>F \<noteq> C\<close> \<open>F face_of C\<close> \<open>K \<in> \<G>\<close> face_of_subset_rel_frontier by fastforce
           ultimately show "x \<in> \<Union>?F"
             by force
         qed
         moreover
         have "convex hull insert (SOME z. z \<in> rel_interior C) K \<subseteq> C"
           if "K \<in> \<U>" "K \<subseteq> rel_frontier C" for K
         proof (rule hull_minimal)
           show "insert (SOME z. z \<in> rel_interior C) K \<subseteq> C"
             using that \<open>C \<in> \<N>\<close> in_rel_interior rel_interior_subset
             by (force simp: closure_eq rel_frontier_def closed\<N>)
           show "convex C"
             by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
         qed
         then have "\<Union>?F \<subseteq> C"
           by auto
         ultimately show ?thesis
           by blast
       qed
 
       have "(\<exists>C. C \<in> \<M> \<and> L \<subseteq> C) \<and> aff_dim L \<le> int n"  if "L \<in> \<U> \<union> ?\<T>" for L
         using that
       proof
         assume "L \<in> \<U>"
         then show ?thesis
           using C\<U> \<S>_def "*" by fastforce
       next
         assume "L \<in> ?\<T>"
         then obtain C K where "C \<in> \<N>"
           and L: "L = convex hull insert (SOME z. z \<in> rel_interior C) K"
           and K: "K \<in> \<U>" "K \<subseteq> rel_frontier C"
           by auto
         then have "convex hull C = C"
           by (meson convex\<N> convex_hull_eq)
         then have "convex C"
           by (metis (no_types) convex_convex_hull)
         have "rel_frontier C \<subseteq> C"
           by (metis DiffE closed\<N> \<open>C \<in> \<N>\<close> closure_closed rel_frontier_def subsetI)
         have "K \<subseteq> C"
           using K \<open>rel_frontier C \<subseteq> C\<close> by blast
         have "C \<in> \<M>"
           using \<N>_def \<open>C \<in> \<N>\<close> by auto
         moreover have "L \<subseteq> C"
           using K L \<open>C \<in> \<N>\<close>
           by (metis \<open>K \<subseteq> C\<close> \<open>convex hull C = C\<close> contra_subsetD hull_mono in_rel_interior insert_subset rel_interior_subset)
         ultimately show ?thesis
           using \<open>rel_frontier C \<subseteq> C\<close> \<open>L \<subseteq> C\<close> aff\<M> aff_dim_subset \<open>C \<in> \<M>\<close> dual_order.trans by blast
       qed
       then show "\<exists>C. C \<in> \<M> \<and> L \<subseteq> C" "aff_dim L \<le> int n" if "L \<in> \<U> \<union> ?\<T>" for L
         using that by auto
     qed
     then show ?thesis
       apply (rule ex_forward, safe)
         apply (meson Union_iff subsetCE, fastforce)
       by (meson infinite_super simplicial_complex_def)
   qed
 qed
 
 
 lemma simplicial_subdivision_of_cell_complex_lowdim:
   assumes "finite \<M>"
       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
       and aff: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> d"
   obtains \<T> where "simplicial_complex \<T>" "\<And>K. K \<in> \<T> \<Longrightarrow> aff_dim K \<le> d"
                   "\<Union>\<T> = \<Union>\<M>"
                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
 proof (cases "d \<ge> 0")
   case True
   then obtain n where n: "d = of_nat n"
     using zero_le_imp_eq_int by blast
   have "\<exists>\<T>. simplicial_complex \<T> \<and>
             (\<forall>K\<in>\<T>. aff_dim K \<le> int n) \<and>
             \<Union>\<T> = \<Union>(\<Union>C\<in>\<M>. {F. F face_of C}) \<and>
             (\<forall>C\<in>\<Union>C\<in>\<M>. {F. F face_of C}.
                 \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
             (\<forall>K\<in>\<T>. \<exists>C. C \<in> (\<Union>C\<in>\<M>. {F. F face_of C}) \<and> K \<subseteq> C)"
   proof (rule simplicial_subdivision_aux)
     show "finite (\<Union>C\<in>\<M>. {F. F face_of C})"
       using \<open>finite \<M>\<close> poly polyhedron_eq_finite_faces polytope_imp_polyhedron by fastforce
     show "polytope F" if "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" for F
       using poly that face_of_polytope_polytope by blast
     show "aff_dim F \<le> int n" if "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" for F
       using that
       by clarify (metis n aff_dim_subset aff face_of_imp_subset order_trans)
     show "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})"
       if "G \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" and "F face_of G" for F G
       using that face_of_trans by blast
   next
     fix F1 F2
     assume "F1 \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" and "F2 \<in> (\<Union>C\<in>\<M>. {F. F face_of C})"
     then obtain C1 C2 where "C1 \<in> \<M>" "C2 \<in> \<M>" and F: "F1 face_of C1" "F2 face_of C2"
       by auto
     show "F1 \<inter> F2 face_of F1"
       using face_of_Int_subface [OF _ _ F]
       by (metis \<open>C1 \<in> \<M>\<close> \<open>C2 \<in> \<M>\<close> face inf_commute)
   qed
   moreover
   have "\<Union>(\<Union>C\<in>\<M>. {F. F face_of C}) = \<Union>\<M>"
     using face_of_imp_subset face by blast
   ultimately show ?thesis
     apply clarify
     apply (rule that, assumption+)
        using n apply blast
       apply (simp_all add: poly face_of_refl polytope_imp_convex)
     using face_of_imp_subset by fastforce
 next
   case False
   then have m1: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C = -1"
     by (metis aff aff_dim_empty_eq aff_dim_negative_iff dual_order.trans not_less)
   then have face\<M>: "\<And>F S. \<lbrakk>S \<in> \<M>; F face_of S\<rbrakk> \<Longrightarrow> F \<in> \<M>"
     by (metis aff_dim_empty face_of_empty)
   show ?thesis
   proof
     have "\<And>S. S \<in> \<M> \<Longrightarrow> \<exists>n. n simplex S"
       by (metis (no_types) m1 aff_dim_empty simplex_minus_1)
     then show "simplicial_complex \<M>"
       by (auto simp: simplicial_complex_def \<open>finite \<M>\<close> face intro: face\<M>)
     show "aff_dim K \<le> d" if "K \<in> \<M>" for K
       by (simp add: that aff)
     show "\<exists>F. finite F \<and> F \<subseteq> \<M> \<and> C = \<Union>F" if "C \<in> \<M>" for C
       using \<open>C \<in> \<M>\<close> equals0I by auto
     show "\<exists>C. C \<in> \<M> \<and> K \<subseteq> C" if "K \<in> \<M>" for K
       using \<open>K \<in> \<M>\<close> by blast
   qed auto
 qed
 
 proposition simplicial_subdivision_of_cell_complex:
   assumes "finite \<M>"
       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
   obtains \<T> where "simplicial_complex \<T>"
                   "\<Union>\<T> = \<Union>\<M>"
                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
   by (blast intro: simplicial_subdivision_of_cell_complex_lowdim [OF assms aff_dim_le_DIM])
 
 corollary fine_simplicial_subdivision_of_cell_complex:
   assumes "0 < e" "finite \<M>"
       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
   obtains \<T> where "simplicial_complex \<T>"
                   "\<And>K. K \<in> \<T> \<Longrightarrow> diameter K < e"
                   "\<Union>\<T> = \<Union>\<M>"
                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
 proof -
   obtain \<N> where \<N>: "finite \<N>" "\<Union>\<N> = \<Union>\<M>" 
               and diapoly: "\<And>X. X \<in> \<N> \<Longrightarrow> diameter X < e" "\<And>X. X \<in> \<N> \<Longrightarrow> polytope X"
                and      "\<And>X Y. \<lbrakk>X \<in> \<N>; Y \<in> \<N>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X"
                and \<N>covers: "\<And>C x. C \<in> \<M> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<N> \<and> x \<in> D \<and> D \<subseteq> C"
                and \<N>covered: "\<And>C. C \<in> \<N> \<Longrightarrow> \<exists>D. D \<in> \<M> \<and> C \<subseteq> D"
     by (blast intro: cell_complex_subdivision_exists [OF \<open>0 < e\<close> \<open>finite \<M>\<close> poly aff_dim_le_DIM face])
   then obtain \<T> where \<T>: "simplicial_complex \<T>" "\<Union>\<T> = \<Union>\<N>"
                    and \<T>covers: "\<And>C. C \<in> \<N> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
                    and \<T>covered: "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<N> \<and> K \<subseteq> C"
     using simplicial_subdivision_of_cell_complex [OF \<open>finite \<N>\<close>] by metis
   show ?thesis
   proof
     show "simplicial_complex \<T>"
       by (rule \<T>)
     show "diameter K < e" if "K \<in> \<T>" for K
       by (metis le_less_trans diapoly \<T>covered diameter_subset polytope_imp_bounded that)
     show "\<Union>\<T> = \<Union>\<M>"
       by (simp add: \<N>(2) \<open>\<Union>\<T> = \<Union>\<N>\<close>)
     show "\<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F" if "C \<in> \<M>" for C
     proof -
       { fix x
         assume "x \<in> C"
         then obtain D where "D \<in> \<T>" "x \<in> D" "D \<subseteq> C"
           using \<N>covers \<open>C \<in> \<M>\<close> \<T>covers by force
         then have "\<exists>X\<in>\<T> \<inter> Pow C. x \<in> X"
           using \<open>D \<in> \<T>\<close> \<open>D \<subseteq> C\<close> \<open>x \<in> D\<close> by blast
       }
       moreover
       have "finite (\<T> \<inter> Pow C)"
         using \<open>simplicial_complex \<T>\<close> simplicial_complex_def by auto
       ultimately show ?thesis
         by (rule_tac x="(\<T> \<inter> Pow C)" in exI) auto
     qed
     show "\<exists>C. C \<in> \<M> \<and> K \<subseteq> C" if "K \<in> \<T>" for K
       by (meson \<N>covered \<T>covered order_trans that)
   qed
 qed
 
 subsection\<open>Some results on cell division with full-dimensional cells only\<close>
 
 lemma convex_Union_fulldim_cells:
   assumes "finite \<S>" and clo: "\<And>C. C \<in> \<S> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<S> \<Longrightarrow> convex C"
       and eq: "\<Union>\<S> = U"and  "convex U"
  shows "\<Union>{C \<in> \<S>. aff_dim C = aff_dim U} = U"  (is "?lhs = U")
 proof -
   have "closed U"
     using \<open>finite \<S>\<close> clo eq by blast
   have "?lhs \<subseteq> U"
     using eq by blast
   moreover have "U \<subseteq> ?lhs"
   proof (cases "\<forall>C \<in> \<S>. aff_dim C = aff_dim U")
     case True
     then show ?thesis
       using eq by blast
   next
     case False
     have "closed ?lhs"
       by (simp add: \<open>finite \<S>\<close> clo closed_Union)
     moreover have "U \<subseteq> closure ?lhs"
     proof -
       have "U \<subseteq> closure(\<Inter>{U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U})"
       proof (rule Baire [OF \<open>closed U\<close>])
         show "countable {U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U}"
           using \<open>finite \<S>\<close> uncountable_infinite by fastforce
         have "\<And>C. C \<in> \<S> \<Longrightarrow> openin (top_of_set U) (U-C)"
           by (metis Sup_upper clo closed_limpt closedin_limpt eq openin_diff openin_subtopology_self)
         then show "openin (top_of_set U) T \<and> U \<subseteq> closure T"
           if "T \<in> {U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U}" for T
           using that dense_complement_convex_closed \<open>closed U\<close> \<open>convex U\<close> by auto
       qed
       also have "... \<subseteq> closure ?lhs"
       proof -
         obtain C where "C \<in> \<S>" "aff_dim C < aff_dim U"
           by (metis False Sup_upper aff_dim_subset eq eq_iff not_le)
         have "\<exists>X. X \<in> \<S> \<and> aff_dim X = aff_dim U \<and> x \<in> X"
           if "\<And>V. (\<exists>C. V = U - C \<and> C \<in> \<S> \<and> aff_dim C < aff_dim U) \<Longrightarrow> x \<in> V" for x
         proof -
           have "x \<in> U \<and> x \<in> \<Union>\<S>"
             using \<open>C \<in> \<S>\<close> \<open>aff_dim C < aff_dim U\<close> eq that by blast
           then show ?thesis
             by (metis Diff_iff Sup_upper Union_iff aff_dim_subset dual_order.order_iff_strict eq that)
         qed
         then show ?thesis
           by (auto intro!: closure_mono)
       qed
       finally show ?thesis .
     qed
     ultimately show ?thesis
       using closure_subset_eq by blast
   qed
   ultimately show ?thesis by blast
 qed
 
 proposition fine_triangular_subdivision_of_cell_complex:
   assumes "0 < e" "finite \<M>"
       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
       and aff: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C = d"
       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1"
   obtains \<T> where "triangulation \<T>" "\<And>k. k \<in> \<T> \<Longrightarrow> diameter k < e"
                  "\<And>k. k \<in> \<T> \<Longrightarrow> aff_dim k = d" "\<Union>\<T> = \<Union>\<M>"
                  "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>f. finite f \<and> f \<subseteq> \<T> \<and> C = \<Union>f"
                  "\<And>k. k \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> k \<subseteq> C"
 proof -
   obtain \<T> where "simplicial_complex \<T>"
              and dia\<T>: "\<And>K. K \<in> \<T> \<Longrightarrow> diameter K < e"
              and "\<Union>\<T> = \<Union>\<M>"
              and in\<M>: "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
              and in\<T>: "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
     by (blast intro: fine_simplicial_subdivision_of_cell_complex [OF \<open>e > 0\<close> \<open>finite \<M>\<close> poly face])
   let ?\<T> = "{K \<in> \<T>. aff_dim K = d}"
   show thesis
   proof
     show "triangulation ?\<T>"
       using \<open>simplicial_complex \<T>\<close> by (auto simp: triangulation_def simplicial_complex_def)
     show "diameter L < e" if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
       using that by (auto simp: dia\<T>)
     show "aff_dim L = d" if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
       using that by auto
     show "\<exists>F. finite F \<and> F \<subseteq> {K \<in> \<T>. aff_dim K = d} \<and> C = \<Union>F" if "C \<in> \<M>" for C
     proof -
       obtain F where "finite F" "F \<subseteq> \<T>" "C = \<Union>F"
         using in\<M> [OF \<open>C \<in> \<M>\<close>] by auto
       show ?thesis
       proof (intro exI conjI)
         show "finite {K \<in> F. aff_dim K = d}"
           by (simp add: \<open>finite F\<close>)
         show "{K \<in> F. aff_dim K = d} \<subseteq> {K \<in> \<T>. aff_dim K = d}"
           using \<open>F \<subseteq> \<T>\<close> by blast
         have "d = aff_dim C"
           by (simp add: aff that)
         moreover have "\<And>K. K \<in> F \<Longrightarrow> closed K \<and> convex K"
           using \<open>simplicial_complex \<T>\<close> \<open>F \<subseteq> \<T>\<close>
           unfolding simplicial_complex_def by (metis subsetCE \<open>F \<subseteq> \<T>\<close> closed_simplex convex_simplex)
         moreover have "convex (\<Union>F)"
           using \<open>C = \<Union>F\<close> poly polytope_imp_convex that by blast
         ultimately show "C = \<Union>{K \<in> F. aff_dim K = d}"
           by (simp add: convex_Union_fulldim_cells \<open>C = \<Union>F\<close> \<open>finite F\<close>)
       qed
     qed
     then show "\<Union>{K \<in> \<T>. aff_dim K = d} = \<Union>\<M>"
       by auto (meson in\<T> subsetCE)
     show "\<exists>C. C \<in> \<M> \<and> L \<subseteq> C"
       if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
       using that by (auto simp: in\<T>)
   qed
 qed
 
 end
diff --git a/src/HOL/Library/Infinite_Set.thy b/src/HOL/Library/Infinite_Set.thy
--- a/src/HOL/Library/Infinite_Set.thy
+++ b/src/HOL/Library/Infinite_Set.thy
@@ -1,587 +1,588 @@
 (*  Title:      HOL/Library/Infinite_Set.thy
     Author:     Stephan Merz
 *)
 
 section \<open>Infinite Sets and Related Concepts\<close>
 
 theory Infinite_Set
   imports Main
 begin
 
 subsection \<open>The set of natural numbers is infinite\<close>
 
 lemma infinite_nat_iff_unbounded_le: "infinite S \<longleftrightarrow> (\<forall>m. \<exists>n\<ge>m. n \<in> S)"
   for S :: "nat set"
   using frequently_cofinite[of "\<lambda>x. x \<in> S"]
   by (simp add: cofinite_eq_sequentially frequently_def eventually_sequentially)
 
 lemma infinite_nat_iff_unbounded: "infinite S \<longleftrightarrow> (\<forall>m. \<exists>n>m. n \<in> S)"
   for S :: "nat set"
   using frequently_cofinite[of "\<lambda>x. x \<in> S"]
   by (simp add: cofinite_eq_sequentially frequently_def eventually_at_top_dense)
 
 lemma finite_nat_iff_bounded: "finite S \<longleftrightarrow> (\<exists>k. S \<subseteq> {..<k})"
   for S :: "nat set"
   using infinite_nat_iff_unbounded_le[of S] by (simp add: subset_eq) (metis not_le)
 
 lemma finite_nat_iff_bounded_le: "finite S \<longleftrightarrow> (\<exists>k. S \<subseteq> {.. k})"
   for S :: "nat set"
   using infinite_nat_iff_unbounded[of S] by (simp add: subset_eq) (metis not_le)
 
 lemma finite_nat_bounded: "finite S \<Longrightarrow> \<exists>k. S \<subseteq> {..<k}"
   for S :: "nat set"
   by (simp add: finite_nat_iff_bounded)
 
 
 text \<open>
   For a set of natural numbers to be infinite, it is enough to know
   that for any number larger than some \<open>k\<close>, there is some larger
   number that is an element of the set.
 \<close>
 
 lemma unbounded_k_infinite: "\<forall>m>k. \<exists>n>m. n \<in> S \<Longrightarrow> infinite (S::nat set)"
   apply (clarsimp simp add: finite_nat_set_iff_bounded)
   apply (drule_tac x="Suc (max m k)" in spec)
   using less_Suc_eq apply fastforce
   done
 
 lemma nat_not_finite: "finite (UNIV::nat set) \<Longrightarrow> R"
   by simp
 
 lemma range_inj_infinite:
   fixes f :: "nat \<Rightarrow> 'a"
   assumes "inj f"
   shows "infinite (range f)"
 proof
   assume "finite (range f)"
   from this assms have "finite (UNIV::nat set)"
     by (rule finite_imageD)
   then show False by simp
 qed
 
 
 subsection \<open>The set of integers is also infinite\<close>
 
 lemma infinite_int_iff_infinite_nat_abs: "infinite S \<longleftrightarrow> infinite ((nat \<circ> abs) ` S)"
   for S :: "int set"
 proof (unfold Not_eq_iff, rule iffI)
   assume "finite ((nat \<circ> abs) ` S)"
   then have "finite (nat ` (abs ` S))"
     by (simp add: image_image cong: image_cong)
   moreover have "inj_on nat (abs ` S)"
     by (rule inj_onI) auto
   ultimately have "finite (abs ` S)"
     by (rule finite_imageD)
   then show "finite S"
     by (rule finite_image_absD)
 qed simp
 
 proposition infinite_int_iff_unbounded_le: "infinite S \<longleftrightarrow> (\<forall>m. \<exists>n. \<bar>n\<bar> \<ge> m \<and> n \<in> S)"
   for S :: "int set"
   by (simp add: infinite_int_iff_infinite_nat_abs infinite_nat_iff_unbounded_le o_def image_def)
     (metis abs_ge_zero nat_le_eq_zle le_nat_iff)
 
 proposition infinite_int_iff_unbounded: "infinite S \<longleftrightarrow> (\<forall>m. \<exists>n. \<bar>n\<bar> > m \<and> n \<in> S)"
   for S :: "int set"
   by (simp add: infinite_int_iff_infinite_nat_abs infinite_nat_iff_unbounded o_def image_def)
     (metis (full_types) nat_le_iff nat_mono not_le)
 
 proposition finite_int_iff_bounded: "finite S \<longleftrightarrow> (\<exists>k. abs ` S \<subseteq> {..<k})"
   for S :: "int set"
   using infinite_int_iff_unbounded_le[of S] by (simp add: subset_eq) (metis not_le)
 
 proposition finite_int_iff_bounded_le: "finite S \<longleftrightarrow> (\<exists>k. abs ` S \<subseteq> {.. k})"
   for S :: "int set"
   using infinite_int_iff_unbounded[of S] by (simp add: subset_eq) (metis not_le)
 
 
 subsection \<open>Infinitely Many and Almost All\<close>
 
 text \<open>
   We often need to reason about the existence of infinitely many
   (resp., all but finitely many) objects satisfying some predicate, so
   we introduce corresponding binders and their proof rules.
 \<close>
 
 lemma not_INFM [simp]: "\<not> (INFM x. P x) \<longleftrightarrow> (MOST x. \<not> P x)"
   by (rule not_frequently)
 
 lemma not_MOST [simp]: "\<not> (MOST x. P x) \<longleftrightarrow> (INFM x. \<not> P x)"
   by (rule not_eventually)
 
 lemma INFM_const [simp]: "(INFM x::'a. P) \<longleftrightarrow> P \<and> infinite (UNIV::'a set)"
   by (simp add: frequently_const_iff)
 
 lemma MOST_const [simp]: "(MOST x::'a. P) \<longleftrightarrow> P \<or> finite (UNIV::'a set)"
   by (simp add: eventually_const_iff)
 
 lemma INFM_imp_distrib: "(INFM x. P x \<longrightarrow> Q x) \<longleftrightarrow> ((MOST x. P x) \<longrightarrow> (INFM x. Q x))"
   by (rule frequently_imp_iff)
 
 lemma MOST_imp_iff: "MOST x. P x \<Longrightarrow> (MOST x. P x \<longrightarrow> Q x) \<longleftrightarrow> (MOST x. Q x)"
   by (auto intro: eventually_rev_mp eventually_mono)
 
 lemma INFM_conjI: "INFM x. P x \<Longrightarrow> MOST x. Q x \<Longrightarrow> INFM x. P x \<and> Q x"
   by (rule frequently_rev_mp[of P]) (auto elim: eventually_mono)
 
 
 text \<open>Properties of quantifiers with injective functions.\<close>
 
 lemma INFM_inj: "INFM x. P (f x) \<Longrightarrow> inj f \<Longrightarrow> INFM x. P x"
   using finite_vimageI[of "{x. P x}" f] by (auto simp: frequently_cofinite)
 
 lemma MOST_inj: "MOST x. P x \<Longrightarrow> inj f \<Longrightarrow> MOST x. P (f x)"
   using finite_vimageI[of "{x. \<not> P x}" f] by (auto simp: eventually_cofinite)
 
 
 text \<open>Properties of quantifiers with singletons.\<close>
 
 lemma not_INFM_eq [simp]:
   "\<not> (INFM x. x = a)"
   "\<not> (INFM x. a = x)"
   unfolding frequently_cofinite by simp_all
 
 lemma MOST_neq [simp]:
   "MOST x. x \<noteq> a"
   "MOST x. a \<noteq> x"
   unfolding eventually_cofinite by simp_all
 
 lemma INFM_neq [simp]:
   "(INFM x::'a. x \<noteq> a) \<longleftrightarrow> infinite (UNIV::'a set)"
   "(INFM x::'a. a \<noteq> x) \<longleftrightarrow> infinite (UNIV::'a set)"
   unfolding frequently_cofinite by simp_all
 
 lemma MOST_eq [simp]:
   "(MOST x::'a. x = a) \<longleftrightarrow> finite (UNIV::'a set)"
   "(MOST x::'a. a = x) \<longleftrightarrow> finite (UNIV::'a set)"
   unfolding eventually_cofinite by simp_all
 
 lemma MOST_eq_imp:
   "MOST x. x = a \<longrightarrow> P x"
   "MOST x. a = x \<longrightarrow> P x"
   unfolding eventually_cofinite by simp_all
 
 
 text \<open>Properties of quantifiers over the naturals.\<close>
 
 lemma MOST_nat: "(\<forall>\<^sub>\<infinity>n. P n) \<longleftrightarrow> (\<exists>m. \<forall>n>m. P n)"
   for P :: "nat \<Rightarrow> bool"
   by (auto simp add: eventually_cofinite finite_nat_iff_bounded_le subset_eq simp flip: not_le)
 
 lemma MOST_nat_le: "(\<forall>\<^sub>\<infinity>n. P n) \<longleftrightarrow> (\<exists>m. \<forall>n\<ge>m. P n)"
   for P :: "nat \<Rightarrow> bool"
   by (auto simp add: eventually_cofinite finite_nat_iff_bounded subset_eq simp flip: not_le)
 
 lemma INFM_nat: "(\<exists>\<^sub>\<infinity>n. P n) \<longleftrightarrow> (\<forall>m. \<exists>n>m. P n)"
   for P :: "nat \<Rightarrow> bool"
   by (simp add: frequently_cofinite infinite_nat_iff_unbounded)
 
 lemma INFM_nat_le: "(\<exists>\<^sub>\<infinity>n. P n) \<longleftrightarrow> (\<forall>m. \<exists>n\<ge>m. P n)"
   for P :: "nat \<Rightarrow> bool"
   by (simp add: frequently_cofinite infinite_nat_iff_unbounded_le)
 
 lemma MOST_INFM: "infinite (UNIV::'a set) \<Longrightarrow> MOST x::'a. P x \<Longrightarrow> INFM x::'a. P x"
   by (simp add: eventually_frequently)
 
 lemma MOST_Suc_iff: "(MOST n. P (Suc n)) \<longleftrightarrow> (MOST n. P n)"
   by (simp add: cofinite_eq_sequentially)
 
 lemma MOST_SucI: "MOST n. P n \<Longrightarrow> MOST n. P (Suc n)"
   and MOST_SucD: "MOST n. P (Suc n) \<Longrightarrow> MOST n. P n"
   by (simp_all add: MOST_Suc_iff)
 
 lemma MOST_ge_nat: "MOST n::nat. m \<le> n"
   by (simp add: cofinite_eq_sequentially)
 
 \<comment> \<open>legacy names\<close>
 lemma Inf_many_def: "Inf_many P \<longleftrightarrow> infinite {x. P x}" by (fact frequently_cofinite)
 lemma Alm_all_def: "Alm_all P \<longleftrightarrow> \<not> (INFM x. \<not> P x)" by simp
 lemma INFM_iff_infinite: "(INFM x. P x) \<longleftrightarrow> infinite {x. P x}" by (fact frequently_cofinite)
 lemma MOST_iff_cofinite: "(MOST x. P x) \<longleftrightarrow> finite {x. \<not> P x}" by (fact eventually_cofinite)
 lemma INFM_EX: "(\<exists>\<^sub>\<infinity>x. P x) \<Longrightarrow> (\<exists>x. P x)" by (fact frequently_ex)
 lemma ALL_MOST: "\<forall>x. P x \<Longrightarrow> \<forall>\<^sub>\<infinity>x. P x" by (fact always_eventually)
 lemma INFM_mono: "\<exists>\<^sub>\<infinity>x. P x \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> \<exists>\<^sub>\<infinity>x. Q x" by (fact frequently_elim1)
 lemma MOST_mono: "\<forall>\<^sub>\<infinity>x. P x \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> \<forall>\<^sub>\<infinity>x. Q x" by (fact eventually_mono)
 lemma INFM_disj_distrib: "(\<exists>\<^sub>\<infinity>x. P x \<or> Q x) \<longleftrightarrow> (\<exists>\<^sub>\<infinity>x. P x) \<or> (\<exists>\<^sub>\<infinity>x. Q x)" by (fact frequently_disj_iff)
 lemma MOST_rev_mp: "\<forall>\<^sub>\<infinity>x. P x \<Longrightarrow> \<forall>\<^sub>\<infinity>x. P x \<longrightarrow> Q x \<Longrightarrow> \<forall>\<^sub>\<infinity>x. Q x" by (fact eventually_rev_mp)
 lemma MOST_conj_distrib: "(\<forall>\<^sub>\<infinity>x. P x \<and> Q x) \<longleftrightarrow> (\<forall>\<^sub>\<infinity>x. P x) \<and> (\<forall>\<^sub>\<infinity>x. Q x)" by (fact eventually_conj_iff)
 lemma MOST_conjI: "MOST x. P x \<Longrightarrow> MOST x. Q x \<Longrightarrow> MOST x. P x \<and> Q x" by (fact eventually_conj)
 lemma INFM_finite_Bex_distrib: "finite A \<Longrightarrow> (INFM y. \<exists>x\<in>A. P x y) \<longleftrightarrow> (\<exists>x\<in>A. INFM y. P x y)" by (fact frequently_bex_finite_distrib)
 lemma MOST_finite_Ball_distrib: "finite A \<Longrightarrow> (MOST y. \<forall>x\<in>A. P x y) \<longleftrightarrow> (\<forall>x\<in>A. MOST y. P x y)" by (fact eventually_ball_finite_distrib)
 lemma INFM_E: "INFM x. P x \<Longrightarrow> (\<And>x. P x \<Longrightarrow> thesis) \<Longrightarrow> thesis" by (fact frequentlyE)
 lemma MOST_I: "(\<And>x. P x) \<Longrightarrow> MOST x. P x" by (rule eventuallyI)
 lemmas MOST_iff_finiteNeg = MOST_iff_cofinite
 
 
 subsection \<open>Enumeration of an Infinite Set\<close>
 
 text \<open>The set's element type must be wellordered (e.g. the natural numbers).\<close>
 
 text \<open>
   Could be generalized to
     \<^prop>\<open>enumerate' S n = (SOME t. t \<in> s \<and> finite {s\<in>S. s < t} \<and> card {s\<in>S. s < t} = n)\<close>.
 \<close>
 
 primrec (in wellorder) enumerate :: "'a set \<Rightarrow> nat \<Rightarrow> 'a"
   where
     enumerate_0: "enumerate S 0 = (LEAST n. n \<in> S)"
   | enumerate_Suc: "enumerate S (Suc n) = enumerate (S - {LEAST n. n \<in> S}) n"
 
 lemma enumerate_Suc': "enumerate S (Suc n) = enumerate (S - {enumerate S 0}) n"
   by simp
 
 lemma enumerate_in_set: "infinite S \<Longrightarrow> enumerate S n \<in> S"
 proof (induct n arbitrary: S)
   case 0
   then show ?case
     by (fastforce intro: LeastI dest!: infinite_imp_nonempty)
 next
   case (Suc n)
   then show ?case
     by simp (metis DiffE infinite_remove)
 qed
 
 declare enumerate_0 [simp del] enumerate_Suc [simp del]
 
 lemma enumerate_step: "infinite S \<Longrightarrow> enumerate S n < enumerate S (Suc n)"
 proof (induction n arbitrary: S)
   case 0
   then have "enumerate S 0 \<le> enumerate S (Suc 0)"
     by (simp add: enumerate_0 Least_le enumerate_in_set)
   moreover have "enumerate (S - {enumerate S 0}) 0 \<in> S - {enumerate S 0}"
     by (meson "0.prems" enumerate_in_set infinite_remove)
   then have "enumerate S 0 \<noteq> enumerate (S - {enumerate S 0}) 0"
     by auto
   ultimately show ?case
     by (simp add: enumerate_Suc')
 next
   case (Suc n)
   then show ?case 
     by (simp add: enumerate_Suc')
 qed
 
 lemma enumerate_mono: "m < n \<Longrightarrow> infinite S \<Longrightarrow> enumerate S m < enumerate S n"
   by (induct m n rule: less_Suc_induct) (auto intro: enumerate_step)
 
 lemma le_enumerate:
   assumes S: "infinite S"
   shows "n \<le> enumerate S n"
   using S
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   then have "n \<le> enumerate S n" by simp
   also note enumerate_mono[of n "Suc n", OF _ \<open>infinite S\<close>]
   finally show ?case by simp
 qed
 
 lemma infinite_enumerate:
   assumes fS: "infinite S"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (\<forall>n. r n \<in> S)"
   unfolding strict_mono_def
   using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
 
 lemma enumerate_Suc'':
   fixes S :: "'a::wellorder set"
   assumes "infinite S"
   shows "enumerate S (Suc n) = (LEAST s. s \<in> S \<and> enumerate S n < s)"
   using assms
 proof (induct n arbitrary: S)
   case 0
   then have "\<forall>s \<in> S. enumerate S 0 \<le> s"
     by (auto simp: enumerate.simps intro: Least_le)
   then show ?case
     unfolding enumerate_Suc' enumerate_0[of "S - {enumerate S 0}"]
     by (intro arg_cong[where f = Least] ext) auto
 next
   case (Suc n S)
   show ?case
     using enumerate_mono[OF zero_less_Suc \<open>infinite S\<close>, of n] \<open>infinite S\<close>
     apply (subst (1 2) enumerate_Suc')
     apply (subst Suc)
      apply (use \<open>infinite S\<close> in simp)
     apply (intro arg_cong[where f = Least] ext)
     apply (auto simp flip: enumerate_Suc')
     done
 qed
 
 lemma enumerate_Ex:
   fixes S :: "nat set"
   assumes S: "infinite S"
     and s: "s \<in> S"
   shows "\<exists>n. enumerate S n = s"
   using s
 proof (induct s rule: less_induct)
   case (less s)
   show ?case
   proof (cases "\<exists>y\<in>S. y < s")
     case True
     let ?y = "Max {s'\<in>S. s' < s}"
     from True have y: "\<And>x. ?y < x \<longleftrightarrow> (\<forall>s'\<in>S. s' < s \<longrightarrow> s' < x)"
       by (subst Max_less_iff) auto
     then have y_in: "?y \<in> {s'\<in>S. s' < s}"
       by (intro Max_in) auto
     with less.hyps[of ?y] obtain n where "enumerate S n = ?y"
       by auto
     with S have "enumerate S (Suc n) = s"
       by (auto simp: y less enumerate_Suc'' intro!: Least_equality)
     then show ?thesis by auto
   next
     case False
     then have "\<forall>t\<in>S. s \<le> t" by auto
     with \<open>s \<in> S\<close> show ?thesis
       by (auto intro!: exI[of _ 0] Least_equality simp: enumerate_0)
   qed
 qed
 
 lemma inj_enumerate:
   fixes S :: "'a::wellorder set"
   assumes S: "infinite S"
   shows "inj (enumerate S)"
   unfolding inj_on_def
 proof clarsimp
   show "\<And>x y. enumerate S x = enumerate S y \<Longrightarrow> x = y"
     by (metis neq_iff enumerate_mono[OF _ \<open>infinite S\<close>]) 
 qed
 
 text \<open>To generalise this, we'd need a condition that all initial segments were finite\<close>
 lemma bij_enumerate:
   fixes S :: "nat set"
   assumes S: "infinite S"
   shows "bij_betw (enumerate S) UNIV S"
 proof -
   have "\<forall>s \<in> S. \<exists>i. enumerate S i = s"
     using enumerate_Ex[OF S] by auto
   moreover note \<open>infinite S\<close> inj_enumerate
   ultimately show ?thesis
     unfolding bij_betw_def by (auto intro: enumerate_in_set)
 qed
 
 text \<open>A pair of weird and wonderful lemmas from HOL Light.\<close>
 lemma finite_transitivity_chain:
   assumes "finite A"
     and R: "\<And>x. \<not> R x x" "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
     and A: "\<And>x. x \<in> A \<Longrightarrow> \<exists>y. y \<in> A \<and> R x y"
   shows "A = {}"
   using \<open>finite A\<close> A
 proof (induct A)
   case empty
   then show ?case by simp
 next
   case (insert a A)
-  with R show ?case
-    by (metis empty_iff insert_iff)   (* somewhat slow *)
+  have False
+    using R(1)[of a] R(2)[of _ a] insert(3,4) by blast   
+  thus ?case ..
 qed
 
 corollary Union_maximal_sets:
   assumes "finite \<F>"
   shows "\<Union>{T \<in> \<F>. \<forall>U\<in>\<F>. \<not> T \<subset> U} = \<Union>\<F>"
     (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs" by force
   show "?rhs \<subseteq> ?lhs"
   proof (rule Union_subsetI)
     fix S
     assume "S \<in> \<F>"
     have "{T \<in> \<F>. S \<subseteq> T} = {}"
       if "\<not> (\<exists>y. y \<in> {T \<in> \<F>. \<forall>U\<in>\<F>. \<not> T \<subset> U} \<and> S \<subseteq> y)"
     proof -
       have \<section>: "\<And>x. x \<in> \<F> \<and> S \<subseteq> x \<Longrightarrow> \<exists>y. y \<in> \<F> \<and> S \<subseteq> y \<and> x \<subset> y"
         using that by (blast intro: dual_order.trans psubset_imp_subset)
       show ?thesis
       proof (rule finite_transitivity_chain [of _ "\<lambda>T U. S \<subseteq> T \<and> T \<subset> U"])
       qed (use assms in \<open>auto intro: \<section>\<close>)
     qed
     with \<open>S \<in> \<F>\<close> show "\<exists>y. y \<in> {T \<in> \<F>. \<forall>U\<in>\<F>. \<not> T \<subset> U} \<and> S \<subseteq> y"
       by blast
   qed
 qed
 
 subsection \<open>Properties of @{term enumerate} on finite sets\<close>
 
 lemma finite_enumerate_in_set: "\<lbrakk>finite S; n < card S\<rbrakk> \<Longrightarrow> enumerate S n \<in> S"
 proof (induction n arbitrary: S)
   case 0
   then show ?case
     by (metis all_not_in_conv card_empty enumerate.simps(1) not_less0 wellorder_Least_lemma(1))
 next
   case (Suc n)
   show ?case
     using Suc.prems Suc.IH [of "S - {LEAST n. n \<in> S}"]
     apply (simp add: enumerate.simps)
     by (metis Diff_empty Diff_insert0 Suc_lessD card.remove less_Suc_eq)
 qed
 
 lemma finite_enumerate_step: "\<lbrakk>finite S; Suc n < card S\<rbrakk> \<Longrightarrow> enumerate S n < enumerate S (Suc n)"
 proof (induction n arbitrary: S)
   case 0
   then have "enumerate S 0 \<le> enumerate S (Suc 0)"
     by (simp add: Least_le enumerate.simps(1) finite_enumerate_in_set)
   moreover have "enumerate (S - {enumerate S 0}) 0 \<in> S - {enumerate S 0}"
     by (metis 0 Suc_lessD Suc_less_eq card_Suc_Diff1 enumerate_in_set finite_enumerate_in_set)
   then have "enumerate S 0 \<noteq> enumerate (S - {enumerate S 0}) 0"
     by auto
   ultimately show ?case
     by (simp add: enumerate_Suc')
 next
   case (Suc n)
   then show ?case
     by (simp add: enumerate_Suc' finite_enumerate_in_set)
 qed
 
 lemma finite_enumerate_mono: "\<lbrakk>m < n; finite S; n < card S\<rbrakk> \<Longrightarrow> enumerate S m < enumerate S n"
   by (induct m n rule: less_Suc_induct) (auto intro: finite_enumerate_step)
 
 
 lemma finite_le_enumerate:
   assumes "finite S" "n < card S"
   shows "n \<le> enumerate S n"
   using assms
 proof (induction n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   then have "n \<le> enumerate S n" by simp
   also note finite_enumerate_mono[of n "Suc n", OF _ \<open>finite S\<close>]
   finally show ?case
     using Suc.prems(2) Suc_leI by blast
 qed
 
 lemma finite_enumerate:
   assumes fS: "finite S"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono_on r {..<card S} \<and> (\<forall>n<card S. r n \<in> S)"
   unfolding strict_mono_def
   using finite_enumerate_in_set[OF fS] finite_enumerate_mono[of _ _ S] fS
   by (metis lessThan_iff strict_mono_on_def)
 
 lemma finite_enumerate_Suc'':
   fixes S :: "'a::wellorder set"
   assumes "finite S" "Suc n < card S"
   shows "enumerate S (Suc n) = (LEAST s. s \<in> S \<and> enumerate S n < s)"
   using assms
 proof (induction n arbitrary: S)
   case 0
   then have "\<forall>s \<in> S. enumerate S 0 \<le> s"
     by (auto simp: enumerate.simps intro: Least_le)
   then show ?case
     unfolding enumerate_Suc' enumerate_0[of "S - {enumerate S 0}"]
     by (metis Diff_iff dual_order.strict_iff_order singletonD singletonI)
 next
   case (Suc n S)
   then have "Suc n < card (S - {enumerate S 0})"
     using Suc.prems(2) finite_enumerate_in_set by force
   then show ?case
     apply (subst (1 2) enumerate_Suc')
     apply (simp add: Suc)
     apply (intro arg_cong[where f = Least] HOL.ext)
     using finite_enumerate_mono[OF zero_less_Suc \<open>finite S\<close>, of n] Suc.prems
     by (auto simp flip: enumerate_Suc')
 qed
 
 lemma finite_enumerate_initial_segment:
   fixes S :: "'a::wellorder set"
   assumes "finite S" "s \<in> S" and n: "n < card (S \<inter> {..<s})"
   shows "enumerate (S \<inter> {..<s}) n = enumerate S n"
   using n
 proof (induction n)
   case 0
   have "(LEAST n. n \<in> S \<and> n < s) = (LEAST n. n \<in> S)"
   proof (rule Least_equality)
     have "\<exists>t. t \<in> S \<and> t < s"
       by (metis "0" card_gt_0_iff disjoint_iff_not_equal lessThan_iff)
     then show "(LEAST n. n \<in> S) \<in> S \<and> (LEAST n. n \<in> S) < s"
       by (meson LeastI Least_le le_less_trans)
   qed (simp add: Least_le)
   then show ?case
     by (auto simp: enumerate_0)
 next
   case (Suc n)
   then have less_card: "Suc n < card S"
     by (meson assms(1) card_mono inf_sup_ord(1) leD le_less_linear order.trans)
   obtain t where t: "t \<in> {s \<in> S. enumerate S n < s}"
     by (metis Infinite_Set.enumerate_step enumerate_in_set finite_enumerate_in_set finite_enumerate_step less_card mem_Collect_eq)
   have "(LEAST x. x \<in> S \<and> x < s \<and> enumerate S n < x) = (LEAST s. s \<in> S \<and> enumerate S n < s)"
        (is "_ = ?r")
   proof (intro Least_equality conjI)
     show "?r \<in> S"
       by (metis (mono_tags, lifting) LeastI mem_Collect_eq t)
     show "?r < s"
       using not_less_Least [of _ "\<lambda>t. t \<in> S \<and> enumerate S n < t"] Suc assms 
       by (metis (no_types, lifting) Int_Collect Suc_lessD finite_Int finite_enumerate_in_set finite_enumerate_step lessThan_def linorder_cases)
     show "enumerate S n < ?r"
       by (metis (no_types, lifting) LeastI mem_Collect_eq t)
   qed (auto simp: Least_le)
   then show ?case
     using Suc assms by (simp add: finite_enumerate_Suc'' less_card)
 qed
 
 lemma finite_enumerate_Ex:
   fixes S :: "'a::wellorder set"
   assumes S: "finite S"
     and s: "s \<in> S"
   shows "\<exists>n<card S. enumerate S n = s"
   using s S
 proof (induction s arbitrary: S rule: less_induct)
   case (less s)
   show ?case
   proof (cases "\<exists>y\<in>S. y < s")
     case True
     let ?T = "S \<inter> {..<s}"
     have "finite ?T"
       using less.prems(2) by blast
     have TS: "card ?T < card S"
       using less.prems by (blast intro: psubset_card_mono [OF \<open>finite S\<close>])
     from True have y: "\<And>x. Max ?T < x \<longleftrightarrow> (\<forall>s'\<in>S. s' < s \<longrightarrow> s' < x)"
       by (subst Max_less_iff) (auto simp: \<open>finite ?T\<close>)
     then have y_in: "Max ?T \<in> {s'\<in>S. s' < s}"
       using Max_in \<open>finite ?T\<close> by fastforce
     with less.IH[of "Max ?T" ?T] obtain n where n: "enumerate ?T n = Max ?T" "n < card ?T"
       using \<open>finite ?T\<close> by blast
     then have "Suc n < card S"
       using TS less_trans_Suc by blast
     with S n have "enumerate S (Suc n) = s"
       by (subst finite_enumerate_Suc'') (auto simp: y finite_enumerate_initial_segment less finite_enumerate_Suc'' intro!: Least_equality)
     then show ?thesis
       using \<open>Suc n < card S\<close> by blast
   next
     case False
     then have "\<forall>t\<in>S. s \<le> t" by auto
     moreover have "0 < card S"
       using card_0_eq less.prems by blast
     ultimately show ?thesis
       using \<open>s \<in> S\<close>
       by (auto intro!: exI[of _ 0] Least_equality simp: enumerate_0)
   qed
 qed
 
 lemma finite_bij_enumerate:
   fixes S :: "'a::wellorder set"
   assumes S: "finite S"
   shows "bij_betw (enumerate S) {..<card S} S"
 proof -
   have "\<And>n m. \<lbrakk>n \<noteq> m; n < card S; m < card S\<rbrakk> \<Longrightarrow> enumerate S n \<noteq> enumerate S m"
     using finite_enumerate_mono[OF _ \<open>finite S\<close>] by (auto simp: neq_iff)
   then have "inj_on (enumerate S) {..<card S}"
     by (auto simp: inj_on_def)
   moreover have "\<forall>s \<in> S. \<exists>i<card S. enumerate S i = s"
     using finite_enumerate_Ex[OF S] by auto
   moreover note \<open>finite S\<close>
   ultimately show ?thesis
     unfolding bij_betw_def by (auto intro: finite_enumerate_in_set)
 qed
 
 lemma ex_bij_betw_strict_mono_card:
   fixes M :: "'a::wellorder set"
   assumes "finite M" 
   obtains h where "bij_betw h {..<card M} M" and "strict_mono_on h {..<card M}"
 proof
   show "bij_betw (enumerate M) {..<card M} M"
     by (simp add: assms finite_bij_enumerate)
   show "strict_mono_on (enumerate M) {..<card M}"
     by (simp add: assms finite_enumerate_mono strict_mono_on_def)
 qed
 
 end