diff --git a/src/HOL/Analysis/Abstract_Euclidean_Space.thy b/src/HOL/Analysis/Abstract_Euclidean_Space.thy
--- a/src/HOL/Analysis/Abstract_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Abstract_Euclidean_Space.thy
@@ -1,405 +1,405 @@
 (*  Author:  LCP, ported from HOL Light
 *)
 
 section\<open>Euclidean space and n-spheres, as subtopologies of n-dimensional space\<close>
 
 theory Abstract_Euclidean_Space
 imports Homotopy Locally
 begin
 
 subsection \<open>Euclidean spaces as abstract topologies\<close>
 
 definition Euclidean_space :: "nat \<Rightarrow> (nat \<Rightarrow> real) topology"
   where "Euclidean_space n \<equiv> subtopology (powertop_real UNIV) {x. \<forall>i\<ge>n. x i = 0}"
 
 lemma topspace_Euclidean_space:
    "topspace(Euclidean_space n) = {x. \<forall>i\<ge>n. x i = 0}"
   by (simp add: Euclidean_space_def)
 
 lemma nonempty_Euclidean_space: "topspace(Euclidean_space n) \<noteq> {}"
   by (force simp: topspace_Euclidean_space)
 
 lemma subset_Euclidean_space [simp]:
    "topspace(Euclidean_space m) \<subseteq> topspace(Euclidean_space n) \<longleftrightarrow> m \<le> n"
   apply (simp add: topspace_Euclidean_space subset_iff, safe)
    apply (drule_tac x="(\<lambda>i. if i < m then 1 else 0)" in spec)
    apply auto
   using not_less by fastforce
 
 lemma topspace_Euclidean_space_alt:
   "topspace(Euclidean_space n) = (\<Inter>i \<in> {n..}. {x. x \<in> topspace(powertop_real UNIV) \<and> x i \<in> {0}})"
   by (auto simp: topspace_Euclidean_space)
 
 lemma closedin_Euclidean_space:
   "closedin (powertop_real UNIV) (topspace(Euclidean_space n))"
 proof -
   have "closedin (powertop_real UNIV) {x. x i = 0}" if "n \<le> i" for i
   proof -
     have "closedin (powertop_real UNIV) {x \<in> topspace (powertop_real UNIV). x i \<in> {0}}"
     proof (rule closedin_continuous_map_preimage)
       show "continuous_map (powertop_real UNIV) euclideanreal (\<lambda>x. x i)"
         by (metis UNIV_I continuous_map_product_coordinates)
       show "closedin euclideanreal {0}"
         by simp
     qed
     then show ?thesis
       by auto
   qed
   then show ?thesis
     unfolding topspace_Euclidean_space_alt
     by force
 qed
 
 lemma closedin_Euclidean_imp_closed: "closedin (Euclidean_space m) S \<Longrightarrow> closed S"
   by (metis Euclidean_space_def closed_closedin closedin_Euclidean_space closedin_closed_subtopology euclidean_product_topology topspace_Euclidean_space)
 
 lemma closedin_Euclidean_space_iff:
   "closedin (Euclidean_space m) S \<longleftrightarrow> closed S \<and> S \<subseteq> topspace (Euclidean_space m)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     using closedin_closed_subtopology topspace_Euclidean_space
     by (fastforce simp: topspace_Euclidean_space_alt closedin_Euclidean_imp_closed)
   show "?rhs \<Longrightarrow> ?lhs"
   apply (simp add: closedin_subtopology Euclidean_space_def)
     by (metis (no_types) closed_closedin euclidean_product_topology inf.orderE)
 qed
 
 lemma continuous_map_componentwise_Euclidean_space:
   "continuous_map X (Euclidean_space n) (\<lambda>x i. if i < n then f x i else 0) \<longleftrightarrow>
    (\<forall>i < n. continuous_map X euclideanreal (\<lambda>x. f x i))"
 proof -
   have *: "continuous_map X euclideanreal (\<lambda>x. if k < n then f x k else 0)"
     if "\<And>i. i<n \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x i)" for k
     by (intro continuous_intros that)
   show ?thesis
     unfolding Euclidean_space_def continuous_map_in_subtopology
     by (fastforce simp: continuous_map_componentwise_UNIV * elim: continuous_map_eq)
 qed
 
 lemma continuous_map_Euclidean_space_add [continuous_intros]:
    "\<lbrakk>continuous_map X (Euclidean_space n) f; continuous_map X (Euclidean_space n) g\<rbrakk>
     \<Longrightarrow> continuous_map X (Euclidean_space n) (\<lambda>x i. f x i + g x i)"
   unfolding Euclidean_space_def continuous_map_in_subtopology
   by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_add)
 
 lemma continuous_map_Euclidean_space_diff [continuous_intros]:
    "\<lbrakk>continuous_map X (Euclidean_space n) f; continuous_map X (Euclidean_space n) g\<rbrakk>
     \<Longrightarrow> continuous_map X (Euclidean_space n) (\<lambda>x i. f x i - g x i)"
   unfolding Euclidean_space_def continuous_map_in_subtopology
   by (fastforce simp add: continuous_map_componentwise_UNIV continuous_map_diff)
 
 lemma continuous_map_Euclidean_space_iff:
   "continuous_map (Euclidean_space m) euclidean g
    = continuous_on (topspace (Euclidean_space m)) g"
 proof
   assume "continuous_map (Euclidean_space m) euclidean g"
   then have "continuous_map (top_of_set {f. \<forall>n\<ge>m. f n = 0}) euclidean g"
     by (simp add: Euclidean_space_def euclidean_product_topology)
   then show "continuous_on (topspace (Euclidean_space m)) g"
     by (metis continuous_map_subtopology_eu subtopology_topspace topspace_Euclidean_space)
 next
   assume "continuous_on (topspace (Euclidean_space m)) g"
   then have "continuous_map (top_of_set {f. \<forall>n\<ge>m. f n = 0}) euclidean g"
     by (metis (lifting) continuous_map_into_fulltopology continuous_map_subtopology_eu order_refl topspace_Euclidean_space)
   then show "continuous_map (Euclidean_space m) euclidean g"
     by (simp add: Euclidean_space_def euclidean_product_topology)
 qed
 
 lemma cm_Euclidean_space_iff_continuous_on:
   "continuous_map (subtopology (Euclidean_space m) S) (Euclidean_space n) f
    \<longleftrightarrow> continuous_on (topspace (subtopology (Euclidean_space m) S)) f \<and>
        f ` (topspace (subtopology (Euclidean_space m) S)) \<subseteq> topspace (Euclidean_space n)"
   (is "?P \<longleftrightarrow> ?Q \<and> ?R")
 proof -
   have ?Q if ?P
   proof -
     have "\<And>n. Euclidean_space n = top_of_set {f. \<forall>m\<ge>n. f m = 0}"
       by (simp add: Euclidean_space_def euclidean_product_topology)
     with that show ?thesis
       by (simp add: subtopology_subtopology)
   qed
   moreover
   have ?R if ?P
     using that by (simp add: image_subset_iff continuous_map_def)
   moreover
   have ?P if ?Q ?R
   proof -
     have "continuous_map (top_of_set (topspace (subtopology (subtopology (powertop_real UNIV) {f. \<forall>n\<ge>m. f n = 0}) S))) (top_of_set (topspace (subtopology (powertop_real UNIV) {f. \<forall>na\<ge>n. f na = 0}))) f"
       using Euclidean_space_def that by auto
     then show ?thesis
       by (simp add: Euclidean_space_def euclidean_product_topology subtopology_subtopology)
   qed
   ultimately show ?thesis
     by auto
 qed
 
 lemma homeomorphic_Euclidean_space_product_topology:
   "Euclidean_space n homeomorphic_space product_topology (\<lambda>i. euclideanreal) {..<n}"
 proof -
   have cm: "continuous_map (product_topology (\<lambda>i. euclideanreal) {..<n})
           euclideanreal (\<lambda>x. if k < n then x k else 0)" for k
     by (auto intro: continuous_map_if continuous_map_product_projection)
   show ?thesis
     unfolding homeomorphic_space_def homeomorphic_maps_def
     apply (rule_tac x="\<lambda>f. restrict f {..<n}" in exI)
     apply (rule_tac x="\<lambda>f i. if i < n then f i else 0" in exI)
-    apply (simp add: Euclidean_space_def topspace_subtopology continuous_map_in_subtopology)
+    apply (simp add: Euclidean_space_def continuous_map_in_subtopology)
     apply (intro conjI continuous_map_from_subtopology)
        apply (force simp: continuous_map_componentwise cm intro: continuous_map_product_projection)+
     done
 qed
 
 lemma contractible_Euclidean_space [simp]: "contractible_space (Euclidean_space n)"
   using homeomorphic_Euclidean_space_product_topology contractible_space_euclideanreal
     contractible_space_product_topology homeomorphic_space_contractibility by blast
 
 lemma path_connected_Euclidean_space: "path_connected_space (Euclidean_space n)"
   by (simp add: contractible_imp_path_connected_space)
 
 lemma connected_Euclidean_space: "connected_space (Euclidean_space n)"
   by (simp add: contractible_Euclidean_space contractible_imp_connected_space)
 
 lemma locally_path_connected_Euclidean_space:
    "locally_path_connected_space (Euclidean_space n)"
   apply (simp add: homeomorphic_locally_path_connected_space [OF homeomorphic_Euclidean_space_product_topology [of n]]
                    locally_path_connected_space_product_topology)
   using locally_path_connected_space_euclideanreal by auto
 
 lemma compact_Euclidean_space:
    "compact_space (Euclidean_space n) \<longleftrightarrow> n = 0"
   by (auto simp: homeomorphic_compact_space [OF homeomorphic_Euclidean_space_product_topology] compact_space_product_topology)
 
 
 subsection\<open>n-dimensional spheres\<close>
 
 definition nsphere where
  "nsphere n \<equiv> subtopology (Euclidean_space (Suc n)) { x. (\<Sum>i\<le>n. x i ^ 2) = 1 }"
 
 lemma nsphere:
    "nsphere n = subtopology (powertop_real UNIV)
                             {x. (\<Sum>i\<le>n. x i ^ 2) = 1 \<and> (\<forall>i>n. x i = 0)}"
   by (simp add: nsphere_def Euclidean_space_def subtopology_subtopology Suc_le_eq Collect_conj_eq Int_commute)
 
 lemma continuous_map_nsphere_projection: "continuous_map (nsphere n) euclideanreal (\<lambda>x. x k)"
   unfolding nsphere
   by (blast intro: continuous_map_from_subtopology [OF continuous_map_product_projection])
 
 lemma in_topspace_nsphere: "(\<lambda>n. if n = 0 then 1 else 0) \<in> topspace (nsphere n)"
   by (simp add: nsphere_def topspace_Euclidean_space power2_eq_square if_distrib [where f = "\<lambda>x. x * _"] cong: if_cong)
 
 lemma nonempty_nsphere [simp]: "~ (topspace(nsphere n) = {})"
   using in_topspace_nsphere by auto
 
 lemma subtopology_nsphere_equator:
   "subtopology (nsphere (Suc n)) {x. x(Suc n) = 0} = nsphere n"
 proof -
   have "({x. (\<Sum>i\<le>n. (x i)\<^sup>2) + (x (Suc n))\<^sup>2 = 1 \<and> (\<forall>i>Suc n. x i = 0)} \<inter> {x. x (Suc n) = 0})
       = {x. (\<Sum>i\<le>n. (x i)\<^sup>2) = 1 \<and> (\<forall>i>n. x i = (0::real))}"
     using Suc_lessI [of n] by (fastforce simp: set_eq_iff)
   then show ?thesis
     by (simp add: nsphere subtopology_subtopology)
 qed
 
 lemma topspace_nsphere_minus1:
   assumes x: "x \<in> topspace (nsphere n)" and "x n = 0"
   shows "x \<in> topspace (nsphere (n - Suc 0))"
 proof (cases "n = 0")
   case True
   then show ?thesis
     using x by auto
 next
   case False
   have subt_eq: "nsphere (n - Suc 0) = subtopology (nsphere n) {x. x n = 0}"
     by (metis False Suc_pred le_zero_eq not_le subtopology_nsphere_equator)
   with x show ?thesis
     by (simp add: assms)
 qed
 
 lemma continuous_map_nsphere_reflection:
   "continuous_map (nsphere n) (nsphere n) (\<lambda>x i. if i = k then -x i else x i)"
 proof -
   have cm: "continuous_map (powertop_real UNIV) euclideanreal (\<lambda>x. if j = k then - x j else x j)" for j
   proof (cases "j=k")
     case True
     then show ?thesis
       by simp (metis UNIV_I continuous_map_product_projection)
   next
     case False
     then show ?thesis
       by (auto intro: continuous_map_product_projection)
   qed
   have eq: "(if i = k then x k * x k else x i * x i) = x i * x i" for i and x :: "nat \<Rightarrow> real"
     by simp
   show ?thesis
     apply (simp add: nsphere continuous_map_in_subtopology continuous_map_componentwise_UNIV
                      continuous_map_from_subtopology cm)
     apply (intro conjI allI impI continuous_intros continuous_map_from_subtopology continuous_map_product_projection)
       apply (auto simp: power2_eq_square if_distrib [where f = "\<lambda>x. x * _"] eq cong: if_cong)
     done
 qed
 
 
 proposition contractible_space_upper_hemisphere:
   assumes "k \<le> n"
   shows "contractible_space(subtopology (nsphere n) {x. x k \<ge> 0})"
 proof -
   define p:: "nat \<Rightarrow> real" where "p \<equiv> \<lambda>i. if i = k then 1 else 0"
   have "p \<in> topspace(nsphere n)"
     using assms
-    by (simp add: nsphere topspace_subtopology p_def power2_eq_square if_distrib [where f = "\<lambda>x. x * _"] cong: if_cong)
+    by (simp add: nsphere p_def power2_eq_square if_distrib [where f = "\<lambda>x. x * _"] cong: if_cong)
   let ?g = "\<lambda>x i. x i / sqrt(\<Sum>j\<le>n. x j ^ 2)"
   let ?h = "\<lambda>(t,q) i. (1 - t) * q i + t * p i"
   let ?Y = "subtopology (Euclidean_space (Suc n)) {x. 0 \<le> x k \<and> (\<exists>i\<le>n. x i \<noteq> 0)}"
   have "continuous_map (prod_topology (top_of_set {0..1}) (subtopology (nsphere n) {x. 0 \<le> x k}))
                        (subtopology (nsphere n) {x. 0 \<le> x k}) (?g \<circ> ?h)"
   proof (rule continuous_map_compose)
     have *: "\<lbrakk>0 \<le> b k; (\<Sum>i\<le>n. (b i)\<^sup>2) = 1; \<forall>i>n. b i = 0; 0 \<le> a; a \<le> 1\<rbrakk>
            \<Longrightarrow> \<exists>i. (i = k \<longrightarrow> (1 - a) * b k + a \<noteq> 0) \<and>
                    (i \<noteq> k \<longrightarrow> i \<le> n \<and> a \<noteq> 1 \<and> b i \<noteq> 0)" for a::real and b
       apply (cases "a \<noteq> 1 \<and> b k = 0"; simp)
        apply (metis (no_types, lifting) atMost_iff sum.neutral zero_power2)
       by (metis add.commute add_le_same_cancel2 diff_ge_0_iff_ge diff_zero less_eq_real_def mult_eq_0_iff mult_nonneg_nonneg not_le numeral_One zero_neq_numeral)
     show "continuous_map (prod_topology (top_of_set {0..1}) (subtopology (nsphere n) {x. 0 \<le> x k})) ?Y ?h"
       using assms
-      apply (auto simp: * nsphere topspace_subtopology continuous_map_componentwise_UNIV
+      apply (auto simp: * nsphere continuous_map_componentwise_UNIV
                prod_topology_subtopology subtopology_subtopology case_prod_unfold
                continuous_map_in_subtopology Euclidean_space_def p_def if_distrib [where f = "\<lambda>x. _ * x"] cong: if_cong)
       apply (intro continuous_map_prod_snd continuous_intros continuous_map_from_subtopology)
         apply auto
       done
   next
     have 1: "\<And>x i. \<lbrakk> i \<le> n; x i \<noteq> 0\<rbrakk> \<Longrightarrow> (\<Sum>i\<le>n. (x i / sqrt (\<Sum>j\<le>n. (x j)\<^sup>2))\<^sup>2) = 1"
       by (force simp: sum_nonneg sum_nonneg_eq_0_iff field_split_simps simp flip: sum_divide_distrib)
     have cm: "continuous_map ?Y (nsphere n) (\<lambda>x i. x i / sqrt (\<Sum>j\<le>n. (x j)\<^sup>2))"
       unfolding Euclidean_space_def nsphere subtopology_subtopology continuous_map_in_subtopology
     proof (intro continuous_intros conjI)
       show "continuous_map
                (subtopology (powertop_real UNIV) ({x. \<forall>i\<ge>Suc n. x i = 0} \<inter> {x. 0 \<le> x k \<and> (\<exists>i\<le>n. x i \<noteq> 0)}))
                (powertop_real UNIV) (\<lambda>x i. x i / sqrt (\<Sum>j\<le>n. (x j)\<^sup>2))"
         unfolding continuous_map_componentwise
         by (intro continuous_intros conjI ballI) (auto simp: sum_nonneg_eq_0_iff)
     qed (auto simp: 1)
     show "continuous_map ?Y (subtopology (nsphere n) {x. 0 \<le> x k}) (\<lambda>x i. x i / sqrt (\<Sum>j\<le>n. (x j)\<^sup>2))"
       by (force simp: cm sum_nonneg continuous_map_in_subtopology if_distrib [where f = "\<lambda>x. _ * x"] cong: if_cong)
   qed
   moreover have "(?g \<circ> ?h) (0, x) = x"
     if "x \<in> topspace (subtopology (nsphere n) {x. 0 \<le> x k})" for x
     using that
-    by (simp add: assms topspace_subtopology nsphere)
+    by (simp add: assms nsphere)
   moreover
   have "(?g \<circ> ?h) (1, x) = p"
     if "x \<in> topspace (subtopology (nsphere n) {x. 0 \<le> x k})" for x
     by (force simp: assms p_def power2_eq_square if_distrib [where f = "\<lambda>x. x * _"] cong: if_cong)
   ultimately
   show ?thesis
     apply (simp add: contractible_space_def homotopic_with)
     apply (rule_tac x=p in exI)
     apply (rule_tac x="?g \<circ> ?h" in exI, force)
     done
 qed
 
 
 corollary contractible_space_lower_hemisphere:
   assumes "k \<le> n"
   shows "contractible_space(subtopology (nsphere n) {x. x k \<le> 0})"
 proof -
   have "contractible_space (subtopology (nsphere n) {x. 0 \<le> x k}) = ?thesis"
   proof (rule homeomorphic_space_contractibility)
     show "subtopology (nsphere n) {x. 0 \<le> x k} homeomorphic_space subtopology (nsphere n) {x. x k \<le> 0}"
       unfolding homeomorphic_space_def homeomorphic_maps_def
       apply (rule_tac x="\<lambda>x i. if i = k then -(x i) else x i" in exI)+
       apply (auto simp: continuous_map_in_subtopology continuous_map_from_subtopology
                   continuous_map_nsphere_reflection)
       done
   qed
   then show ?thesis
     using contractible_space_upper_hemisphere [OF assms] by metis
 qed
 
 
 proposition nullhomotopic_nonsurjective_sphere_map:
   assumes f: "continuous_map (nsphere p) (nsphere p) f"
     and fim: "f ` (topspace(nsphere p)) \<noteq> topspace(nsphere p)"
   obtains a where "homotopic_with (\<lambda>x. True) (nsphere p) (nsphere p) f (\<lambda>x. a)"
 proof -
   obtain a where a: "a \<in> topspace(nsphere p)" "a \<notin> f ` (topspace(nsphere p))"
     using fim continuous_map_image_subset_topspace f by blast
   then have a1: "(\<Sum>i\<le>p. (a i)\<^sup>2) = 1" and a0: "\<And>i. i > p \<Longrightarrow> a i = 0"
     by (simp_all add: nsphere)
   have f1: "(\<Sum>j\<le>p. (f x j)\<^sup>2) = 1" if "x \<in> topspace (nsphere p)" for x
   proof -
     have "f x \<in> topspace (nsphere p)"
       using continuous_map_image_subset_topspace f that by blast
     then show ?thesis
       by (simp add: nsphere)
   qed
   show thesis
   proof
     let ?g = "\<lambda>x i. x i / sqrt(\<Sum>j\<le>p. x j ^ 2)"
     let ?h = "\<lambda>(t,x) i. (1 - t) * f x i - t * a i"
     let ?Y = "subtopology (Euclidean_space(Suc p)) (- {\<lambda>i. 0})"
     let ?T01 = "top_of_set {0..1::real}"
     have 1: "continuous_map (prod_topology ?T01 (nsphere p)) (nsphere p) (?g \<circ> ?h)"
     proof (rule continuous_map_compose)
       have "continuous_map (prod_topology ?T01 (nsphere p)) euclideanreal ((\<lambda>x. f x k) \<circ> snd)" for k
         unfolding nsphere
         apply (simp add: continuous_map_of_snd)
         apply (rule continuous_map_compose [of _ "nsphere p" f, unfolded o_def])
         using f apply (simp add: nsphere)
         by (simp add: continuous_map_nsphere_projection)
       then have "continuous_map (prod_topology ?T01 (nsphere p)) euclideanreal (\<lambda>r. ?h r k)"
         for k
         unfolding case_prod_unfold o_def
         by (intro continuous_map_into_fulltopology [OF continuous_map_fst] continuous_intros) auto
       moreover have "?h ` ({0..1} \<times> topspace (nsphere p)) \<subseteq> {x. \<forall>i\<ge>Suc p. x i = 0}"
         using continuous_map_image_subset_topspace [OF f]
         by (auto simp: nsphere image_subset_iff a0)
       moreover have "(\<lambda>i. 0) \<notin> ?h ` ({0..1} \<times> topspace (nsphere p))"
       proof clarify
         fix t b
         assume eq: "(\<lambda>i. 0) = (\<lambda>i. (1 - t) * f b i - t * a i)" and "t \<in> {0..1}" and b: "b \<in> topspace (nsphere p)"
         have "(1 - t)\<^sup>2 = (\<Sum>i\<le>p. ((1 - t) * f b i)^2)"
           using f1 [OF b] by (simp add: power_mult_distrib flip: sum_distrib_left)
         also have "\<dots> = (\<Sum>i\<le>p. (t * a i)^2)"
           using eq by (simp add: fun_eq_iff)
         also have "\<dots> = t\<^sup>2"
           using a1 by (simp add: power_mult_distrib flip: sum_distrib_left)
         finally have "1 - t = t"
           by (simp add: power2_eq_iff)
         then have *: "t = 1/2"
           by simp
         have fba: "f b \<noteq> a"
           using a(2) b by blast
         then show False
           using eq unfolding * by (simp add: fun_eq_iff)
       qed
       ultimately show "continuous_map (prod_topology ?T01 (nsphere p)) ?Y ?h"
         by (simp add: Euclidean_space_def continuous_map_in_subtopology continuous_map_componentwise_UNIV)
     next
       have *: "\<lbrakk>\<forall>i\<ge>Suc p. x i = 0; x \<noteq> (\<lambda>i. 0)\<rbrakk> \<Longrightarrow> (\<Sum>j\<le>p. (x j)\<^sup>2) \<noteq> 0" for x :: "nat \<Rightarrow> real"
         by (force simp: fun_eq_iff not_less_eq_eq sum_nonneg_eq_0_iff)
       show "continuous_map ?Y (nsphere p) ?g"
         apply (simp add: Euclidean_space_def continuous_map_in_subtopology continuous_map_componentwise_UNIV
                          nsphere continuous_map_componentwise subtopology_subtopology)
         apply (intro conjI allI continuous_intros continuous_map_from_subtopology [OF continuous_map_product_projection])
             apply (simp_all add: *)
          apply (force simp: sum_nonneg fun_eq_iff not_less_eq_eq sum_nonneg_eq_0_iff power_divide simp flip: sum_divide_distrib)
         done
     qed
     have 2: "(?g \<circ> ?h) (0, x) = f x" if "x \<in> topspace (nsphere p)" for x
       using that f1 by simp
     have 3: "(?g \<circ> ?h) (1, x) = (\<lambda>i. - a i)" for x
       using a by (force simp: field_split_simps nsphere)
     then show "homotopic_with (\<lambda>x. True) (nsphere p) (nsphere p) f (\<lambda>x. (\<lambda>i. - a i))"
       by (force simp: homotopic_with intro: 1 2 3)
   qed
 qed
 
 lemma Hausdorff_Euclidean_space:
    "Hausdorff_space (Euclidean_space n)"
   unfolding Euclidean_space_def
   by (rule Hausdorff_space_subtopology) (metis Hausdorff_space_euclidean euclidean_product_topology)
 
 end
 
diff --git a/src/HOL/Analysis/Abstract_Limits.thy b/src/HOL/Analysis/Abstract_Limits.thy
--- a/src/HOL/Analysis/Abstract_Limits.thy
+++ b/src/HOL/Analysis/Abstract_Limits.thy
@@ -1,309 +1,309 @@
 theory Abstract_Limits
   imports
     Abstract_Topology
 begin
 
 subsection\<open>nhdsin and atin\<close>
 
 definition nhdsin :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a filter"
   where "nhdsin X a =
            (if a \<in> topspace X then (INF S\<in>{S. openin X S \<and> a \<in> S}. principal S) else bot)"
 
 definition atin :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a filter"
   where "atin X a \<equiv> inf (nhdsin X a) (principal (topspace X - {a}))"
 
 
 lemma nhdsin_degenerate [simp]: "a \<notin> topspace X \<Longrightarrow> nhdsin X a = bot"
   and atin_degenerate [simp]: "a \<notin> topspace X \<Longrightarrow> atin X a = bot"
   by (simp_all add: nhdsin_def atin_def)
 
 lemma eventually_nhdsin:
   "eventually P (nhdsin X a) \<longleftrightarrow> a \<notin> topspace X \<or> (\<exists>S. openin X S \<and> a \<in> S \<and> (\<forall>x\<in>S. P x))"
 proof (cases "a \<in> topspace X")
   case True
   hence "nhdsin X a = (INF S\<in>{S. openin X S \<and> a \<in> S}. principal S)"
     by (simp add: nhdsin_def)
   also have "eventually P \<dots> \<longleftrightarrow> (\<exists>S. openin X S \<and> a \<in> S \<and> (\<forall>x\<in>S. P x))"
     using True by (subst eventually_INF_base) (auto simp: eventually_principal)
   finally show ?thesis using True by simp
 qed auto
 
 lemma eventually_atin:
   "eventually P (atin X a) \<longleftrightarrow> a \<notin> topspace X \<or>
              (\<exists>U. openin X U \<and> a \<in> U \<and> (\<forall>x \<in> U - {a}. P x))"
 proof (cases "a \<in> topspace X")
   case True
   hence "eventually P (atin X a) \<longleftrightarrow> (\<exists>S. openin X S \<and>
            a \<in> S \<and> (\<forall>x\<in>S. x \<in> topspace X \<and> x \<noteq> a \<longrightarrow> P x))"
     by (simp add: atin_def eventually_inf_principal eventually_nhdsin)
   also have "\<dots> \<longleftrightarrow> (\<exists>U. openin X U \<and> a \<in> U \<and> (\<forall>x \<in> U - {a}. P x))"
     using openin_subset by (intro ex_cong) auto
   finally show ?thesis by (simp add: True)
 qed auto
 
 
 subsection\<open>Limits in a topological space\<close>
 
 definition limitin :: "'a topology \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b filter \<Rightarrow> bool" where
   "limitin X f l F \<equiv> l \<in> topspace X \<and> (\<forall>U. openin X U \<and> l \<in> U \<longrightarrow> eventually (\<lambda>x. f x \<in> U) F)"
 
 lemma limitin_canonical_iff [simp]: "limitin euclidean f l F \<longleftrightarrow> (f \<longlongrightarrow> l) F"
   by (auto simp: limitin_def tendsto_def)
 
 lemma limitin_topspace: "limitin X f l F \<Longrightarrow> l \<in> topspace X"
   by (simp add: limitin_def)
 
 lemma limitin_const_iff [simp]: "limitin X (\<lambda>a. l) l F \<longleftrightarrow> l \<in> topspace X"
   by (simp add: limitin_def)
 
 lemma limitin_const: "limitin euclidean (\<lambda>a. l) l F"
   by simp
 
 lemma limitin_eventually:
    "\<lbrakk>l \<in> topspace X; eventually (\<lambda>x. f x = l) F\<rbrakk> \<Longrightarrow> limitin X f l F"
   by (auto simp: limitin_def eventually_mono)
 
 lemma limitin_subsequence:
    "\<lbrakk>strict_mono r; limitin X f l sequentially\<rbrakk> \<Longrightarrow> limitin X (f \<circ> r) l sequentially"
   unfolding limitin_def using eventually_subseq by fastforce
 
 lemma limitin_subtopology:
   "limitin (subtopology X S) f l F
    \<longleftrightarrow> l \<in> S \<and> eventually (\<lambda>a. f a \<in> S) F \<and> limitin X f l F"  (is "?lhs = ?rhs")
 proof (cases "l \<in> S \<inter> topspace X")
   case True
   show ?thesis
   proof
     assume L: ?lhs
     with True
     have "\<forall>\<^sub>F b in F. f b \<in> topspace X \<inter> S"
       by (metis (no_types) limitin_def openin_topspace topspace_subtopology)
     with L show ?rhs
-      apply (clarsimp simp add: limitin_def eventually_mono topspace_subtopology openin_subtopology_alt)
+      apply (clarsimp simp add: limitin_def eventually_mono openin_subtopology_alt)
       apply (drule_tac x="S \<inter> U" in spec, force simp: elim: eventually_mono)
       done
   next
     assume ?rhs
     then show ?lhs
       using eventually_elim2
-      by (fastforce simp add: limitin_def topspace_subtopology openin_subtopology_alt)
+      by (fastforce simp add: limitin_def openin_subtopology_alt)
   qed
-qed (auto simp: limitin_def topspace_subtopology)
+qed (auto simp: limitin_def)
 
 
 lemma limitin_canonical_iff_gen [simp]:
   assumes "open S"
   shows "limitin (top_of_set S) f l F \<longleftrightarrow> (f \<longlongrightarrow> l) F \<and> l \<in> S"
   using assms by (auto simp: limitin_subtopology tendsto_def)
 
 lemma limitin_sequentially:
    "limitin X S l sequentially \<longleftrightarrow>
      l \<in> topspace X \<and> (\<forall>U. openin X U \<and> l \<in> U \<longrightarrow> (\<exists>N. \<forall>n. N \<le> n \<longrightarrow> S n \<in> U))"
   by (simp add: limitin_def eventually_sequentially)
 
 lemma limitin_sequentially_offset:
    "limitin X f l sequentially \<Longrightarrow> limitin X (\<lambda>i. f (i + k)) l sequentially"
   unfolding limitin_sequentially
   by (metis add.commute le_add2 order_trans)
 
 lemma limitin_sequentially_offset_rev:
   assumes "limitin X (\<lambda>i. f (i + k)) l sequentially"
   shows "limitin X f l sequentially"
 proof -
   have "\<exists>N. \<forall>n\<ge>N. f n \<in> U" if U: "openin X U" "l \<in> U" for U
   proof -
     obtain N where "\<And>n. n\<ge>N \<Longrightarrow> f (n + k) \<in> U"
       using assms U unfolding limitin_sequentially by blast
     then have "\<forall>n\<ge>N+k. f n \<in> U"
       by (metis add_leD2 le_add_diff_inverse ordered_cancel_comm_monoid_diff_class.le_diff_conv2 add.commute)
     then show ?thesis ..
   qed
   with assms show ?thesis
     unfolding limitin_sequentially
     by simp
 qed
 
 lemma limitin_atin:
    "limitin Y f y (atin X x) \<longleftrightarrow>
         y \<in> topspace Y \<and>
         (x \<in> topspace X
         \<longrightarrow> (\<forall>V. openin Y V \<and> y \<in> V
                  \<longrightarrow> (\<exists>U. openin X U \<and> x \<in> U \<and> f ` (U - {x}) \<subseteq> V)))"
   by (auto simp: limitin_def eventually_atin image_subset_iff)
 
 lemma limitin_atin_self:
    "limitin Y f (f a) (atin X a) \<longleftrightarrow>
         f a \<in> topspace Y \<and>
         (a \<in> topspace X
          \<longrightarrow> (\<forall>V. openin Y V \<and> f a \<in> V
                   \<longrightarrow> (\<exists>U. openin X U \<and> a \<in> U \<and> f ` U \<subseteq> V)))"
   unfolding limitin_atin by fastforce
 
 lemma limitin_trivial:
    "\<lbrakk>trivial_limit F; y \<in> topspace X\<rbrakk> \<Longrightarrow> limitin X f y F"
   by (simp add: limitin_def)
 
 lemma limitin_transform_eventually:
    "\<lbrakk>eventually (\<lambda>x. f x = g x) F; limitin X f l F\<rbrakk> \<Longrightarrow> limitin X g l F"
   unfolding limitin_def using eventually_elim2 by fastforce
 
 lemma continuous_map_limit:
   assumes "continuous_map X Y g" and f: "limitin X f l F"
   shows "limitin Y (g \<circ> f) (g l) F"
 proof -
   have "g l \<in> topspace Y"
     by (meson assms continuous_map_def limitin_topspace)
   moreover
   have "\<And>U. \<lbrakk>\<forall>V. openin X V \<and> l \<in> V \<longrightarrow> (\<forall>\<^sub>F x in F. f x \<in> V); openin Y U; g l \<in> U\<rbrakk>
             \<Longrightarrow> \<forall>\<^sub>F x in F. g (f x) \<in> U"
     using assms eventually_mono
     by (fastforce simp: limitin_def dest!: openin_continuous_map_preimage)
   ultimately show ?thesis
     using f by (fastforce simp add: limitin_def)
 qed
 
 
 subsection\<open>Pointwise continuity in topological spaces\<close>
 
 definition topcontinuous_at where
   "topcontinuous_at X Y f x \<longleftrightarrow>
      x \<in> topspace X \<and>
      (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
      (\<forall>V. openin Y V \<and> f x \<in> V
           \<longrightarrow> (\<exists>U. openin X U \<and> x \<in> U \<and> (\<forall>y \<in> U. f y \<in> V)))"
 
 lemma topcontinuous_at_atin:
    "topcontinuous_at X Y f x \<longleftrightarrow>
         x \<in> topspace X \<and>
         (\<forall>x \<in> topspace X. f x \<in> topspace Y) \<and>
         limitin Y f (f x) (atin X x)"
   unfolding topcontinuous_at_def
   by (fastforce simp add: limitin_atin)+
 
 lemma continuous_map_eq_topcontinuous_at:
    "continuous_map X Y f \<longleftrightarrow> (\<forall>x \<in> topspace X. topcontinuous_at X Y f x)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: continuous_map_def topcontinuous_at_def)
 next
   assume R: ?rhs
   then show ?lhs
     apply (auto simp: continuous_map_def topcontinuous_at_def)
     apply (subst openin_subopen, safe)
     apply (drule bspec, assumption)
     using openin_subset[of X] apply (auto simp: subset_iff dest!: spec)
     done
 qed
 
 lemma continuous_map_atin:
    "continuous_map X Y f \<longleftrightarrow> (\<forall>x \<in> topspace X. limitin Y f (f x) (atin X x))"
   by (auto simp: limitin_def topcontinuous_at_atin continuous_map_eq_topcontinuous_at)
 
 lemma limitin_continuous_map:
    "\<lbrakk>continuous_map X Y f; a \<in> topspace X; f a = b\<rbrakk> \<Longrightarrow> limitin Y f b (atin X a)"
   by (auto simp: continuous_map_atin)
 
 
 subsection\<open>Combining theorems for continuous functions into the reals\<close>
 
 lemma continuous_map_canonical_const [continuous_intros]:
    "continuous_map X euclidean (\<lambda>x. c)"
   by simp
 
 lemma continuous_map_real_mult [continuous_intros]:
    "\<lbrakk>continuous_map X euclideanreal f; continuous_map X euclideanreal g\<rbrakk>
    \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x * g x)"
   by (simp add: continuous_map_atin tendsto_mult)
 
 lemma continuous_map_real_pow [continuous_intros]:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x ^ n)"
   by (induction n) (auto simp: continuous_map_real_mult)
 
 lemma continuous_map_real_mult_left:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. c * f x)"
   by (simp add: continuous_map_atin tendsto_mult)
 
 lemma continuous_map_real_mult_left_eq:
    "continuous_map X euclideanreal (\<lambda>x. c * f x) \<longleftrightarrow> c = 0 \<or> continuous_map X euclideanreal f"
 proof (cases "c = 0")
   case False
   have "continuous_map X euclideanreal (\<lambda>x. c * f x) \<Longrightarrow> continuous_map X euclideanreal f"
     apply (frule continuous_map_real_mult_left [where c="inverse c"])
     apply (simp add: field_simps False)
     done
   with False show ?thesis
     using continuous_map_real_mult_left by blast
 qed simp
 
 lemma continuous_map_real_mult_right:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x * c)"
   by (simp add: continuous_map_atin tendsto_mult)
 
 lemma continuous_map_real_mult_right_eq:
    "continuous_map X euclideanreal (\<lambda>x. f x * c) \<longleftrightarrow> c = 0 \<or> continuous_map X euclideanreal f"
   by (simp add: mult.commute flip: continuous_map_real_mult_left_eq)
 
 lemma continuous_map_minus [continuous_intros]:
   fixes f :: "'a\<Rightarrow>'b::real_normed_vector"
   shows "continuous_map X euclidean f \<Longrightarrow> continuous_map X euclidean (\<lambda>x. - f x)"
   by (simp add: continuous_map_atin tendsto_minus)
 
 lemma continuous_map_minus_eq [simp]:
   fixes f :: "'a\<Rightarrow>'b::real_normed_vector"
   shows "continuous_map X euclidean (\<lambda>x. - f x) \<longleftrightarrow> continuous_map X euclidean f"
   using continuous_map_minus add.inverse_inverse continuous_map_eq by fastforce
 
 lemma continuous_map_add [continuous_intros]:
   fixes f :: "'a\<Rightarrow>'b::real_normed_vector"
   shows "\<lbrakk>continuous_map X euclidean f; continuous_map X euclidean g\<rbrakk> \<Longrightarrow> continuous_map X euclidean (\<lambda>x. f x + g x)"
   by (simp add: continuous_map_atin tendsto_add)
 
 lemma continuous_map_diff [continuous_intros]:
   fixes f :: "'a\<Rightarrow>'b::real_normed_vector"
   shows "\<lbrakk>continuous_map X euclidean f; continuous_map X euclidean g\<rbrakk> \<Longrightarrow> continuous_map X euclidean (\<lambda>x. f x - g x)"
   by (simp add: continuous_map_atin tendsto_diff)
 
 lemma continuous_map_norm [continuous_intros]:
   fixes f :: "'a\<Rightarrow>'b::real_normed_vector"
   shows "continuous_map X euclidean f \<Longrightarrow> continuous_map X euclidean (\<lambda>x. norm(f x))"
   by (simp add: continuous_map_atin tendsto_norm)
 
 lemma continuous_map_real_abs [continuous_intros]:
    "continuous_map X euclideanreal f \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. abs(f x))"
   by (simp add: continuous_map_atin tendsto_rabs)
 
 lemma continuous_map_real_max [continuous_intros]:
    "\<lbrakk>continuous_map X euclideanreal f; continuous_map X euclideanreal g\<rbrakk>
    \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. max (f x) (g x))"
   by (simp add: continuous_map_atin tendsto_max)
 
 lemma continuous_map_real_min [continuous_intros]:
    "\<lbrakk>continuous_map X euclideanreal f; continuous_map X euclideanreal g\<rbrakk>
    \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. min (f x) (g x))"
   by (simp add: continuous_map_atin tendsto_min)
 
 lemma continuous_map_sum [continuous_intros]:
   fixes f :: "'a\<Rightarrow>'b\<Rightarrow>'c::real_normed_vector"
   shows "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> continuous_map X euclidean (\<lambda>x. f x i)\<rbrakk>
          \<Longrightarrow> continuous_map X euclidean (\<lambda>x. sum (f x) I)"
   by (simp add: continuous_map_atin tendsto_sum)
 
 lemma continuous_map_prod [continuous_intros]:
    "\<lbrakk>finite I;
          \<And>i. i \<in> I \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x i)\<rbrakk>
         \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. prod (f x) I)"
   by (simp add: continuous_map_atin tendsto_prod)
 
 lemma continuous_map_real_inverse [continuous_intros]:
    "\<lbrakk>continuous_map X euclideanreal f; \<And>x. x \<in> topspace X \<Longrightarrow> f x \<noteq> 0\<rbrakk>
         \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. inverse(f x))"
   by (simp add: continuous_map_atin tendsto_inverse)
 
 lemma continuous_map_real_divide [continuous_intros]:
    "\<lbrakk>continuous_map X euclideanreal f; continuous_map X euclideanreal g; \<And>x. x \<in> topspace X \<Longrightarrow> g x \<noteq> 0\<rbrakk>
    \<Longrightarrow> continuous_map X euclideanreal (\<lambda>x. f x / g x)"
   by (simp add: continuous_map_atin tendsto_divide)
 
 end
diff --git a/src/HOL/Analysis/Abstract_Topology.thy b/src/HOL/Analysis/Abstract_Topology.thy
--- a/src/HOL/Analysis/Abstract_Topology.thy
+++ b/src/HOL/Analysis/Abstract_Topology.thy
@@ -1,4607 +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 topspace_subtopology)
+  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 topspace_subtopology)
+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 add: topspace_subtopology)
+  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 *)
 
 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 topspace_subtopology) blast
+  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 topspace_subtopology derived_set_of_subtopology)
+  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 topspace_subtopology derived_set_of_subtopology Int_absorb1)
+  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 add: topspace_subtopology)
+      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: topspace_subtopology openin_subtopology eq)
+    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 topspace_subtopology openin_subtopology)
+  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 simp: topspace_subtopology)
+      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 add: topspace_subtopology)
+      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: topspace_subtopology openin_open_subtopology eq) (auto simp: openin_closedin_eq)
+      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 simp: topspace_subtopology)
+      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 add: topspace_subtopology)
+      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: topspace_subtopology closedin_closed_subtopology eq) (auto simp: closedin_def)
+      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)
 
 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 topspace_subtopology)
+  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_maps_i [simp]:"homeomorphic_maps X Y id id \<longleftrightarrow> Y = X"
   by (metis (full_types) eq_id_iff homeomorphic_maps_id)
 
 lemma homeomorphic_map_i [simp]: "homeomorphic_map X Y id \<longleftrightarrow> Y = X"
   by (metis (no_types) eq_id_iff homeomorphic_map_id)
 
 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 topspace_subtopology continuous_map_in_subtopology)
+  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 topspace_subtopology continuous_map_in_subtopology)
+  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 topspace_subtopology inf_absorb2)
+  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 topspace_subtopology openin_subtopology eq imp_conjL all_subset_image ex_finite_subset_image)
+    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 topspace_subtopology)
+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 topspace_subtopology)
+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 topspace_subtopology)
+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 topspace_subtopology)
+  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 topspace_subtopology)
+  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])
 
 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/Abstract_Topology_2.thy b/src/HOL/Analysis/Abstract_Topology_2.thy
--- a/src/HOL/Analysis/Abstract_Topology_2.thy
+++ b/src/HOL/Analysis/Abstract_Topology_2.thy
@@ -1,1616 +1,1616 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 section \<open>Abstract Topology 2\<close>
 
 theory Abstract_Topology_2
   imports
     Elementary_Topology
     Abstract_Topology
     "HOL-Library.Indicator_Function"
 begin
 
 text \<open>Combination of Elementary and Abstract Topology\<close>
 
 (* FIXME: move elsewhere *)
 
 lemma approachable_lt_le: "(\<exists>(d::real) > 0. \<forall>x. f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> P x)"
   apply auto
   apply (rule_tac x="d/2" in exI)
   apply auto
   done
 
 lemma approachable_lt_le2:  \<comment> \<open>like the above, but pushes aside an extra formula\<close>
     "(\<exists>(d::real) > 0. \<forall>x. Q x \<longrightarrow> f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> Q x \<longrightarrow> P x)"
   apply auto
   apply (rule_tac x="d/2" in exI, auto)
   done
 
 lemma triangle_lemma:
   fixes x y z :: real
   assumes x: "0 \<le> x"
     and y: "0 \<le> y"
     and z: "0 \<le> z"
     and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
   shows "x \<le> y + z"
 proof -
   have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
     using z y by simp
   with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
     by (simp add: power2_eq_square field_simps)
   from y z have yz: "y + z \<ge> 0"
     by arith
   from power2_le_imp_le[OF th yz] show ?thesis .
 qed
 
 lemma isCont_indicator:
   fixes x :: "'a::t2_space"
   shows "isCont (indicator A :: 'a \<Rightarrow> real) x = (x \<notin> frontier A)"
 proof auto
   fix x
   assume cts_at: "isCont (indicator A :: 'a \<Rightarrow> real) x" and fr: "x \<in> frontier A"
   with continuous_at_open have 1: "\<forall>V::real set. open V \<and> indicator A x \<in> V \<longrightarrow>
     (\<exists>U::'a set. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> V))" by auto
   show False
   proof (cases "x \<in> A")
     assume x: "x \<in> A"
     hence "indicator A x \<in> ({0<..<2} :: real set)" by simp
     hence "\<exists>U. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> ({0<..<2} :: real set))"
       using 1 open_greaterThanLessThan by blast
     then guess U .. note U = this
     hence "\<forall>y\<in>U. indicator A y > (0::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> A" using indicator_eq_0_iff by force
     hence "x \<in> interior A" using U interiorI by auto
     thus ?thesis using fr unfolding frontier_def by simp
   next
     assume x: "x \<notin> A"
     hence "indicator A x \<in> ({-1<..<1} :: real set)" by simp
     hence "\<exists>U. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> ({-1<..<1} :: real set))"
       using 1 open_greaterThanLessThan by blast
     then guess U .. note U = this
     hence "\<forall>y\<in>U. indicator A y < (1::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> -A" by auto
     hence "x \<in> interior (-A)" using U interiorI by auto
     thus ?thesis using fr interior_complement unfolding frontier_def by auto
   qed
 next
   assume nfr: "x \<notin> frontier A"
   hence "x \<in> interior A \<or> x \<in> interior (-A)"
     by (auto simp: frontier_def closure_interior)
   thus "isCont ((indicator A)::'a \<Rightarrow> real) x"
   proof
     assume int: "x \<in> interior A"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> A" unfolding interior_def by auto
     hence "\<forall>y\<in>U. indicator A y = (1::real)" unfolding indicator_def by auto
-    hence "continuous_on U (indicator A)" by (simp add: continuous_on_const indicator_eq_1_iff)
+    hence "continuous_on U (indicator A)" by (simp add: indicator_eq_1_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   next
     assume ext: "x \<in> interior (-A)"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> -A" unfolding interior_def by auto
     then have "continuous_on U (indicator A)"
       using continuous_on_topological by (auto simp: subset_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   qed
 qed
 
 lemma closedin_limpt:
   "closedin (top_of_set T) S \<longleftrightarrow> S \<subseteq> T \<and> (\<forall>x. x islimpt S \<and> x \<in> T \<longrightarrow> x \<in> S)"
   apply (simp add: closedin_closed, safe)
    apply (simp add: closed_limpt islimpt_subset)
   apply (rule_tac x="closure S" in exI, simp)
   apply (force simp: closure_def)
   done
 
 lemma closedin_closed_eq: "closed S \<Longrightarrow> closedin (top_of_set S) T \<longleftrightarrow> closed T \<and> T \<subseteq> S"
   by (meson closedin_limpt closed_subset closedin_closed_trans)
 
 lemma connected_closed_set:
    "closed S
     \<Longrightarrow> connected S \<longleftrightarrow> (\<nexists>A B. closed A \<and> closed B \<and> A \<noteq> {} \<and> B \<noteq> {} \<and> A \<union> B = S \<and> A \<inter> B = {})"
   unfolding connected_closedin_eq closedin_closed_eq connected_closedin_eq by blast
 
 text \<open>If a connnected set is written as the union of two nonempty closed sets, then these sets
 have to intersect.\<close>
 
 lemma connected_as_closed_union:
   assumes "connected C" "C = A \<union> B" "closed A" "closed B" "A \<noteq> {}" "B \<noteq> {}"
   shows "A \<inter> B \<noteq> {}"
 by (metis assms closed_Un connected_closed_set)
 
 lemma closedin_subset_trans:
   "closedin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     closedin (top_of_set T) S"
   by (meson closedin_limpt subset_iff)
 
 lemma openin_subset_trans:
   "openin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     openin (top_of_set T) S"
   by (auto simp: openin_open)
 
 lemma closedin_compact:
    "\<lbrakk>compact S; closedin (top_of_set S) T\<rbrakk> \<Longrightarrow> compact T"
 by (metis closedin_closed compact_Int_closed)
 
 lemma closedin_compact_eq:
   fixes S :: "'a::t2_space set"
   shows
    "compact S
          \<Longrightarrow> (closedin (top_of_set S) T \<longleftrightarrow>
               compact T \<and> T \<subseteq> S)"
 by (metis closedin_imp_subset closedin_compact closed_subset compact_imp_closed)
 
 
 subsection \<open>Closure\<close>
 
 lemma euclidean_closure_of [simp]: "euclidean closure_of S = closure S"
   by (auto simp: closure_of_def closure_def islimpt_def)
 
 lemma closure_openin_Int_closure:
   assumes ope: "openin (top_of_set U) S" and "T \<subseteq> U"
   shows "closure(S \<inter> closure T) = closure(S \<inter> T)"
 proof
   obtain V where "open V" and S: "S = U \<inter> V"
     using ope using openin_open by metis
   show "closure (S \<inter> closure T) \<subseteq> closure (S \<inter> T)"
     proof (clarsimp simp: S)
       fix x
       assume  "x \<in> closure (U \<inter> V \<inter> closure T)"
       then have "V \<inter> closure T \<subseteq> A \<Longrightarrow> x \<in> closure A" for A
           by (metis closure_mono subsetD inf.coboundedI2 inf_assoc)
       then have "x \<in> closure (T \<inter> V)"
          by (metis \<open>open V\<close> closure_closure inf_commute open_Int_closure_subset)
       then show "x \<in> closure (U \<inter> V \<inter> T)"
         by (metis \<open>T \<subseteq> U\<close> inf.absorb_iff2 inf_assoc inf_commute)
     qed
 next
   show "closure (S \<inter> T) \<subseteq> closure (S \<inter> closure T)"
     by (meson Int_mono closure_mono closure_subset order_refl)
 qed
 
 corollary infinite_openin:
   fixes S :: "'a :: t1_space set"
   shows "\<lbrakk>openin (top_of_set U) S; x \<in> S; x islimpt U\<rbrakk> \<Longrightarrow> infinite S"
   by (clarsimp simp add: openin_open islimpt_eq_acc_point inf_commute)
 
 lemma closure_Int_ballI:
   assumes "\<And>U. \<lbrakk>openin (top_of_set S) U; U \<noteq> {}\<rbrakk> \<Longrightarrow> T \<inter> U \<noteq> {}"
   shows "S \<subseteq> closure T"
 proof (clarsimp simp: closure_iff_nhds_not_empty)
   fix x and A and V
   assume "x \<in> S" "V \<subseteq> A" "open V" "x \<in> V" "T \<inter> A = {}"
   then have "openin (top_of_set S) (A \<inter> V \<inter> S)"
     by (auto simp: openin_open intro!: exI[where x="V"])
   moreover have "A \<inter> V \<inter> S \<noteq> {}" using \<open>x \<in> V\<close> \<open>V \<subseteq> A\<close> \<open>x \<in> S\<close>
     by auto
   ultimately have "T \<inter> (A \<inter> V \<inter> S) \<noteq> {}"
     by (rule assms)
   with \<open>T \<inter> A = {}\<close> show False by auto
 qed
 
 
 subsection \<open>Frontier\<close>
 
 lemma euclidean_interior_of [simp]: "euclidean interior_of S = interior S"
   by (auto simp: interior_of_def interior_def)
 
 lemma euclidean_frontier_of [simp]: "euclidean frontier_of S = frontier S"
   by (auto simp: frontier_of_def frontier_def)
 
 lemma connected_Int_frontier:
      "\<lbrakk>connected s; s \<inter> t \<noteq> {}; s - t \<noteq> {}\<rbrakk> \<Longrightarrow> (s \<inter> frontier t \<noteq> {})"
   apply (simp add: frontier_interiors connected_openin, safe)
   apply (drule_tac x="s \<inter> interior t" in spec, safe)
    apply (drule_tac [2] x="s \<inter> interior (-t)" in spec)
    apply (auto simp: disjoint_eq_subset_Compl dest: interior_subset [THEN subsetD])
   done
 
 subsection \<open>Compactness\<close>
 
 lemma openin_delete:
   fixes a :: "'a :: t1_space"
   shows "openin (top_of_set u) s
          \<Longrightarrow> openin (top_of_set u) (s - {a})"
 by (metis Int_Diff open_delete openin_open)
 
 lemma compact_eq_openin_cover:
   "compact S \<longleftrightarrow>
     (\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
       (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"
 proof safe
   fix C
   assume "compact S" and "\<forall>c\<in>C. openin (top_of_set S) c" and "S \<subseteq> \<Union>C"
   then have "\<forall>c\<in>{T. open T \<and> S \<inter> T \<in> C}. open c" and "S \<subseteq> \<Union>{T. open T \<and> S \<inter> T \<in> C}"
     unfolding openin_open by force+
   with \<open>compact S\<close> obtain D where "D \<subseteq> {T. open T \<and> S \<inter> T \<in> C}" and "finite D" and "S \<subseteq> \<Union>D"
     by (meson compactE)
   then have "image (\<lambda>T. S \<inter> T) D \<subseteq> C \<and> finite (image (\<lambda>T. S \<inter> T) D) \<and> S \<subseteq> \<Union>(image (\<lambda>T. S \<inter> T) D)"
     by auto
   then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
 next
   assume 1: "\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
         (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D)"
   show "compact S"
   proof (rule compactI)
     fix C
     let ?C = "image (\<lambda>T. S \<inter> T) C"
     assume "\<forall>t\<in>C. open t" and "S \<subseteq> \<Union>C"
     then have "(\<forall>c\<in>?C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>?C"
       unfolding openin_open by auto
     with 1 obtain D where "D \<subseteq> ?C" and "finite D" and "S \<subseteq> \<Union>D"
       by metis
     let ?D = "inv_into C (\<lambda>T. S \<inter> T) ` D"
     have "?D \<subseteq> C \<and> finite ?D \<and> S \<subseteq> \<Union>?D"
     proof (intro conjI)
       from \<open>D \<subseteq> ?C\<close> show "?D \<subseteq> C"
         by (fast intro: inv_into_into)
       from \<open>finite D\<close> show "finite ?D"
         by (rule finite_imageI)
       from \<open>S \<subseteq> \<Union>D\<close> show "S \<subseteq> \<Union>?D"
         apply (rule subset_trans, clarsimp)
         apply (frule subsetD [OF \<open>D \<subseteq> ?C\<close>, THEN f_inv_into_f])
         apply (erule rev_bexI, fast)
         done
     qed
     then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
   qed
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma interior_image_subset:
   assumes "inj f" "\<And>x. continuous (at x) f"
   shows "interior (f ` S) \<subseteq> f ` (interior S)"
 proof
   fix x assume "x \<in> interior (f ` S)"
   then obtain T where as: "open T" "x \<in> T" "T \<subseteq> f ` S" ..
   then have "x \<in> f ` S" by auto
   then obtain y where y: "y \<in> S" "x = f y" by auto
   have "open (f -` T)"
     using assms \<open>open T\<close> by (simp add: continuous_at_imp_continuous_on open_vimage)
   moreover have "y \<in> vimage f T"
     using \<open>x = f y\<close> \<open>x \<in> T\<close> by simp
   moreover have "vimage f T \<subseteq> S"
     using \<open>T \<subseteq> image f S\<close> \<open>inj f\<close> unfolding inj_on_def subset_eq by auto
   ultimately have "y \<in> interior S" ..
   with \<open>x = f y\<close> show "x \<in> f ` interior S" ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Equality of continuous functions on closure and related results\<close>
 
 lemma continuous_closedin_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x = a}"
   using continuous_closedin_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_closed_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closed S \<Longrightarrow> closed {x \<in> S. f x = a}"
   using continuous_closed_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_constant_on_closure:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes "continuous_on (closure S) f"
       and "\<And>x. x \<in> S \<Longrightarrow> f x = a"
       and "x \<in> closure S"
   shows "f x = a"
     using continuous_closed_preimage_constant[of "closure S" f a]
       assms closure_minimal[of S "{x \<in> closure S. f x = a}"] closure_subset
     unfolding subset_eq
     by auto
 
 lemma image_closure_subset:
   assumes contf: "continuous_on (closure S) f"
     and "closed T"
     and "(f ` S) \<subseteq> T"
   shows "f ` (closure S) \<subseteq> T"
 proof -
   have "S \<subseteq> {x \<in> closure S. f x \<in> T}"
     using assms(3) closure_subset by auto
   moreover have "closed (closure S \<inter> f -` T)"
     using continuous_closed_preimage[OF contf] \<open>closed T\<close> by auto
   ultimately have "closure S = (closure S \<inter> f -` T)"
     using closure_minimal[of S "(closure S \<inter> f -` T)"] by auto
   then show ?thesis by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A function constant on a set\<close>
 
 definition constant_on  (infixl "(constant'_on)" 50)
   where "f constant_on A \<equiv> \<exists>y. \<forall>x\<in>A. f x = y"
 
 lemma constant_on_subset: "\<lbrakk>f constant_on A; B \<subseteq> A\<rbrakk> \<Longrightarrow> f constant_on B"
   unfolding constant_on_def by blast
 
 lemma injective_not_constant:
   fixes S :: "'a::{perfect_space} set"
   shows "\<lbrakk>open S; inj_on f S; f constant_on S\<rbrakk> \<Longrightarrow> S = {}"
 unfolding constant_on_def
 by (metis equals0I inj_on_contraD islimpt_UNIV islimpt_def)
 
 lemma constant_on_closureI:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes cof: "f constant_on S" and contf: "continuous_on (closure S) f"
     shows "f constant_on (closure S)"
 using continuous_constant_on_closure [OF contf] cof unfolding constant_on_def
 by metis
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Continuity relative to a union.\<close>
 
 lemma continuous_on_Un_local:
     "\<lbrakk>closedin (top_of_set (s \<union> t)) s; closedin (top_of_set (s \<union> t)) t;
       continuous_on s f; continuous_on t f\<rbrakk>
      \<Longrightarrow> continuous_on (s \<union> t) f"
   unfolding continuous_on closedin_limpt
   by (metis Lim_trivial_limit Lim_within_union Un_iff trivial_limit_within)
 
 lemma continuous_on_cases_local:
      "\<lbrakk>closedin (top_of_set (s \<union> t)) s; closedin (top_of_set (s \<union> t)) t;
        continuous_on s f; continuous_on t g;
        \<And>x. \<lbrakk>x \<in> s \<and> \<not>P x \<or> x \<in> t \<and> P x\<rbrakk> \<Longrightarrow> f x = g x\<rbrakk>
       \<Longrightarrow> continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
   by (rule continuous_on_Un_local) (auto intro: continuous_on_eq)
 
 lemma continuous_on_cases_le:
   fixes h :: "'a :: topological_space \<Rightarrow> real"
   assumes "continuous_on {t \<in> s. h t \<le> a} f"
       and "continuous_on {t \<in> s. a \<le> h t} g"
       and h: "continuous_on s h"
       and "\<And>t. \<lbrakk>t \<in> s; h t = a\<rbrakk> \<Longrightarrow> f t = g t"
     shows "continuous_on s (\<lambda>t. if h t \<le> a then f(t) else g(t))"
 proof -
   have s: "s = (s \<inter> h -` atMost a) \<union> (s \<inter> h -` atLeast a)"
     by force
   have 1: "closedin (top_of_set s) (s \<inter> h -` atMost a)"
     by (rule continuous_closedin_preimage [OF h closed_atMost])
   have 2: "closedin (top_of_set s) (s \<inter> h -` atLeast a)"
     by (rule continuous_closedin_preimage [OF h closed_atLeast])
   have eq: "s \<inter> h -` {..a} = {t \<in> s. h t \<le> a}" "s \<inter> h -` {a..} = {t \<in> s. a \<le> h t}"
     by auto
   show ?thesis
     apply (rule continuous_on_subset [of s, OF _ order_refl])
     apply (subst s)
     apply (rule continuous_on_cases_local)
     using 1 2 s assms apply (auto simp: eq)
     done
 qed
 
 lemma continuous_on_cases_1:
   fixes s :: "real set"
   assumes "continuous_on {t \<in> s. t \<le> a} f"
       and "continuous_on {t \<in> s. a \<le> t} g"
       and "a \<in> s \<Longrightarrow> f a = g a"
     shows "continuous_on s (\<lambda>t. if t \<le> a then f(t) else g(t))"
 using assms
-by (auto simp: continuous_on_id intro: continuous_on_cases_le [where h = id, simplified])
+by (auto intro: continuous_on_cases_le [where h = id, simplified])
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Inverse function property for open/closed maps\<close>
 
 lemma continuous_on_inverse_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_open [of T g] gTS) (metis openin_imp_subset fU oo)
 qed
 
 lemma continuous_on_inverse_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_closed [of T g] gTS) (metis closedin_imp_subset fU oo)
 qed
 
 lemma homeomorphism_injective_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_open_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_injective_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_closed_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_imp_open_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "openin (top_of_set S) U"
   shows "openin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using openin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_open oo)
 qed
 
 lemma homeomorphism_imp_closed_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "closedin (top_of_set S) U"
   shows "closedin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using closedin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_closed oo)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Seperability\<close>
 
 lemma subset_second_countable:
   obtains \<B> :: "'a:: second_countable_topology set set"
     where "countable \<B>"
           "{} \<notin> \<B>"
           "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
           "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
 proof -
   obtain \<B> :: "'a set set"
     where "countable \<B>"
       and opeB: "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
       and \<B>:    "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
   proof -
     obtain \<C> :: "'a set set"
       where "countable \<C>" and ope: "\<And>C. C \<in> \<C> \<Longrightarrow> open C"
         and \<C>: "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<C> \<and> S = \<Union>U"
       by (metis univ_second_countable that)
     show ?thesis
     proof
       show "countable ((\<lambda>C. S \<inter> C) ` \<C>)"
         by (simp add: \<open>countable \<C>\<close>)
       show "\<And>C. C \<in> (\<inter>) S ` \<C> \<Longrightarrow> openin (top_of_set S) C"
         using ope by auto
       show "\<And>T. openin (top_of_set S) T \<Longrightarrow> \<exists>\<U>\<subseteq>(\<inter>) S ` \<C>. T = \<Union>\<U>"
         by (metis \<C> image_mono inf_Sup openin_open)
     qed
   qed
   show ?thesis
   proof
     show "countable (\<B> - {{}})"
       using \<open>countable \<B>\<close> by blast
     show "\<And>C. \<lbrakk>C \<in> \<B> - {{}}\<rbrakk> \<Longrightarrow> openin (top_of_set S) C"
       by (simp add: \<open>\<And>C. C \<in> \<B> \<Longrightarrow> openin (top_of_set S) C\<close>)
     show "\<exists>\<U>\<subseteq>\<B> - {{}}. T = \<Union>\<U>" if "openin (top_of_set S) T" for T
       using \<B> [OF that]
       apply clarify
       apply (rule_tac x="\<U> - {{}}" in exI, auto)
         done
   qed auto
 qed
 
 lemma Lindelof_openin:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set U) S"
   obtains \<F>' where "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
 proof -
   have "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>T. open T \<and> S = U \<inter> T"
     using assms by (simp add: openin_open)
   then obtain tf where tf: "\<And>S. S \<in> \<F> \<Longrightarrow> open (tf S) \<and> (S = U \<inter> tf S)"
     by metis
   have [simp]: "\<And>\<F>'. \<F>' \<subseteq> \<F> \<Longrightarrow> \<Union>\<F>' = U \<inter> \<Union>(tf ` \<F>')"
     using tf by fastforce
   obtain \<G> where "countable \<G> \<and> \<G> \<subseteq> tf ` \<F>" "\<Union>\<G> = \<Union>(tf ` \<F>)"
     using tf by (force intro: Lindelof [of "tf ` \<F>"])
   then obtain \<F>' where \<F>': "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
     by (clarsimp simp add: countable_subset_image)
   then show ?thesis ..
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed Maps\<close>
 
 lemma continuous_imp_closed_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "closedin (top_of_set S) U"
           "continuous_on S f" "f ` S = T" "compact S"
     shows "closedin (top_of_set T) (f ` U)"
   by (metis assms closedin_compact_eq compact_continuous_image continuous_on_subset subset_image_iff)
 
 lemma closed_map_restrict:
   assumes cloU: "closedin (top_of_set (S \<inter> f -` T')) U"
     and cc: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "closedin (top_of_set T') (f ` U)"
 proof -
   obtain V where "closed V" "U = S \<inter> f -` T' \<inter> V"
     using cloU by (auto simp: closedin_closed)
   with cc [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: closedin_closed)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Open Maps\<close>
 
 lemma open_map_restrict:
   assumes opeU: "openin (top_of_set (S \<inter> f -` T')) U"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "openin (top_of_set T') (f ` U)"
 proof -
   obtain V where "open V" "U = S \<inter> f -` T' \<inter> V"
     using opeU by (auto simp: openin_open)
   with oo [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: openin_open)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Quotient maps\<close>
 
 lemma quotient_map_imp_continuous_open:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
               \<Longrightarrow> (openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                    openin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     using ope [OF T]
     apply (simp add: continuous_on_open)
     by (meson ope openin_imp_subset openin_trans)
 qed
 
 lemma quotient_map_imp_continuous_closed:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
                   \<Longrightarrow> (closedin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                        closedin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     using ope [OF T]
     apply (simp add: continuous_on_closed)
     by (metis (no_types, lifting) ope closedin_imp_subset closedin_trans)
 qed
 
 lemma open_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. openin (top_of_set S) T
                    \<Longrightarrow> openin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) =
            openin (top_of_set (f ` S)) T"
 proof -
   have "T = f ` (S \<inter> f -` T)"
     using T by blast
   then show ?thesis
     using "ope" contf continuous_on_open by metis
 qed
 
 lemma closed_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. closedin (top_of_set S) T
               \<Longrightarrow> closedin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
            openin (top_of_set (f ` S)) T"
           (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have *: "closedin (top_of_set S) (S - (S \<inter> f -` T))"
     using closedin_diff by fastforce
   have [simp]: "(f ` S - f ` (S - (S \<inter> f -` T))) = T"
     using T by blast
   show ?rhs
     using ope [OF *, unfolded closedin_def] by auto
 next
   assume ?rhs
   with contf show ?lhs
     by (auto simp: continuous_on_open)
 qed
 
 lemma continuous_right_inverse_imp_quotient_map:
   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T"
       and contg: "continuous_on T g" and img: "g ` T \<subseteq> S"
       and fg [simp]: "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y"
       and U: "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
           (is "?lhs = ?rhs")
 proof -
   have f: "\<And>Z. openin (top_of_set (f ` S)) Z \<Longrightarrow>
                 openin (top_of_set S) (S \<inter> f -` Z)"
   and  g: "\<And>Z. openin (top_of_set (g ` T)) Z \<Longrightarrow>
                 openin (top_of_set T) (T \<inter> g -` Z)"
     using contf contg by (auto simp: continuous_on_open)
   show ?thesis
   proof
     have "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = {x \<in> T. f (g x) \<in> U}"
       using imf img by blast
     also have "... = U"
       using U by auto
     finally have eq: "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = U" .
     assume ?lhs
     then have *: "openin (top_of_set (g ` T)) (g ` T \<inter> (S \<inter> f -` U))"
       by (meson img openin_Int openin_subtopology_Int_subset openin_subtopology_self)
     show ?rhs
       using g [OF *] eq by auto
   next
     assume rhs: ?rhs
     show ?lhs
       by (metis f fg image_eqI image_subset_iff imf img openin_subopen openin_subtopology_self openin_trans rhs)
   qed
 qed
 
 lemma continuous_left_inverse_imp_quotient_map:
   assumes "continuous_on S f"
       and "continuous_on (f ` S) g"
       and  "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
       and "U \<subseteq> f ` S"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set (f ` S)) U"
 apply (rule continuous_right_inverse_imp_quotient_map)
 using assms apply force+
 done
 
 lemma continuous_imp_quotient_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "continuous_on S f" "f ` S = T" "compact S" "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
   by (metis (no_types, lifting) assms closed_map_imp_quotient_map continuous_imp_closed_map)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Pasting lemmas for functions, for of casewise definitions\<close>
 
 subsubsection\<open>on open sets\<close>
 
 lemma pasting_lemma:
   assumes ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
       and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
     shows "continuous_map X Y g"
   unfolding continuous_map_openin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace topspace_subtopology by fastforce
 next
   fix U
   assume Y: "openin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using ope by (simp add: openin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have "\<And>i. i \<in> I \<Longrightarrow> openin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_openin_preimage_eq
     by (metis Y T inf.commute inf_absorb1 ope topspace_subtopology openin_trans_full)
   then show "openin X (topspace X \<inter> g -` U)"
     by (auto simp: *)
 qed
 
 lemma pasting_lemma_exists:
   assumes X: "topspace X \<subseteq> (\<Union>i \<in> I. T i)"
       and ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   let ?h = "\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x"
   show "continuous_map X Y ?h"
     apply (rule pasting_lemma [OF ope cont])
      apply (blast intro: f)+
     by (metis (no_types, lifting) UN_E X subsetD someI_ex)
   show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x" if "i \<in> I" "x \<in> topspace X \<inter> T i" for i x
     by (metis (no_types, lifting) IntD2 IntI f someI_ex that)
 qed
 
 lemma pasting_lemma_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   unfolding continuous_map_closedin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace topspace_subtopology by fastforce
 next
   fix U
   assume Y: "closedin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using clo by (simp add: closedin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have cTf: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_closedin_preimage_eq topspace_subtopology
     by (simp add: Int_absorb1 T Y clo closedin_closed_subtopology)
   have sub: "{Z \<in> (\<lambda>i. T i \<inter> f i -` U) ` I. Z \<inter> V \<noteq> {}}
            \<subseteq> (\<lambda>i. T i \<inter> f i -` U) ` {i \<in> I. T i \<inter> V \<noteq> {}}" for V
     by auto
   have 1: "(\<Union>i\<in>I. T i \<inter> f i -` U) \<subseteq> topspace X"
     using T by blast
   then have lf: "locally_finite_in X ((\<lambda>i. T i \<inter> f i -` U) ` I)"
     unfolding locally_finite_in_def
     using finite_subset [OF sub] fin by force
   show "closedin X (topspace X \<inter> g -` U)"
     apply (subst *)
     apply (rule closedin_locally_finite_Union)
      apply (auto intro: cTf lf)
     done
 qed
 
 subsubsection\<open>Likewise on closed sets, with a finiteness assumption\<close>
 
 lemma pasting_lemma_closed:
   assumes fin: "finite I"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   using pasting_lemma_locally_finite [OF _ clo cont f g] fin by auto
 
 lemma pasting_lemma_exists_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f(@i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_locally_finite [OF fin])
         apply (blast intro: assms)+
     by (metis (no_types, lifting) UN_E X set_rev_mp someI_ex)
 next
   fix x i
   assume "i \<in> I" and "x \<in> topspace X \<inter> T i"
   show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     apply (rule someI2_ex)
     using \<open>i \<in> I\<close> \<open>x \<in> topspace X \<inter> T i\<close> apply blast
     by (meson Int_iff \<open>i \<in> I\<close> \<open>x \<in> topspace X \<inter> T i\<close> f)
 qed
 
 lemma pasting_lemma_exists_closed:
   assumes fin: "finite I"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_closed [OF \<open>finite I\<close> clo cont])
      apply (blast intro: f)+
     by (metis (mono_tags, lifting) UN_iff X someI_ex subset_iff)
 next
   fix x i
   assume "i \<in> I" "x \<in> topspace X \<inter> T i"
   then show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     by (metis (no_types, lifting) IntD2 IntI f someI_ex)
 qed
 
 lemma continuous_map_cases:
   assumes f: "continuous_map (subtopology X (X closure_of {x. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x. \<not> P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x. P x} \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
 proof (rule pasting_lemma_closed)
   let ?f = "\<lambda>b. if b then f else g"
   let ?g = "\<lambda>x. if P x then f x else g x"
   let ?T = "\<lambda>b. if b then X closure_of {x. P x} else X closure_of {x. ~P x}"
   show "finite {True,False}" by auto
   have eq: "topspace X - Collect P = topspace X \<inter> {x. \<not> P x}"
     by blast
   show "?f i x = ?f j x"
     if "i \<in> {True,False}" "j \<in> {True,False}" and x: "x \<in> topspace X \<inter> ?T i \<inter> ?T j" for i j x
   proof -
     have "f x = g x"
       if "i" "\<not> j"
       apply (rule fg)
       unfolding frontier_of_closures eq
       using x that closure_of_restrict by fastforce
     moreover
     have "g x = f x"
       if "x \<in> X closure_of {x. \<not> P x}" "x \<in> X closure_of Collect P" "\<not> i" "j" for x
         apply (rule fg [symmetric])
         unfolding frontier_of_closures eq
         using x that closure_of_restrict by fastforce
     ultimately show ?thesis
       using that by (auto simp flip: closure_of_restrict)
   qed
   show "\<exists>j. j \<in> {True,False} \<and> x \<in> ?T j \<and> (if P x then f x else g x) = ?f j x"
     if "x \<in> topspace X" for x
     apply simp
     apply safe
     apply (metis Int_iff closure_of inf_sup_absorb mem_Collect_eq that)
     by (metis DiffI eq closure_of_subset_Int contra_subsetD mem_Collect_eq that)
 qed (auto simp: f g)
 
 lemma continuous_map_cases_alt:
   assumes f: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. ~P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x \<in> topspace X. P x} \<Longrightarrow> f x = g x"
     shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
   apply (rule continuous_map_cases)
   using assms
     apply (simp_all add: Collect_conj_eq closure_of_restrict [symmetric] frontier_of_restrict [symmetric])
   done
 
 lemma continuous_map_cases_function:
   assumes contp: "continuous_map X Z p"
     and contf: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of U}) Y f"
     and contg: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x \<in> Z frontier_of U\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<in> U then f x else g x)"
 proof (rule continuous_map_cases_alt)
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<in> U})) Y f"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of U}"
     show "continuous_map (subtopology X ?T) Y f"
       by (simp add: contf)
     show "X closure_of {x \<in> topspace X. p x \<in> U} \<subseteq> ?T"
       by (rule continuous_map_closure_preimage_subset [OF contp])
   qed
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<notin> U})) Y g"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}"
     show "continuous_map (subtopology X ?T) Y g"
       by (simp add: contg)
     have "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> X closure_of {x \<in> topspace X. p x \<in> topspace Z - U}"
       apply (rule closure_of_mono)
       using continuous_map_closedin contp by fastforce
     then show "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> ?T"
       by (rule order_trans [OF _ continuous_map_closure_preimage_subset [OF contp]])
   qed
 next
   show "f x = g x" if "x \<in> X frontier_of {x \<in> topspace X. p x \<in> U}" for x
     using that continuous_map_frontier_frontier_preimage_subset [OF contp, of U] fg by blast
 qed
 
 subsection \<open>Retractions\<close>
 
 definition\<^marker>\<open>tag important\<close> retraction :: "('a::topological_space) set \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> bool"
 where "retraction S T r \<longleftrightarrow>
   T \<subseteq> S \<and> continuous_on S r \<and> r ` S \<subseteq> T \<and> (\<forall>x\<in>T. r x = x)"
 
 definition\<^marker>\<open>tag important\<close> retract_of (infixl "retract'_of" 50) where
 "T retract_of S  \<longleftrightarrow>  (\<exists>r. retraction S T r)"
 
 lemma retraction_idempotent: "retraction S T r \<Longrightarrow> x \<in> S \<Longrightarrow>  r (r x) = r x"
   unfolding retraction_def by auto
 
 text \<open>Preservation of fixpoints under (more general notion of) retraction\<close>
 
 lemma invertible_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes contt: "continuous_on T i"
     and "i ` T \<subseteq> S"
     and contr: "continuous_on S r"
     and "r ` S \<subseteq> T"
     and ri: "\<And>y. y \<in> T \<Longrightarrow> r (i y) = y"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   have "\<exists>x\<in>S. (i \<circ> g \<circ> r) x = x"
   proof (rule FP)
     show "continuous_on S (i \<circ> g \<circ> r)"
       by (meson contt contr assms(4) contg assms(8) continuous_on_compose continuous_on_subset)
     show "(i \<circ> g \<circ> r) ` S \<subseteq> S"
       using assms(2,4,8) by force
   qed
   then obtain x where x: "x \<in> S" "(i \<circ> g \<circ> r) x = x" ..
   then have *: "g (r x) \<in> T"
     using assms(4,8) by auto
   have "r ((i \<circ> g \<circ> r) x) = r x"
     using x by auto
   then show ?thesis
     using "*" ri that by auto
 qed
 
 lemma homeomorphic_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes "S homeomorphic T"
   shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> S \<longrightarrow> (\<exists>x\<in>S. f x = x)) \<longleftrightarrow>
          (\<forall>g. continuous_on T g \<and> g ` T \<subseteq> T \<longrightarrow> (\<exists>y\<in>T. g y = y))"
          (is "?lhs = ?rhs")
 proof -
   obtain r i where r:
       "\<forall>x\<in>S. i (r x) = x" "r ` S = T" "continuous_on S r"
       "\<forall>y\<in>T. r (i y) = y" "i ` T = S" "continuous_on T i"
     using assms unfolding homeomorphic_def homeomorphism_def  by blast
   show ?thesis
   proof
     assume ?lhs
     with r show ?rhs
       by (metis invertible_fixpoint_property[of T i S r] order_refl)
   next
     assume ?rhs
     with r show ?lhs
       by (metis invertible_fixpoint_property[of S r T i] order_refl)
   qed
 qed
 
 lemma retract_fixpoint_property:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
     and S :: "'a set"
   assumes "T retract_of S"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   obtain h where "retraction S T h"
     using assms(1) unfolding retract_of_def ..
   then show ?thesis
     unfolding retraction_def
     using invertible_fixpoint_property[OF continuous_on_id _ _ _ _ FP]
     by (metis assms(4) contg image_ident that)
 qed
 
 lemma retraction:
   "retraction S T r \<longleftrightarrow>
     T \<subseteq> S \<and> continuous_on S r \<and> r ` S = T \<and> (\<forall>x \<in> T. r x = x)"
   by (force simp: retraction_def)
 
 lemma retractionE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "retraction S T r"
   obtains "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof (rule that)
   from retraction [of S T r] assms
   have "T \<subseteq> S" "continuous_on S r" "r ` S = T" and "\<forall>x \<in> T. r x = x"
     by simp_all
   then show "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r"
     by simp_all
   from \<open>\<forall>x \<in> T. r x = x\<close> have "r x = x" if "x \<in> T" for x
     using that by simp
   with \<open>r ` S = T\<close> show "r (r x) = r x" if "x \<in> S" for x
     using that by auto
 qed
 
 lemma retract_ofE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "T retract_of S"
   obtains r where "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof -
   from assms obtain r where "retraction S T r"
     by (auto simp add: retract_of_def)
   with that show thesis
     by (auto elim: retractionE)
 qed
 
 lemma retract_of_imp_extensible:
   assumes "S retract_of T" and "continuous_on S f" and "f ` S \<subseteq> U"
   obtains g where "continuous_on T g" "g ` T \<subseteq> U" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   from \<open>S retract_of T\<close> obtain r where "retraction T S r"
     by (auto simp add: retract_of_def)
   show thesis
     by (rule that [of "f \<circ> r"])
       (use \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> U\<close> \<open>retraction T S r\<close> in \<open>auto simp: continuous_on_compose2 retraction\<close>)
 qed
 
 lemma idempotent_imp_retraction:
   assumes "continuous_on S f" and "f ` S \<subseteq> S" and "\<And>x. x \<in> S \<Longrightarrow> f(f x) = f x"
     shows "retraction S (f ` S) f"
 by (simp add: assms retraction)
 
 lemma retraction_subset:
   assumes "retraction S T r" and "T \<subseteq> s'" and "s' \<subseteq> S"
   shows "retraction s' T r"
   unfolding retraction_def
   by (metis assms continuous_on_subset image_mono retraction)
 
 lemma retract_of_subset:
   assumes "T retract_of S" and "T \<subseteq> s'" and "s' \<subseteq> S"
     shows "T retract_of s'"
 by (meson assms retract_of_def retraction_subset)
 
 lemma retraction_refl [simp]: "retraction S S (\<lambda>x. x)"
 by (simp add: retraction)
 
 lemma retract_of_refl [iff]: "S retract_of S"
   unfolding retract_of_def retraction_def
   using continuous_on_id by blast
 
 lemma retract_of_imp_subset:
    "S retract_of T \<Longrightarrow> S \<subseteq> T"
 by (simp add: retract_of_def retraction_def)
 
 lemma retract_of_empty [simp]:
      "({} retract_of S) \<longleftrightarrow> S = {}"  "(S retract_of {}) \<longleftrightarrow> S = {}"
 by (auto simp: retract_of_def retraction_def)
 
 lemma retract_of_singleton [iff]: "({x} retract_of S) \<longleftrightarrow> x \<in> S"
   unfolding retract_of_def retraction_def by force
 
 lemma retraction_comp:
    "\<lbrakk>retraction S T f; retraction T U g\<rbrakk>
         \<Longrightarrow> retraction S U (g \<circ> f)"
 apply (auto simp: retraction_def intro: continuous_on_compose2)
 by blast
 
 lemma retract_of_trans [trans]:
   assumes "S retract_of T" and "T retract_of U"
     shows "S retract_of U"
 using assms by (auto simp: retract_of_def intro: retraction_comp)
 
 lemma closedin_retract:
   fixes S :: "'a :: t2_space set"
   assumes "S retract_of T"
     shows "closedin (top_of_set T) S"
 proof -
   obtain r where r: "S \<subseteq> T" "continuous_on T r" "r ` T \<subseteq> S" "\<And>x. x \<in> S \<Longrightarrow> r x = x"
     using assms by (auto simp: retract_of_def retraction_def)
   have "S = {x\<in>T. x = r x}"
     using r by auto
   also have "\<dots> = T \<inter> ((\<lambda>x. (x, r x)) -` ({y. \<exists>x. y = (x, x)}))"
     unfolding vimage_def mem_Times_iff fst_conv snd_conv
     using r
     by auto
   also have "closedin (top_of_set T) \<dots>"
     by (rule continuous_closedin_preimage) (auto intro!: closed_diagonal continuous_on_Pair r)
   finally show ?thesis .
 qed
 
 lemma closedin_self [simp]: "closedin (top_of_set S) S"
   by simp
 
 lemma retract_of_closed:
     fixes S :: "'a :: t2_space set"
     shows "\<lbrakk>closed T; S retract_of T\<rbrakk> \<Longrightarrow> closed S"
   by (metis closedin_retract closedin_closed_eq)
 
 lemma retract_of_compact:
      "\<lbrakk>compact T; S retract_of T\<rbrakk> \<Longrightarrow> compact S"
   by (metis compact_continuous_image retract_of_def retraction)
 
 lemma retract_of_connected:
     "\<lbrakk>connected T; S retract_of T\<rbrakk> \<Longrightarrow> connected S"
   by (metis Topological_Spaces.connected_continuous_image retract_of_def retraction)
 
 lemma retraction_openin_vimage_iff:
   "openin (top_of_set S) (S \<inter> r -` U) \<longleftrightarrow> openin (top_of_set T) U"
   if retraction: "retraction S T r" and "U \<subseteq> T"
   using retraction apply (rule retractionE)
   apply (rule continuous_right_inverse_imp_quotient_map [where g=r])
   using \<open>U \<subseteq> T\<close> apply (auto elim: continuous_on_subset)
   done
 
 lemma retract_of_Times:
    "\<lbrakk>S retract_of s'; T retract_of t'\<rbrakk> \<Longrightarrow> (S \<times> T) retract_of (s' \<times> t')"
 apply (simp add: retract_of_def retraction_def Sigma_mono, clarify)
 apply (rename_tac f g)
 apply (rule_tac x="\<lambda>z. ((f \<circ> fst) z, (g \<circ> snd) z)" in exI)
 apply (rule conjI continuous_intros | erule continuous_on_subset | force)+
 done
 
 subsection\<open>Retractions on a topological space\<close>
 
 definition retract_of_space :: "'a set \<Rightarrow> 'a topology \<Rightarrow> bool" (infix "retract'_of'_space" 50)
   where "S retract_of_space X
          \<equiv> S \<subseteq> topspace X \<and> (\<exists>r. continuous_map X (subtopology X S) r \<and> (\<forall>x \<in> S. r x = x))"
 
 lemma retract_of_space_retraction_maps:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> (\<exists>r. retraction_maps X (subtopology X S) r id)"
   by (auto simp: retract_of_space_def retraction_maps_def)
 
 lemma retract_of_space_section_map:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> section_map (subtopology X S) X id"
   unfolding retract_of_space_def retraction_maps_def section_map_def
   by (auto simp: continuous_map_from_subtopology)
 
 lemma retract_of_space_imp_subset:
    "S retract_of_space X \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: retract_of_space_def)
 
 lemma retract_of_space_topspace:
    "topspace X retract_of_space X"
   using retract_of_space_def by force
 
 lemma retract_of_space_empty [simp]:
    "{} retract_of_space X \<longleftrightarrow> topspace X = {}"
   by (auto simp: continuous_map_def retract_of_space_def)
 
 lemma retract_of_space_singleton [simp]:
   "{a} retract_of_space X \<longleftrightarrow> a \<in> topspace X"
 proof -
   have "continuous_map X (subtopology X {a}) (\<lambda>x. a) \<and> (\<lambda>x. a) a = a" if "a \<in> topspace X"
     using that by simp
   then show ?thesis
     by (force simp: retract_of_space_def)
 qed
 
 lemma retract_of_space_clopen:
   assumes "openin X S" "closedin X S" "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by blast
   show ?thesis
     unfolding retract_of_space_def
   proof (intro exI conjI)
     show "S \<subseteq> topspace X"
       by (simp add: assms closedin_subset)
     have "continuous_map X X (\<lambda>x. if x \<in> S then x else a)"
     proof (rule continuous_map_cases)
       show "continuous_map (subtopology X (X closure_of {x. x \<in> S})) X (\<lambda>x. x)"
         by (simp add: continuous_map_from_subtopology)
       show "continuous_map (subtopology X (X closure_of {x. x \<notin> S})) X (\<lambda>x. a)"
         using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close> by force
       show "x = a" if "x \<in> X frontier_of {x. x \<in> S}" for x
         using assms that clopenin_eq_frontier_of by fastforce
     qed
     then show "continuous_map X (subtopology X S) (\<lambda>x. if x \<in> S then x else a)"
       using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close>  by (auto simp: continuous_map_in_subtopology)
   qed auto
 qed (use assms in auto)
 
 lemma retract_of_space_disjoint_union:
   assumes "openin X S" "openin X T" and ST: "disjnt S T" "S \<union> T = topspace X" and "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (rule retract_of_space_clopen)
   have "S \<inter> T = {}"
     by (meson ST disjnt_def)
   then have "S = topspace X - T"
     using ST by auto
   then show "closedin X S"
     using \<open>openin X T\<close> by blast
 qed (auto simp: assms)
 
 lemma retraction_maps_section_image1:
   assumes "retraction_maps X Y r s"
   shows "s ` (topspace Y) retract_of_space X"
   unfolding retract_of_space_section_map
 proof
   show "s ` topspace Y \<subseteq> topspace X"
     using assms continuous_map_image_subset_topspace retraction_maps_def by blast
   show "section_map (subtopology X (s ` topspace Y)) X id"
     unfolding section_map_def
     using assms retraction_maps_to_retract_maps by blast
 qed
 
 lemma retraction_maps_section_image2:
    "retraction_maps X Y r s
         \<Longrightarrow> subtopology X (s ` (topspace Y)) homeomorphic_space Y"
   using embedding_map_imp_homeomorphic_space homeomorphic_space_sym section_imp_embedding_map
         section_map_def by blast
 
 subsection\<open>Paths and path-connectedness\<close>
 
 definition pathin :: "'a topology \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool" where
    "pathin X g \<equiv> continuous_map (subtopology euclideanreal {0..1}) X g"
 
 lemma pathin_compose:
      "\<lbrakk>pathin X g; continuous_map X Y f\<rbrakk> \<Longrightarrow> pathin Y (f \<circ> g)"
    by (simp add: continuous_map_compose pathin_def)
 
 lemma pathin_subtopology:
      "pathin (subtopology X S) g \<longleftrightarrow> pathin X g \<and> (\<forall>x \<in> {0..1}. g x \<in> S)"
   by (auto simp: pathin_def continuous_map_in_subtopology)
 
 lemma pathin_const:
    "pathin X (\<lambda>x. a) \<longleftrightarrow> a \<in> topspace X"
   by (simp add: pathin_def)
    
 lemma path_start_in_topspace: "pathin X g \<Longrightarrow> g 0 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_finish_in_topspace: "pathin X g \<Longrightarrow> g 1 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_image_subset_topspace: "pathin X g \<Longrightarrow> g ` ({0..1}) \<subseteq> topspace X"
   by (force simp: pathin_def continuous_map)
 
 definition path_connected_space :: "'a topology \<Rightarrow> bool"
   where "path_connected_space X \<equiv> \<forall>x \<in> topspace X. \<forall> y \<in> topspace X. \<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y"
 
 definition path_connectedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool"
   where "path_connectedin X S \<equiv> S \<subseteq> topspace X \<and> path_connected_space(subtopology X S)"
 
 lemma path_connectedin_absolute [simp]:
      "path_connectedin (subtopology X S) S \<longleftrightarrow> path_connectedin X S"
-  by (simp add: path_connectedin_def subtopology_subtopology topspace_subtopology)
+  by (simp add: path_connectedin_def subtopology_subtopology)
 
 lemma path_connectedin_subset_topspace:
      "path_connectedin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: path_connectedin_def)
 
 lemma path_connectedin_subtopology:
      "path_connectedin (subtopology X S) T \<longleftrightarrow> path_connectedin X T \<and> T \<subseteq> S"
-  by (auto simp: path_connectedin_def subtopology_subtopology topspace_subtopology inf.absorb2)
+  by (auto simp: path_connectedin_def subtopology_subtopology inf.absorb2)
 
 lemma path_connectedin:
      "path_connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         (\<forall>x \<in> S. \<forall>y \<in> S. \<exists>g. pathin X g \<and> g ` {0..1} \<subseteq> S \<and> g 0 = x \<and> g 1 = y)"
   unfolding path_connectedin_def path_connected_space_def pathin_def continuous_map_in_subtopology
-  by (intro conj_cong refl ball_cong) (simp_all add: inf.absorb_iff2 topspace_subtopology)
+  by (intro conj_cong refl ball_cong) (simp_all add: inf.absorb_iff2)
 
 lemma path_connectedin_topspace:
      "path_connectedin X (topspace X) \<longleftrightarrow> path_connected_space X"
   by (simp add: path_connectedin_def)
 
 lemma path_connected_imp_connected_space:
   assumes "path_connected_space X"
   shows "connected_space X"
 proof -
   have *: "\<exists>S. connectedin X S \<and> g 0 \<in> S \<and> g 1 \<in> S" if "pathin X g" for g
   proof (intro exI conjI)
     have "continuous_map (subtopology euclideanreal {0..1}) X g"
       using connectedin_absolute that by (simp add: pathin_def)
     then show "connectedin X (g ` {0..1})"
       by (rule connectedin_continuous_map_image) auto
   qed auto
   show ?thesis
     using assms
     by (auto intro: * simp add: path_connected_space_def connected_space_subconnected Ball_def)
 qed
 
 lemma path_connectedin_imp_connectedin:
      "path_connectedin X S \<Longrightarrow> connectedin X S"
   by (simp add: connectedin_def path_connected_imp_connected_space path_connectedin_def)
 
 lemma path_connected_space_topspace_empty:
      "topspace X = {} \<Longrightarrow> path_connected_space X"
   by (simp add: path_connected_space_def)
 
 lemma path_connectedin_empty [simp]: "path_connectedin X {}"
   by (simp add: path_connectedin)
 
 lemma path_connectedin_singleton [simp]: "path_connectedin X {a} \<longleftrightarrow> a \<in> topspace X"
 proof
   show "path_connectedin X {a} \<Longrightarrow> a \<in> topspace X"
     by (simp add: path_connectedin)
   show "a \<in> topspace X \<Longrightarrow> path_connectedin X {a}"
     unfolding path_connectedin
     using pathin_const by fastforce
 qed
 
 lemma path_connectedin_continuous_map_image:
   assumes f: "continuous_map X Y f" and S: "path_connectedin X S"
   shows "path_connectedin Y (f ` S)"
 proof -
   have fX: "f ` (topspace X) \<subseteq> topspace Y"
     by (metis f continuous_map_image_subset_topspace)
   show ?thesis
     unfolding path_connectedin
   proof (intro conjI ballI; clarify?)
     fix x
     assume "x \<in> S"
     show "f x \<in> topspace Y"
       by (meson S fX \<open>x \<in> S\<close> image_subset_iff path_connectedin_subset_topspace set_mp)
   next
     fix x y
     assume "x \<in> S" and "y \<in> S"
     then obtain g where g: "pathin X g" "g ` {0..1} \<subseteq> S" "g 0 = x" "g 1 = y"
       using S  by (force simp: path_connectedin)
     show "\<exists>g. pathin Y g \<and> g ` {0..1} \<subseteq> f ` S \<and> g 0 = f x \<and> g 1 = f y"
     proof (intro exI conjI)
       show "pathin Y (f \<circ> g)"
         using \<open>pathin X g\<close> f pathin_compose by auto
     qed (use g in auto)
   qed
 qed
 
 lemma path_connectedin_discrete_topology:
   "path_connectedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U \<and> (\<exists>a. S \<subseteq> {a})"
   apply safe
   using path_connectedin_subset_topspace apply fastforce
    apply (meson connectedin_discrete_topology path_connectedin_imp_connectedin)
   using subset_singletonD by fastforce
 
 lemma path_connected_space_discrete_topology:
    "path_connected_space (discrete_topology U) \<longleftrightarrow> (\<exists>a. U \<subseteq> {a})"
   by (metis path_connectedin_discrete_topology path_connectedin_topspace path_connected_space_topspace_empty
             subset_singletonD topspace_discrete_topology)
 
 
 lemma homeomorphic_path_connected_space_imp:
      "\<lbrakk>path_connected_space X; X homeomorphic_space Y\<rbrakk> \<Longrightarrow> path_connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   by (metis (no_types, hide_lams) continuous_map_closedin continuous_map_image_subset_topspace imageI order_class.order.antisym path_connectedin_continuous_map_image path_connectedin_topspace subsetI)
 
 lemma homeomorphic_path_connected_space:
    "X homeomorphic_space Y \<Longrightarrow> path_connected_space X \<longleftrightarrow> path_connected_space Y"
   by (meson homeomorphic_path_connected_space_imp homeomorphic_space_sym)
 
 lemma homeomorphic_map_path_connectedness:
   assumes "homeomorphic_map X Y f" "U \<subseteq> topspace X"
   shows "path_connectedin Y (f ` U) \<longleftrightarrow> path_connectedin X U"
   unfolding path_connectedin_def
 proof (intro conj_cong homeomorphic_path_connected_space)
   show "(f ` U \<subseteq> topspace Y) = (U \<subseteq> topspace X)"
     using assms homeomorphic_imp_surjective_map by blast
 next
   assume "U \<subseteq> topspace X"
   show "subtopology Y (f ` U) homeomorphic_space subtopology X U"
     using assms unfolding homeomorphic_eq_everything_map
     by (metis (no_types, hide_lams) assms homeomorphic_map_subtopologies homeomorphic_space homeomorphic_space_sym image_mono inf.absorb_iff2)
 qed
 
 lemma homeomorphic_map_path_connectedness_eq:
    "homeomorphic_map X Y f \<Longrightarrow> path_connectedin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> path_connectedin Y (f ` U)"
   by (meson homeomorphic_map_path_connectedness path_connectedin_def)
 
 subsection\<open>Connected components\<close>
 
 definition connected_component_of :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "connected_component_of X x y \<equiv>
         \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T"
 
 abbreviation connected_component_of_set
   where "connected_component_of_set X x \<equiv> Collect (connected_component_of X x)"
 
 definition connected_components_of :: "'a topology \<Rightarrow> ('a set) set"
   where "connected_components_of X \<equiv> connected_component_of_set X ` topspace X"
 
 lemma connected_component_in_topspace:
    "connected_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (meson connected_component_of_def connectedin_subset_topspace in_mono)
 
 lemma connected_component_of_refl:
    "connected_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   by (meson connected_component_in_topspace connected_component_of_def connectedin_sing insertI1)
 
 lemma connected_component_of_sym:
    "connected_component_of X x y \<longleftrightarrow> connected_component_of X y x"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_trans:
    "\<lbrakk>connected_component_of X x y; connected_component_of X y z\<rbrakk>
         \<Longrightarrow> connected_component_of X x z"
   unfolding connected_component_of_def
   using connectedin_Un by fastforce
 
 lemma connected_component_of_mono:
    "\<lbrakk>connected_component_of (subtopology X S) x y; S \<subseteq> T\<rbrakk>
         \<Longrightarrow> connected_component_of (subtopology X T) x y"
   by (metis connected_component_of_def connectedin_subtopology inf.absorb_iff2 subtopology_subtopology)
 
 lemma connected_component_of_set:
    "connected_component_of_set X x = {y. \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T}"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_subset_topspace:
    "connected_component_of_set X x \<subseteq> topspace X"
   using connected_component_in_topspace by force
 
 lemma connected_component_of_eq_empty:
    "connected_component_of_set X x = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using connected_component_in_topspace connected_component_of_refl by fastforce
 
 lemma connected_space_iff_connected_component:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. connected_component_of X x y)"
   by (simp add: connected_component_of_def connected_space_subconnected)
 
 lemma connected_space_imp_connected_component_of:
    "\<lbrakk>connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk>
     \<Longrightarrow> connected_component_of X a b"
   by (simp add: connected_space_iff_connected_component)
 
 lemma connected_space_connected_component_set:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. connected_component_of_set X x = topspace X)"
   using connected_component_of_subset_topspace connected_space_iff_connected_component by fastforce
 
 lemma connected_component_of_maximal:
    "\<lbrakk>connectedin X S; x \<in> S\<rbrakk> \<Longrightarrow> S \<subseteq> connected_component_of_set X x"
   by (meson Ball_Collect connected_component_of_def)
 
 lemma connected_component_of_equiv:
    "connected_component_of X x y \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> connected_component_of X x = connected_component_of X y"
   apply (simp add: connected_component_in_topspace fun_eq_iff)
   by (meson connected_component_of_refl connected_component_of_sym connected_component_of_trans)
 
 lemma connected_component_of_disjoint:
    "disjnt (connected_component_of_set X x) (connected_component_of_set X y)
     \<longleftrightarrow> ~(connected_component_of X x y)"
   using connected_component_of_equiv unfolding disjnt_iff by force
 
 lemma connected_component_of_eq:
    "connected_component_of X x = connected_component_of X y \<longleftrightarrow>
         (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         connected_component_of X x y"
   by (metis Collect_empty_eq_bot connected_component_of_eq_empty connected_component_of_equiv)
 
 lemma connectedin_connected_component_of:
    "connectedin X (connected_component_of_set X x)"
 proof -
   have "connected_component_of_set X x = \<Union> {T. connectedin X T \<and> x \<in> T}"
     by (auto simp: connected_component_of_def)
   then show ?thesis
     apply (rule ssubst)
     by (blast intro: connectedin_Union)
 qed
 
 
 lemma Union_connected_components_of:
    "\<Union>(connected_components_of X) = topspace X"
   unfolding connected_components_of_def
   apply (rule equalityI)
   apply (simp add: SUP_least connected_component_of_subset_topspace)
   using connected_component_of_refl by fastforce
 
 lemma connected_components_of_maximal:
    "\<lbrakk>C \<in> connected_components_of X; connectedin X S; ~disjnt C S\<rbrakk> \<Longrightarrow> S \<subseteq> C"
   unfolding connected_components_of_def disjnt_def
   apply clarify
   by (metis Int_emptyI connected_component_of_def connected_component_of_trans mem_Collect_eq)
 
 lemma pairwise_disjoint_connected_components_of:
    "pairwise disjnt (connected_components_of X)"
   unfolding connected_components_of_def pairwise_def
   apply clarify
   by (metis connected_component_of_disjoint connected_component_of_equiv)
 
 lemma complement_connected_components_of_Union:
    "C \<in> connected_components_of X
       \<Longrightarrow> topspace X - C = \<Union> (connected_components_of X - {C})"
   apply (rule equalityI)
   using Union_connected_components_of apply fastforce
   by (metis Diff_cancel Diff_subset Union_connected_components_of cSup_singleton diff_Union_pairwise_disjoint equalityE insert_subsetI pairwise_disjoint_connected_components_of)
 
 lemma nonempty_connected_components_of:
    "C \<in> connected_components_of X \<Longrightarrow> C \<noteq> {}"
   unfolding connected_components_of_def
   by (metis (no_types, lifting) connected_component_of_eq_empty imageE)
 
 lemma connected_components_of_subset:
    "C \<in> connected_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   using Union_connected_components_of by fastforce
 
 lemma connectedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows "connectedin X C"
 proof -
   have "C \<in> connected_component_of_set X ` topspace X"
     using assms connected_components_of_def by blast
 then show ?thesis
   using connectedin_connected_component_of by fastforce
 qed
 
 lemma connected_component_in_connected_components_of:
    "connected_component_of_set X a \<in> connected_components_of X \<longleftrightarrow> a \<in> topspace X"
   apply (rule iffI)
   using connected_component_of_eq_empty nonempty_connected_components_of apply fastforce
   by (simp add: connected_components_of_def)
 
 lemma connected_space_iff_components_eq:
    "connected_space X \<longleftrightarrow> (\<forall>C \<in> connected_components_of X. \<forall>C' \<in> connected_components_of X. C = C')"
   apply (rule iffI)
   apply (force simp: connected_components_of_def connected_space_connected_component_set image_iff)
   by (metis connected_component_in_connected_components_of connected_component_of_refl connected_space_iff_connected_component mem_Collect_eq)
 
 lemma connected_components_of_eq_empty:
    "connected_components_of X = {} \<longleftrightarrow> topspace X = {}"
   by (simp add: connected_components_of_def)
 
 lemma connected_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> connected_components_of X = {}"
   by (simp add: connected_components_of_eq_empty)
 
 lemma connected_components_of_subset_sing:
    "connected_components_of X \<subseteq> {S} \<longleftrightarrow> connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: connected_components_of_empty_space connected_space_topspace_empty)
 next
   case False
   then show ?thesis
     by (metis (no_types, hide_lams) Union_connected_components_of ccpo_Sup_singleton
         connected_components_of_eq_empty connected_space_iff_components_eq insertI1 singletonD
         subsetI subset_singleton_iff)
 qed
 
 lemma connected_space_iff_components_subset_singleton:
    "connected_space X \<longleftrightarrow> (\<exists>a. connected_components_of X \<subseteq> {a})"
   by (simp add: connected_components_of_subset_sing)
 
 lemma connected_components_of_eq_singleton:
    "connected_components_of X = {S}
 \<longleftrightarrow> connected_space X \<and> topspace X \<noteq> {} \<and> S = topspace X"
   by (metis ccpo_Sup_singleton connected_components_of_subset_sing insert_not_empty subset_singleton_iff)
 
 lemma connected_components_of_connected_space:
    "connected_space X \<Longrightarrow> connected_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: connected_components_of_eq_empty connected_components_of_eq_singleton)
 
 lemma exists_connected_component_of_superset:
   assumes "connectedin X S" and ne: "topspace X \<noteq> {}"
   shows "\<exists>C. C \<in> connected_components_of X \<and> S \<subseteq> C"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using ne connected_components_of_def by blast
 next
   case False
   then show ?thesis
     by (meson all_not_in_conv assms(1) connected_component_in_connected_components_of connected_component_of_maximal connectedin_subset_topspace in_mono)
 qed
 
 lemma closedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows   "closedin X C"
 proof -
   obtain x where "x \<in> topspace X" and x: "C = connected_component_of_set X x"
     using assms by (auto simp: connected_components_of_def)
   have "connected_component_of_set X x \<subseteq> topspace X"
     by (simp add: connected_component_of_subset_topspace)
   moreover have "X closure_of connected_component_of_set X x \<subseteq> connected_component_of_set X x"
   proof (rule connected_component_of_maximal)
     show "connectedin X (X closure_of connected_component_of_set X x)"
       by (simp add: connectedin_closure_of connectedin_connected_component_of)
     show "x \<in> X closure_of connected_component_of_set X x"
       by (simp add: \<open>x \<in> topspace X\<close> closure_of connected_component_of_refl)
   qed
   ultimately
   show ?thesis
     using closure_of_subset_eq x by auto
 qed
 
 lemma closedin_connected_component_of:
    "closedin X (connected_component_of_set X x)"
   by (metis closedin_connected_components_of closedin_empty connected_component_in_connected_components_of connected_component_of_eq_empty)
 
 lemma connected_component_of_eq_overlap:
    "connected_component_of_set X x = connected_component_of_set X y \<longleftrightarrow>
       (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
       ~(connected_component_of_set X x \<inter> connected_component_of_set X y = {})"
   using connected_component_of_equiv by fastforce
 
 lemma connected_component_of_nonoverlap:
    "connected_component_of_set X x \<inter> connected_component_of_set X y = {} \<longleftrightarrow>
      (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
      ~(connected_component_of_set X x = connected_component_of_set X y)"
   by (metis connected_component_of_eq_empty connected_component_of_eq_overlap inf.idem)
 
 lemma connected_component_of_overlap:
    "~(connected_component_of_set X x \<inter> connected_component_of_set X y = {}) \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and>
     connected_component_of_set X x = connected_component_of_set X y"
   by (meson connected_component_of_nonoverlap)
 
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Bounded_Continuous_Function.thy b/src/HOL/Analysis/Bounded_Continuous_Function.thy
--- a/src/HOL/Analysis/Bounded_Continuous_Function.thy
+++ b/src/HOL/Analysis/Bounded_Continuous_Function.thy
@@ -1,321 +1,321 @@
 section \<open>Bounded Continuous Functions\<close>
 
 theory Bounded_Continuous_Function
   imports
     Topology_Euclidean_Space
     Uniform_Limit
 begin
 
 subsection \<open>Definition\<close>
 
 definition\<^marker>\<open>tag important\<close> "bcontfun = {f. continuous_on UNIV f \<and> bounded (range f)}"
 
 typedef (overloaded) ('a, 'b) bcontfun ("(_ \<Rightarrow>\<^sub>C /_)" [22, 21] 21) =
   "bcontfun::('a::topological_space \<Rightarrow> 'b::metric_space) set"
   morphisms apply_bcontfun Bcontfun
   by (auto intro: continuous_intros simp: bounded_def bcontfun_def)
 
 declare [[coercion "apply_bcontfun :: ('a::topological_space \<Rightarrow>\<^sub>C'b::metric_space) \<Rightarrow> 'a \<Rightarrow> 'b"]]
 
 setup_lifting type_definition_bcontfun
 
 lemma continuous_on_apply_bcontfun[intro, simp]: "continuous_on T (apply_bcontfun x)"
   and bounded_apply_bcontfun[intro, simp]: "bounded (range (apply_bcontfun x))"
   using apply_bcontfun[of x]
   by (auto simp: bcontfun_def intro: continuous_on_subset)
 
 lemma bcontfun_eqI: "(\<And>x. apply_bcontfun f x = apply_bcontfun g x) \<Longrightarrow> f = g"
   by transfer auto
 
 lemma bcontfunE:
   assumes "f \<in> bcontfun"
   obtains g where "f = apply_bcontfun g"
   by (blast intro: apply_bcontfun_cases assms )
 
 lemma const_bcontfun: "(\<lambda>x. b) \<in> bcontfun"
-  by (auto simp: bcontfun_def continuous_on_const image_def)
+  by (auto simp: bcontfun_def image_def)
 
 lift_definition const_bcontfun::"'b::metric_space \<Rightarrow> ('a::topological_space \<Rightarrow>\<^sub>C 'b)" is "\<lambda>c _. c"
   by (rule const_bcontfun)
 
 (* TODO: Generalize to uniform spaces? *)
 instantiation bcontfun :: (topological_space, metric_space) metric_space
 begin
 
 lift_definition\<^marker>\<open>tag important\<close> dist_bcontfun :: "'a \<Rightarrow>\<^sub>C 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>C 'b \<Rightarrow> real"
   is "\<lambda>f g. (SUP x. dist (f x) (g x))" .
 
 definition uniformity_bcontfun :: "('a \<Rightarrow>\<^sub>C 'b \<times> 'a \<Rightarrow>\<^sub>C 'b) filter"
   where "uniformity_bcontfun = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_bcontfun :: "('a \<Rightarrow>\<^sub>C 'b) set \<Rightarrow> bool"
   where "open_bcontfun S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)"
 
 lemma bounded_dist_le_SUP_dist:
   "bounded (range f) \<Longrightarrow> bounded (range g) \<Longrightarrow> dist (f x) (g x) \<le> (SUP x. dist (f x) (g x))"
   by (auto intro!: cSUP_upper bounded_imp_bdd_above bounded_dist_comp)
 
 lemma dist_bounded:
   fixes f g :: "'a \<Rightarrow>\<^sub>C 'b"
   shows "dist (f x) (g x) \<le> dist f g"
   by transfer (auto intro!: bounded_dist_le_SUP_dist simp: bcontfun_def)
 
 lemma dist_bound:
   fixes f g :: "'a \<Rightarrow>\<^sub>C 'b"
   assumes "\<And>x. dist (f x) (g x) \<le> b"
   shows "dist f g \<le> b"
   using assms
   by transfer (auto intro!: cSUP_least)
 
 lemma dist_fun_lt_imp_dist_val_lt:
   fixes f g :: "'a \<Rightarrow>\<^sub>C 'b"
   assumes "dist f g < e"
   shows "dist (f x) (g x) < e"
   using dist_bounded assms by (rule le_less_trans)
 
 instance
 proof
   fix f g h :: "'a \<Rightarrow>\<^sub>C 'b"
   show "dist f g = 0 \<longleftrightarrow> f = g"
   proof
     have "\<And>x. dist (f x) (g x) \<le> dist f g"
       by (rule dist_bounded)
     also assume "dist f g = 0"
     finally show "f = g"
       by (auto simp: apply_bcontfun_inject[symmetric])
   qed (auto simp: dist_bcontfun_def intro!: cSup_eq)
   show "dist f g \<le> dist f h + dist g h"
   proof (rule dist_bound)
     fix x
     have "dist (f x) (g x) \<le> dist (f x) (h x) + dist (g x) (h x)"
       by (rule dist_triangle2)
     also have "dist (f x) (h x) \<le> dist f h"
       by (rule dist_bounded)
     also have "dist (g x) (h x) \<le> dist g h"
       by (rule dist_bounded)
     finally show "dist (f x) (g x) \<le> dist f h + dist g h"
       by simp
   qed
 qed (rule open_bcontfun_def uniformity_bcontfun_def)+
 
 end
 
 lift_definition PiC::"'a::topological_space set \<Rightarrow> ('a \<Rightarrow> 'b set) \<Rightarrow> ('a \<Rightarrow>\<^sub>C 'b::metric_space) set"
   is "\<lambda>I X. Pi I X \<inter> bcontfun"
   by auto
 
 lemma mem_PiC_iff: "x \<in> PiC I X \<longleftrightarrow> apply_bcontfun x \<in> Pi I X"
   by transfer simp
 
 lemmas mem_PiCD = mem_PiC_iff[THEN iffD1]
   and mem_PiCI = mem_PiC_iff[THEN iffD2]
 
 lemma tendsto_bcontfun_uniform_limit:
   fixes f::"'i \<Rightarrow> 'a::topological_space \<Rightarrow>\<^sub>C 'b::metric_space"
   assumes "(f \<longlongrightarrow> l) F"
   shows "uniform_limit UNIV f l F"
 proof (rule uniform_limitI)
   fix e::real assume "e > 0"
   from tendstoD[OF assms this] have "\<forall>\<^sub>F x in F. dist (f x) l < e" .
   then show "\<forall>\<^sub>F n in F. \<forall>x\<in>UNIV. dist ((f n) x) (l x) < e"
     by eventually_elim (auto simp: dist_fun_lt_imp_dist_val_lt)
 qed
 
 lemma uniform_limit_tendsto_bcontfun:
   fixes f::"'i \<Rightarrow> 'a::topological_space \<Rightarrow>\<^sub>C 'b::metric_space"
     and l::"'a::topological_space \<Rightarrow>\<^sub>C 'b::metric_space"
   assumes "uniform_limit UNIV f l F"
   shows "(f \<longlongrightarrow> l) F"
 proof (rule tendstoI)
   fix e::real assume "e > 0"
   then have "e / 2 > 0" by simp
   from uniform_limitD[OF assms this]
   have "\<forall>\<^sub>F i in F. \<forall>x. dist (f i x) (l x) < e / 2" by simp
   then have "\<forall>\<^sub>F x in F. dist (f x) l \<le> e / 2"
     by eventually_elim (blast intro: dist_bound less_imp_le)
   then show "\<forall>\<^sub>F x in F. dist (f x) l < e"
     by eventually_elim (use \<open>0 < e\<close> in auto)
 qed
 
 lemma uniform_limit_bcontfunE:
   fixes f::"'i \<Rightarrow> 'a::topological_space \<Rightarrow>\<^sub>C 'b::metric_space"
     and l::"'a::topological_space \<Rightarrow> 'b::metric_space"
   assumes "uniform_limit UNIV f l F" "F \<noteq> bot"
   obtains l'::"'a::topological_space \<Rightarrow>\<^sub>C 'b::metric_space"
   where "l = l'" "(f \<longlongrightarrow> l') F"
   by (metis (mono_tags, lifting) always_eventually apply_bcontfun apply_bcontfun_cases assms
       bcontfun_def mem_Collect_eq uniform_limit_bounded uniform_limit_tendsto_bcontfun
       uniform_limit_theorem)
 
 lemma closed_PiC:
   fixes I :: "'a::metric_space set"
     and X :: "'a \<Rightarrow> 'b::complete_space set"
   assumes "\<And>i. i \<in> I \<Longrightarrow> closed (X i)"
   shows "closed (PiC I X)"
   unfolding closed_sequential_limits
 proof safe
   fix f l
   assume seq: "\<forall>n. f n \<in> PiC I X" and lim: "f \<longlonglongrightarrow> l"
   show "l \<in> PiC I X"
   proof (safe intro!: mem_PiCI)
     fix x assume "x \<in> I"
     then have "closed (X x)"
       using assms by simp
     moreover have "eventually (\<lambda>i. f i x \<in> X x) sequentially"
       using seq \<open>x \<in> I\<close>
       by (auto intro!: eventuallyI dest!: mem_PiCD simp: Pi_iff)
     moreover note sequentially_bot
     moreover have "(\<lambda>n. (f n) x) \<longlonglongrightarrow> l x"
       using tendsto_bcontfun_uniform_limit[OF lim]
       by (rule tendsto_uniform_limitI) simp
     ultimately show "l x \<in> X x"
       by (rule Lim_in_closed_set)
   qed
 qed
 
 
 subsection \<open>Complete Space\<close>
 
 instance\<^marker>\<open>tag important\<close> bcontfun :: (metric_space, complete_space) complete_space
 proof
   fix f :: "nat \<Rightarrow> ('a, 'b) bcontfun"
   assume "Cauchy f"  \<comment> \<open>Cauchy equals uniform convergence\<close>
   then obtain g where "uniform_limit UNIV f g sequentially"
     using uniformly_convergent_eq_cauchy[of "\<lambda>_. True" f]
     unfolding Cauchy_def uniform_limit_sequentially_iff
     by (metis dist_fun_lt_imp_dist_val_lt)
 
   from uniform_limit_bcontfunE[OF this sequentially_bot]
   obtain l' where "g = apply_bcontfun l'" "(f \<longlonglongrightarrow> l')" by metis
   then show "convergent f"
     by (intro convergentI)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Supremum norm for a normed vector space\<close>
 
 instantiation\<^marker>\<open>tag unimportant\<close> bcontfun :: (topological_space, real_normed_vector) real_vector
 begin
 
 lemma uminus_cont: "f \<in> bcontfun \<Longrightarrow> (\<lambda>x. - f x) \<in> bcontfun" for f::"'a \<Rightarrow> 'b"
   by (auto simp: bcontfun_def intro!: continuous_intros)
 
 lemma plus_cont: "f \<in> bcontfun \<Longrightarrow> g \<in> bcontfun \<Longrightarrow> (\<lambda>x. f x + g x) \<in> bcontfun" for f g::"'a \<Rightarrow> 'b"
   by (auto simp: bcontfun_def intro!: continuous_intros bounded_plus_comp)
 
 lemma minus_cont: "f \<in> bcontfun \<Longrightarrow> g \<in> bcontfun \<Longrightarrow> (\<lambda>x. f x - g x) \<in> bcontfun" for f g::"'a \<Rightarrow> 'b"
   by (auto simp: bcontfun_def intro!: continuous_intros bounded_minus_comp)
 
 lemma scaleR_cont: "f \<in> bcontfun \<Longrightarrow> (\<lambda>x. a *\<^sub>R f x) \<in> bcontfun" for f :: "'a \<Rightarrow> 'b"
   by (auto simp: bcontfun_def intro!: continuous_intros bounded_scaleR_comp)
 
 lemma bcontfun_normI: "continuous_on UNIV f \<Longrightarrow> (\<And>x. norm (f x) \<le> b) \<Longrightarrow> f \<in> bcontfun"
   by (auto simp: bcontfun_def intro: boundedI)
 
 lift_definition uminus_bcontfun::"('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>C 'b" is "\<lambda>f x. - f x"
   by (rule uminus_cont)
 
 lift_definition plus_bcontfun::"('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>C 'b"  is "\<lambda>f g x. f x + g x"
   by (rule plus_cont)
 
 lift_definition minus_bcontfun::"('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>C 'b"  is "\<lambda>f g x. f x - g x"
   by (rule minus_cont)
 
 lift_definition zero_bcontfun::"'a \<Rightarrow>\<^sub>C 'b" is "\<lambda>_. 0"
   by (rule const_bcontfun)
 
 lemma const_bcontfun_0_eq_0[simp]: "const_bcontfun 0 = 0"
   by transfer simp
 
 lift_definition scaleR_bcontfun::"real \<Rightarrow> ('a \<Rightarrow>\<^sub>C 'b) \<Rightarrow> 'a \<Rightarrow>\<^sub>C 'b"  is "\<lambda>r g x. r *\<^sub>R g x"
   by (rule scaleR_cont)
 
 lemmas [simp] =
   const_bcontfun.rep_eq
   uminus_bcontfun.rep_eq
   plus_bcontfun.rep_eq
   minus_bcontfun.rep_eq
   zero_bcontfun.rep_eq
   scaleR_bcontfun.rep_eq
 
 
 instance
   by standard (auto intro!: bcontfun_eqI simp: algebra_simps)
 
 end
 
 lemma bounded_norm_le_SUP_norm:
   "bounded (range f) \<Longrightarrow> norm (f x) \<le> (SUP x. norm (f x))"
   by (auto intro!: cSUP_upper bounded_imp_bdd_above simp: bounded_norm_comp)
 
 instantiation\<^marker>\<open>tag unimportant\<close> bcontfun :: (topological_space, real_normed_vector) real_normed_vector
 begin
 
 definition norm_bcontfun :: "('a, 'b) bcontfun \<Rightarrow> real"
   where "norm_bcontfun f = dist f 0"
 
 definition "sgn (f::('a,'b) bcontfun) = f /\<^sub>R norm f"
 
 instance
 proof
   fix a :: real
   fix f g :: "('a, 'b) bcontfun"
   show "dist f g = norm (f - g)"
     unfolding norm_bcontfun_def
     by transfer (simp add: dist_norm)
   show "norm (f + g) \<le> norm f + norm g"
     unfolding norm_bcontfun_def
     by transfer
       (auto intro!: cSUP_least norm_triangle_le add_mono bounded_norm_le_SUP_norm
         simp: dist_norm bcontfun_def)
   show "norm (a *\<^sub>R f) = \<bar>a\<bar> * norm f"
     unfolding norm_bcontfun_def
     apply transfer
     by (rule trans[OF _ continuous_at_Sup_mono[symmetric]])
       (auto intro!: monoI mult_left_mono continuous_intros bounded_imp_bdd_above
         simp: bounded_norm_comp bcontfun_def image_comp)
 qed (auto simp: norm_bcontfun_def sgn_bcontfun_def)
 
 end
 
 lemma norm_bounded:
   fixes f :: "('a::topological_space, 'b::real_normed_vector) bcontfun"
   shows "norm (apply_bcontfun f x) \<le> norm f"
   using dist_bounded[of f x 0]
   by (simp add: dist_norm)
 
 lemma norm_bound:
   fixes f :: "('a::topological_space, 'b::real_normed_vector) bcontfun"
   assumes "\<And>x. norm (apply_bcontfun f x) \<le> b"
   shows "norm f \<le> b"
   using dist_bound[of f 0 b] assms
   by (simp add: dist_norm)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>(bounded) continuous extenstion\<close>
 
 lemma continuous_on_cbox_bcontfunE:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::metric_space"
   assumes "continuous_on (cbox a b) f"
   obtains g::"'a \<Rightarrow>\<^sub>C 'b" where
     "\<And>x. x \<in> cbox a b \<Longrightarrow> g x = f x"
     "\<And>x. g x = f (clamp a b x)"
 proof -
   define g where "g \<equiv> ext_cont f a b"
   have "g \<in> bcontfun"
     using assms
     by (auto intro!: continuous_on_ext_cont simp: g_def bcontfun_def)
       (auto simp: g_def ext_cont_def
         intro!: clamp_bounded compact_imp_bounded[OF compact_continuous_image] assms)
   then obtain h where h: "g = apply_bcontfun h" by (rule bcontfunE)
   then have "h x = f x" if "x \<in> cbox a b" for x
     by (auto simp: h[symmetric] g_def that)
   moreover
   have "h x = f (clamp a b x)" for x
     by (auto simp: h[symmetric] g_def ext_cont_def)
   ultimately show ?thesis ..
 qed
 
 lifting_update bcontfun.lifting
 lifting_forget bcontfun.lifting
 
 end
diff --git a/src/HOL/Analysis/Bounded_Linear_Function.thy b/src/HOL/Analysis/Bounded_Linear_Function.thy
--- a/src/HOL/Analysis/Bounded_Linear_Function.thy
+++ b/src/HOL/Analysis/Bounded_Linear_Function.thy
@@ -1,843 +1,843 @@
 (*  Title:      HOL/Analysis/Bounded_Linear_Function.thy
     Author:     Fabian Immler, TU München
 *)
 
 section \<open>Bounded Linear Function\<close>
 
 theory Bounded_Linear_Function
 imports
   Topology_Euclidean_Space
   Operator_Norm
   Uniform_Limit
   Function_Topology
 
 begin
 
 lemma onorm_componentwise:
   assumes "bounded_linear f"
   shows "onorm f \<le> (\<Sum>i\<in>Basis. norm (f i))"
 proof -
   {
     fix i::'a
     assume "i \<in> Basis"
     hence "onorm (\<lambda>x. (x \<bullet> i) *\<^sub>R f i) \<le> onorm (\<lambda>x. (x \<bullet> i)) * norm (f i)"
       by (auto intro!: onorm_scaleR_left_lemma bounded_linear_inner_left)
     also have "\<dots> \<le>  norm i * norm (f i)"
       by (rule mult_right_mono)
         (auto simp: ac_simps Cauchy_Schwarz_ineq2 intro!: onorm_le)
     finally have "onorm (\<lambda>x. (x \<bullet> i) *\<^sub>R f i) \<le> norm (f i)" using \<open>i \<in> Basis\<close>
       by simp
   } hence "onorm (\<lambda>x. \<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) \<le> (\<Sum>i\<in>Basis. norm (f i))"
     by (auto intro!: order_trans[OF onorm_sum_le] bounded_linear_scaleR_const
       sum_mono bounded_linear_inner_left)
   also have "(\<lambda>x. \<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R f i) = (\<lambda>x. f (\<Sum>i\<in>Basis. (x \<bullet> i) *\<^sub>R i))"
     by (simp add: linear_sum bounded_linear.linear assms linear_simps)
   also have "\<dots> = f"
     by (simp add: euclidean_representation)
   finally show ?thesis .
 qed
 
 lemmas onorm_componentwise_le = order_trans[OF onorm_componentwise]
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Intro rules for \<^term>\<open>bounded_linear\<close>\<close>
 
 named_theorems bounded_linear_intros
 
 lemma onorm_inner_left:
   assumes "bounded_linear r"
   shows "onorm (\<lambda>x. r x \<bullet> f) \<le> onorm r * norm f"
 proof (rule onorm_bound)
   fix x
   have "norm (r x \<bullet> f) \<le> norm (r x) * norm f"
     by (simp add: Cauchy_Schwarz_ineq2)
   also have "\<dots> \<le> onorm r * norm x * norm f"
     by (intro mult_right_mono onorm assms norm_ge_zero)
   finally show "norm (r x \<bullet> f) \<le> onorm r * norm f * norm x"
     by (simp add: ac_simps)
 qed (intro mult_nonneg_nonneg norm_ge_zero onorm_pos_le assms)
 
 lemma onorm_inner_right:
   assumes "bounded_linear r"
   shows "onorm (\<lambda>x. f \<bullet> r x) \<le> norm f * onorm r"
   apply (subst inner_commute)
   apply (rule onorm_inner_left[OF assms, THEN order_trans])
   apply simp
   done
 
 lemmas [bounded_linear_intros] =
   bounded_linear_zero
   bounded_linear_add
   bounded_linear_const_mult
   bounded_linear_mult_const
   bounded_linear_scaleR_const
   bounded_linear_const_scaleR
   bounded_linear_ident
   bounded_linear_sum
   bounded_linear_Pair
   bounded_linear_sub
   bounded_linear_fst_comp
   bounded_linear_snd_comp
   bounded_linear_inner_left_comp
   bounded_linear_inner_right_comp
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>declaration of derivative/continuous/tendsto introduction rules for bounded linear functions\<close>
 
 attribute_setup bounded_linear =
   \<open>Scan.succeed (Thm.declaration_attribute (fn thm =>
     fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
       [
         (@{thm bounded_linear.has_derivative}, \<^named_theorems>\<open>derivative_intros\<close>),
         (@{thm bounded_linear.tendsto}, \<^named_theorems>\<open>tendsto_intros\<close>),
         (@{thm bounded_linear.continuous}, \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_linear.continuous_on}, \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_linear.uniformly_continuous_on}, \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_linear_compose}, \<^named_theorems>\<open>bounded_linear_intros\<close>)
       ]))\<close>
 
 attribute_setup bounded_bilinear =
   \<open>Scan.succeed (Thm.declaration_attribute (fn thm =>
     fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
       [
         (@{thm bounded_bilinear.FDERIV}, \<^named_theorems>\<open>derivative_intros\<close>),
         (@{thm bounded_bilinear.tendsto}, \<^named_theorems>\<open>tendsto_intros\<close>),
         (@{thm bounded_bilinear.continuous}, \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_bilinear.continuous_on}, \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_linear_compose[OF bounded_bilinear.bounded_linear_left]},
           \<^named_theorems>\<open>bounded_linear_intros\<close>),
         (@{thm bounded_linear_compose[OF bounded_bilinear.bounded_linear_right]},
           \<^named_theorems>\<open>bounded_linear_intros\<close>),
         (@{thm bounded_linear.uniformly_continuous_on[OF bounded_bilinear.bounded_linear_left]},
           \<^named_theorems>\<open>continuous_intros\<close>),
         (@{thm bounded_linear.uniformly_continuous_on[OF bounded_bilinear.bounded_linear_right]},
           \<^named_theorems>\<open>continuous_intros\<close>)
       ]))\<close>
 
 
 subsection \<open>Type of bounded linear functions\<close>
 
 typedef\<^marker>\<open>tag important\<close> (overloaded) ('a, 'b) blinfun ("(_ \<Rightarrow>\<^sub>L /_)" [22, 21] 21) =
   "{f::'a::real_normed_vector\<Rightarrow>'b::real_normed_vector. bounded_linear f}"
   morphisms blinfun_apply Blinfun
   by (blast intro: bounded_linear_intros)
 
 declare [[coercion
     "blinfun_apply :: ('a::real_normed_vector \<Rightarrow>\<^sub>L'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> 'b"]]
 
 lemma bounded_linear_blinfun_apply[bounded_linear_intros]:
   "bounded_linear g \<Longrightarrow> bounded_linear (\<lambda>x. blinfun_apply f (g x))"
   by (metis blinfun_apply mem_Collect_eq bounded_linear_compose)
 
 setup_lifting type_definition_blinfun
 
 lemma blinfun_eqI: "(\<And>i. blinfun_apply x i = blinfun_apply y i) \<Longrightarrow> x = y"
   by transfer auto
 
 lemma bounded_linear_Blinfun_apply: "bounded_linear f \<Longrightarrow> blinfun_apply (Blinfun f) = f"
   by (auto simp: Blinfun_inverse)
 
 
 subsection \<open>Type class instantiations\<close>
 
 instantiation blinfun :: (real_normed_vector, real_normed_vector) real_normed_vector
 begin
 
 lift_definition\<^marker>\<open>tag important\<close> norm_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> real" is onorm .
 
 lift_definition minus_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   is "\<lambda>f g x. f x - g x"
   by (rule bounded_linear_sub)
 
 definition dist_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> real"
   where "dist_blinfun a b = norm (a - b)"
 
 definition [code del]:
   "(uniformity :: (('a \<Rightarrow>\<^sub>L 'b) \<times> ('a \<Rightarrow>\<^sub>L 'b)) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_blinfun :: "('a \<Rightarrow>\<^sub>L 'b) set \<Rightarrow> bool"
   where [code del]: "open_blinfun S = (\<forall>x\<in>S. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> S)"
 
 lift_definition uminus_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b" is "\<lambda>f x. - f x"
   by (rule bounded_linear_minus)
 
 lift_definition\<^marker>\<open>tag important\<close> zero_blinfun :: "'a \<Rightarrow>\<^sub>L 'b" is "\<lambda>x. 0"
   by (rule bounded_linear_zero)
 
 lift_definition\<^marker>\<open>tag important\<close> plus_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   is "\<lambda>f g x. f x + g x"
   by (metis bounded_linear_add)
 
 lift_definition\<^marker>\<open>tag important\<close> scaleR_blinfun::"real \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b" is "\<lambda>r f x. r *\<^sub>R f x"
   by (metis bounded_linear_compose bounded_linear_scaleR_right)
 
 definition sgn_blinfun :: "'a \<Rightarrow>\<^sub>L 'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   where "sgn_blinfun x = scaleR (inverse (norm x)) x"
 
 instance
   apply standard
   unfolding dist_blinfun_def open_blinfun_def sgn_blinfun_def uniformity_blinfun_def
   apply (rule refl | (transfer, force simp: onorm_triangle onorm_scaleR onorm_eq_0 algebra_simps))+
   done
 
 end
 
 declare uniformity_Abort[where 'a="('a :: real_normed_vector) \<Rightarrow>\<^sub>L ('b :: real_normed_vector)", code]
 
 lemma norm_blinfun_eqI:
   assumes "n \<le> norm (blinfun_apply f x) / norm x"
   assumes "\<And>x. norm (blinfun_apply f x) \<le> n * norm x"
   assumes "0 \<le> n"
   shows "norm f = n"
   by (auto simp: norm_blinfun_def
     intro!: antisym onorm_bound assms order_trans[OF _ le_onorm]
     bounded_linear_intros)
 
 lemma norm_blinfun: "norm (blinfun_apply f x) \<le> norm f * norm x"
   by transfer (rule onorm)
 
 lemma norm_blinfun_bound: "0 \<le> b \<Longrightarrow> (\<And>x. norm (blinfun_apply f x) \<le> b * norm x) \<Longrightarrow> norm f \<le> b"
   by transfer (rule onorm_bound)
 
 lemma bounded_bilinear_blinfun_apply[bounded_bilinear]: "bounded_bilinear blinfun_apply"
 proof
   fix f g::"'a \<Rightarrow>\<^sub>L 'b" and a b::'a and r::real
   show "(f + g) a = f a + g a" "(r *\<^sub>R f) a = r *\<^sub>R f a"
     by (transfer, simp)+
   interpret bounded_linear f for f::"'a \<Rightarrow>\<^sub>L 'b"
     by (auto intro!: bounded_linear_intros)
   show "f (a + b) = f a + f b" "f (r *\<^sub>R a) = r *\<^sub>R f a"
     by (simp_all add: add scaleR)
   show "\<exists>K. \<forall>a b. norm (blinfun_apply a b) \<le> norm a * norm b * K"
     by (auto intro!: exI[where x=1] norm_blinfun)
 qed
 
 interpretation blinfun: bounded_bilinear blinfun_apply
   by (rule bounded_bilinear_blinfun_apply)
 
 lemmas bounded_linear_apply_blinfun[intro, simp] = blinfun.bounded_linear_left
 
 declare blinfun.zero_left [simp] blinfun.zero_right [simp]
 
 
 context bounded_bilinear
 begin
 
 named_theorems bilinear_simps
 
 lemmas [bilinear_simps] =
   add_left
   add_right
   diff_left
   diff_right
   minus_left
   minus_right
   scaleR_left
   scaleR_right
   zero_left
   zero_right
   sum_left
   sum_right
 
 end
 
 
 instance blinfun :: (real_normed_vector, banach) banach
 proof
   fix X::"nat \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   assume "Cauchy X"
   {
     fix x::'a
     {
       fix x::'a
       assume "norm x \<le> 1"
       have "Cauchy (\<lambda>n. X n x)"
       proof (rule CauchyI)
         fix e::real
         assume "0 < e"
         from CauchyD[OF \<open>Cauchy X\<close> \<open>0 < e\<close>] obtain M
           where M: "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> norm (X m - X n) < e"
           by auto
         show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m x - X n x) < e"
         proof (safe intro!: exI[where x=M])
           fix m n
           assume le: "M \<le> m" "M \<le> n"
           have "norm (X m x - X n x) = norm ((X m - X n) x)"
             by (simp add: blinfun.bilinear_simps)
           also have "\<dots> \<le> norm (X m - X n) * norm x"
              by (rule norm_blinfun)
           also have "\<dots> \<le> norm (X m - X n) * 1"
             using \<open>norm x \<le> 1\<close> norm_ge_zero by (rule mult_left_mono)
           also have "\<dots> = norm (X m - X n)" by simp
           also have "\<dots> < e" using le by fact
           finally show "norm (X m x - X n x) < e" .
         qed
       qed
       hence "convergent (\<lambda>n. X n x)"
         by (metis Cauchy_convergent_iff)
     } note convergent_norm1 = this
     define y where "y = x /\<^sub>R norm x"
     have y: "norm y \<le> 1" and xy: "x = norm x *\<^sub>R y"
       by (simp_all add: y_def inverse_eq_divide)
     have "convergent (\<lambda>n. norm x *\<^sub>R X n y)"
       by (intro bounded_bilinear.convergent[OF bounded_bilinear_scaleR] convergent_const
         convergent_norm1 y)
     also have "(\<lambda>n. norm x *\<^sub>R X n y) = (\<lambda>n. X n x)"
       by (subst xy) (simp add: blinfun.bilinear_simps)
     finally have "convergent (\<lambda>n. X n x)" .
   }
   then obtain v where v: "\<And>x. (\<lambda>n. X n x) \<longlonglongrightarrow> v x"
     unfolding convergent_def
     by metis
 
   have "Cauchy (\<lambda>n. norm (X n))"
   proof (rule CauchyI)
     fix e::real
     assume "e > 0"
     from CauchyD[OF \<open>Cauchy X\<close> \<open>0 < e\<close>] obtain M
       where M: "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> norm (X m - X n) < e"
       by auto
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (norm (X m) - norm (X n)) < e"
     proof (safe intro!: exI[where x=M])
       fix m n assume mn: "m \<ge> M" "n \<ge> M"
       have "norm (norm (X m) - norm (X n)) \<le> norm (X m - X n)"
         by (metis norm_triangle_ineq3 real_norm_def)
       also have "\<dots> < e" using mn by fact
       finally show "norm (norm (X m) - norm (X n)) < e" .
     qed
   qed
   then obtain K where K: "(\<lambda>n. norm (X n)) \<longlonglongrightarrow> K"
     unfolding Cauchy_convergent_iff convergent_def
     by metis
 
   have "bounded_linear v"
   proof
     fix x y and r::real
     from tendsto_add[OF v[of x] v [of y]] v[of "x + y", unfolded blinfun.bilinear_simps]
       tendsto_scaleR[OF tendsto_const[of r] v[of x]] v[of "r *\<^sub>R x", unfolded blinfun.bilinear_simps]
     show "v (x + y) = v x + v y" "v (r *\<^sub>R x) = r *\<^sub>R v x"
       by (metis (poly_guards_query) LIMSEQ_unique)+
     show "\<exists>K. \<forall>x. norm (v x) \<le> norm x * K"
     proof (safe intro!: exI[where x=K])
       fix x
       have "norm (v x) \<le> K * norm x"
         by (rule tendsto_le[OF _ tendsto_mult[OF K tendsto_const] tendsto_norm[OF v]])
           (auto simp: norm_blinfun)
       thus "norm (v x) \<le> norm x * K"
         by (simp add: ac_simps)
     qed
   qed
   hence Bv: "\<And>x. (\<lambda>n. X n x) \<longlonglongrightarrow> Blinfun v x"
     by (auto simp: bounded_linear_Blinfun_apply v)
 
   have "X \<longlonglongrightarrow> Blinfun v"
   proof (rule LIMSEQ_I)
     fix r::real assume "r > 0"
     define r' where "r' = r / 2"
     have "0 < r'" "r' < r" using \<open>r > 0\<close> by (simp_all add: r'_def)
     from CauchyD[OF \<open>Cauchy X\<close> \<open>r' > 0\<close>]
     obtain M where M: "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> norm (X m - X n) < r'"
       by metis
     show "\<exists>no. \<forall>n\<ge>no. norm (X n - Blinfun v) < r"
     proof (safe intro!: exI[where x=M])
       fix n assume n: "M \<le> n"
       have "norm (X n - Blinfun v) \<le> r'"
       proof (rule norm_blinfun_bound)
         fix x
         have "eventually (\<lambda>m. m \<ge> M) sequentially"
           by (metis eventually_ge_at_top)
         hence ev_le: "eventually (\<lambda>m. norm (X n x - X m x) \<le> r' * norm x) sequentially"
         proof eventually_elim
           case (elim m)
           have "norm (X n x - X m x) = norm ((X n - X m) x)"
             by (simp add: blinfun.bilinear_simps)
           also have "\<dots> \<le> norm ((X n - X m)) * norm x"
             by (rule norm_blinfun)
           also have "\<dots> \<le> r' * norm x"
             using M[OF n elim] by (simp add: mult_right_mono)
           finally show ?case .
         qed
         have tendsto_v: "(\<lambda>m. norm (X n x - X m x)) \<longlonglongrightarrow> norm (X n x - Blinfun v x)"
           by (auto intro!: tendsto_intros Bv)
         show "norm ((X n - Blinfun v) x) \<le> r' * norm x"
           by (auto intro!: tendsto_upperbound tendsto_v ev_le simp: blinfun.bilinear_simps)
       qed (simp add: \<open>0 < r'\<close> less_imp_le)
       thus "norm (X n - Blinfun v) < r"
         by (metis \<open>r' < r\<close> le_less_trans)
     qed
   qed
   thus "convergent X"
     by (rule convergentI)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>On Euclidean Space\<close>
 
 lemma Zfun_sum:
   assumes "finite s"
   assumes f: "\<And>i. i \<in> s \<Longrightarrow> Zfun (f i) F"
   shows "Zfun (\<lambda>x. sum (\<lambda>i. f i x) s) F"
   using assms by induct (auto intro!: Zfun_zero Zfun_add)
 
 lemma norm_blinfun_euclidean_le:
   fixes a::"'a::euclidean_space \<Rightarrow>\<^sub>L 'b::real_normed_vector"
   shows "norm a \<le> sum (\<lambda>x. norm (a x)) Basis"
   apply (rule norm_blinfun_bound)
    apply (simp add: sum_nonneg)
   apply (subst euclidean_representation[symmetric, where 'a='a])
   apply (simp only: blinfun.bilinear_simps sum_distrib_right)
   apply (rule order.trans[OF norm_sum sum_mono])
   apply (simp add: abs_mult mult_right_mono ac_simps Basis_le_norm)
   done
 
 lemma tendsto_componentwise1:
   fixes a::"'a::euclidean_space \<Rightarrow>\<^sub>L 'b::real_normed_vector"
     and b::"'c \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   assumes "(\<And>j. j \<in> Basis \<Longrightarrow> ((\<lambda>n. b n j) \<longlongrightarrow> a j) F)"
   shows "(b \<longlongrightarrow> a) F"
 proof -
   have "\<And>j. j \<in> Basis \<Longrightarrow> Zfun (\<lambda>x. norm (b x j - a j)) F"
     using assms unfolding tendsto_Zfun_iff Zfun_norm_iff .
   hence "Zfun (\<lambda>x. \<Sum>j\<in>Basis. norm (b x j - a j)) F"
     by (auto intro!: Zfun_sum)
   thus ?thesis
     unfolding tendsto_Zfun_iff
     by (rule Zfun_le)
       (auto intro!: order_trans[OF norm_blinfun_euclidean_le] simp: blinfun.bilinear_simps)
 qed
 
 lift_definition
   blinfun_of_matrix::"('b::euclidean_space \<Rightarrow> 'a::euclidean_space \<Rightarrow> real) \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   is "\<lambda>a x. \<Sum>i\<in>Basis. \<Sum>j\<in>Basis. ((x \<bullet> j) * a i j) *\<^sub>R i"
   by (intro bounded_linear_intros)
 
 lemma blinfun_of_matrix_works:
   fixes f::"'a::euclidean_space \<Rightarrow>\<^sub>L 'b::euclidean_space"
   shows "blinfun_of_matrix (\<lambda>i j. (f j) \<bullet> i) = f"
 proof (transfer, rule,  rule euclidean_eqI)
   fix f::"'a \<Rightarrow> 'b" and x::'a and b::'b assume "bounded_linear f" and b: "b \<in> Basis"
   then interpret bounded_linear f by simp
   have "(\<Sum>j\<in>Basis. \<Sum>i\<in>Basis. (x \<bullet> i * (f i \<bullet> j)) *\<^sub>R j) \<bullet> b
     = (\<Sum>j\<in>Basis. if j = b then (\<Sum>i\<in>Basis. (x \<bullet> i * (f i \<bullet> j))) else 0)"
     using b
     by (simp add: inner_sum_left inner_Basis if_distrib cong: if_cong) (simp add: sum.swap)
   also have "\<dots> = (\<Sum>i\<in>Basis. (x \<bullet> i * (f i \<bullet> b)))"
     using b by (simp add: sum.delta)
   also have "\<dots> = f x \<bullet> b"
     by (metis (mono_tags, lifting) Linear_Algebra.linear_componentwise linear_axioms)
   finally show "(\<Sum>j\<in>Basis. \<Sum>i\<in>Basis. (x \<bullet> i * (f i \<bullet> j)) *\<^sub>R j) \<bullet> b = f x \<bullet> b" .
 qed
 
 lemma blinfun_of_matrix_apply:
   "blinfun_of_matrix a x = (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. ((x \<bullet> j) * a i j) *\<^sub>R i)"
   by transfer simp
 
 lemma blinfun_of_matrix_minus: "blinfun_of_matrix x - blinfun_of_matrix y = blinfun_of_matrix (x - y)"
   by transfer (auto simp: algebra_simps sum_subtractf)
 
 lemma norm_blinfun_of_matrix:
   "norm (blinfun_of_matrix a) \<le> (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. \<bar>a i j\<bar>)"
   apply (rule norm_blinfun_bound)
    apply (simp add: sum_nonneg)
   apply (simp only: blinfun_of_matrix_apply sum_distrib_right)
   apply (rule order_trans[OF norm_sum sum_mono])
   apply (rule order_trans[OF norm_sum sum_mono])
   apply (simp add: abs_mult mult_right_mono ac_simps Basis_le_norm)
   done
 
 lemma tendsto_blinfun_of_matrix:
   assumes "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> ((\<lambda>n. b n i j) \<longlongrightarrow> a i j) F"
   shows "((\<lambda>n. blinfun_of_matrix (b n)) \<longlongrightarrow> blinfun_of_matrix a) F"
 proof -
   have "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> Zfun (\<lambda>x. norm (b x i j - a i j)) F"
     using assms unfolding tendsto_Zfun_iff Zfun_norm_iff .
   hence "Zfun (\<lambda>x. (\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. \<bar>b x i j - a i j\<bar>)) F"
     by (auto intro!: Zfun_sum)
   thus ?thesis
     unfolding tendsto_Zfun_iff blinfun_of_matrix_minus
     by (rule Zfun_le) (auto intro!: order_trans[OF norm_blinfun_of_matrix])
 qed
 
 lemma tendsto_componentwise:
   fixes a::"'a::euclidean_space \<Rightarrow>\<^sub>L 'b::euclidean_space"
     and b::"'c \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   shows "(\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> ((\<lambda>n. b n j \<bullet> i) \<longlongrightarrow> a j \<bullet> i) F) \<Longrightarrow> (b \<longlongrightarrow> a) F"
   apply (subst blinfun_of_matrix_works[of a, symmetric])
   apply (subst blinfun_of_matrix_works[of "b x" for x, symmetric, abs_def])
   by (rule tendsto_blinfun_of_matrix)
 
 lemma
   continuous_blinfun_componentwiseI:
   fixes f:: "'b::t2_space \<Rightarrow> 'a::euclidean_space \<Rightarrow>\<^sub>L 'c::euclidean_space"
   assumes "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> continuous F (\<lambda>x. (f x) j \<bullet> i)"
   shows "continuous F f"
   using assms by (auto simp: continuous_def intro!: tendsto_componentwise)
 
 lemma
   continuous_blinfun_componentwiseI1:
   fixes f:: "'b::t2_space \<Rightarrow> 'a::euclidean_space \<Rightarrow>\<^sub>L 'c::real_normed_vector"
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> continuous F (\<lambda>x. f x i)"
   shows "continuous F f"
   using assms by (auto simp: continuous_def intro!: tendsto_componentwise1)
 
 lemma
   continuous_on_blinfun_componentwise:
   fixes f:: "'d::t2_space \<Rightarrow> 'e::euclidean_space \<Rightarrow>\<^sub>L 'f::real_normed_vector"
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> continuous_on s (\<lambda>x. f x i)"
   shows "continuous_on s f"
   using assms
   by (auto intro!: continuous_at_imp_continuous_on intro!: tendsto_componentwise1
     simp: continuous_on_eq_continuous_within continuous_def)
 
 lemma bounded_linear_blinfun_matrix: "bounded_linear (\<lambda>x. (x::_\<Rightarrow>\<^sub>L _) j \<bullet> i)"
   by (auto intro!: bounded_linearI' bounded_linear_intros)
 
 lemma continuous_blinfun_matrix:
   fixes f:: "'b::t2_space \<Rightarrow> 'a::real_normed_vector \<Rightarrow>\<^sub>L 'c::real_inner"
   assumes "continuous F f"
   shows "continuous F (\<lambda>x. (f x) j \<bullet> i)"
   by (rule bounded_linear.continuous[OF bounded_linear_blinfun_matrix assms])
 
 lemma continuous_on_blinfun_matrix:
   fixes f::"'a::t2_space \<Rightarrow> 'b::real_normed_vector \<Rightarrow>\<^sub>L 'c::real_inner"
   assumes "continuous_on S f"
   shows "continuous_on S (\<lambda>x. (f x) j \<bullet> i)"
   using assms
   by (auto simp: continuous_on_eq_continuous_within continuous_blinfun_matrix)
 
 lemma continuous_on_blinfun_of_matrix[continuous_intros]:
   assumes "\<And>i j. i \<in> Basis \<Longrightarrow> j \<in> Basis \<Longrightarrow> continuous_on S (\<lambda>s. g s i j)"
   shows "continuous_on S (\<lambda>s. blinfun_of_matrix (g s))"
   using assms
   by (auto simp: continuous_on intro!: tendsto_blinfun_of_matrix)
 
 lemma mult_if_delta:
   "(if P then (1::'a::comm_semiring_1) else 0) * q = (if P then q else 0)"
   by auto
 
 lemma compact_blinfun_lemma:
   fixes f :: "nat \<Rightarrow> 'a::euclidean_space \<Rightarrow>\<^sub>L 'b::euclidean_space"
   assumes "bounded (range f)"
   shows "\<forall>d\<subseteq>Basis. \<exists>l::'a \<Rightarrow>\<^sub>L 'b. \<exists> r::nat\<Rightarrow>nat.
     strict_mono r \<and> (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) i) (l i) < e) sequentially)"
   by (rule compact_lemma_general[where unproj = "\<lambda>e. blinfun_of_matrix (\<lambda>i j. e j \<bullet> i)"])
    (auto intro!: euclidean_eqI[where 'a='b] bounded_linear_image assms
     simp: blinfun_of_matrix_works blinfun_of_matrix_apply inner_Basis mult_if_delta sum.delta'
       scaleR_sum_left[symmetric])
 
 lemma blinfun_euclidean_eqI: "(\<And>i. i \<in> Basis \<Longrightarrow> blinfun_apply x i = blinfun_apply y i) \<Longrightarrow> x = y"
   apply (auto intro!: blinfun_eqI)
   apply (subst (2) euclidean_representation[symmetric, where 'a='a])
   apply (subst (1) euclidean_representation[symmetric, where 'a='a])
   apply (simp add: blinfun.bilinear_simps)
   done
 
 lemma Blinfun_eq_matrix: "bounded_linear f \<Longrightarrow> Blinfun f = blinfun_of_matrix (\<lambda>i j. f j \<bullet> i)"
   by (intro blinfun_euclidean_eqI)
      (auto simp: blinfun_of_matrix_apply bounded_linear_Blinfun_apply inner_Basis if_distrib
       if_distribR sum.delta' euclidean_representation
       cong: if_cong)
 
 text \<open>TODO: generalize (via \<open>compact_cball\<close>)?\<close>
 instance blinfun :: (euclidean_space, euclidean_space) heine_borel
 proof
   fix f :: "nat \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'b"
   assume f: "bounded (range f)"
   then obtain l::"'a \<Rightarrow>\<^sub>L 'b" and r where r: "strict_mono r"
     and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>Basis. dist (f (r n) i) (l i) < e) sequentially"
     using compact_blinfun_lemma [OF f] by blast
   {
     fix e::real
     let ?d = "real_of_nat DIM('a) * real_of_nat DIM('b)"
     assume "e > 0"
-    hence "e / ?d > 0" by (simp add: DIM_positive)
+    hence "e / ?d > 0" by (simp)
     with l have "eventually (\<lambda>n. \<forall>i\<in>Basis. dist (f (r n) i) (l i) < e / ?d) sequentially"
       by simp
     moreover
     {
       fix n
       assume n: "\<forall>i\<in>Basis. dist (f (r n) i) (l i) < e / ?d"
       have "norm (f (r n) - l) = norm (blinfun_of_matrix (\<lambda>i j. (f (r n) - l) j \<bullet> i))"
         unfolding blinfun_of_matrix_works ..
       also note norm_blinfun_of_matrix
       also have "(\<Sum>i\<in>Basis. \<Sum>j\<in>Basis. \<bar>(f (r n) - l) j \<bullet> i\<bar>) <
         (\<Sum>i\<in>(Basis::'b set). e / real_of_nat DIM('b))"
       proof (rule sum_strict_mono)
         fix i::'b assume i: "i \<in> Basis"
         have "(\<Sum>j::'a\<in>Basis. \<bar>(f (r n) - l) j \<bullet> i\<bar>) < (\<Sum>j::'a\<in>Basis. e / ?d)"
         proof (rule sum_strict_mono)
           fix j::'a assume j: "j \<in> Basis"
           have "\<bar>(f (r n) - l) j \<bullet> i\<bar> \<le> norm ((f (r n) - l) j)"
             by (simp add: Basis_le_norm i)
           also have "\<dots> < e / ?d"
             using n i j by (auto simp: dist_norm blinfun.bilinear_simps)
           finally show "\<bar>(f (r n) - l) j \<bullet> i\<bar> < e / ?d" by simp
         qed simp_all
         also have "\<dots> \<le> e / real_of_nat DIM('b)"
           by simp
         finally show "(\<Sum>j\<in>Basis. \<bar>(f (r n) - l) j \<bullet> i\<bar>) < e / real_of_nat DIM('b)"
           by simp
       qed simp_all
       also have "\<dots> \<le> e" by simp
       finally have "dist (f (r n)) l < e"
         by (auto simp: dist_norm)
     }
     ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
       using eventually_elim2 by force
   }
   then have *: "((f \<circ> r) \<longlongrightarrow> l) sequentially"
     unfolding o_def tendsto_iff by simp
   with r show "\<exists>l r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
     by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>concrete bounded linear functions\<close>
 
 lemma transfer_bounded_bilinear_bounded_linearI:
   assumes "g = (\<lambda>i x. (blinfun_apply (f i) x))"
   shows "bounded_bilinear g = bounded_linear f"
 proof
   assume "bounded_bilinear g"
   then interpret bounded_bilinear f by (simp add: assms)
   show "bounded_linear f"
   proof (unfold_locales, safe intro!: blinfun_eqI)
     fix i
     show "f (x + y) i = (f x + f y) i" "f (r *\<^sub>R x) i = (r *\<^sub>R f x) i" for r x y
       by (auto intro!: blinfun_eqI simp: blinfun.bilinear_simps)
     from _ nonneg_bounded show "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
       by (rule ex_reg) (auto intro!: onorm_bound simp: norm_blinfun.rep_eq ac_simps)
   qed
 qed (auto simp: assms intro!: blinfun.comp)
 
 lemma transfer_bounded_bilinear_bounded_linear[transfer_rule]:
   "(rel_fun (rel_fun (=) (pcr_blinfun (=) (=))) (=)) bounded_bilinear bounded_linear"
   by (auto simp: pcr_blinfun_def cr_blinfun_def rel_fun_def OO_def
     intro!: transfer_bounded_bilinear_bounded_linearI)
 
 context bounded_bilinear
 begin
 
 lift_definition prod_left::"'b \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'c" is "(\<lambda>b a. prod a b)"
   by (rule bounded_linear_left)
 declare prod_left.rep_eq[simp]
 
 lemma bounded_linear_prod_left[bounded_linear]: "bounded_linear prod_left"
   by transfer (rule flip)
 
 lift_definition prod_right::"'a \<Rightarrow> 'b \<Rightarrow>\<^sub>L 'c" is "(\<lambda>a b. prod a b)"
   by (rule bounded_linear_right)
 declare prod_right.rep_eq[simp]
 
 lemma bounded_linear_prod_right[bounded_linear]: "bounded_linear prod_right"
   by transfer (rule bounded_bilinear_axioms)
 
 end
 
 lift_definition id_blinfun::"'a::real_normed_vector \<Rightarrow>\<^sub>L 'a" is "\<lambda>x. x"
   by (rule bounded_linear_ident)
 
 lemmas blinfun_apply_id_blinfun[simp] = id_blinfun.rep_eq
 
 lemma norm_blinfun_id[simp]:
   "norm (id_blinfun::'a::{real_normed_vector, perfect_space} \<Rightarrow>\<^sub>L 'a) = 1"
   by transfer (auto simp: onorm_id)
 
 lemma norm_blinfun_id_le:
   "norm (id_blinfun::'a::real_normed_vector \<Rightarrow>\<^sub>L 'a) \<le> 1"
   by transfer (auto simp: onorm_id_le)
 
 
 lift_definition fst_blinfun::"('a::real_normed_vector \<times> 'b::real_normed_vector) \<Rightarrow>\<^sub>L 'a" is fst
   by (rule bounded_linear_fst)
 
 lemma blinfun_apply_fst_blinfun[simp]: "blinfun_apply fst_blinfun = fst"
   by transfer (rule refl)
 
 
 lift_definition snd_blinfun::"('a::real_normed_vector \<times> 'b::real_normed_vector) \<Rightarrow>\<^sub>L 'b" is snd
   by (rule bounded_linear_snd)
 
 lemma blinfun_apply_snd_blinfun[simp]: "blinfun_apply snd_blinfun = snd"
   by transfer (rule refl)
 
 
 lift_definition blinfun_compose::
   "'a::real_normed_vector \<Rightarrow>\<^sub>L 'b::real_normed_vector \<Rightarrow>
     'c::real_normed_vector \<Rightarrow>\<^sub>L 'a \<Rightarrow>
     'c \<Rightarrow>\<^sub>L 'b" (infixl "o\<^sub>L" 55) is "(o)"
   parametric comp_transfer
   unfolding o_def
   by (rule bounded_linear_compose)
 
 lemma blinfun_apply_blinfun_compose[simp]: "(a o\<^sub>L b) c = a (b c)"
   by (simp add: blinfun_compose.rep_eq)
 
 lemma norm_blinfun_compose:
   "norm (f o\<^sub>L g) \<le> norm f * norm g"
   by transfer (rule onorm_compose)
 
 lemma bounded_bilinear_blinfun_compose[bounded_bilinear]: "bounded_bilinear (o\<^sub>L)"
   by unfold_locales
     (auto intro!: blinfun_eqI exI[where x=1] simp: blinfun.bilinear_simps norm_blinfun_compose)
 
 lemma blinfun_compose_zero[simp]:
   "blinfun_compose 0 = (\<lambda>_. 0)"
   "blinfun_compose x 0 = 0"
   by (auto simp: blinfun.bilinear_simps intro!: blinfun_eqI)
 
 lemma blinfun_bij2:
   fixes f::"'a \<Rightarrow>\<^sub>L 'a::euclidean_space"
   assumes "f o\<^sub>L g = id_blinfun"
   shows "bij (blinfun_apply g)"
 proof (rule bijI)
   show "inj g"
     using assms
     by (metis blinfun_apply_id_blinfun blinfun_compose.rep_eq injI inj_on_imageI2)
   then show "surj g"
     using blinfun.bounded_linear_right bounded_linear_def linear_inj_imp_surj by blast
 qed
 
 lemma blinfun_bij1:
   fixes f::"'a \<Rightarrow>\<^sub>L 'a::euclidean_space"
   assumes "f o\<^sub>L g = id_blinfun"
   shows "bij (blinfun_apply f)"
 proof (rule bijI)
   show "surj (blinfun_apply f)"
     by (metis assms blinfun_apply_blinfun_compose blinfun_apply_id_blinfun surjI)
   then show "inj (blinfun_apply f)"
     using blinfun.bounded_linear_right bounded_linear_def linear_surj_imp_inj by blast
 qed
 
 lift_definition blinfun_inner_right::"'a::real_inner \<Rightarrow> 'a \<Rightarrow>\<^sub>L real" is "(\<bullet>)"
   by (rule bounded_linear_inner_right)
 declare blinfun_inner_right.rep_eq[simp]
 
 lemma bounded_linear_blinfun_inner_right[bounded_linear]: "bounded_linear blinfun_inner_right"
   by transfer (rule bounded_bilinear_inner)
 
 
 lift_definition blinfun_inner_left::"'a::real_inner \<Rightarrow> 'a \<Rightarrow>\<^sub>L real" is "\<lambda>x y. y \<bullet> x"
   by (rule bounded_linear_inner_left)
 declare blinfun_inner_left.rep_eq[simp]
 
 lemma bounded_linear_blinfun_inner_left[bounded_linear]: "bounded_linear blinfun_inner_left"
   by transfer (rule bounded_bilinear.flip[OF bounded_bilinear_inner])
 
 
 lift_definition blinfun_scaleR_right::"real \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a::real_normed_vector" is "(*\<^sub>R)"
   by (rule bounded_linear_scaleR_right)
 declare blinfun_scaleR_right.rep_eq[simp]
 
 lemma bounded_linear_blinfun_scaleR_right[bounded_linear]: "bounded_linear blinfun_scaleR_right"
   by transfer (rule bounded_bilinear_scaleR)
 
 
 lift_definition blinfun_scaleR_left::"'a::real_normed_vector \<Rightarrow> real \<Rightarrow>\<^sub>L 'a" is "\<lambda>x y. y *\<^sub>R x"
   by (rule bounded_linear_scaleR_left)
 lemmas [simp] = blinfun_scaleR_left.rep_eq
 
 lemma bounded_linear_blinfun_scaleR_left[bounded_linear]: "bounded_linear blinfun_scaleR_left"
   by transfer (rule bounded_bilinear.flip[OF bounded_bilinear_scaleR])
 
 
 lift_definition blinfun_mult_right::"'a \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a::real_normed_algebra" is "(*)"
   by (rule bounded_linear_mult_right)
 declare blinfun_mult_right.rep_eq[simp]
 
 lemma bounded_linear_blinfun_mult_right[bounded_linear]: "bounded_linear blinfun_mult_right"
   by transfer (rule bounded_bilinear_mult)
 
 
 lift_definition blinfun_mult_left::"'a::real_normed_algebra \<Rightarrow> 'a \<Rightarrow>\<^sub>L 'a" is "\<lambda>x y. y * x"
   by (rule bounded_linear_mult_left)
 lemmas [simp] = blinfun_mult_left.rep_eq
 
 lemma bounded_linear_blinfun_mult_left[bounded_linear]: "bounded_linear blinfun_mult_left"
   by transfer (rule bounded_bilinear.flip[OF bounded_bilinear_mult])
 
 lemmas bounded_linear_function_uniform_limit_intros[uniform_limit_intros] =
   bounded_linear.uniform_limit[OF bounded_linear_apply_blinfun]
   bounded_linear.uniform_limit[OF bounded_linear_blinfun_apply]
   bounded_linear.uniform_limit[OF bounded_linear_blinfun_matrix]
 
 
 subsection \<open>The strong operator topology on continuous linear operators\<close>
 
 text \<open>Let \<open>'a\<close> and \<open>'b\<close> be two normed real vector spaces. Then the space of linear continuous
 operators from \<open>'a\<close> to \<open>'b\<close> has a canonical norm, and therefore a canonical corresponding topology
 (the type classes instantiation are given in \<^file>\<open>Bounded_Linear_Function.thy\<close>).
 
 However, there is another topology on this space, the strong operator topology, where \<open>T\<^sub>n\<close> tends to
 \<open>T\<close> iff, for all \<open>x\<close> in \<open>'a\<close>, then \<open>T\<^sub>n x\<close> tends to \<open>T x\<close>. This is precisely the product topology
 where the target space is endowed with the norm topology. It is especially useful when \<open>'b\<close> is the set
 of real numbers, since then this topology is compact.
 
 We can not implement it using type classes as there is already a topology, but at least we
 can define it as a topology.
 
 Note that there is yet another (common and useful) topology on operator spaces, the weak operator
 topology, defined analogously using the product topology, but where the target space is given the
 weak-* topology, i.e., the pullback of the weak topology on the bidual of the space under the
 canonical embedding of a space into its bidual. We do not define it there, although it could also be
 defined analogously.
 \<close>
 
 definition\<^marker>\<open>tag important\<close> strong_operator_topology::"('a::real_normed_vector \<Rightarrow>\<^sub>L'b::real_normed_vector) topology"
 where "strong_operator_topology = pullback_topology UNIV blinfun_apply euclidean"
 
 lemma strong_operator_topology_topspace:
   "topspace strong_operator_topology = UNIV"
 unfolding strong_operator_topology_def topspace_pullback_topology topspace_euclidean by auto
 
 lemma strong_operator_topology_basis:
   fixes f::"('a::real_normed_vector \<Rightarrow>\<^sub>L'b::real_normed_vector)" and U::"'i \<Rightarrow> 'b set" and x::"'i \<Rightarrow> 'a"
   assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> open (U i)"
   shows "openin strong_operator_topology {f. \<forall>i\<in>I. blinfun_apply f (x i) \<in> U i}"
 proof -
   have "open {g::('a\<Rightarrow>'b). \<forall>i\<in>I. g (x i) \<in> U i}"
     by (rule product_topology_basis'[OF assms])
   moreover have "{f. \<forall>i\<in>I. blinfun_apply f (x i) \<in> U i}
                 = blinfun_apply-`{g::('a\<Rightarrow>'b). \<forall>i\<in>I. g (x i) \<in> U i} \<inter> UNIV"
     by auto
   ultimately show ?thesis
     unfolding strong_operator_topology_def by (subst openin_pullback_topology) auto
 qed
 
 lemma strong_operator_topology_continuous_evaluation:
   "continuous_map strong_operator_topology euclidean (\<lambda>f. blinfun_apply f x)"
 proof -
   have "continuous_map strong_operator_topology euclidean ((\<lambda>f. f x) o blinfun_apply)"
     unfolding strong_operator_topology_def apply (rule continuous_map_pullback)
     using continuous_on_product_coordinates by fastforce
   then show ?thesis unfolding comp_def by simp
 qed
 
 lemma continuous_on_strong_operator_topo_iff_coordinatewise:
   "continuous_map T strong_operator_topology f
     \<longleftrightarrow> (\<forall>x. continuous_map T euclidean (\<lambda>y. blinfun_apply (f y) x))"
 proof (auto)
   fix x::"'b"
   assume "continuous_map T strong_operator_topology f"
   with continuous_map_compose[OF this strong_operator_topology_continuous_evaluation]
   have "continuous_map T euclidean ((\<lambda>z. blinfun_apply z x) o f)"
     by simp
   then show "continuous_map T euclidean (\<lambda>y. blinfun_apply (f y) x)"
     unfolding comp_def by auto
 next
   assume *: "\<forall>x. continuous_map T euclidean (\<lambda>y. blinfun_apply (f y) x)"
   have "\<And>i. continuous_map T euclidean (\<lambda>x. blinfun_apply (f x) i)"
     using * unfolding comp_def by auto
   then have "continuous_map T euclidean (blinfun_apply o f)"
     unfolding o_def
     by (metis (no_types) continuous_map_componentwise_UNIV euclidean_product_topology)
   show "continuous_map T strong_operator_topology f"
     unfolding strong_operator_topology_def
     apply (rule continuous_map_pullback')
     by (auto simp add: \<open>continuous_map T euclidean (blinfun_apply o f)\<close>)
 qed
 
 lemma strong_operator_topology_weaker_than_euclidean:
   "continuous_map euclidean strong_operator_topology (\<lambda>f. f)"
   by (subst continuous_on_strong_operator_topo_iff_coordinatewise,
     auto simp add: linear_continuous_on)
 
 end
diff --git a/src/HOL/Analysis/Brouwer_Fixpoint.thy b/src/HOL/Analysis/Brouwer_Fixpoint.thy
--- a/src/HOL/Analysis/Brouwer_Fixpoint.thy
+++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy
@@ -1,2607 +1,2605 @@
 (*  Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light) and LCP
 *)
 
 (* At the moment this is just Brouwer's fixpoint theorem. The proof is from  *)
 (* Kuhn: "some combinatorial lemmas in topology", IBM J. v4. (1960) p. 518   *)
 (* See "http://www.research.ibm.com/journal/rd/045/ibmrd0405K.pdf".          *)
 (*                                                                           *)
 (* The script below is quite messy, but at least we avoid formalizing any    *)
 (* topological machinery; we don't even use barycentric subdivision; this is *)
 (* the big advantage of Kuhn's proof over the usual Sperner's lemma one.     *)
 (*                                                                           *)
 (*              (c) Copyright, John Harrison 1998-2008                       *)
 
 section \<open>Brouwer's Fixed Point Theorem\<close>
 
 theory Brouwer_Fixpoint
   imports Homeomorphism Derivative
 begin
 
 subsection \<open>Retractions\<close>
 
 lemma retract_of_contractible:
   assumes "contractible T" "S retract_of T"
     shows "contractible S"
 using assms
 apply (clarsimp simp add: retract_of_def contractible_def retraction_def homotopic_with)
 apply (rule_tac x="r a" in exI)
 apply (rule_tac x="r \<circ> h" in exI)
 apply (intro conjI continuous_intros continuous_on_compose)
 apply (erule continuous_on_subset | force)+
 done
 
 lemma retract_of_path_connected:
     "\<lbrakk>path_connected T; S retract_of T\<rbrakk> \<Longrightarrow> path_connected S"
   by (metis path_connected_continuous_image retract_of_def retraction)
 
 lemma retract_of_simply_connected:
     "\<lbrakk>simply_connected T; S retract_of T\<rbrakk> \<Longrightarrow> simply_connected S"
 apply (simp add: retract_of_def retraction_def, clarify)
 apply (rule simply_connected_retraction_gen)
 apply (force elim!: continuous_on_subset)+
 done
 
 lemma retract_of_homotopically_trivial:
   assumes ts: "T retract_of S"
       and hom: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S;
                        continuous_on U g; g ` U \<subseteq> S\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g"
       and "continuous_on U f" "f ` U \<subseteq> T"
       and "continuous_on U g" "g ` U \<subseteq> T"
     shows "homotopic_with_canon (\<lambda>x. True) U T f g"
 proof -
   obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S"
     using ts by (auto simp: retract_of_def retraction)
   then obtain k where "Retracts S r T k"
     unfolding Retracts_def
     by (metis continuous_on_subset dual_order.trans image_iff image_mono)
   then show ?thesis
     apply (rule Retracts.homotopically_trivial_retraction_gen)
     using assms
     apply (force simp: hom)+
     done
 qed
 
 lemma retract_of_homotopically_trivial_null:
   assumes ts: "T retract_of S"
       and hom: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk>
                      \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c)"
       and "continuous_on U f" "f ` U \<subseteq> T"
   obtains c where "homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)"
 proof -
   obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S"
     using ts by (auto simp: retract_of_def retraction)
   then obtain k where "Retracts S r T k"
     unfolding Retracts_def
     by (metis continuous_on_subset dual_order.trans image_iff image_mono)
   then show ?thesis
     apply (rule Retracts.homotopically_trivial_retraction_null_gen)
     apply (rule TrueI refl assms that | assumption)+
     done
 qed
 
 lemma retraction_openin_vimage_iff:
   "openin (top_of_set S) (S \<inter> r -` U) \<longleftrightarrow> openin (top_of_set T) U"
   if retraction: "retraction S T r" and "U \<subseteq> T"
   using retraction apply (rule retractionE)
   apply (rule continuous_right_inverse_imp_quotient_map [where g=r])
   using \<open>U \<subseteq> T\<close> apply (auto elim: continuous_on_subset)
   done
 
 lemma retract_of_locally_compact:
     fixes S :: "'a :: {heine_borel,real_normed_vector} set"
     shows  "\<lbrakk> locally compact S; T retract_of S\<rbrakk> \<Longrightarrow> locally compact T"
   by (metis locally_compact_closedin closedin_retract)
 
 lemma homotopic_into_retract:
    "\<lbrakk>f ` S \<subseteq> T; g ` S \<subseteq> T; T retract_of U; homotopic_with_canon (\<lambda>x. True) S U f g\<rbrakk>
         \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g"
 apply (subst (asm) homotopic_with_def)
 apply (simp add: homotopic_with retract_of_def retraction_def, clarify)
 apply (rule_tac x="r \<circ> h" in exI)
 apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+
 done
 
 lemma retract_of_locally_connected:
   assumes "locally connected T" "S retract_of T"
   shows "locally connected S"
   using assms
   by (auto simp: idempotent_imp_retraction intro!: retraction_openin_vimage_iff elim!: locally_connected_quotient_image retract_ofE)
 
 lemma retract_of_locally_path_connected:
   assumes "locally path_connected T" "S retract_of T"
   shows "locally path_connected S"
   using assms
   by (auto simp: idempotent_imp_retraction intro!: retraction_openin_vimage_iff elim!: locally_path_connected_quotient_image retract_ofE)
 
 text \<open>A few simple lemmas about deformation retracts\<close>
 
 lemma deformation_retract_imp_homotopy_eqv:
   fixes S :: "'a::euclidean_space set"
   assumes "homotopic_with_canon (\<lambda>x. True) S S id r" and r: "retraction S T r"
   shows "S homotopy_eqv T"
 proof -
   have "homotopic_with_canon (\<lambda>x. True) S S (id \<circ> r) id"
     by (simp add: assms(1) homotopic_with_symD)
   moreover have "homotopic_with_canon (\<lambda>x. True) T T (r \<circ> id) id"
     using r unfolding retraction_def
     by (metis eq_id_iff homotopic_with_id2 topspace_euclidean_subtopology)
   ultimately
   show ?thesis
     unfolding homotopy_equivalent_space_def 
     by (metis (no_types, lifting) continuous_map_subtopology_eu continuous_on_id' id_def image_id r retraction_def)
 qed
 
 lemma deformation_retract:
   fixes S :: "'a::euclidean_space set"
     shows "(\<exists>r. homotopic_with_canon (\<lambda>x. True) S S id r \<and> retraction S T r) \<longleftrightarrow>
            T retract_of S \<and> (\<exists>f. homotopic_with_canon (\<lambda>x. True) S S id f \<and> f ` S \<subseteq> T)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (auto simp: retract_of_def retraction_def)
 next
   assume ?rhs
   then show ?lhs
     apply (clarsimp simp add: retract_of_def retraction_def)
     apply (rule_tac x=r in exI, simp)
      apply (rule homotopic_with_trans, assumption)
      apply (rule_tac f = "r \<circ> f" and g="r \<circ> id" in homotopic_with_eq)
         apply (rule_tac Y=S in homotopic_compose_continuous_left)
          apply (auto simp: homotopic_with_sym)
     done
 qed
 
 lemma deformation_retract_of_contractible_sing:
   fixes S :: "'a::euclidean_space set"
   assumes "contractible S" "a \<in> S"
   obtains r where "homotopic_with_canon (\<lambda>x. True) S S id r" "retraction S {a} r"
 proof -
   have "{a} retract_of S"
     by (simp add: \<open>a \<in> S\<close>)
   moreover have "homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
       using assms
       by (auto simp: contractible_def homotopic_into_contractible image_subset_iff)
   moreover have "(\<lambda>x. a) ` S \<subseteq> {a}"
     by (simp add: image_subsetI)
   ultimately show ?thesis
     using that deformation_retract  by metis
 qed
 
 
 lemma continuous_on_compact_surface_projection_aux:
   fixes S :: "'a::t2_space set"
   assumes "compact S" "S \<subseteq> T" "image q T \<subseteq> S"
       and contp: "continuous_on T p"
       and "\<And>x. x \<in> S \<Longrightarrow> q x = x"
       and [simp]: "\<And>x. x \<in> T \<Longrightarrow> q(p x) = q x"
       and "\<And>x. x \<in> T \<Longrightarrow> p(q x) = p x"
     shows "continuous_on T q"
 proof -
   have *: "image p T = image p S"
     using assms by auto (metis imageI subset_iff)
   have contp': "continuous_on S p"
     by (rule continuous_on_subset [OF contp \<open>S \<subseteq> T\<close>])
   have "continuous_on (p ` T) q"
     by (simp add: "*" assms(1) assms(2) assms(5) continuous_on_inv contp' rev_subsetD)
   then have "continuous_on T (q \<circ> p)"
     by (rule continuous_on_compose [OF contp])
   then show ?thesis
     by (rule continuous_on_eq [of _ "q \<circ> p"]) (simp add: o_def)
 qed
 
 lemma continuous_on_compact_surface_projection:
   fixes S :: "'a::real_normed_vector set"
   assumes "compact S"
       and S: "S \<subseteq> V - {0}" and "cone V"
       and iff: "\<And>x k. x \<in> V - {0} \<Longrightarrow> 0 < k \<and> (k *\<^sub>R x) \<in> S \<longleftrightarrow> d x = k"
   shows "continuous_on (V - {0}) (\<lambda>x. d x *\<^sub>R x)"
 proof (rule continuous_on_compact_surface_projection_aux [OF \<open>compact S\<close> S])
   show "(\<lambda>x. d x *\<^sub>R x) ` (V - {0}) \<subseteq> S"
     using iff by auto
   show "continuous_on (V - {0}) (\<lambda>x. inverse(norm x) *\<^sub>R x)"
     by (intro continuous_intros) force
   show "\<And>x. x \<in> S \<Longrightarrow> d x *\<^sub>R x = x"
     by (metis S zero_less_one local.iff scaleR_one subset_eq)
   show "d (x /\<^sub>R norm x) *\<^sub>R (x /\<^sub>R norm x) = d x *\<^sub>R x" if "x \<in> V - {0}" for x
     using iff [of "inverse(norm x) *\<^sub>R x" "norm x * d x", symmetric] iff that \<open>cone V\<close>
     by (simp add: field_simps cone_def zero_less_mult_iff)
   show "d x *\<^sub>R x /\<^sub>R norm (d x *\<^sub>R x) = x /\<^sub>R norm x" if "x \<in> V - {0}" for x
   proof -
     have "0 < d x"
       using local.iff that by blast
     then show ?thesis
       by simp
   qed
 qed
 
 subsection \<open>Kuhn Simplices\<close>
 
 lemma bij_betw_singleton_eq:
   assumes f: "bij_betw f A B" and g: "bij_betw g A B" and a: "a \<in> A"
   assumes eq: "(\<And>x. x \<in> A \<Longrightarrow> x \<noteq> a \<Longrightarrow> f x = g x)"
   shows "f a = g a"
 proof -
   have "f ` (A - {a}) = g ` (A - {a})"
     by (intro image_cong) (simp_all add: eq)
   then have "B - {f a} = B - {g a}"
     using f g a  by (auto simp: bij_betw_def inj_on_image_set_diff set_eq_iff)
   moreover have "f a \<in> B" "g a \<in> B"
     using f g a by (auto simp: bij_betw_def)
   ultimately show ?thesis
     by auto
 qed
 
 lemma swap_image:
   "Fun.swap i j f ` A = (if i \<in> A then (if j \<in> A then f ` A else f ` ((A - {i}) \<union> {j}))
                                   else (if j \<in> A then f ` ((A - {j}) \<union> {i}) else f ` A))"
   by (auto simp: swap_def cong: image_cong_simp)
 
 lemmas swap_apply1 = swap_apply(1)
 lemmas swap_apply2 = swap_apply(2)
 
 lemma pointwise_minimal_pointwise_maximal:
   fixes s :: "(nat \<Rightarrow> nat) set"
   assumes "finite s"
     and "s \<noteq> {}"
     and "\<forall>x\<in>s. \<forall>y\<in>s. x \<le> y \<or> y \<le> x"
   shows "\<exists>a\<in>s. \<forall>x\<in>s. a \<le> x"
     and "\<exists>a\<in>s. \<forall>x\<in>s. x \<le> a"
   using assms
 proof (induct s rule: finite_ne_induct)
   case (insert b s)
   assume *: "\<forall>x\<in>insert b s. \<forall>y\<in>insert b s. x \<le> y \<or> y \<le> x"
   then obtain u l where "l \<in> s" "\<forall>b\<in>s. l \<le> b" "u \<in> s" "\<forall>b\<in>s. b \<le> u"
     using insert by auto
   with * show "\<exists>a\<in>insert b s. \<forall>x\<in>insert b s. a \<le> x" "\<exists>a\<in>insert b s. \<forall>x\<in>insert b s. x \<le> a"
     using *[rule_format, of b u] *[rule_format, of b l] by (metis insert_iff order.trans)+
 qed auto
 
 lemma kuhn_labelling_lemma:
   fixes P Q :: "'a::euclidean_space \<Rightarrow> bool"
   assumes "\<forall>x. P x \<longrightarrow> P (f x)"
     and "\<forall>x. P x \<longrightarrow> (\<forall>i\<in>Basis. Q i \<longrightarrow> 0 \<le> x\<bullet>i \<and> x\<bullet>i \<le> 1)"
   shows "\<exists>l. (\<forall>x.\<forall>i\<in>Basis. l x i \<le> (1::nat)) \<and>
              (\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (x\<bullet>i = 0) \<longrightarrow> (l x i = 0)) \<and>
              (\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (x\<bullet>i = 1) \<longrightarrow> (l x i = 1)) \<and>
              (\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (l x i = 0) \<longrightarrow> x\<bullet>i \<le> f x\<bullet>i) \<and>
              (\<forall>x.\<forall>i\<in>Basis. P x \<and> Q i \<and> (l x i = 1) \<longrightarrow> f x\<bullet>i \<le> x\<bullet>i)"
 proof -
   { fix x i
     let ?R = "\<lambda>y. (P x \<and> Q i \<and> x \<bullet> i = 0 \<longrightarrow> y = (0::nat)) \<and>
         (P x \<and> Q i \<and> x \<bullet> i = 1 \<longrightarrow> y = 1) \<and>
         (P x \<and> Q i \<and> y = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i) \<and>
         (P x \<and> Q i \<and> y = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i)"
     { assume "P x" "Q i" "i \<in> Basis" with assms have "0 \<le> f x \<bullet> i \<and> f x \<bullet> i \<le> 1" by auto }
     then have "i \<in> Basis \<Longrightarrow> ?R 0 \<or> ?R 1" by auto }
   then show ?thesis
     unfolding all_conj_distrib[symmetric] Ball_def (* FIXME: shouldn't this work by metis? *)
     by (subst choice_iff[symmetric])+ blast
 qed
 
 
 subsubsection \<open>The key "counting" observation, somewhat abstracted\<close>
 
 lemma kuhn_counting_lemma:
   fixes bnd compo compo' face S F
   defines "nF s == card {f\<in>F. face f s \<and> compo' f}"
   assumes [simp, intro]: "finite F" \<comment> \<open>faces\<close> and [simp, intro]: "finite S" \<comment> \<open>simplices\<close>
     and "\<And>f. f \<in> F \<Longrightarrow> bnd f \<Longrightarrow> card {s\<in>S. face f s} = 1"
     and "\<And>f. f \<in> F \<Longrightarrow> \<not> bnd f \<Longrightarrow> card {s\<in>S. face f s} = 2"
     and "\<And>s. s \<in> S \<Longrightarrow> compo s \<Longrightarrow> nF s = 1"
     and "\<And>s. s \<in> S \<Longrightarrow> \<not> compo s \<Longrightarrow> nF s = 0 \<or> nF s = 2"
     and "odd (card {f\<in>F. compo' f \<and> bnd f})"
   shows "odd (card {s\<in>S. compo s})"
 proof -
   have "(\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) + (\<Sum>s | s \<in> S \<and> compo s. nF s) = (\<Sum>s\<in>S. nF s)"
     by (subst sum.union_disjoint[symmetric]) (auto intro!: sum.cong)
   also have "\<dots> = (\<Sum>s\<in>S. card {f \<in> {f\<in>F. compo' f \<and> bnd f}. face f s}) +
                   (\<Sum>s\<in>S. card {f \<in> {f\<in>F. compo' f \<and> \<not> bnd f}. face f s})"
     unfolding sum.distrib[symmetric]
     by (subst card_Un_disjoint[symmetric])
        (auto simp: nF_def intro!: sum.cong arg_cong[where f=card])
   also have "\<dots> = 1 * card {f\<in>F. compo' f \<and> bnd f} + 2 * card {f\<in>F. compo' f \<and> \<not> bnd f}"
     using assms(4,5) by (fastforce intro!: arg_cong2[where f="(+)"] sum_multicount)
   finally have "odd ((\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) + card {s\<in>S. compo s})"
     using assms(6,8) by simp
   moreover have "(\<Sum>s | s \<in> S \<and> \<not> compo s. nF s) =
     (\<Sum>s | s \<in> S \<and> \<not> compo s \<and> nF s = 0. nF s) + (\<Sum>s | s \<in> S \<and> \<not> compo s \<and> nF s = 2. nF s)"
     using assms(7) by (subst sum.union_disjoint[symmetric]) (fastforce intro!: sum.cong)+
   ultimately show ?thesis
     by auto
 qed
 
 subsubsection \<open>The odd/even result for faces of complete vertices, generalized\<close>
 
 lemma kuhn_complete_lemma:
   assumes [simp]: "finite simplices"
     and face: "\<And>f s. face f s \<longleftrightarrow> (\<exists>a\<in>s. f = s - {a})"
     and card_s[simp]:  "\<And>s. s \<in> simplices \<Longrightarrow> card s = n + 2"
     and rl_bd: "\<And>s. s \<in> simplices \<Longrightarrow> rl ` s \<subseteq> {..Suc n}"
     and bnd: "\<And>f s. s \<in> simplices \<Longrightarrow> face f s \<Longrightarrow> bnd f \<Longrightarrow> card {s\<in>simplices. face f s} = 1"
     and nbnd: "\<And>f s. s \<in> simplices \<Longrightarrow> face f s \<Longrightarrow> \<not> bnd f \<Longrightarrow> card {s\<in>simplices. face f s} = 2"
     and odd_card: "odd (card {f. (\<exists>s\<in>simplices. face f s) \<and> rl ` f = {..n} \<and> bnd f})"
   shows "odd (card {s\<in>simplices. (rl ` s = {..Suc n})})"
 proof (rule kuhn_counting_lemma)
   have finite_s[simp]: "\<And>s. s \<in> simplices \<Longrightarrow> finite s"
     by (metis add_is_0 zero_neq_numeral card_infinite assms(3))
 
   let ?F = "{f. \<exists>s\<in>simplices. face f s}"
   have F_eq: "?F = (\<Union>s\<in>simplices. \<Union>a\<in>s. {s - {a}})"
     by (auto simp: face)
   show "finite ?F"
     using \<open>finite simplices\<close> unfolding F_eq by auto
 
   show "card {s \<in> simplices. face f s} = 1" if "f \<in> ?F" "bnd f" for f
     using bnd that by auto
 
   show "card {s \<in> simplices. face f s} = 2" if "f \<in> ?F" "\<not> bnd f" for f
     using nbnd that by auto
 
   show "odd (card {f \<in> {f. \<exists>s\<in>simplices. face f s}. rl ` f = {..n} \<and> bnd f})"
     using odd_card by simp
 
   fix s assume s[simp]: "s \<in> simplices"
   let ?S = "{f \<in> {f. \<exists>s\<in>simplices. face f s}. face f s \<and> rl ` f = {..n}}"
   have "?S = (\<lambda>a. s - {a}) ` {a\<in>s. rl ` (s - {a}) = {..n}}"
     using s by (fastforce simp: face)
   then have card_S: "card ?S = card {a\<in>s. rl ` (s - {a}) = {..n}}"
     by (auto intro!: card_image inj_onI)
 
   { assume rl: "rl ` s = {..Suc n}"
     then have inj_rl: "inj_on rl s"
       by (intro eq_card_imp_inj_on) auto
     moreover obtain a where "rl a = Suc n" "a \<in> s"
       by (metis atMost_iff image_iff le_Suc_eq rl)
     ultimately have n: "{..n} = rl ` (s - {a})"
       by (auto simp: inj_on_image_set_diff rl)
     have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a}"
       using inj_rl \<open>a \<in> s\<close> by (auto simp: n inj_on_image_eq_iff[OF inj_rl])
     then show "card ?S = 1"
       unfolding card_S by simp }
 
   { assume rl: "rl ` s \<noteq> {..Suc n}"
     show "card ?S = 0 \<or> card ?S = 2"
     proof cases
       assume *: "{..n} \<subseteq> rl ` s"
       with rl rl_bd[OF s] have rl_s: "rl ` s = {..n}"
         by (auto simp: atMost_Suc subset_insert_iff split: if_split_asm)
       then have "\<not> inj_on rl s"
         by (intro pigeonhole) simp
       then obtain a b where ab: "a \<in> s" "b \<in> s" "rl a = rl b" "a \<noteq> b"
         by (auto simp: inj_on_def)
       then have eq: "rl ` (s - {a}) = rl ` s"
         by auto
       with ab have inj: "inj_on rl (s - {a})"
         by (intro eq_card_imp_inj_on) (auto simp: rl_s card_Diff_singleton_if)
 
       { fix x assume "x \<in> s" "x \<notin> {a, b}"
         then have "rl ` s - {rl x} = rl ` ((s - {a}) - {x})"
           by (auto simp: eq inj_on_image_set_diff[OF inj])
         also have "\<dots> = rl ` (s - {x})"
           using ab \<open>x \<notin> {a, b}\<close> by auto
         also assume "\<dots> = rl ` s"
         finally have False
           using \<open>x\<in>s\<close> by auto }
       moreover
       { fix x assume "x \<in> {a, b}" with ab have "x \<in> s \<and> rl ` (s - {x}) = rl ` s"
           by (simp add: set_eq_iff image_iff Bex_def) metis }
       ultimately have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a, b}"
         unfolding rl_s[symmetric] by fastforce
       with \<open>a \<noteq> b\<close> show "card ?S = 0 \<or> card ?S = 2"
         unfolding card_S by simp
     next
       assume "\<not> {..n} \<subseteq> rl ` s"
       then have "\<And>x. rl ` (s - {x}) \<noteq> {..n}"
         by auto
       then show "card ?S = 0 \<or> card ?S = 2"
         unfolding card_S by simp
     qed }
 qed fact
 
 locale kuhn_simplex =
   fixes p n and base upd and s :: "(nat \<Rightarrow> nat) set"
   assumes base: "base \<in> {..< n} \<rightarrow> {..< p}"
   assumes base_out: "\<And>i. n \<le> i \<Longrightarrow> base i = p"
   assumes upd: "bij_betw upd {..< n} {..< n}"
   assumes s_pre: "s = (\<lambda>i j. if j \<in> upd`{..< i} then Suc (base j) else base j) ` {.. n}"
 begin
 
 definition "enum i j = (if j \<in> upd`{..< i} then Suc (base j) else base j)"
 
 lemma s_eq: "s = enum ` {.. n}"
   unfolding s_pre enum_def[abs_def] ..
 
 lemma upd_space: "i < n \<Longrightarrow> upd i < n"
   using upd by (auto dest!: bij_betwE)
 
 lemma s_space: "s \<subseteq> {..< n} \<rightarrow> {.. p}"
 proof -
   { fix i assume "i \<le> n" then have "enum i \<in> {..< n} \<rightarrow> {.. p}"
     proof (induct i)
       case 0 then show ?case
         using base by (auto simp: Pi_iff less_imp_le enum_def)
     next
       case (Suc i) with base show ?case
         by (auto simp: Pi_iff Suc_le_eq less_imp_le enum_def intro: upd_space)
     qed }
   then show ?thesis
     by (auto simp: s_eq)
 qed
 
 lemma inj_upd: "inj_on upd {..< n}"
   using upd by (simp add: bij_betw_def)
 
 lemma inj_enum: "inj_on enum {.. n}"
 proof -
   { fix x y :: nat assume "x \<noteq> y" "x \<le> n" "y \<le> n"
     with upd have "upd ` {..< x} \<noteq> upd ` {..< y}"
       by (subst inj_on_image_eq_iff[where C="{..< n}"]) (auto simp: bij_betw_def)
     then have "enum x \<noteq> enum y"
       by (auto simp: enum_def fun_eq_iff) }
   then show ?thesis
     by (auto simp: inj_on_def)
 qed
 
 lemma enum_0: "enum 0 = base"
   by (simp add: enum_def[abs_def])
 
 lemma base_in_s: "base \<in> s"
   unfolding s_eq by (subst enum_0[symmetric]) auto
 
 lemma enum_in: "i \<le> n \<Longrightarrow> enum i \<in> s"
   unfolding s_eq by auto
 
 lemma one_step:
   assumes a: "a \<in> s" "j < n"
   assumes *: "\<And>a'. a' \<in> s \<Longrightarrow> a' \<noteq> a \<Longrightarrow> a' j = p'"
   shows "a j \<noteq> p'"
 proof
   assume "a j = p'"
   with * a have "\<And>a'. a' \<in> s \<Longrightarrow> a' j = p'"
     by auto
   then have "\<And>i. i \<le> n \<Longrightarrow> enum i j = p'"
     unfolding s_eq by auto
   from this[of 0] this[of n] have "j \<notin> upd ` {..< n}"
     by (auto simp: enum_def fun_eq_iff split: if_split_asm)
   with upd \<open>j < n\<close> show False
     by (auto simp: bij_betw_def)
 qed
 
 lemma upd_inj: "i < n \<Longrightarrow> j < n \<Longrightarrow> upd i = upd j \<longleftrightarrow> i = j"
   using upd by (auto simp: bij_betw_def inj_on_eq_iff)
 
 lemma upd_surj: "upd ` {..< n} = {..< n}"
   using upd by (auto simp: bij_betw_def)
 
 lemma in_upd_image: "A \<subseteq> {..< n} \<Longrightarrow> i < n \<Longrightarrow> upd i \<in> upd ` A \<longleftrightarrow> i \<in> A"
   using inj_on_image_mem_iff[of upd "{..< n}"] upd
   by (auto simp: bij_betw_def)
 
 lemma enum_inj: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i = enum j \<longleftrightarrow> i = j"
   using inj_enum by (auto simp: inj_on_eq_iff)
 
 lemma in_enum_image: "A \<subseteq> {.. n} \<Longrightarrow> i \<le> n \<Longrightarrow> enum i \<in> enum ` A \<longleftrightarrow> i \<in> A"
   using inj_on_image_mem_iff[OF inj_enum] by auto
 
 lemma enum_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i \<le> enum j \<longleftrightarrow> i \<le> j"
   by (auto simp: enum_def le_fun_def in_upd_image Ball_def[symmetric])
 
 lemma enum_strict_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i < enum j \<longleftrightarrow> i < j"
   using enum_mono[of i j] enum_inj[of i j] by (auto simp: le_less)
 
 lemma chain: "a \<in> s \<Longrightarrow> b \<in> s \<Longrightarrow> a \<le> b \<or> b \<le> a"
   by (auto simp: s_eq enum_mono)
 
 lemma less: "a \<in> s \<Longrightarrow> b \<in> s \<Longrightarrow> a i < b i \<Longrightarrow> a < b"
   using chain[of a b] by (auto simp: less_fun_def le_fun_def not_le[symmetric])
 
 lemma enum_0_bot: "a \<in> s \<Longrightarrow> a = enum 0 \<longleftrightarrow> (\<forall>a'\<in>s. a \<le> a')"
   unfolding s_eq by (auto simp: enum_mono Ball_def)
 
 lemma enum_n_top: "a \<in> s \<Longrightarrow> a = enum n \<longleftrightarrow> (\<forall>a'\<in>s. a' \<le> a)"
   unfolding s_eq by (auto simp: enum_mono Ball_def)
 
 lemma enum_Suc: "i < n \<Longrightarrow> enum (Suc i) = (enum i)(upd i := Suc (enum i (upd i)))"
   by (auto simp: fun_eq_iff enum_def upd_inj)
 
 lemma enum_eq_p: "i \<le> n \<Longrightarrow> n \<le> j \<Longrightarrow> enum i j = p"
   by (induct i) (auto simp: enum_Suc enum_0 base_out upd_space not_less[symmetric])
 
 lemma out_eq_p: "a \<in> s \<Longrightarrow> n \<le> j \<Longrightarrow> a j = p"
   unfolding s_eq by (auto simp: enum_eq_p)
 
 lemma s_le_p: "a \<in> s \<Longrightarrow> a j \<le> p"
   using out_eq_p[of a j] s_space by (cases "j < n") auto
 
 lemma le_Suc_base: "a \<in> s \<Longrightarrow> a j \<le> Suc (base j)"
   unfolding s_eq by (auto simp: enum_def)
 
 lemma base_le: "a \<in> s \<Longrightarrow> base j \<le> a j"
   unfolding s_eq by (auto simp: enum_def)
 
 lemma enum_le_p: "i \<le> n \<Longrightarrow> j < n \<Longrightarrow> enum i j \<le> p"
   using enum_in[of i] s_space by auto
 
 lemma enum_less: "a \<in> s \<Longrightarrow> i < n \<Longrightarrow> enum i < a \<longleftrightarrow> enum (Suc i) \<le> a"
   unfolding s_eq by (auto simp: enum_strict_mono enum_mono)
 
 lemma ksimplex_0:
   "n = 0 \<Longrightarrow> s = {(\<lambda>x. p)}"
   using s_eq enum_def base_out by auto
 
 lemma replace_0:
   assumes "j < n" "a \<in> s" and p: "\<forall>x\<in>s - {a}. x j = 0" and "x \<in> s"
   shows "x \<le> a"
 proof cases
   assume "x \<noteq> a"
   have "a j \<noteq> 0"
     using assms by (intro one_step[where a=a]) auto
   with less[OF \<open>x\<in>s\<close> \<open>a\<in>s\<close>, of j] p[rule_format, of x] \<open>x \<in> s\<close> \<open>x \<noteq> a\<close>
   show ?thesis
     by auto
 qed simp
 
 lemma replace_1:
   assumes "j < n" "a \<in> s" and p: "\<forall>x\<in>s - {a}. x j = p" and "x \<in> s"
   shows "a \<le> x"
 proof cases
   assume "x \<noteq> a"
   have "a j \<noteq> p"
     using assms by (intro one_step[where a=a]) auto
   with enum_le_p[of _ j] \<open>j < n\<close> \<open>a\<in>s\<close>
   have "a j < p"
     by (auto simp: less_le s_eq)
   with less[OF \<open>a\<in>s\<close> \<open>x\<in>s\<close>, of j] p[rule_format, of x] \<open>x \<in> s\<close> \<open>x \<noteq> a\<close>
   show ?thesis
     by auto
 qed simp
 
 end
 
 locale kuhn_simplex_pair = s: kuhn_simplex p n b_s u_s s + t: kuhn_simplex p n b_t u_t t
   for p n b_s u_s s b_t u_t t
 begin
 
 lemma enum_eq:
   assumes l: "i \<le> l" "l \<le> j" and "j + d \<le> n"
   assumes eq: "s.enum ` {i .. j} = t.enum ` {i + d .. j + d}"
   shows "s.enum l = t.enum (l + d)"
 using l proof (induct l rule: dec_induct)
   case base
   then have s: "s.enum i \<in> t.enum ` {i + d .. j + d}" and t: "t.enum (i + d) \<in> s.enum ` {i .. j}"
     using eq by auto
   from t \<open>i \<le> j\<close> \<open>j + d \<le> n\<close> have "s.enum i \<le> t.enum (i + d)"
     by (auto simp: s.enum_mono)
   moreover from s \<open>i \<le> j\<close> \<open>j + d \<le> n\<close> have "t.enum (i + d) \<le> s.enum i"
     by (auto simp: t.enum_mono)
   ultimately show ?case
     by auto
 next
   case (step l)
   moreover from step.prems \<open>j + d \<le> n\<close> have
       "s.enum l < s.enum (Suc l)"
       "t.enum (l + d) < t.enum (Suc l + d)"
     by (simp_all add: s.enum_strict_mono t.enum_strict_mono)
   moreover have
       "s.enum (Suc l) \<in> t.enum ` {i + d .. j + d}"
       "t.enum (Suc l + d) \<in> s.enum ` {i .. j}"
     using step \<open>j + d \<le> n\<close> eq by (auto simp: s.enum_inj t.enum_inj)
   ultimately have "s.enum (Suc l) = t.enum (Suc (l + d))"
     using \<open>j + d \<le> n\<close>
     by (intro antisym s.enum_less[THEN iffD1] t.enum_less[THEN iffD1])
        (auto intro!: s.enum_in t.enum_in)
   then show ?case by simp
 qed
 
 lemma ksimplex_eq_bot:
   assumes a: "a \<in> s" "\<And>a'. a' \<in> s \<Longrightarrow> a \<le> a'"
   assumes b: "b \<in> t" "\<And>b'. b' \<in> t \<Longrightarrow> b \<le> b'"
   assumes eq: "s - {a} = t - {b}"
   shows "s = t"
 proof cases
   assume "n = 0" with s.ksimplex_0 t.ksimplex_0 show ?thesis by simp
 next
   assume "n \<noteq> 0"
   have "s.enum 0 = (s.enum (Suc 0)) (u_s 0 := s.enum (Suc 0) (u_s 0) - 1)"
        "t.enum 0 = (t.enum (Suc 0)) (u_t 0 := t.enum (Suc 0) (u_t 0) - 1)"
     using \<open>n \<noteq> 0\<close> by (simp_all add: s.enum_Suc t.enum_Suc)
   moreover have e0: "a = s.enum 0" "b = t.enum 0"
     using a b by (simp_all add: s.enum_0_bot t.enum_0_bot)
   moreover
   { fix j assume "0 < j" "j \<le> n"
     moreover have "s - {a} = s.enum ` {Suc 0 .. n}" "t - {b} = t.enum ` {Suc 0 .. n}"
       unfolding s.s_eq t.s_eq e0 by (auto simp: s.enum_inj t.enum_inj)
     ultimately have "s.enum j = t.enum j"
       using enum_eq[of "1" j n 0] eq by auto }
   note enum_eq = this
   then have "s.enum (Suc 0) = t.enum (Suc 0)"
     using \<open>n \<noteq> 0\<close> by auto
   moreover
   { fix j assume "Suc j < n"
     with enum_eq[of "Suc j"] enum_eq[of "Suc (Suc j)"]
     have "u_s (Suc j) = u_t (Suc j)"
       using s.enum_Suc[of "Suc j"] t.enum_Suc[of "Suc j"]
       by (auto simp: fun_eq_iff split: if_split_asm) }
   then have "\<And>j. 0 < j \<Longrightarrow> j < n \<Longrightarrow> u_s j = u_t j"
     by (auto simp: gr0_conv_Suc)
   with \<open>n \<noteq> 0\<close> have "u_t 0 = u_s 0"
     by (intro bij_betw_singleton_eq[OF t.upd s.upd, of 0]) auto
   ultimately have "a = b"
     by simp
   with assms show "s = t"
     by auto
 qed
 
 lemma ksimplex_eq_top:
   assumes a: "a \<in> s" "\<And>a'. a' \<in> s \<Longrightarrow> a' \<le> a"
   assumes b: "b \<in> t" "\<And>b'. b' \<in> t \<Longrightarrow> b' \<le> b"
   assumes eq: "s - {a} = t - {b}"
   shows "s = t"
 proof (cases n)
   assume "n = 0" with s.ksimplex_0 t.ksimplex_0 show ?thesis by simp
 next
   case (Suc n')
   have "s.enum n = (s.enum n') (u_s n' := Suc (s.enum n' (u_s n')))"
        "t.enum n = (t.enum n') (u_t n' := Suc (t.enum n' (u_t n')))"
     using Suc by (simp_all add: s.enum_Suc t.enum_Suc)
   moreover have en: "a = s.enum n" "b = t.enum n"
     using a b by (simp_all add: s.enum_n_top t.enum_n_top)
   moreover
   { fix j assume "j < n"
     moreover have "s - {a} = s.enum ` {0 .. n'}" "t - {b} = t.enum ` {0 .. n'}"
       unfolding s.s_eq t.s_eq en by (auto simp: s.enum_inj t.enum_inj Suc)
     ultimately have "s.enum j = t.enum j"
       using enum_eq[of "0" j n' 0] eq Suc by auto }
   note enum_eq = this
   then have "s.enum n' = t.enum n'"
     using Suc by auto
   moreover
   { fix j assume "j < n'"
     with enum_eq[of j] enum_eq[of "Suc j"]
     have "u_s j = u_t j"
       using s.enum_Suc[of j] t.enum_Suc[of j]
       by (auto simp: Suc fun_eq_iff split: if_split_asm) }
   then have "\<And>j. j < n' \<Longrightarrow> u_s j = u_t j"
     by (auto simp: gr0_conv_Suc)
   then have "u_t n' = u_s n'"
     by (intro bij_betw_singleton_eq[OF t.upd s.upd, of n']) (auto simp: Suc)
   ultimately have "a = b"
     by simp
   with assms show "s = t"
     by auto
 qed
 
 end
 
 inductive ksimplex for p n :: nat where
   ksimplex: "kuhn_simplex p n base upd s \<Longrightarrow> ksimplex p n s"
 
 lemma finite_ksimplexes: "finite {s. ksimplex p n s}"
 proof (rule finite_subset)
   { fix a s assume "ksimplex p n s" "a \<in> s"
     then obtain b u where "kuhn_simplex p n b u s" by (auto elim: ksimplex.cases)
     then interpret kuhn_simplex p n b u s .
     from s_space \<open>a \<in> s\<close> out_eq_p[OF \<open>a \<in> s\<close>]
     have "a \<in> (\<lambda>f x. if n \<le> x then p else f x) ` ({..< n} \<rightarrow>\<^sub>E {.. p})"
       by (auto simp: image_iff subset_eq Pi_iff split: if_split_asm
                intro!: bexI[of _ "restrict a {..< n}"]) }
   then show "{s. ksimplex p n s} \<subseteq> Pow ((\<lambda>f x. if n \<le> x then p else f x) ` ({..< n} \<rightarrow>\<^sub>E {.. p}))"
     by auto
 qed (simp add: finite_PiE)
 
 lemma ksimplex_card:
   assumes "ksimplex p n s" shows "card s = Suc n"
 using assms proof cases
   case (ksimplex u b)
   then interpret kuhn_simplex p n u b s .
   show ?thesis
     by (simp add: card_image s_eq inj_enum)
 qed
 
 lemma simplex_top_face:
   assumes "0 < p" "\<forall>x\<in>s'. x n = p"
   shows "ksimplex p n s' \<longleftrightarrow> (\<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> s' = s - {a})"
   using assms
 proof safe
   fix s a assume "ksimplex p (Suc n) s" and a: "a \<in> s" and na: "\<forall>x\<in>s - {a}. x n = p"
   then show "ksimplex p n (s - {a})"
   proof cases
     case (ksimplex base upd)
     then interpret kuhn_simplex p "Suc n" base upd "s" .
 
     have "a n < p"
       using one_step[of a n p] na \<open>a\<in>s\<close> s_space by (auto simp: less_le)
     then have "a = enum 0"
       using \<open>a \<in> s\<close> na by (subst enum_0_bot) (auto simp: le_less intro!: less[of a _ n])
     then have s_eq: "s - {a} = enum ` Suc ` {.. n}"
-      using s_eq by (simp add: atMost_Suc_eq_insert_0 insert_ident zero_notin_Suc_image in_enum_image subset_eq)
+      using s_eq by (simp add: atMost_Suc_eq_insert_0 insert_ident in_enum_image subset_eq)
     then have "enum 1 \<in> s - {a}"
       by auto
     then have "upd 0 = n"
       using \<open>a n < p\<close> \<open>a = enum 0\<close> na[rule_format, of "enum 1"]
       by (auto simp: fun_eq_iff enum_Suc split: if_split_asm)
     then have "bij_betw upd (Suc ` {..< n}) {..< n}"
       using upd
       by (subst notIn_Un_bij_betw3[where b=0])
          (auto simp: lessThan_Suc[symmetric] lessThan_Suc_eq_insert_0)
     then have "bij_betw (upd\<circ>Suc) {..<n} {..<n}"
       by (rule bij_betw_trans[rotated]) (auto simp: bij_betw_def)
 
     have "a n = p - 1"
       using enum_Suc[of 0] na[rule_format, OF \<open>enum 1 \<in> s - {a}\<close>] \<open>a = enum 0\<close> by (auto simp: \<open>upd 0 = n\<close>)
 
     show ?thesis
     proof (rule ksimplex.intros, standard)
       show "bij_betw (upd\<circ>Suc) {..< n} {..< n}" by fact
       show "base(n := p) \<in> {..<n} \<rightarrow> {..<p}" "\<And>i. n\<le>i \<Longrightarrow> (base(n := p)) i = p"
         using base base_out by (auto simp: Pi_iff)
 
       have "\<And>i. Suc ` {..< i} = {..< Suc i} - {0}"
         by (auto simp: image_iff Ball_def) arith
       then have upd_Suc: "\<And>i. i \<le> n \<Longrightarrow> (upd\<circ>Suc) ` {..< i} = upd ` {..< Suc i} - {n}"
         using \<open>upd 0 = n\<close> upd_inj by (auto simp add: image_iff less_Suc_eq_0_disj)
       have n_in_upd: "\<And>i. n \<in> upd ` {..< Suc i}"
         using \<open>upd 0 = n\<close> by auto
 
       define f' where "f' i j =
         (if j \<in> (upd\<circ>Suc)`{..< i} then Suc ((base(n := p)) j) else (base(n := p)) j)" for i j
       { fix x i
         assume i [arith]: "i \<le> n"
         with upd_Suc have "(upd \<circ> Suc) ` {..<i} = upd ` {..<Suc i} - {n}" .
         with \<open>a n < p\<close> \<open>a = enum 0\<close> \<open>upd 0 = n\<close> \<open>a n = p - 1\<close>
         have "enum (Suc i) x = f' i x"
           by (auto simp add: f'_def enum_def)  }
       then show "s - {a} = f' ` {.. n}"
         unfolding s_eq image_comp by (intro image_cong) auto
     qed
   qed
 next
   assume "ksimplex p n s'" and *: "\<forall>x\<in>s'. x n = p"
   then show "\<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> s' = s - {a}"
   proof cases
     case (ksimplex base upd)
     then interpret kuhn_simplex p n base upd s' .
     define b where "b = base (n := p - 1)"
     define u where "u i = (case i of 0 \<Rightarrow> n | Suc i \<Rightarrow> upd i)" for i
 
     have "ksimplex p (Suc n) (s' \<union> {b})"
     proof (rule ksimplex.intros, standard)
       show "b \<in> {..<Suc n} \<rightarrow> {..<p}"
         using base \<open>0 < p\<close> unfolding lessThan_Suc b_def by (auto simp: PiE_iff)
       show "\<And>i. Suc n \<le> i \<Longrightarrow> b i = p"
         using base_out by (auto simp: b_def)
 
       have "bij_betw u (Suc ` {..< n} \<union> {0}) ({..<n} \<union> {u 0})"
         using upd
         by (intro notIn_Un_bij_betw) (auto simp: u_def bij_betw_def image_comp comp_def inj_on_def)
       then show "bij_betw u {..<Suc n} {..<Suc n}"
         by (simp add: u_def lessThan_Suc[symmetric] lessThan_Suc_eq_insert_0)
 
       define f' where "f' i j = (if j \<in> u`{..< i} then Suc (b j) else b j)" for i j
 
       have u_eq: "\<And>i. i \<le> n \<Longrightarrow> u ` {..< Suc i} = upd ` {..< i} \<union> { n }"
         by (auto simp: u_def image_iff upd_inj Ball_def split: nat.split) arith
 
       { fix x have "x \<le> n \<Longrightarrow> n \<notin> upd ` {..<x}"
           using upd_space by (simp add: image_iff neq_iff) }
       note n_not_upd = this
 
       have *: "f' ` {.. Suc n} = f' ` (Suc ` {.. n} \<union> {0})"
         unfolding atMost_Suc_eq_insert_0 by simp
       also have "\<dots> = (f' \<circ> Suc) ` {.. n} \<union> {b}"
         by (auto simp: f'_def)
       also have "(f' \<circ> Suc) ` {.. n} = s'"
         using \<open>0 < p\<close> base_out[of n]
         unfolding s_eq enum_def[abs_def] f'_def[abs_def] upd_space
         by (intro image_cong) (simp_all add: u_eq b_def fun_eq_iff n_not_upd)
       finally show "s' \<union> {b} = f' ` {.. Suc n}" ..
     qed
     moreover have "b \<notin> s'"
       using * \<open>0 < p\<close> by (auto simp: b_def)
     ultimately show ?thesis by auto
   qed
 qed
 
 lemma ksimplex_replace_0:
   assumes s: "ksimplex p n s" and a: "a \<in> s"
   assumes j: "j < n" and p: "\<forall>x\<in>s - {a}. x j = 0"
   shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 1"
   using s
 proof cases
   case (ksimplex b_s u_s)
 
   { fix t b assume "ksimplex p n t"
     then obtain b_t u_t where "kuhn_simplex p n b_t u_t t"
       by (auto elim: ksimplex.cases)
     interpret kuhn_simplex_pair p n b_s u_s s b_t u_t t
       by intro_locales fact+
 
     assume b: "b \<in> t" "t - {b} = s - {a}"
     with a j p s.replace_0[of _ a] t.replace_0[of _ b] have "s = t"
       by (intro ksimplex_eq_top[of a b]) auto }
   then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}"
     using s \<open>a \<in> s\<close> by auto
   then show ?thesis
     by simp
 qed
 
 lemma ksimplex_replace_1:
   assumes s: "ksimplex p n s" and a: "a \<in> s"
   assumes j: "j < n" and p: "\<forall>x\<in>s - {a}. x j = p"
   shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 1"
   using s
 proof cases
   case (ksimplex b_s u_s)
 
   { fix t b assume "ksimplex p n t"
     then obtain b_t u_t where "kuhn_simplex p n b_t u_t t"
       by (auto elim: ksimplex.cases)
     interpret kuhn_simplex_pair p n b_s u_s s b_t u_t t
       by intro_locales fact+
 
     assume b: "b \<in> t" "t - {b} = s - {a}"
     with a j p s.replace_1[of _ a] t.replace_1[of _ b] have "s = t"
       by (intro ksimplex_eq_bot[of a b]) auto }
   then have "{s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = {s}"
     using s \<open>a \<in> s\<close> by auto
   then show ?thesis
     by simp
 qed
 
 lemma card_2_exists: "card s = 2 \<longleftrightarrow> (\<exists>x\<in>s. \<exists>y\<in>s. x \<noteq> y \<and> (\<forall>z\<in>s. z = x \<or> z = y))"
   by (auto simp: card_Suc_eq eval_nat_numeral)
 
 lemma ksimplex_replace_2:
   assumes s: "ksimplex p n s" and "a \<in> s" and "n \<noteq> 0"
     and lb: "\<forall>j<n. \<exists>x\<in>s - {a}. x j \<noteq> 0"
     and ub: "\<forall>j<n. \<exists>x\<in>s - {a}. x j \<noteq> p"
   shows "card {s'. ksimplex p n s' \<and> (\<exists>b\<in>s'. s' - {b} = s - {a})} = 2"
   using s
 proof cases
   case (ksimplex base upd)
   then interpret kuhn_simplex p n base upd s .
 
   from \<open>a \<in> s\<close> obtain i where "i \<le> n" "a = enum i"
     unfolding s_eq by auto
 
   from \<open>i \<le> n\<close> have "i = 0 \<or> i = n \<or> (0 < i \<and> i < n)"
     by linarith
   then have "\<exists>!s'. s' \<noteq> s \<and> ksimplex p n s' \<and> (\<exists>b\<in>s'. s - {a} = s'- {b})"
   proof (elim disjE conjE)
     assume "i = 0"
     define rot where [abs_def]: "rot i = (if i + 1 = n then 0 else i + 1)" for i
     let ?upd = "upd \<circ> rot"
 
     have rot: "bij_betw rot {..< n} {..< n}"
       by (auto simp: bij_betw_def inj_on_def image_iff Ball_def rot_def)
          arith+
     from rot upd have "bij_betw ?upd {..<n} {..<n}"
       by (rule bij_betw_trans)
 
     define f' where [abs_def]: "f' i j =
       (if j \<in> ?upd`{..< i} then Suc (enum (Suc 0) j) else enum (Suc 0) j)" for i j
 
     interpret b: kuhn_simplex p n "enum (Suc 0)" "upd \<circ> rot" "f' ` {.. n}"
     proof
       from \<open>a = enum i\<close> ub \<open>n \<noteq> 0\<close> \<open>i = 0\<close>
       obtain i' where "i' \<le> n" "enum i' \<noteq> enum 0" "enum i' (upd 0) \<noteq> p"
         unfolding s_eq by (auto intro: upd_space simp: enum_inj)
       then have "enum 1 \<le> enum i'" "enum i' (upd 0) < p"
         using enum_le_p[of i' "upd 0"] by (auto simp: enum_inj enum_mono upd_space)
       then have "enum 1 (upd 0) < p"
         by (auto simp: le_fun_def intro: le_less_trans)
       then show "enum (Suc 0) \<in> {..<n} \<rightarrow> {..<p}"
         using base \<open>n \<noteq> 0\<close> by (auto simp: enum_0 enum_Suc PiE_iff extensional_def upd_space)
 
       { fix i assume "n \<le> i" then show "enum (Suc 0) i = p"
         using \<open>n \<noteq> 0\<close> by (auto simp: enum_eq_p) }
       show "bij_betw ?upd {..<n} {..<n}" by fact
     qed (simp add: f'_def)
     have ks_f': "ksimplex p n (f' ` {.. n})"
       by rule unfold_locales
 
     have b_enum: "b.enum = f'" unfolding f'_def b.enum_def[abs_def] ..
     with b.inj_enum have inj_f': "inj_on f' {.. n}" by simp
 
     have f'_eq_enum: "f' j = enum (Suc j)" if "j < n" for j
     proof -
       from that have "rot ` {..< j} = {0 <..< Suc j}"
         by (auto simp: rot_def image_Suc_lessThan cong: image_cong_simp)
       with that \<open>n \<noteq> 0\<close> show ?thesis
         by (simp only: f'_def enum_def fun_eq_iff image_comp [symmetric])
           (auto simp add: upd_inj)
     qed
     then have "enum ` Suc ` {..< n} = f' ` {..< n}"
       by (force simp: enum_inj)
     also have "Suc ` {..< n} = {.. n} - {0}"
       by (auto simp: image_iff Ball_def) arith
     also have "{..< n} = {.. n} - {n}"
       by auto
     finally have eq: "s - {a} = f' ` {.. n} - {f' n}"
       unfolding s_eq \<open>a = enum i\<close> \<open>i = 0\<close>
       by (simp add: inj_on_image_set_diff[OF inj_enum] inj_on_image_set_diff[OF inj_f'])
 
     have "enum 0 < f' 0"
       using \<open>n \<noteq> 0\<close> by (simp add: enum_strict_mono f'_eq_enum)
     also have "\<dots> < f' n"
       using \<open>n \<noteq> 0\<close> b.enum_strict_mono[of 0 n] unfolding b_enum by simp
     finally have "a \<noteq> f' n"
       using \<open>a = enum i\<close> \<open>i = 0\<close> by auto
 
     { fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}"
       obtain b u where "kuhn_simplex p n b u t"
         using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases)
       then interpret t: kuhn_simplex p n b u t .
 
       { fix x assume "x \<in> s" "x \<noteq> a"
          then have "x (upd 0) = enum (Suc 0) (upd 0)"
            by (auto simp: \<open>a = enum i\<close> \<open>i = 0\<close> s_eq enum_def enum_inj) }
       then have eq_upd0: "\<forall>x\<in>t-{c}. x (upd 0) = enum (Suc 0) (upd 0)"
         unfolding eq_sma[symmetric] by auto
       then have "c (upd 0) \<noteq> enum (Suc 0) (upd 0)"
         using \<open>n \<noteq> 0\<close> by (intro t.one_step[OF \<open>c\<in>t\<close> ]) (auto simp: upd_space)
       then have "c (upd 0) < enum (Suc 0) (upd 0) \<or> c (upd 0) > enum (Suc 0) (upd 0)"
         by auto
       then have "t = s \<or> t = f' ` {..n}"
       proof (elim disjE conjE)
         assume *: "c (upd 0) < enum (Suc 0) (upd 0)"
         interpret st: kuhn_simplex_pair p n base upd s b u t ..
         { fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "c \<le> x"
             by (auto simp: le_less intro!: t.less[of _ _ "upd 0"]) }
         note top = this
         have "s = t"
           using \<open>a = enum i\<close> \<open>i = 0\<close> \<open>c \<in> t\<close>
           by (intro st.ksimplex_eq_bot[OF _ _ _ _ eq_sma])
              (auto simp: s_eq enum_mono t.s_eq t.enum_mono top)
         then show ?thesis by simp
       next
         assume *: "c (upd 0) > enum (Suc 0) (upd 0)"
         interpret st: kuhn_simplex_pair p n "enum (Suc 0)" "upd \<circ> rot" "f' ` {.. n}" b u t ..
         have eq: "f' ` {..n} - {f' n} = t - {c}"
           using eq_sma eq by simp
         { fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "x \<le> c"
             by (auto simp: le_less intro!: t.less[of _ _ "upd 0"]) }
         note top = this
         have "f' ` {..n} = t"
           using \<open>a = enum i\<close> \<open>i = 0\<close> \<open>c \<in> t\<close>
           by (intro st.ksimplex_eq_top[OF _ _ _ _ eq])
              (auto simp: b.s_eq b.enum_mono t.s_eq t.enum_mono b_enum[symmetric] top)
         then show ?thesis by simp
       qed }
     with ks_f' eq \<open>a \<noteq> f' n\<close> \<open>n \<noteq> 0\<close> show ?thesis
       apply (intro ex1I[of _ "f' ` {.. n}"])
       apply auto []
       apply metis
       done
   next
     assume "i = n"
     from \<open>n \<noteq> 0\<close> obtain n' where n': "n = Suc n'"
       by (cases n) auto
 
     define rot where "rot i = (case i of 0 \<Rightarrow> n' | Suc i \<Rightarrow> i)" for i
     let ?upd = "upd \<circ> rot"
 
     have rot: "bij_betw rot {..< n} {..< n}"
       by (auto simp: bij_betw_def inj_on_def image_iff Bex_def rot_def n' split: nat.splits)
          arith
     from rot upd have "bij_betw ?upd {..<n} {..<n}"
       by (rule bij_betw_trans)
 
     define b where "b = base (upd n' := base (upd n') - 1)"
     define f' where [abs_def]: "f' i j = (if j \<in> ?upd`{..< i} then Suc (b j) else b j)" for i j
 
     interpret b: kuhn_simplex p n b "upd \<circ> rot" "f' ` {.. n}"
     proof
       { fix i assume "n \<le> i" then show "b i = p"
           using base_out[of i] upd_space[of n'] by (auto simp: b_def n') }
       show "b \<in> {..<n} \<rightarrow> {..<p}"
         using base \<open>n \<noteq> 0\<close> upd_space[of n']
         by (auto simp: b_def PiE_def Pi_iff Ball_def upd_space extensional_def n')
 
       show "bij_betw ?upd {..<n} {..<n}" by fact
     qed (simp add: f'_def)
     have f': "b.enum = f'" unfolding f'_def b.enum_def[abs_def] ..
     have ks_f': "ksimplex p n (b.enum ` {.. n})"
       unfolding f' by rule unfold_locales
 
     have "0 < n"
       using \<open>n \<noteq> 0\<close> by auto
 
     { from \<open>a = enum i\<close> \<open>n \<noteq> 0\<close> \<open>i = n\<close> lb upd_space[of n']
       obtain i' where "i' \<le> n" "enum i' \<noteq> enum n" "0 < enum i' (upd n')"
         unfolding s_eq by (auto simp: enum_inj n')
       moreover have "enum i' (upd n') = base (upd n')"
         unfolding enum_def using \<open>i' \<le> n\<close> \<open>enum i' \<noteq> enum n\<close> by (auto simp: n' upd_inj enum_inj)
       ultimately have "0 < base (upd n')"
         by auto }
     then have benum1: "b.enum (Suc 0) = base"
       unfolding b.enum_Suc[OF \<open>0<n\<close>] b.enum_0 by (auto simp: b_def rot_def)
 
     have [simp]: "\<And>j. Suc j < n \<Longrightarrow> rot ` {..< Suc j} = {n'} \<union> {..< j}"
       by (auto simp: rot_def image_iff Ball_def split: nat.splits)
     have rot_simps: "\<And>j. rot (Suc j) = j" "rot 0 = n'"
       by (simp_all add: rot_def)
 
     { fix j assume j: "Suc j \<le> n" then have "b.enum (Suc j) = enum j"
         by (induct j) (auto simp: benum1 enum_0 b.enum_Suc enum_Suc rot_simps) }
     note b_enum_eq_enum = this
     then have "enum ` {..< n} = b.enum ` Suc ` {..< n}"
       by (auto simp: image_comp intro!: image_cong)
     also have "Suc ` {..< n} = {.. n} - {0}"
       by (auto simp: image_iff Ball_def) arith
     also have "{..< n} = {.. n} - {n}"
       by auto
     finally have eq: "s - {a} = b.enum ` {.. n} - {b.enum 0}"
       unfolding s_eq \<open>a = enum i\<close> \<open>i = n\<close>
       using inj_on_image_set_diff[OF inj_enum Diff_subset, of "{n}"]
             inj_on_image_set_diff[OF b.inj_enum Diff_subset, of "{0}"]
       by (simp add: comp_def)
 
     have "b.enum 0 \<le> b.enum n"
       by (simp add: b.enum_mono)
     also have "b.enum n < enum n"
       using \<open>n \<noteq> 0\<close> by (simp add: enum_strict_mono b_enum_eq_enum n')
     finally have "a \<noteq> b.enum 0"
       using \<open>a = enum i\<close> \<open>i = n\<close> by auto
 
     { fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}"
       obtain b' u where "kuhn_simplex p n b' u t"
         using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases)
       then interpret t: kuhn_simplex p n b' u t .
 
       { fix x assume "x \<in> s" "x \<noteq> a"
          then have "x (upd n') = enum n' (upd n')"
            by (auto simp: \<open>a = enum i\<close> n' \<open>i = n\<close> s_eq enum_def enum_inj in_upd_image) }
       then have eq_upd0: "\<forall>x\<in>t-{c}. x (upd n') = enum n' (upd n')"
         unfolding eq_sma[symmetric] by auto
       then have "c (upd n') \<noteq> enum n' (upd n')"
         using \<open>n \<noteq> 0\<close> by (intro t.one_step[OF \<open>c\<in>t\<close> ]) (auto simp: n' upd_space[unfolded n'])
       then have "c (upd n') < enum n' (upd n') \<or> c (upd n') > enum n' (upd n')"
         by auto
       then have "t = s \<or> t = b.enum ` {..n}"
       proof (elim disjE conjE)
         assume *: "c (upd n') > enum n' (upd n')"
         interpret st: kuhn_simplex_pair p n base upd s b' u t ..
         { fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "x \<le> c"
             by (auto simp: le_less intro!: t.less[of _ _ "upd n'"]) }
         note top = this
         have "s = t"
           using \<open>a = enum i\<close> \<open>i = n\<close> \<open>c \<in> t\<close>
           by (intro st.ksimplex_eq_top[OF _ _ _ _ eq_sma])
              (auto simp: s_eq enum_mono t.s_eq t.enum_mono top)
         then show ?thesis by simp
       next
         assume *: "c (upd n') < enum n' (upd n')"
         interpret st: kuhn_simplex_pair p n b "upd \<circ> rot" "f' ` {.. n}" b' u t ..
         have eq: "f' ` {..n} - {b.enum 0} = t - {c}"
           using eq_sma eq f' by simp
         { fix x assume "x \<in> t" with * \<open>c\<in>t\<close> eq_upd0[rule_format, of x] have "c \<le> x"
             by (auto simp: le_less intro!: t.less[of _ _ "upd n'"]) }
         note bot = this
         have "f' ` {..n} = t"
           using \<open>a = enum i\<close> \<open>i = n\<close> \<open>c \<in> t\<close>
           by (intro st.ksimplex_eq_bot[OF _ _ _ _ eq])
              (auto simp: b.s_eq b.enum_mono t.s_eq t.enum_mono bot)
         with f' show ?thesis by simp
       qed }
     with ks_f' eq \<open>a \<noteq> b.enum 0\<close> \<open>n \<noteq> 0\<close> show ?thesis
       apply (intro ex1I[of _ "b.enum ` {.. n}"])
       apply auto []
       apply metis
       done
   next
     assume i: "0 < i" "i < n"
     define i' where "i' = i - 1"
     with i have "Suc i' < n"
       by simp
     with i have Suc_i': "Suc i' = i"
       by (simp add: i'_def)
 
     let ?upd = "Fun.swap i' i upd"
     from i upd have "bij_betw ?upd {..< n} {..< n}"
       by (subst bij_betw_swap_iff) (auto simp: i'_def)
 
     define f' where [abs_def]: "f' i j = (if j \<in> ?upd`{..< i} then Suc (base j) else base j)"
       for i j
     interpret b: kuhn_simplex p n base ?upd "f' ` {.. n}"
     proof
       show "base \<in> {..<n} \<rightarrow> {..<p}" by (rule base)
       { fix i assume "n \<le> i" then show "base i = p" by (rule base_out) }
       show "bij_betw ?upd {..<n} {..<n}" by fact
     qed (simp add: f'_def)
     have f': "b.enum = f'" unfolding f'_def b.enum_def[abs_def] ..
     have ks_f': "ksimplex p n (b.enum ` {.. n})"
       unfolding f' by rule unfold_locales
 
     have "{i} \<subseteq> {..n}"
       using i by auto
     { fix j assume "j \<le> n"
       moreover have "j < i \<or> i = j \<or> i < j" by arith
       moreover note i
       ultimately have "enum j = b.enum j \<longleftrightarrow> j \<noteq> i"
         unfolding enum_def[abs_def] b.enum_def[abs_def]
         by (auto simp: fun_eq_iff swap_image i'_def
                            in_upd_image inj_on_image_set_diff[OF inj_upd]) }
     note enum_eq_benum = this
     then have "enum ` ({.. n} - {i}) = b.enum ` ({.. n} - {i})"
       by (intro image_cong) auto
     then have eq: "s - {a} = b.enum ` {.. n} - {b.enum i}"
       unfolding s_eq \<open>a = enum i\<close>
       using inj_on_image_set_diff[OF inj_enum Diff_subset \<open>{i} \<subseteq> {..n}\<close>]
             inj_on_image_set_diff[OF b.inj_enum Diff_subset \<open>{i} \<subseteq> {..n}\<close>]
       by (simp add: comp_def)
 
     have "a \<noteq> b.enum i"
       using \<open>a = enum i\<close> enum_eq_benum i by auto
 
     { fix t c assume "ksimplex p n t" "c \<in> t" and eq_sma: "s - {a} = t - {c}"
       obtain b' u where "kuhn_simplex p n b' u t"
         using \<open>ksimplex p n t\<close> by (auto elim: ksimplex.cases)
       then interpret t: kuhn_simplex p n b' u t .
       have "enum i' \<in> s - {a}" "enum (i + 1) \<in> s - {a}"
         using \<open>a = enum i\<close> i enum_in by (auto simp: enum_inj i'_def)
       then obtain l k where
         l: "t.enum l = enum i'" "l \<le> n" "t.enum l \<noteq> c" and
         k: "t.enum k = enum (i + 1)" "k \<le> n" "t.enum k \<noteq> c"
         unfolding eq_sma by (auto simp: t.s_eq)
       with i have "t.enum l < t.enum k"
         by (simp add: enum_strict_mono i'_def)
       with \<open>l \<le> n\<close> \<open>k \<le> n\<close> have "l < k"
         by (simp add: t.enum_strict_mono)
       { assume "Suc l = k"
         have "enum (Suc (Suc i')) = t.enum (Suc l)"
           using i by (simp add: k \<open>Suc l = k\<close> i'_def)
         then have False
           using \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close>
           by (auto simp: t.enum_Suc enum_Suc l upd_inj fun_eq_iff split: if_split_asm)
              (metis Suc_lessD n_not_Suc_n upd_inj) }
       with \<open>l < k\<close> have "Suc l < k"
         by arith
       have c_eq: "c = t.enum (Suc l)"
       proof (rule ccontr)
         assume "c \<noteq> t.enum (Suc l)"
         then have "t.enum (Suc l) \<in> s - {a}"
           using \<open>l < k\<close> \<open>k \<le> n\<close> by (simp add: t.s_eq eq_sma)
         then obtain j where "t.enum (Suc l) = enum j" "j \<le> n" "enum j \<noteq> enum i"
           unfolding s_eq \<open>a = enum i\<close> by auto
         with i have "t.enum (Suc l) \<le> t.enum l \<or> t.enum k \<le> t.enum (Suc l)"
           by (auto simp: i'_def enum_mono enum_inj l k)
         with \<open>Suc l < k\<close> \<open>k \<le> n\<close> show False
           by (simp add: t.enum_mono)
       qed
 
       { have "t.enum (Suc (Suc l)) \<in> s - {a}"
           unfolding eq_sma c_eq t.s_eq using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (auto simp: t.enum_inj)
         then obtain j where eq: "t.enum (Suc (Suc l)) = enum j" and "j \<le> n" "j \<noteq> i"
           by (auto simp: s_eq \<open>a = enum i\<close>)
         moreover have "enum i' < t.enum (Suc (Suc l))"
           unfolding l(1)[symmetric] using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (auto simp: t.enum_strict_mono)
         ultimately have "i' < j"
           using i by (simp add: enum_strict_mono i'_def)
         with \<open>j \<noteq> i\<close> \<open>j \<le> n\<close> have "t.enum k \<le> t.enum (Suc (Suc l))"
           unfolding i'_def by (simp add: enum_mono k eq)
         then have "k \<le> Suc (Suc l)"
           using \<open>k \<le> n\<close> \<open>Suc l < k\<close> by (simp add: t.enum_mono) }
       with \<open>Suc l < k\<close> have "Suc (Suc l) = k" by simp
       then have "enum (Suc (Suc i')) = t.enum (Suc (Suc l))"
         using i by (simp add: k i'_def)
       also have "\<dots> = (enum i') (u l := Suc (enum i' (u l)), u (Suc l) := Suc (enum i' (u (Suc l))))"
         using \<open>Suc l < k\<close> \<open>k \<le> n\<close> by (simp add: t.enum_Suc l t.upd_inj)
       finally have "(u l = upd i' \<and> u (Suc l) = upd (Suc i')) \<or>
         (u l = upd (Suc i') \<and> u (Suc l) = upd i')"
         using \<open>Suc i' < n\<close> by (auto simp: enum_Suc fun_eq_iff split: if_split_asm)
 
       then have "t = s \<or> t = b.enum ` {..n}"
       proof (elim disjE conjE)
         assume u: "u l = upd i'"
         have "c = t.enum (Suc l)" unfolding c_eq ..
         also have "t.enum (Suc l) = enum (Suc i')"
           using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close> by (simp add: enum_Suc t.enum_Suc l)
         also have "\<dots> = a"
           using \<open>a = enum i\<close> i by (simp add: i'_def)
         finally show ?thesis
           using eq_sma \<open>a \<in> s\<close> \<open>c \<in> t\<close> by auto
       next
         assume u: "u l = upd (Suc i')"
         define B where "B = b.enum ` {..n}"
         have "b.enum i' = enum i'"
           using enum_eq_benum[of i'] i by (auto simp: i'_def gr0_conv_Suc)
         have "c = t.enum (Suc l)" unfolding c_eq ..
         also have "t.enum (Suc l) = b.enum (Suc i')"
           using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close>
-          by (simp_all add: enum_Suc t.enum_Suc l b.enum_Suc \<open>b.enum i' = enum i'\<close> swap_apply1)
+          by (simp_all add: enum_Suc t.enum_Suc l b.enum_Suc \<open>b.enum i' = enum i'\<close>)
              (simp add: Suc_i')
         also have "\<dots> = b.enum i"
           using i by (simp add: i'_def)
         finally have "c = b.enum i" .
         then have "t - {c} = B - {c}" "c \<in> B"
           unfolding eq_sma[symmetric] eq B_def using i by auto
         with \<open>c \<in> t\<close> have "t = B"
           by auto
         then show ?thesis
           by (simp add: B_def)
       qed }
     with ks_f' eq \<open>a \<noteq> b.enum i\<close> \<open>n \<noteq> 0\<close> \<open>i \<le> n\<close> show ?thesis
       apply (intro ex1I[of _ "b.enum ` {.. n}"])
       apply auto []
       apply metis
       done
   qed
   then show ?thesis
     using s \<open>a \<in> s\<close> by (simp add: card_2_exists Ex1_def) metis
 qed
 
 text \<open>Hence another step towards concreteness.\<close>
 
 lemma kuhn_simplex_lemma:
   assumes "\<forall>s. ksimplex p (Suc n) s \<longrightarrow> rl ` s \<subseteq> {.. Suc n}"
     and "odd (card {f. \<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> (f = s - {a}) \<and>
       rl ` f = {..n} \<and> ((\<exists>j\<le>n. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>f. x j = p))})"
   shows "odd (card {s. ksimplex p (Suc n) s \<and> rl ` s = {..Suc n}})"
 proof (rule kuhn_complete_lemma[OF finite_ksimplexes refl, unfolded mem_Collect_eq,
     where bnd="\<lambda>f. (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = p)"],
     safe del: notI)
 
   have *: "\<And>x y. x = y \<Longrightarrow> odd (card x) \<Longrightarrow> odd (card y)"
     by auto
   show "odd (card {f. (\<exists>s\<in>{s. ksimplex p (Suc n) s}. \<exists>a\<in>s. f = s - {a}) \<and>
     rl ` f = {..n} \<and> ((\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<in>{..n}. \<forall>x\<in>f. x j = p))})"
     apply (rule *[OF _ assms(2)])
     apply (auto simp: atLeast0AtMost)
     done
 
 next
 
   fix s assume s: "ksimplex p (Suc n) s"
   then show "card s = n + 2"
     by (simp add: ksimplex_card)
 
   fix a assume a: "a \<in> s" then show "rl a \<le> Suc n"
     using assms(1) s by (auto simp: subset_eq)
 
   let ?S = "{t. ksimplex p (Suc n) t \<and> (\<exists>b\<in>t. s - {a} = t - {b})}"
   { fix j assume j: "j \<le> n" "\<forall>x\<in>s - {a}. x j = 0"
     with s a show "card ?S = 1"
       using ksimplex_replace_0[of p "n + 1" s a j]
       by (subst eq_commute) simp }
 
   { fix j assume j: "j \<le> n" "\<forall>x\<in>s - {a}. x j = p"
     with s a show "card ?S = 1"
       using ksimplex_replace_1[of p "n + 1" s a j]
       by (subst eq_commute) simp }
 
   { assume "card ?S \<noteq> 2" "\<not> (\<exists>j\<in>{..n}. \<forall>x\<in>s - {a}. x j = p)"
     with s a show "\<exists>j\<in>{..n}. \<forall>x\<in>s - {a}. x j = 0"
       using ksimplex_replace_2[of p "n + 1" s a]
       by (subst (asm) eq_commute) auto }
 qed
 
 subsubsection \<open>Reduced labelling\<close>
 
 definition reduced :: "nat \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> nat" where "reduced n x = (LEAST k. k = n \<or> x k \<noteq> 0)"
 
 lemma reduced_labelling:
   shows "reduced n x \<le> n"
     and "\<forall>i<reduced n x. x i = 0"
     and "reduced n x = n \<or> x (reduced n x) \<noteq> 0"
 proof -
   show "reduced n x \<le> n"
     unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) auto
   show "\<forall>i<reduced n x. x i = 0"
     unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) fastforce+
   show "reduced n x = n \<or> x (reduced n x) \<noteq> 0"
     unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) fastforce+
 qed
 
 lemma reduced_labelling_unique:
   "r \<le> n \<Longrightarrow> \<forall>i<r. x i = 0 \<Longrightarrow> r = n \<or> x r \<noteq> 0 \<Longrightarrow> reduced n x = r"
  unfolding reduced_def by (rule LeastI2_wellorder[where a=n]) (metis le_less not_le)+
 
 lemma reduced_labelling_zero: "j < n \<Longrightarrow> x j = 0 \<Longrightarrow> reduced n x \<noteq> j"
   using reduced_labelling[of n x] by auto
 
 lemma reduce_labelling_zero[simp]: "reduced 0 x = 0"
   by (rule reduced_labelling_unique) auto
 
 lemma reduced_labelling_nonzero: "j < n \<Longrightarrow> x j \<noteq> 0 \<Longrightarrow> reduced n x \<le> j"
   using reduced_labelling[of n x] by (elim allE[where x=j]) auto
 
 lemma reduced_labelling_Suc: "reduced (Suc n) x \<noteq> Suc n \<Longrightarrow> reduced (Suc n) x = reduced n x"
   using reduced_labelling[of "Suc n" x]
   by (intro reduced_labelling_unique[symmetric]) auto
 
 lemma complete_face_top:
   assumes "\<forall>x\<in>f. \<forall>j\<le>n. x j = 0 \<longrightarrow> lab x j = 0"
     and "\<forall>x\<in>f. \<forall>j\<le>n. x j = p \<longrightarrow> lab x j = 1"
     and eq: "(reduced (Suc n) \<circ> lab) ` f = {..n}"
   shows "((\<exists>j\<le>n. \<forall>x\<in>f. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>f. x j = p)) \<longleftrightarrow> (\<forall>x\<in>f. x n = p)"
 proof (safe del: disjCI)
   fix x j assume j: "j \<le> n" "\<forall>x\<in>f. x j = 0"
   { fix x assume "x \<in> f" with assms j have "reduced (Suc n) (lab x) \<noteq> j"
       by (intro reduced_labelling_zero) auto }
   moreover have "j \<in> (reduced (Suc n) \<circ> lab) ` f"
     using j eq by auto
   ultimately show "x n = p"
     by force
 next
   fix x j assume j: "j \<le> n" "\<forall>x\<in>f. x j = p" and x: "x \<in> f"
   have "j = n"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     { fix x assume "x \<in> f"
       with assms j have "reduced (Suc n) (lab x) \<le> j"
         by (intro reduced_labelling_nonzero) auto
       then have "reduced (Suc n) (lab x) \<noteq> n"
         using \<open>j \<noteq> n\<close> \<open>j \<le> n\<close> by simp }
     moreover
     have "n \<in> (reduced (Suc n) \<circ> lab) ` f"
       using eq by auto
     ultimately show False
       by force
   qed
   moreover have "j \<in> (reduced (Suc n) \<circ> lab) ` f"
     using j eq by auto
   ultimately show "x n = p"
     using j x by auto
 qed auto
 
 text \<open>Hence we get just about the nice induction.\<close>
 
 lemma kuhn_induction:
   assumes "0 < p"
     and lab_0: "\<forall>x. \<forall>j\<le>n. (\<forall>j. x j \<le> p) \<and> x j = 0 \<longrightarrow> lab x j = 0"
     and lab_1: "\<forall>x. \<forall>j\<le>n. (\<forall>j. x j \<le> p) \<and> x j = p \<longrightarrow> lab x j = 1"
     and odd: "odd (card {s. ksimplex p n s \<and> (reduced n\<circ>lab) ` s = {..n}})"
   shows "odd (card {s. ksimplex p (Suc n) s \<and> (reduced (Suc n)\<circ>lab) ` s = {..Suc n}})"
 proof -
   let ?rl = "reduced (Suc n) \<circ> lab" and ?ext = "\<lambda>f v. \<exists>j\<le>n. \<forall>x\<in>f. x j = v"
   let ?ext = "\<lambda>s. (\<exists>j\<le>n. \<forall>x\<in>s. x j = 0) \<or> (\<exists>j\<le>n. \<forall>x\<in>s. x j = p)"
   have "\<forall>s. ksimplex p (Suc n) s \<longrightarrow> ?rl ` s \<subseteq> {..Suc n}"
     by (simp add: reduced_labelling subset_eq)
   moreover
   have "{s. ksimplex p n s \<and> (reduced n \<circ> lab) ` s = {..n}} =
         {f. \<exists>s a. ksimplex p (Suc n) s \<and> a \<in> s \<and> f = s - {a} \<and> ?rl ` f = {..n} \<and> ?ext f}"
   proof (intro set_eqI, safe del: disjCI equalityI disjE)
     fix s assume s: "ksimplex p n s" and rl: "(reduced n \<circ> lab) ` s = {..n}"
     from s obtain u b where "kuhn_simplex p n u b s" by (auto elim: ksimplex.cases)
     then interpret kuhn_simplex p n u b s .
     have all_eq_p: "\<forall>x\<in>s. x n = p"
       by (auto simp: out_eq_p)
     moreover
     { fix x assume "x \<in> s"
       with lab_1[rule_format, of n x] all_eq_p s_le_p[of x]
       have "?rl x \<le> n"
         by (auto intro!: reduced_labelling_nonzero)
       then have "?rl x = reduced n (lab x)"
         by (auto intro!: reduced_labelling_Suc) }
     then have "?rl ` s = {..n}"
       using rl by (simp cong: image_cong)
     moreover
     obtain t a where "ksimplex p (Suc n) t" "a \<in> t" "s = t - {a}"
       using s unfolding simplex_top_face[OF \<open>0 < p\<close> all_eq_p] by auto
     ultimately
     show "\<exists>t a. ksimplex p (Suc n) t \<and> a \<in> t \<and> s = t - {a} \<and> ?rl ` s = {..n} \<and> ?ext s"
       by auto
   next
     fix x s a assume s: "ksimplex p (Suc n) s" and rl: "?rl ` (s - {a}) = {.. n}"
       and a: "a \<in> s" and "?ext (s - {a})"
     from s obtain u b where "kuhn_simplex p (Suc n) u b s" by (auto elim: ksimplex.cases)
     then interpret kuhn_simplex p "Suc n" u b s .
     have all_eq_p: "\<forall>x\<in>s. x (Suc n) = p"
       by (auto simp: out_eq_p)
 
     { fix x assume "x \<in> s - {a}"
       then have "?rl x \<in> ?rl ` (s - {a})"
         by auto
       then have "?rl x \<le> n"
         unfolding rl by auto
       then have "?rl x = reduced n (lab x)"
         by (auto intro!: reduced_labelling_Suc) }
     then show rl': "(reduced n\<circ>lab) ` (s - {a}) = {..n}"
       unfolding rl[symmetric] by (intro image_cong) auto
 
     from \<open>?ext (s - {a})\<close>
     have all_eq_p: "\<forall>x\<in>s - {a}. x n = p"
     proof (elim disjE exE conjE)
       fix j assume "j \<le> n" "\<forall>x\<in>s - {a}. x j = 0"
       with lab_0[rule_format, of j] all_eq_p s_le_p
       have "\<And>x. x \<in> s - {a} \<Longrightarrow> reduced (Suc n) (lab x) \<noteq> j"
         by (intro reduced_labelling_zero) auto
       moreover have "j \<in> ?rl ` (s - {a})"
         using \<open>j \<le> n\<close> unfolding rl by auto
       ultimately show ?thesis
         by force
     next
       fix j assume "j \<le> n" and eq_p: "\<forall>x\<in>s - {a}. x j = p"
       show ?thesis
       proof cases
         assume "j = n" with eq_p show ?thesis by simp
       next
         assume "j \<noteq> n"
         { fix x assume x: "x \<in> s - {a}"
           have "reduced n (lab x) \<le> j"
           proof (rule reduced_labelling_nonzero)
             show "lab x j \<noteq> 0"
               using lab_1[rule_format, of j x] x s_le_p[of x] eq_p \<open>j \<le> n\<close> by auto
             show "j < n"
               using \<open>j \<le> n\<close> \<open>j \<noteq> n\<close> by simp
           qed
           then have "reduced n (lab x) \<noteq> n"
             using \<open>j \<le> n\<close> \<open>j \<noteq> n\<close> by simp }
         moreover have "n \<in> (reduced n\<circ>lab) ` (s - {a})"
           unfolding rl' by auto
         ultimately show ?thesis
           by force
       qed
     qed
     show "ksimplex p n (s - {a})"
       unfolding simplex_top_face[OF \<open>0 < p\<close> all_eq_p] using s a by auto
   qed
   ultimately show ?thesis
     using assms by (intro kuhn_simplex_lemma) auto
 qed
 
 text \<open>And so we get the final combinatorial result.\<close>
 
 lemma ksimplex_0: "ksimplex p 0 s \<longleftrightarrow> s = {(\<lambda>x. p)}"
 proof
   assume "ksimplex p 0 s" then show "s = {(\<lambda>x. p)}"
     by (blast dest: kuhn_simplex.ksimplex_0 elim: ksimplex.cases)
 next
   assume s: "s = {(\<lambda>x. p)}"
   show "ksimplex p 0 s"
   proof (intro ksimplex, unfold_locales)
     show "(\<lambda>_. p) \<in> {..<0::nat} \<rightarrow> {..<p}" by auto
     show "bij_betw id {..<0} {..<0}"
       by simp
   qed (auto simp: s)
 qed
 
 lemma kuhn_combinatorial:
   assumes "0 < p"
     and "\<forall>x j. (\<forall>j. x j \<le> p) \<and> j < n \<and> x j = 0 \<longrightarrow> lab x j = 0"
     and "\<forall>x j. (\<forall>j. x j \<le> p) \<and> j < n  \<and> x j = p \<longrightarrow> lab x j = 1"
   shows "odd (card {s. ksimplex p n s \<and> (reduced n\<circ>lab) ` s = {..n}})"
     (is "odd (card (?M n))")
   using assms
 proof (induct n)
   case 0 then show ?case
     by (simp add: ksimplex_0 cong: conj_cong)
 next
   case (Suc n)
   then have "odd (card (?M n))"
     by force
   with Suc show ?case
     using kuhn_induction[of p n] by (auto simp: comp_def)
 qed
 
 lemma kuhn_lemma:
   fixes n p :: nat
   assumes "0 < p"
     and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. label x i = (0::nat) \<or> label x i = 1)"
     and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = 0 \<longrightarrow> label x i = 0)"
     and "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = p \<longrightarrow> label x i = 1)"
   obtains q where "\<forall>i<n. q i < p"
     and "\<forall>i<n. \<exists>r s. (\<forall>j<n. q j \<le> r j \<and> r j \<le> q j + 1) \<and> (\<forall>j<n. q j \<le> s j \<and> s j \<le> q j + 1) \<and> label r i \<noteq> label s i"
 proof -
   let ?rl = "reduced n \<circ> label"
   let ?A = "{s. ksimplex p n s \<and> ?rl ` s = {..n}}"
   have "odd (card ?A)"
     using assms by (intro kuhn_combinatorial[of p n label]) auto
   then have "?A \<noteq> {}"
     by (rule odd_card_imp_not_empty)
   then obtain s b u where "kuhn_simplex p n b u s" and rl: "?rl ` s = {..n}"
     by (auto elim: ksimplex.cases)
   interpret kuhn_simplex p n b u s by fact
 
   show ?thesis
   proof (intro that[of b] allI impI)
     fix i
     assume "i < n"
     then show "b i < p"
       using base by auto
   next
     fix i
     assume "i < n"
     then have "i \<in> {.. n}" "Suc i \<in> {.. n}"
       by auto
     then obtain u v where u: "u \<in> s" "Suc i = ?rl u" and v: "v \<in> s" "i = ?rl v"
       unfolding rl[symmetric] by blast
 
     have "label u i \<noteq> label v i"
       using reduced_labelling [of n "label u"] reduced_labelling [of n "label v"]
         u(2)[symmetric] v(2)[symmetric] \<open>i < n\<close>
       by auto
     moreover
     have "b j \<le> u j" "u j \<le> b j + 1" "b j \<le> v j" "v j \<le> b j + 1" if "j < n" for j
       using that base_le[OF \<open>u\<in>s\<close>] le_Suc_base[OF \<open>u\<in>s\<close>] base_le[OF \<open>v\<in>s\<close>] le_Suc_base[OF \<open>v\<in>s\<close>]
       by auto
     ultimately show "\<exists>r s. (\<forall>j<n. b j \<le> r j \<and> r j \<le> b j + 1) \<and>
         (\<forall>j<n. b j \<le> s j \<and> s j \<le> b j + 1) \<and> label r i \<noteq> label s i"
       by blast
   qed
 qed
 
 subsubsection \<open>Main result for the unit cube\<close>
 
 lemma kuhn_labelling_lemma':
   assumes "(\<forall>x::nat\<Rightarrow>real. P x \<longrightarrow> P (f x))"
     and "\<forall>x. P x \<longrightarrow> (\<forall>i::nat. Q i \<longrightarrow> 0 \<le> x i \<and> x i \<le> 1)"
   shows "\<exists>l. (\<forall>x i. l x i \<le> (1::nat)) \<and>
              (\<forall>x i. P x \<and> Q i \<and> x i = 0 \<longrightarrow> l x i = 0) \<and>
              (\<forall>x i. P x \<and> Q i \<and> x i = 1 \<longrightarrow> l x i = 1) \<and>
              (\<forall>x i. P x \<and> Q i \<and> l x i = 0 \<longrightarrow> x i \<le> f x i) \<and>
              (\<forall>x i. P x \<and> Q i \<and> l x i = 1 \<longrightarrow> f x i \<le> x i)"
 proof -
   have and_forall_thm: "\<And>P Q. (\<forall>x. P x) \<and> (\<forall>x. Q x) \<longleftrightarrow> (\<forall>x. P x \<and> Q x)"
     by auto
   have *: "\<forall>x y::real. 0 \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1 \<longrightarrow> x \<noteq> 1 \<and> x \<le> y \<or> x \<noteq> 0 \<and> y \<le> x"
     by auto
   show ?thesis
     unfolding and_forall_thm
     apply (subst choice_iff[symmetric])+
     apply rule
     apply rule
   proof -
     fix x x'
     let ?R = "\<lambda>y::nat.
       (P x \<and> Q x' \<and> x x' = 0 \<longrightarrow> y = 0) \<and>
       (P x \<and> Q x' \<and> x x' = 1 \<longrightarrow> y = 1) \<and>
       (P x \<and> Q x' \<and> y = 0 \<longrightarrow> x x' \<le> (f x) x') \<and>
       (P x \<and> Q x' \<and> y = 1 \<longrightarrow> (f x) x' \<le> x x')"
     have "0 \<le> f x x' \<and> f x x' \<le> 1" if "P x" "Q x'"
       using assms(2)[rule_format,of "f x" x'] that
       apply (drule_tac assms(1)[rule_format])
       apply auto
       done
     then have "?R 0 \<or> ?R 1"
       by auto
     then show "\<exists>y\<le>1. ?R y"
       by auto
   qed
 qed
 
 subsection \<open>Brouwer's fixed point theorem\<close>
 
 text \<open>We start proving Brouwer's fixed point theorem for the unit cube = \<open>cbox 0 One\<close>.\<close>
 
 lemma brouwer_cube:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "continuous_on (cbox 0 One) f"
     and "f ` cbox 0 One \<subseteq> cbox 0 One"
   shows "\<exists>x\<in>cbox 0 One. f x = x"
 proof (rule ccontr)
   define n where "n = DIM('a)"
   have n: "1 \<le> n" "0 < n" "n \<noteq> 0"
-    unfolding n_def by (auto simp: Suc_le_eq DIM_positive)
+    unfolding n_def by (auto simp: Suc_le_eq)
   assume "\<not> ?thesis"
   then have *: "\<not> (\<exists>x\<in>cbox 0 One. f x - x = 0)"
     by auto
   obtain d where
       d: "d > 0" "\<And>x. x \<in> cbox 0 One \<Longrightarrow> d \<le> norm (f x - x)"
     apply (rule brouwer_compactness_lemma[OF compact_cbox _ *])
     apply (rule continuous_intros assms)+
     apply blast
     done
   have *: "\<forall>x. x \<in> cbox 0 One \<longrightarrow> f x \<in> cbox 0 One"
     "\<forall>x. x \<in> (cbox 0 One::'a set) \<longrightarrow> (\<forall>i\<in>Basis. True \<longrightarrow> 0 \<le> x \<bullet> i \<and> x \<bullet> i \<le> 1)"
     using assms(2)[unfolded image_subset_iff Ball_def]
     unfolding cbox_def
     by auto
   obtain label :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where label [rule_format]:
     "\<forall>x. \<forall>i\<in>Basis. label x i \<le> 1"
     "\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> x \<bullet> i = 0 \<longrightarrow> label x i = 0"
     "\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> x \<bullet> i = 1 \<longrightarrow> label x i = 1"
     "\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> label x i = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i"
     "\<forall>x. \<forall>i\<in>Basis. x \<in> cbox 0 One \<and> label x i = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i"
     using kuhn_labelling_lemma[OF *] by auto
   note label = this [rule_format]
   have lem1: "\<forall>x\<in>cbox 0 One. \<forall>y\<in>cbox 0 One. \<forall>i\<in>Basis. label x i \<noteq> label y i \<longrightarrow>
     \<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)"
   proof safe
     fix x y :: 'a
     assume x: "x \<in> cbox 0 One" and y: "y \<in> cbox 0 One"
     fix i
     assume i: "label x i \<noteq> label y i" "i \<in> Basis"
     have *: "\<And>x y fx fy :: real. x \<le> fx \<and> fy \<le> y \<or> fx \<le> x \<and> y \<le> fy \<Longrightarrow>
       \<bar>fx - x\<bar> \<le> \<bar>fy - fx\<bar> + \<bar>y - x\<bar>" by auto
     have "\<bar>(f x - x) \<bullet> i\<bar> \<le> \<bar>(f y - f x)\<bullet>i\<bar> + \<bar>(y - x)\<bullet>i\<bar>"
     proof (cases "label x i = 0")
       case True
       then have fxy: "\<not> f y \<bullet> i \<le> y \<bullet> i \<Longrightarrow> f x \<bullet> i \<le> x \<bullet> i"
         by (metis True i label(1) label(5) le_antisym less_one not_le_imp_less y)
       show ?thesis
       unfolding inner_simps         
       by (rule *) (auto simp: True i label x y fxy)
     next
       case False
       then show ?thesis
         using label [OF \<open>i \<in> Basis\<close>] i(1) x y
         apply (auto simp: inner_diff_left le_Suc_eq)
         by (metis "*")
     qed
     also have "\<dots> \<le> norm (f y - f x) + norm (y - x)"
       by (simp add: add_mono i(2) norm_bound_Basis_le)
     finally show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)"
       unfolding inner_simps .
   qed
   have "\<exists>e>0. \<forall>x\<in>cbox 0 One. \<forall>y\<in>cbox 0 One. \<forall>z\<in>cbox 0 One. \<forall>i\<in>Basis.
     norm (x - z) < e \<longrightarrow> norm (y - z) < e \<longrightarrow> label x i \<noteq> label y i \<longrightarrow>
       \<bar>(f(z) - z)\<bullet>i\<bar> < d / (real n)"
   proof -
     have d': "d / real n / 8 > 0"
-      using d(1) by (simp add: n_def DIM_positive)
+      using d(1) by (simp add: n_def)
     have *: "uniformly_continuous_on (cbox 0 One) f"
       by (rule compact_uniformly_continuous[OF assms(1) compact_cbox])
     obtain e where e:
         "e > 0"
         "\<And>x x'. x \<in> cbox 0 One \<Longrightarrow>
           x' \<in> cbox 0 One \<Longrightarrow>
           norm (x' - x) < e \<Longrightarrow>
           norm (f x' - f x) < d / real n / 8"
       using *[unfolded uniformly_continuous_on_def,rule_format,OF d']
       unfolding dist_norm
       by blast
     show ?thesis
     proof (intro exI conjI ballI impI)
       show "0 < min (e / 2) (d / real n / 8)"
         using d' e by auto
       fix x y z i
       assume as:
         "x \<in> cbox 0 One" "y \<in> cbox 0 One" "z \<in> cbox 0 One"
         "norm (x - z) < min (e / 2) (d / real n / 8)"
         "norm (y - z) < min (e / 2) (d / real n / 8)"
         "label x i \<noteq> label y i"
       assume i: "i \<in> Basis"
       have *: "\<And>z fz x fx n1 n2 n3 n4 d4 d :: real. \<bar>fx - x\<bar> \<le> n1 + n2 \<Longrightarrow>
         \<bar>fx - fz\<bar> \<le> n3 \<Longrightarrow> \<bar>x - z\<bar> \<le> n4 \<Longrightarrow>
         n1 < d4 \<Longrightarrow> n2 < 2 * d4 \<Longrightarrow> n3 < d4 \<Longrightarrow> n4 < d4 \<Longrightarrow>
         (8 * d4 = d) \<Longrightarrow> \<bar>fz - z\<bar> < d"
         by auto
       show "\<bar>(f z - z) \<bullet> i\<bar> < d / real n"
         unfolding inner_simps
       proof (rule *)
         show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y -f x) + norm (y - x)"
           using as(1) as(2) as(6) i lem1 by blast
         show "norm (f x - f z) < d / real n / 8"
           using d' e as by auto
         show "\<bar>f x \<bullet> i - f z \<bullet> i\<bar> \<le> norm (f x - f z)" "\<bar>x \<bullet> i - z \<bullet> i\<bar> \<le> norm (x - z)"
           unfolding inner_diff_left[symmetric]
           by (rule Basis_le_norm[OF i])+
         have tria: "norm (y - x) \<le> norm (y - z) + norm (x - z)"
           using dist_triangle[of y x z, unfolded dist_norm]
           unfolding norm_minus_commute
           by auto
         also have "\<dots> < e / 2 + e / 2"
           using as(4) as(5) by auto
         finally show "norm (f y - f x) < d / real n / 8"
           using as(1) as(2) e(2) by auto
         have "norm (y - z) + norm (x - z) < d / real n / 8 + d / real n / 8"
           using as(4) as(5) by auto
         with tria show "norm (y - x) < 2 * (d / real n / 8)"
           by auto
       qed (use as in auto)
     qed
   qed
   then
   obtain e where e:
     "e > 0"
     "\<And>x y z i. x \<in> cbox 0 One \<Longrightarrow>
       y \<in> cbox 0 One \<Longrightarrow>
       z \<in> cbox 0 One \<Longrightarrow>
       i \<in> Basis \<Longrightarrow>
       norm (x - z) < e \<and> norm (y - z) < e \<and> label x i \<noteq> label y i \<Longrightarrow>
       \<bar>(f z - z) \<bullet> i\<bar> < d / real n"
     by blast
   obtain p :: nat where p: "1 + real n / e \<le> real p"
     using real_arch_simple ..
   have "1 + real n / e > 0"
     using e(1) n by (simp add: add_pos_pos)
   then have "p > 0"
     using p by auto
 
   obtain b :: "nat \<Rightarrow> 'a" where b: "bij_betw b {..< n} Basis"
     by atomize_elim (auto simp: n_def intro!: finite_same_card_bij)
   define b' where "b' = inv_into {..< n} b"
   then have b': "bij_betw b' Basis {..< n}"
     using bij_betw_inv_into[OF b] by auto
   then have b'_Basis: "\<And>i. i \<in> Basis \<Longrightarrow> b' i \<in> {..< n}"
     unfolding bij_betw_def by (auto simp: set_eq_iff)
   have bb'[simp]:"\<And>i. i \<in> Basis \<Longrightarrow> b (b' i) = i"
     unfolding b'_def
     using b
     by (auto simp: f_inv_into_f bij_betw_def)
   have b'b[simp]:"\<And>i. i < n \<Longrightarrow> b' (b i) = i"
     unfolding b'_def
     using b
     by (auto simp: inv_into_f_eq bij_betw_def)
   have *: "\<And>x :: nat. x = 0 \<or> x = 1 \<longleftrightarrow> x \<le> 1"
     by auto
   have b'': "\<And>j. j < n \<Longrightarrow> b j \<in> Basis"
     using b unfolding bij_betw_def by auto
   have q1: "0 < p" "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow>
     (\<forall>i<n. (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0 \<or>
            (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)"
     unfolding *
     using \<open>p > 0\<close> \<open>n > 0\<close>
     using label(1)[OF b'']
     by auto
   { fix x :: "nat \<Rightarrow> nat" and i assume "\<forall>i<n. x i \<le> p" "i < n" "x i = p \<or> x i = 0"
     then have "(\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<in> (cbox 0 One::'a set)"
       using b'_Basis
-      by (auto simp: cbox_def inner_simps bij_betw_def zero_le_divide_iff divide_le_eq_1) }
+      by (auto simp: cbox_def bij_betw_def zero_le_divide_iff divide_le_eq_1) }
   note cube = this
   have q2: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = 0 \<longrightarrow>
       (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0)"
     unfolding o_def using cube \<open>p > 0\<close> by (intro allI impI label(2)) (auto simp: b'')
   have q3: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = p \<longrightarrow>
       (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)"
     using cube \<open>p > 0\<close> unfolding o_def by (intro allI impI label(3)) (auto simp: b'')
   obtain q where q:
       "\<forall>i<n. q i < p"
       "\<forall>i<n.
          \<exists>r s. (\<forall>j<n. q j \<le> r j \<and> r j \<le> q j + 1) \<and>
                (\<forall>j<n. q j \<le> s j \<and> s j \<le> q j + 1) \<and>
                (label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) i \<noteq>
                (label (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i) \<circ> b) i"
     by (rule kuhn_lemma[OF q1 q2 q3])
   define z :: 'a where "z = (\<Sum>i\<in>Basis. (real (q (b' i)) / real p) *\<^sub>R i)"
   have "\<exists>i\<in>Basis. d / real n \<le> \<bar>(f z - z)\<bullet>i\<bar>"
   proof (rule ccontr)
     have "\<forall>i\<in>Basis. q (b' i) \<in> {0..p}"
       using q(1) b'
       by (auto intro: less_imp_le simp: bij_betw_def)
     then have "z \<in> cbox 0 One"
       unfolding z_def cbox_def
       using b'_Basis
       by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
     then have d_fz_z: "d \<le> norm (f z - z)"
       by (rule d)
     assume "\<not> ?thesis"
     then have as: "\<forall>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar> < d / real n"
       using \<open>n > 0\<close>
       by (auto simp: not_le inner_diff)
     have "norm (f z - z) \<le> (\<Sum>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar>)"
       unfolding inner_diff_left[symmetric]
       by (rule norm_le_l1)
     also have "\<dots> < (\<Sum>(i::'a) \<in> Basis. d / real n)"
       by (meson as finite_Basis nonempty_Basis sum_strict_mono)
     also have "\<dots> = d"
       using DIM_positive[where 'a='a] by (auto simp: n_def)
     finally show False
       using d_fz_z by auto
   qed
   then obtain i where i: "i \<in> Basis" "d / real n \<le> \<bar>(f z - z) \<bullet> i\<bar>" ..
   have *: "b' i < n"
     using i and b'[unfolded bij_betw_def]
     by auto
   obtain r s where rs:
     "\<And>j. j < n \<Longrightarrow> q j \<le> r j \<and> r j \<le> q j + 1"
     "\<And>j. j < n \<Longrightarrow> q j \<le> s j \<and> s j \<le> q j + 1"
     "(label (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i) \<noteq>
       (label (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i) \<circ> b) (b' i)"
     using q(2)[rule_format,OF *] by blast
   have b'_im: "\<And>i. i \<in> Basis \<Longrightarrow>  b' i < n"
     using b' unfolding bij_betw_def by auto
   define r' ::'a where "r' = (\<Sum>i\<in>Basis. (real (r (b' i)) / real p) *\<^sub>R i)"
   have "\<And>i. i \<in> Basis \<Longrightarrow> r (b' i) \<le> p"
     apply (rule order_trans)
     apply (rule rs(1)[OF b'_im,THEN conjunct2])
     using q(1)[rule_format,OF b'_im]
     apply (auto simp: Suc_le_eq)
     done
   then have "r' \<in> cbox 0 One"
     unfolding r'_def cbox_def
     using b'_Basis
     by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
   define s' :: 'a where "s' = (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i)"
   have "\<And>i. i \<in> Basis \<Longrightarrow> s (b' i) \<le> p"
     using b'_im q(1) rs(2) by fastforce
   then have "s' \<in> cbox 0 One"
     unfolding s'_def cbox_def
     using b'_Basis by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
   have "z \<in> cbox 0 One"
     unfolding z_def cbox_def
     using b'_Basis q(1)[rule_format,OF b'_im] \<open>p > 0\<close>
     by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1 less_imp_le)
   {
     have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)"
       by (rule sum_mono) (use rs(1)[OF b'_im] in force)
     also have "\<dots> < e * real p"
       using p \<open>e > 0\<close> \<open>p > 0\<close>
       by (auto simp: field_simps n_def)
     finally have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) < e * real p" .
   }
   moreover
   {
     have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)"
       by (rule sum_mono) (use rs(2)[OF b'_im] in force)
     also have "\<dots> < e * real p"
       using p \<open>e > 0\<close> \<open>p > 0\<close>
       by (auto simp: field_simps n_def)
     finally have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) < e * real p" .
   }
   ultimately
   have "norm (r' - z) < e" and "norm (s' - z) < e"
     unfolding r'_def s'_def z_def
     using \<open>p > 0\<close>
     apply (rule_tac[!] le_less_trans[OF norm_le_l1])
     apply (auto simp: field_simps sum_divide_distrib[symmetric] inner_diff_left)
     done
   then have "\<bar>(f z - z) \<bullet> i\<bar> < d / real n"
     using rs(3) i
     unfolding r'_def[symmetric] s'_def[symmetric] o_def bb'
     by (intro e(2)[OF \<open>r'\<in>cbox 0 One\<close> \<open>s'\<in>cbox 0 One\<close> \<open>z\<in>cbox 0 One\<close>]) auto
   then show False
     using i by auto
 qed
 
 text \<open>Next step is to prove it for nonempty interiors.\<close>
 
 lemma brouwer_weak:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "compact S"
     and "convex S"
     and "interior S \<noteq> {}"
     and "continuous_on S f"
     and "f ` S \<subseteq> S"
   obtains x where "x \<in> S" and "f x = x"
 proof -
   let ?U = "cbox 0 One :: 'a set"
   have "\<Sum>Basis /\<^sub>R 2 \<in> interior ?U"
   proof (rule interiorI)
     let ?I = "(\<Inter>i\<in>Basis. {x::'a. 0 < x \<bullet> i} \<inter> {x. x \<bullet> i < 1})"
     show "open ?I"
-      by (intro open_INT finite_Basis ballI open_Int, auto intro: open_Collect_less simp: continuous_on_inner continuous_on_const continuous_on_id)
+      by (intro open_INT finite_Basis ballI open_Int, auto intro: open_Collect_less simp: continuous_on_inner)
     show "\<Sum>Basis /\<^sub>R 2 \<in> ?I"
       by simp
     show "?I \<subseteq> cbox 0 One"
       unfolding cbox_def by force
   qed
   then have *: "interior ?U \<noteq> {}" by fast
   have *: "?U homeomorphic S"
     using homeomorphic_convex_compact[OF convex_box(1) compact_cbox * assms(2,1,3)] .
   have "\<forall>f. continuous_on ?U f \<and> f ` ?U \<subseteq> ?U \<longrightarrow>
     (\<exists>x\<in>?U. f x = x)"
     using brouwer_cube by auto
   then show ?thesis
     unfolding homeomorphic_fixpoint_property[OF *]
     using assms
     by (auto intro: that)
 qed
 
 text \<open>Then the particular case for closed balls.\<close>
 
 lemma brouwer_ball:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "e > 0"
     and "continuous_on (cball a e) f"
     and "f ` cball a e \<subseteq> cball a e"
   obtains x where "x \<in> cball a e" and "f x = x"
   using brouwer_weak[OF compact_cball convex_cball, of a e f]
   unfolding interior_cball ball_eq_empty
   using assms by auto
 
 text \<open>And finally we prove Brouwer's fixed point theorem in its general version.\<close>
 
 theorem brouwer:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes S: "compact S" "convex S" "S \<noteq> {}"
     and contf: "continuous_on S f"
     and fim: "f ` S \<subseteq> S"
   obtains x where "x \<in> S" and "f x = x"
 proof -
   have "\<exists>e>0. S \<subseteq> cball 0 e"
     using compact_imp_bounded[OF \<open>compact S\<close>]  unfolding bounded_pos
     by auto
   then obtain e where e: "e > 0" "S \<subseteq> cball 0 e"
     by blast
   have "\<exists>x\<in> cball 0 e. (f \<circ> closest_point S) x = x"
   proof (rule_tac brouwer_ball[OF e(1)])
     show "continuous_on (cball 0 e) (f \<circ> closest_point S)"
       apply (rule continuous_on_compose)
       using S compact_eq_bounded_closed continuous_on_closest_point apply blast
       by (meson S contf closest_point_in_set compact_imp_closed continuous_on_subset image_subsetI)
     show "(f \<circ> closest_point S) ` cball 0 e \<subseteq> cball 0 e"
       by clarsimp (metis S fim closest_point_exists(1) compact_eq_bounded_closed e(2) image_subset_iff mem_cball_0 subsetCE)
   qed (use assms in auto)
   then obtain x where x: "x \<in> cball 0 e" "(f \<circ> closest_point S) x = x" ..
   have "x \<in> S"
     by (metis closest_point_in_set comp_apply compact_imp_closed fim image_eqI S(1) S(3) subset_iff x(2))
   then have *: "closest_point S x = x"
     by (rule closest_point_self)
   show thesis
   proof
     show "closest_point S x \<in> S"
       by (simp add: "*" \<open>x \<in> S\<close>)
     show "f (closest_point S x) = closest_point S x"
       using "*" x(2) by auto
   qed
 qed
 
 subsection \<open>Applications\<close>
 
 text \<open>So we get the no-retraction theorem.\<close>
 
 corollary no_retraction_cball:
   fixes a :: "'a::euclidean_space"
   assumes "e > 0"
   shows "\<not> (frontier (cball a e) retract_of (cball a e))"
 proof
   assume *: "frontier (cball a e) retract_of (cball a e)"
   have **: "\<And>xa. a - (2 *\<^sub>R a - xa) = - (a - xa)"
     using scaleR_left_distrib[of 1 1 a] by auto
   obtain x where x: "x \<in> {x. norm (a - x) = e}" "2 *\<^sub>R a - x = x"
   proof (rule retract_fixpoint_property[OF *, of "\<lambda>x. scaleR 2 a - x"])
     show "continuous_on (frontier (cball a e)) ((-) (2 *\<^sub>R a))"
       by (intro continuous_intros)
     show "(-) (2 *\<^sub>R a) ` frontier (cball a e) \<subseteq> frontier (cball a e)"
       by clarsimp (metis "**" dist_norm norm_minus_cancel)
   qed (auto simp: dist_norm intro: brouwer_ball[OF assms])
   then have "scaleR 2 a = scaleR 1 x + scaleR 1 x"
     by (auto simp: algebra_simps)
   then have "a = x"
     unfolding scaleR_left_distrib[symmetric]
     by auto
   then show False
     using x assms by auto
 qed
 
 corollary contractible_sphere:
   fixes a :: "'a::euclidean_space"
   shows "contractible(sphere a r) \<longleftrightarrow> r \<le> 0"
 proof (cases "0 < r")
   case True
   then show ?thesis
     unfolding contractible_def nullhomotopic_from_sphere_extension
     using no_retraction_cball [OF True, of a]
     by (auto simp: retract_of_def retraction_def)
 next
   case False
   then show ?thesis
     unfolding contractible_def nullhomotopic_from_sphere_extension
-    using continuous_on_const less_eq_real_def by auto
+    using less_eq_real_def by auto
 qed
 
 corollary connected_sphere_eq:
   fixes a :: "'a :: euclidean_space"
   shows "connected(sphere a r) \<longleftrightarrow> 2 \<le> DIM('a) \<or> r \<le> 0"
     (is "?lhs = ?rhs")
 proof (cases r "0::real" rule: linorder_cases)
   case less
   then show ?thesis by auto
 next
   case equal
   then show ?thesis by auto
 next
   case greater
   show ?thesis
   proof
     assume L: ?lhs
     have "False" if 1: "DIM('a) = 1"
     proof -
       obtain x y where xy: "sphere a r = {x,y}" "x \<noteq> y"
         using sphere_1D_doubleton [OF 1 greater]
         by (metis dist_self greater insertI1 less_add_same_cancel1 mem_sphere mult_2 not_le zero_le_dist)
       then have "finite (sphere a r)"
         by auto
       with L \<open>r > 0\<close> xy show "False"
         using connected_finite_iff_sing by auto
     qed
     with greater show ?rhs
       by (metis DIM_ge_Suc0 One_nat_def Suc_1 le_antisym not_less_eq_eq)
   next
     assume ?rhs
     then show ?lhs
       using connected_sphere greater by auto
   qed
 qed
 
 corollary path_connected_sphere_eq:
   fixes a :: "'a :: euclidean_space"
   shows "path_connected(sphere a r) \<longleftrightarrow> 2 \<le> DIM('a) \<or> r \<le> 0"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     using connected_sphere_eq path_connected_imp_connected by blast
 next
   assume R: ?rhs
   then show ?lhs
     by (auto simp: contractible_imp_path_connected contractible_sphere path_connected_sphere)
 qed
 
 proposition frontier_subset_retraction:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S" and fros: "frontier S \<subseteq> T"
       and contf: "continuous_on (closure S) f"
       and fim: "f ` S \<subseteq> T"
       and fid: "\<And>x. x \<in> T \<Longrightarrow> f x = x"
     shows "S \<subseteq> T"
 proof (rule ccontr)
   assume "\<not> S \<subseteq> T"
   then obtain a where "a \<in> S" "a \<notin> T" by blast
   define g where "g \<equiv> \<lambda>z. if z \<in> closure S then f z else z"
   have "continuous_on (closure S \<union> closure(-S)) g"
     unfolding g_def
     apply (rule continuous_on_cases)
-    using fros fid frontier_closures
-        apply (auto simp: contf continuous_on_id)
-    done
+    using fros fid frontier_closures by (auto simp: contf)
   moreover have "closure S \<union> closure(- S) = UNIV"
     using closure_Un by fastforce
   ultimately have contg: "continuous_on UNIV g" by metis
   obtain B where "0 < B" and B: "closure S \<subseteq> ball a B"
     using \<open>bounded S\<close> bounded_subset_ballD by blast
   have notga: "g x \<noteq> a" for x
     unfolding g_def using fros fim \<open>a \<notin> T\<close>
     apply (auto simp: frontier_def)
     using fid interior_subset apply fastforce
     by (simp add: \<open>a \<in> S\<close> closure_def)
   define h where "h \<equiv> (\<lambda>y. a + (B / norm(y - a)) *\<^sub>R (y - a)) \<circ> g"
   have "\<not> (frontier (cball a B) retract_of (cball a B))"
     by (metis no_retraction_cball \<open>0 < B\<close>)
   then have "\<And>k. \<not> retraction (cball a B) (frontier (cball a B)) k"
     by (simp add: retract_of_def)
   moreover have "retraction (cball a B) (frontier (cball a B)) h"
     unfolding retraction_def
   proof (intro conjI ballI)
     show "frontier (cball a B) \<subseteq> cball a B"
       by force
     show "continuous_on (cball a B) h"
       unfolding h_def
       by (intro continuous_intros) (use contg continuous_on_subset notga in auto)
     show "h ` cball a B \<subseteq> frontier (cball a B)"
       using \<open>0 < B\<close> by (auto simp: h_def notga dist_norm)
     show "\<And>x. x \<in> frontier (cball a B) \<Longrightarrow> h x = x"
       apply (auto simp: h_def algebra_simps)
       apply (simp add: vector_add_divide_simps  notga)
       by (metis (no_types, hide_lams) B add.commute dist_commute  dist_norm g_def mem_ball not_less_iff_gr_or_eq  subset_eq)
   qed
   ultimately show False by simp
 qed
 
 subsubsection \<open>Punctured affine hulls, etc\<close>
 
 lemma rel_frontier_deformation_retract_of_punctured_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "convex T" "bounded S"
       and arelS: "a \<in> rel_interior S"
       and relS: "rel_frontier S \<subseteq> T"
       and affS: "T \<subseteq> affine hull S"
   obtains r where "homotopic_with_canon (\<lambda>x. True) (T - {a}) (T - {a}) id r"
                   "retraction (T - {a}) (rel_frontier S) r"
 proof -
   have "\<exists>d. 0 < d \<and> (a + d *\<^sub>R l) \<in> rel_frontier S \<and>
             (\<forall>e. 0 \<le> e \<and> e < d \<longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S)"
        if "(a + l) \<in> affine hull S" "l \<noteq> 0" for l
     apply (rule ray_to_rel_frontier [OF \<open>bounded S\<close> arelS])
     apply (rule that)+
     by metis
   then obtain dd
     where dd1: "\<And>l. \<lbrakk>(a + l) \<in> affine hull S; l \<noteq> 0\<rbrakk> \<Longrightarrow> 0 < dd l \<and> (a + dd l *\<^sub>R l) \<in> rel_frontier S"
       and dd2: "\<And>l e. \<lbrakk>(a + l) \<in> affine hull S; e < dd l; 0 \<le> e; l \<noteq> 0\<rbrakk>
                       \<Longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S"
     by metis+
   have aaffS: "a \<in> affine hull S"
     by (meson arelS subsetD hull_inc rel_interior_subset)
   have "((\<lambda>z. z - a) ` (affine hull S - {a})) = ((\<lambda>z. z - a) ` (affine hull S)) - {0}"
     by auto
   moreover have "continuous_on (((\<lambda>z. z - a) ` (affine hull S)) - {0}) (\<lambda>x. dd x *\<^sub>R x)"
   proof (rule continuous_on_compact_surface_projection)
     show "compact (rel_frontier ((\<lambda>z. z - a) ` S))"
       by (simp add: \<open>bounded S\<close> bounded_translation_minus compact_rel_frontier_bounded)
     have releq: "rel_frontier ((\<lambda>z. z - a) ` S) = (\<lambda>z. z - a) ` rel_frontier S"
       using rel_frontier_translation [of "-a"] add.commute by simp
     also have "\<dots> \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}"
       using rel_frontier_affine_hull arelS rel_frontier_def by fastforce
     finally show "rel_frontier ((\<lambda>z. z - a) ` S) \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}" .
     show "cone ((\<lambda>z. z - a) ` (affine hull S))"
       by (rule subspace_imp_cone)
          (use aaffS in \<open>simp add: subspace_affine image_comp o_def affine_translation_aux [of a]\<close>)
     show "(0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)) \<longleftrightarrow> (dd x = k)"
          if x: "x \<in> (\<lambda>z. z - a) ` (affine hull S) - {0}" for k x
     proof
       show "dd x = k \<Longrightarrow> 0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)"
       using dd1 [of x] that image_iff by (fastforce simp add: releq)
     next
       assume k: "0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)"
       have False if "dd x < k"
       proof -
         have "k \<noteq> 0" "a + k *\<^sub>R x \<in> closure S"
           using k closure_translation [of "-a"]
           by (auto simp: rel_frontier_def cong: image_cong_simp)
         then have segsub: "open_segment a (a + k *\<^sub>R x) \<subseteq> rel_interior S"
           by (metis rel_interior_closure_convex_segment [OF \<open>convex S\<close> arelS])
         have "x \<noteq> 0" and xaffS: "a + x \<in> affine hull S"
           using x by auto
         then have "0 < dd x" and inS: "a + dd x *\<^sub>R x \<in> rel_frontier S"
           using dd1 by auto
         moreover have "a + dd x *\<^sub>R x \<in> open_segment a (a + k *\<^sub>R x)"
           using k \<open>x \<noteq> 0\<close> \<open>0 < dd x\<close>
           apply (simp add: in_segment)
           apply (rule_tac x = "dd x / k" in exI)
           apply (simp add: field_simps that)
           apply (simp add: vector_add_divide_simps algebra_simps)
           done
         ultimately show ?thesis
           using segsub by (auto simp: rel_frontier_def)
       qed
       moreover have False if "k < dd x"
         using x k that rel_frontier_def
         by (fastforce simp: algebra_simps releq dest!: dd2)
       ultimately show "dd x = k"
         by fastforce
     qed
   qed
   ultimately have *: "continuous_on ((\<lambda>z. z - a) ` (affine hull S - {a})) (\<lambda>x. dd x *\<^sub>R x)"
     by auto
   have "continuous_on (affine hull S - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))"
     by (intro * continuous_intros continuous_on_compose)
   with affS have contdd: "continuous_on (T - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))"
     by (blast intro: continuous_on_subset)
   show ?thesis
   proof
     show "homotopic_with_canon (\<lambda>x. True) (T - {a}) (T - {a}) id (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))"
     proof (rule homotopic_with_linear)
       show "continuous_on (T - {a}) id"
         by (intro continuous_intros continuous_on_compose)
       show "continuous_on (T - {a}) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))"
         using contdd by (simp add: o_def)
       show "closed_segment (id x) (a + dd (x - a) *\<^sub>R (x - a)) \<subseteq> T - {a}"
            if "x \<in> T - {a}" for x
       proof (clarsimp simp: in_segment, intro conjI)
         fix u::real assume u: "0 \<le> u" "u \<le> 1"
         have "a + dd (x - a) *\<^sub>R (x - a) \<in> T"
           by (metis DiffD1 DiffD2 add.commute add.right_neutral affS dd1 diff_add_cancel relS singletonI subsetCE that)
         then show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<in> T"
           using convexD [OF \<open>convex T\<close>] that u by simp
         have iff: "(1 - u) *\<^sub>R x + u *\<^sub>R (a + d *\<^sub>R (x - a)) = a \<longleftrightarrow>
                   (1 - u + u * d) *\<^sub>R (x - a) = 0" for d
           by (auto simp: algebra_simps)
         have "x \<in> T" "x \<noteq> a" using that by auto
         then have axa: "a + (x - a) \<in> affine hull S"
            by (metis (no_types) add.commute affS diff_add_cancel rev_subsetD)
         then have "\<not> dd (x - a) \<le> 0 \<and> a + dd (x - a) *\<^sub>R (x - a) \<in> rel_frontier S"
           using \<open>x \<noteq> a\<close> dd1 by fastforce
         with \<open>x \<noteq> a\<close> show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<noteq> a"
           apply (auto simp: iff)
           using less_eq_real_def mult_le_0_iff not_less u by fastforce
       qed
     qed
     show "retraction (T - {a}) (rel_frontier S) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))"
     proof (simp add: retraction_def, intro conjI ballI)
       show "rel_frontier S \<subseteq> T - {a}"
         using arelS relS rel_frontier_def by fastforce
       show "continuous_on (T - {a}) (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))"
         using contdd by (simp add: o_def)
       show "(\<lambda>x. a + dd (x - a) *\<^sub>R (x - a)) ` (T - {a}) \<subseteq> rel_frontier S"
         apply (auto simp: rel_frontier_def)
         apply (metis Diff_subset add.commute affS dd1 diff_add_cancel eq_iff_diff_eq_0 rel_frontier_def subset_iff)
         by (metis DiffE add.commute affS dd1 diff_add_cancel eq_iff_diff_eq_0 rel_frontier_def rev_subsetD)
       show "a + dd (x - a) *\<^sub>R (x - a) = x" if x: "x \<in> rel_frontier S" for x
       proof -
         have "x \<noteq> a"
           using that arelS by (auto simp: rel_frontier_def)
         have False if "dd (x - a) < 1"
         proof -
           have "x \<in> closure S"
             using x by (auto simp: rel_frontier_def)
           then have segsub: "open_segment a x \<subseteq> rel_interior S"
             by (metis rel_interior_closure_convex_segment [OF \<open>convex S\<close> arelS])
           have  xaffS: "x \<in> affine hull S"
             using affS relS x by auto
           then have "0 < dd (x - a)" and inS: "a + dd (x - a) *\<^sub>R (x - a) \<in> rel_frontier S"
             using dd1 by (auto simp: \<open>x \<noteq> a\<close>)
           moreover have "a + dd (x - a) *\<^sub>R (x - a) \<in> open_segment a x"
             using  \<open>x \<noteq> a\<close> \<open>0 < dd (x - a)\<close>
             apply (simp add: in_segment)
             apply (rule_tac x = "dd (x - a)" in exI)
             apply (simp add: algebra_simps that)
             done
           ultimately show ?thesis
             using segsub by (auto simp: rel_frontier_def)
         qed
         moreover have False if "1 < dd (x - a)"
           using x that dd2 [of "x - a" 1] \<open>x \<noteq> a\<close> closure_affine_hull
           by (auto simp: rel_frontier_def)
         ultimately have "dd (x - a) = 1" \<comment> \<open>similar to another proof above\<close>
           by fastforce
         with that show ?thesis
           by (simp add: rel_frontier_def)
       qed
     qed
   qed
 qed
 
 corollary rel_frontier_retract_of_punctured_affine_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S" "convex S" "a \<in> rel_interior S"
     shows "rel_frontier S retract_of (affine hull S - {a})"
 apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S "affine hull S" a])
 apply (auto simp: affine_imp_convex rel_frontier_affine_hull retract_of_def assms)
 done
 
 corollary rel_boundary_retract_of_punctured_affine_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "convex S" "a \<in> rel_interior S"
     shows "(S - rel_interior S) retract_of (affine hull S - {a})"
 by (metis assms closure_closed compact_eq_bounded_closed rel_frontier_def
           rel_frontier_retract_of_punctured_affine_hull)
 
 lemma homotopy_eqv_rel_frontier_punctured_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "bounded S" "a \<in> rel_interior S" "convex T" "rel_frontier S \<subseteq> T" "T \<subseteq> affine hull S"
   shows "(rel_frontier S) homotopy_eqv (T - {a})"
   apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S T])
   using assms
   apply auto
   using deformation_retract_imp_homotopy_eqv homotopy_equivalent_space_sym by blast
 
 lemma homotopy_eqv_rel_frontier_punctured_affine_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "bounded S" "a \<in> rel_interior S"
     shows "(rel_frontier S) homotopy_eqv (affine hull S - {a})"
 apply (rule homotopy_eqv_rel_frontier_punctured_convex)
   using assms rel_frontier_affine_hull  by force+
 
 lemma path_connected_sphere_gen:
   assumes "convex S" "bounded S" "aff_dim S \<noteq> 1"
   shows "path_connected(rel_frontier S)"
 proof (cases "rel_interior S = {}")
   case True
   then show ?thesis
     by (simp add: \<open>convex S\<close> convex_imp_path_connected rel_frontier_def)
 next
   case False
   then show ?thesis
     by (metis aff_dim_affine_hull affine_affine_hull affine_imp_convex all_not_in_conv assms path_connected_punctured_convex rel_frontier_retract_of_punctured_affine_hull retract_of_path_connected)
 qed
 
 lemma connected_sphere_gen:
   assumes "convex S" "bounded S" "aff_dim S \<noteq> 1"
   shows "connected(rel_frontier S)"
   by (simp add: assms path_connected_imp_connected path_connected_sphere_gen)
 
 subsubsection\<open>Borsuk-style characterization of separation\<close>
 
 lemma continuous_on_Borsuk_map:
    "a \<notin> s \<Longrightarrow>  continuous_on s (\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a))"
 by (rule continuous_intros | force)+
 
 lemma Borsuk_map_into_sphere:
    "(\<lambda>x. inverse(norm (x - a)) *\<^sub>R (x - a)) ` s \<subseteq> sphere 0 1 \<longleftrightarrow> (a \<notin> s)"
   by auto (metis eq_iff_diff_eq_0 left_inverse norm_eq_zero)
 
 lemma Borsuk_maps_homotopic_in_path_component:
   assumes "path_component (- s) a b"
     shows "homotopic_with_canon (\<lambda>x. True) s (sphere 0 1)
                    (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a))
                    (\<lambda>x. inverse(norm(x - b)) *\<^sub>R (x - b))"
 proof -
   obtain g where "path g" "path_image g \<subseteq> -s" "pathstart g = a" "pathfinish g = b"
     using assms by (auto simp: path_component_def)
   then show ?thesis
     apply (simp add: path_def path_image_def pathstart_def pathfinish_def homotopic_with_def)
     apply (rule_tac x = "\<lambda>z. inverse(norm(snd z - (g \<circ> fst)z)) *\<^sub>R (snd z - (g \<circ> fst)z)" in exI)
     apply (intro conjI continuous_intros)
     apply (rule continuous_intros | erule continuous_on_subset | fastforce simp: divide_simps sphere_def)+
     done
 qed
 
 lemma non_extensible_Borsuk_map:
   fixes a :: "'a :: euclidean_space"
   assumes "compact s" and cin: "c \<in> components(- s)" and boc: "bounded c" and "a \<in> c"
     shows "\<not> (\<exists>g. continuous_on (s \<union> c) g \<and>
                   g ` (s \<union> c) \<subseteq> sphere 0 1 \<and>
                   (\<forall>x \<in> s. g x = inverse(norm(x - a)) *\<^sub>R (x - a)))"
 proof -
   have "closed s" using assms by (simp add: compact_imp_closed)
   have "c \<subseteq> -s"
     using assms by (simp add: in_components_subset)
   with \<open>a \<in> c\<close> have "a \<notin> s" by blast
   then have ceq: "c = connected_component_set (- s) a"
     by (metis \<open>a \<in> c\<close> cin components_iff connected_component_eq)
   then have "bounded (s \<union> connected_component_set (- s) a)"
     using \<open>compact s\<close> boc compact_imp_bounded by auto
   with bounded_subset_ballD obtain r where "0 < r" and r: "(s \<union> connected_component_set (- s) a) \<subseteq> ball a r"
     by blast
   { fix g
     assume "continuous_on (s \<union> c) g"
             "g ` (s \<union> c) \<subseteq> sphere 0 1"
        and [simp]: "\<And>x. x \<in> s \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
     then have [simp]: "\<And>x. x \<in> s \<union> c \<Longrightarrow> norm (g x) = 1"
       by force
     have cb_eq: "cball a r = (s \<union> connected_component_set (- s) a) \<union>
                       (cball a r - connected_component_set (- s) a)"
       using ball_subset_cball [of a r] r by auto
     have cont1: "continuous_on (s \<union> connected_component_set (- s) a)
                      (\<lambda>x. a + r *\<^sub>R g x)"
       apply (rule continuous_intros)+
       using \<open>continuous_on (s \<union> c) g\<close> ceq by blast
     have cont2: "continuous_on (cball a r - connected_component_set (- s) a)
             (\<lambda>x. a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))"
       by (rule continuous_intros | force simp: \<open>a \<notin> s\<close>)+
     have 1: "continuous_on (cball a r)
              (\<lambda>x. if connected_component (- s) a x
                   then a + r *\<^sub>R g x
                   else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))"
       apply (subst cb_eq)
       apply (rule continuous_on_cases [OF _ _ cont1 cont2])
         using ceq cin
       apply (auto intro: closed_Un_complement_component
                   simp: \<open>closed s\<close> open_Compl open_connected_component)
       done
     have 2: "(\<lambda>x. a + r *\<^sub>R g x) ` (cball a r \<inter> connected_component_set (- s) a)
              \<subseteq> sphere a r "
       using \<open>0 < r\<close> by (force simp: dist_norm ceq)
     have "retraction (cball a r) (sphere a r)
             (\<lambda>x. if x \<in> connected_component_set (- s) a
                  then a + r *\<^sub>R g x
                  else a + r *\<^sub>R ((x - a) /\<^sub>R norm (x - a)))"
       using  \<open>0 < r\<close>
       apply (simp add: retraction_def dist_norm 1 2, safe)
       apply (force simp: dist_norm abs_if mult_less_0_iff divide_simps \<open>a \<notin> s\<close>)
       using r
       by (auto simp: dist_norm norm_minus_commute)
     then have False
       using no_retraction_cball
              [OF \<open>0 < r\<close>, of a, unfolded retract_of_def, simplified, rule_format,
               of "\<lambda>x. if x \<in> connected_component_set (- s) a
                       then a + r *\<^sub>R g x
                       else a + r *\<^sub>R inverse(norm(x - a)) *\<^sub>R (x - a)"]
       by blast
   }
   then show ?thesis
     by blast
 qed
 
 subsubsection \<open>Proving surjectivity via Brouwer fixpoint theorem\<close>
 
 lemma brouwer_surjective:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "compact T"
     and "convex T"
     and "T \<noteq> {}"
     and "continuous_on T f"
     and "\<And>x y. \<lbrakk>x\<in>S; y\<in>T\<rbrakk> \<Longrightarrow> x + (y - f y) \<in> T"
     and "x \<in> S"
   shows "\<exists>y\<in>T. f y = x"
 proof -
   have *: "\<And>x y. f y = x \<longleftrightarrow> x + (y - f y) = y"
     by (auto simp add: algebra_simps)
   show ?thesis
     unfolding *
     apply (rule brouwer[OF assms(1-3), of "\<lambda>y. x + (y - f y)"])
     apply (intro continuous_intros)
     using assms
     apply auto
     done
 qed
 
 lemma brouwer_surjective_cball:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "continuous_on (cball a e) f"
     and "e > 0"
     and "x \<in> S"
     and "\<And>x y. \<lbrakk>x\<in>S; y\<in>cball a e\<rbrakk> \<Longrightarrow> x + (y - f y) \<in> cball a e"
   shows "\<exists>y\<in>cball a e. f y = x"
   apply (rule brouwer_surjective)
   apply (rule compact_cball convex_cball)+
   unfolding cball_eq_empty
   using assms
   apply auto
   done
 
 subsubsection \<open>Inverse function theorem\<close>
 
 text \<open>See Sussmann: "Multidifferential calculus", Theorem 2.1.1\<close>
 
 lemma sussmann_open_mapping:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "open S"
     and contf: "continuous_on S f"
     and "x \<in> S"
     and derf: "(f has_derivative f') (at x)"
     and "bounded_linear g'" "f' \<circ> g' = id"
     and "T \<subseteq> S"
     and x: "x \<in> interior T"
   shows "f x \<in> interior (f ` T)"
 proof -
   interpret f': bounded_linear f'
     using assms unfolding has_derivative_def by auto
   interpret g': bounded_linear g'
     using assms by auto
   obtain B where B: "0 < B" "\<forall>x. norm (g' x) \<le> norm x * B"
     using bounded_linear.pos_bounded[OF assms(5)] by blast
   hence *: "1 / (2 * B) > 0" by auto
   obtain e0 where e0:
       "0 < e0"
       "\<forall>y. norm (y - x) < e0 \<longrightarrow> norm (f y - f x - f' (y - x)) \<le> 1 / (2 * B) * norm (y - x)"
     using derf unfolding has_derivative_at_alt
     using * by blast
   obtain e1 where e1: "0 < e1" "cball x e1 \<subseteq> T"
     using mem_interior_cball x by blast
   have *: "0 < e0 / B" "0 < e1 / B" using e0 e1 B by auto
   obtain e where e: "0 < e" "e < e0 / B" "e < e1 / B"
     using field_lbound_gt_zero[OF *] by blast
   have lem: "\<exists>y\<in>cball (f x) e. f (x + g' (y - f x)) = z" if "z\<in>cball (f x) (e / 2)" for z
   proof (rule brouwer_surjective_cball)
     have z: "z \<in> S" if as: "y \<in>cball (f x) e" "z = x + (g' y - g' (f x))" for y z
     proof-
       have "dist x z = norm (g' (f x) - g' y)"
         unfolding as(2) and dist_norm by auto
       also have "\<dots> \<le> norm (f x - y) * B"
         by (metis B(2) g'.diff)
       also have "\<dots> \<le> e * B"
         by (metis B(1) dist_norm mem_cball real_mult_le_cancel_iff1 that(1))
       also have "\<dots> \<le> e1"
         using B(1) e(3) pos_less_divide_eq by fastforce
       finally have "z \<in> cball x e1"
         by force
       then show "z \<in> S"
         using e1 assms(7) by auto
     qed
     show "continuous_on (cball (f x) e) (\<lambda>y. f (x + g' (y - f x)))"
       unfolding g'.diff
     proof (rule continuous_on_compose2 [OF _ _ order_refl, of _ _ f])
       show "continuous_on ((\<lambda>y. x + (g' y - g' (f x))) ` cball (f x) e) f"
         by (rule continuous_on_subset[OF contf]) (use z in blast)
       show "continuous_on (cball (f x) e) (\<lambda>y. x + (g' y - g' (f x)))"
         by (intro continuous_intros linear_continuous_on[OF \<open>bounded_linear g'\<close>])
     qed
   next
     fix y z
     assume y: "y \<in> cball (f x) (e / 2)" and z: "z \<in> cball (f x) e"
     have "norm (g' (z - f x)) \<le> norm (z - f x) * B"
       using B by auto
     also have "\<dots> \<le> e * B"
       by (metis B(1) z dist_norm mem_cball norm_minus_commute real_mult_le_cancel_iff1)
     also have "\<dots> < e0"
       using B(1) e(2) pos_less_divide_eq by blast
     finally have *: "norm (x + g' (z - f x) - x) < e0"
       by auto
     have **: "f x + f' (x + g' (z - f x) - x) = z"
       using assms(6)[unfolded o_def id_def,THEN cong]
       by auto
     have "norm (f x - (y + (z - f (x + g' (z - f x))))) \<le>
           norm (f (x + g' (z - f x)) - z) + norm (f x - y)"
       using norm_triangle_ineq[of "f (x + g'(z - f x)) - z" "f x - y"]
       by (auto simp add: algebra_simps)
     also have "\<dots> \<le> 1 / (B * 2) * norm (g' (z - f x)) + norm (f x - y)"
       using e0(2)[rule_format, OF *]
       by (simp only: algebra_simps **) auto
     also have "\<dots> \<le> 1 / (B * 2) * norm (g' (z - f x)) + e/2"
       using y by (auto simp: dist_norm)
     also have "\<dots> \<le> 1 / (B * 2) * B * norm (z - f x) + e/2"
       using * B by (auto simp add: field_simps)
     also have "\<dots> \<le> 1 / 2 * norm (z - f x) + e/2"
       by auto
     also have "\<dots> \<le> e/2 + e/2"
       using B(1) \<open>norm (z - f x) * B \<le> e * B\<close> by auto
     finally show "y + (z - f (x + g' (z - f x))) \<in> cball (f x) e"
       by (auto simp: dist_norm)
   qed (use e that in auto) 
   show ?thesis
     unfolding mem_interior
   proof (intro exI conjI subsetI)
     fix y
     assume "y \<in> ball (f x) (e / 2)"
     then have *: "y \<in> cball (f x) (e / 2)"
       by auto
     obtain z where z: "z \<in> cball (f x) e" "f (x + g' (z - f x)) = y"
       using lem * by blast
     then have "norm (g' (z - f x)) \<le> norm (z - f x) * B"
       using B
       by (auto simp add: field_simps)
     also have "\<dots> \<le> e * B"
       by (metis B(1) dist_norm mem_cball norm_minus_commute real_mult_le_cancel_iff1 z(1))
     also have "\<dots> \<le> e1"
       using e B unfolding less_divide_eq by auto
     finally have "x + g'(z - f x) \<in> T"
       by (metis add_diff_cancel diff_diff_add dist_norm e1(2) mem_cball norm_minus_commute subset_eq)
     then show "y \<in> f ` T"
       using z by auto
   qed (use e in auto)
 qed
 
 text \<open>Hence the following eccentric variant of the inverse function theorem.
   This has no continuity assumptions, but we do need the inverse function.
   We could put \<open>f' \<circ> g = I\<close> but this happens to fit with the minimal linear
   algebra theory I've set up so far.\<close>
 
 lemma has_derivative_inverse_strong:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "open S"
     and "x \<in> S"
     and contf: "continuous_on S f"
     and gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and derf: "(f has_derivative f') (at x)"
     and id: "f' \<circ> g' = id"
   shows "(g has_derivative g') (at (f x))"
 proof -
   have linf: "bounded_linear f'"
     using derf unfolding has_derivative_def by auto
   then have ling: "bounded_linear g'"
     unfolding linear_conv_bounded_linear[symmetric]
     using id right_inverse_linear by blast
   moreover have "g' \<circ> f' = id"
     using id linf ling
     unfolding linear_conv_bounded_linear[symmetric]
     using linear_inverse_left
     by auto
   moreover have *: "\<And>T. \<lbrakk>T \<subseteq> S; x \<in> interior T\<rbrakk> \<Longrightarrow> f x \<in> interior (f ` T)"
     apply (rule sussmann_open_mapping)
     apply (rule assms ling)+
     apply auto
     done
   have "continuous (at (f x)) g"
     unfolding continuous_at Lim_at
   proof (rule, rule)
     fix e :: real
     assume "e > 0"
     then have "f x \<in> interior (f ` (ball x e \<inter> S))"
       using *[rule_format,of "ball x e \<inter> S"] \<open>x \<in> S\<close>
       by (auto simp add: interior_open[OF open_ball] interior_open[OF assms(1)])
     then obtain d where d: "0 < d" "ball (f x) d \<subseteq> f ` (ball x e \<inter> S)"
       unfolding mem_interior by blast
     show "\<exists>d>0. \<forall>y. 0 < dist y (f x) \<and> dist y (f x) < d \<longrightarrow> dist (g y) (g (f x)) < e"
     proof (intro exI allI impI conjI)
       fix y
       assume "0 < dist y (f x) \<and> dist y (f x) < d"
       then have "g y \<in> g ` f ` (ball x e \<inter> S)"
         by (metis d(2) dist_commute mem_ball rev_image_eqI subset_iff)
       then show "dist (g y) (g (f x)) < e"
         using gf[OF \<open>x \<in> S\<close>]
         by (simp add: assms(4) dist_commute image_iff)
     qed (use d in auto)
   qed
   moreover have "f x \<in> interior (f ` S)"
     apply (rule sussmann_open_mapping)
     apply (rule assms ling)+
     using interior_open[OF assms(1)] and \<open>x \<in> S\<close>
     apply auto
     done
   moreover have "f (g y) = y" if "y \<in> interior (f ` S)" for y
     by (metis gf imageE interiorE subsetD that)
   ultimately show ?thesis using assms
     by (metis has_derivative_inverse_basic_x open_interior)
 qed
 
 text \<open>A rewrite based on the other domain.\<close>
 
 lemma has_derivative_inverse_strong_x:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "open S"
     and "g y \<in> S"
     and "continuous_on S f"
     and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and "(f has_derivative f') (at (g y))"
     and "f' \<circ> g' = id"
     and "f (g y) = y"
   shows "(g has_derivative g') (at y)"
   using has_derivative_inverse_strong[OF assms(1-6)]
   unfolding assms(7)
   by simp
 
 text \<open>On a region.\<close>
 
 theorem has_derivative_inverse_on:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "open S"
     and derf: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f'(x)) (at x)"
     and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and "f' x \<circ> g' x = id"
     and "x \<in> S"
   shows "(g has_derivative g'(x)) (at (f x))"
 proof (rule has_derivative_inverse_strong[where g'="g' x" and f=f])
   show "continuous_on S f"
   unfolding continuous_on_eq_continuous_at[OF \<open>open S\<close>]
   using derf has_derivative_continuous by blast
 qed (use assms in auto)
 
 
 end
diff --git a/src/HOL/Analysis/Cartesian_Euclidean_Space.thy b/src/HOL/Analysis/Cartesian_Euclidean_Space.thy
--- a/src/HOL/Analysis/Cartesian_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Cartesian_Euclidean_Space.thy
@@ -1,552 +1,552 @@
 (* Title:      HOL/Analysis/Cartesian_Euclidean_Space.thy
    Some material by Jose Divasón, Tim Makarios and L C Paulson
 *)
 
 section \<open>Finite Cartesian Products of Euclidean Spaces\<close>
 
 theory Cartesian_Euclidean_Space
 imports Convex_Euclidean_Space Derivative
 begin
 
 lemma subspace_special_hyperplane: "subspace {x. x $ k = 0}"
   by (simp add: subspace_def)
 
 lemma sum_mult_product:
   "sum h {..<A * B :: nat} = (\<Sum>i\<in>{..<A}. \<Sum>j\<in>{..<B}. h (j + i * B))"
   unfolding sum.nat_group[of h B A, unfolded atLeast0LessThan, symmetric]
 proof (rule sum.cong, simp, rule sum.reindex_cong)
   fix i
   show "inj_on (\<lambda>j. j + i * B) {..<B}" by (auto intro!: inj_onI)
   show "{i * B..<i * B + B} = (\<lambda>j. j + i * B) ` {..<B}"
   proof safe
     fix j assume "j \<in> {i * B..<i * B + B}"
     then show "j \<in> (\<lambda>j. j + i * B) ` {..<B}"
       by (auto intro!: image_eqI[of _ _ "j - i * B"])
   qed simp
 qed simp
 
 lemma interval_cbox_cart: "{a::real^'n..b} = cbox a b"
   by (auto simp add: less_eq_vec_def mem_box Basis_vec_def inner_axis)
 
 lemma differentiable_vec:
   fixes S :: "'a::euclidean_space set"
   shows "vec differentiable_on S"
   by (simp add: linear_linear bounded_linear_imp_differentiable_on)
 
 lemma continuous_vec [continuous_intros]:
   fixes x :: "'a::euclidean_space"
   shows "isCont vec x"
   apply (clarsimp simp add: continuous_def LIM_def dist_vec_def L2_set_def)
   apply (rule_tac x="r / sqrt (real CARD('b))" in exI)
   by (simp add: mult.commute pos_less_divide_eq real_sqrt_mult)
 
 lemma box_vec_eq_empty [simp]:
   shows "cbox (vec a) (vec b) = {} \<longleftrightarrow> cbox a b = {}"
         "box (vec a) (vec b) = {} \<longleftrightarrow> box a b = {}"
   by (auto simp: Basis_vec_def mem_box box_eq_empty inner_axis)
 
 subsection\<open>Closures and interiors of halfspaces\<close>
 
 lemma interior_halfspace_component_le [simp]:
      "interior {x. x$k \<le> a} = {x :: (real^'n). x$k < a}" (is "?LE")
   and interior_halfspace_component_ge [simp]:
      "interior {x. x$k \<ge> a} = {x :: (real^'n). x$k > a}" (is "?GE")
 proof -
   have "axis k (1::real) \<noteq> 0"
     by (simp add: axis_def vec_eq_iff)
   moreover have "axis k (1::real) \<bullet> x = x$k" for x
     by (simp add: cart_eq_inner_axis inner_commute)
   ultimately show ?LE ?GE
     using interior_halfspace_le [of "axis k (1::real)" a]
           interior_halfspace_ge [of "axis k (1::real)" a] by auto
 qed
 
 lemma closure_halfspace_component_lt [simp]:
      "closure {x. x$k < a} = {x :: (real^'n). x$k \<le> a}" (is "?LE")
   and closure_halfspace_component_gt [simp]:
      "closure {x. x$k > a} = {x :: (real^'n). x$k \<ge> a}" (is "?GE")
 proof -
   have "axis k (1::real) \<noteq> 0"
     by (simp add: axis_def vec_eq_iff)
   moreover have "axis k (1::real) \<bullet> x = x$k" for x
     by (simp add: cart_eq_inner_axis inner_commute)
   ultimately show ?LE ?GE
     using closure_halfspace_lt [of "axis k (1::real)" a]
           closure_halfspace_gt [of "axis k (1::real)" a] by auto
 qed
 
 lemma interior_standard_hyperplane:
    "interior {x :: (real^'n). x$k = a} = {}"
 proof -
   have "axis k (1::real) \<noteq> 0"
     by (simp add: axis_def vec_eq_iff)
   moreover have "axis k (1::real) \<bullet> x = x$k" for x
     by (simp add: cart_eq_inner_axis inner_commute)
   ultimately show ?thesis
     using interior_hyperplane [of "axis k (1::real)" a]
     by force
 qed
 
 lemma matrix_vector_mul_bounded_linear[intro, simp]: "bounded_linear ((*v) A)" for A :: "'a::{euclidean_space,real_algebra_1}^'n^'m"
   using matrix_vector_mul_linear[of A]
   by (simp add: linear_conv_bounded_linear linear_matrix_vector_mul_eq)
 
 lemma
   fixes A :: "'a::{euclidean_space,real_algebra_1}^'n^'m"
   shows matrix_vector_mult_linear_continuous_at [continuous_intros]: "isCont ((*v) A) z"
     and matrix_vector_mult_linear_continuous_on [continuous_intros]: "continuous_on S ((*v) A)"
   by (simp_all add: linear_continuous_at linear_continuous_on)
 
 
 subsection\<open>Bounds on components etc.\ relative to operator norm\<close>
 
 lemma norm_column_le_onorm:
   fixes A :: "real^'n^'m"
   shows "norm(column i A) \<le> onorm((*v) A)"
 proof -
   have "norm (\<chi> j. A $ j $ i) \<le> norm (A *v axis i 1)"
     by (simp add: matrix_mult_dot cart_eq_inner_axis)
   also have "\<dots> \<le> onorm ((*v) A)"
     using onorm [OF matrix_vector_mul_bounded_linear, of A "axis i 1"] by auto
   finally have "norm (\<chi> j. A $ j $ i) \<le> onorm ((*v) A)" .
   then show ?thesis
     unfolding column_def .
 qed
 
 lemma matrix_component_le_onorm:
   fixes A :: "real^'n^'m"
   shows "\<bar>A $ i $ j\<bar> \<le> onorm((*v) A)"
 proof -
   have "\<bar>A $ i $ j\<bar> \<le> norm (\<chi> n. (A $ n $ j))"
     by (metis (full_types, lifting) component_le_norm_cart vec_lambda_beta)
   also have "\<dots> \<le> onorm ((*v) A)"
     by (metis (no_types) column_def norm_column_le_onorm)
   finally show ?thesis .
 qed
 
 lemma component_le_onorm:
   fixes f :: "real^'m \<Rightarrow> real^'n"
   shows "linear f \<Longrightarrow> \<bar>matrix f $ i $ j\<bar> \<le> onorm f"
-  by (metis linear_matrix_vector_mul_eq matrix_component_le_onorm matrix_vector_mul)
+  by (metis matrix_component_le_onorm matrix_vector_mul(2))
 
 lemma onorm_le_matrix_component_sum:
   fixes A :: "real^'n^'m"
   shows "onorm((*v) A) \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar>)"
 proof (rule onorm_le)
   fix x
   have "norm (A *v x) \<le> (\<Sum>i\<in>UNIV. \<bar>(A *v x) $ i\<bar>)"
     by (rule norm_le_l1_cart)
   also have "\<dots> \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar> * norm x)"
   proof (rule sum_mono)
     fix i
     have "\<bar>(A *v x) $ i\<bar> \<le> \<bar>\<Sum>j\<in>UNIV. A $ i $ j * x $ j\<bar>"
       by (simp add: matrix_vector_mult_def)
     also have "\<dots> \<le> (\<Sum>j\<in>UNIV. \<bar>A $ i $ j * x $ j\<bar>)"
       by (rule sum_abs)
     also have "\<dots> \<le> (\<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar> * norm x)"
       by (rule sum_mono) (simp add: abs_mult component_le_norm_cart mult_left_mono)
     finally show "\<bar>(A *v x) $ i\<bar> \<le> (\<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar> * norm x)" .
   qed
   finally show "norm (A *v x) \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar>) * norm x"
     by (simp add: sum_distrib_right)
 qed
 
 lemma onorm_le_matrix_component:
   fixes A :: "real^'n^'m"
   assumes "\<And>i j. abs(A$i$j) \<le> B"
   shows "onorm((*v) A) \<le> real (CARD('m)) * real (CARD('n)) * B"
 proof (rule onorm_le)
   fix x :: "real^'n::_"
   have "norm (A *v x) \<le> (\<Sum>i\<in>UNIV. \<bar>(A *v x) $ i\<bar>)"
     by (rule norm_le_l1_cart)
   also have "\<dots> \<le> (\<Sum>i::'m \<in>UNIV. real (CARD('n)) * B * norm x)"
   proof (rule sum_mono)
     fix i
     have "\<bar>(A *v x) $ i\<bar> \<le> norm(A $ i) * norm x"
       by (simp add: matrix_mult_dot Cauchy_Schwarz_ineq2)
     also have "\<dots> \<le> (\<Sum>j\<in>UNIV. \<bar>A $ i $ j\<bar>) * norm x"
       by (simp add: mult_right_mono norm_le_l1_cart)
     also have "\<dots> \<le> real (CARD('n)) * B * norm x"
       by (simp add: assms sum_bounded_above mult_right_mono)
     finally show "\<bar>(A *v x) $ i\<bar> \<le> real (CARD('n)) * B * norm x" .
   qed
   also have "\<dots> \<le> CARD('m) * real (CARD('n)) * B * norm x"
     by simp
   finally show "norm (A *v x) \<le> CARD('m) * real (CARD('n)) * B * norm x" .
 qed
 
 
 lemma rational_approximation:
   assumes "e > 0"
   obtains r::real where "r \<in> \<rat>" "\<bar>r - x\<bar> < e"
   using Rats_dense_in_real [of "x - e/2" "x + e/2"] assms by auto
 
 proposition matrix_rational_approximation:
   fixes A :: "real^'n^'m"
   assumes "e > 0"
   obtains B where "\<And>i j. B$i$j \<in> \<rat>" "onorm(\<lambda>x. (A - B) *v x) < e"
 proof -
   have "\<forall>i j. \<exists>q \<in> \<rat>. \<bar>q - A $ i $ j\<bar> < e / (2 * CARD('m) * CARD('n))"
     using assms by (force intro: rational_approximation [of "e / (2 * CARD('m) * CARD('n))"])
   then obtain B where B: "\<And>i j. B$i$j \<in> \<rat>" and Bclo: "\<And>i j. \<bar>B$i$j - A $ i $ j\<bar> < e / (2 * CARD('m) * CARD('n))"
     by (auto simp: lambda_skolem Bex_def)
   show ?thesis
   proof
     have "onorm ((*v) (A - B)) \<le> real CARD('m) * real CARD('n) *
     (e / (2 * real CARD('m) * real CARD('n)))"
       apply (rule onorm_le_matrix_component)
       using Bclo by (simp add: abs_minus_commute less_imp_le)
     also have "\<dots> < e"
       using \<open>0 < e\<close> by (simp add: field_split_simps)
     finally show "onorm ((*v) (A - B)) < e" .
   qed (use B in auto)
 qed
 
 lemma vector_sub_project_orthogonal_cart: "(b::real^'n) \<bullet> (x - ((b \<bullet> x) / (b \<bullet> b)) *s b) = 0"
   unfolding inner_simps scalar_mult_eq_scaleR by auto
 
 lemma infnorm_cart:"infnorm (x::real^'n) = Sup {\<bar>x$i\<bar> |i. i\<in>UNIV}"
   by (simp add: infnorm_def inner_axis Basis_vec_def) (metis (lifting) inner_axis real_inner_1_right)
 
 lemma component_le_infnorm_cart: "\<bar>x$i\<bar> \<le> infnorm (x::real^'n)"
   using Basis_le_infnorm[of "axis i 1" x]
   by (simp add: Basis_vec_def axis_eq_axis inner_axis)
 
 lemma continuous_component[continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. f x $ i)"
   unfolding continuous_def by (rule tendsto_vec_nth)
 
 lemma continuous_on_component[continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. f x $ i)"
   unfolding continuous_on_def by (fast intro: tendsto_vec_nth)
 
 lemma continuous_on_vec_lambda[continuous_intros]:
   "(\<And>i. continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<chi> i. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_vec_lambda)
 
 lemma closed_positive_orthant: "closed {x::real^'n. \<forall>i. 0 \<le>x$i}"
-  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_const continuous_on_id continuous_on_component)
+  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_component)
 
 lemma bounded_component_cart: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
   unfolding bounded_def
   apply clarify
   apply (rule_tac x="x $ i" in exI)
   apply (rule_tac x="e" in exI)
   apply clarify
   apply (rule order_trans [OF dist_vec_nth_le], simp)
   done
 
 lemma compact_lemma_cart:
   fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n"
   assumes f: "bounded (range f)"
   shows "\<exists>l r. strict_mono r \<and>
         (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
     (is "?th d")
 proof -
   have "\<forall>d' \<subseteq> d. ?th d'"
     by (rule compact_lemma_general[where unproj=vec_lambda])
-      (auto intro!: f bounded_component_cart simp: vec_lambda_eta)
+      (auto intro!: f bounded_component_cart)
   then show "?th d" by simp
 qed
 
 instance vec :: (heine_borel, finite) heine_borel
 proof
   fix f :: "nat \<Rightarrow> 'a ^ 'b"
   assume f: "bounded (range f)"
   then obtain l r where r: "strict_mono r"
       and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
     using compact_lemma_cart [OF f] by blast
   let ?d = "UNIV::'b set"
   { fix e::real assume "e>0"
     hence "0 < e / (real_of_nat (card ?d))"
       using zero_less_card_finite divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
     with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
       by simp
     moreover
     { fix n
       assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
       have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
         unfolding dist_vec_def using zero_le_dist by (rule L2_set_le_sum)
       also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
         by (rule sum_strict_mono) (simp_all add: n)
       finally have "dist (f (r n)) l < e" by simp
     }
     ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
       by (rule eventually_mono)
   }
   hence "((f \<circ> r) \<longlongrightarrow> l) sequentially" unfolding o_def tendsto_iff by simp
   with r show "\<exists>l r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially" by auto
 qed
 
 lemma interval_cart:
   fixes a :: "real^'n"
   shows "box a b = {x::real^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}"
     and "cbox a b = {x::real^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
   by (auto simp add: set_eq_iff less_vec_def less_eq_vec_def mem_box Basis_vec_def inner_axis)
 
 lemma mem_box_cart:
   fixes a :: "real^'n"
   shows "x \<in> box a b \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
     and "x \<in> cbox a b \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
   using interval_cart[of a b] by (auto simp add: set_eq_iff less_vec_def less_eq_vec_def)
 
 lemma interval_eq_empty_cart:
   fixes a :: "real^'n"
   shows "(box a b = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1)
     and "(cbox a b = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
 proof -
   { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>box a b"
     hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_box_cart by auto
     hence "a$i < b$i" by auto
     hence False using as by auto }
   moreover
   { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
     let ?x = "(1/2) *\<^sub>R (a + b)"
     { fix i
       have "a$i < b$i" using as[THEN spec[where x=i]] by auto
       hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
         unfolding vector_smult_component and vector_add_component
         by auto }
     hence "box a b \<noteq> {}" using mem_box_cart(1)[of "?x" a b] by auto }
   ultimately show ?th1 by blast
 
   { fix i x assume as:"b$i < a$i" and x:"x\<in>cbox a b"
     hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_box_cart by auto
     hence "a$i \<le> b$i" by auto
     hence False using as by auto }
   moreover
   { assume as:"\<forall>i. \<not> (b$i < a$i)"
     let ?x = "(1/2) *\<^sub>R (a + b)"
     { fix i
       have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
       hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
         unfolding vector_smult_component and vector_add_component
         by auto }
     hence "cbox a b \<noteq> {}" using mem_box_cart(2)[of "?x" a b] by auto  }
   ultimately show ?th2 by blast
 qed
 
 lemma interval_ne_empty_cart:
   fixes a :: "real^'n"
   shows "cbox a b \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)"
     and "box a b \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
   unfolding interval_eq_empty_cart[of a b] by (auto simp add: not_less not_le)
     (* BH: Why doesn't just "auto" work here? *)
 
 lemma subset_interval_imp_cart:
   fixes a :: "real^'n"
   shows "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> cbox c d \<subseteq> cbox a b"
     and "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> cbox c d \<subseteq> box a b"
     and "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> box c d \<subseteq> cbox a b"
     and "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> box c d \<subseteq> box a b"
   unfolding subset_eq[unfolded Ball_def] unfolding mem_box_cart
   by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
 
 lemma interval_sing:
   fixes a :: "'a::linorder^'n"
   shows "{a .. a} = {a} \<and> {a<..<a} = {}"
   apply (auto simp add: set_eq_iff less_vec_def less_eq_vec_def vec_eq_iff)
   done
 
 lemma subset_interval_cart:
   fixes a :: "real^'n"
   shows "cbox c d \<subseteq> cbox a b \<longleftrightarrow> (\<forall>i. c$i \<le> d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th1)
     and "cbox c d \<subseteq> box a b \<longleftrightarrow> (\<forall>i. c$i \<le> d$i) --> (\<forall>i. a$i < c$i \<and> d$i < b$i)" (is ?th2)
     and "box c d \<subseteq> cbox a b \<longleftrightarrow> (\<forall>i. c$i < d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th3)
     and "box c d \<subseteq> box a b \<longleftrightarrow> (\<forall>i. c$i < d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th4)
   using subset_box[of c d a b] by (simp_all add: Basis_vec_def inner_axis)
 
 lemma disjoint_interval_cart:
   fixes a::"real^'n"
   shows "cbox a b \<inter> cbox c d = {} \<longleftrightarrow> (\<exists>i. (b$i < a$i \<or> d$i < c$i \<or> b$i < c$i \<or> d$i < a$i))" (is ?th1)
     and "cbox a b \<inter> box c d = {} \<longleftrightarrow> (\<exists>i. (b$i < a$i \<or> d$i \<le> c$i \<or> b$i \<le> c$i \<or> d$i \<le> a$i))" (is ?th2)
     and "box a b \<inter> cbox c d = {} \<longleftrightarrow> (\<exists>i. (b$i \<le> a$i \<or> d$i < c$i \<or> b$i \<le> c$i \<or> d$i \<le> a$i))" (is ?th3)
     and "box a b \<inter> box c d = {} \<longleftrightarrow> (\<exists>i. (b$i \<le> a$i \<or> d$i \<le> c$i \<or> b$i \<le> c$i \<or> d$i \<le> a$i))" (is ?th4)
   using disjoint_interval[of a b c d] by (simp_all add: Basis_vec_def inner_axis)
 
 lemma Int_interval_cart:
   fixes a :: "real^'n"
   shows "cbox a b \<inter> cbox c d =  {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
   unfolding Int_interval
   by (auto simp: mem_box less_eq_vec_def)
     (auto simp: Basis_vec_def inner_axis)
 
 lemma closed_interval_left_cart:
   fixes b :: "real^'n"
   shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
-  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_const continuous_on_id continuous_on_component)
+  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_component)
 
 lemma closed_interval_right_cart:
   fixes a::"real^'n"
   shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
-  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_const continuous_on_id continuous_on_component)
+  by (simp add: Collect_all_eq closed_INT closed_Collect_le continuous_on_component)
 
 lemma is_interval_cart:
   "is_interval (s::(real^'n) set) \<longleftrightarrow>
     (\<forall>a\<in>s. \<forall>b\<in>s. \<forall>x. (\<forall>i. ((a$i \<le> x$i \<and> x$i \<le> b$i) \<or> (b$i \<le> x$i \<and> x$i \<le> a$i))) \<longrightarrow> x \<in> s)"
   by (simp add: is_interval_def Ball_def Basis_vec_def inner_axis imp_ex)
 
 lemma closed_halfspace_component_le_cart: "closed {x::real^'n. x$i \<le> a}"
   by (simp add: closed_Collect_le continuous_on_component)
 
 lemma closed_halfspace_component_ge_cart: "closed {x::real^'n. x$i \<ge> a}"
   by (simp add: closed_Collect_le continuous_on_component)
 
 lemma open_halfspace_component_lt_cart: "open {x::real^'n. x$i < a}"
   by (simp add: open_Collect_less continuous_on_component)
 
 lemma open_halfspace_component_gt_cart: "open {x::real^'n. x$i  > a}"
   by (simp add: open_Collect_less continuous_on_component)
 
 lemma Lim_component_le_cart:
   fixes f :: "'a \<Rightarrow> real^'n"
   assumes "(f \<longlongrightarrow> l) net" "\<not> (trivial_limit net)"  "eventually (\<lambda>x. f x $i \<le> b) net"
   shows "l$i \<le> b"
   by (rule tendsto_le[OF assms(2) tendsto_const tendsto_vec_nth, OF assms(1, 3)])
 
 lemma Lim_component_ge_cart:
   fixes f :: "'a \<Rightarrow> real^'n"
   assumes "(f \<longlongrightarrow> l) net"  "\<not> (trivial_limit net)"  "eventually (\<lambda>x. b \<le> (f x)$i) net"
   shows "b \<le> l$i"
   by (rule tendsto_le[OF assms(2) tendsto_vec_nth tendsto_const, OF assms(1, 3)])
 
 lemma Lim_component_eq_cart:
   fixes f :: "'a \<Rightarrow> real^'n"
   assumes net: "(f \<longlongrightarrow> l) net" "\<not> trivial_limit net" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
   shows "l$i = b"
   using ev[unfolded order_eq_iff eventually_conj_iff] and
     Lim_component_ge_cart[OF net, of b i] and
     Lim_component_le_cart[OF net, of i b] by auto
 
 lemma connected_ivt_component_cart:
   fixes x :: "real^'n"
   shows "connected s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x$k \<le> a \<Longrightarrow> a \<le> y$k \<Longrightarrow> (\<exists>z\<in>s.  z$k = a)"
   using connected_ivt_hyperplane[of s x y "axis k 1" a]
   by (auto simp add: inner_axis inner_commute)
 
 lemma subspace_substandard_cart: "vec.subspace {x. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
   unfolding vec.subspace_def by auto
 
 lemma closed_substandard_cart:
   "closed {x::'a::real_normed_vector ^ 'n. \<forall>i. P i \<longrightarrow> x$i = 0}"
 proof -
   { fix i::'n
     have "closed {x::'a ^ 'n. P i \<longrightarrow> x$i = 0}"
-      by (cases "P i") (simp_all add: closed_Collect_eq continuous_on_const continuous_on_id continuous_on_component) }
+      by (cases "P i") (simp_all add: closed_Collect_eq continuous_on_component) }
   thus ?thesis
     unfolding Collect_all_eq by (simp add: closed_INT)
 qed
 
 subsection "Convex Euclidean Space"
 
 lemma Cart_1:"(1::real^'n) = \<Sum>Basis"
   using const_vector_cart[of 1] by (simp add: one_vec_def)
 
 declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp]
 declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp]
 
 lemmas vector_component_simps = vector_minus_component vector_smult_component vector_add_component less_eq_vec_def vec_lambda_beta vector_uminus_component
 
 lemma convex_box_cart:
   assumes "\<And>i. convex {x. P i x}"
   shows "convex {x. \<forall>i. P i (x$i)}"
   using assms unfolding convex_def by auto
 
 lemma convex_positive_orthant_cart: "convex {x::real^'n. (\<forall>i. 0 \<le> x$i)}"
   by (rule convex_box_cart) (simp add: atLeast_def[symmetric])
 
 lemma unit_interval_convex_hull_cart:
   "cbox (0::real^'n) 1 = convex hull {x. \<forall>i. (x$i = 0) \<or> (x$i = 1)}"
   unfolding Cart_1 unit_interval_convex_hull[where 'a="real^'n"] box_real[symmetric]
   by (rule arg_cong[where f="\<lambda>x. convex hull x"]) (simp add: Basis_vec_def inner_axis)
 
 proposition cube_convex_hull_cart:
   assumes "0 < d"
   obtains s::"(real^'n) set"
     where "finite s" "cbox (x - (\<chi> i. d)) (x + (\<chi> i. d)) = convex hull s"
 proof -
   from assms obtain s where "finite s"
     and "cbox (x - sum ((*\<^sub>R) d) Basis) (x + sum ((*\<^sub>R) d) Basis) = convex hull s"
     by (rule cube_convex_hull)
   with that[of s] show thesis
     by (simp add: const_vector_cart)
 qed
 
 
 subsection "Derivative"
 
 definition\<^marker>\<open>tag important\<close> "jacobian f net = matrix(frechet_derivative f net)"
 
 proposition jacobian_works:
   "(f::(real^'a) \<Rightarrow> (real^'b)) differentiable net \<longleftrightarrow>
     (f has_derivative (\<lambda>h. (jacobian f net) *v h)) net" (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (simp add: frechet_derivative_works has_derivative_linear jacobian_def)
 next
   assume ?rhs then show ?lhs
     by (rule differentiableI)
 qed
 
 
 text \<open>Component of the differential must be zero if it exists at a local
   maximum or minimum for that corresponding component\<close>
 
 proposition differential_zero_maxmin_cart:
   fixes f::"real^'a \<Rightarrow> real^'b"
   assumes "0 < e" "((\<forall>y \<in> ball x e. (f y)$k \<le> (f x)$k) \<or> (\<forall>y\<in>ball x e. (f x)$k \<le> (f y)$k))"
     "f differentiable (at x)"
   shows "jacobian f (at x) $ k = 0"
   using differential_zero_maxmin_component[of "axis k 1" e x f] assms
     vector_cart[of "\<lambda>j. frechet_derivative f (at x) j $ k"]
   by (simp add: Basis_vec_def axis_eq_axis inner_axis jacobian_def matrix_def)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Routine results connecting the types \<^typ>\<open>real^1\<close> and \<^typ>\<open>real\<close>\<close>
 
 lemma vec_cbox_1_eq [simp]:
   shows "vec ` cbox u v = cbox (vec u) (vec v ::real^1)"
   by (force simp: Basis_vec_def cart_eq_inner_axis [symmetric] mem_box)
 
 lemma vec_nth_cbox_1_eq [simp]:
   fixes u v :: "'a::euclidean_space^1"
   shows "(\<lambda>x. x $ 1) ` cbox u v = cbox (u$1) (v$1)"
     by (auto simp: Basis_vec_def cart_eq_inner_axis [symmetric] mem_box image_iff Bex_def inner_axis) (metis vec_component)
 
 lemma vec_nth_1_iff_cbox [simp]:
   fixes a b :: "'a::euclidean_space"
   shows "(\<lambda>x::'a^1. x $ 1) ` S = cbox a b \<longleftrightarrow> S = cbox (vec a) (vec b)"
     (is "?lhs = ?rhs")
 proof
   assume L: ?lhs show ?rhs
   proof (intro equalityI subsetI)
     fix x 
     assume "x \<in> S"
     then have "x $ 1 \<in> (\<lambda>v. v $ (1::1)) ` cbox (vec a) (vec b)"
       using L by auto
     then show "x \<in> cbox (vec a) (vec b)"
       by (metis (no_types, lifting) imageE vector_one_nth)
   next
     fix x :: "'a^1"
     assume "x \<in> cbox (vec a) (vec b)"
     then show "x \<in> S"
       by (metis (no_types, lifting) L imageE imageI vec_component vec_nth_cbox_1_eq vector_one_nth)
   qed
 qed simp
 
 lemma vec_nth_real_1_iff_cbox [simp]:
   fixes a b :: real
   shows "(\<lambda>x::real^1. x $ 1) ` S = {a..b} \<longleftrightarrow> S = cbox (vec a) (vec b)"
   using vec_nth_1_iff_cbox[of S a b]
   by simp
 
 lemma interval_split_cart:
   "{a..b::real^'n} \<inter> {x. x$k \<le> c} = {a .. (\<chi> i. if i = k then min (b$k) c else b$i)}"
   "cbox a b \<inter> {x. x$k \<ge> c} = {(\<chi> i. if i = k then max (a$k) c else a$i) .. b}"
   apply (rule_tac[!] set_eqI)
   unfolding Int_iff mem_box_cart mem_Collect_eq interval_cbox_cart
   unfolding vec_lambda_beta
   by auto
 
 lemmas cartesian_euclidean_space_uniform_limit_intros[uniform_limit_intros] =
   bounded_linear.uniform_limit[OF blinfun.bounded_linear_right]
   bounded_linear.uniform_limit[OF bounded_linear_vec_nth]
 
 end
diff --git a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy
--- a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy
+++ b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy
@@ -1,7847 +1,7847 @@
 section \<open>Complex Path Integrals and Cauchy's Integral Theorem\<close>
 
 text\<open>By John Harrison et al.  Ported from HOL Light by L C Paulson (2015)\<close>
 
 theory Cauchy_Integral_Theorem
 imports
   Complex_Transcendental
   Henstock_Kurzweil_Integration
   Weierstrass_Theorems
   Retracts
 begin
 
 lemma leibniz_rule_holomorphic:
   fixes f::"complex \<Rightarrow> 'b::euclidean_space \<Rightarrow> complex"
   assumes "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> ((\<lambda>x. f x t) has_field_derivative fx x t) (at x within U)"
   assumes "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes "convex U"
   shows "(\<lambda>x. integral (cbox a b) (f x)) holomorphic_on U"
   using leibniz_rule_field_differentiable[OF assms(1-3) _ assms(4)]
   by (auto simp: holomorphic_on_def)
 
 lemma Ln_measurable [measurable]: "Ln \<in> measurable borel borel"
 proof -
   have *: "Ln (-of_real x) = of_real (ln x) + \<i> * pi" if "x > 0" for x
     using that by (subst Ln_minus) (auto simp: Ln_of_real)
   have **: "Ln (of_real x) = of_real (ln (-x)) + \<i> * pi" if "x < 0" for x
     using *[of "-x"] that by simp
   have cont: "(\<lambda>x. indicat_real (- \<real>\<^sub>\<le>\<^sub>0) x *\<^sub>R Ln x) \<in> borel_measurable borel"
     by (intro borel_measurable_continuous_on_indicator continuous_intros) auto
   have "(\<lambda>x. if x \<in> \<real>\<^sub>\<le>\<^sub>0 then ln (-Re x) + \<i> * pi else indicator (-\<real>\<^sub>\<le>\<^sub>0) x *\<^sub>R Ln x) \<in> borel \<rightarrow>\<^sub>M borel"
     (is "?f \<in> _") by (rule measurable_If_set[OF _ cont]) auto
   hence "(\<lambda>x. if x = 0 then Ln 0 else ?f x) \<in> borel \<rightarrow>\<^sub>M borel" by measurable
   also have "(\<lambda>x. if x = 0 then Ln 0 else ?f x) = Ln"
     by (auto simp: fun_eq_iff ** nonpos_Reals_def)
   finally show ?thesis .
 qed
 
 lemma powr_complex_measurable [measurable]:
   assumes [measurable]: "f \<in> measurable M borel" "g \<in> measurable M borel"
   shows   "(\<lambda>x. f x powr g x :: complex) \<in> measurable M borel"
   using assms by (simp add: powr_def)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Homeomorphisms of arc images\<close>
 
 lemma homeomorphism_arc:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   assumes "arc g"
   obtains h where "homeomorphism {0..1} (path_image g) g h"
 using assms by (force simp: arc_def homeomorphism_compact path_def path_image_def)
 
 lemma homeomorphic_arc_image_interval:
   fixes g :: "real \<Rightarrow> 'a::t2_space" and a::real
   assumes "arc g" "a < b"
   shows "(path_image g) homeomorphic {a..b}"
 proof -
   have "(path_image g) homeomorphic {0..1::real}"
     by (meson assms(1) homeomorphic_def homeomorphic_sym homeomorphism_arc)
   also have "\<dots> homeomorphic {a..b}"
     using assms by (force intro: homeomorphic_closed_intervals_real)
   finally show ?thesis .
 qed
 
 lemma homeomorphic_arc_images:
   fixes g :: "real \<Rightarrow> 'a::t2_space" and h :: "real \<Rightarrow> 'b::t2_space"
   assumes "arc g" "arc h"
   shows "(path_image g) homeomorphic (path_image h)"
 proof -
   have "(path_image g) homeomorphic {0..1::real}"
     by (meson assms homeomorphic_def homeomorphic_sym homeomorphism_arc)
   also have "\<dots> homeomorphic (path_image h)"
     by (meson assms homeomorphic_def homeomorphism_arc)
   finally show ?thesis .
 qed
 
 lemma path_connected_arc_complement:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>" "2 \<le> DIM('a)"
   shows "path_connected(- path_image \<gamma>)"
 proof -
   have "path_image \<gamma> homeomorphic {0..1::real}"
     by (simp add: assms homeomorphic_arc_image_interval)
   then
   show ?thesis
     apply (rule path_connected_complement_homeomorphic_convex_compact)
       apply (auto simp: assms)
     done
 qed
 
 lemma connected_arc_complement:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>" "2 \<le> DIM('a)"
   shows "connected(- path_image \<gamma>)"
   by (simp add: assms path_connected_arc_complement path_connected_imp_connected)
 
 lemma inside_arc_empty:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "arc \<gamma>"
     shows "inside(path_image \<gamma>) = {}"
 proof (cases "DIM('a) = 1")
   case True
   then show ?thesis
     using assms connected_arc_image connected_convex_1_gen inside_convex by blast
 next
   case False
   show ?thesis
   proof (rule inside_bounded_complement_connected_empty)
     show "connected (- path_image \<gamma>)"
       apply (rule connected_arc_complement [OF assms])
       using False
       by (metis DIM_ge_Suc0 One_nat_def Suc_1 not_less_eq_eq order_class.order.antisym)
     show "bounded (path_image \<gamma>)"
       by (simp add: assms bounded_arc_image)
   qed
 qed
 
 lemma inside_simple_curve_imp_closed:
   fixes \<gamma> :: "real \<Rightarrow> 'a::euclidean_space"
     shows "\<lbrakk>simple_path \<gamma>; x \<in> inside(path_image \<gamma>)\<rbrakk> \<Longrightarrow> pathfinish \<gamma> = pathstart \<gamma>"
   using arc_simple_path  inside_arc_empty by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Piecewise differentiable functions\<close>
 
 definition piecewise_differentiable_on
            (infixr "piecewise'_differentiable'_on" 50)
   where "f piecewise_differentiable_on i  \<equiv>
            continuous_on i f \<and>
            (\<exists>S. finite S \<and> (\<forall>x \<in> i - S. f differentiable (at x within i)))"
 
 lemma piecewise_differentiable_on_imp_continuous_on:
     "f piecewise_differentiable_on S \<Longrightarrow> continuous_on S f"
 by (simp add: piecewise_differentiable_on_def)
 
 lemma piecewise_differentiable_on_subset:
     "f piecewise_differentiable_on S \<Longrightarrow> T \<le> S \<Longrightarrow> f piecewise_differentiable_on T"
   using continuous_on_subset
   unfolding piecewise_differentiable_on_def
   apply safe
   apply (blast elim: continuous_on_subset)
   by (meson Diff_iff differentiable_within_subset subsetCE)
 
 lemma differentiable_on_imp_piecewise_differentiable:
   fixes a:: "'a::{linorder_topology,real_normed_vector}"
   shows "f differentiable_on {a..b} \<Longrightarrow> f piecewise_differentiable_on {a..b}"
   apply (simp add: piecewise_differentiable_on_def differentiable_imp_continuous_on)
   apply (rule_tac x="{a,b}" in exI, simp add: differentiable_on_def)
   done
 
 lemma differentiable_imp_piecewise_differentiable:
     "(\<And>x. x \<in> S \<Longrightarrow> f differentiable (at x within S))
          \<Longrightarrow> f piecewise_differentiable_on S"
 by (auto simp: piecewise_differentiable_on_def differentiable_imp_continuous_on differentiable_on_def
          intro: differentiable_within_subset)
 
 lemma piecewise_differentiable_const [iff]: "(\<lambda>x. z) piecewise_differentiable_on S"
   by (simp add: differentiable_imp_piecewise_differentiable)
 
 lemma piecewise_differentiable_compose:
     "\<lbrakk>f piecewise_differentiable_on S; g piecewise_differentiable_on (f ` S);
       \<And>x. finite (S \<inter> f-`{x})\<rbrakk>
       \<Longrightarrow> (g \<circ> f) piecewise_differentiable_on S"
   apply (simp add: piecewise_differentiable_on_def, safe)
   apply (blast intro: continuous_on_compose2)
   apply (rename_tac A B)
   apply (rule_tac x="A \<union> (\<Union>x\<in>B. S \<inter> f-`{x})" in exI)
   apply (blast intro!: differentiable_chain_within)
   done
 
 lemma piecewise_differentiable_affine:
   fixes m::real
   assumes "f piecewise_differentiable_on ((\<lambda>x. m *\<^sub>R x + c) ` S)"
   shows "(f \<circ> (\<lambda>x. m *\<^sub>R x + c)) piecewise_differentiable_on S"
 proof (cases "m = 0")
   case True
   then show ?thesis
     unfolding o_def
     by (force intro: differentiable_imp_piecewise_differentiable differentiable_const)
 next
   case False
   show ?thesis
     apply (rule piecewise_differentiable_compose [OF differentiable_imp_piecewise_differentiable])
     apply (rule assms derivative_intros | simp add: False vimage_def real_vector_affinity_eq)+
     done
 qed
 
 lemma piecewise_differentiable_cases:
   fixes c::real
   assumes "f piecewise_differentiable_on {a..c}"
           "g piecewise_differentiable_on {c..b}"
            "a \<le> c" "c \<le> b" "f c = g c"
   shows "(\<lambda>x. if x \<le> c then f x else g x) piecewise_differentiable_on {a..b}"
 proof -
   obtain S T where st: "finite S" "finite T"
                and fd: "\<And>x. x \<in> {a..c} - S \<Longrightarrow> f differentiable at x within {a..c}"
                and gd: "\<And>x. x \<in> {c..b} - T \<Longrightarrow> g differentiable at x within {c..b}"
     using assms
     by (auto simp: piecewise_differentiable_on_def)
   have finabc: "finite ({a,b,c} \<union> (S \<union> T))"
     by (metis \<open>finite S\<close> \<open>finite T\<close> finite_Un finite_insert finite.emptyI)
   have "continuous_on {a..c} f" "continuous_on {c..b} g"
     using assms piecewise_differentiable_on_def by auto
   then have "continuous_on {a..b} (\<lambda>x. if x \<le> c then f x else g x)"
     using continuous_on_cases [OF closed_real_atLeastAtMost [of a c],
                                OF closed_real_atLeastAtMost [of c b],
                                of f g "\<lambda>x. x\<le>c"]  assms
     by (force simp: ivl_disj_un_two_touch)
   moreover
   { fix x
     assume x: "x \<in> {a..b} - ({a,b,c} \<union> (S \<union> T))"
     have "(\<lambda>x. if x \<le> c then f x else g x) differentiable at x within {a..b}" (is "?diff_fg")
     proof (cases x c rule: le_cases)
       case le show ?diff_fg
       proof (rule differentiable_transform_within [where d = "dist x c"])
         have "f differentiable at x"
           using x le fd [of x] at_within_interior [of x "{a..c}"] by simp
         then show "f differentiable at x within {a..b}"
           by (simp add: differentiable_at_withinI)
       qed (use x le st dist_real_def in auto)
     next
       case ge show ?diff_fg
       proof (rule differentiable_transform_within [where d = "dist x c"])
         have "g differentiable at x"
           using x ge gd [of x] at_within_interior [of x "{c..b}"] by simp
         then show "g differentiable at x within {a..b}"
           by (simp add: differentiable_at_withinI)
       qed (use x ge st dist_real_def in auto)
     qed
   }
   then have "\<exists>S. finite S \<and>
                  (\<forall>x\<in>{a..b} - S. (\<lambda>x. if x \<le> c then f x else g x) differentiable at x within {a..b})"
     by (meson finabc)
   ultimately show ?thesis
     by (simp add: piecewise_differentiable_on_def)
 qed
 
 lemma piecewise_differentiable_neg:
     "f piecewise_differentiable_on S \<Longrightarrow> (\<lambda>x. -(f x)) piecewise_differentiable_on S"
   by (auto simp: piecewise_differentiable_on_def continuous_on_minus)
 
 lemma piecewise_differentiable_add:
   assumes "f piecewise_differentiable_on i"
           "g piecewise_differentiable_on i"
     shows "(\<lambda>x. f x + g x) piecewise_differentiable_on i"
 proof -
   obtain S T where st: "finite S" "finite T"
                        "\<forall>x\<in>i - S. f differentiable at x within i"
                        "\<forall>x\<in>i - T. g differentiable at x within i"
     using assms by (auto simp: piecewise_differentiable_on_def)
   then have "finite (S \<union> T) \<and> (\<forall>x\<in>i - (S \<union> T). (\<lambda>x. f x + g x) differentiable at x within i)"
     by auto
   moreover have "continuous_on i f" "continuous_on i g"
     using assms piecewise_differentiable_on_def by auto
   ultimately show ?thesis
     by (auto simp: piecewise_differentiable_on_def continuous_on_add)
 qed
 
 lemma piecewise_differentiable_diff:
     "\<lbrakk>f piecewise_differentiable_on S;  g piecewise_differentiable_on S\<rbrakk>
      \<Longrightarrow> (\<lambda>x. f x - g x) piecewise_differentiable_on S"
   unfolding diff_conv_add_uminus
   by (metis piecewise_differentiable_add piecewise_differentiable_neg)
 
 lemma continuous_on_joinpaths_D1:
     "continuous_on {0..1} (g1 +++ g2) \<Longrightarrow> continuous_on {0..1} g1"
   apply (rule continuous_on_eq [of _ "(g1 +++ g2) \<circ> ((*)(inverse 2))"])
   apply (rule continuous_intros | simp)+
   apply (auto elim!: continuous_on_subset simp: joinpaths_def)
   done
 
 lemma continuous_on_joinpaths_D2:
     "\<lbrakk>continuous_on {0..1} (g1 +++ g2); pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> continuous_on {0..1} g2"
   apply (rule continuous_on_eq [of _ "(g1 +++ g2) \<circ> (\<lambda>x. inverse 2*x + 1/2)"])
   apply (rule continuous_intros | simp)+
   apply (auto elim!: continuous_on_subset simp add: joinpaths_def pathfinish_def pathstart_def Ball_def)
   done
 
 lemma piecewise_differentiable_D1:
   assumes "(g1 +++ g2) piecewise_differentiable_on {0..1}"
   shows "g1 piecewise_differentiable_on {0..1}"
 proof -
   obtain S where cont: "continuous_on {0..1} g1" and "finite S"
     and S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g1 +++ g2 differentiable at x within {0..1}"
     using assms unfolding piecewise_differentiable_on_def
     by (blast dest!: continuous_on_joinpaths_D1)
   show ?thesis
     unfolding piecewise_differentiable_on_def
   proof (intro exI conjI ballI cont)
     show "finite (insert 1 (((*)2) ` S))"
       by (simp add: \<open>finite S\<close>)
     show "g1 differentiable at x within {0..1}" if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
     proof (rule_tac d="dist (x/2) (1/2)" in differentiable_transform_within)
       have "g1 +++ g2 differentiable at (x / 2) within {0..1/2}"
         by (rule differentiable_subset [OF S [of "x/2"]] | use that in force)+
       then show "g1 +++ g2 \<circ> (*) (inverse 2) differentiable at x within {0..1}"
         using image_affinity_atLeastAtMost_div [of 2 0 "0::real" 1]
         by (auto intro: differentiable_chain_within)
     qed (use that in \<open>auto simp: joinpaths_def\<close>)
   qed
 qed
 
 lemma piecewise_differentiable_D2:
   assumes "(g1 +++ g2) piecewise_differentiable_on {0..1}" and eq: "pathfinish g1 = pathstart g2"
   shows "g2 piecewise_differentiable_on {0..1}"
 proof -
   have [simp]: "g1 1 = g2 0"
     using eq by (simp add: pathfinish_def pathstart_def)
   obtain S where cont: "continuous_on {0..1} g2" and "finite S"
     and S: "\<And>x. x \<in> {0..1} - S \<Longrightarrow> g1 +++ g2 differentiable at x within {0..1}"
     using assms unfolding piecewise_differentiable_on_def
     by (blast dest!: continuous_on_joinpaths_D2)
   show ?thesis
     unfolding piecewise_differentiable_on_def
   proof (intro exI conjI ballI cont)
     show "finite (insert 0 ((\<lambda>x. 2*x-1)`S))"
       by (simp add: \<open>finite S\<close>)
     show "g2 differentiable at x within {0..1}" if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1)`S)" for x
     proof (rule_tac d="dist ((x+1)/2) (1/2)" in differentiable_transform_within)
       have x2: "(x + 1) / 2 \<notin> S"
         using that
         apply (clarsimp simp: image_iff)
         by (metis add.commute add_diff_cancel_left' mult_2 field_sum_of_halves)
       have "g1 +++ g2 \<circ> (\<lambda>x. (x+1) / 2) differentiable at x within {0..1}"
         by (rule differentiable_chain_within differentiable_subset [OF S [of "(x+1)/2"]] | use x2 that in force)+
       then show "g1 +++ g2 \<circ> (\<lambda>x. (x+1) / 2) differentiable at x within {0..1}"
         by (auto intro: differentiable_chain_within)
       show "(g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2)) x' = g2 x'" if "x' \<in> {0..1}" "dist x' x < dist ((x + 1) / 2) (1/2)" for x'
       proof -
         have [simp]: "(2*x'+2)/2 = x'+1"
           by (simp add: field_split_simps)
         show ?thesis
           using that by (auto simp: joinpaths_def)
       qed
     qed (use that in \<open>auto simp: joinpaths_def\<close>)
   qed
 qed
 
 
 subsection\<open>The concept of continuously differentiable\<close>
 
 text \<open>
 John Harrison writes as follows:
 
 ``The usual assumption in complex analysis texts is that a path \<open>\<gamma>\<close> should be piecewise
 continuously differentiable, which ensures that the path integral exists at least for any continuous
 f, since all piecewise continuous functions are integrable. However, our notion of validity is
 weaker, just piecewise differentiability\ldots{} [namely] continuity plus differentiability except on a
 finite set\ldots{} [Our] underlying theory of integration is the Kurzweil-Henstock theory. In contrast to
 the Riemann or Lebesgue theory (but in common with a simple notion based on antiderivatives), this
 can integrate all derivatives.''
 
 "Formalizing basic complex analysis." From Insight to Proof: Festschrift in Honour of Andrzej Trybulec.
 Studies in Logic, Grammar and Rhetoric 10.23 (2007): 151-165.
 
 And indeed he does not assume that his derivatives are continuous, but the penalty is unreasonably
 difficult proofs concerning winding numbers. We need a self-contained and straightforward theorem
 asserting that all derivatives can be integrated before we can adopt Harrison's choice.\<close>
 
 definition\<^marker>\<open>tag important\<close> C1_differentiable_on :: "(real \<Rightarrow> 'a::real_normed_vector) \<Rightarrow> real set \<Rightarrow> bool"
            (infix "C1'_differentiable'_on" 50)
   where
   "f C1_differentiable_on S \<longleftrightarrow>
    (\<exists>D. (\<forall>x \<in> S. (f has_vector_derivative (D x)) (at x)) \<and> continuous_on S D)"
 
 lemma C1_differentiable_on_eq:
     "f C1_differentiable_on S \<longleftrightarrow>
      (\<forall>x \<in> S. f differentiable at x) \<and> continuous_on S (\<lambda>x. vector_derivative f (at x))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding C1_differentiable_on_def
     by (metis (no_types, lifting) continuous_on_eq  differentiableI_vector vector_derivative_at)
 next
   assume ?rhs
   then show ?lhs
     using C1_differentiable_on_def vector_derivative_works by fastforce
 qed
 
 lemma C1_differentiable_on_subset:
   "f C1_differentiable_on T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> f C1_differentiable_on S"
   unfolding C1_differentiable_on_def  continuous_on_eq_continuous_within
   by (blast intro:  continuous_within_subset)
 
 lemma C1_differentiable_compose:
   assumes fg: "f C1_differentiable_on S" "g C1_differentiable_on (f ` S)" and fin: "\<And>x. finite (S \<inter> f-`{x})"
   shows "(g \<circ> f) C1_differentiable_on S"
 proof -
   have "\<And>x. x \<in> S \<Longrightarrow> g \<circ> f differentiable at x"
     by (meson C1_differentiable_on_eq assms differentiable_chain_at imageI)
   moreover have "continuous_on S (\<lambda>x. vector_derivative (g \<circ> f) (at x))"
   proof (rule continuous_on_eq [of _ "\<lambda>x. vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x))"])
     show "continuous_on S (\<lambda>x. vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x)))"
       using fg
       apply (clarsimp simp add: C1_differentiable_on_eq)
       apply (rule Limits.continuous_on_scaleR, assumption)
       by (metis (mono_tags, lifting) continuous_at_imp_continuous_on continuous_on_compose continuous_on_cong differentiable_imp_continuous_within o_def)
     show "\<And>x. x \<in> S \<Longrightarrow> vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x)) = vector_derivative (g \<circ> f) (at x)"
       by (metis (mono_tags, hide_lams) C1_differentiable_on_eq fg imageI vector_derivative_chain_at)
   qed
   ultimately show ?thesis
     by (simp add: C1_differentiable_on_eq)
 qed
 
 lemma C1_diff_imp_diff: "f C1_differentiable_on S \<Longrightarrow> f differentiable_on S"
   by (simp add: C1_differentiable_on_eq differentiable_at_imp_differentiable_on)
 
 lemma C1_differentiable_on_ident [simp, derivative_intros]: "(\<lambda>x. x) C1_differentiable_on S"
-  by (auto simp: C1_differentiable_on_eq continuous_on_const)
+  by (auto simp: C1_differentiable_on_eq)
 
 lemma C1_differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. a) C1_differentiable_on S"
-  by (auto simp: C1_differentiable_on_eq continuous_on_const)
+  by (auto simp: C1_differentiable_on_eq)
 
 lemma C1_differentiable_on_add [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x + g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_minus [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> (\<lambda>x. - f x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_diff [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x - g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq  by (auto intro: continuous_intros)
 
 lemma C1_differentiable_on_mult [simp, derivative_intros]:
   fixes f g :: "real \<Rightarrow> 'a :: real_normed_algebra"
   shows "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x * g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq
   by (auto simp: continuous_on_add continuous_on_mult continuous_at_imp_continuous_on differentiable_imp_continuous_within)
 
 lemma C1_differentiable_on_scaleR [simp, derivative_intros]:
   "f C1_differentiable_on S \<Longrightarrow> g C1_differentiable_on S \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) C1_differentiable_on S"
   unfolding C1_differentiable_on_eq
   by (rule continuous_intros | simp add: continuous_at_imp_continuous_on differentiable_imp_continuous_within)+
 
 
 definition\<^marker>\<open>tag important\<close> piecewise_C1_differentiable_on
            (infixr "piecewise'_C1'_differentiable'_on" 50)
   where "f piecewise_C1_differentiable_on i  \<equiv>
            continuous_on i f \<and>
            (\<exists>S. finite S \<and> (f C1_differentiable_on (i - S)))"
 
 lemma C1_differentiable_imp_piecewise:
     "f C1_differentiable_on S \<Longrightarrow> f piecewise_C1_differentiable_on S"
   by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq continuous_at_imp_continuous_on differentiable_imp_continuous_within)
 
 lemma piecewise_C1_imp_differentiable:
     "f piecewise_C1_differentiable_on i \<Longrightarrow> f piecewise_differentiable_on i"
   by (auto simp: piecewise_C1_differentiable_on_def piecewise_differentiable_on_def
            C1_differentiable_on_def differentiable_def has_vector_derivative_def
            intro: has_derivative_at_withinI)
 
 lemma piecewise_C1_differentiable_compose:
   assumes fg: "f piecewise_C1_differentiable_on S" "g piecewise_C1_differentiable_on (f ` S)" and fin: "\<And>x. finite (S \<inter> f-`{x})"
   shows "(g \<circ> f) piecewise_C1_differentiable_on S"
 proof -
   have "continuous_on S (\<lambda>x. g (f x))"
     by (metis continuous_on_compose2 fg order_refl piecewise_C1_differentiable_on_def)
   moreover have "\<exists>T. finite T \<and> g \<circ> f C1_differentiable_on S - T"
   proof -
     obtain F where "finite F" and F: "f C1_differentiable_on S - F" and f: "f piecewise_C1_differentiable_on S"
       using fg by (auto simp: piecewise_C1_differentiable_on_def)
     obtain G where "finite G" and G: "g C1_differentiable_on f ` S - G" and g: "g piecewise_C1_differentiable_on f ` S"
       using fg by (auto simp: piecewise_C1_differentiable_on_def)
     show ?thesis
     proof (intro exI conjI)
       show "finite (F \<union> (\<Union>x\<in>G. S \<inter> f-`{x}))"
         using fin by (auto simp only: Int_Union \<open>finite F\<close> \<open>finite G\<close> finite_UN finite_imageI)
       show "g \<circ> f C1_differentiable_on S - (F \<union> (\<Union>x\<in>G. S \<inter> f -` {x}))"
         apply (rule C1_differentiable_compose)
           apply (blast intro: C1_differentiable_on_subset [OF F])
           apply (blast intro: C1_differentiable_on_subset [OF G])
         by (simp add:  C1_differentiable_on_subset G Diff_Int_distrib2 fin)
     qed
   qed
   ultimately show ?thesis
     by (simp add: piecewise_C1_differentiable_on_def)
 qed
 
 lemma piecewise_C1_differentiable_on_subset:
     "f piecewise_C1_differentiable_on S \<Longrightarrow> T \<le> S \<Longrightarrow> f piecewise_C1_differentiable_on T"
   by (auto simp: piecewise_C1_differentiable_on_def elim!: continuous_on_subset C1_differentiable_on_subset)
 
 lemma C1_differentiable_imp_continuous_on:
   "f C1_differentiable_on S \<Longrightarrow> continuous_on S f"
   unfolding C1_differentiable_on_eq continuous_on_eq_continuous_within
   using differentiable_at_withinI differentiable_imp_continuous_within by blast
 
 lemma C1_differentiable_on_empty [iff]: "f C1_differentiable_on {}"
   unfolding C1_differentiable_on_def
   by auto
 
 lemma piecewise_C1_differentiable_affine:
   fixes m::real
   assumes "f piecewise_C1_differentiable_on ((\<lambda>x. m * x + c) ` S)"
   shows "(f \<circ> (\<lambda>x. m *\<^sub>R x + c)) piecewise_C1_differentiable_on S"
 proof (cases "m = 0")
   case True
   then show ?thesis
-    unfolding o_def by (auto simp: piecewise_C1_differentiable_on_def continuous_on_const)
+    unfolding o_def by (auto simp: piecewise_C1_differentiable_on_def)
 next
   case False
   have *: "\<And>x. finite (S \<inter> {y. m * y + c = x})"
     using False not_finite_existsD by fastforce
   show ?thesis
     apply (rule piecewise_C1_differentiable_compose [OF C1_differentiable_imp_piecewise])
     apply (rule * assms derivative_intros | simp add: False vimage_def)+
     done
 qed
 
 lemma piecewise_C1_differentiable_cases:
   fixes c::real
   assumes "f piecewise_C1_differentiable_on {a..c}"
           "g piecewise_C1_differentiable_on {c..b}"
            "a \<le> c" "c \<le> b" "f c = g c"
   shows "(\<lambda>x. if x \<le> c then f x else g x) piecewise_C1_differentiable_on {a..b}"
 proof -
   obtain S T where st: "f C1_differentiable_on ({a..c} - S)"
                        "g C1_differentiable_on ({c..b} - T)"
                        "finite S" "finite T"
     using assms
     by (force simp: piecewise_C1_differentiable_on_def)
   then have f_diff: "f differentiable_on {a..<c} - S"
         and g_diff: "g differentiable_on {c<..b} - T"
     by (simp_all add: C1_differentiable_on_eq differentiable_at_withinI differentiable_on_def)
   have "continuous_on {a..c} f" "continuous_on {c..b} g"
     using assms piecewise_C1_differentiable_on_def by auto
   then have cab: "continuous_on {a..b} (\<lambda>x. if x \<le> c then f x else g x)"
     using continuous_on_cases [OF closed_real_atLeastAtMost [of a c],
                                OF closed_real_atLeastAtMost [of c b],
                                of f g "\<lambda>x. x\<le>c"]  assms
     by (force simp: ivl_disj_un_two_touch)
   { fix x
     assume x: "x \<in> {a..b} - insert c (S \<union> T)"
     have "(\<lambda>x. if x \<le> c then f x else g x) differentiable at x" (is "?diff_fg")
     proof (cases x c rule: le_cases)
       case le show ?diff_fg
         apply (rule differentiable_transform_within [where f=f and d = "dist x c"])
         using x dist_real_def le st by (auto simp: C1_differentiable_on_eq)
     next
       case ge show ?diff_fg
         apply (rule differentiable_transform_within [where f=g and d = "dist x c"])
         using dist_nz x dist_real_def ge st x by (auto simp: C1_differentiable_on_eq)
     qed
   }
   then have "(\<forall>x \<in> {a..b} - insert c (S \<union> T). (\<lambda>x. if x \<le> c then f x else g x) differentiable at x)"
     by auto
   moreover
   { assume fcon: "continuous_on ({a<..<c} - S) (\<lambda>x. vector_derivative f (at x))"
        and gcon: "continuous_on ({c<..<b} - T) (\<lambda>x. vector_derivative g (at x))"
     have "open ({a<..<c} - S)"  "open ({c<..<b} - T)"
       using st by (simp_all add: open_Diff finite_imp_closed)
     moreover have "continuous_on ({a<..<c} - S) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     proof -
       have "((\<lambda>x. if x \<le> c then f x else g x) has_vector_derivative vector_derivative f (at x))            (at x)"
         if "a < x" "x < c" "x \<notin> S" for x
       proof -
         have f: "f differentiable at x"
           by (meson C1_differentiable_on_eq Diff_iff atLeastAtMost_iff less_eq_real_def st(1) that)
         show ?thesis
           using that
           apply (rule_tac f=f and d="dist x c" in has_vector_derivative_transform_within)
              apply (auto simp: dist_norm vector_derivative_works [symmetric] f)
           done
       qed
       then show ?thesis
         by (metis (no_types, lifting) continuous_on_eq [OF fcon] DiffE greaterThanLessThan_iff vector_derivative_at)
     qed
     moreover have "continuous_on ({c<..<b} - T) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     proof -
       have "((\<lambda>x. if x \<le> c then f x else g x) has_vector_derivative vector_derivative g (at x))            (at x)"
         if "c < x" "x < b" "x \<notin> T" for x
       proof -
         have g: "g differentiable at x"
           by (metis C1_differentiable_on_eq DiffD1 DiffI atLeastAtMost_diff_ends greaterThanLessThan_iff st(2) that)
         show ?thesis
           using that
           apply (rule_tac f=g and d="dist x c" in has_vector_derivative_transform_within)
              apply (auto simp: dist_norm vector_derivative_works [symmetric] g)
           done
       qed
       then show ?thesis
         by (metis (no_types, lifting) continuous_on_eq [OF gcon] DiffE greaterThanLessThan_iff vector_derivative_at)
     qed
     ultimately have "continuous_on ({a<..<b} - insert c (S \<union> T))
         (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
       by (rule continuous_on_subset [OF continuous_on_open_Un], auto)
   } note * = this
   have "continuous_on ({a<..<b} - insert c (S \<union> T)) (\<lambda>x. vector_derivative (\<lambda>x. if x \<le> c then f x else g x) (at x))"
     using st
     by (auto simp: C1_differentiable_on_eq elim!: continuous_on_subset intro: *)
   ultimately have "\<exists>S. finite S \<and> ((\<lambda>x. if x \<le> c then f x else g x) C1_differentiable_on {a..b} - S)"
     apply (rule_tac x="{a,b,c} \<union> S \<union> T" in exI)
     using st  by (auto simp: C1_differentiable_on_eq elim!: continuous_on_subset)
   with cab show ?thesis
     by (simp add: piecewise_C1_differentiable_on_def)
 qed
 
 lemma piecewise_C1_differentiable_neg:
     "f piecewise_C1_differentiable_on S \<Longrightarrow> (\<lambda>x. -(f x)) piecewise_C1_differentiable_on S"
   unfolding piecewise_C1_differentiable_on_def
   by (auto intro!: continuous_on_minus C1_differentiable_on_minus)
 
 lemma piecewise_C1_differentiable_add:
   assumes "f piecewise_C1_differentiable_on i"
           "g piecewise_C1_differentiable_on i"
     shows "(\<lambda>x. f x + g x) piecewise_C1_differentiable_on i"
 proof -
   obtain S t where st: "finite S" "finite t"
                        "f C1_differentiable_on (i-S)"
                        "g C1_differentiable_on (i-t)"
     using assms by (auto simp: piecewise_C1_differentiable_on_def)
   then have "finite (S \<union> t) \<and> (\<lambda>x. f x + g x) C1_differentiable_on i - (S \<union> t)"
     by (auto intro: C1_differentiable_on_add elim!: C1_differentiable_on_subset)
   moreover have "continuous_on i f" "continuous_on i g"
     using assms piecewise_C1_differentiable_on_def by auto
   ultimately show ?thesis
     by (auto simp: piecewise_C1_differentiable_on_def continuous_on_add)
 qed
 
 lemma piecewise_C1_differentiable_diff:
     "\<lbrakk>f piecewise_C1_differentiable_on S;  g piecewise_C1_differentiable_on S\<rbrakk>
      \<Longrightarrow> (\<lambda>x. f x - g x) piecewise_C1_differentiable_on S"
   unfolding diff_conv_add_uminus
   by (metis piecewise_C1_differentiable_add piecewise_C1_differentiable_neg)
 
 lemma piecewise_C1_differentiable_D1:
   fixes g1 :: "real \<Rightarrow> 'a::real_normed_field"
   assumes "(g1 +++ g2) piecewise_C1_differentiable_on {0..1}"
     shows "g1 piecewise_C1_differentiable_on {0..1}"
 proof -
   obtain S where "finite S"
              and co12: "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
              and g12D: "\<forall>x\<in>{0..1} - S. g1 +++ g2 differentiable at x"
     using assms  by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have g1D: "g1 differentiable at x" if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
   proof (rule differentiable_transform_within)
     show "g1 +++ g2 \<circ> (*) (inverse 2) differentiable at x"
       using that g12D
       apply (simp only: joinpaths_def)
       by (rule differentiable_chain_at derivative_intros | force)+
     show "\<And>x'. \<lbrakk>dist x' x < dist (x/2) (1/2)\<rbrakk>
           \<Longrightarrow> (g1 +++ g2 \<circ> (*) (inverse 2)) x' = g1 x'"
       using that by (auto simp: dist_real_def joinpaths_def)
   qed (use that in \<open>auto simp: dist_real_def\<close>)
   have [simp]: "vector_derivative (g1 \<circ> (*) 2) (at (x/2)) = 2 *\<^sub>R vector_derivative g1 (at x)"
                if "x \<in> {0..1} - insert 1 ((*) 2 ` S)" for x
     apply (subst vector_derivative_chain_at)
     using that
     apply (rule derivative_eq_intros g1D | simp)+
     done
   have "continuous_on ({0..1/2} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
     using co12 by (rule continuous_on_subset) force
   then have coDhalf: "continuous_on ({0..1/2} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 \<circ> (*)2) (at x))"
   proof (rule continuous_on_eq [OF _ vector_derivative_at])
     show "(g1 +++ g2 has_vector_derivative vector_derivative (g1 \<circ> (*) 2) (at x)) (at x)"
       if "x \<in> {0..1/2} - insert (1/2) S" for x
     proof (rule has_vector_derivative_transform_within)
       show "(g1 \<circ> (*) 2 has_vector_derivative vector_derivative (g1 \<circ> (*) 2) (at x)) (at x)"
         using that
         by (force intro: g1D differentiable_chain_at simp: vector_derivative_works [symmetric])
       show "\<And>x'. \<lbrakk>dist x' x < dist x (1/2)\<rbrakk> \<Longrightarrow> (g1 \<circ> (*) 2) x' = (g1 +++ g2) x'"
         using that by (auto simp: dist_norm joinpaths_def)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   qed
   have "continuous_on ({0..1} - insert 1 ((*) 2 ` S))
                       ((\<lambda>x. 1/2 * vector_derivative (g1 \<circ> (*)2) (at x)) \<circ> (*)(1/2))"
     apply (rule continuous_intros)+
     using coDhalf
     apply (simp add: scaleR_conv_of_real image_set_diff image_image)
     done
   then have con_g1: "continuous_on ({0..1} - insert 1 ((*) 2 ` S)) (\<lambda>x. vector_derivative g1 (at x))"
     by (rule continuous_on_eq) (simp add: scaleR_conv_of_real)
   have "continuous_on {0..1} g1"
     using continuous_on_joinpaths_D1 assms piecewise_C1_differentiable_on_def by blast
   with \<open>finite S\<close> show ?thesis
     apply (clarsimp simp add: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
     apply (rule_tac x="insert 1 (((*)2)`S)" in exI)
     apply (simp add: g1D con_g1)
   done
 qed
 
 lemma piecewise_C1_differentiable_D2:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   assumes "(g1 +++ g2) piecewise_C1_differentiable_on {0..1}" "pathfinish g1 = pathstart g2"
     shows "g2 piecewise_C1_differentiable_on {0..1}"
 proof -
   obtain S where "finite S"
              and co12: "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
              and g12D: "\<forall>x\<in>{0..1} - S. g1 +++ g2 differentiable at x"
     using assms  by (auto simp: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have g2D: "g2 differentiable at x" if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)" for x
   proof (rule differentiable_transform_within)
     show "g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2) differentiable at x"
       using g12D that
       apply (simp only: joinpaths_def)
       apply (drule_tac x= "(x+1) / 2" in bspec, force simp: field_split_simps)
       apply (rule differentiable_chain_at derivative_intros | force)+
       done
     show "\<And>x'. dist x' x < dist ((x + 1) / 2) (1/2) \<Longrightarrow> (g1 +++ g2 \<circ> (\<lambda>x. (x + 1) / 2)) x' = g2 x'"
       using that by (auto simp: dist_real_def joinpaths_def field_simps)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   have [simp]: "vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at ((x+1)/2)) = 2 *\<^sub>R vector_derivative g2 (at x)"
                if "x \<in> {0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)" for x
     using that  by (auto simp: vector_derivative_chain_at field_split_simps g2D)
   have "continuous_on ({1/2..1} - insert (1/2) S) (\<lambda>x. vector_derivative (g1 +++ g2) (at x))"
     using co12 by (rule continuous_on_subset) force
   then have coDhalf: "continuous_on ({1/2..1} - insert (1/2) S) (\<lambda>x. vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at x))"
   proof (rule continuous_on_eq [OF _ vector_derivative_at])
     show "(g1 +++ g2 has_vector_derivative vector_derivative (g2 \<circ> (\<lambda>x. 2 * x - 1)) (at x))
           (at x)"
       if "x \<in> {1 / 2..1} - insert (1 / 2) S" for x
     proof (rule_tac f="g2 \<circ> (\<lambda>x. 2*x-1)" and d="dist (3/4) ((x+1)/2)" in has_vector_derivative_transform_within)
       show "(g2 \<circ> (\<lambda>x. 2 * x - 1) has_vector_derivative vector_derivative (g2 \<circ> (\<lambda>x. 2 * x - 1)) (at x))
             (at x)"
         using that by (force intro: g2D differentiable_chain_at simp: vector_derivative_works [symmetric])
       show "\<And>x'. \<lbrakk>dist x' x < dist (3 / 4) ((x + 1) / 2)\<rbrakk> \<Longrightarrow> (g2 \<circ> (\<lambda>x. 2 * x - 1)) x' = (g1 +++ g2) x'"
         using that by (auto simp: dist_norm joinpaths_def add_divide_distrib)
     qed (use that in \<open>auto simp: dist_norm\<close>)
   qed
   have [simp]: "((\<lambda>x. (x+1) / 2) ` ({0..1} - insert 0 ((\<lambda>x. 2 * x - 1) ` S))) = ({1/2..1} - insert (1/2) S)"
     apply (simp add: image_set_diff inj_on_def image_image)
     apply (auto simp: image_affinity_atLeastAtMost_div add_divide_distrib)
     done
   have "continuous_on ({0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S))
                       ((\<lambda>x. 1/2 * vector_derivative (g2 \<circ> (\<lambda>x. 2*x-1)) (at x)) \<circ> (\<lambda>x. (x+1)/2))"
     by (rule continuous_intros | simp add:  coDhalf)+
   then have con_g2: "continuous_on ({0..1} - insert 0 ((\<lambda>x. 2*x-1) ` S)) (\<lambda>x. vector_derivative g2 (at x))"
     by (rule continuous_on_eq) (simp add: scaleR_conv_of_real)
   have "continuous_on {0..1} g2"
     using continuous_on_joinpaths_D2 assms piecewise_C1_differentiable_on_def by blast
   with \<open>finite S\<close> show ?thesis
     apply (clarsimp simp add: piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
     apply (rule_tac x="insert 0 ((\<lambda>x. 2 * x - 1) ` S)" in exI)
     apply (simp add: g2D con_g2)
   done
 qed
 
 subsection \<open>Valid paths, and their start and finish\<close>
 
 definition\<^marker>\<open>tag important\<close> valid_path :: "(real \<Rightarrow> 'a :: real_normed_vector) \<Rightarrow> bool"
   where "valid_path f \<equiv> f piecewise_C1_differentiable_on {0..1::real}"
 
 definition closed_path :: "(real \<Rightarrow> 'a :: real_normed_vector) \<Rightarrow> bool"
   where "closed_path g \<equiv> g 0 = g 1"
 
 text\<open>In particular, all results for paths apply\<close>
 
 lemma valid_path_imp_path: "valid_path g \<Longrightarrow> path g"
   by (simp add: path_def piecewise_C1_differentiable_on_def valid_path_def)
 
 lemma connected_valid_path_image: "valid_path g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image valid_path_imp_path)
 
 lemma compact_valid_path_image: "valid_path g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image valid_path_imp_path)
 
 lemma bounded_valid_path_image: "valid_path g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image valid_path_imp_path)
 
 lemma closed_valid_path_image: "valid_path g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image valid_path_imp_path)
 
 lemma valid_path_compose:
   assumes "valid_path g"
       and der: "\<And>x. x \<in> path_image g \<Longrightarrow> f field_differentiable (at x)"
       and con: "continuous_on (path_image g) (deriv f)"
     shows "valid_path (f \<circ> g)"
 proof -
   obtain S where "finite S" and g_diff: "g C1_differentiable_on {0..1} - S"
     using \<open>valid_path g\<close> unfolding valid_path_def piecewise_C1_differentiable_on_def by auto
   have "f \<circ> g differentiable at t" when "t\<in>{0..1} - S" for t
     proof (rule differentiable_chain_at)
       show "g differentiable at t" using \<open>valid_path g\<close>
         by (meson C1_differentiable_on_eq \<open>g C1_differentiable_on {0..1} - S\<close> that)
     next
       have "g t\<in>path_image g" using that DiffD1 image_eqI path_image_def by metis
       then show "f differentiable at (g t)"
         using der[THEN field_differentiable_imp_differentiable] by auto
     qed
   moreover have "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative (f \<circ> g) (at x))"
     proof (rule continuous_on_eq [where f = "\<lambda>x. vector_derivative g (at x) * deriv f (g x)"],
         rule continuous_intros)
       show "continuous_on ({0..1} - S) (\<lambda>x. vector_derivative g (at x))"
         using g_diff C1_differentiable_on_eq by auto
     next
       have "continuous_on {0..1} (\<lambda>x. deriv f (g x))"
         using continuous_on_compose[OF _ con[unfolded path_image_def],unfolded comp_def]
           \<open>valid_path g\<close> piecewise_C1_differentiable_on_def valid_path_def
         by blast
       then show "continuous_on ({0..1} - S) (\<lambda>x. deriv f (g x))"
         using continuous_on_subset by blast
     next
       show "vector_derivative g (at t) * deriv f (g t) = vector_derivative (f \<circ> g) (at t)"
           when "t \<in> {0..1} - S" for t
         proof (rule vector_derivative_chain_at_general[symmetric])
           show "g differentiable at t" by (meson C1_differentiable_on_eq g_diff that)
         next
           have "g t\<in>path_image g" using that DiffD1 image_eqI path_image_def by metis
           then show "f field_differentiable at (g t)" using der by auto
         qed
     qed
   ultimately have "f \<circ> g C1_differentiable_on {0..1} - S"
     using C1_differentiable_on_eq by blast
   moreover have "path (f \<circ> g)"
     apply (rule path_continuous_image[OF valid_path_imp_path[OF \<open>valid_path g\<close>]])
     using der
     by (simp add: continuous_at_imp_continuous_on field_differentiable_imp_continuous_at)
   ultimately show ?thesis unfolding valid_path_def piecewise_C1_differentiable_on_def path_def
     using \<open>finite S\<close> by auto
 qed
   
 lemma valid_path_uminus_comp[simp]:
   fixes g::"real \<Rightarrow> 'a ::real_normed_field"
   shows "valid_path (uminus \<circ> g) \<longleftrightarrow> valid_path g"
 proof 
   show "valid_path g \<Longrightarrow> valid_path (uminus \<circ> g)" for g::"real \<Rightarrow> 'a"
     by (auto intro!: valid_path_compose derivative_intros simp add: deriv_linear[of "-1",simplified])  
   then show "valid_path g" when "valid_path (uminus \<circ> g)"
     by (metis fun.map_comp group_add_class.minus_comp_minus id_comp that)
 qed
 
 lemma valid_path_offset[simp]:
   shows "valid_path (\<lambda>t. g t - z) \<longleftrightarrow> valid_path g"  
 proof 
   show *: "valid_path (g::real\<Rightarrow>'a) \<Longrightarrow> valid_path (\<lambda>t. g t - z)" for g z
     unfolding valid_path_def
     by (fastforce intro:derivative_intros C1_differentiable_imp_piecewise piecewise_C1_differentiable_diff)
   show "valid_path (\<lambda>t. g t - z) \<Longrightarrow> valid_path g"
     using *[of "\<lambda>t. g t - z" "-z",simplified] .
 qed
   
 
 subsection\<open>Contour Integrals along a path\<close>
 
 text\<open>This definition is for complex numbers only, and does not generalise to line integrals in a vector field\<close>
 
 text\<open>piecewise differentiable function on [0,1]\<close>
 
 definition\<^marker>\<open>tag important\<close> has_contour_integral :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> (real \<Rightarrow> complex) \<Rightarrow> bool"
            (infixr "has'_contour'_integral" 50)
   where "(f has_contour_integral i) g \<equiv>
            ((\<lambda>x. f(g x) * vector_derivative g (at x within {0..1}))
             has_integral i) {0..1}"
 
 definition\<^marker>\<open>tag important\<close> contour_integrable_on
            (infixr "contour'_integrable'_on" 50)
   where "f contour_integrable_on g \<equiv> \<exists>i. (f has_contour_integral i) g"
 
 definition\<^marker>\<open>tag important\<close> contour_integral
   where "contour_integral g f \<equiv> SOME i. (f has_contour_integral i) g \<or> \<not> f contour_integrable_on g \<and> i=0"
 
 lemma not_integrable_contour_integral: "\<not> f contour_integrable_on g \<Longrightarrow> contour_integral g f = 0"
   unfolding contour_integrable_on_def contour_integral_def by blast
 
 lemma contour_integral_unique: "(f has_contour_integral i) g \<Longrightarrow> contour_integral g f = i"
   apply (simp add: contour_integral_def has_contour_integral_def contour_integrable_on_def)
   using has_integral_unique by blast
 
 lemma has_contour_integral_eqpath:
      "\<lbrakk>(f has_contour_integral y) p; f contour_integrable_on \<gamma>;
        contour_integral p f = contour_integral \<gamma> f\<rbrakk>
       \<Longrightarrow> (f has_contour_integral y) \<gamma>"
 using contour_integrable_on_def contour_integral_unique by auto
 
 lemma has_contour_integral_integral:
     "f contour_integrable_on i \<Longrightarrow> (f has_contour_integral (contour_integral i f)) i"
   by (metis contour_integral_unique contour_integrable_on_def)
 
 lemma has_contour_integral_unique:
     "(f has_contour_integral i) g \<Longrightarrow> (f has_contour_integral j) g \<Longrightarrow> i = j"
   using has_integral_unique
   by (auto simp: has_contour_integral_def)
 
 lemma has_contour_integral_integrable: "(f has_contour_integral i) g \<Longrightarrow> f contour_integrable_on g"
   using contour_integrable_on_def by blast
 
 text\<open>Show that we can forget about the localized derivative.\<close>
 
 lemma has_integral_localized_vector_derivative:
     "((\<lambda>x. f (g x) * vector_derivative g (at x within {a..b})) has_integral i) {a..b} \<longleftrightarrow>
      ((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {a..b}"
 proof -
   have *: "{a..b} - {a,b} = interior {a..b}"
     by (simp add: atLeastAtMost_diff_ends)
   show ?thesis
     apply (rule has_integral_spike_eq [of "{a,b}"])
     apply (auto simp: at_within_interior [of _ "{a..b}"])
     done
 qed
 
 lemma integrable_on_localized_vector_derivative:
     "(\<lambda>x. f (g x) * vector_derivative g (at x within {a..b})) integrable_on {a..b} \<longleftrightarrow>
      (\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on {a..b}"
   by (simp add: integrable_on_def has_integral_localized_vector_derivative)
 
 lemma has_contour_integral:
      "(f has_contour_integral i) g \<longleftrightarrow>
       ((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {0..1}"
   by (simp add: has_integral_localized_vector_derivative has_contour_integral_def)
 
 lemma contour_integrable_on:
      "f contour_integrable_on g \<longleftrightarrow>
       (\<lambda>t. f(g t) * vector_derivative g (at t)) integrable_on {0..1}"
   by (simp add: has_contour_integral integrable_on_def contour_integrable_on_def)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Reversing a path\<close>
 
 lemma valid_path_imp_reverse:
   assumes "valid_path g"
     shows "valid_path(reversepath g)"
 proof -
   obtain S where "finite S" and S: "g C1_differentiable_on ({0..1} - S)"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   then have "finite ((-) 1 ` S)"
     by auto
   moreover have "(reversepath g C1_differentiable_on ({0..1} - (-) 1 ` S))"
     unfolding reversepath_def
     apply (rule C1_differentiable_compose [of "\<lambda>x::real. 1-x" _ g, unfolded o_def])
     using S
-    by (force simp: finite_vimageI inj_on_def C1_differentiable_on_eq continuous_on_const elim!: continuous_on_subset)+
+    by (force simp: finite_vimageI inj_on_def C1_differentiable_on_eq elim!: continuous_on_subset)+
   ultimately show ?thesis using assms
     by (auto simp: valid_path_def piecewise_C1_differentiable_on_def path_def [symmetric])
 qed
 
 lemma valid_path_reversepath [simp]: "valid_path(reversepath g) \<longleftrightarrow> valid_path g"
   using valid_path_imp_reverse by force
 
 lemma has_contour_integral_reversepath:
   assumes "valid_path g" and f: "(f has_contour_integral i) g"
     shows "(f has_contour_integral (-i)) (reversepath g)"
 proof -
   { fix S x
     assume xs: "g C1_differentiable_on ({0..1} - S)" "x \<notin> (-) 1 ` S" "0 \<le> x" "x \<le> 1"
     have "vector_derivative (\<lambda>x. g (1 - x)) (at x within {0..1}) =
             - vector_derivative g (at (1 - x) within {0..1})"
     proof -
       obtain f' where f': "(g has_vector_derivative f') (at (1 - x))"
         using xs
         by (force simp: has_vector_derivative_def C1_differentiable_on_def)
       have "(g \<circ> (\<lambda>x. 1 - x) has_vector_derivative -1 *\<^sub>R f') (at x)"
         by (intro vector_diff_chain_within has_vector_derivative_at_within [OF f'] derivative_eq_intros | simp)+
       then have mf': "((\<lambda>x. g (1 - x)) has_vector_derivative -f') (at x)"
         by (simp add: o_def)
       show ?thesis
         using xs
         by (auto simp: vector_derivative_at_within_ivl [OF mf'] vector_derivative_at_within_ivl [OF f'])
     qed
   } note * = this
   obtain S where S: "continuous_on {0..1} g" "finite S" "g C1_differentiable_on {0..1} - S"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have "((\<lambda>x. - (f (g (1 - x)) * vector_derivative g (at (1 - x) within {0..1}))) has_integral -i)
        {0..1}"
     using has_integral_affinity01 [where m= "-1" and c=1, OF f [unfolded has_contour_integral_def]]
     by (simp add: has_integral_neg)
   then show ?thesis
     using S
     apply (clarsimp simp: reversepath_def has_contour_integral_def)
     apply (rule_tac S = "(\<lambda>x. 1 - x) ` S" in has_integral_spike_finite)
       apply (auto simp: *)
     done
 qed
 
 lemma contour_integrable_reversepath:
     "valid_path g \<Longrightarrow> f contour_integrable_on g \<Longrightarrow> f contour_integrable_on (reversepath g)"
   using has_contour_integral_reversepath contour_integrable_on_def by blast
 
 lemma contour_integrable_reversepath_eq:
     "valid_path g \<Longrightarrow> (f contour_integrable_on (reversepath g) \<longleftrightarrow> f contour_integrable_on g)"
   using contour_integrable_reversepath valid_path_reversepath by fastforce
 
 lemma contour_integral_reversepath:
   assumes "valid_path g"
     shows "contour_integral (reversepath g) f = - (contour_integral g f)"
 proof (cases "f contour_integrable_on g")
   case True then show ?thesis
     by (simp add: assms contour_integral_unique has_contour_integral_integral has_contour_integral_reversepath)
 next
   case False then have "\<not> f contour_integrable_on (reversepath g)"
     by (simp add: assms contour_integrable_reversepath_eq)
   with False show ?thesis by (simp add: not_integrable_contour_integral)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Joining two paths together\<close>
 
 lemma valid_path_join:
   assumes "valid_path g1" "valid_path g2" "pathfinish g1 = pathstart g2"
     shows "valid_path(g1 +++ g2)"
 proof -
   have "g1 1 = g2 0"
     using assms by (auto simp: pathfinish_def pathstart_def)
   moreover have "(g1 \<circ> (\<lambda>x. 2*x)) piecewise_C1_differentiable_on {0..1/2}"
     apply (rule piecewise_C1_differentiable_compose)
     using assms
     apply (auto simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_joinpaths)
     apply (force intro: finite_vimageI [where h = "(*)2"] inj_onI)
     done
   moreover have "(g2 \<circ> (\<lambda>x. 2*x-1)) piecewise_C1_differentiable_on {1/2..1}"
     apply (rule piecewise_C1_differentiable_compose)
     using assms unfolding valid_path_def piecewise_C1_differentiable_on_def
     by (auto intro!: continuous_intros finite_vimageI [where h = "(\<lambda>x. 2*x - 1)"] inj_onI
              simp: image_affinity_atLeastAtMost_diff continuous_on_joinpaths)
   ultimately show ?thesis
     apply (simp only: valid_path_def continuous_on_joinpaths joinpaths_def)
     apply (rule piecewise_C1_differentiable_cases)
     apply (auto simp: o_def)
     done
 qed
 
 lemma valid_path_join_D1:
   fixes g1 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "valid_path (g1 +++ g2) \<Longrightarrow> valid_path g1"
   unfolding valid_path_def
   by (rule piecewise_C1_differentiable_D1)
 
 lemma valid_path_join_D2:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "\<lbrakk>valid_path (g1 +++ g2); pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> valid_path g2"
   unfolding valid_path_def
   by (rule piecewise_C1_differentiable_D2)
 
 lemma valid_path_join_eq [simp]:
   fixes g2 :: "real \<Rightarrow> 'a::real_normed_field"
   shows "pathfinish g1 = pathstart g2 \<Longrightarrow> (valid_path(g1 +++ g2) \<longleftrightarrow> valid_path g1 \<and> valid_path g2)"
   using valid_path_join_D1 valid_path_join_D2 valid_path_join by blast
 
 lemma has_contour_integral_join:
   assumes "(f has_contour_integral i1) g1" "(f has_contour_integral i2) g2"
           "valid_path g1" "valid_path g2"
     shows "(f has_contour_integral (i1 + i2)) (g1 +++ g2)"
 proof -
   obtain s1 s2
     where s1: "finite s1" "\<forall>x\<in>{0..1} - s1. g1 differentiable at x"
       and s2: "finite s2" "\<forall>x\<in>{0..1} - s2. g2 differentiable at x"
     using assms
     by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have 1: "((\<lambda>x. f (g1 x) * vector_derivative g1 (at x)) has_integral i1) {0..1}"
    and 2: "((\<lambda>x. f (g2 x) * vector_derivative g2 (at x)) has_integral i2) {0..1}"
     using assms
     by (auto simp: has_contour_integral)
   have i1: "((\<lambda>x. (2*f (g1 (2*x))) * vector_derivative g1 (at (2*x))) has_integral i1) {0..1/2}"
    and i2: "((\<lambda>x. (2*f (g2 (2*x - 1))) * vector_derivative g2 (at (2*x - 1))) has_integral i2) {1/2..1}"
     using has_integral_affinity01 [OF 1, where m= 2 and c=0, THEN has_integral_cmul [where c=2]]
           has_integral_affinity01 [OF 2, where m= 2 and c="-1", THEN has_integral_cmul [where c=2]]
     by (simp_all only: image_affinity_atLeastAtMost_div_diff, simp_all add: scaleR_conv_of_real mult_ac)
   have g1: "\<lbrakk>0 \<le> z; z*2 < 1; z*2 \<notin> s1\<rbrakk> \<Longrightarrow>
             vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at z) =
             2 *\<^sub>R vector_derivative g1 (at (z*2))" for z
     apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g1(2*x))" and d = "\<bar>z - 1/2\<bar>"]])
     apply (simp_all add: dist_real_def abs_if split: if_split_asm)
     apply (rule vector_diff_chain_at [of "\<lambda>x. 2*x" 2 _ g1, simplified o_def])
     apply (simp add: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     using s1
     apply (auto simp: algebra_simps vector_derivative_works)
     done
   have g2: "\<lbrakk>1 < z*2; z \<le> 1; z*2 - 1 \<notin> s2\<rbrakk> \<Longrightarrow>
             vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at z) =
             2 *\<^sub>R vector_derivative g2 (at (z*2 - 1))" for z
     apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g2 (2*x - 1))" and d = "\<bar>z - 1/2\<bar>"]])
     apply (simp_all add: dist_real_def abs_if split: if_split_asm)
     apply (rule vector_diff_chain_at [of "\<lambda>x. 2*x - 1" 2 _ g2, simplified o_def])
     apply (simp add: has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     using s2
     apply (auto simp: algebra_simps vector_derivative_works)
     done
   have "((\<lambda>x. f ((g1 +++ g2) x) * vector_derivative (g1 +++ g2) (at x)) has_integral i1) {0..1/2}"
     apply (rule has_integral_spike_finite [OF _ _ i1, of "insert (1/2) ((*)2 -` s1)"])
     using s1
     apply (force intro: finite_vimageI [where h = "(*)2"] inj_onI)
     apply (clarsimp simp add: joinpaths_def scaleR_conv_of_real mult_ac g1)
     done
   moreover have "((\<lambda>x. f ((g1 +++ g2) x) * vector_derivative (g1 +++ g2) (at x)) has_integral i2) {1/2..1}"
     apply (rule has_integral_spike_finite [OF _ _ i2, of "insert (1/2) ((\<lambda>x. 2*x-1) -` s2)"])
     using s2
     apply (force intro: finite_vimageI [where h = "\<lambda>x. 2*x-1"] inj_onI)
     apply (clarsimp simp add: joinpaths_def scaleR_conv_of_real mult_ac g2)
     done
   ultimately
   show ?thesis
     apply (simp add: has_contour_integral)
     apply (rule has_integral_combine [where c = "1/2"], auto)
     done
 qed
 
 lemma contour_integrable_joinI:
   assumes "f contour_integrable_on g1" "f contour_integrable_on g2"
           "valid_path g1" "valid_path g2"
     shows "f contour_integrable_on (g1 +++ g2)"
   using assms
   by (meson has_contour_integral_join contour_integrable_on_def)
 
 lemma contour_integrable_joinD1:
   assumes "f contour_integrable_on (g1 +++ g2)" "valid_path g1"
     shows "f contour_integrable_on g1"
 proof -
   obtain s1
     where s1: "finite s1" "\<forall>x\<in>{0..1} - s1. g1 differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have "(\<lambda>x. f ((g1 +++ g2) (x/2)) * vector_derivative (g1 +++ g2) (at (x/2))) integrable_on {0..1}"
     using assms
     apply (auto simp: contour_integrable_on)
     apply (drule integrable_on_subcbox [where a=0 and b="1/2"])
     apply (auto intro: integrable_affinity [of _ 0 "1/2::real" "1/2" 0, simplified])
     done
   then have *: "(\<lambda>x. (f ((g1 +++ g2) (x/2))/2) * vector_derivative (g1 +++ g2) (at (x/2))) integrable_on {0..1}"
     by (auto dest: integrable_cmul [where c="1/2"] simp: scaleR_conv_of_real)
   have g1: "\<lbrakk>0 < z; z < 1; z \<notin> s1\<rbrakk> \<Longrightarrow>
             vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at (z/2)) =
             2 *\<^sub>R vector_derivative g1 (at z)"  for z
     apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g1(2*x))" and d = "\<bar>(z-1)/2\<bar>"]])
     apply (simp_all add: field_simps dist_real_def abs_if split: if_split_asm)
     apply (rule vector_diff_chain_at [of "\<lambda>x. x*2" 2 _ g1, simplified o_def])
     using s1
     apply (auto simp: vector_derivative_works has_vector_derivative_def has_derivative_def bounded_linear_mult_left)
     done
   show ?thesis
     using s1
     apply (auto simp: contour_integrable_on)
     apply (rule integrable_spike_finite [of "{0,1} \<union> s1", OF _ _ *])
     apply (auto simp: joinpaths_def scaleR_conv_of_real g1)
     done
 qed
 
 lemma contour_integrable_joinD2:
   assumes "f contour_integrable_on (g1 +++ g2)" "valid_path g2"
     shows "f contour_integrable_on g2"
 proof -
   obtain s2
     where s2: "finite s2" "\<forall>x\<in>{0..1} - s2. g2 differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have "(\<lambda>x. f ((g1 +++ g2) (x/2 + 1/2)) * vector_derivative (g1 +++ g2) (at (x/2 + 1/2))) integrable_on {0..1}"
     using assms
     apply (auto simp: contour_integrable_on)
     apply (drule integrable_on_subcbox [where a="1/2" and b=1], auto)
     apply (drule integrable_affinity [of _ "1/2::real" 1 "1/2" "1/2", simplified])
     apply (simp add: image_affinity_atLeastAtMost_diff)
     done
   then have *: "(\<lambda>x. (f ((g1 +++ g2) (x/2 + 1/2))/2) * vector_derivative (g1 +++ g2) (at (x/2 + 1/2)))
                 integrable_on {0..1}"
     by (auto dest: integrable_cmul [where c="1/2"] simp: scaleR_conv_of_real)
   have g2: "\<lbrakk>0 < z; z < 1; z \<notin> s2\<rbrakk> \<Longrightarrow>
             vector_derivative (\<lambda>x. if x*2 \<le> 1 then g1 (2*x) else g2 (2*x - 1)) (at (z/2+1/2)) =
             2 *\<^sub>R vector_derivative g2 (at z)" for z
     apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g2(2*x-1))" and d = "\<bar>z/2\<bar>"]])
     apply (simp_all add: field_simps dist_real_def abs_if split: if_split_asm)
     apply (rule vector_diff_chain_at [of "\<lambda>x. x*2-1" 2 _ g2, simplified o_def])
     using s2
     apply (auto simp: has_vector_derivative_def has_derivative_def bounded_linear_mult_left
                       vector_derivative_works add_divide_distrib)
     done
   show ?thesis
     using s2
     apply (auto simp: contour_integrable_on)
     apply (rule integrable_spike_finite [of "{0,1} \<union> s2", OF _ _ *])
     apply (auto simp: joinpaths_def scaleR_conv_of_real g2)
     done
 qed
 
 lemma contour_integrable_join [simp]:
   shows
     "\<lbrakk>valid_path g1; valid_path g2\<rbrakk>
      \<Longrightarrow> f contour_integrable_on (g1 +++ g2) \<longleftrightarrow> f contour_integrable_on g1 \<and> f contour_integrable_on g2"
 using contour_integrable_joinD1 contour_integrable_joinD2 contour_integrable_joinI by blast
 
 lemma contour_integral_join [simp]:
   shows
     "\<lbrakk>f contour_integrable_on g1; f contour_integrable_on g2; valid_path g1; valid_path g2\<rbrakk>
         \<Longrightarrow> contour_integral (g1 +++ g2) f = contour_integral g1 f + contour_integral g2 f"
   by (simp add: has_contour_integral_integral has_contour_integral_join contour_integral_unique)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Shifting the starting point of a (closed) path\<close>
 
 lemma shiftpath_alt_def: "shiftpath a f = (\<lambda>x. if x \<le> 1-a then f (a + x) else f (a + x - 1))"
   by (auto simp: shiftpath_def)
 
 lemma valid_path_shiftpath [intro]:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "valid_path(shiftpath a g)"
   using assms
   apply (auto simp: valid_path_def shiftpath_alt_def)
   apply (rule piecewise_C1_differentiable_cases)
   apply (auto simp: algebra_simps)
   apply (rule piecewise_C1_differentiable_affine [of g 1 a, simplified o_def scaleR_one])
   apply (auto simp: pathfinish_def pathstart_def elim: piecewise_C1_differentiable_on_subset)
   apply (rule piecewise_C1_differentiable_affine [of g 1 "a-1", simplified o_def scaleR_one algebra_simps])
   apply (auto simp: pathfinish_def pathstart_def elim: piecewise_C1_differentiable_on_subset)
   done
 
 lemma has_contour_integral_shiftpath:
   assumes f: "(f has_contour_integral i) g" "valid_path g"
       and a: "a \<in> {0..1}"
     shows "(f has_contour_integral i) (shiftpath a g)"
 proof -
   obtain s
     where s: "finite s" and g: "\<forall>x\<in>{0..1} - s. g differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have *: "((\<lambda>x. f (g x) * vector_derivative g (at x)) has_integral i) {0..1}"
     using assms by (auto simp: has_contour_integral)
   then have i: "i = integral {a..1} (\<lambda>x. f (g x) * vector_derivative g (at x)) +
                     integral {0..a} (\<lambda>x. f (g x) * vector_derivative g (at x))"
     apply (rule has_integral_unique)
     apply (subst add.commute)
     apply (subst integral_combine)
     using assms * integral_unique by auto
   { fix x
     have "0 \<le> x \<Longrightarrow> x + a < 1 \<Longrightarrow> x \<notin> (\<lambda>x. x - a) ` s \<Longrightarrow>
          vector_derivative (shiftpath a g) (at x) = vector_derivative g (at (x + a))"
       unfolding shiftpath_def
       apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g(a+x))" and d = "dist(1-a) x"]])
         apply (auto simp: field_simps dist_real_def abs_if split: if_split_asm)
       apply (rule vector_diff_chain_at [of "\<lambda>x. x+a" 1 _ g, simplified o_def scaleR_one])
        apply (intro derivative_eq_intros | simp)+
       using g
        apply (drule_tac x="x+a" in bspec)
       using a apply (auto simp: has_vector_derivative_def vector_derivative_works image_def add.commute)
       done
   } note vd1 = this
   { fix x
     have "1 < x + a \<Longrightarrow> x \<le> 1 \<Longrightarrow> x \<notin> (\<lambda>x. x - a + 1) ` s \<Longrightarrow>
           vector_derivative (shiftpath a g) (at x) = vector_derivative g (at (x + a - 1))"
       unfolding shiftpath_def
       apply (rule vector_derivative_at [OF has_vector_derivative_transform_within [where f = "(\<lambda>x. g(a+x-1))" and d = "dist (1-a) x"]])
         apply (auto simp: field_simps dist_real_def abs_if split: if_split_asm)
       apply (rule vector_diff_chain_at [of "\<lambda>x. x+a-1" 1 _ g, simplified o_def scaleR_one])
        apply (intro derivative_eq_intros | simp)+
       using g
       apply (drule_tac x="x+a-1" in bspec)
       using a apply (auto simp: has_vector_derivative_def vector_derivative_works image_def add.commute)
       done
   } note vd2 = this
   have va1: "(\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on ({a..1})"
     using * a   by (fastforce intro: integrable_subinterval_real)
   have v0a: "(\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on ({0..a})"
     apply (rule integrable_subinterval_real)
     using * a by auto
   have "((\<lambda>x. f (shiftpath a g x) * vector_derivative (shiftpath a g) (at x))
         has_integral  integral {a..1} (\<lambda>x. f (g x) * vector_derivative g (at x)))  {0..1 - a}"
     apply (rule has_integral_spike_finite
              [where S = "{1-a} \<union> (\<lambda>x. x-a) ` s" and f = "\<lambda>x. f(g(a+x)) * vector_derivative g (at(a+x))"])
       using s apply blast
      using a apply (auto simp: algebra_simps vd1)
      apply (force simp: shiftpath_def add.commute)
     using has_integral_affinity [where m=1 and c=a, simplified, OF integrable_integral [OF va1]]
     apply (simp add: image_affinity_atLeastAtMost_diff [where m=1 and c=a, simplified] add.commute)
     done
   moreover
   have "((\<lambda>x. f (shiftpath a g x) * vector_derivative (shiftpath a g) (at x))
         has_integral  integral {0..a} (\<lambda>x. f (g x) * vector_derivative g (at x)))  {1 - a..1}"
     apply (rule has_integral_spike_finite
              [where S = "{1-a} \<union> (\<lambda>x. x-a+1) ` s" and f = "\<lambda>x. f(g(a+x-1)) * vector_derivative g (at(a+x-1))"])
       using s apply blast
      using a apply (auto simp: algebra_simps vd2)
      apply (force simp: shiftpath_def add.commute)
     using has_integral_affinity [where m=1 and c="a-1", simplified, OF integrable_integral [OF v0a]]
     apply (simp add: image_affinity_atLeastAtMost [where m=1 and c="1-a", simplified])
     apply (simp add: algebra_simps)
     done
   ultimately show ?thesis
     using a
     by (auto simp: i has_contour_integral intro: has_integral_combine [where c = "1-a"])
 qed
 
 lemma has_contour_integral_shiftpath_D:
   assumes "(f has_contour_integral i) (shiftpath a g)"
           "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "(f has_contour_integral i) g"
 proof -
   obtain s
     where s: "finite s" and g: "\<forall>x\<in>{0..1} - s. g differentiable at x"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   { fix x
     assume x: "0 < x" "x < 1" "x \<notin> s"
     then have gx: "g differentiable at x"
       using g by auto
     have "vector_derivative g (at x within {0..1}) =
           vector_derivative (shiftpath (1 - a) (shiftpath a g)) (at x within {0..1})"
       apply (rule vector_derivative_at_within_ivl
                   [OF has_vector_derivative_transform_within_open
                       [where f = "(shiftpath (1 - a) (shiftpath a g))" and S = "{0<..<1}-s"]])
       using s g assms x
       apply (auto simp: finite_imp_closed open_Diff shiftpath_shiftpath
                         at_within_interior [of _ "{0..1}"] vector_derivative_works [symmetric])
       apply (rule differentiable_transform_within [OF gx, of "min x (1-x)"])
       apply (auto simp: dist_real_def shiftpath_shiftpath abs_if split: if_split_asm)
       done
   } note vd = this
   have fi: "(f has_contour_integral i) (shiftpath (1 - a) (shiftpath a g))"
     using assms  by (auto intro!: has_contour_integral_shiftpath)
   show ?thesis
     apply (simp add: has_contour_integral_def)
     apply (rule has_integral_spike_finite [of "{0,1} \<union> s", OF _ _  fi [unfolded has_contour_integral_def]])
     using s assms vd
     apply (auto simp: Path_Connected.shiftpath_shiftpath)
     done
 qed
 
 lemma has_contour_integral_shiftpath_eq:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "(f has_contour_integral i) (shiftpath a g) \<longleftrightarrow> (f has_contour_integral i) g"
   using assms has_contour_integral_shiftpath has_contour_integral_shiftpath_D by blast
 
 lemma contour_integrable_on_shiftpath_eq:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "f contour_integrable_on (shiftpath a g) \<longleftrightarrow> f contour_integrable_on g"
 using assms contour_integrable_on_def has_contour_integral_shiftpath_eq by auto
 
 lemma contour_integral_shiftpath:
   assumes "valid_path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
     shows "contour_integral (shiftpath a g) f = contour_integral g f"
    using assms
    by (simp add: contour_integral_def contour_integrable_on_def has_contour_integral_shiftpath_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More about straight-line paths\<close>
 
 lemma has_vector_derivative_linepath_within:
     "(linepath a b has_vector_derivative (b - a)) (at x within s)"
 apply (simp add: linepath_def has_vector_derivative_def algebra_simps)
 apply (rule derivative_eq_intros | simp)+
 done
 
 lemma vector_derivative_linepath_within:
     "x \<in> {0..1} \<Longrightarrow> vector_derivative (linepath a b) (at x within {0..1}) = b - a"
   apply (rule vector_derivative_within_cbox [of 0 "1::real", simplified])
   apply (auto simp: has_vector_derivative_linepath_within)
   done
 
 lemma vector_derivative_linepath_at [simp]: "vector_derivative (linepath a b) (at x) = b - a"
   by (simp add: has_vector_derivative_linepath_within vector_derivative_at)
 
 lemma valid_path_linepath [iff]: "valid_path (linepath a b)"
   apply (simp add: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq continuous_on_linepath)
   apply (rule_tac x="{}" in exI)
   apply (simp add: differentiable_on_def differentiable_def)
   using has_vector_derivative_def has_vector_derivative_linepath_within
   apply (fastforce simp add: continuous_on_eq_continuous_within)
   done
 
 lemma has_contour_integral_linepath:
   shows "(f has_contour_integral i) (linepath a b) \<longleftrightarrow>
          ((\<lambda>x. f(linepath a b x) * (b - a)) has_integral i) {0..1}"
-  by (simp add: has_contour_integral vector_derivative_linepath_at)
+  by (simp add: has_contour_integral)
 
 lemma linepath_in_path:
   shows "x \<in> {0..1} \<Longrightarrow> linepath a b x \<in> closed_segment a b"
   by (auto simp: segment linepath_def)
 
 lemma linepath_image_01: "linepath a b ` {0..1} = closed_segment a b"
   by (auto simp: segment linepath_def)
 
 lemma linepath_in_convex_hull:
     fixes x::real
     assumes a: "a \<in> convex hull s"
         and b: "b \<in> convex hull s"
         and x: "0\<le>x" "x\<le>1"
        shows "linepath a b x \<in> convex hull s"
   apply (rule closed_segment_subset_convex_hull [OF a b, THEN subsetD])
   using x
   apply (auto simp: linepath_image_01 [symmetric])
   done
 
 lemma Re_linepath: "Re(linepath (of_real a) (of_real b) x) = (1 - x)*a + x*b"
   by (simp add: linepath_def)
 
 lemma Im_linepath: "Im(linepath (of_real a) (of_real b) x) = 0"
   by (simp add: linepath_def)
 
 lemma has_contour_integral_trivial [iff]: "(f has_contour_integral 0) (linepath a a)"
   by (simp add: has_contour_integral_linepath)
 
 lemma has_contour_integral_trivial_iff [simp]: "(f has_contour_integral i) (linepath a a) \<longleftrightarrow> i=0"
   using has_contour_integral_unique by blast
 
 lemma contour_integral_trivial [simp]: "contour_integral (linepath a a) f = 0"
   using has_contour_integral_trivial contour_integral_unique by blast
 
 lemma differentiable_linepath [intro]: "linepath a b differentiable at x within A"
   by (auto simp: linepath_def)
 
 lemma bounded_linear_linepath:
   assumes "bounded_linear f"
   shows   "f (linepath a b x) = linepath (f a) (f b) x"
 proof -
   interpret f: bounded_linear f by fact
   show ?thesis by (simp add: linepath_def f.add f.scale)
 qed
 
 lemma bounded_linear_linepath':
   assumes "bounded_linear f"
   shows   "f \<circ> linepath a b = linepath (f a) (f b)"
   using bounded_linear_linepath[OF assms] by (simp add: fun_eq_iff)
 
 lemma cnj_linepath: "cnj (linepath a b x) = linepath (cnj a) (cnj b) x"
   by (simp add: linepath_def)
 
 lemma cnj_linepath': "cnj \<circ> linepath a b = linepath (cnj a) (cnj b)"
   by (simp add: linepath_def fun_eq_iff)
 
 subsection\<open>Relation to subpath construction\<close>
 
 lemma valid_path_subpath:
   fixes g :: "real \<Rightarrow> 'a :: real_normed_vector"
   assumes "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "valid_path(subpath u v g)"
 proof (cases "v=u")
   case True
   then show ?thesis
     unfolding valid_path_def subpath_def
     by (force intro: C1_differentiable_on_const C1_differentiable_imp_piecewise)
 next
   case False
   have "(g \<circ> (\<lambda>x. ((v-u) * x + u))) piecewise_C1_differentiable_on {0..1}"
     apply (rule piecewise_C1_differentiable_compose)
     apply (simp add: C1_differentiable_imp_piecewise)
      apply (simp add: image_affinity_atLeastAtMost)
     using assms False
     apply (auto simp: algebra_simps valid_path_def piecewise_C1_differentiable_on_subset)
     apply (subst Int_commute)
     apply (auto simp: inj_on_def algebra_simps crossproduct_eq finite_vimage_IntI)
     done
   then show ?thesis
     by (auto simp: o_def valid_path_def subpath_def)
 qed
 
 lemma has_contour_integral_subpath_refl [iff]: "(f has_contour_integral 0) (subpath u u g)"
   by (simp add: has_contour_integral subpath_def)
 
 lemma contour_integrable_subpath_refl [iff]: "f contour_integrable_on (subpath u u g)"
   using has_contour_integral_subpath_refl contour_integrable_on_def by blast
 
 lemma contour_integral_subpath_refl [simp]: "contour_integral (subpath u u g) f = 0"
-  by (simp add: has_contour_integral_subpath_refl contour_integral_unique)
+  by (simp add: contour_integral_unique)
 
 lemma has_contour_integral_subpath:
   assumes f: "f contour_integrable_on g" and g: "valid_path g"
       and uv: "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "(f has_contour_integral  integral {u..v} (\<lambda>x. f(g x) * vector_derivative g (at x)))
            (subpath u v g)"
 proof (cases "v=u")
   case True
   then show ?thesis
     using f   by (simp add: contour_integrable_on_def subpath_def has_contour_integral)
 next
   case False
   obtain s where s: "\<And>x. x \<in> {0..1} - s \<Longrightarrow> g differentiable at x" and fs: "finite s"
     using g unfolding piecewise_C1_differentiable_on_def C1_differentiable_on_eq valid_path_def by blast
   have *: "((\<lambda>x. f (g ((v - u) * x + u)) * vector_derivative g (at ((v - u) * x + u)))
             has_integral (1 / (v - u)) * integral {u..v} (\<lambda>t. f (g t) * vector_derivative g (at t)))
            {0..1}"
     using f uv
     apply (simp add: contour_integrable_on subpath_def has_contour_integral)
     apply (drule integrable_on_subcbox [where a=u and b=v, simplified])
     apply (simp_all add: has_integral_integral)
     apply (drule has_integral_affinity [where m="v-u" and c=u, simplified])
     apply (simp_all add: False image_affinity_atLeastAtMost_div_diff scaleR_conv_of_real)
     apply (simp add: divide_simps False)
     done
   { fix x
     have "x \<in> {0..1} \<Longrightarrow>
            x \<notin> (\<lambda>t. (v-u) *\<^sub>R t + u) -` s \<Longrightarrow>
            vector_derivative (\<lambda>x. g ((v-u) * x + u)) (at x) = (v-u) *\<^sub>R vector_derivative g (at ((v-u) * x + u))"
       apply (rule vector_derivative_at [OF vector_diff_chain_at [simplified o_def]])
       apply (intro derivative_eq_intros | simp)+
       apply (cut_tac s [of "(v - u) * x + u"])
       using uv mult_left_le [of x "v-u"]
       apply (auto simp:  vector_derivative_works)
       done
   } note vd = this
   show ?thesis
     apply (cut_tac has_integral_cmul [OF *, where c = "v-u"])
     using fs assms
     apply (simp add: False subpath_def has_contour_integral)
     apply (rule_tac S = "(\<lambda>t. ((v-u) *\<^sub>R t + u)) -` s" in has_integral_spike_finite)
     apply (auto simp: inj_on_def False finite_vimageI vd scaleR_conv_of_real)
     done
 qed
 
 lemma contour_integrable_subpath:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "f contour_integrable_on (subpath u v g)"
   apply (cases u v rule: linorder_class.le_cases)
    apply (metis contour_integrable_on_def has_contour_integral_subpath [OF assms])
   apply (subst reversepath_subpath [symmetric])
   apply (rule contour_integrable_reversepath)
    using assms apply (blast intro: valid_path_subpath)
   apply (simp add: contour_integrable_on_def)
   using assms apply (blast intro: has_contour_integral_subpath)
   done
 
 lemma has_integral_contour_integral_subpath:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "(((\<lambda>x. f(g x) * vector_derivative g (at x)))
             has_integral  contour_integral (subpath u v g) f) {u..v}"
   using assms
   apply (auto simp: has_integral_integrable_integral)
   apply (rule integrable_on_subcbox [where a=u and b=v and S = "{0..1}", simplified])
   apply (auto simp: contour_integral_unique [OF has_contour_integral_subpath] contour_integrable_on)
   done
 
 lemma contour_integral_subcontour_integral:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<le> v"
     shows "contour_integral (subpath u v g) f =
            integral {u..v} (\<lambda>x. f(g x) * vector_derivative g (at x))"
   using assms has_contour_integral_subpath contour_integral_unique by blast
 
 lemma contour_integral_subpath_combine_less:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "w \<in> {0..1}"
           "u<v" "v<w"
     shows "contour_integral (subpath u v g) f + contour_integral (subpath v w g) f =
            contour_integral (subpath u w g) f"
   using assms apply (auto simp: contour_integral_subcontour_integral)
   apply (rule integral_combine, auto)
   apply (rule integrable_on_subcbox [where a=u and b=w and S = "{0..1}", simplified])
   apply (auto simp: contour_integrable_on)
   done
 
 lemma contour_integral_subpath_combine:
   assumes "f contour_integrable_on g" "valid_path g" "u \<in> {0..1}" "v \<in> {0..1}" "w \<in> {0..1}"
     shows "contour_integral (subpath u v g) f + contour_integral (subpath v w g) f =
            contour_integral (subpath u w g) f"
 proof (cases "u\<noteq>v \<and> v\<noteq>w \<and> u\<noteq>w")
   case True
     have *: "subpath v u g = reversepath(subpath u v g) \<and>
              subpath w u g = reversepath(subpath u w g) \<and>
              subpath w v g = reversepath(subpath v w g)"
       by (auto simp: reversepath_subpath)
     have "u < v \<and> v < w \<or>
           u < w \<and> w < v \<or>
           v < u \<and> u < w \<or>
           v < w \<and> w < u \<or>
           w < u \<and> u < v \<or>
           w < v \<and> v < u"
       using True assms by linarith
     with assms show ?thesis
       using contour_integral_subpath_combine_less [of f g u v w]
             contour_integral_subpath_combine_less [of f g u w v]
             contour_integral_subpath_combine_less [of f g v u w]
             contour_integral_subpath_combine_less [of f g v w u]
             contour_integral_subpath_combine_less [of f g w u v]
             contour_integral_subpath_combine_less [of f g w v u]
       apply simp
       apply (elim disjE)
       apply (auto simp: * contour_integral_reversepath contour_integrable_subpath
-                   valid_path_reversepath valid_path_subpath algebra_simps)
+               valid_path_subpath algebra_simps)
       done
 next
   case False
   then show ?thesis
-    apply (auto simp: contour_integral_subpath_refl)
+    apply (auto)
     using assms
-    by (metis eq_neg_iff_add_eq_0 contour_integrable_subpath contour_integral_reversepath reversepath_subpath valid_path_subpath)
+    by (metis eq_neg_iff_add_eq_0 contour_integral_reversepath reversepath_subpath valid_path_subpath)
 qed
 
 lemma contour_integral_integral:
      "contour_integral g f = integral {0..1} (\<lambda>x. f (g x) * vector_derivative g (at x))"
   by (simp add: contour_integral_def integral_def has_contour_integral contour_integrable_on)
 
 lemma contour_integral_cong:
   assumes "g = g'" "\<And>x. x \<in> path_image g \<Longrightarrow> f x = f' x"
   shows   "contour_integral g f = contour_integral g' f'"
   unfolding contour_integral_integral using assms
   by (intro integral_cong) (auto simp: path_image_def)
 
 
 text \<open>Contour integral along a segment on the real axis\<close>
 
 lemma has_contour_integral_linepath_Reals_iff:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "(f has_contour_integral I) (linepath a b) \<longleftrightarrow>
              ((\<lambda>x. f (of_real x)) has_integral I) {Re a..Re b}"
 proof -
   from assms have [simp]: "of_real (Re a) = a" "of_real (Re b) = b"
     by (simp_all add: complex_eq_iff)
   from assms have "a \<noteq> b" by auto
   have "((\<lambda>x. f (of_real x)) has_integral I) (cbox (Re a) (Re b)) \<longleftrightarrow>
           ((\<lambda>x. f (a + b * of_real x - a * of_real x)) has_integral I /\<^sub>R (Re b - Re a)) {0..1}"
     by (subst has_integral_affinity_iff [of "Re b - Re a" _ "Re a", symmetric])
        (insert assms, simp_all add: field_simps scaleR_conv_of_real)
   also have "(\<lambda>x. f (a + b * of_real x - a * of_real x)) =
                (\<lambda>x. (f (a + b * of_real x - a * of_real x) * (b - a)) /\<^sub>R (Re b - Re a))"
     using \<open>a \<noteq> b\<close> by (auto simp: field_simps fun_eq_iff scaleR_conv_of_real)
   also have "(\<dots> has_integral I /\<^sub>R (Re b - Re a)) {0..1} \<longleftrightarrow> 
                ((\<lambda>x. f (linepath a b x) * (b - a)) has_integral I) {0..1}" using assms
     by (subst has_integral_cmul_iff) (auto simp: linepath_def scaleR_conv_of_real algebra_simps)
   also have "\<dots> \<longleftrightarrow> (f has_contour_integral I) (linepath a b)" unfolding has_contour_integral_def
     by (intro has_integral_cong) (simp add: vector_derivative_linepath_within)
   finally show ?thesis by simp
 qed
 
 lemma contour_integrable_linepath_Reals_iff:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "(f contour_integrable_on linepath a b) \<longleftrightarrow>
              (\<lambda>x. f (of_real x)) integrable_on {Re a..Re b}"
   using has_contour_integral_linepath_Reals_iff[OF assms, of f]
   by (auto simp: contour_integrable_on_def integrable_on_def)
 
 lemma contour_integral_linepath_Reals_eq:
   fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   shows   "contour_integral (linepath a b) f = integral {Re a..Re b} (\<lambda>x. f (of_real x))"
 proof (cases "f contour_integrable_on linepath a b")
   case True
   thus ?thesis using has_contour_integral_linepath_Reals_iff[OF assms, of f]
     using has_contour_integral_integral has_contour_integral_unique by blast
 next
   case False
   thus ?thesis using contour_integrable_linepath_Reals_iff[OF assms, of f]
     by (simp add: not_integrable_contour_integral not_integrable_integral)
 qed
 
 
 
 text\<open>Cauchy's theorem where there's a primitive\<close>
 
 lemma contour_integral_primitive_lemma:
   fixes f :: "complex \<Rightarrow> complex" and g :: "real \<Rightarrow> complex"
   assumes "a \<le> b"
       and "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative f' x) (at x within s)"
       and "g piecewise_differentiable_on {a..b}"  "\<And>x. x \<in> {a..b} \<Longrightarrow> g x \<in> s"
     shows "((\<lambda>x. f'(g x) * vector_derivative g (at x within {a..b}))
              has_integral (f(g b) - f(g a))) {a..b}"
 proof -
   obtain k where k: "finite k" "\<forall>x\<in>{a..b} - k. g differentiable (at x within {a..b})" and cg: "continuous_on {a..b} g"
     using assms by (auto simp: piecewise_differentiable_on_def)
   have cfg: "continuous_on {a..b} (\<lambda>x. f (g x))"
     apply (rule continuous_on_compose [OF cg, unfolded o_def])
     using assms
     apply (metis field_differentiable_def field_differentiable_imp_continuous_at continuous_on_eq_continuous_within continuous_on_subset image_subset_iff)
     done
   { fix x::real
     assume a: "a < x" and b: "x < b" and xk: "x \<notin> k"
     then have "g differentiable at x within {a..b}"
       using k by (simp add: differentiable_at_withinI)
     then have "(g has_vector_derivative vector_derivative g (at x within {a..b})) (at x within {a..b})"
       by (simp add: vector_derivative_works has_field_derivative_def scaleR_conv_of_real)
     then have gdiff: "(g has_derivative (\<lambda>u. u * vector_derivative g (at x within {a..b}))) (at x within {a..b})"
       by (simp add: has_vector_derivative_def scaleR_conv_of_real)
     have "(f has_field_derivative (f' (g x))) (at (g x) within g ` {a..b})"
       using assms by (metis a atLeastAtMost_iff b DERIV_subset image_subset_iff less_eq_real_def)
     then have fdiff: "(f has_derivative (*) (f' (g x))) (at (g x) within g ` {a..b})"
       by (simp add: has_field_derivative_def)
     have "((\<lambda>x. f (g x)) has_vector_derivative f' (g x) * vector_derivative g (at x within {a..b})) (at x within {a..b})"
       using diff_chain_within [OF gdiff fdiff]
       by (simp add: has_vector_derivative_def scaleR_conv_of_real o_def mult_ac)
   } note * = this
   show ?thesis
     apply (rule fundamental_theorem_of_calculus_interior_strong)
     using k assms cfg *
     apply (auto simp: at_within_Icc_at)
     done
 qed
 
 lemma contour_integral_primitive:
   assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative f' x) (at x within s)"
       and "valid_path g" "path_image g \<subseteq> s"
     shows "(f' has_contour_integral (f(pathfinish g) - f(pathstart g))) g"
   using assms
   apply (simp add: valid_path_def path_image_def pathfinish_def pathstart_def has_contour_integral_def)
   apply (auto intro!: piecewise_C1_imp_differentiable contour_integral_primitive_lemma [of 0 1 s])
   done
 
 corollary Cauchy_theorem_primitive:
   assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative f' x) (at x within s)"
       and "valid_path g"  "path_image g \<subseteq> s" "pathfinish g = pathstart g"
     shows "(f' has_contour_integral 0) g"
   using assms
   by (metis diff_self contour_integral_primitive)
 
 text\<open>Existence of path integral for continuous function\<close>
 lemma contour_integrable_continuous_linepath:
   assumes "continuous_on (closed_segment a b) f"
   shows "f contour_integrable_on (linepath a b)"
 proof -
   have "continuous_on {0..1} ((\<lambda>x. f x * (b - a)) \<circ> linepath a b)"
     apply (rule continuous_on_compose [OF continuous_on_linepath], simp add: linepath_image_01)
     apply (rule continuous_intros | simp add: assms)+
     done
   then show ?thesis
     apply (simp add: contour_integrable_on_def has_contour_integral_def integrable_on_def [symmetric])
     apply (rule integrable_continuous [of 0 "1::real", simplified])
     apply (rule continuous_on_eq [where f = "\<lambda>x. f(linepath a b x)*(b - a)"])
     apply (auto simp: vector_derivative_linepath_within)
     done
 qed
 
 lemma has_field_der_id: "((\<lambda>x. x\<^sup>2 / 2) has_field_derivative x) (at x)"
   by (rule has_derivative_imp_has_field_derivative)
      (rule derivative_intros | simp)+
 
 lemma contour_integral_id [simp]: "contour_integral (linepath a b) (\<lambda>y. y) = (b^2 - a^2)/2"
   apply (rule contour_integral_unique)
   using contour_integral_primitive [of UNIV "\<lambda>x. x^2/2" "\<lambda>x. x" "linepath a b"]
   apply (auto simp: field_simps has_field_der_id)
   done
 
 lemma contour_integrable_on_const [iff]: "(\<lambda>x. c) contour_integrable_on (linepath a b)"
-  by (simp add: continuous_on_const contour_integrable_continuous_linepath)
+  by (simp add: contour_integrable_continuous_linepath)
 
 lemma contour_integrable_on_id [iff]: "(\<lambda>x. x) contour_integrable_on (linepath a b)"
-  by (simp add: continuous_on_id contour_integrable_continuous_linepath)
+  by (simp add: contour_integrable_continuous_linepath)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetical combining theorems\<close>
 
 lemma has_contour_integral_neg:
     "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. -(f x)) has_contour_integral (-i)) g"
   by (simp add: has_integral_neg has_contour_integral_def)
 
 lemma has_contour_integral_add:
     "\<lbrakk>(f1 has_contour_integral i1) g; (f2 has_contour_integral i2) g\<rbrakk>
      \<Longrightarrow> ((\<lambda>x. f1 x + f2 x) has_contour_integral (i1 + i2)) g"
   by (simp add: has_integral_add has_contour_integral_def algebra_simps)
 
 lemma has_contour_integral_diff:
   "\<lbrakk>(f1 has_contour_integral i1) g; (f2 has_contour_integral i2) g\<rbrakk>
          \<Longrightarrow> ((\<lambda>x. f1 x - f2 x) has_contour_integral (i1 - i2)) g"
   by (simp add: has_integral_diff has_contour_integral_def algebra_simps)
 
 lemma has_contour_integral_lmul:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. c * (f x)) has_contour_integral (c*i)) g"
 apply (simp add: has_contour_integral_def)
 apply (drule has_integral_mult_right)
 apply (simp add: algebra_simps)
 done
 
 lemma has_contour_integral_rmul:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. (f x) * c) has_contour_integral (i*c)) g"
 apply (drule has_contour_integral_lmul)
 apply (simp add: mult.commute)
 done
 
 lemma has_contour_integral_div:
   "(f has_contour_integral i) g \<Longrightarrow> ((\<lambda>x. f x/c) has_contour_integral (i/c)) g"
   by (simp add: field_class.field_divide_inverse) (metis has_contour_integral_rmul)
 
 lemma has_contour_integral_eq:
     "\<lbrakk>(f has_contour_integral y) p; \<And>x. x \<in> path_image p \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> (g has_contour_integral y) p"
 apply (simp add: path_image_def has_contour_integral_def)
 by (metis (no_types, lifting) image_eqI has_integral_eq)
 
 lemma has_contour_integral_bound_linepath:
   assumes "(f has_contour_integral i) (linepath a b)"
           "0 \<le> B" "\<And>x. x \<in> closed_segment a b \<Longrightarrow> norm(f x) \<le> B"
     shows "norm i \<le> B * norm(b - a)"
 proof -
   { fix x::real
     assume x: "0 \<le> x" "x \<le> 1"
   have "norm (f (linepath a b x)) *
         norm (vector_derivative (linepath a b) (at x within {0..1})) \<le> B * norm (b - a)"
     by (auto intro: mult_mono simp: assms linepath_in_path of_real_linepath vector_derivative_linepath_within x)
   } note * = this
   have "norm i \<le> (B * norm (b - a)) * content (cbox 0 (1::real))"
     apply (rule has_integral_bound
        [of _ "\<lambda>x. f (linepath a b x) * vector_derivative (linepath a b) (at x within {0..1})"])
     using assms * unfolding has_contour_integral_def
     apply (auto simp: norm_mult)
     done
   then show ?thesis
     by (auto simp: content_real)
 qed
 
 (*UNUSED
 lemma has_contour_integral_bound_linepath_strong:
   fixes a :: real and f :: "complex \<Rightarrow> real"
   assumes "(f has_contour_integral i) (linepath a b)"
           "finite k"
           "0 \<le> B" "\<And>x::real. x \<in> closed_segment a b - k \<Longrightarrow> norm(f x) \<le> B"
     shows "norm i \<le> B*norm(b - a)"
 *)
 
 lemma has_contour_integral_const_linepath: "((\<lambda>x. c) has_contour_integral c*(b - a))(linepath a b)"
   unfolding has_contour_integral_linepath
   by (metis content_real diff_0_right has_integral_const_real lambda_one of_real_1 scaleR_conv_of_real zero_le_one)
 
 lemma has_contour_integral_0: "((\<lambda>x. 0) has_contour_integral 0) g"
   by (simp add: has_contour_integral_def)
 
 lemma has_contour_integral_is_0:
     "(\<And>z. z \<in> path_image g \<Longrightarrow> f z = 0) \<Longrightarrow> (f has_contour_integral 0) g"
   by (rule has_contour_integral_eq [OF has_contour_integral_0]) auto
 
 lemma has_contour_integral_sum:
     "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a has_contour_integral i a) p\<rbrakk>
      \<Longrightarrow> ((\<lambda>x. sum (\<lambda>a. f a x) s) has_contour_integral sum i s) p"
   by (induction s rule: finite_induct) (auto simp: has_contour_integral_0 has_contour_integral_add)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Operations on path integrals\<close>
 
 lemma contour_integral_const_linepath [simp]: "contour_integral (linepath a b) (\<lambda>x. c) = c*(b - a)"
   by (rule contour_integral_unique [OF has_contour_integral_const_linepath])
 
 lemma contour_integral_neg:
     "f contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. -(f x)) = -(contour_integral g f)"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_neg)
 
 lemma contour_integral_add:
     "f1 contour_integrable_on g \<Longrightarrow> f2 contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. f1 x + f2 x) =
                 contour_integral g f1 + contour_integral g f2"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_add)
 
 lemma contour_integral_diff:
     "f1 contour_integrable_on g \<Longrightarrow> f2 contour_integrable_on g \<Longrightarrow> contour_integral g (\<lambda>x. f1 x - f2 x) =
                 contour_integral g f1 - contour_integral g f2"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_diff)
 
 lemma contour_integral_lmul:
   shows "f contour_integrable_on g
            \<Longrightarrow> contour_integral g (\<lambda>x. c * f x) = c*contour_integral g f"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_lmul)
 
 lemma contour_integral_rmul:
   shows "f contour_integrable_on g
         \<Longrightarrow> contour_integral g (\<lambda>x. f x * c) = contour_integral g f * c"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_rmul)
 
 lemma contour_integral_div:
   shows "f contour_integrable_on g
         \<Longrightarrow> contour_integral g (\<lambda>x. f x / c) = contour_integral g f / c"
   by (simp add: contour_integral_unique has_contour_integral_integral has_contour_integral_div)
 
 lemma contour_integral_eq:
     "(\<And>x. x \<in> path_image p \<Longrightarrow> f x = g x) \<Longrightarrow> contour_integral p f = contour_integral p g"
   apply (simp add: contour_integral_def)
   using has_contour_integral_eq
   by (metis contour_integral_unique has_contour_integral_integrable has_contour_integral_integral)
 
 lemma contour_integral_eq_0:
     "(\<And>z. z \<in> path_image g \<Longrightarrow> f z = 0) \<Longrightarrow> contour_integral g f = 0"
   by (simp add: has_contour_integral_is_0 contour_integral_unique)
 
 lemma contour_integral_bound_linepath:
   shows
     "\<lbrakk>f contour_integrable_on (linepath a b);
       0 \<le> B; \<And>x. x \<in> closed_segment a b \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
      \<Longrightarrow> norm(contour_integral (linepath a b) f) \<le> B*norm(b - a)"
   apply (rule has_contour_integral_bound_linepath [of f])
   apply (auto simp: has_contour_integral_integral)
   done
 
 lemma contour_integral_0 [simp]: "contour_integral g (\<lambda>x. 0) = 0"
   by (simp add: contour_integral_unique has_contour_integral_0)
 
 lemma contour_integral_sum:
     "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a) contour_integrable_on p\<rbrakk>
      \<Longrightarrow> contour_integral p (\<lambda>x. sum (\<lambda>a. f a x) s) = sum (\<lambda>a. contour_integral p (f a)) s"
   by (auto simp: contour_integral_unique has_contour_integral_sum has_contour_integral_integral)
 
 lemma contour_integrable_eq:
     "\<lbrakk>f contour_integrable_on p; \<And>x. x \<in> path_image p \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g contour_integrable_on p"
   unfolding contour_integrable_on_def
   by (metis has_contour_integral_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetic theorems for path integrability\<close>
 
 lemma contour_integrable_neg:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. -(f x)) contour_integrable_on g"
   using has_contour_integral_neg contour_integrable_on_def by blast
 
 lemma contour_integrable_add:
     "\<lbrakk>f1 contour_integrable_on g; f2 contour_integrable_on g\<rbrakk> \<Longrightarrow> (\<lambda>x. f1 x + f2 x) contour_integrable_on g"
   using has_contour_integral_add contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_diff:
     "\<lbrakk>f1 contour_integrable_on g; f2 contour_integrable_on g\<rbrakk> \<Longrightarrow> (\<lambda>x. f1 x - f2 x) contour_integrable_on g"
   using has_contour_integral_diff contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_lmul:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. c * f x) contour_integrable_on g"
   using has_contour_integral_lmul contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_rmul:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. f x * c) contour_integrable_on g"
   using has_contour_integral_rmul contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_div:
     "f contour_integrable_on g \<Longrightarrow> (\<lambda>x. f x / c) contour_integrable_on g"
   using has_contour_integral_div contour_integrable_on_def
   by fastforce
 
 lemma contour_integrable_sum:
     "\<lbrakk>finite s; \<And>a. a \<in> s \<Longrightarrow> (f a) contour_integrable_on p\<rbrakk>
      \<Longrightarrow> (\<lambda>x. sum (\<lambda>a. f a x) s) contour_integrable_on p"
    unfolding contour_integrable_on_def
    by (metis has_contour_integral_sum)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Reversing a path integral\<close>
 
 lemma has_contour_integral_reverse_linepath:
     "(f has_contour_integral i) (linepath a b)
      \<Longrightarrow> (f has_contour_integral (-i)) (linepath b a)"
   using has_contour_integral_reversepath valid_path_linepath by fastforce
 
 lemma contour_integral_reverse_linepath:
     "continuous_on (closed_segment a b) f
      \<Longrightarrow> contour_integral (linepath a b) f = - (contour_integral(linepath b a) f)"
 apply (rule contour_integral_unique)
 apply (rule has_contour_integral_reverse_linepath)
 by (simp add: closed_segment_commute contour_integrable_continuous_linepath has_contour_integral_integral)
 
 
 (* Splitting a path integral in a flat way.*)
 
 lemma has_contour_integral_split:
   assumes f: "(f has_contour_integral i) (linepath a c)" "(f has_contour_integral j) (linepath c b)"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "(f has_contour_integral (i + j)) (linepath a b)"
 proof (cases "k = 0 \<or> k = 1")
   case True
   then show ?thesis
     using assms by auto
 next
   case False
   then have k: "0 < k" "k < 1" "complex_of_real k \<noteq> 1"
     using assms by auto
   have c': "c = k *\<^sub>R (b - a) + a"
     by (metis diff_add_cancel c)
   have bc: "(b - c) = (1 - k) *\<^sub>R (b - a)"
     by (simp add: algebra_simps c')
   { assume *: "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R c) * (c - a)) has_integral i) {0..1}"
     have **: "\<And>x. ((k - x) / k) *\<^sub>R a + (x / k) *\<^sub>R c = (1 - x) *\<^sub>R a + x *\<^sub>R b"
       using False apply (simp add: c' algebra_simps)
       apply (simp add: real_vector.scale_left_distrib [symmetric] field_split_simps)
       done
     have "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R b) * (b - a)) has_integral i) {0..k}"
       using k has_integral_affinity01 [OF *, of "inverse k" "0"]
       apply (simp add: divide_simps mult.commute [of _ "k"] image_affinity_atLeastAtMost ** c)
       apply (auto dest: has_integral_cmul [where c = "inverse k"])
       done
   } note fi = this
   { assume *: "((\<lambda>x. f ((1 - x) *\<^sub>R c + x *\<^sub>R b) * (b - c)) has_integral j) {0..1}"
     have **: "\<And>x. (((1 - x) / (1 - k)) *\<^sub>R c + ((x - k) / (1 - k)) *\<^sub>R b) = ((1 - x) *\<^sub>R a + x *\<^sub>R b)"
       using k
       apply (simp add: c' field_simps)
       apply (simp add: scaleR_conv_of_real divide_simps)
       apply (simp add: field_simps)
       done
     have "((\<lambda>x. f ((1 - x) *\<^sub>R a + x *\<^sub>R b) * (b - a)) has_integral j) {k..1}"
       using k has_integral_affinity01 [OF *, of "inverse(1 - k)" "-(k/(1 - k))"]
       apply (simp add: divide_simps mult.commute [of _ "1-k"] image_affinity_atLeastAtMost ** bc)
       apply (auto dest: has_integral_cmul [where k = "(1 - k) *\<^sub>R j" and c = "inverse (1 - k)"])
       done
   } note fj = this
   show ?thesis
     using f k
     apply (simp add: has_contour_integral_linepath)
     apply (simp add: linepath_def)
     apply (rule has_integral_combine [OF _ _ fi fj], simp_all)
     done
 qed
 
 lemma continuous_on_closed_segment_transform:
   assumes f: "continuous_on (closed_segment a b) f"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "continuous_on (closed_segment a c) f"
 proof -
   have c': "c = (1 - k) *\<^sub>R a + k *\<^sub>R b"
     using c by (simp add: algebra_simps)
   have "closed_segment a c \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(1) in_segment(1) k subset_closed_segment)
   then show "continuous_on (closed_segment a c) f"
     by (rule continuous_on_subset [OF f])
 qed
 
 lemma contour_integral_split:
   assumes f: "continuous_on (closed_segment a b) f"
       and k: "0 \<le> k" "k \<le> 1"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "contour_integral(linepath a b) f = contour_integral(linepath a c) f + contour_integral(linepath c b) f"
 proof -
   have c': "c = (1 - k) *\<^sub>R a + k *\<^sub>R b"
     using c by (simp add: algebra_simps)
   have "closed_segment a c \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(1) in_segment(1) k subset_closed_segment)
   moreover have "closed_segment c b \<subseteq> closed_segment a b"
     by (metis c' ends_in_segment(2) in_segment(1) k subset_closed_segment)
   ultimately
   have *: "continuous_on (closed_segment a c) f" "continuous_on (closed_segment c b) f"
     by (auto intro: continuous_on_subset [OF f])
   show ?thesis
     by (rule contour_integral_unique) (meson "*" c contour_integrable_continuous_linepath has_contour_integral_integral has_contour_integral_split k)
 qed
 
 lemma contour_integral_split_linepath:
   assumes f: "continuous_on (closed_segment a b) f"
       and c: "c \<in> closed_segment a b"
     shows "contour_integral(linepath a b) f = contour_integral(linepath a c) f + contour_integral(linepath c b) f"
   using c by (auto simp: closed_segment_def algebra_simps intro!: contour_integral_split [OF f])
 
 text\<open>The special case of midpoints used in the main quadrisection\<close>
 
 lemma has_contour_integral_midpoint:
   assumes "(f has_contour_integral i) (linepath a (midpoint a b))"
           "(f has_contour_integral j) (linepath (midpoint a b) b)"
     shows "(f has_contour_integral (i + j)) (linepath a b)"
   apply (rule has_contour_integral_split [where c = "midpoint a b" and k = "1/2"])
   using assms
   apply (auto simp: midpoint_def algebra_simps scaleR_conv_of_real)
   done
 
 lemma contour_integral_midpoint:
    "continuous_on (closed_segment a b) f
     \<Longrightarrow> contour_integral (linepath a b) f =
         contour_integral (linepath a (midpoint a b)) f + contour_integral (linepath (midpoint a b) b) f"
   apply (rule contour_integral_split [where c = "midpoint a b" and k = "1/2"])
   apply (auto simp: midpoint_def algebra_simps scaleR_conv_of_real)
   done
 
 
 text\<open>A couple of special case lemmas that are useful below\<close>
 
 lemma triangle_linear_has_chain_integral:
     "((\<lambda>x. m*x + d) has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
   apply (rule Cauchy_theorem_primitive [of UNIV "\<lambda>x. m/2 * x^2 + d*x"])
   apply (auto intro!: derivative_eq_intros)
   done
 
 lemma has_chain_integral_chain_integral3:
      "(f has_contour_integral i) (linepath a b +++ linepath b c +++ linepath c d)
       \<Longrightarrow> contour_integral (linepath a b) f + contour_integral (linepath b c) f + contour_integral (linepath c d) f = i"
   apply (subst contour_integral_unique [symmetric], assumption)
   apply (drule has_contour_integral_integrable)
   apply (simp add: valid_path_join)
   done
 
 lemma has_chain_integral_chain_integral4:
      "(f has_contour_integral i) (linepath a b +++ linepath b c +++ linepath c d +++ linepath d e)
       \<Longrightarrow> contour_integral (linepath a b) f + contour_integral (linepath b c) f + contour_integral (linepath c d) f + contour_integral (linepath d e) f = i"
   apply (subst contour_integral_unique [symmetric], assumption)
   apply (drule has_contour_integral_integrable)
   apply (simp add: valid_path_join)
   done
 
 subsection\<open>Reversing the order in a double path integral\<close>
 
 text\<open>The condition is stronger than needed but it's often true in typical situations\<close>
 
 lemma fst_im_cbox [simp]: "cbox c d \<noteq> {} \<Longrightarrow> (fst ` cbox (a,c) (b,d)) = cbox a b"
   by (auto simp: cbox_Pair_eq)
 
 lemma snd_im_cbox [simp]: "cbox a b \<noteq> {} \<Longrightarrow> (snd ` cbox (a,c) (b,d)) = cbox c d"
   by (auto simp: cbox_Pair_eq)
 
 proposition contour_integral_swap:
   assumes fcon:  "continuous_on (path_image g \<times> path_image h) (\<lambda>(y1,y2). f y1 y2)"
       and vp:    "valid_path g" "valid_path h"
       and gvcon: "continuous_on {0..1} (\<lambda>t. vector_derivative g (at t))"
       and hvcon: "continuous_on {0..1} (\<lambda>t. vector_derivative h (at t))"
   shows "contour_integral g (\<lambda>w. contour_integral h (f w)) =
          contour_integral h (\<lambda>z. contour_integral g (\<lambda>w. f w z))"
 proof -
   have gcon: "continuous_on {0..1} g" and hcon: "continuous_on {0..1} h"
     using assms by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have fgh1: "\<And>x. (\<lambda>t. f (g x) (h t)) = (\<lambda>(y1,y2). f y1 y2) \<circ> (\<lambda>t. (g x, h t))"
     by (rule ext) simp
   have fgh2: "\<And>x. (\<lambda>t. f (g t) (h x)) = (\<lambda>(y1,y2). f y1 y2) \<circ> (\<lambda>t. (g t, h x))"
     by (rule ext) simp
   have fcon_im1: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> continuous_on ((\<lambda>t. (g x, h t)) ` {0..1}) (\<lambda>(x, y). f x y)"
     by (rule continuous_on_subset [OF fcon]) (auto simp: path_image_def)
   have fcon_im2: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> continuous_on ((\<lambda>t. (g t, h x)) ` {0..1}) (\<lambda>(x, y). f x y)"
     by (rule continuous_on_subset [OF fcon]) (auto simp: path_image_def)
   have "\<And>y. y \<in> {0..1} \<Longrightarrow> continuous_on {0..1} (\<lambda>x. f (g x) (h y))"
     by (subst fgh2) (rule fcon_im2 gcon continuous_intros | simp)+
   then have vdg: "\<And>y. y \<in> {0..1} \<Longrightarrow> (\<lambda>x. f (g x) (h y) * vector_derivative g (at x)) integrable_on {0..1}"
     using continuous_on_mult gvcon integrable_continuous_real by blast
   have "(\<lambda>z. vector_derivative g (at (fst z))) = (\<lambda>x. vector_derivative g (at x)) \<circ> fst"
     by auto
   then have gvcon': "continuous_on (cbox (0, 0) (1, 1::real)) (\<lambda>x. vector_derivative g (at (fst x)))"
     apply (rule ssubst)
     apply (rule continuous_intros | simp add: gvcon)+
     done
   have "(\<lambda>z. vector_derivative h (at (snd z))) = (\<lambda>x. vector_derivative h (at x)) \<circ> snd"
     by auto
   then have hvcon': "continuous_on (cbox (0, 0) (1::real, 1)) (\<lambda>x. vector_derivative h (at (snd x)))"
     apply (rule ssubst)
     apply (rule continuous_intros | simp add: hvcon)+
     done
   have "(\<lambda>x. f (g (fst x)) (h (snd x))) = (\<lambda>(y1,y2). f y1 y2) \<circ> (\<lambda>w. ((g \<circ> fst) w, (h \<circ> snd) w))"
     by auto
   then have fgh: "continuous_on (cbox (0, 0) (1, 1)) (\<lambda>x. f (g (fst x)) (h (snd x)))"
     apply (rule ssubst)
     apply (rule gcon hcon continuous_intros | simp)+
     apply (auto simp: path_image_def intro: continuous_on_subset [OF fcon])
     done
   have "integral {0..1} (\<lambda>x. contour_integral h (f (g x)) * vector_derivative g (at x)) =
         integral {0..1} (\<lambda>x. contour_integral h (\<lambda>y. f (g x) y * vector_derivative g (at x)))"
   proof (rule integral_cong [OF contour_integral_rmul [symmetric]])
     show "\<And>x. x \<in> {0..1} \<Longrightarrow> f (g x) contour_integrable_on h"
       unfolding contour_integrable_on
     apply (rule integrable_continuous_real)
     apply (rule continuous_on_mult [OF _ hvcon])
     apply (subst fgh1)
     apply (rule fcon_im1 hcon continuous_intros | simp)+
       done
   qed
   also have "\<dots> = integral {0..1}
                      (\<lambda>y. contour_integral g (\<lambda>x. f x (h y) * vector_derivative h (at y)))"
     unfolding contour_integral_integral
     apply (subst integral_swap_continuous [where 'a = real and 'b = real, of 0 0 1 1, simplified])
      apply (rule fgh gvcon' hvcon' continuous_intros | simp add: split_def)+
     unfolding integral_mult_left [symmetric]
     apply (simp only: mult_ac)
     done
   also have "\<dots> = contour_integral h (\<lambda>z. contour_integral g (\<lambda>w. f w z))"
     unfolding contour_integral_integral
     apply (rule integral_cong)
     unfolding integral_mult_left [symmetric]
     apply (simp add: algebra_simps)
     done
   finally show ?thesis
     by (simp add: contour_integral_integral)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>The key quadrisection step\<close>
 
 lemma norm_sum_half:
   assumes "norm(a + b) \<ge> e"
     shows "norm a \<ge> e/2 \<or> norm b \<ge> e/2"
 proof -
   have "e \<le> norm (- a - b)"
     by (simp add: add.commute assms norm_minus_commute)
   thus ?thesis
     using norm_triangle_ineq4 order_trans by fastforce
 qed
 
 lemma norm_sum_lemma:
   assumes "e \<le> norm (a + b + c + d)"
     shows "e / 4 \<le> norm a \<or> e / 4 \<le> norm b \<or> e / 4 \<le> norm c \<or> e / 4 \<le> norm d"
 proof -
   have "e \<le> norm ((a + b) + (c + d))" using assms
     by (simp add: algebra_simps)
   then show ?thesis
     by (auto dest!: norm_sum_half)
 qed
 
 lemma Cauchy_theorem_quadrisection:
   assumes f: "continuous_on (convex hull {a,b,c}) f"
       and dist: "dist a b \<le> K" "dist b c \<le> K" "dist c a \<le> K"
       and e: "e * K^2 \<le>
               norm (contour_integral(linepath a b) f + contour_integral(linepath b c) f + contour_integral(linepath c a) f)"
   shows "\<exists>a' b' c'.
            a' \<in> convex hull {a,b,c} \<and> b' \<in> convex hull {a,b,c} \<and> c' \<in> convex hull {a,b,c} \<and>
            dist a' b' \<le> K/2  \<and>  dist b' c' \<le> K/2  \<and>  dist c' a' \<le> K/2  \<and>
            e * (K/2)^2 \<le> norm(contour_integral(linepath a' b') f + contour_integral(linepath b' c') f + contour_integral(linepath c' a') f)"
          (is "\<exists>x y z. ?\<Phi> x y z")
 proof -
   note divide_le_eq_numeral1 [simp del]
   define a' where "a' = midpoint b c"
   define b' where "b' = midpoint c a"
   define c' where "c' = midpoint a b"
   have fabc: "continuous_on (closed_segment a b) f" "continuous_on (closed_segment b c) f" "continuous_on (closed_segment c a) f"
     using f continuous_on_subset segments_subset_convex_hull by metis+
   have fcont': "continuous_on (closed_segment c' b') f"
                "continuous_on (closed_segment a' c') f"
                "continuous_on (closed_segment b' a') f"
     unfolding a'_def b'_def c'_def
     by (rule continuous_on_subset [OF f],
            metis midpoints_in_convex_hull convex_hull_subset hull_subset insert_subset segment_convex_hull)+
   let ?pathint = "\<lambda>x y. contour_integral(linepath x y) f"
   have *: "?pathint a b + ?pathint b c + ?pathint c a =
           (?pathint a c' + ?pathint c' b' + ?pathint b' a) +
           (?pathint a' c' + ?pathint c' b + ?pathint b a') +
           (?pathint a' c + ?pathint c b' + ?pathint b' a') +
           (?pathint a' b' + ?pathint b' c' + ?pathint c' a')"
     by (simp add: fcont' contour_integral_reverse_linepath) (simp add: a'_def b'_def c'_def contour_integral_midpoint fabc)
   have [simp]: "\<And>x y. cmod (x * 2 - y * 2) = cmod (x - y) * 2"
     by (metis left_diff_distrib mult.commute norm_mult_numeral1)
   have [simp]: "\<And>x y. cmod (x - y) = cmod (y - x)"
     by (simp add: norm_minus_commute)
   consider "e * K\<^sup>2 / 4 \<le> cmod (?pathint a c' + ?pathint c' b' + ?pathint b' a)" |
            "e * K\<^sup>2 / 4 \<le> cmod (?pathint a' c' + ?pathint c' b + ?pathint b a')" |
            "e * K\<^sup>2 / 4 \<le> cmod (?pathint a' c + ?pathint c b' + ?pathint b' a')" |
            "e * K\<^sup>2 / 4 \<le> cmod (?pathint a' b' + ?pathint b' c' + ?pathint c' a')"
     using assms unfolding * by (blast intro: that dest!: norm_sum_lemma)
   then show ?thesis
   proof cases
     case 1 then have "?\<Phi> a c' b'"
       using assms
       apply (clarsimp simp: c'_def b'_def midpoints_in_convex_hull hull_subset [THEN subsetD])
       apply (auto simp: midpoint_def dist_norm scaleR_conv_of_real field_split_simps)
       done
     then show ?thesis by blast
   next
     case 2 then  have "?\<Phi> a' c' b"
       using assms
       apply (clarsimp simp: a'_def c'_def midpoints_in_convex_hull hull_subset [THEN subsetD])
       apply (auto simp: midpoint_def dist_norm scaleR_conv_of_real field_split_simps)
       done
     then show ?thesis by blast
   next
     case 3 then have "?\<Phi> a' c b'"
       using assms
       apply (clarsimp simp: a'_def b'_def midpoints_in_convex_hull hull_subset [THEN subsetD])
       apply (auto simp: midpoint_def dist_norm scaleR_conv_of_real field_split_simps)
       done
     then show ?thesis by blast
   next
     case 4 then have "?\<Phi> a' b' c'"
       using assms
       apply (clarsimp simp: a'_def c'_def b'_def midpoints_in_convex_hull hull_subset [THEN subsetD])
       apply (auto simp: midpoint_def dist_norm scaleR_conv_of_real field_split_simps)
       done
     then show ?thesis by blast
   qed
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Cauchy's theorem for triangles\<close>
 
 lemma triangle_points_closer:
   fixes a::complex
   shows "\<lbrakk>x \<in> convex hull {a,b,c};  y \<in> convex hull {a,b,c}\<rbrakk>
          \<Longrightarrow> norm(x - y) \<le> norm(a - b) \<or>
              norm(x - y) \<le> norm(b - c) \<or>
              norm(x - y) \<le> norm(c - a)"
   using simplex_extremal_le [of "{a,b,c}"]
   by (auto simp: norm_minus_commute)
 
 lemma holomorphic_point_small_triangle:
   assumes x: "x \<in> S"
       and f: "continuous_on S f"
       and cd: "f field_differentiable (at x within S)"
       and e: "0 < e"
     shows "\<exists>k>0. \<forall>a b c. dist a b \<le> k \<and> dist b c \<le> k \<and> dist c a \<le> k \<and>
               x \<in> convex hull {a,b,c} \<and> convex hull {a,b,c} \<subseteq> S
               \<longrightarrow> norm(contour_integral(linepath a b) f + contour_integral(linepath b c) f +
                        contour_integral(linepath c a) f)
                   \<le> e*(dist a b + dist b c + dist c a)^2"
            (is "\<exists>k>0. \<forall>a b c. _ \<longrightarrow> ?normle a b c")
 proof -
   have le_of_3: "\<And>a x y z. \<lbrakk>0 \<le> x*y; 0 \<le> x*z; 0 \<le> y*z; a \<le> (e*(x + y + z))*x + (e*(x + y + z))*y + (e*(x + y + z))*z\<rbrakk>
                      \<Longrightarrow> a \<le> e*(x + y + z)^2"
     by (simp add: algebra_simps power2_eq_square)
   have disj_le: "\<lbrakk>x \<le> a \<or> x \<le> b \<or> x \<le> c; 0 \<le> a; 0 \<le> b; 0 \<le> c\<rbrakk> \<Longrightarrow> x \<le> a + b + c"
              for x::real and a b c
     by linarith
   have fabc: "f contour_integrable_on linepath a b" "f contour_integrable_on linepath b c" "f contour_integrable_on linepath c a"
               if "convex hull {a, b, c} \<subseteq> S" for a b c
     using segments_subset_convex_hull that
     by (metis continuous_on_subset f contour_integrable_continuous_linepath)+
   note path_bound = has_contour_integral_bound_linepath [simplified norm_minus_commute, OF has_contour_integral_integral]
   { fix f' a b c d
     assume d: "0 < d"
        and f': "\<And>y. \<lbrakk>cmod (y - x) \<le> d; y \<in> S\<rbrakk> \<Longrightarrow> cmod (f y - f x - f' * (y - x)) \<le> e * cmod (y - x)"
        and le: "cmod (a - b) \<le> d" "cmod (b - c) \<le> d" "cmod (c - a) \<le> d"
        and xc: "x \<in> convex hull {a, b, c}"
        and S: "convex hull {a, b, c} \<subseteq> S"
     have pa: "contour_integral (linepath a b) f + contour_integral (linepath b c) f + contour_integral (linepath c a) f =
               contour_integral (linepath a b) (\<lambda>y. f y - f x - f'*(y - x)) +
               contour_integral (linepath b c) (\<lambda>y. f y - f x - f'*(y - x)) +
               contour_integral (linepath c a) (\<lambda>y. f y - f x - f'*(y - x))"
       apply (simp add: contour_integral_diff contour_integral_lmul contour_integrable_lmul contour_integrable_diff fabc [OF S])
       apply (simp add: field_simps)
       done
     { fix y
       assume yc: "y \<in> convex hull {a,b,c}"
       have "cmod (f y - f x - f' * (y - x)) \<le> e*norm(y - x)"
       proof (rule f')
         show "cmod (y - x) \<le> d"
           by (metis triangle_points_closer [OF xc yc] le norm_minus_commute order_trans)
       qed (use S yc in blast)
       also have "\<dots> \<le> e * (cmod (a - b) + cmod (b - c) + cmod (c - a))"
         by (simp add: yc e xc disj_le [OF triangle_points_closer])
       finally have "cmod (f y - f x - f' * (y - x)) \<le> e * (cmod (a - b) + cmod (b - c) + cmod (c - a))" .
     } note cm_le = this
     have "?normle a b c"
       unfolding dist_norm pa
       apply (rule le_of_3)
       using f' xc S e
       apply simp_all
       apply (intro norm_triangle_le add_mono path_bound)
       apply (simp_all add: contour_integral_diff contour_integral_lmul contour_integrable_lmul contour_integrable_diff fabc)
       apply (blast intro: cm_le elim: dest: segments_subset_convex_hull [THEN subsetD])+
       done
   } note * = this
   show ?thesis
     using cd e
     apply (simp add: field_differentiable_def has_field_derivative_def has_derivative_within_alt approachable_lt_le2 Ball_def)
     apply (clarify dest!: spec mp)
     using * unfolding dist_norm
     apply blast
     done
 qed
 
 
 text\<open>Hence the most basic theorem for a triangle.\<close>
 
 locale Chain =
   fixes x0 At Follows
   assumes At0: "At x0 0"
       and AtSuc: "\<And>x n. At x n \<Longrightarrow> \<exists>x'. At x' (Suc n) \<and> Follows x' x"
 begin
   primrec f where
     "f 0 = x0"
   | "f (Suc n) = (SOME x. At x (Suc n) \<and> Follows x (f n))"
 
   lemma At: "At (f n) n"
   proof (induct n)
     case 0 show ?case
       by (simp add: At0)
   next
     case (Suc n) show ?case
       by (metis (no_types, lifting) AtSuc [OF Suc] f.simps(2) someI_ex)
   qed
 
   lemma Follows: "Follows (f(Suc n)) (f n)"
     by (metis (no_types, lifting) AtSuc [OF At [of n]] f.simps(2) someI_ex)
 
   declare f.simps(2) [simp del]
 end
 
 lemma Chain3:
   assumes At0: "At x0 y0 z0 0"
       and AtSuc: "\<And>x y z n. At x y z n \<Longrightarrow> \<exists>x' y' z'. At x' y' z' (Suc n) \<and> Follows x' y' z' x y z"
   obtains f g h where
     "f 0 = x0" "g 0 = y0" "h 0 = z0"
                       "\<And>n. At (f n) (g n) (h n) n"
                        "\<And>n. Follows (f(Suc n)) (g(Suc n)) (h(Suc n)) (f n) (g n) (h n)"
 proof -
   interpret three: Chain "(x0,y0,z0)" "\<lambda>(x,y,z). At x y z" "\<lambda>(x',y',z'). \<lambda>(x,y,z). Follows x' y' z' x y z"
     apply unfold_locales
     using At0 AtSuc by auto
   show ?thesis
   apply (rule that [of "\<lambda>n. fst (three.f n)"  "\<lambda>n. fst (snd (three.f n))" "\<lambda>n. snd (snd (three.f n))"])
   using three.At three.Follows
   apply simp_all
   apply (simp_all add: split_beta')
   done
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> Cauchy_theorem_triangle:
   assumes "f holomorphic_on (convex hull {a,b,c})"
     shows "(f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
 proof -
   have contf: "continuous_on (convex hull {a,b,c}) f"
     by (metis assms holomorphic_on_imp_continuous_on)
   let ?pathint = "\<lambda>x y. contour_integral(linepath x y) f"
   { fix y::complex
     assume fy: "(f has_contour_integral y) (linepath a b +++ linepath b c +++ linepath c a)"
        and ynz: "y \<noteq> 0"
     define K where "K = 1 + max (dist a b) (max (dist b c) (dist c a))"
     define e where "e = norm y / K^2"
     have K1: "K \<ge> 1"  by (simp add: K_def max.coboundedI1)
     then have K: "K > 0" by linarith
     have [iff]: "dist a b \<le> K" "dist b c \<le> K" "dist c a \<le> K"
       by (simp_all add: K_def)
     have e: "e > 0"
       unfolding e_def using ynz K1 by simp
     define At where "At x y z n \<longleftrightarrow>
         convex hull {x,y,z} \<subseteq> convex hull {a,b,c} \<and>
         dist x y \<le> K/2^n \<and> dist y z \<le> K/2^n \<and> dist z x \<le> K/2^n \<and>
         norm(?pathint x y + ?pathint y z + ?pathint z x) \<ge> e*(K/2^n)^2"
       for x y z n
     have At0: "At a b c 0"
       using fy
       by (simp add: At_def e_def has_chain_integral_chain_integral3)
     { fix x y z n
       assume At: "At x y z n"
       then have contf': "continuous_on (convex hull {x,y,z}) f"
         using contf At_def continuous_on_subset by metis
       have "\<exists>x' y' z'. At x' y' z' (Suc n) \<and> convex hull {x',y',z'} \<subseteq> convex hull {x,y,z}"
         using At Cauchy_theorem_quadrisection [OF contf', of "K/2^n" e]
         apply (simp add: At_def algebra_simps)
         apply (meson convex_hull_subset empty_subsetI insert_subset subsetCE)
         done
     } note AtSuc = this
     obtain fa fb fc
       where f0 [simp]: "fa 0 = a" "fb 0 = b" "fc 0 = c"
         and cosb: "\<And>n. convex hull {fa n, fb n, fc n} \<subseteq> convex hull {a,b,c}"
         and dist: "\<And>n. dist (fa n) (fb n) \<le> K/2^n"
                   "\<And>n. dist (fb n) (fc n) \<le> K/2^n"
                   "\<And>n. dist (fc n) (fa n) \<le> K/2^n"
         and no: "\<And>n. norm(?pathint (fa n) (fb n) +
                            ?pathint (fb n) (fc n) +
                            ?pathint (fc n) (fa n)) \<ge> e * (K/2^n)^2"
         and conv_le: "\<And>n. convex hull {fa(Suc n), fb(Suc n), fc(Suc n)} \<subseteq> convex hull {fa n, fb n, fc n}"
       apply (rule Chain3 [of At, OF At0 AtSuc])
       apply (auto simp: At_def)
       done
     obtain x where x: "\<And>n. x \<in> convex hull {fa n, fb n, fc n}"
     proof (rule bounded_closed_nest)
       show "\<And>n. closed (convex hull {fa n, fb n, fc n})"
         by (simp add: compact_imp_closed finite_imp_compact_convex_hull)
       show "\<And>m n. m \<le> n \<Longrightarrow> convex hull {fa n, fb n, fc n} \<subseteq> convex hull {fa m, fb m, fc m}"
         by (erule transitive_stepwise_le) (auto simp: conv_le)
     qed (fastforce intro: finite_imp_bounded_convex_hull)+
     then have xin: "x \<in> convex hull {a,b,c}"
       using assms f0 by blast
     then have fx: "f field_differentiable at x within (convex hull {a,b,c})"
       using assms holomorphic_on_def by blast
     { fix k n
       assume k: "0 < k"
          and le:
             "\<And>x' y' z'.
                \<lbrakk>dist x' y' \<le> k; dist y' z' \<le> k; dist z' x' \<le> k;
                 x \<in> convex hull {x',y',z'};
                 convex hull {x',y',z'} \<subseteq> convex hull {a,b,c}\<rbrakk>
                \<Longrightarrow>
                cmod (?pathint x' y' + ?pathint y' z' + ?pathint z' x') * 10
                      \<le> e * (dist x' y' + dist y' z' + dist z' x')\<^sup>2"
          and Kk: "K / k < 2 ^ n"
       have "K / 2 ^ n < k" using Kk k
         by (auto simp: field_simps)
       then have DD: "dist (fa n) (fb n) \<le> k" "dist (fb n) (fc n) \<le> k" "dist (fc n) (fa n) \<le> k"
         using dist [of n]  k
         by linarith+
       have dle: "(dist (fa n) (fb n) + dist (fb n) (fc n) + dist (fc n) (fa n))\<^sup>2
                \<le> (3 * K / 2 ^ n)\<^sup>2"
         using dist [of n] e K
         by (simp add: abs_le_square_iff [symmetric])
       have less10: "\<And>x y::real. 0 < x \<Longrightarrow> y \<le> 9*x \<Longrightarrow> y < x*10"
         by linarith
       have "e * (dist (fa n) (fb n) + dist (fb n) (fc n) + dist (fc n) (fa n))\<^sup>2 \<le> e * (3 * K / 2 ^ n)\<^sup>2"
         using ynz dle e mult_le_cancel_left_pos by blast
       also have "\<dots> <
           cmod (?pathint (fa n) (fb n) + ?pathint (fb n) (fc n) + ?pathint (fc n) (fa n)) * 10"
         using no [of n] e K
         apply (simp add: e_def field_simps)
         apply (simp only: zero_less_norm_iff [symmetric])
         done
       finally have False
         using le [OF DD x cosb] by auto
     } then
     have ?thesis
       using holomorphic_point_small_triangle [OF xin contf fx, of "e/10"] e
       apply clarsimp
       apply (rule_tac y1="K/k" in exE [OF real_arch_pow[of 2]], force+)
       done
   }
   moreover have "f contour_integrable_on (linepath a b +++ linepath b c +++ linepath c a)"
     by simp (meson contf continuous_on_subset contour_integrable_continuous_linepath segments_subset_convex_hull(1)
                    segments_subset_convex_hull(3) segments_subset_convex_hull(5))
   ultimately show ?thesis
     using has_contour_integral_integral by fastforce
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Version needing function holomorphic in interior only\<close>
 
 lemma Cauchy_theorem_flat_lemma:
   assumes f: "continuous_on (convex hull {a,b,c}) f"
       and c: "c - a = k *\<^sub>R (b - a)"
       and k: "0 \<le> k"
     shows "contour_integral (linepath a b) f + contour_integral (linepath b c) f +
           contour_integral (linepath c a) f = 0"
 proof -
   have fabc: "continuous_on (closed_segment a b) f" "continuous_on (closed_segment b c) f" "continuous_on (closed_segment c a) f"
     using f continuous_on_subset segments_subset_convex_hull by metis+
   show ?thesis
   proof (cases "k \<le> 1")
     case True show ?thesis
       by (simp add: contour_integral_split [OF fabc(1) k True c] contour_integral_reverse_linepath fabc)
   next
     case False then show ?thesis
       using fabc c
       apply (subst contour_integral_split [of a c f "1/k" b, symmetric])
       apply (metis closed_segment_commute fabc(3))
       apply (auto simp: k contour_integral_reverse_linepath)
       done
   qed
 qed
 
 lemma Cauchy_theorem_flat:
   assumes f: "continuous_on (convex hull {a,b,c}) f"
       and c: "c - a = k *\<^sub>R (b - a)"
     shows "contour_integral (linepath a b) f +
            contour_integral (linepath b c) f +
            contour_integral (linepath c a) f = 0"
 proof (cases "0 \<le> k")
   case True with assms show ?thesis
     by (blast intro: Cauchy_theorem_flat_lemma)
 next
   case False
   have "continuous_on (closed_segment a b) f" "continuous_on (closed_segment b c) f" "continuous_on (closed_segment c a) f"
     using f continuous_on_subset segments_subset_convex_hull by metis+
   moreover have "contour_integral (linepath b a) f + contour_integral (linepath a c) f +
         contour_integral (linepath c b) f = 0"
     apply (rule Cauchy_theorem_flat_lemma [of b a c f "1-k"])
     using False c
     apply (auto simp: f insert_commute scaleR_conv_of_real algebra_simps)
     done
   ultimately show ?thesis
     apply (auto simp: contour_integral_reverse_linepath)
     using add_eq_0_iff by force
 qed
 
 lemma Cauchy_theorem_triangle_interior:
   assumes contf: "continuous_on (convex hull {a,b,c}) f"
       and holf:  "f holomorphic_on interior (convex hull {a,b,c})"
      shows "(f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
 proof -
   have fabc: "continuous_on (closed_segment a b) f" "continuous_on (closed_segment b c) f" "continuous_on (closed_segment c a) f"
     using contf continuous_on_subset segments_subset_convex_hull by metis+
   have "bounded (f ` (convex hull {a,b,c}))"
     by (simp add: compact_continuous_image compact_convex_hull compact_imp_bounded contf)
   then obtain B where "0 < B" and Bnf: "\<And>x. x \<in> convex hull {a,b,c} \<Longrightarrow> norm (f x) \<le> B"
      by (auto simp: dest!: bounded_pos [THEN iffD1])
   have "bounded (convex hull {a,b,c})"
     by (simp add: bounded_convex_hull)
   then obtain C where C: "0 < C" and Cno: "\<And>y. y \<in> convex hull {a,b,c} \<Longrightarrow> norm y < C"
     using bounded_pos_less by blast
   then have diff_2C: "norm(x - y) \<le> 2*C"
            if x: "x \<in> convex hull {a, b, c}" and y: "y \<in> convex hull {a, b, c}" for x y
   proof -
     have "cmod x \<le> C"
       using x by (meson Cno not_le not_less_iff_gr_or_eq)
     hence "cmod (x - y) \<le> C + C"
       using y by (meson Cno add_mono_thms_linordered_field(4) less_eq_real_def norm_triangle_ineq4 order_trans)
     thus "cmod (x - y) \<le> 2 * C"
       by (metis mult_2)
   qed
   have contf': "continuous_on (convex hull {b,a,c}) f"
     using contf by (simp add: insert_commute)
   { fix y::complex
     assume fy: "(f has_contour_integral y) (linepath a b +++ linepath b c +++ linepath c a)"
        and ynz: "y \<noteq> 0"
     have pi_eq_y: "contour_integral (linepath a b) f + contour_integral (linepath b c) f + contour_integral (linepath c a) f = y"
       by (rule has_chain_integral_chain_integral3 [OF fy])
     have ?thesis
     proof (cases "c=a \<or> a=b \<or> b=c")
       case True then show ?thesis
         using Cauchy_theorem_flat [OF contf, of 0]
         using has_chain_integral_chain_integral3 [OF fy] ynz
         by (force simp: fabc contour_integral_reverse_linepath)
     next
       case False
       then have car3: "card {a, b, c} = Suc (DIM(complex))"
         by auto
       { assume "interior(convex hull {a,b,c}) = {}"
         then have "collinear{a,b,c}"
           using interior_convex_hull_eq_empty [OF car3]
           by (simp add: collinear_3_eq_affine_dependent)
         with False obtain d where "c \<noteq> a" "a \<noteq> b" "b \<noteq> c" "c - b = d *\<^sub>R (a - b)"
           by (auto simp: collinear_3 collinear_lemma)
         then have "False"
           using False Cauchy_theorem_flat [OF contf'] pi_eq_y ynz
           by (simp add: fabc add_eq_0_iff contour_integral_reverse_linepath)
       }
       then obtain d where d: "d \<in> interior (convex hull {a, b, c})"
         by blast
       { fix d1
         assume d1_pos: "0 < d1"
            and d1: "\<And>x x'. \<lbrakk>x\<in>convex hull {a, b, c}; x'\<in>convex hull {a, b, c}; cmod (x' - x) < d1\<rbrakk>
                            \<Longrightarrow> cmod (f x' - f x) < cmod y / (24 * C)"
         define e where "e = min 1 (min (d1/(4*C)) ((norm y / 24 / C) / B))"
         define shrink where "shrink x = x - e *\<^sub>R (x - d)" for x
         let ?pathint = "\<lambda>x y. contour_integral(linepath x y) f"
         have e: "0 < e" "e \<le> 1" "e \<le> d1 / (4 * C)" "e \<le> cmod y / 24 / C / B"
           using d1_pos \<open>C>0\<close> \<open>B>0\<close> ynz by (simp_all add: e_def)
         then have eCB: "24 * e * C * B \<le> cmod y"
           using \<open>C>0\<close> \<open>B>0\<close>  by (simp add: field_simps)
         have e_le_d1: "e * (4 * C) \<le> d1"
           using e \<open>C>0\<close> by (simp add: field_simps)
         have "shrink a \<in> interior(convex hull {a,b,c})"
              "shrink b \<in> interior(convex hull {a,b,c})"
              "shrink c \<in> interior(convex hull {a,b,c})"
           using d e by (auto simp: hull_inc mem_interior_convex_shrink shrink_def)
         then have fhp0: "(f has_contour_integral 0)
                 (linepath (shrink a) (shrink b) +++ linepath (shrink b) (shrink c) +++ linepath (shrink c) (shrink a))"
           by (simp add: Cauchy_theorem_triangle holomorphic_on_subset [OF holf] hull_minimal)
         then have f_0_shrink: "?pathint (shrink a) (shrink b) + ?pathint (shrink b) (shrink c) + ?pathint (shrink c) (shrink a) = 0"
           by (simp add: has_chain_integral_chain_integral3)
         have fpi_abc: "f contour_integrable_on linepath (shrink a) (shrink b)"
                       "f contour_integrable_on linepath (shrink b) (shrink c)"
                       "f contour_integrable_on linepath (shrink c) (shrink a)"
           using fhp0  by (auto simp: valid_path_join dest: has_contour_integral_integrable)
         have cmod_shr: "\<And>x y. cmod (shrink y - shrink x - (y - x)) = e * cmod (x - y)"
           using e by (simp add: shrink_def real_vector.scale_right_diff_distrib [symmetric])
         have sh_eq: "\<And>a b d::complex. (b - e *\<^sub>R (b - d)) - (a - e *\<^sub>R (a - d)) - (b - a) = e *\<^sub>R (a - b)"
           by (simp add: algebra_simps)
         have "cmod y / (24 * C) \<le> cmod y / cmod (b - a) / 12"
           using False \<open>C>0\<close> diff_2C [of b a] ynz
           by (auto simp: field_split_simps hull_inc)
         have less_C: "\<lbrakk>u \<in> convex hull {a, b, c}; 0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> x * cmod u < C" for x u
           apply (cases "x=0", simp add: \<open>0<C\<close>)
           using Cno [of u] mult_left_le_one_le [of "cmod u" x] le_less_trans norm_ge_zero by blast
         { fix u v
           assume uv: "u \<in> convex hull {a, b, c}" "v \<in> convex hull {a, b, c}" "u\<noteq>v"
              and fpi_uv: "f contour_integrable_on linepath (shrink u) (shrink v)"
           have shr_uv: "shrink u \<in> interior(convex hull {a,b,c})"
                        "shrink v \<in> interior(convex hull {a,b,c})"
             using d e uv
             by (auto simp: hull_inc mem_interior_convex_shrink shrink_def)
           have cmod_fuv: "\<And>x. 0\<le>x \<Longrightarrow> x\<le>1 \<Longrightarrow> cmod (f (linepath (shrink u) (shrink v) x)) \<le> B"
             using shr_uv by (blast intro: Bnf linepath_in_convex_hull interior_subset [THEN subsetD])
           have By_uv: "B * (12 * (e * cmod (u - v))) \<le> cmod y"
             apply (rule order_trans [OF _ eCB])
             using e \<open>B>0\<close> diff_2C [of u v] uv
             by (auto simp: field_simps)
           { fix x::real   assume x: "0\<le>x" "x\<le>1"
             have cmod_less_4C: "cmod ((1 - x) *\<^sub>R u - (1 - x) *\<^sub>R d) + cmod (x *\<^sub>R v - x *\<^sub>R d) < (C+C) + (C+C)"
               apply (rule add_strict_mono; rule norm_triangle_half_l [of _ 0])
               using uv x d interior_subset
               apply (auto simp: hull_inc intro!: less_C)
               done
             have ll: "linepath (shrink u) (shrink v) x - linepath u v x = -e * ((1 - x) *\<^sub>R (u - d) + x *\<^sub>R (v - d))"
               by (simp add: linepath_def shrink_def algebra_simps scaleR_conv_of_real)
             have cmod_less_dt: "cmod (linepath (shrink u) (shrink v) x - linepath u v x) < d1"
               apply (simp only: ll norm_mult scaleR_diff_right)
               using \<open>e>0\<close> cmod_less_4C apply (force intro: norm_triangle_lt less_le_trans [OF _ e_le_d1])
               done
             have "cmod (f (linepath (shrink u) (shrink v) x) - f (linepath u v x)) < cmod y / (24 * C)"
               using x uv shr_uv cmod_less_dt
               by (auto simp: hull_inc intro: d1 interior_subset [THEN subsetD] linepath_in_convex_hull)
             also have "\<dots> \<le> cmod y / cmod (v - u) / 12"
               using False uv \<open>C>0\<close> diff_2C [of v u] ynz
               by (auto simp: field_split_simps hull_inc)
             finally have "cmod (f (linepath (shrink u) (shrink v) x) - f (linepath u v x)) \<le> cmod y / cmod (v - u) / 12"
               by simp
             then have cmod_12_le: "cmod (v - u) * cmod (f (linepath (shrink u) (shrink v) x) - f (linepath u v x)) * 12 \<le> cmod y"
               using uv False by (auto simp: field_simps)
             have "cmod (f (linepath (shrink u) (shrink v) x)) * cmod (shrink v - shrink u - (v - u)) +
                           cmod (v - u) * cmod (f (linepath (shrink u) (shrink v) x) - f (linepath u v x))
                           \<le> B * (cmod y / 24 / C / B * 2 * C) + 2 * C * (cmod y / 24 / C)"
               apply (rule add_mono [OF mult_mono])
               using By_uv e \<open>0 < B\<close> \<open>0 < C\<close> x apply (simp_all add: cmod_fuv cmod_shr cmod_12_le)
               apply (simp add: field_simps)
               done
             also have "\<dots> \<le> cmod y / 6"
               by simp
             finally have "cmod (f (linepath (shrink u) (shrink v) x)) * cmod (shrink v - shrink u - (v - u)) +
                           cmod (v - u) * cmod (f (linepath (shrink u) (shrink v) x) - f (linepath u v x))
                           \<le> cmod y / 6" .
           } note cmod_diff_le = this
           have f_uv: "continuous_on (closed_segment u v) f"
             by (blast intro: uv continuous_on_subset [OF contf closed_segment_subset_convex_hull])
           have **: "\<And>f' x' f x::complex. f'*x' - f*x = f'*(x' - x) + x*(f' - f)"
             by (simp add: algebra_simps)
           have "norm (?pathint (shrink u) (shrink v) - ?pathint u v)
                 \<le> (B*(norm y /24/C/B)*2*C + (2*C)*(norm y/24/C)) * content (cbox 0 (1::real))"
             apply (rule has_integral_bound
                     [of _ "\<lambda>x. f(linepath (shrink u) (shrink v) x) * (shrink v - shrink u) - f(linepath u v x)*(v - u)"
                         _ 0 1])
             using ynz \<open>0 < B\<close> \<open>0 < C\<close>
               apply (simp_all del: le_divide_eq_numeral1)
             apply (simp add: has_integral_diff has_contour_integral_linepath [symmetric] has_contour_integral_integral
                 fpi_uv f_uv contour_integrable_continuous_linepath)
             apply (auto simp: ** norm_triangle_le norm_mult cmod_diff_le simp del: le_divide_eq_numeral1)
             done
           also have "\<dots> \<le> norm y / 6"
             by simp
           finally have "norm (?pathint (shrink u) (shrink v) - ?pathint u v) \<le> norm y / 6" .
           } note * = this
           have "norm (?pathint (shrink a) (shrink b) - ?pathint a b) \<le> norm y / 6"
             using False fpi_abc by (rule_tac *) (auto simp: hull_inc)
           moreover
           have "norm (?pathint (shrink b) (shrink c) - ?pathint b c) \<le> norm y / 6"
             using False fpi_abc by (rule_tac *) (auto simp: hull_inc)
           moreover
           have "norm (?pathint (shrink c) (shrink a) - ?pathint c a) \<le> norm y / 6"
             using False fpi_abc by (rule_tac *) (auto simp: hull_inc)
           ultimately
           have "norm((?pathint (shrink a) (shrink b) - ?pathint a b) +
                      (?pathint (shrink b) (shrink c) - ?pathint b c) + (?pathint (shrink c) (shrink a) - ?pathint c a))
                 \<le> norm y / 6 + norm y / 6 + norm y / 6"
             by (metis norm_triangle_le add_mono)
           also have "\<dots> = norm y / 2"
             by simp
           finally have "norm((?pathint (shrink a) (shrink b) + ?pathint (shrink b) (shrink c) + ?pathint (shrink c) (shrink a)) -
                           (?pathint a b + ?pathint b c + ?pathint c a))
                 \<le> norm y / 2"
             by (simp add: algebra_simps)
           then
           have "norm(?pathint a b + ?pathint b c + ?pathint c a) \<le> norm y / 2"
             by (simp add: f_0_shrink) (metis (mono_tags) add.commute minus_add_distrib norm_minus_cancel uminus_add_conv_diff)
           then have "False"
             using pi_eq_y ynz by auto
         }
         moreover have "uniformly_continuous_on (convex hull {a,b,c}) f"
           by (simp add: contf compact_convex_hull compact_uniformly_continuous)
         ultimately have "False"
           unfolding uniformly_continuous_on_def
           by (force simp: ynz \<open>0 < C\<close> dist_norm)
         then show ?thesis ..
       qed
   }
   moreover have "f contour_integrable_on (linepath a b +++ linepath b c +++ linepath c a)"
     using fabc contour_integrable_continuous_linepath by auto
   ultimately show ?thesis
     using has_contour_integral_integral by fastforce
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Version allowing finite number of exceptional points\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> Cauchy_theorem_triangle_cofinite:
   assumes "continuous_on (convex hull {a,b,c}) f"
       and "finite S"
       and "(\<And>x. x \<in> interior(convex hull {a,b,c}) - S \<Longrightarrow> f field_differentiable (at x))"
      shows "(f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
 using assms
 proof (induction "card S" arbitrary: a b c S rule: less_induct)
   case (less S a b c)
   show ?case
   proof (cases "S={}")
     case True with less show ?thesis
       by (fastforce simp: holomorphic_on_def field_differentiable_at_within Cauchy_theorem_triangle_interior)
   next
     case False
     then obtain d S' where d: "S = insert d S'" "d \<notin> S'"
       by (meson Set.set_insert all_not_in_conv)
     then show ?thesis
     proof (cases "d \<in> convex hull {a,b,c}")
       case False
       show "(f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
       proof (rule less.hyps)
         show "\<And>x. x \<in> interior (convex hull {a, b, c}) - S' \<Longrightarrow> f field_differentiable at x"
         using False d interior_subset by (auto intro!: less.prems)
     qed (use d less.prems in auto)
     next
       case True
       have *: "convex hull {a, b, d} \<subseteq> convex hull {a, b, c}"
         by (meson True hull_subset insert_subset convex_hull_subset)
       have abd: "(f has_contour_integral 0) (linepath a b +++ linepath b d +++ linepath d a)"
       proof (rule less.hyps)
         show "\<And>x. x \<in> interior (convex hull {a, b, d}) - S' \<Longrightarrow> f field_differentiable at x"
           using d not_in_interior_convex_hull_3
           by (clarsimp intro!: less.prems) (metis * insert_absorb insert_subset interior_mono)
       qed (use d continuous_on_subset [OF  _ *] less.prems in auto)
       have *: "convex hull {b, c, d} \<subseteq> convex hull {a, b, c}"
         by (meson True hull_subset insert_subset convex_hull_subset)
       have bcd: "(f has_contour_integral 0) (linepath b c +++ linepath c d +++ linepath d b)"
       proof (rule less.hyps)
         show "\<And>x. x \<in> interior (convex hull {b, c, d}) - S' \<Longrightarrow> f field_differentiable at x"
           using d not_in_interior_convex_hull_3
           by (clarsimp intro!: less.prems) (metis * insert_absorb insert_subset interior_mono)
       qed (use d continuous_on_subset [OF  _ *] less.prems in auto)
       have *: "convex hull {c, a, d} \<subseteq> convex hull {a, b, c}"
         by (meson True hull_subset insert_subset convex_hull_subset)
       have cad: "(f has_contour_integral 0) (linepath c a +++ linepath a d +++ linepath d c)"
       proof (rule less.hyps)
         show "\<And>x. x \<in> interior (convex hull {c, a, d}) - S' \<Longrightarrow> f field_differentiable at x"
           using d not_in_interior_convex_hull_3
           by (clarsimp intro!: less.prems) (metis * insert_absorb insert_subset interior_mono)
       qed (use d continuous_on_subset [OF  _ *] less.prems in auto)
       have "f contour_integrable_on linepath a b"
         using less.prems abd contour_integrable_joinD1 contour_integrable_on_def by blast
       moreover have "f contour_integrable_on linepath b c"
         using less.prems bcd contour_integrable_joinD1 contour_integrable_on_def by blast
       moreover have "f contour_integrable_on linepath c a"
         using less.prems cad contour_integrable_joinD1 contour_integrable_on_def by blast
       ultimately have fpi: "f contour_integrable_on (linepath a b +++ linepath b c +++ linepath c a)"
         by auto
       { fix y::complex
         assume fy: "(f has_contour_integral y) (linepath a b +++ linepath b c +++ linepath c a)"
            and ynz: "y \<noteq> 0"
         have cont_ad: "continuous_on (closed_segment a d) f"
           by (meson "*" continuous_on_subset less.prems(1) segments_subset_convex_hull(3))
         have cont_bd: "continuous_on (closed_segment b d) f"
           by (meson True closed_segment_subset_convex_hull continuous_on_subset hull_subset insert_subset less.prems(1))
         have cont_cd: "continuous_on (closed_segment c d) f"
           by (meson "*" continuous_on_subset less.prems(1) segments_subset_convex_hull(2))
         have "contour_integral  (linepath a b) f = - (contour_integral (linepath b d) f + (contour_integral (linepath d a) f))"
              "contour_integral  (linepath b c) f = - (contour_integral (linepath c d) f + (contour_integral (linepath d b) f))"
              "contour_integral  (linepath c a) f = - (contour_integral (linepath a d) f + contour_integral (linepath d c) f)"
             using has_chain_integral_chain_integral3 [OF abd]
                   has_chain_integral_chain_integral3 [OF bcd]
                   has_chain_integral_chain_integral3 [OF cad]
             by (simp_all add: algebra_simps add_eq_0_iff)
         then have ?thesis
           using cont_ad cont_bd cont_cd fy has_chain_integral_chain_integral3 contour_integral_reverse_linepath by fastforce
       }
       then show ?thesis
         using fpi contour_integrable_on_def by blast
     qed
   qed
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Cauchy's theorem for an open starlike set\<close>
 
 lemma starlike_convex_subset:
   assumes S: "a \<in> S" "closed_segment b c \<subseteq> S" and subs: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
     shows "convex hull {a,b,c} \<subseteq> S"
       using S
       apply (clarsimp simp add: convex_hull_insert [of "{b,c}" a] segment_convex_hull)
       apply (meson subs convexD convex_closed_segment ends_in_segment(1) ends_in_segment(2) subsetCE)
       done
 
 lemma triangle_contour_integrals_starlike_primitive:
   assumes contf: "continuous_on S f"
       and S: "a \<in> S" "open S"
       and x: "x \<in> S"
       and subs: "\<And>y. y \<in> S \<Longrightarrow> closed_segment a y \<subseteq> S"
       and zer: "\<And>b c. closed_segment b c \<subseteq> S
                    \<Longrightarrow> contour_integral (linepath a b) f + contour_integral (linepath b c) f +
                        contour_integral (linepath c a) f = 0"
     shows "((\<lambda>x. contour_integral(linepath a x) f) has_field_derivative f x) (at x)"
 proof -
   let ?pathint = "\<lambda>x y. contour_integral(linepath x y) f"
   { fix e y
     assume e: "0 < e" and bxe: "ball x e \<subseteq> S" and close: "cmod (y - x) < e"
     have y: "y \<in> S"
       using bxe close  by (force simp: dist_norm norm_minus_commute)
     have cont_ayf: "continuous_on (closed_segment a y) f"
       using contf continuous_on_subset subs y by blast
     have xys: "closed_segment x y \<subseteq> S"
       apply (rule order_trans [OF _ bxe])
       using close
       by (auto simp: dist_norm ball_def norm_minus_commute dest: segment_bound)
     have "?pathint a y - ?pathint a x = ?pathint x y"
       using zer [OF xys]  contour_integral_reverse_linepath [OF cont_ayf]  add_eq_0_iff by force
   } note [simp] = this
   { fix e::real
     assume e: "0 < e"
     have cont_atx: "continuous (at x) f"
       using x S contf continuous_on_eq_continuous_at by blast
     then obtain d1 where d1: "d1>0" and d1_less: "\<And>y. cmod (y - x) < d1 \<Longrightarrow> cmod (f y - f x) < e/2"
       unfolding continuous_at Lim_at dist_norm  using e
       by (drule_tac x="e/2" in spec) force
     obtain d2 where d2: "d2>0" "ball x d2 \<subseteq> S" using  \<open>open S\<close> x
       by (auto simp: open_contains_ball)
     have dpos: "min d1 d2 > 0" using d1 d2 by simp
     { fix y
       assume yx: "y \<noteq> x" and close: "cmod (y - x) < min d1 d2"
       have y: "y \<in> S"
         using d2 close  by (force simp: dist_norm norm_minus_commute)
       have "closed_segment x y \<subseteq> S"
         using close d2  by (auto simp: dist_norm norm_minus_commute dest!: segment_bound(1))
       then have fxy: "f contour_integrable_on linepath x y"
         by (metis contour_integrable_continuous_linepath continuous_on_subset [OF contf])
       then obtain i where i: "(f has_contour_integral i) (linepath x y)"
         by (auto simp: contour_integrable_on_def)
       then have "((\<lambda>w. f w - f x) has_contour_integral (i - f x * (y - x))) (linepath x y)"
         by (rule has_contour_integral_diff [OF _ has_contour_integral_const_linepath])
       then have "cmod (i - f x * (y - x)) \<le> e / 2 * cmod (y - x)"
       proof (rule has_contour_integral_bound_linepath)
         show "\<And>u. u \<in> closed_segment x y \<Longrightarrow> cmod (f u - f x) \<le> e / 2"
           by (meson close d1_less le_less_trans less_imp_le min.strict_boundedE segment_bound1)
       qed (use e in simp)
       also have "\<dots> < e * cmod (y - x)"
         by (simp add: e yx)
       finally have "cmod (?pathint x y - f x * (y-x)) / cmod (y-x) < e"
         using i yx  by (simp add: contour_integral_unique divide_less_eq)
     }
     then have "\<exists>d>0. \<forall>y. y \<noteq> x \<and> cmod (y-x) < d \<longrightarrow> cmod (?pathint x y - f x * (y-x)) / cmod (y-x) < e"
       using dpos by blast
   }
   then have *: "(\<lambda>y. (?pathint x y - f x * (y - x)) /\<^sub>R cmod (y - x)) \<midarrow>x\<rightarrow> 0"
     by (simp add: Lim_at dist_norm inverse_eq_divide)
   show ?thesis
     apply (simp add: has_field_derivative_def has_derivative_at2 bounded_linear_mult_right)
     apply (rule Lim_transform [OF * tendsto_eventually])
     using \<open>open S\<close> x apply (force simp: dist_norm open_contains_ball inverse_eq_divide [symmetric] eventually_at)
     done
 qed
 
 (** Existence of a primitive.*)
 lemma holomorphic_starlike_primitive:
   fixes f :: "complex \<Rightarrow> complex"
   assumes contf: "continuous_on S f"
       and S: "starlike S" and os: "open S"
       and k: "finite k"
       and fcd: "\<And>x. x \<in> S - k \<Longrightarrow> f field_differentiable at x"
     shows "\<exists>g. \<forall>x \<in> S. (g has_field_derivative f x) (at x)"
 proof -
   obtain a where a: "a\<in>S" and a_cs: "\<And>x. x\<in>S \<Longrightarrow> closed_segment a x \<subseteq> S"
     using S by (auto simp: starlike_def)
   { fix x b c
     assume "x \<in> S" "closed_segment b c \<subseteq> S"
     then have abcs: "convex hull {a, b, c} \<subseteq> S"
       by (simp add: a a_cs starlike_convex_subset)
     then have "continuous_on (convex hull {a, b, c}) f"
       by (simp add: continuous_on_subset [OF contf])
     then have "(f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
       using abcs interior_subset by (force intro: fcd Cauchy_theorem_triangle_cofinite [OF _ k])
   } note 0 = this
   show ?thesis
     apply (intro exI ballI)
     apply (rule triangle_contour_integrals_starlike_primitive [OF contf a os], assumption)
     apply (metis a_cs)
     apply (metis has_chain_integral_chain_integral3 0)
     done
 qed
 
 lemma Cauchy_theorem_starlike:
  "\<lbrakk>open S; starlike S; finite k; continuous_on S f;
    \<And>x. x \<in> S - k \<Longrightarrow> f field_differentiable at x;
    valid_path g; path_image g \<subseteq> S; pathfinish g = pathstart g\<rbrakk>
    \<Longrightarrow> (f has_contour_integral 0)  g"
   by (metis holomorphic_starlike_primitive Cauchy_theorem_primitive at_within_open)
 
 lemma Cauchy_theorem_starlike_simple:
   "\<lbrakk>open S; starlike S; f holomorphic_on S; valid_path g; path_image g \<subseteq> S; pathfinish g = pathstart g\<rbrakk>
    \<Longrightarrow> (f has_contour_integral 0) g"
 apply (rule Cauchy_theorem_starlike [OF _ _ finite.emptyI])
 apply (simp_all add: holomorphic_on_imp_continuous_on)
 apply (metis at_within_open holomorphic_on_def)
 done
 
 subsection\<open>Cauchy's theorem for a convex set\<close>
 
 text\<open>For a convex set we can avoid assuming openness and boundary analyticity\<close>
 
 lemma triangle_contour_integrals_convex_primitive:
   assumes contf: "continuous_on S f"
       and S: "a \<in> S" "convex S"
       and x: "x \<in> S"
       and zer: "\<And>b c. \<lbrakk>b \<in> S; c \<in> S\<rbrakk>
                    \<Longrightarrow> contour_integral (linepath a b) f + contour_integral (linepath b c) f +
                        contour_integral (linepath c a) f = 0"
     shows "((\<lambda>x. contour_integral(linepath a x) f) has_field_derivative f x) (at x within S)"
 proof -
   let ?pathint = "\<lambda>x y. contour_integral(linepath x y) f"
   { fix y
     assume y: "y \<in> S"
     have cont_ayf: "continuous_on (closed_segment a y) f"
       using S y  by (meson contf continuous_on_subset convex_contains_segment)
     have xys: "closed_segment x y \<subseteq> S"  (*?*)
       using convex_contains_segment S x y by auto
     have "?pathint a y - ?pathint a x = ?pathint x y"
       using zer [OF x y]  contour_integral_reverse_linepath [OF cont_ayf]  add_eq_0_iff by force
   } note [simp] = this
   { fix e::real
     assume e: "0 < e"
     have cont_atx: "continuous (at x within S) f"
       using x S contf  by (simp add: continuous_on_eq_continuous_within)
     then obtain d1 where d1: "d1>0" and d1_less: "\<And>y. \<lbrakk>y \<in> S; cmod (y - x) < d1\<rbrakk> \<Longrightarrow> cmod (f y - f x) < e/2"
       unfolding continuous_within Lim_within dist_norm using e
       by (drule_tac x="e/2" in spec) force
     { fix y
       assume yx: "y \<noteq> x" and close: "cmod (y - x) < d1" and y: "y \<in> S"
       have fxy: "f contour_integrable_on linepath x y"
         using convex_contains_segment S x y
         by (blast intro!: contour_integrable_continuous_linepath continuous_on_subset [OF contf])
       then obtain i where i: "(f has_contour_integral i) (linepath x y)"
         by (auto simp: contour_integrable_on_def)
       then have "((\<lambda>w. f w - f x) has_contour_integral (i - f x * (y - x))) (linepath x y)"
         by (rule has_contour_integral_diff [OF _ has_contour_integral_const_linepath])
       then have "cmod (i - f x * (y - x)) \<le> e / 2 * cmod (y - x)"
       proof (rule has_contour_integral_bound_linepath)
         show "\<And>u. u \<in> closed_segment x y \<Longrightarrow> cmod (f u - f x) \<le> e / 2"
           by (meson assms(3) close convex_contains_segment d1_less le_less_trans less_imp_le segment_bound1 subset_iff x y)
       qed (use e in simp)
       also have "\<dots> < e * cmod (y - x)"
         by (simp add: e yx)
       finally have "cmod (?pathint x y - f x * (y-x)) / cmod (y-x) < e"
         using i yx  by (simp add: contour_integral_unique divide_less_eq)
     }
     then have "\<exists>d>0. \<forall>y\<in>S. y \<noteq> x \<and> cmod (y-x) < d \<longrightarrow> cmod (?pathint x y - f x * (y-x)) / cmod (y-x) < e"
       using d1 by blast
   }
   then have *: "((\<lambda>y. (contour_integral (linepath x y) f - f x * (y - x)) /\<^sub>R cmod (y - x)) \<longlongrightarrow> 0) (at x within S)"
     by (simp add: Lim_within dist_norm inverse_eq_divide)
   show ?thesis
     apply (simp add: has_field_derivative_def has_derivative_within bounded_linear_mult_right)
     apply (rule Lim_transform [OF * tendsto_eventually])
     using linordered_field_no_ub
     apply (force simp: inverse_eq_divide [symmetric] eventually_at)
     done
 qed
 
 lemma contour_integral_convex_primitive:
   assumes "convex S" "continuous_on S f"
           "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S\<rbrakk> \<Longrightarrow> (f has_contour_integral 0) (linepath a b +++ linepath b c +++ linepath c a)"
   obtains g where "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative f x) (at x within S)"
 proof (cases "S={}")
   case False
   with assms that show ?thesis
     by (blast intro: triangle_contour_integrals_convex_primitive has_chain_integral_chain_integral3)
 qed auto
 
 lemma holomorphic_convex_primitive:
   fixes f :: "complex \<Rightarrow> complex"
   assumes "convex S" "finite K" and contf: "continuous_on S f"
     and fd: "\<And>x. x \<in> interior S - K \<Longrightarrow> f field_differentiable at x"
   obtains g where "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative f x) (at x within S)"
 proof (rule contour_integral_convex_primitive [OF \<open>convex S\<close> contf Cauchy_theorem_triangle_cofinite])
   have *: "convex hull {a, b, c} \<subseteq> S" if "a \<in> S" "b \<in> S" "c \<in> S" for a b c
     by (simp add: \<open>convex S\<close> hull_minimal that)
   show "continuous_on (convex hull {a, b, c}) f" if "a \<in> S" "b \<in> S" "c \<in> S" for a b c
     by (meson "*" contf continuous_on_subset that)
   show "f field_differentiable at x" if "a \<in> S" "b \<in> S" "c \<in> S" "x \<in> interior (convex hull {a, b, c}) - K" for a b c x
     by (metis "*" DiffD1 DiffD2 DiffI fd interior_mono subsetCE that)
 qed (use assms in \<open>force+\<close>)
 
 lemma holomorphic_convex_primitive':
   fixes f :: "complex \<Rightarrow> complex"
   assumes "convex S" and "open S" and "f holomorphic_on S"
   obtains g where "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative f x) (at x within S)"
 proof (rule holomorphic_convex_primitive)
   fix x assume "x \<in> interior S - {}"
   with assms show "f field_differentiable at x"
     by (auto intro!: holomorphic_on_imp_differentiable_at simp: interior_open)
 qed (use assms in \<open>auto intro: holomorphic_on_imp_continuous_on\<close>)
 
 corollary\<^marker>\<open>tag unimportant\<close> Cauchy_theorem_convex:
     "\<lbrakk>continuous_on S f; convex S; finite K;
       \<And>x. x \<in> interior S - K \<Longrightarrow> f field_differentiable at x;
       valid_path g; path_image g \<subseteq> S; pathfinish g = pathstart g\<rbrakk>
      \<Longrightarrow> (f has_contour_integral 0) g"
   by (metis holomorphic_convex_primitive Cauchy_theorem_primitive)
 
 corollary Cauchy_theorem_convex_simple:
     "\<lbrakk>f holomorphic_on S; convex S;
      valid_path g; path_image g \<subseteq> S;
      pathfinish g = pathstart g\<rbrakk> \<Longrightarrow> (f has_contour_integral 0) g"
   apply (rule Cauchy_theorem_convex [where K = "{}"])
   apply (simp_all add: holomorphic_on_imp_continuous_on)
   using at_within_interior holomorphic_on_def interior_subset by fastforce
 
 text\<open>In particular for a disc\<close>
 corollary\<^marker>\<open>tag unimportant\<close> Cauchy_theorem_disc:
     "\<lbrakk>finite K; continuous_on (cball a e) f;
       \<And>x. x \<in> ball a e - K \<Longrightarrow> f field_differentiable at x;
      valid_path g; path_image g \<subseteq> cball a e;
      pathfinish g = pathstart g\<rbrakk> \<Longrightarrow> (f has_contour_integral 0) g"
   by (auto intro: Cauchy_theorem_convex)
 
 corollary\<^marker>\<open>tag unimportant\<close> Cauchy_theorem_disc_simple:
     "\<lbrakk>f holomorphic_on (ball a e); valid_path g; path_image g \<subseteq> ball a e;
      pathfinish g = pathstart g\<rbrakk> \<Longrightarrow> (f has_contour_integral 0) g"
 by (simp add: Cauchy_theorem_convex_simple)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Generalize integrability to local primitives\<close>
 
 lemma contour_integral_local_primitive_lemma:
   fixes f :: "complex\<Rightarrow>complex"
   shows
     "\<lbrakk>g piecewise_differentiable_on {a..b};
       \<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative f' x) (at x within s);
       \<And>x. x \<in> {a..b} \<Longrightarrow> g x \<in> s\<rbrakk>
      \<Longrightarrow> (\<lambda>x. f' (g x) * vector_derivative g (at x within {a..b}))
             integrable_on {a..b}"
   apply (cases "cbox a b = {}", force)
   apply (simp add: integrable_on_def)
   apply (rule exI)
   apply (rule contour_integral_primitive_lemma, assumption+)
   using atLeastAtMost_iff by blast
 
 lemma contour_integral_local_primitive_any:
   fixes f :: "complex \<Rightarrow> complex"
   assumes gpd: "g piecewise_differentiable_on {a..b}"
       and dh: "\<And>x. x \<in> s
                \<Longrightarrow> \<exists>d h. 0 < d \<and>
                          (\<forall>y. norm(y - x) < d \<longrightarrow> (h has_field_derivative f y) (at y within s))"
       and gs: "\<And>x. x \<in> {a..b} \<Longrightarrow> g x \<in> s"
   shows "(\<lambda>x. f(g x) * vector_derivative g (at x)) integrable_on {a..b}"
 proof -
   { fix x
     assume x: "a \<le> x" "x \<le> b"
     obtain d h where d: "0 < d"
                and h: "(\<And>y. norm(y - g x) < d \<Longrightarrow> (h has_field_derivative f y) (at y within s))"
       using x gs dh by (metis atLeastAtMost_iff)
     have "continuous_on {a..b} g" using gpd piecewise_differentiable_on_def by blast
     then obtain e where e: "e>0" and lessd: "\<And>x'. x' \<in> {a..b} \<Longrightarrow> \<bar>x' - x\<bar> < e \<Longrightarrow> cmod (g x' - g x) < d"
       using x d
       apply (auto simp: dist_norm continuous_on_iff)
       apply (drule_tac x=x in bspec)
       using x apply simp
       apply (drule_tac x=d in spec, auto)
       done
     have "\<exists>d>0. \<forall>u v. u \<le> x \<and> x \<le> v \<and> {u..v} \<subseteq> ball x d \<and> (u \<le> v \<longrightarrow> a \<le> u \<and> v \<le> b) \<longrightarrow>
                           (\<lambda>x. f (g x) * vector_derivative g (at x)) integrable_on {u..v}"
       apply (rule_tac x=e in exI)
       using e
       apply (simp add: integrable_on_localized_vector_derivative [symmetric], clarify)
       apply (rule_tac f = h and s = "g ` {u..v}" in contour_integral_local_primitive_lemma)
         apply (meson atLeastatMost_subset_iff gpd piecewise_differentiable_on_subset)
        apply (force simp: ball_def dist_norm intro: lessd gs DERIV_subset [OF h], force)
       done
   } then
   show ?thesis
     by (force simp: intro!: integrable_on_little_subintervals [of a b, simplified])
 qed
 
 lemma contour_integral_local_primitive:
   fixes f :: "complex \<Rightarrow> complex"
   assumes g: "valid_path g" "path_image g \<subseteq> s"
       and dh: "\<And>x. x \<in> s
                \<Longrightarrow> \<exists>d h. 0 < d \<and>
                          (\<forall>y. norm(y - x) < d \<longrightarrow> (h has_field_derivative f y) (at y within s))"
   shows "f contour_integrable_on g"
   using g
   apply (simp add: valid_path_def path_image_def contour_integrable_on_def has_contour_integral_def
             has_integral_localized_vector_derivative integrable_on_def [symmetric])
   using contour_integral_local_primitive_any [OF _ dh]
   by (meson image_subset_iff piecewise_C1_imp_differentiable)
 
 
 text\<open>In particular if a function is holomorphic\<close>
 
 lemma contour_integrable_holomorphic:
   assumes contf: "continuous_on s f"
       and os: "open s"
       and k: "finite k"
       and g: "valid_path g" "path_image g \<subseteq> s"
       and fcd: "\<And>x. x \<in> s - k \<Longrightarrow> f field_differentiable at x"
     shows "f contour_integrable_on g"
 proof -
   { fix z
     assume z: "z \<in> s"
     obtain d where "d>0" and d: "ball z d \<subseteq> s" using  \<open>open s\<close> z
       by (auto simp: open_contains_ball)
     then have contfb: "continuous_on (ball z d) f"
       using contf continuous_on_subset by blast
     obtain h where "\<forall>y\<in>ball z d. (h has_field_derivative f y) (at y within ball z d)"
       by (metis holomorphic_convex_primitive [OF convex_ball k contfb fcd] d interior_subset Diff_iff subsetD)
     then have "\<forall>y\<in>ball z d. (h has_field_derivative f y) (at y within s)"
       by (metis open_ball at_within_open d os subsetCE)
     then have "\<exists>h. (\<forall>y. cmod (y - z) < d \<longrightarrow> (h has_field_derivative f y) (at y within s))"
       by (force simp: dist_norm norm_minus_commute)
     then have "\<exists>d h. 0 < d \<and> (\<forall>y. cmod (y - z) < d \<longrightarrow> (h has_field_derivative f y) (at y within s))"
       using \<open>0 < d\<close> by blast
   }
   then show ?thesis
     by (rule contour_integral_local_primitive [OF g])
 qed
 
 lemma contour_integrable_holomorphic_simple:
   assumes fh: "f holomorphic_on S"
       and os: "open S"
       and g: "valid_path g" "path_image g \<subseteq> S"
     shows "f contour_integrable_on g"
   apply (rule contour_integrable_holomorphic [OF _ os Finite_Set.finite.emptyI g])
   apply (simp add: fh holomorphic_on_imp_continuous_on)
   using fh  by (simp add: field_differentiable_def holomorphic_on_open os)
 
 lemma continuous_on_inversediff:
   fixes z:: "'a::real_normed_field" shows "z \<notin> S \<Longrightarrow> continuous_on S (\<lambda>w. 1 / (w - z))"
   by (rule continuous_intros | force)+
 
 lemma contour_integrable_inversediff:
     "\<lbrakk>valid_path g; z \<notin> path_image g\<rbrakk> \<Longrightarrow> (\<lambda>w. 1 / (w-z)) contour_integrable_on g"
 apply (rule contour_integrable_holomorphic_simple [of _ "UNIV-{z}"])
 apply (auto simp: holomorphic_on_open open_delete intro!: derivative_eq_intros)
 done
 
 text\<open>Key fact that path integral is the same for a "nearby" path. This is the
  main lemma for the homotopy form of Cauchy's theorem and is also useful
  if we want "without loss of generality" to assume some nice properties of a
  path (e.g. smoothness). It can also be used to define the integrals of
  analytic functions over arbitrary continuous paths. This is just done for
  winding numbers now.
 \<close>
 
 text\<open>A technical definition to avoid duplication of similar proofs,
      for paths joined at the ends versus looping paths\<close>
 definition linked_paths :: "bool \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "linked_paths atends g h ==
         (if atends then pathstart h = pathstart g \<and> pathfinish h = pathfinish g
                    else pathfinish g = pathstart g \<and> pathfinish h = pathstart h)"
 
 text\<open>This formulation covers two cases: \<^term>\<open>g\<close> and \<^term>\<open>h\<close> share their
       start and end points; \<^term>\<open>g\<close> and \<^term>\<open>h\<close> both loop upon themselves.\<close>
 lemma contour_integral_nearby:
   assumes os: "open S" and p: "path p" "path_image p \<subseteq> S"
   shows "\<exists>d. 0 < d \<and>
             (\<forall>g h. valid_path g \<and> valid_path h \<and>
                   (\<forall>t \<in> {0..1}. norm(g t - p t) < d \<and> norm(h t - p t) < d) \<and>
                   linked_paths atends g h
                   \<longrightarrow> path_image g \<subseteq> S \<and> path_image h \<subseteq> S \<and>
                       (\<forall>f. f holomorphic_on S \<longrightarrow> contour_integral h f = contour_integral g f))"
 proof -
   have "\<forall>z. \<exists>e. z \<in> path_image p \<longrightarrow> 0 < e \<and> ball z e \<subseteq> S"
     using open_contains_ball os p(2) by blast
   then obtain ee where ee: "\<And>z. z \<in> path_image p \<Longrightarrow> 0 < ee z \<and> ball z (ee z) \<subseteq> S"
     by metis
   define cover where "cover = (\<lambda>z. ball z (ee z/3)) ` (path_image p)"
   have "compact (path_image p)"
     by (metis p(1) compact_path_image)
   moreover have "path_image p \<subseteq> (\<Union>c\<in>path_image p. ball c (ee c / 3))"
     using ee by auto
   ultimately have "\<exists>D \<subseteq> cover. finite D \<and> path_image p \<subseteq> \<Union>D"
     by (simp add: compact_eq_Heine_Borel cover_def)
   then obtain D where D: "D \<subseteq> cover" "finite D" "path_image p \<subseteq> \<Union>D"
     by blast
   then obtain k where k: "k \<subseteq> {0..1}" "finite k" and D_eq: "D = ((\<lambda>z. ball z (ee z / 3)) \<circ> p) ` k"
     apply (simp add: cover_def path_image_def image_comp)
     apply (blast dest!: finite_subset_image [OF \<open>finite D\<close>])
     done
   then have kne: "k \<noteq> {}"
     using D by auto
   have pi: "\<And>i. i \<in> k \<Longrightarrow> p i \<in> path_image p"
     using k  by (auto simp: path_image_def)
   then have eepi: "\<And>i. i \<in> k \<Longrightarrow> 0 < ee((p i))"
     by (metis ee)
   define e where "e = Min((ee \<circ> p) ` k)"
   have fin_eep: "finite ((ee \<circ> p) ` k)"
     using k  by blast
   have "0 < e"
     using ee k  by (simp add: kne e_def Min_gr_iff [OF fin_eep] eepi)
   have "uniformly_continuous_on {0..1} p"
     using p  by (simp add: path_def compact_uniformly_continuous)
   then obtain d::real where d: "d>0"
           and de: "\<And>x x'. \<bar>x' - x\<bar> < d \<Longrightarrow> x\<in>{0..1} \<Longrightarrow> x'\<in>{0..1} \<Longrightarrow> cmod (p x' - p x) < e/3"
     unfolding uniformly_continuous_on_def dist_norm real_norm_def
     by (metis divide_pos_pos \<open>0 < e\<close> zero_less_numeral)
   then obtain N::nat where N: "N>0" "inverse N < d"
     using real_arch_inverse [of d]   by auto
   show ?thesis
   proof (intro exI conjI allI; clarify?)
     show "e/3 > 0"
       using \<open>0 < e\<close> by simp
     fix g h
     assume g: "valid_path g" and ghp: "\<forall>t\<in>{0..1}. cmod (g t - p t) < e / 3 \<and>  cmod (h t - p t) < e / 3"
        and h: "valid_path h"
        and joins: "linked_paths atends g h"
     { fix t::real
       assume t: "0 \<le> t" "t \<le> 1"
       then obtain u where u: "u \<in> k" and ptu: "p t \<in> ball(p u) (ee(p u) / 3)"
         using \<open>path_image p \<subseteq> \<Union>D\<close> D_eq by (force simp: path_image_def)
       then have ele: "e \<le> ee (p u)" using fin_eep
         by (simp add: e_def)
       have "cmod (g t - p t) < e / 3" "cmod (h t - p t) < e / 3"
         using ghp t by auto
       with ele have "cmod (g t - p t) < ee (p u) / 3"
                     "cmod (h t - p t) < ee (p u) / 3"
         by linarith+
       then have "g t \<in> ball(p u) (ee(p u))"  "h t \<in> ball(p u) (ee(p u))"
         using norm_diff_triangle_ineq [of "g t" "p t" "p t" "p u"]
               norm_diff_triangle_ineq [of "h t" "p t" "p t" "p u"] ptu eepi u
         by (force simp: dist_norm ball_def norm_minus_commute)+
       then have "g t \<in> S" "h t \<in> S" using ee u k
         by (auto simp: path_image_def ball_def)
     }
     then have ghs: "path_image g \<subseteq> S" "path_image h \<subseteq> S"
       by (auto simp: path_image_def)
     moreover
     { fix f
       assume fhols: "f holomorphic_on S"
       then have fpa: "f contour_integrable_on g"  "f contour_integrable_on h"
         using g ghs h holomorphic_on_imp_continuous_on os contour_integrable_holomorphic_simple
         by blast+
       have contf: "continuous_on S f"
         by (simp add: fhols holomorphic_on_imp_continuous_on)
       { fix z
         assume z: "z \<in> path_image p"
         have "f holomorphic_on ball z (ee z)"
           using fhols ee z holomorphic_on_subset by blast
         then have "\<exists>ff. (\<forall>w \<in> ball z (ee z). (ff has_field_derivative f w) (at w))"
           using holomorphic_convex_primitive [of "ball z (ee z)" "{}" f, simplified]
           by (metis open_ball at_within_open holomorphic_on_def holomorphic_on_imp_continuous_on mem_ball)
       }
       then obtain ff where ff:
             "\<And>z w. \<lbrakk>z \<in> path_image p; w \<in> ball z (ee z)\<rbrakk> \<Longrightarrow> (ff z has_field_derivative f w) (at w)"
         by metis
       { fix n
         assume n: "n \<le> N"
         then have "contour_integral(subpath 0 (n/N) h) f - contour_integral(subpath 0 (n/N) g) f =
                    contour_integral(linepath (g(n/N)) (h(n/N))) f - contour_integral(linepath (g 0) (h 0)) f"
         proof (induct n)
           case 0 show ?case by simp
         next
           case (Suc n)
           obtain t where t: "t \<in> k" and "p (n/N) \<in> ball(p t) (ee(p t) / 3)"
             using \<open>path_image p \<subseteq> \<Union>D\<close> [THEN subsetD, where c="p (n/N)"] D_eq N Suc.prems
             by (force simp: path_image_def)
           then have ptu: "cmod (p t - p (n/N)) < ee (p t) / 3"
             by (simp add: dist_norm)
           have e3le: "e/3 \<le> ee (p t) / 3"  using fin_eep t
             by (simp add: e_def)
           { fix x
             assume x: "n/N \<le> x" "x \<le> (1 + n)/N"
             then have nN01: "0 \<le> n/N" "(1 + n)/N \<le> 1"
               using Suc.prems by auto
             then have x01: "0 \<le> x" "x \<le> 1"
               using x by linarith+
             have "cmod (p t - p x)  < ee (p t) / 3 + e/3"
             proof (rule norm_diff_triangle_less [OF ptu de])
               show "\<bar>real n / real N - x\<bar> < d"
                 using x N by (auto simp: field_simps)
             qed (use x01 Suc.prems in auto)
             then have ptx: "cmod (p t - p x) < 2*ee (p t)/3"
               using e3le eepi [OF t] by simp
             have "cmod (p t - g x) < 2*ee (p t)/3 + e/3 "
               apply (rule norm_diff_triangle_less [OF ptx])
               using ghp x01 by (simp add: norm_minus_commute)
             also have "\<dots> \<le> ee (p t)"
               using e3le eepi [OF t] by simp
             finally have gg: "cmod (p t - g x) < ee (p t)" .
             have "cmod (p t - h x) < 2*ee (p t)/3 + e/3 "
               apply (rule norm_diff_triangle_less [OF ptx])
               using ghp x01 by (simp add: norm_minus_commute)
             also have "\<dots> \<le> ee (p t)"
               using e3le eepi [OF t] by simp
             finally have "cmod (p t - g x) < ee (p t)"
                          "cmod (p t - h x) < ee (p t)"
               using gg by auto
           } note ptgh_ee = this
           have "closed_segment (g (real n / real N)) (h (real n / real N)) = path_image (linepath (h (n/N)) (g (n/N)))"
             by (simp add: closed_segment_commute)
           also have pi_hgn: "\<dots> \<subseteq> ball (p t) (ee (p t))"
             using ptgh_ee [of "n/N"] Suc.prems
             by (auto simp: field_simps dist_norm dest: segment_furthest_le [where y="p t"])
           finally have gh_ns: "closed_segment (g (n/N)) (h (n/N)) \<subseteq> S"
             using ee pi t by blast
           have pi_ghn': "path_image (linepath (g ((1 + n) / N)) (h ((1 + n) / N))) \<subseteq> ball (p t) (ee (p t))"
             using ptgh_ee [of "(1+n)/N"] Suc.prems
             by (auto simp: field_simps dist_norm dest: segment_furthest_le [where y="p t"])
           then have gh_n's: "closed_segment (g ((1 + n) / N)) (h ((1 + n) / N)) \<subseteq> S"
             using \<open>N>0\<close> Suc.prems ee pi t
             by (auto simp: Path_Connected.path_image_join field_simps)
           have pi_subset_ball:
                 "path_image (subpath (n/N) ((1+n) / N) g +++ linepath (g ((1+n) / N)) (h ((1+n) / N)) +++
                              subpath ((1+n) / N) (n/N) h +++ linepath (h (n/N)) (g (n/N)))
                  \<subseteq> ball (p t) (ee (p t))"
             apply (intro subset_path_image_join pi_hgn pi_ghn')
             using \<open>N>0\<close> Suc.prems
             apply (auto simp: path_image_subpath dist_norm field_simps closed_segment_eq_real_ivl ptgh_ee)
             done
           have pi0: "(f has_contour_integral 0)
                        (subpath (n/ N) ((Suc n)/N) g +++ linepath(g ((Suc n) / N)) (h((Suc n) / N)) +++
                         subpath ((Suc n) / N) (n/N) h +++ linepath(h (n/N)) (g (n/N)))"
             apply (rule Cauchy_theorem_primitive [of "ball(p t) (ee(p t))" "ff (p t)" "f"])
             apply (metis ff open_ball at_within_open pi t)
             using Suc.prems pi_subset_ball apply (simp_all add: valid_path_join valid_path_subpath g h)
             done
           have fpa1: "f contour_integrable_on subpath (real n / real N) (real (Suc n) / real N) g"
             using Suc.prems by (simp add: contour_integrable_subpath g fpa)
           have fpa2: "f contour_integrable_on linepath (g (real (Suc n) / real N)) (h (real (Suc n) / real N))"
             using gh_n's
             by (auto intro!: contour_integrable_continuous_linepath continuous_on_subset [OF contf])
           have fpa3: "f contour_integrable_on linepath (h (real n / real N)) (g (real n / real N))"
             using gh_ns
             by (auto simp: closed_segment_commute intro!: contour_integrable_continuous_linepath continuous_on_subset [OF contf])
           have eq0: "contour_integral (subpath (n/N) ((Suc n) / real N) g) f +
                      contour_integral (linepath (g ((Suc n) / N)) (h ((Suc n) / N))) f +
                      contour_integral (subpath ((Suc n) / N) (n/N) h) f +
                      contour_integral (linepath (h (n/N)) (g (n/N))) f = 0"
             using contour_integral_unique [OF pi0] Suc.prems
             by (simp add: g h fpa valid_path_subpath contour_integrable_subpath
                           fpa1 fpa2 fpa3 algebra_simps del: of_nat_Suc)
           have *: "\<And>hn he hn' gn gd gn' hgn ghn gh0 ghn'.
                     \<lbrakk>hn - gn = ghn - gh0;
                      gd + ghn' + he + hgn = (0::complex);
                      hn - he = hn'; gn + gd = gn'; hgn = -ghn\<rbrakk> \<Longrightarrow> hn' - gn' = ghn' - gh0"
             by (auto simp: algebra_simps)
           have "contour_integral (subpath 0 (n/N) h) f - contour_integral (subpath ((Suc n) / N) (n/N) h) f =
                 contour_integral (subpath 0 (n/N) h) f + contour_integral (subpath (n/N) ((Suc n) / N) h) f"
             unfolding reversepath_subpath [symmetric, of "((Suc n) / N)"]
             using Suc.prems by (simp add: h fpa contour_integral_reversepath valid_path_subpath contour_integrable_subpath)
           also have "\<dots> = contour_integral (subpath 0 ((Suc n) / N) h) f"
             using Suc.prems by (simp add: contour_integral_subpath_combine h fpa)
           finally have pi0_eq:
                "contour_integral (subpath 0 (n/N) h) f - contour_integral (subpath ((Suc n) / N) (n/N) h) f =
                 contour_integral (subpath 0 ((Suc n) / N) h) f" .
           show ?case
             apply (rule * [OF Suc.hyps eq0 pi0_eq])
             using Suc.prems
             apply (simp_all add: g h fpa contour_integral_subpath_combine
                      contour_integral_reversepath [symmetric] contour_integrable_continuous_linepath
                      continuous_on_subset [OF contf gh_ns])
             done
       qed
       } note ind = this
       have "contour_integral h f = contour_integral g f"
         using ind [OF order_refl] N joins
         by (simp add: linked_paths_def pathstart_def pathfinish_def split: if_split_asm)
     }
     ultimately
     show "path_image g \<subseteq> S \<and> path_image h \<subseteq> S \<and> (\<forall>f. f holomorphic_on S \<longrightarrow> contour_integral h f = contour_integral g f)"
       by metis
   qed
 qed
 
 
 lemma
   assumes "open S" "path p" "path_image p \<subseteq> S"
     shows contour_integral_nearby_ends:
       "\<exists>d. 0 < d \<and>
               (\<forall>g h. valid_path g \<and> valid_path h \<and>
                     (\<forall>t \<in> {0..1}. norm(g t - p t) < d \<and> norm(h t - p t) < d) \<and>
                     pathstart h = pathstart g \<and> pathfinish h = pathfinish g
                     \<longrightarrow> path_image g \<subseteq> S \<and>
                         path_image h \<subseteq> S \<and>
                         (\<forall>f. f holomorphic_on S
                             \<longrightarrow> contour_integral h f = contour_integral g f))"
     and contour_integral_nearby_loops:
       "\<exists>d. 0 < d \<and>
               (\<forall>g h. valid_path g \<and> valid_path h \<and>
                     (\<forall>t \<in> {0..1}. norm(g t - p t) < d \<and> norm(h t - p t) < d) \<and>
                     pathfinish g = pathstart g \<and> pathfinish h = pathstart h
                     \<longrightarrow> path_image g \<subseteq> S \<and>
                         path_image h \<subseteq> S \<and>
                         (\<forall>f. f holomorphic_on S
                             \<longrightarrow> contour_integral h f = contour_integral g f))"
   using contour_integral_nearby [OF assms, where atends=True]
   using contour_integral_nearby [OF assms, where atends=False]
   unfolding linked_paths_def by simp_all
 
 lemma C1_differentiable_polynomial_function:
   fixes p :: "real \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function p \<Longrightarrow> p C1_differentiable_on S"
   by (metis continuous_on_polymonial_function C1_differentiable_on_def  has_vector_derivative_polynomial_function)
 
 lemma valid_path_polynomial_function:
   fixes p :: "real \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function p \<Longrightarrow> valid_path p"
 by (force simp: valid_path_def piecewise_C1_differentiable_on_def continuous_on_polymonial_function C1_differentiable_polynomial_function)
 
 lemma valid_path_subpath_trivial [simp]:
     fixes g :: "real \<Rightarrow> 'a::euclidean_space"
     shows "z \<noteq> g x \<Longrightarrow> valid_path (subpath x x g)"
   by (simp add: subpath_def valid_path_polynomial_function)
 
 lemma contour_integral_bound_exists:
 assumes S: "open S"
     and g: "valid_path g"
     and pag: "path_image g \<subseteq> S"
   shows "\<exists>L. 0 < L \<and>
              (\<forall>f B. f holomorphic_on S \<and> (\<forall>z \<in> S. norm(f z) \<le> B)
                \<longrightarrow> norm(contour_integral g f) \<le> L*B)"
 proof -
   have "path g" using g
     by (simp add: valid_path_imp_path)
   then obtain d::real and p
     where d: "0 < d"
       and p: "polynomial_function p" "path_image p \<subseteq> S"
       and pi: "\<And>f. f holomorphic_on S \<Longrightarrow> contour_integral g f = contour_integral p f"
     using contour_integral_nearby_ends [OF S \<open>path g\<close> pag]
     apply clarify
     apply (drule_tac x=g in spec)
     apply (simp only: assms)
     apply (force simp: valid_path_polynomial_function dest: path_approx_polynomial_function)
     done
   then obtain p' where p': "polynomial_function p'"
     "\<And>x. (p has_vector_derivative (p' x)) (at x)"
     by (blast intro: has_vector_derivative_polynomial_function that)
   then have "bounded(p' ` {0..1})"
     using continuous_on_polymonial_function
     by (force simp: intro!: compact_imp_bounded compact_continuous_image)
   then obtain L where L: "L>0" and nop': "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> norm (p' x) \<le> L"
     by (force simp: bounded_pos)
   { fix f B
     assume f: "f holomorphic_on S" and B: "\<And>z. z\<in>S \<Longrightarrow> cmod (f z) \<le> B"
     then have "f contour_integrable_on p \<and> valid_path p"
       using p S
       by (blast intro: valid_path_polynomial_function contour_integrable_holomorphic_simple holomorphic_on_imp_continuous_on)
     moreover have "cmod (vector_derivative p (at x)) * cmod (f (p x)) \<le> L * B" if "0 \<le> x" "x \<le> 1" for x
     proof (rule mult_mono)
       show "cmod (vector_derivative p (at x)) \<le> L"
         by (metis nop' p'(2) that vector_derivative_at)
       show "cmod (f (p x)) \<le> B"
         by (metis B atLeastAtMost_iff imageI p(2) path_defs(4) subset_eq that)
     qed (use \<open>L>0\<close> in auto)
     ultimately have "cmod (contour_integral g f) \<le> L * B"
       apply (simp only: pi [OF f])
       apply (simp only: contour_integral_integral)
       apply (rule order_trans [OF integral_norm_bound_integral])
          apply (auto simp: mult.commute integral_norm_bound_integral contour_integrable_on [symmetric] norm_mult)
       done
   } then
   show ?thesis
     by (force simp: L contour_integral_integral)
 qed
 
 text\<open>We can treat even non-rectifiable paths as having a "length" for bounds on analytic functions in open sets.\<close>
 
 subsection \<open>Winding Numbers\<close>
 
 definition\<^marker>\<open>tag important\<close> winding_number_prop :: "[real \<Rightarrow> complex, complex, real, real \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "winding_number_prop \<gamma> z e p n \<equiv>
       valid_path p \<and> z \<notin> path_image p \<and>
       pathstart p = pathstart \<gamma> \<and>
       pathfinish p = pathfinish \<gamma> \<and>
       (\<forall>t \<in> {0..1}. norm(\<gamma> t - p t) < e) \<and>
       contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
 
 definition\<^marker>\<open>tag important\<close> winding_number:: "[real \<Rightarrow> complex, complex] \<Rightarrow> complex" where
   "winding_number \<gamma> z \<equiv> SOME n. \<forall>e > 0. \<exists>p. winding_number_prop \<gamma> z e p n"
 
 
 lemma winding_number:
   assumes "path \<gamma>" "z \<notin> path_image \<gamma>" "0 < e"
     shows "\<exists>p. winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain d
     where d: "d>0"
       and pi_eq: "\<And>h1 h2. valid_path h1 \<and> valid_path h2 \<and>
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < d \<and> cmod (h2 t - \<gamma> t) < d) \<and>
                     pathstart h2 = pathstart h1 \<and> pathfinish h2 = pathfinish h1 \<longrightarrow>
                       path_image h1 \<subseteq> UNIV - {z} \<and> path_image h2 \<subseteq> UNIV - {z} \<and>
                       (\<forall>f. f holomorphic_on UNIV - {z} \<longrightarrow> contour_integral h2 f = contour_integral h1 f)"
     using contour_integral_nearby_ends [of "UNIV - {z}" \<gamma>] assms by (auto simp: open_delete)
   then obtain h where h: "polynomial_function h \<and> pathstart h = pathstart \<gamma> \<and> pathfinish h = pathfinish \<gamma> \<and>
                           (\<forall>t \<in> {0..1}. norm(h t - \<gamma> t) < d/2)"
     using path_approx_polynomial_function [OF \<open>path \<gamma>\<close>, of "d/2"] d by auto
   define nn where "nn = 1/(2* pi*\<i>) * contour_integral h (\<lambda>w. 1/(w - z))"
   have "\<exists>n. \<forall>e > 0. \<exists>p. winding_number_prop \<gamma> z e p n"
     proof (rule_tac x=nn in exI, clarify)
       fix e::real
       assume e: "e>0"
       obtain p where p: "polynomial_function p \<and>
             pathstart p = pathstart \<gamma> \<and> pathfinish p = pathfinish \<gamma> \<and> (\<forall>t\<in>{0..1}. cmod (p t - \<gamma> t) < min e (d/2))"
         using path_approx_polynomial_function [OF \<open>path \<gamma>\<close>, of "min e (d/2)"] d \<open>0<e\<close> by auto
       have "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
         by (auto simp: intro!: holomorphic_intros)
       then show "\<exists>p. winding_number_prop \<gamma> z e p nn"
         apply (rule_tac x=p in exI)
         using pi_eq [of h p] h p d
         apply (auto simp: valid_path_polynomial_function norm_minus_commute nn_def winding_number_prop_def)
         done
     qed
   then show ?thesis
     unfolding winding_number_def by (rule someI2_ex) (blast intro: \<open>0<e\<close>)
 qed
 
 lemma winding_number_unique:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and pi: "\<And>e. e>0 \<Longrightarrow> \<exists>p. winding_number_prop \<gamma> z e p n"
    shows "winding_number \<gamma> z = n"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain e
     where e: "e>0"
       and pi_eq: "\<And>h1 h2 f. \<lbrakk>valid_path h1; valid_path h2;
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < e \<and> cmod (h2 t - \<gamma> t) < e);
                     pathstart h2 = pathstart h1; pathfinish h2 = pathfinish h1; f holomorphic_on UNIV - {z}\<rbrakk> \<Longrightarrow>
                     contour_integral h2 f = contour_integral h1 f"
     using contour_integral_nearby_ends [of "UNIV - {z}" \<gamma>] assms  by (auto simp: open_delete)
   obtain p where p: "winding_number_prop \<gamma> z e p n"
     using pi [OF e] by blast
   obtain q where q: "winding_number_prop \<gamma> z e q (winding_number \<gamma> z)"
     using winding_number [OF \<gamma> e] by blast
   have "2 * complex_of_real pi * \<i> * n = contour_integral p (\<lambda>w. 1 / (w - z))"
     using p by (auto simp: winding_number_prop_def)
   also have "\<dots> = contour_integral q (\<lambda>w. 1 / (w - z))"
   proof (rule pi_eq)
     show "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
       by (auto intro!: holomorphic_intros)
   qed (use p q in \<open>auto simp: winding_number_prop_def norm_minus_commute\<close>)
   also have "\<dots> = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z"
     using q by (auto simp: winding_number_prop_def)
   finally have "2 * complex_of_real pi * \<i> * n = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z" .
   then show ?thesis
     by simp
 qed
 
 (*NB not winding_number_prop here due to the loop in p*)
 lemma winding_number_unique_loop:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and pi:
         "\<And>e. e>0 \<Longrightarrow> \<exists>p. valid_path p \<and> z \<notin> path_image p \<and>
                            pathfinish p = pathstart p \<and>
                            (\<forall>t \<in> {0..1}. norm (\<gamma> t - p t) < e) \<and>
                            contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
    shows "winding_number \<gamma> z = n"
 proof -
   have "path_image \<gamma> \<subseteq> UNIV - {z}"
     using assms by blast
   then obtain e
     where e: "e>0"
       and pi_eq: "\<And>h1 h2 f. \<lbrakk>valid_path h1; valid_path h2;
                     (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < e \<and> cmod (h2 t - \<gamma> t) < e);
                     pathfinish h1 = pathstart h1; pathfinish h2 = pathstart h2; f holomorphic_on UNIV - {z}\<rbrakk> \<Longrightarrow>
                     contour_integral h2 f = contour_integral h1 f"
     using contour_integral_nearby_loops [of "UNIV - {z}" \<gamma>] assms  by (auto simp: open_delete)
   obtain p where p:
      "valid_path p \<and> z \<notin> path_image p \<and> pathfinish p = pathstart p \<and>
       (\<forall>t \<in> {0..1}. norm (\<gamma> t - p t) < e) \<and>
       contour_integral p (\<lambda>w. 1/(w - z)) = 2 * pi * \<i> * n"
     using pi [OF e] by blast
   obtain q where q: "winding_number_prop \<gamma> z e q (winding_number \<gamma> z)"
     using winding_number [OF \<gamma> e] by blast
   have "2 * complex_of_real pi * \<i> * n = contour_integral p (\<lambda>w. 1 / (w - z))"
     using p by auto
   also have "\<dots> = contour_integral q (\<lambda>w. 1 / (w - z))"
   proof (rule pi_eq)
     show "(\<lambda>w. 1 / (w - z)) holomorphic_on UNIV - {z}"
       by (auto intro!: holomorphic_intros)
   qed (use p q loop in \<open>auto simp: winding_number_prop_def norm_minus_commute\<close>)
   also have "\<dots> = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z"
     using q by (auto simp: winding_number_prop_def)
   finally have "2 * complex_of_real pi * \<i> * n = 2 * complex_of_real pi * \<i> * winding_number \<gamma> z" .
   then show ?thesis
     by simp
 qed
 
 proposition winding_number_valid_path:
   assumes "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
   shows "winding_number \<gamma> z = 1/(2*pi*\<i>) * contour_integral \<gamma> (\<lambda>w. 1/(w - z))"
   by (rule winding_number_unique)
   (use assms in \<open>auto simp: valid_path_imp_path winding_number_prop_def\<close>)
 
 proposition has_contour_integral_winding_number:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
     shows "((\<lambda>w. 1/(w - z)) has_contour_integral (2*pi*\<i>*winding_number \<gamma> z)) \<gamma>"
 by (simp add: winding_number_valid_path has_contour_integral_integral contour_integrable_inversediff assms)
 
 lemma winding_number_trivial [simp]: "z \<noteq> a \<Longrightarrow> winding_number(linepath a a) z = 0"
   by (simp add: winding_number_valid_path)
 
 lemma winding_number_subpath_trivial [simp]: "z \<noteq> g x \<Longrightarrow> winding_number (subpath x x g) z = 0"
   by (simp add: path_image_subpath winding_number_valid_path)
 
 lemma winding_number_join:
   assumes \<gamma>1: "path \<gamma>1" "z \<notin> path_image \<gamma>1"
       and \<gamma>2: "path \<gamma>2" "z \<notin> path_image \<gamma>2"
       and "pathfinish \<gamma>1 = pathstart \<gamma>2"
     shows "winding_number(\<gamma>1 +++ \<gamma>2) z = winding_number \<gamma>1 z + winding_number \<gamma>2 z"
 proof (rule winding_number_unique)
   show "\<exists>p. winding_number_prop (\<gamma>1 +++ \<gamma>2) z e p
               (winding_number \<gamma>1 z + winding_number \<gamma>2 z)" if "e > 0" for e
   proof -
     obtain p1 where "winding_number_prop \<gamma>1 z e p1 (winding_number \<gamma>1 z)"
       using \<open>0 < e\<close> \<gamma>1 winding_number by blast
     moreover
     obtain p2 where "winding_number_prop \<gamma>2 z e p2 (winding_number \<gamma>2 z)"
       using \<open>0 < e\<close> \<gamma>2 winding_number by blast
     ultimately
     have "winding_number_prop (\<gamma>1+++\<gamma>2) z e (p1+++p2) (winding_number \<gamma>1 z + winding_number \<gamma>2 z)"
       using assms
       apply (simp add: winding_number_prop_def not_in_path_image_join contour_integrable_inversediff algebra_simps)
       apply (auto simp: joinpaths_def)
       done
     then show ?thesis
       by blast
   qed
 qed (use assms in \<open>auto simp: not_in_path_image_join\<close>)
 
 lemma winding_number_reversepath:
   assumes "path \<gamma>" "z \<notin> path_image \<gamma>"
     shows "winding_number(reversepath \<gamma>) z = - (winding_number \<gamma> z)"
 proof (rule winding_number_unique)
   show "\<exists>p. winding_number_prop (reversepath \<gamma>) z e p (- winding_number \<gamma> z)" if "e > 0" for e
   proof -
     obtain p where "winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
       using \<open>0 < e\<close> assms winding_number by blast
     then have "winding_number_prop (reversepath \<gamma>) z e (reversepath p) (- winding_number \<gamma> z)"
       using assms
       apply (simp add: winding_number_prop_def contour_integral_reversepath contour_integrable_inversediff valid_path_imp_reverse)
       apply (auto simp: reversepath_def)
       done
     then show ?thesis
       by blast
   qed
 qed (use assms in auto)
 
 lemma winding_number_shiftpath:
   assumes \<gamma>: "path \<gamma>" "z \<notin> path_image \<gamma>"
       and "pathfinish \<gamma> = pathstart \<gamma>" "a \<in> {0..1}"
     shows "winding_number(shiftpath a \<gamma>) z = winding_number \<gamma> z"
 proof (rule winding_number_unique_loop)
   show "\<exists>p. valid_path p \<and> z \<notin> path_image p \<and> pathfinish p = pathstart p \<and>
             (\<forall>t\<in>{0..1}. cmod (shiftpath a \<gamma> t - p t) < e) \<and>
             contour_integral p (\<lambda>w. 1 / (w - z)) =
             complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z"
     if "e > 0" for e
   proof -
     obtain p where "winding_number_prop \<gamma> z e p (winding_number \<gamma> z)"
       using \<open>0 < e\<close> assms winding_number by blast
     then show ?thesis
       apply (rule_tac x="shiftpath a p" in exI)
       using assms that
       apply (auto simp: winding_number_prop_def path_image_shiftpath pathfinish_shiftpath pathstart_shiftpath contour_integral_shiftpath)
       apply (simp add: shiftpath_def)
       done
   qed
 qed (use assms in \<open>auto simp: path_shiftpath path_image_shiftpath pathfinish_shiftpath pathstart_shiftpath\<close>)
 
 lemma winding_number_split_linepath:
   assumes "c \<in> closed_segment a b" "z \<notin> closed_segment a b"
     shows "winding_number(linepath a b) z = winding_number(linepath a c) z + winding_number(linepath c b) z"
 proof -
   have "z \<notin> closed_segment a c" "z \<notin> closed_segment c b"
     using assms  by (meson convex_contains_segment convex_segment ends_in_segment subsetCE)+
   then show ?thesis
     using assms
     by (simp add: winding_number_valid_path contour_integral_split_linepath [symmetric] continuous_on_inversediff field_simps)
 qed
 
 lemma winding_number_cong:
    "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> p t = q t) \<Longrightarrow> winding_number p z = winding_number q z"
   by (simp add: winding_number_def winding_number_prop_def pathstart_def pathfinish_def)
 
 lemma winding_number_constI:
   assumes "c\<noteq>z" "\<And>t. \<lbrakk>0\<le>t; t\<le>1\<rbrakk> \<Longrightarrow> g t = c" 
   shows "winding_number g z = 0"
 proof -
   have "winding_number g z = winding_number (linepath c c) z"
     apply (rule winding_number_cong)
     using assms unfolding linepath_def by auto
   moreover have "winding_number (linepath c c) z =0"
     apply (rule winding_number_trivial)
     using assms by auto
   ultimately show ?thesis by auto
 qed
 
 lemma winding_number_offset: "winding_number p z = winding_number (\<lambda>w. p w - z) 0"
   unfolding winding_number_def
 proof (intro ext arg_cong [where f = Eps] arg_cong [where f = All] imp_cong refl, safe)
   fix n e g
   assume "0 < e" and g: "winding_number_prop p z e g n"
   then show "\<exists>r. winding_number_prop (\<lambda>w. p w - z) 0 e r n"
     by (rule_tac x="\<lambda>t. g t - z" in exI)
        (force simp: winding_number_prop_def contour_integral_integral valid_path_def path_defs
                 vector_derivative_def has_vector_derivative_diff_const piecewise_C1_differentiable_diff C1_differentiable_imp_piecewise)
 next
   fix n e g
   assume "0 < e" and g: "winding_number_prop (\<lambda>w. p w - z) 0 e g n"
   then show "\<exists>r. winding_number_prop p z e r n"
     apply (rule_tac x="\<lambda>t. g t + z" in exI)
     apply (simp add: winding_number_prop_def contour_integral_integral valid_path_def path_defs
         piecewise_C1_differentiable_add vector_derivative_def has_vector_derivative_add_const C1_differentiable_imp_piecewise)
     apply (force simp: algebra_simps)
     done
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Some lemmas about negating a path\<close>
 
 lemma valid_path_negatepath: "valid_path \<gamma> \<Longrightarrow> valid_path (uminus \<circ> \<gamma>)"
    unfolding o_def using piecewise_C1_differentiable_neg valid_path_def by blast
 
 lemma has_contour_integral_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and cint: "((\<lambda>z. f (- z)) has_contour_integral - i) \<gamma>"
   shows "(f has_contour_integral i) (uminus \<circ> \<gamma>)"
 proof -
   obtain S where cont: "continuous_on {0..1} \<gamma>" and "finite S" and diff: "\<gamma> C1_differentiable_on {0..1} - S"
     using \<gamma> by (auto simp: valid_path_def piecewise_C1_differentiable_on_def)
   have "((\<lambda>x. - (f (- \<gamma> x) * vector_derivative \<gamma> (at x within {0..1}))) has_integral i) {0..1}"
     using cint by (auto simp: has_contour_integral_def dest: has_integral_neg)
   then
   have "((\<lambda>x. f (- \<gamma> x) * vector_derivative (uminus \<circ> \<gamma>) (at x within {0..1})) has_integral i) {0..1}"
   proof (rule rev_iffD1 [OF _ has_integral_spike_eq])
     show "negligible S"
       by (simp add: \<open>finite S\<close> negligible_finite)
     show "f (- \<gamma> x) * vector_derivative (uminus \<circ> \<gamma>) (at x within {0..1}) =
          - (f (- \<gamma> x) * vector_derivative \<gamma> (at x within {0..1}))"
       if "x \<in> {0..1} - S" for x
     proof -
       have "vector_derivative (uminus \<circ> \<gamma>) (at x within cbox 0 1) = - vector_derivative \<gamma> (at x within cbox 0 1)"
       proof (rule vector_derivative_within_cbox)
         show "(uminus \<circ> \<gamma> has_vector_derivative - vector_derivative \<gamma> (at x within cbox 0 1)) (at x within cbox 0 1)"
           using that unfolding o_def
           by (metis C1_differentiable_on_eq UNIV_I diff differentiable_subset has_vector_derivative_minus subsetI that vector_derivative_works)
       qed (use that in auto)
       then show ?thesis
         by simp
     qed
   qed
   then show ?thesis by (simp add: has_contour_integral_def)
 qed
 
 lemma winding_number_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and 0: "0 \<notin> path_image \<gamma>"
   shows "winding_number(uminus \<circ> \<gamma>) 0 = winding_number \<gamma> 0"
 proof -
   have "(/) 1 contour_integrable_on \<gamma>"
     using "0" \<gamma> contour_integrable_inversediff by fastforce
   then have "((\<lambda>z. 1/z) has_contour_integral contour_integral \<gamma> ((/) 1)) \<gamma>"
     by (rule has_contour_integral_integral)
   then have "((\<lambda>z. 1 / - z) has_contour_integral - contour_integral \<gamma> ((/) 1)) \<gamma>"
     using has_contour_integral_neg by auto
   then show ?thesis
     using assms
     apply (simp add: winding_number_valid_path valid_path_negatepath image_def path_defs)
     apply (simp add: contour_integral_unique has_contour_integral_negatepath)
     done
 qed
 
 lemma contour_integrable_negatepath:
   assumes \<gamma>: "valid_path \<gamma>" and pi: "(\<lambda>z. f (- z)) contour_integrable_on \<gamma>"
   shows "f contour_integrable_on (uminus \<circ> \<gamma>)"
   by (metis \<gamma> add.inverse_inverse contour_integrable_on_def has_contour_integral_negatepath pi)
 
 (* A combined theorem deducing several things piecewise.*)
 lemma winding_number_join_pos_combined:
      "\<lbrakk>valid_path \<gamma>1; z \<notin> path_image \<gamma>1; 0 < Re(winding_number \<gamma>1 z);
        valid_path \<gamma>2; z \<notin> path_image \<gamma>2; 0 < Re(winding_number \<gamma>2 z); pathfinish \<gamma>1 = pathstart \<gamma>2\<rbrakk>
       \<Longrightarrow> valid_path(\<gamma>1 +++ \<gamma>2) \<and> z \<notin> path_image(\<gamma>1 +++ \<gamma>2) \<and> 0 < Re(winding_number(\<gamma>1 +++ \<gamma>2) z)"
   by (simp add: valid_path_join path_image_join winding_number_join valid_path_imp_path)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Useful sufficient conditions for the winding number to be positive\<close>
 
 lemma Re_winding_number:
     "\<lbrakk>valid_path \<gamma>; z \<notin> path_image \<gamma>\<rbrakk>
      \<Longrightarrow> Re(winding_number \<gamma> z) = Im(contour_integral \<gamma> (\<lambda>w. 1/(w - z))) / (2*pi)"
 by (simp add: winding_number_valid_path field_simps Re_divide power2_eq_square)
 
 lemma winding_number_pos_le:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> 0 \<le> Im (vector_derivative \<gamma> (at x) * cnj(\<gamma> x - z))"
     shows "0 \<le> Re(winding_number \<gamma> z)"
 proof -
   have ge0: "0 \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))" if x: "0 < x" "x < 1" for x
     using ge by (simp add: Complex.Im_divide algebra_simps x)
   let ?vd = "\<lambda>x. 1 / (\<gamma> x - z) * vector_derivative \<gamma> (at x)"
   let ?int = "\<lambda>z. contour_integral \<gamma> (\<lambda>w. 1 / (w - z))"
   have hi: "(?vd has_integral ?int z) (cbox 0 1)"
     unfolding box_real
     apply (subst has_contour_integral [symmetric])
     using \<gamma> by (simp add: contour_integrable_inversediff has_contour_integral_integral)
   have "0 \<le> Im (?int z)"
   proof (rule has_integral_component_nonneg [of \<i>, simplified])
     show "\<And>x. x \<in> cbox 0 1 \<Longrightarrow> 0 \<le> Im (if 0 < x \<and> x < 1 then ?vd x else 0)"
       by (force simp: ge0)
     show "((\<lambda>x. if 0 < x \<and> x < 1 then ?vd x else 0) has_integral ?int z) (cbox 0 1)"
       by (rule has_integral_spike_interior [OF hi]) simp
   qed
   then show ?thesis
     by (simp add: Re_winding_number [OF \<gamma>] field_simps)
 qed
 
 lemma winding_number_pos_lt_lemma:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and e: "0 < e"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> e \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
     shows "0 < Re(winding_number \<gamma> z)"
 proof -
   let ?vd = "\<lambda>x. 1 / (\<gamma> x - z) * vector_derivative \<gamma> (at x)"
   let ?int = "\<lambda>z. contour_integral \<gamma> (\<lambda>w. 1 / (w - z))"
   have hi: "(?vd has_integral ?int z) (cbox 0 1)"
     unfolding box_real
     apply (subst has_contour_integral [symmetric])
     using \<gamma> by (simp add: contour_integrable_inversediff has_contour_integral_integral)
   have "e \<le> Im (contour_integral \<gamma> (\<lambda>w. 1 / (w - z)))"
   proof (rule has_integral_component_le [of \<i> "\<lambda>x. \<i>*e" "\<i>*e" "{0..1}", simplified])
     show "((\<lambda>x. if 0 < x \<and> x < 1 then ?vd x else \<i> * complex_of_real e) has_integral ?int z) {0..1}"
       by (rule has_integral_spike_interior [OF hi, simplified box_real]) (use e in simp)
     show "\<And>x. 0 \<le> x \<and> x \<le> 1 \<Longrightarrow>
               e \<le> Im (if 0 < x \<and> x < 1 then ?vd x else \<i> * complex_of_real e)"
       by (simp add: ge)
   qed (use has_integral_const_real [of _ 0 1] in auto)
   with e show ?thesis
     by (simp add: Re_winding_number [OF \<gamma>] field_simps)
 qed
 
 lemma winding_number_pos_lt:
   assumes \<gamma>: "valid_path \<gamma>" "z \<notin> path_image \<gamma>"
       and e: "0 < e"
       and ge: "\<And>x. \<lbrakk>0 < x; x < 1\<rbrakk> \<Longrightarrow> e \<le> Im (vector_derivative \<gamma> (at x) * cnj(\<gamma> x - z))"
     shows "0 < Re (winding_number \<gamma> z)"
 proof -
   have bm: "bounded ((\<lambda>w. w - z) ` (path_image \<gamma>))"
     using bounded_translation [of _ "-z"] \<gamma> by (simp add: bounded_valid_path_image)
   then obtain B where B: "B > 0" and Bno: "\<And>x. x \<in> (\<lambda>w. w - z) ` (path_image \<gamma>) \<Longrightarrow> norm x \<le> B"
     using bounded_pos [THEN iffD1, OF bm] by blast
   { fix x::real  assume x: "0 < x" "x < 1"
     then have B2: "cmod (\<gamma> x - z)^2 \<le> B^2" using Bno [of "\<gamma> x - z"]
       by (simp add: path_image_def power2_eq_square mult_mono')
     with x have "\<gamma> x \<noteq> z" using \<gamma>
       using path_image_def by fastforce
     then have "e / B\<^sup>2 \<le> Im (vector_derivative \<gamma> (at x) * cnj (\<gamma> x - z)) / (cmod (\<gamma> x - z))\<^sup>2"
       using B ge [OF x] B2 e
       apply (rule_tac y="e / (cmod (\<gamma> x - z))\<^sup>2" in order_trans)
       apply (auto simp: divide_left_mono divide_right_mono)
       done
     then have "e / B\<^sup>2 \<le> Im (vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
       by (simp add: complex_div_cnj [of _ "\<gamma> x - z" for x] del: complex_cnj_diff times_complex.sel)
   } note * = this
   show ?thesis
     using e B by (simp add: * winding_number_pos_lt_lemma [OF \<gamma>, of "e/B^2"])
 qed
 
 subsection\<open>The winding number is an integer\<close>
 
 text\<open>Proof from the book Complex Analysis by Lars V. Ahlfors, Chapter 4, section 2.1,
      Also on page 134 of Serge Lang's book with the name title, etc.\<close>
 
 lemma exp_fg:
   fixes z::complex
   assumes g: "(g has_vector_derivative g') (at x within s)"
       and f: "(f has_vector_derivative (g' / (g x - z))) (at x within s)"
       and z: "g x \<noteq> z"
     shows "((\<lambda>x. exp(-f x) * (g x - z)) has_vector_derivative 0) (at x within s)"
 proof -
   have *: "(exp \<circ> (\<lambda>x. (- f x)) has_vector_derivative - (g' / (g x - z)) * exp (- f x)) (at x within s)"
     using assms unfolding has_vector_derivative_def scaleR_conv_of_real
     by (auto intro!: derivative_eq_intros)
   show ?thesis
     apply (rule has_vector_derivative_eq_rhs)
     using z
     apply (auto intro!: derivative_eq_intros * [unfolded o_def] g)
     done
 qed
 
 lemma winding_number_exp_integral:
   fixes z::complex
   assumes \<gamma>: "\<gamma> piecewise_C1_differentiable_on {a..b}"
       and ab: "a \<le> b"
       and z: "z \<notin> \<gamma> ` {a..b}"
     shows "(\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)) integrable_on {a..b}"
           (is "?thesis1")
           "exp (- (integral {a..b} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))) * (\<gamma> b - z) = \<gamma> a - z"
           (is "?thesis2")
 proof -
   let ?D\<gamma> = "\<lambda>x. vector_derivative \<gamma> (at x)"
   have [simp]: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<gamma> x \<noteq> z"
     using z by force
   have cong: "continuous_on {a..b} \<gamma>"
     using \<gamma> by (simp add: piecewise_C1_differentiable_on_def)
   obtain k where fink: "finite k" and g_C1_diff: "\<gamma> C1_differentiable_on ({a..b} - k)"
     using \<gamma> by (force simp: piecewise_C1_differentiable_on_def)
   have \<circ>: "open ({a<..<b} - k)"
     using \<open>finite k\<close> by (simp add: finite_imp_closed open_Diff)
   moreover have "{a<..<b} - k \<subseteq> {a..b} - k"
     by force
   ultimately have g_diff_at: "\<And>x. \<lbrakk>x \<notin> k; x \<in> {a<..<b}\<rbrakk> \<Longrightarrow> \<gamma> differentiable at x"
     by (metis Diff_iff differentiable_on_subset C1_diff_imp_diff [OF g_C1_diff] differentiable_on_def at_within_open)
   { fix w
     assume "w \<noteq> z"
     have "continuous_on (ball w (cmod (w - z))) (\<lambda>w. 1 / (w - z))"
       by (auto simp: dist_norm intro!: continuous_intros)
     moreover have "\<And>x. cmod (w - x) < cmod (w - z) \<Longrightarrow> \<exists>f'. ((\<lambda>w. 1 / (w - z)) has_field_derivative f') (at x)"
       by (auto simp: intro!: derivative_eq_intros)
     ultimately have "\<exists>h. \<forall>y. norm(y - w) < norm(w - z) \<longrightarrow> (h has_field_derivative 1/(y - z)) (at y)"
       using holomorphic_convex_primitive [of "ball w (norm(w - z))" "{}" "\<lambda>w. 1/(w - z)"]
       by (force simp: field_differentiable_def Ball_def dist_norm at_within_open_NO_MATCH norm_minus_commute)
   }
   then obtain h where h: "\<And>w y. w \<noteq> z \<Longrightarrow> norm(y - w) < norm(w - z) \<Longrightarrow> (h w has_field_derivative 1/(y - z)) (at y)"
     by meson
   have exy: "\<exists>y. ((\<lambda>x. inverse (\<gamma> x - z) * ?D\<gamma> x) has_integral y) {a..b}"
     unfolding integrable_on_def [symmetric]
   proof (rule contour_integral_local_primitive_any [OF piecewise_C1_imp_differentiable [OF \<gamma>]])
     show "\<exists>d h. 0 < d \<and>
                (\<forall>y. cmod (y - w) < d \<longrightarrow> (h has_field_derivative inverse (y - z))(at y within - {z}))"
           if "w \<in> - {z}" for w
       apply (rule_tac x="norm(w - z)" in exI)
       using that inverse_eq_divide has_field_derivative_at_within h
       by (metis Compl_insert DiffD2 insertCI right_minus_eq zero_less_norm_iff)
   qed simp
   have vg_int: "(\<lambda>x. ?D\<gamma> x / (\<gamma> x - z)) integrable_on {a..b}"
     unfolding box_real [symmetric] divide_inverse_commute
     by (auto intro!: exy integrable_subinterval simp add: integrable_on_def ab)
   with ab show ?thesis1
     by (simp add: divide_inverse_commute integral_def integrable_on_def)
   { fix t
     assume t: "t \<in> {a..b}"
     have cball: "continuous_on (ball (\<gamma> t) (dist (\<gamma> t) z)) (\<lambda>x. inverse (x - z))"
         using z by (auto intro!: continuous_intros simp: dist_norm)
     have icd: "\<And>x. cmod (\<gamma> t - x) < cmod (\<gamma> t - z) \<Longrightarrow> (\<lambda>w. inverse (w - z)) field_differentiable at x"
       unfolding field_differentiable_def by (force simp: intro!: derivative_eq_intros)
     obtain h where h: "\<And>x. cmod (\<gamma> t - x) < cmod (\<gamma> t - z) \<Longrightarrow>
                        (h has_field_derivative inverse (x - z)) (at x within {y. cmod (\<gamma> t - y) < cmod (\<gamma> t - z)})"
       using holomorphic_convex_primitive [where f = "\<lambda>w. inverse(w - z)", OF convex_ball finite.emptyI cball icd]
       by simp (auto simp: ball_def dist_norm that)
     { fix x D
       assume x: "x \<notin> k" "a < x" "x < b"
       then have "x \<in> interior ({a..b} - k)"
         using open_subset_interior [OF \<circ>] by fastforce
       then have con: "isCont ?D\<gamma> x"
         using g_C1_diff x by (auto simp: C1_differentiable_on_eq intro: continuous_on_interior)
       then have con_vd: "continuous (at x within {a..b}) (\<lambda>x. ?D\<gamma> x)"
         by (rule continuous_at_imp_continuous_within)
       have gdx: "\<gamma> differentiable at x"
         using x by (simp add: g_diff_at)
       have "\<And>d. \<lbrakk>x \<notin> k; a < x; x < b;
           (\<gamma> has_vector_derivative d) (at x); a \<le> t; t \<le> b\<rbrakk>
          \<Longrightarrow> ((\<lambda>x. integral {a..x}
                      (\<lambda>x. ?D\<gamma> x /
                            (\<gamma> x - z))) has_vector_derivative
               d / (\<gamma> x - z))
               (at x within {a..b})"
         apply (rule has_vector_derivative_eq_rhs)
          apply (rule integral_has_vector_derivative_continuous_at [where S = "{}", simplified])
         apply (rule con_vd continuous_intros cong vg_int | simp add: continuous_at_imp_continuous_within has_vector_derivative_continuous vector_derivative_at)+
         done
       then have "((\<lambda>c. exp (- integral {a..c} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z))) * (\<gamma> c - z)) has_derivative (\<lambda>h. 0))
           (at x within {a..b})"
         using x gdx t
         apply (clarsimp simp add: differentiable_iff_scaleR)
         apply (rule exp_fg [unfolded has_vector_derivative_def, simplified], blast intro: has_derivative_at_withinI)
         apply (simp_all add: has_vector_derivative_def [symmetric])
         done
       } note * = this
     have "exp (- (integral {a..t} (\<lambda>x. ?D\<gamma> x / (\<gamma> x - z)))) * (\<gamma> t - z) =\<gamma> a - z"
       apply (rule has_derivative_zero_unique_strong_interval [of "{a,b} \<union> k" a b])
       using t
       apply (auto intro!: * continuous_intros fink cong indefinite_integral_continuous_1 [OF vg_int]  simp add: ab)+
       done
    }
   with ab show ?thesis2
     by (simp add: divide_inverse_commute integral_def)
 qed
 
 lemma winding_number_exp_2pi:
     "\<lbrakk>path p; z \<notin> path_image p\<rbrakk>
      \<Longrightarrow> pathfinish p - z = exp (2 * pi * \<i> * winding_number p z) * (pathstart p - z)"
 using winding_number [of p z 1] unfolding valid_path_def path_image_def pathstart_def pathfinish_def winding_number_prop_def
   by (force dest: winding_number_exp_integral(2) [of _ 0 1 z] simp: field_simps contour_integral_integral exp_minus)
 
 lemma integer_winding_number_eq:
   assumes \<gamma>: "path \<gamma>" and z: "z \<notin> path_image \<gamma>"
   shows "winding_number \<gamma> z \<in> \<int> \<longleftrightarrow> pathfinish \<gamma> = pathstart \<gamma>"
 proof -
   obtain p where p: "valid_path p" "z \<notin> path_image p"
                     "pathstart p = pathstart \<gamma>" "pathfinish p = pathfinish \<gamma>"
            and eq: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z"
     using winding_number [OF assms, of 1] unfolding winding_number_prop_def by auto
   then have wneq: "winding_number \<gamma> z = winding_number p z"
       using eq winding_number_valid_path by force
   have iff: "(winding_number \<gamma> z \<in> \<int>) \<longleftrightarrow> (exp (contour_integral p (\<lambda>w. 1 / (w - z))) = 1)"
     using eq by (simp add: exp_eq_1 complex_is_Int_iff)
   have "exp (contour_integral p (\<lambda>w. 1 / (w - z))) = (\<gamma> 1 - z) / (\<gamma> 0 - z)"
     using p winding_number_exp_integral(2) [of p 0 1 z]
     apply (simp add: valid_path_def path_defs contour_integral_integral exp_minus field_split_simps)
     by (metis path_image_def pathstart_def pathstart_in_path_image)
   then have "winding_number p z \<in> \<int> \<longleftrightarrow> pathfinish p = pathstart p"
     using p wneq iff by (auto simp: path_defs)
   then show ?thesis using p eq
     by (auto simp: winding_number_valid_path)
 qed
 
 theorem integer_winding_number:
   "\<lbrakk>path \<gamma>; pathfinish \<gamma> = pathstart \<gamma>; z \<notin> path_image \<gamma>\<rbrakk> \<Longrightarrow> winding_number \<gamma> z \<in> \<int>"
 by (metis integer_winding_number_eq)
 
 
 text\<open>If the winding number's magnitude is at least one, then the path must contain points in every direction.*)
    We can thus bound the winding number of a path that doesn't intersect a given ray. \<close>
 
 lemma winding_number_pos_meets:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and 1: "Re (winding_number \<gamma> z) \<ge> 1"
       and w: "w \<noteq> z"
   shows "\<exists>a::real. 0 < a \<and> z + a*(w - z) \<in> path_image \<gamma>"
 proof -
   have [simp]: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> \<gamma> x \<noteq> z"
     using z by (auto simp: path_image_def)
   have [simp]: "z \<notin> \<gamma> ` {0..1}"
     using path_image_def z by auto
   have gpd: "\<gamma> piecewise_C1_differentiable_on {0..1}"
     using \<gamma> valid_path_def by blast
   define r where "r = (w - z) / (\<gamma> 0 - z)"
   have [simp]: "r \<noteq> 0"
     using w z by (auto simp: r_def)
   have cont: "continuous_on {0..1}
      (\<lambda>x. Im (integral {0..x} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z))))"
     by (intro continuous_intros indefinite_integral_continuous_1 winding_number_exp_integral [OF gpd]; simp)
   have "Arg2pi r \<le> 2*pi"
     by (simp add: Arg2pi less_eq_real_def)
   also have "\<dots> \<le> Im (integral {0..1} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))"
     using 1
     apply (simp add: winding_number_valid_path [OF \<gamma> z] contour_integral_integral)
     apply (simp add: Complex.Re_divide field_simps power2_eq_square)
     done
   finally have "Arg2pi r \<le> Im (integral {0..1} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z)))" .
   then have "\<exists>t. t \<in> {0..1} \<and> Im(integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x)/(\<gamma> x - z))) = Arg2pi r"
     by (simp add: Arg2pi_ge_0 cont IVT')
   then obtain t where t:     "t \<in> {0..1}"
                   and eqArg: "Im (integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x)/(\<gamma> x - z))) = Arg2pi r"
     by blast
   define i where "i = integral {0..t} (\<lambda>x. vector_derivative \<gamma> (at x) / (\<gamma> x - z))"
   have iArg: "Arg2pi r = Im i"
     using eqArg by (simp add: i_def)
   have gpdt: "\<gamma> piecewise_C1_differentiable_on {0..t}"
     by (metis atLeastAtMost_iff atLeastatMost_subset_iff order_refl piecewise_C1_differentiable_on_subset gpd t)
   have "exp (- i) * (\<gamma> t - z) = \<gamma> 0 - z"
     unfolding i_def
     apply (rule winding_number_exp_integral [OF gpdt])
     using t z unfolding path_image_def by force+
   then have *: "\<gamma> t - z = exp i * (\<gamma> 0 - z)"
     by (simp add: exp_minus field_simps)
   then have "(w - z) = r * (\<gamma> 0 - z)"
     by (simp add: r_def)
   then have "z + complex_of_real (exp (Re i)) * (w - z) / complex_of_real (cmod r) = \<gamma> t"
     apply simp
     apply (subst Complex_Transcendental.Arg2pi_eq [of r])
     apply (simp add: iArg)
     using * apply (simp add: exp_eq_polar field_simps)
     done
   with t show ?thesis
     by (rule_tac x="exp(Re i) / norm r" in exI) (auto simp: path_image_def)
 qed
 
 lemma winding_number_big_meets:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "\<bar>Re (winding_number \<gamma> z)\<bar> \<ge> 1"
       and w: "w \<noteq> z"
   shows "\<exists>a::real. 0 < a \<and> z + a*(w - z) \<in> path_image \<gamma>"
 proof -
   { assume "Re (winding_number \<gamma> z) \<le> - 1"
     then have "Re (winding_number (reversepath \<gamma>) z) \<ge> 1"
       by (simp add: \<gamma> valid_path_imp_path winding_number_reversepath z)
     moreover have "valid_path (reversepath \<gamma>)"
       using \<gamma> valid_path_imp_reverse by auto
     moreover have "z \<notin> path_image (reversepath \<gamma>)"
       by (simp add: z)
     ultimately have "\<exists>a::real. 0 < a \<and> z + a*(w - z) \<in> path_image (reversepath \<gamma>)"
       using winding_number_pos_meets w by blast
     then have ?thesis
       by simp
   }
   then show ?thesis
     using assms
     by (simp add: abs_if winding_number_pos_meets split: if_split_asm)
 qed
 
 lemma winding_number_less_1:
   fixes z::complex
   shows
   "\<lbrakk>valid_path \<gamma>; z \<notin> path_image \<gamma>; w \<noteq> z;
     \<And>a::real. 0 < a \<Longrightarrow> z + a*(w - z) \<notin> path_image \<gamma>\<rbrakk>
    \<Longrightarrow> Re(winding_number \<gamma> z) < 1"
    by (auto simp: not_less dest: winding_number_big_meets)
 
 text\<open>One way of proving that WN=1 for a loop.\<close>
 lemma winding_number_eq_1:
   fixes z::complex
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and 0: "0 < Re(winding_number \<gamma> z)" and 2: "Re(winding_number \<gamma> z) < 2"
   shows "winding_number \<gamma> z = 1"
 proof -
   have "winding_number \<gamma> z \<in> Ints"
     by (simp add: \<gamma> integer_winding_number loop valid_path_imp_path z)
   then show ?thesis
     using 0 2 by (auto simp: Ints_def)
 qed
 
 subsection\<open>Continuity of winding number and invariance on connected sets\<close>
 
 lemma continuous_at_winding_number:
   fixes z::complex
   assumes \<gamma>: "path \<gamma>" and z: "z \<notin> path_image \<gamma>"
   shows "continuous (at z) (winding_number \<gamma>)"
 proof -
   obtain e where "e>0" and cbg: "cball z e \<subseteq> - path_image \<gamma>"
     using open_contains_cball [of "- path_image \<gamma>"]  z
     by (force simp: closed_def [symmetric] closed_path_image [OF \<gamma>])
   then have ppag: "path_image \<gamma> \<subseteq> - cball z (e/2)"
     by (force simp: cball_def dist_norm)
   have oc: "open (- cball z (e / 2))"
     by (simp add: closed_def [symmetric])
   obtain d where "d>0" and pi_eq:
     "\<And>h1 h2. \<lbrakk>valid_path h1; valid_path h2;
               (\<forall>t\<in>{0..1}. cmod (h1 t - \<gamma> t) < d \<and> cmod (h2 t - \<gamma> t) < d);
               pathstart h2 = pathstart h1; pathfinish h2 = pathfinish h1\<rbrakk>
              \<Longrightarrow>
                path_image h1 \<subseteq> - cball z (e / 2) \<and>
                path_image h2 \<subseteq> - cball z (e / 2) \<and>
                (\<forall>f. f holomorphic_on - cball z (e / 2) \<longrightarrow> contour_integral h2 f = contour_integral h1 f)"
     using contour_integral_nearby_ends [OF oc \<gamma> ppag] by metis
   obtain p where p: "valid_path p" "z \<notin> path_image p"
                     "pathstart p = pathstart \<gamma> \<and> pathfinish p = pathfinish \<gamma>"
               and pg: "\<And>t. t\<in>{0..1} \<Longrightarrow> cmod (\<gamma> t - p t) < min d e / 2"
               and pi: "contour_integral p (\<lambda>x. 1 / (x - z)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z"
     using winding_number [OF \<gamma> z, of "min d e / 2"] \<open>d>0\<close> \<open>e>0\<close> by (auto simp: winding_number_prop_def)
   { fix w
     assume d2: "cmod (w - z) < d/2" and e2: "cmod (w - z) < e/2"
     then have wnotp: "w \<notin> path_image p"
       using cbg \<open>d>0\<close> \<open>e>0\<close>
       apply (simp add: path_image_def cball_def dist_norm, clarify)
       apply (frule pg)
       apply (drule_tac c="\<gamma> x" in subsetD)
       apply (auto simp: less_eq_real_def norm_minus_commute norm_triangle_half_l)
       done
     have wnotg: "w \<notin> path_image \<gamma>"
       using cbg e2 \<open>e>0\<close> by (force simp: dist_norm norm_minus_commute)
     { fix k::real
       assume k: "k>0"
       then obtain q where q: "valid_path q" "w \<notin> path_image q"
                              "pathstart q = pathstart \<gamma> \<and> pathfinish q = pathfinish \<gamma>"
                     and qg: "\<And>t. t \<in> {0..1} \<Longrightarrow> cmod (\<gamma> t - q t) < min k (min d e) / 2"
                     and qi: "contour_integral q (\<lambda>u. 1 / (u - w)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> w"
         using winding_number [OF \<gamma> wnotg, of "min k (min d e) / 2"] \<open>d>0\<close> \<open>e>0\<close> k
         by (force simp: min_divide_distrib_right winding_number_prop_def)
       have "contour_integral p (\<lambda>u. 1 / (u - w)) = contour_integral q (\<lambda>u. 1 / (u - w))"
         apply (rule pi_eq [OF \<open>valid_path q\<close> \<open>valid_path p\<close>, THEN conjunct2, THEN conjunct2, rule_format])
         apply (frule pg)
         apply (frule qg)
         using p q \<open>d>0\<close> e2
         apply (auto simp: dist_norm norm_minus_commute intro!: holomorphic_intros)
         done
       then have "contour_integral p (\<lambda>x. 1 / (x - w)) = complex_of_real (2 * pi) * \<i> * winding_number \<gamma> w"
         by (simp add: pi qi)
     } note pip = this
     have "path p"
       using p by (simp add: valid_path_imp_path)
     then have "winding_number p w = winding_number \<gamma> w"
       apply (rule winding_number_unique [OF _ wnotp])
       apply (rule_tac x=p in exI)
       apply (simp add: p wnotp min_divide_distrib_right pip winding_number_prop_def)
       done
   } note wnwn = this
   obtain pe where "pe>0" and cbp: "cball z (3 / 4 * pe) \<subseteq> - path_image p"
     using p open_contains_cball [of "- path_image p"]
     by (force simp: closed_def [symmetric] closed_path_image [OF valid_path_imp_path])
   obtain L
     where "L>0"
       and L: "\<And>f B. \<lbrakk>f holomorphic_on - cball z (3 / 4 * pe);
                       \<forall>z \<in> - cball z (3 / 4 * pe). cmod (f z) \<le> B\<rbrakk> \<Longrightarrow>
                       cmod (contour_integral p f) \<le> L * B"
     using contour_integral_bound_exists [of "- cball z (3/4*pe)" p] cbp \<open>valid_path p\<close> by force
   { fix e::real and w::complex
     assume e: "0 < e" and w: "cmod (w - z) < pe/4" "cmod (w - z) < e * pe\<^sup>2 / (8 * L)"
     then have [simp]: "w \<notin> path_image p"
       using cbp p(2) \<open>0 < pe\<close>
       by (force simp: dist_norm norm_minus_commute path_image_def cball_def)
     have [simp]: "contour_integral p (\<lambda>x. 1/(x - w)) - contour_integral p (\<lambda>x. 1/(x - z)) =
                   contour_integral p (\<lambda>x. 1/(x - w) - 1/(x - z))"
       by (simp add: p contour_integrable_inversediff contour_integral_diff)
     { fix x
       assume pe: "3/4 * pe < cmod (z - x)"
       have "cmod (w - x) < pe/4 + cmod (z - x)"
         by (meson add_less_cancel_right norm_diff_triangle_le order_refl order_trans_rules(21) w(1))
       then have wx: "cmod (w - x) < 4/3 * cmod (z - x)" using pe by simp
       have "cmod (z - x) \<le> cmod (z - w) + cmod (w - x)"
         using norm_diff_triangle_le by blast
       also have "\<dots> < pe/4 + cmod (w - x)"
         using w by (simp add: norm_minus_commute)
       finally have "pe/2 < cmod (w - x)"
         using pe by auto
       then have "(pe/2)^2 < cmod (w - x) ^ 2"
         apply (rule power_strict_mono)
         using \<open>pe>0\<close> by auto
       then have pe2: "pe^2 < 4 * cmod (w - x) ^ 2"
         by (simp add: power_divide)
       have "8 * L * cmod (w - z) < e * pe\<^sup>2"
         using w \<open>L>0\<close> by (simp add: field_simps)
       also have "\<dots> < e * 4 * cmod (w - x) * cmod (w - x)"
         using pe2 \<open>e>0\<close> by (simp add: power2_eq_square)
       also have "\<dots> < e * 4 * cmod (w - x) * (4/3 * cmod (z - x))"
         using wx
         apply (rule mult_strict_left_mono)
         using pe2 e not_less_iff_gr_or_eq by fastforce
       finally have "L * cmod (w - z) < 2/3 * e * cmod (w - x) * cmod (z - x)"
         by simp
       also have "\<dots> \<le> e * cmod (w - x) * cmod (z - x)"
          using e by simp
       finally have Lwz: "L * cmod (w - z) < e * cmod (w - x) * cmod (z - x)" .
       have "L * cmod (1 / (x - w) - 1 / (x - z)) \<le> e"
         apply (cases "x=z \<or> x=w")
         using pe \<open>pe>0\<close> w \<open>L>0\<close>
         apply (force simp: norm_minus_commute)
         using wx w(2) \<open>L>0\<close> pe pe2 Lwz
         apply (auto simp: divide_simps mult_less_0_iff norm_minus_commute norm_divide norm_mult power2_eq_square)
         done
     } note L_cmod_le = this
     have *: "cmod (contour_integral p (\<lambda>x. 1 / (x - w) - 1 / (x - z))) \<le> L * (e * pe\<^sup>2 / L / 4 * (inverse (pe / 2))\<^sup>2)"
       apply (rule L)
       using \<open>pe>0\<close> w
       apply (force simp: dist_norm norm_minus_commute intro!: holomorphic_intros)
       using \<open>pe>0\<close> w \<open>L>0\<close>
       apply (auto simp: cball_def dist_norm field_simps L_cmod_le  simp del: less_divide_eq_numeral1 le_divide_eq_numeral1)
       done
     have "cmod (contour_integral p (\<lambda>x. 1 / (x - w)) - contour_integral p (\<lambda>x. 1 / (x - z))) < 2*e"
       apply simp
       apply (rule le_less_trans [OF *])
       using \<open>L>0\<close> e
       apply (force simp: field_simps)
       done
     then have "cmod (winding_number p w - winding_number p z) < e"
       using pi_ge_two e
       by (force simp: winding_number_valid_path p field_simps norm_divide norm_mult intro: less_le_trans)
   } note cmod_wn_diff = this
   then have "isCont (winding_number p) z"
     apply (simp add: continuous_at_eps_delta, clarify)
     apply (rule_tac x="min (pe/4) (e/2*pe^2/L/4)" in exI)
     using \<open>pe>0\<close> \<open>L>0\<close>
     apply (simp add: dist_norm cmod_wn_diff)
     done
   then show ?thesis
     apply (rule continuous_transform_within [where d = "min d e / 2"])
     apply (auto simp: \<open>d>0\<close> \<open>e>0\<close> dist_norm wnwn)
     done
 qed
 
 corollary continuous_on_winding_number:
     "path \<gamma> \<Longrightarrow> continuous_on (- path_image \<gamma>) (\<lambda>w. winding_number \<gamma> w)"
   by (simp add: continuous_at_imp_continuous_on continuous_at_winding_number)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>The winding number is constant on a connected region\<close>
 
 lemma winding_number_constant:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and cs: "connected S" and sg: "S \<inter> path_image \<gamma> = {}"
   shows "winding_number \<gamma> constant_on S"
 proof -
   have *: "1 \<le> cmod (winding_number \<gamma> y - winding_number \<gamma> z)"
       if ne: "winding_number \<gamma> y \<noteq> winding_number \<gamma> z" and "y \<in> S" "z \<in> S" for y z
   proof -
     have "winding_number \<gamma> y \<in> \<int>"  "winding_number \<gamma> z \<in>  \<int>"
       using that integer_winding_number [OF \<gamma> loop] sg \<open>y \<in> S\<close> by auto
     with ne show ?thesis
       by (auto simp: Ints_def simp flip: of_int_diff)
   qed
   have cont: "continuous_on S (\<lambda>w. winding_number \<gamma> w)"
     using continuous_on_winding_number [OF \<gamma>] sg
     by (meson continuous_on_subset disjoint_eq_subset_Compl)
   show ?thesis
     using "*" zero_less_one
     by (blast intro: continuous_discrete_range_constant [OF cs cont])
 qed
 
 lemma winding_number_eq:
      "\<lbrakk>path \<gamma>; pathfinish \<gamma> = pathstart \<gamma>; w \<in> S; z \<in> S; connected S; S \<inter> path_image \<gamma> = {}\<rbrakk>
       \<Longrightarrow> winding_number \<gamma> w = winding_number \<gamma> z"
   using winding_number_constant by (metis constant_on_def)
 
 lemma open_winding_number_levelsets:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
     shows "open {z. z \<notin> path_image \<gamma> \<and> winding_number \<gamma> z = k}"
 proof -
   have opn: "open (- path_image \<gamma>)"
     by (simp add: closed_path_image \<gamma> open_Compl)
   { fix z assume z: "z \<notin> path_image \<gamma>" and k: "k = winding_number \<gamma> z"
     obtain e where e: "e>0" "ball z e \<subseteq> - path_image \<gamma>"
       using open_contains_ball [of "- path_image \<gamma>"] opn z
       by blast
     have "\<exists>e>0. \<forall>y. dist y z < e \<longrightarrow> y \<notin> path_image \<gamma> \<and> winding_number \<gamma> y = winding_number \<gamma> z"
       apply (rule_tac x=e in exI)
       using e apply (simp add: dist_norm ball_def norm_minus_commute)
       apply (auto simp: dist_norm norm_minus_commute intro!: winding_number_eq [OF assms, where S = "ball z e"])
       done
   } then
   show ?thesis
     by (auto simp: open_dist)
 qed
 
 subsection\<open>Winding number is zero "outside" a curve\<close>
 
 proposition winding_number_zero_in_outside:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>" and z: "z \<in> outside (path_image \<gamma>)"
     shows "winding_number \<gamma> z = 0"
 proof -
   obtain B::real where "0 < B" and B: "path_image \<gamma> \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bounded_path_image [OF \<gamma>]] by auto
   obtain w::complex where w: "w \<notin> ball 0 (B + 1)"
     by (metis abs_of_nonneg le_less less_irrefl mem_ball_0 norm_of_real)
   have "- ball 0 (B + 1) \<subseteq> outside (path_image \<gamma>)"
     apply (rule outside_subset_convex)
     using B subset_ball by auto
   then have wout: "w \<in> outside (path_image \<gamma>)"
     using w by blast
   moreover have "winding_number \<gamma> constant_on outside (path_image \<gamma>)"
     using winding_number_constant [OF \<gamma> loop, of "outside(path_image \<gamma>)"] connected_outside
     by (metis DIM_complex bounded_path_image dual_order.refl \<gamma> outside_no_overlap)
   ultimately have "winding_number \<gamma> z = winding_number \<gamma> w"
     by (metis (no_types, hide_lams) constant_on_def z)
   also have "\<dots> = 0"
   proof -
     have wnot: "w \<notin> path_image \<gamma>"  using wout by (simp add: outside_def)
     { fix e::real assume "0<e"
       obtain p where p: "polynomial_function p" "pathstart p = pathstart \<gamma>" "pathfinish p = pathfinish \<gamma>"
                  and pg1: "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> cmod (p t - \<gamma> t) < 1)"
                  and pge: "(\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> cmod (p t - \<gamma> t) < e)"
         using path_approx_polynomial_function [OF \<gamma>, of "min 1 e"] \<open>e>0\<close> by force
       have pip: "path_image p \<subseteq> ball 0 (B + 1)"
         using B
         apply (clarsimp simp add: path_image_def dist_norm ball_def)
         apply (frule (1) pg1)
         apply (fastforce dest: norm_add_less)
         done
       then have "w \<notin> path_image p"  using w by blast
       then have "\<exists>p. valid_path p \<and> w \<notin> path_image p \<and>
                      pathstart p = pathstart \<gamma> \<and> pathfinish p = pathfinish \<gamma> \<and>
                      (\<forall>t\<in>{0..1}. cmod (\<gamma> t - p t) < e) \<and> contour_integral p (\<lambda>wa. 1 / (wa - w)) = 0"
         apply (rule_tac x=p in exI)
         apply (simp add: p valid_path_polynomial_function)
         apply (intro conjI)
         using pge apply (simp add: norm_minus_commute)
         apply (rule contour_integral_unique [OF Cauchy_theorem_convex_simple [OF _ convex_ball [of 0 "B+1"]]])
         apply (rule holomorphic_intros | simp add: dist_norm)+
         using mem_ball_0 w apply blast
         using p apply (simp_all add: valid_path_polynomial_function loop pip)
         done
     }
     then show ?thesis
       by (auto intro: winding_number_unique [OF \<gamma>] simp add: winding_number_prop_def wnot)
   qed
   finally show ?thesis .
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> winding_number_zero_const: "a \<noteq> z \<Longrightarrow> winding_number (\<lambda>t. a) z = 0"
   by (rule winding_number_zero_in_outside)
      (auto simp: pathfinish_def pathstart_def path_polynomial_function)
 
 corollary\<^marker>\<open>tag unimportant\<close> winding_number_zero_outside:
     "\<lbrakk>path \<gamma>; convex s; pathfinish \<gamma> = pathstart \<gamma>; z \<notin> s; path_image \<gamma> \<subseteq> s\<rbrakk> \<Longrightarrow> winding_number \<gamma> z = 0"
   by (meson convex_in_outside outside_mono subsetCE winding_number_zero_in_outside)
 
 lemma winding_number_zero_at_infinity:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
     shows "\<exists>B. \<forall>z. B \<le> norm z \<longrightarrow> winding_number \<gamma> z = 0"
 proof -
   obtain B::real where "0 < B" and B: "path_image \<gamma> \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bounded_path_image [OF \<gamma>]] by auto
   then show ?thesis
     apply (rule_tac x="B+1" in exI, clarify)
     apply (rule winding_number_zero_outside [OF \<gamma> convex_cball [of 0 B] loop])
     apply (meson less_add_one mem_cball_0 not_le order_trans)
     using ball_subset_cball by blast
 qed
 
 lemma winding_number_zero_point:
     "\<lbrakk>path \<gamma>; convex s; pathfinish \<gamma> = pathstart \<gamma>; open s; path_image \<gamma> \<subseteq> s\<rbrakk>
      \<Longrightarrow> \<exists>z. z \<in> s \<and> winding_number \<gamma> z = 0"
   using outside_compact_in_open [of "path_image \<gamma>" s] path_image_nonempty winding_number_zero_in_outside
   by (fastforce simp add: compact_path_image)
 
 
 text\<open>If a path winds round a set, it winds rounds its inside.\<close>
 lemma winding_number_around_inside:
   assumes \<gamma>: "path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       and cls: "closed s" and cos: "connected s" and s_disj: "s \<inter> path_image \<gamma> = {}"
       and z: "z \<in> s" and wn_nz: "winding_number \<gamma> z \<noteq> 0" and w: "w \<in> s \<union> inside s"
     shows "winding_number \<gamma> w = winding_number \<gamma> z"
 proof -
   have ssb: "s \<subseteq> inside(path_image \<gamma>)"
   proof
     fix x :: complex
     assume "x \<in> s"
     hence "x \<notin> path_image \<gamma>"
       by (meson disjoint_iff_not_equal s_disj)
     thus "x \<in> inside (path_image \<gamma>)"
       using \<open>x \<in> s\<close> by (metis (no_types) ComplI UnE cos \<gamma> loop s_disj union_with_outside winding_number_eq winding_number_zero_in_outside wn_nz z)
 qed
   show ?thesis
     apply (rule winding_number_eq [OF \<gamma> loop w])
     using z apply blast
     apply (simp add: cls connected_with_inside cos)
     apply (simp add: Int_Un_distrib2 s_disj, safe)
     by (meson ssb inside_inside_compact_connected [OF cls, of "path_image \<gamma>"] compact_path_image connected_path_image contra_subsetD disjoint_iff_not_equal \<gamma> inside_no_overlap)
  qed
 
 
 text\<open>Bounding a WN by 1/2 for a path and point in opposite halfspaces.\<close>
 lemma winding_number_subpath_continuous:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>"
     shows "continuous_on {0..1} (\<lambda>x. winding_number(subpath 0 x \<gamma>) z)"
 proof -
   have *: "integral {0..x} (\<lambda>t. vector_derivative \<gamma> (at t) / (\<gamma> t - z)) / (2 * of_real pi * \<i>) =
          winding_number (subpath 0 x \<gamma>) z"
          if x: "0 \<le> x" "x \<le> 1" for x
   proof -
     have "integral {0..x} (\<lambda>t. vector_derivative \<gamma> (at t) / (\<gamma> t - z)) / (2 * of_real pi * \<i>) =
           1 / (2*pi*\<i>) * contour_integral (subpath 0 x \<gamma>) (\<lambda>w. 1/(w - z))"
       using assms x
       apply (simp add: contour_integral_subcontour_integral [OF contour_integrable_inversediff])
       done
     also have "\<dots> = winding_number (subpath 0 x \<gamma>) z"
       apply (subst winding_number_valid_path)
       using assms x
       apply (simp_all add: path_image_subpath valid_path_subpath)
       by (force simp: path_image_def)
     finally show ?thesis .
   qed
   show ?thesis
     apply (rule continuous_on_eq
                  [where f = "\<lambda>x. 1 / (2*pi*\<i>) *
                                  integral {0..x} (\<lambda>t. 1/(\<gamma> t - z) * vector_derivative \<gamma> (at t))"])
     apply (rule continuous_intros)+
     apply (rule indefinite_integral_continuous_1)
     apply (rule contour_integrable_inversediff [OF assms, unfolded contour_integrable_on])
       using assms
     apply (simp add: *)
     done
 qed
 
 lemma winding_number_ivt_pos:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "0 \<le> w" "w \<le> Re(winding_number \<gamma> z)"
       shows "\<exists>t \<in> {0..1}. Re(winding_number(subpath 0 t \<gamma>) z) = w"
   apply (rule ivt_increasing_component_on_1 [of 0 1, where ?k = "1::complex", simplified complex_inner_1_right], simp)
   apply (rule winding_number_subpath_continuous [OF \<gamma> z])
   using assms
   apply (auto simp: path_image_def image_def)
   done
 
 lemma winding_number_ivt_neg:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "Re(winding_number \<gamma> z) \<le> w" "w \<le> 0"
       shows "\<exists>t \<in> {0..1}. Re(winding_number(subpath 0 t \<gamma>) z) = w"
   apply (rule ivt_decreasing_component_on_1 [of 0 1, where ?k = "1::complex", simplified complex_inner_1_right], simp)
   apply (rule winding_number_subpath_continuous [OF \<gamma> z])
   using assms
   apply (auto simp: path_image_def image_def)
   done
 
 lemma winding_number_ivt_abs:
     assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and "0 \<le> w" "w \<le> \<bar>Re(winding_number \<gamma> z)\<bar>"
       shows "\<exists>t \<in> {0..1}. \<bar>Re (winding_number (subpath 0 t \<gamma>) z)\<bar> = w"
   using assms winding_number_ivt_pos [of \<gamma> z w] winding_number_ivt_neg [of \<gamma> z "-w"]
   by force
 
 lemma winding_number_lt_half_lemma:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>" and az: "a \<bullet> z \<le> b" and pag: "path_image \<gamma> \<subseteq> {w. a \<bullet> w > b}"
     shows "Re(winding_number \<gamma> z) < 1/2"
 proof -
   { assume "Re(winding_number \<gamma> z) \<ge> 1/2"
     then obtain t::real where t: "0 \<le> t" "t \<le> 1" and sub12: "Re (winding_number (subpath 0 t \<gamma>) z) = 1/2"
       using winding_number_ivt_pos [OF \<gamma> z, of "1/2"] by auto
     have gt: "\<gamma> t - z = - (of_real (exp (- (2 * pi * Im (winding_number (subpath 0 t \<gamma>) z)))) * (\<gamma> 0 - z))"
       using winding_number_exp_2pi [of "subpath 0 t \<gamma>" z]
       apply (simp add: t \<gamma> valid_path_imp_path)
       using closed_segment_eq_real_ivl path_image_def t z by (fastforce simp: path_image_subpath Euler sub12)
     have "b < a \<bullet> \<gamma> 0"
     proof -
       have "\<gamma> 0 \<in> {c. b < a \<bullet> c}"
         by (metis (no_types) pag atLeastAtMost_iff image_subset_iff order_refl path_image_def zero_le_one)
       thus ?thesis
         by blast
     qed
     moreover have "b < a \<bullet> \<gamma> t"
     proof -
       have "\<gamma> t \<in> {c. b < a \<bullet> c}"
         by (metis (no_types) pag atLeastAtMost_iff image_subset_iff path_image_def t)
       thus ?thesis
         by blast
     qed
     ultimately have "0 < a \<bullet> (\<gamma> 0 - z)" "0 < a \<bullet> (\<gamma> t - z)" using az
       by (simp add: inner_diff_right)+
     then have False
       by (simp add: gt inner_mult_right mult_less_0_iff)
   }
   then show ?thesis by force
 qed
 
 lemma winding_number_lt_half:
   assumes "valid_path \<gamma>" "a \<bullet> z \<le> b" "path_image \<gamma> \<subseteq> {w. a \<bullet> w > b}"
     shows "\<bar>Re (winding_number \<gamma> z)\<bar> < 1/2"
 proof -
   have "z \<notin> path_image \<gamma>" using assms by auto
   with assms show ?thesis
     apply (simp add: winding_number_lt_half_lemma abs_if del: less_divide_eq_numeral1)
     apply (metis complex_inner_1_right winding_number_lt_half_lemma [OF valid_path_imp_reverse, of \<gamma> z a b]
                  winding_number_reversepath valid_path_imp_path inner_minus_left path_image_reversepath)
     done
 qed
 
 lemma winding_number_le_half:
   assumes \<gamma>: "valid_path \<gamma>" and z: "z \<notin> path_image \<gamma>"
       and anz: "a \<noteq> 0" and azb: "a \<bullet> z \<le> b" and pag: "path_image \<gamma> \<subseteq> {w. a \<bullet> w \<ge> b}"
     shows "\<bar>Re (winding_number \<gamma> z)\<bar> \<le> 1/2"
 proof -
   { assume wnz_12: "\<bar>Re (winding_number \<gamma> z)\<bar> > 1/2"
     have "isCont (winding_number \<gamma>) z"
       by (metis continuous_at_winding_number valid_path_imp_path \<gamma> z)
     then obtain d where "d>0" and d: "\<And>x'. dist x' z < d \<Longrightarrow> dist (winding_number \<gamma> x') (winding_number \<gamma> z) < \<bar>Re(winding_number \<gamma> z)\<bar> - 1/2"
       using continuous_at_eps_delta wnz_12 diff_gt_0_iff_gt by blast
     define z' where "z' = z - (d / (2 * cmod a)) *\<^sub>R a"
     have *: "a \<bullet> z' \<le> b - d / 3 * cmod a"
       unfolding z'_def inner_mult_right' divide_inverse
       apply (simp add: field_split_simps algebra_simps dot_square_norm power2_eq_square anz)
       apply (metis \<open>0 < d\<close> add_increasing azb less_eq_real_def mult_nonneg_nonneg mult_right_mono norm_ge_zero norm_numeral)
       done
     have "cmod (winding_number \<gamma> z' - winding_number \<gamma> z) < \<bar>Re (winding_number \<gamma> z)\<bar> - 1/2"
       using d [of z'] anz \<open>d>0\<close> by (simp add: dist_norm z'_def)
     then have "1/2 < \<bar>Re (winding_number \<gamma> z)\<bar> - cmod (winding_number \<gamma> z' - winding_number \<gamma> z)"
       by simp
     then have "1/2 < \<bar>Re (winding_number \<gamma> z)\<bar> - \<bar>Re (winding_number \<gamma> z') - Re (winding_number \<gamma> z)\<bar>"
       using abs_Re_le_cmod [of "winding_number \<gamma> z' - winding_number \<gamma> z"] by simp
     then have wnz_12': "\<bar>Re (winding_number \<gamma> z')\<bar> > 1/2"
       by linarith
     moreover have "\<bar>Re (winding_number \<gamma> z')\<bar> < 1/2"
       apply (rule winding_number_lt_half [OF \<gamma> *])
       using azb \<open>d>0\<close> pag
-      apply (auto simp: add_strict_increasing anz field_split_simps algebra_simps dest!: subsetD)
+      apply (auto simp: add_strict_increasing anz field_split_simps dest!: subsetD)
       done
     ultimately have False
       by simp
   }
   then show ?thesis by force
 qed
 
 lemma winding_number_lt_half_linepath: "z \<notin> closed_segment a b \<Longrightarrow> \<bar>Re (winding_number (linepath a b) z)\<bar> < 1/2"
   using separating_hyperplane_closed_point [of "closed_segment a b" z]
   apply auto
   apply (simp add: closed_segment_def)
   apply (drule less_imp_le)
   apply (frule winding_number_lt_half [OF valid_path_linepath [of a b]])
   apply (auto simp: segment)
   done
 
 
 text\<open> Positivity of WN for a linepath.\<close>
 lemma winding_number_linepath_pos_lt:
     assumes "0 < Im ((b - a) * cnj (b - z))"
       shows "0 < Re(winding_number(linepath a b) z)"
 proof -
   have z: "z \<notin> path_image (linepath a b)"
     using assms
     by (simp add: closed_segment_def) (force simp: algebra_simps)
   show ?thesis
     apply (rule winding_number_pos_lt [OF valid_path_linepath z assms])
     apply (simp add: linepath_def algebra_simps)
     done
 qed
 
 
 subsection\<open>Cauchy's integral formula, again for a convex enclosing set\<close>
 
 lemma Cauchy_integral_formula_weak:
     assumes s: "convex s" and "finite k" and conf: "continuous_on s f"
         and fcd: "(\<And>x. x \<in> interior s - k \<Longrightarrow> f field_differentiable at x)"
         and z: "z \<in> interior s - k" and vpg: "valid_path \<gamma>"
         and pasz: "path_image \<gamma> \<subseteq> s - {z}" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
       shows "((\<lambda>w. f w / (w - z)) has_contour_integral (2*pi * \<i> * winding_number \<gamma> z * f z)) \<gamma>"
 proof -
   obtain f' where f': "(f has_field_derivative f') (at z)"
     using fcd [OF z] by (auto simp: field_differentiable_def)
   have pas: "path_image \<gamma> \<subseteq> s" and znotin: "z \<notin> path_image \<gamma>" using pasz by blast+
   have c: "continuous (at x within s) (\<lambda>w. if w = z then f' else (f w - f z) / (w - z))" if "x \<in> s" for x
   proof (cases "x = z")
     case True then show ?thesis
       apply (simp add: continuous_within)
       apply (rule Lim_transform_away_within [of _ "z+1" _ "\<lambda>w::complex. (f w - f z)/(w - z)"])
       using has_field_derivative_at_within has_field_derivative_iff f'
       apply (fastforce simp add:)+
       done
   next
     case False
     then have dxz: "dist x z > 0" by auto
     have cf: "continuous (at x within s) f"
       using conf continuous_on_eq_continuous_within that by blast
     have "continuous (at x within s) (\<lambda>w. (f w - f z) / (w - z))"
       by (rule cf continuous_intros | simp add: False)+
     then show ?thesis
       apply (rule continuous_transform_within [OF _ dxz that, of "\<lambda>w::complex. (f w - f z)/(w - z)"])
       apply (force simp: dist_commute)
       done
   qed
   have fink': "finite (insert z k)" using \<open>finite k\<close> by blast
   have *: "((\<lambda>w. if w = z then f' else (f w - f z) / (w - z)) has_contour_integral 0) \<gamma>"
     apply (rule Cauchy_theorem_convex [OF _ s fink' _ vpg pas loop])
     using c apply (force simp: continuous_on_eq_continuous_within)
     apply (rename_tac w)
     apply (rule_tac d="dist w z" and f = "\<lambda>w. (f w - f z)/(w - z)" in field_differentiable_transform_within)
     apply (simp_all add: dist_pos_lt dist_commute)
     apply (metis less_irrefl)
     apply (rule derivative_intros fcd | simp)+
     done
   show ?thesis
     apply (rule has_contour_integral_eq)
     using znotin has_contour_integral_add [OF has_contour_integral_lmul [OF has_contour_integral_winding_number [OF vpg znotin], of "f z"] *]
     apply (auto simp: ac_simps divide_simps)
     done
 qed
 
 theorem Cauchy_integral_formula_convex_simple:
     "\<lbrakk>convex s; f holomorphic_on s; z \<in> interior s; valid_path \<gamma>; path_image \<gamma> \<subseteq> s - {z};
       pathfinish \<gamma> = pathstart \<gamma>\<rbrakk>
      \<Longrightarrow> ((\<lambda>w. f w / (w - z)) has_contour_integral (2*pi * \<i> * winding_number \<gamma> z * f z)) \<gamma>"
   apply (rule Cauchy_integral_formula_weak [where k = "{}"])
   using holomorphic_on_imp_continuous_on
   by auto (metis at_within_interior holomorphic_on_def interiorE subsetCE)
 
 subsection\<open>Homotopy forms of Cauchy's theorem\<close>
 
 lemma Cauchy_theorem_homotopic:
     assumes hom: "if atends then homotopic_paths s g h else homotopic_loops s g h"
         and "open s" and f: "f holomorphic_on s"
         and vpg: "valid_path g" and vph: "valid_path h"
     shows "contour_integral g f = contour_integral h f"
 proof -
   have pathsf: "linked_paths atends g h"
     using hom  by (auto simp: linked_paths_def homotopic_paths_imp_pathstart homotopic_paths_imp_pathfinish homotopic_loops_imp_loop)
   obtain k :: "real \<times> real \<Rightarrow> complex"
     where contk: "continuous_on ({0..1} \<times> {0..1}) k"
       and ks: "k ` ({0..1} \<times> {0..1}) \<subseteq> s"
       and k [simp]: "\<forall>x. k (0, x) = g x" "\<forall>x. k (1, x) = h x"
       and ksf: "\<forall>t\<in>{0..1}. linked_paths atends g (\<lambda>x. k (t, x))"
       using hom pathsf by (auto simp: linked_paths_def homotopic_paths_def homotopic_loops_def homotopic_with_def split: if_split_asm)
   have ucontk: "uniformly_continuous_on ({0..1} \<times> {0..1}) k"
     by (blast intro: compact_Times compact_uniformly_continuous [OF contk])
   { fix t::real assume t: "t \<in> {0..1}"
     have pak: "path (k \<circ> (\<lambda>u. (t, u)))"
       unfolding path_def
       apply (rule continuous_intros continuous_on_subset [OF contk])+
       using t by force
     have pik: "path_image (k \<circ> Pair t) \<subseteq> s"
       using ks t by (auto simp: path_image_def)
     obtain e where "e>0" and e:
          "\<And>g h. \<lbrakk>valid_path g; valid_path h;
                   \<forall>u\<in>{0..1}. cmod (g u - (k \<circ> Pair t) u) < e \<and> cmod (h u - (k \<circ> Pair t) u) < e;
                   linked_paths atends g h\<rbrakk>
                  \<Longrightarrow> contour_integral h f = contour_integral g f"
       using contour_integral_nearby [OF \<open>open s\<close> pak pik, of atends] f by metis
     obtain d where "d>0" and d:
         "\<And>x x'. \<lbrakk>x \<in> {0..1} \<times> {0..1}; x' \<in> {0..1} \<times> {0..1}; norm (x'-x) < d\<rbrakk> \<Longrightarrow> norm (k x' - k x) < e/4"
       by (rule uniformly_continuous_onE [OF ucontk, of "e/4"]) (auto simp: dist_norm \<open>e>0\<close>)
     { fix t1 t2
       assume t1: "0 \<le> t1" "t1 \<le> 1" and t2: "0 \<le> t2" "t2 \<le> 1" and ltd: "\<bar>t1 - t\<bar> < d" "\<bar>t2 - t\<bar> < d"
       have no2: "\<And>g1 k1 kt. \<lbrakk>norm(g1 - k1) < e/4; norm(k1 - kt) < e/4\<rbrakk> \<Longrightarrow> norm(g1 - kt) < e"
         using \<open>e > 0\<close>
         apply (rule_tac y = k1 in norm_triangle_half_l)
         apply (auto simp: norm_minus_commute intro: order_less_trans)
         done
       have "\<exists>d>0. \<forall>g1 g2. valid_path g1 \<and> valid_path g2 \<and>
                           (\<forall>u\<in>{0..1}. cmod (g1 u - k (t1, u)) < d \<and> cmod (g2 u - k (t2, u)) < d) \<and>
                           linked_paths atends g1 g2 \<longrightarrow>
                           contour_integral g2 f = contour_integral g1 f"
         apply (rule_tac x="e/4" in exI)
         using t t1 t2 ltd \<open>e > 0\<close>
         apply (auto intro!: e simp: d no2 simp del: less_divide_eq_numeral1)
         done
     }
     then have "\<exists>e. 0 < e \<and>
               (\<forall>t1 t2. t1 \<in> {0..1} \<and> t2 \<in> {0..1} \<and> \<bar>t1 - t\<bar> < e \<and> \<bar>t2 - t\<bar> < e
                 \<longrightarrow> (\<exists>d. 0 < d \<and>
                      (\<forall>g1 g2. valid_path g1 \<and> valid_path g2 \<and>
                        (\<forall>u \<in> {0..1}.
                           norm(g1 u - k((t1,u))) < d \<and> norm(g2 u - k((t2,u))) < d) \<and>
                           linked_paths atends g1 g2
                           \<longrightarrow> contour_integral g2 f = contour_integral g1 f)))"
       by (rule_tac x=d in exI) (simp add: \<open>d > 0\<close>)
   }
   then obtain ee where ee:
        "\<And>t. t \<in> {0..1} \<Longrightarrow> ee t > 0 \<and>
           (\<forall>t1 t2. t1 \<in> {0..1} \<longrightarrow> t2 \<in> {0..1} \<longrightarrow> \<bar>t1 - t\<bar> < ee t \<longrightarrow> \<bar>t2 - t\<bar> < ee t
             \<longrightarrow> (\<exists>d. 0 < d \<and>
                  (\<forall>g1 g2. valid_path g1 \<and> valid_path g2 \<and>
                    (\<forall>u \<in> {0..1}.
                       norm(g1 u - k((t1,u))) < d \<and> norm(g2 u - k((t2,u))) < d) \<and>
                       linked_paths atends g1 g2
                       \<longrightarrow> contour_integral g2 f = contour_integral g1 f)))"
     by metis
   note ee_rule = ee [THEN conjunct2, rule_format]
   define C where "C = (\<lambda>t. ball t (ee t / 3)) ` {0..1}"
   obtain C' where C': "C' \<subseteq> C" "finite C'" and C'01: "{0..1} \<subseteq> \<Union>C'"
   proof (rule compactE [OF compact_interval])
     show "{0..1} \<subseteq> \<Union>C"
       using ee [THEN conjunct1] by (auto simp: C_def dist_norm)
   qed (use C_def in auto)
   define kk where "kk = {t \<in> {0..1}. ball t (ee t / 3) \<in> C'}"
   have kk01: "kk \<subseteq> {0..1}" by (auto simp: kk_def)
   define e where "e = Min (ee ` kk)"
   have C'_eq: "C' = (\<lambda>t. ball t (ee t / 3)) ` kk"
     using C' by (auto simp: kk_def C_def)
   have ee_pos[simp]: "\<And>t. t \<in> {0..1} \<Longrightarrow> ee t > 0"
     by (simp add: kk_def ee)
   moreover have "finite kk"
     using \<open>finite C'\<close> kk01 by (force simp: C'_eq inj_on_def ball_eq_ball_iff dest: ee_pos finite_imageD)
   moreover have "kk \<noteq> {}" using \<open>{0..1} \<subseteq> \<Union>C'\<close> C'_eq by force
   ultimately have "e > 0"
     using finite_less_Inf_iff [of "ee ` kk" 0] kk01 by (force simp: e_def)
   then obtain N::nat where "N > 0" and N: "1/N < e/3"
     by (meson divide_pos_pos nat_approx_posE zero_less_Suc zero_less_numeral)
   have e_le_ee: "\<And>i. i \<in> kk \<Longrightarrow> e \<le> ee i"
     using \<open>finite kk\<close> by (simp add: e_def Min_le_iff [of "ee ` kk"])
   have plus: "\<exists>t \<in> kk. x \<in> ball t (ee t / 3)" if "x \<in> {0..1}" for x
     using C' subsetD [OF C'01 that]  unfolding C'_eq by blast
   have [OF order_refl]:
       "\<exists>d. 0 < d \<and> (\<forall>j. valid_path j \<and> (\<forall>u \<in> {0..1}. norm(j u - k (n/N, u)) < d) \<and> linked_paths atends g j
                         \<longrightarrow> contour_integral j f = contour_integral g f)"
        if "n \<le> N" for n
   using that
   proof (induct n)
     case 0 show ?case using ee_rule [of 0 0 0]
       apply clarsimp
       apply (rule_tac x=d in exI, safe)
       by (metis diff_self vpg norm_zero)
   next
     case (Suc n)
     then have N01: "n/N \<in> {0..1}" "(Suc n)/N \<in> {0..1}"  by auto
     then obtain t where t: "t \<in> kk" "n/N \<in> ball t (ee t / 3)"
       using plus [of "n/N"] by blast
     then have nN_less: "\<bar>n/N - t\<bar> < ee t"
       by (simp add: dist_norm del: less_divide_eq_numeral1)
     have n'N_less: "\<bar>real (Suc n) / real N - t\<bar> < ee t"
       using t N \<open>N > 0\<close> e_le_ee [of t]
       by (simp add: dist_norm add_divide_distrib abs_diff_less_iff del: less_divide_eq_numeral1) (simp add: field_simps)
     have t01: "t \<in> {0..1}" using \<open>kk \<subseteq> {0..1}\<close> \<open>t \<in> kk\<close> by blast
     obtain d1 where "d1 > 0" and d1:
         "\<And>g1 g2. \<lbrakk>valid_path g1; valid_path g2;
                    \<forall>u\<in>{0..1}. cmod (g1 u - k (n/N, u)) < d1 \<and> cmod (g2 u - k ((Suc n) / N, u)) < d1;
                    linked_paths atends g1 g2\<rbrakk>
                    \<Longrightarrow> contour_integral g2 f = contour_integral g1 f"
       using ee [THEN conjunct2, rule_format, OF t01 N01 nN_less n'N_less] by fastforce
     have "n \<le> N" using Suc.prems by auto
     with Suc.hyps
     obtain d2 where "d2 > 0"
       and d2: "\<And>j. \<lbrakk>valid_path j; \<forall>u\<in>{0..1}. cmod (j u - k (n/N, u)) < d2; linked_paths atends g j\<rbrakk>
                      \<Longrightarrow> contour_integral j f = contour_integral g f"
         by auto
     have "continuous_on {0..1} (k \<circ> (\<lambda>u. (n/N, u)))"
       apply (rule continuous_intros continuous_on_subset [OF contk])+
       using N01 by auto
     then have pkn: "path (\<lambda>u. k (n/N, u))"
       by (simp add: path_def)
     have min12: "min d1 d2 > 0" by (simp add: \<open>0 < d1\<close> \<open>0 < d2\<close>)
     obtain p where "polynomial_function p"
         and psf: "pathstart p = pathstart (\<lambda>u. k (n/N, u))"
                  "pathfinish p = pathfinish (\<lambda>u. k (n/N, u))"
         and pk_le:  "\<And>t. t\<in>{0..1} \<Longrightarrow> cmod (p t - k (n/N, t)) < min d1 d2"
       using path_approx_polynomial_function [OF pkn min12] by blast
     then have vpp: "valid_path p" using valid_path_polynomial_function by blast
     have lpa: "linked_paths atends g p"
       by (metis (mono_tags, lifting) N01(1) ksf linked_paths_def pathfinish_def pathstart_def psf)
     show ?case
     proof (intro exI; safe)
       fix j
       assume "valid_path j" "linked_paths atends g j"
         and "\<forall>u\<in>{0..1}. cmod (j u - k (real (Suc n) / real N, u)) < min d1 d2"
       then have "contour_integral j f = contour_integral p f"
         using pk_le N01(1) ksf by (force intro!: vpp d1 simp add: linked_paths_def psf)
       also have "... = contour_integral g f"
         using pk_le by (force intro!: vpp d2 lpa)
       finally show "contour_integral j f = contour_integral g f" .
     qed (simp add: \<open>0 < d1\<close> \<open>0 < d2\<close>)
   qed
   then obtain d where "0 < d"
                        "\<And>j. valid_path j \<and> (\<forall>u \<in> {0..1}. norm(j u - k (1,u)) < d) \<and> linked_paths atends g j
                             \<Longrightarrow> contour_integral j f = contour_integral g f"
     using \<open>N>0\<close> by auto
   then have "linked_paths atends g h \<Longrightarrow> contour_integral h f = contour_integral g f"
     using \<open>N>0\<close> vph by fastforce
   then show ?thesis
     by (simp add: pathsf)
 qed
 
 proposition Cauchy_theorem_homotopic_paths:
     assumes hom: "homotopic_paths s g h"
         and "open s" and f: "f holomorphic_on s"
         and vpg: "valid_path g" and vph: "valid_path h"
     shows "contour_integral g f = contour_integral h f"
   using Cauchy_theorem_homotopic [of True s g h] assms by simp
 
 proposition Cauchy_theorem_homotopic_loops:
     assumes hom: "homotopic_loops s g h"
         and "open s" and f: "f holomorphic_on s"
         and vpg: "valid_path g" and vph: "valid_path h"
     shows "contour_integral g f = contour_integral h f"
   using Cauchy_theorem_homotopic [of False s g h] assms by simp
 
 lemma has_contour_integral_newpath:
     "\<lbrakk>(f has_contour_integral y) h; f contour_integrable_on g; contour_integral g f = contour_integral h f\<rbrakk>
      \<Longrightarrow> (f has_contour_integral y) g"
   using has_contour_integral_integral contour_integral_unique by auto
 
 lemma Cauchy_theorem_null_homotopic:
      "\<lbrakk>f holomorphic_on s; open s; valid_path g; homotopic_loops s g (linepath a a)\<rbrakk> \<Longrightarrow> (f has_contour_integral 0) g"
   apply (rule has_contour_integral_newpath [where h = "linepath a a"], simp)
   using contour_integrable_holomorphic_simple
     apply (blast dest: holomorphic_on_imp_continuous_on homotopic_loops_imp_subset)
   by (simp add: Cauchy_theorem_homotopic_loops)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More winding number properties\<close>
 
 text\<open>including the fact that it's +-1 inside a simple closed curve.\<close>
 
 lemma winding_number_homotopic_paths:
     assumes "homotopic_paths (-{z}) g h"
       shows "winding_number g z = winding_number h z"
 proof -
   have "path g" "path h" using homotopic_paths_imp_path [OF assms] by auto
   moreover have pag: "z \<notin> path_image g" and pah: "z \<notin> path_image h"
     using homotopic_paths_imp_subset [OF assms] by auto
   ultimately obtain d e where "d > 0" "e > 0"
       and d: "\<And>p. \<lbrakk>path p; pathstart p = pathstart g; pathfinish p = pathfinish g; \<forall>t\<in>{0..1}. norm (p t - g t) < d\<rbrakk>
             \<Longrightarrow> homotopic_paths (-{z}) g p"
       and e: "\<And>q. \<lbrakk>path q; pathstart q = pathstart h; pathfinish q = pathfinish h; \<forall>t\<in>{0..1}. norm (q t - h t) < e\<rbrakk>
             \<Longrightarrow> homotopic_paths (-{z}) h q"
     using homotopic_nearby_paths [of g "-{z}"] homotopic_nearby_paths [of h "-{z}"] by force
   obtain p where p:
        "valid_path p" "z \<notin> path_image p"
        "pathstart p = pathstart g" "pathfinish p = pathfinish g"
        and gp_less:"\<forall>t\<in>{0..1}. cmod (g t - p t) < d"
        and pap: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number g z"
     using winding_number [OF \<open>path g\<close> pag \<open>0 < d\<close>] unfolding winding_number_prop_def by blast
   obtain q where q:
        "valid_path q" "z \<notin> path_image q"
        "pathstart q = pathstart h" "pathfinish q = pathfinish h"
        and hq_less: "\<forall>t\<in>{0..1}. cmod (h t - q t) < e"
        and paq:  "contour_integral q (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number h z"
     using winding_number [OF \<open>path h\<close> pah \<open>0 < e\<close>] unfolding winding_number_prop_def by blast
   have "homotopic_paths (- {z}) g p"
     by (simp add: d p valid_path_imp_path norm_minus_commute gp_less)
   moreover have "homotopic_paths (- {z}) h q"
     by (simp add: e q valid_path_imp_path norm_minus_commute hq_less)
   ultimately have "homotopic_paths (- {z}) p q"
     by (blast intro: homotopic_paths_trans homotopic_paths_sym assms)
   then have "contour_integral p (\<lambda>w. 1/(w - z)) = contour_integral q (\<lambda>w. 1/(w - z))"
     by (rule Cauchy_theorem_homotopic_paths) (auto intro!: holomorphic_intros simp: p q)
   then show ?thesis
     by (simp add: pap paq)
 qed
 
 lemma winding_number_homotopic_loops:
     assumes "homotopic_loops (-{z}) g h"
       shows "winding_number g z = winding_number h z"
 proof -
   have "path g" "path h" using homotopic_loops_imp_path [OF assms] by auto
   moreover have pag: "z \<notin> path_image g" and pah: "z \<notin> path_image h"
     using homotopic_loops_imp_subset [OF assms] by auto
   moreover have gloop: "pathfinish g = pathstart g" and hloop: "pathfinish h = pathstart h"
     using homotopic_loops_imp_loop [OF assms] by auto
   ultimately obtain d e where "d > 0" "e > 0"
       and d: "\<And>p. \<lbrakk>path p; pathfinish p = pathstart p; \<forall>t\<in>{0..1}. norm (p t - g t) < d\<rbrakk>
             \<Longrightarrow> homotopic_loops (-{z}) g p"
       and e: "\<And>q. \<lbrakk>path q; pathfinish q = pathstart q; \<forall>t\<in>{0..1}. norm (q t - h t) < e\<rbrakk>
             \<Longrightarrow> homotopic_loops (-{z}) h q"
     using homotopic_nearby_loops [of g "-{z}"] homotopic_nearby_loops [of h "-{z}"] by force
   obtain p where p:
        "valid_path p" "z \<notin> path_image p"
        "pathstart p = pathstart g" "pathfinish p = pathfinish g"
        and gp_less:"\<forall>t\<in>{0..1}. cmod (g t - p t) < d"
        and pap: "contour_integral p (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number g z"
     using winding_number [OF \<open>path g\<close> pag \<open>0 < d\<close>] unfolding winding_number_prop_def by blast
   obtain q where q:
        "valid_path q" "z \<notin> path_image q"
        "pathstart q = pathstart h" "pathfinish q = pathfinish h"
        and hq_less: "\<forall>t\<in>{0..1}. cmod (h t - q t) < e"
        and paq:  "contour_integral q (\<lambda>w. 1 / (w - z)) = complex_of_real (2 * pi) * \<i> * winding_number h z"
     using winding_number [OF \<open>path h\<close> pah \<open>0 < e\<close>] unfolding winding_number_prop_def by blast
   have gp: "homotopic_loops (- {z}) g p"
     by (simp add: gloop d gp_less norm_minus_commute p valid_path_imp_path)
   have hq: "homotopic_loops (- {z}) h q"
     by (simp add: e hloop hq_less norm_minus_commute q valid_path_imp_path)
   have "contour_integral p (\<lambda>w. 1/(w - z)) = contour_integral q (\<lambda>w. 1/(w - z))"
   proof (rule Cauchy_theorem_homotopic_loops)
     show "homotopic_loops (- {z}) p q"
       by (blast intro: homotopic_loops_trans homotopic_loops_sym gp hq assms)
   qed (auto intro!: holomorphic_intros simp: p q)
   then show ?thesis
     by (simp add: pap paq)
 qed
 
 lemma winding_number_paths_linear_eq:
   "\<lbrakk>path g; path h; pathstart h = pathstart g; pathfinish h = pathfinish g;
     \<And>t. t \<in> {0..1} \<Longrightarrow> z \<notin> closed_segment (g t) (h t)\<rbrakk>
         \<Longrightarrow> winding_number h z = winding_number g z"
   by (blast intro: sym homotopic_paths_linear winding_number_homotopic_paths)
 
 lemma winding_number_loops_linear_eq:
   "\<lbrakk>path g; path h; pathfinish g = pathstart g; pathfinish h = pathstart h;
     \<And>t. t \<in> {0..1} \<Longrightarrow> z \<notin> closed_segment (g t) (h t)\<rbrakk>
         \<Longrightarrow> winding_number h z = winding_number g z"
   by (blast intro: sym homotopic_loops_linear winding_number_homotopic_loops)
 
 lemma winding_number_nearby_paths_eq:
      "\<lbrakk>path g; path h; pathstart h = pathstart g; pathfinish h = pathfinish g;
       \<And>t. t \<in> {0..1} \<Longrightarrow> norm(h t - g t) < norm(g t - z)\<rbrakk>
       \<Longrightarrow> winding_number h z = winding_number g z"
   by (metis segment_bound(2) norm_minus_commute not_le winding_number_paths_linear_eq)
 
 lemma winding_number_nearby_loops_eq:
      "\<lbrakk>path g; path h; pathfinish g = pathstart g; pathfinish h = pathstart h;
       \<And>t. t \<in> {0..1} \<Longrightarrow> norm(h t - g t) < norm(g t - z)\<rbrakk>
       \<Longrightarrow> winding_number h z = winding_number g z"
   by (metis segment_bound(2) norm_minus_commute not_le winding_number_loops_linear_eq)
 
 
 lemma winding_number_subpath_combine:
     "\<lbrakk>path g; z \<notin> path_image g;
       u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
       \<Longrightarrow> winding_number (subpath u v g) z + winding_number (subpath v w g) z =
           winding_number (subpath u w g) z"
 apply (rule trans [OF winding_number_join [THEN sym]
                       winding_number_homotopic_paths [OF homotopic_join_subpaths]])
   using path_image_subpath_subset by auto
 
 subsection\<open>Partial circle path\<close>
 
 definition\<^marker>\<open>tag important\<close> part_circlepath :: "[complex, real, real, real, real] \<Rightarrow> complex"
   where "part_circlepath z r s t \<equiv> \<lambda>x. z + of_real r * exp (\<i> * of_real (linepath s t x))"
 
 lemma pathstart_part_circlepath [simp]:
      "pathstart(part_circlepath z r s t) = z + r*exp(\<i> * s)"
 by (metis part_circlepath_def pathstart_def pathstart_linepath)
 
 lemma pathfinish_part_circlepath [simp]:
      "pathfinish(part_circlepath z r s t) = z + r*exp(\<i>*t)"
 by (metis part_circlepath_def pathfinish_def pathfinish_linepath)
 
 lemma reversepath_part_circlepath[simp]:
     "reversepath (part_circlepath z r s t) = part_circlepath z r t s"
   unfolding part_circlepath_def reversepath_def linepath_def 
   by (auto simp:algebra_simps)
     
 lemma has_vector_derivative_part_circlepath [derivative_intros]:
     "((part_circlepath z r s t) has_vector_derivative
       (\<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)))
      (at x within X)"
   apply (simp add: part_circlepath_def linepath_def scaleR_conv_of_real)
   apply (rule has_vector_derivative_real_field)
   apply (rule derivative_eq_intros | simp)+
   done
 
 lemma differentiable_part_circlepath:
   "part_circlepath c r a b differentiable at x within A"
   using has_vector_derivative_part_circlepath[of c r a b x A] differentiableI_vector by blast
 
 lemma vector_derivative_part_circlepath:
     "vector_derivative (part_circlepath z r s t) (at x) =
        \<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)"
   using has_vector_derivative_part_circlepath vector_derivative_at by blast
 
 lemma vector_derivative_part_circlepath01:
     "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk>
      \<Longrightarrow> vector_derivative (part_circlepath z r s t) (at x within {0..1}) =
           \<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)"
   using has_vector_derivative_part_circlepath
   by (auto simp: vector_derivative_at_within_ivl)
 
 lemma valid_path_part_circlepath [simp]: "valid_path (part_circlepath z r s t)"
   apply (simp add: valid_path_def)
   apply (rule C1_differentiable_imp_piecewise)
   apply (auto simp: C1_differentiable_on_eq vector_derivative_works vector_derivative_part_circlepath has_vector_derivative_part_circlepath
               intro!: continuous_intros)
   done
 
 lemma path_part_circlepath [simp]: "path (part_circlepath z r s t)"
   by (simp add: valid_path_imp_path)
 
 proposition path_image_part_circlepath:
   assumes "s \<le> t"
     shows "path_image (part_circlepath z r s t) = {z + r * exp(\<i> * of_real x) | x. s \<le> x \<and> x \<le> t}"
 proof -
   { fix z::real
     assume "0 \<le> z" "z \<le> 1"
     with \<open>s \<le> t\<close> have "\<exists>x. (exp (\<i> * linepath s t z) = exp (\<i> * of_real x)) \<and> s \<le> x \<and> x \<le> t"
       apply (rule_tac x="(1 - z) * s + z * t" in exI)
       apply (simp add: linepath_def scaleR_conv_of_real algebra_simps)
       apply (rule conjI)
       using mult_right_mono apply blast
       using affine_ineq  by (metis "mult.commute")
   }
   moreover
   { fix z
     assume "s \<le> z" "z \<le> t"
     then have "z + of_real r * exp (\<i> * of_real z) \<in> (\<lambda>x. z + of_real r * exp (\<i> * linepath s t x)) ` {0..1}"
       apply (rule_tac x="(z - s)/(t - s)" in image_eqI)
       apply (simp add: linepath_def scaleR_conv_of_real divide_simps exp_eq)
       apply (auto simp: field_split_simps)
       done
   }
   ultimately show ?thesis
     by (fastforce simp add: path_image_def part_circlepath_def)
 qed
 
 lemma path_image_part_circlepath':
   "path_image (part_circlepath z r s t) = (\<lambda>x. z + r * cis x) ` closed_segment s t"
 proof -
   have "path_image (part_circlepath z r s t) = 
           (\<lambda>x. z + r * exp(\<i> * of_real x)) ` linepath s t ` {0..1}"
     by (simp add: image_image path_image_def part_circlepath_def)
   also have "linepath s t ` {0..1} = closed_segment s t"
     by (rule linepath_image_01)
   finally show ?thesis by (simp add: cis_conv_exp)
 qed
 
 lemma path_image_part_circlepath_subset:
     "\<lbrakk>s \<le> t; 0 \<le> r\<rbrakk> \<Longrightarrow> path_image(part_circlepath z r s t) \<subseteq> sphere z r"
 by (auto simp: path_image_part_circlepath sphere_def dist_norm algebra_simps norm_mult)
 
 lemma in_path_image_part_circlepath:
   assumes "w \<in> path_image(part_circlepath z r s t)" "s \<le> t" "0 \<le> r"
     shows "norm(w - z) = r"
 proof -
   have "w \<in> {c. dist z c = r}"
     by (metis (no_types) path_image_part_circlepath_subset sphere_def subset_eq assms)
   thus ?thesis
     by (simp add: dist_norm norm_minus_commute)
 qed
 
 lemma path_image_part_circlepath_subset':
   assumes "r \<ge> 0"
   shows   "path_image (part_circlepath z r s t) \<subseteq> sphere z r"
 proof (cases "s \<le> t")
   case True
   thus ?thesis using path_image_part_circlepath_subset[of s t r z] assms by simp
 next
   case False
   thus ?thesis using path_image_part_circlepath_subset[of t s r z] assms
     by (subst reversepath_part_circlepath [symmetric], subst path_image_reversepath) simp_all
 qed
 
 lemma part_circlepath_cnj: "cnj (part_circlepath c r a b x) = part_circlepath (cnj c) r (-a) (-b) x"
   by (simp add: part_circlepath_def exp_cnj linepath_def algebra_simps)
 
 lemma contour_integral_bound_part_circlepath:
   assumes "f contour_integrable_on part_circlepath c r a b"
   assumes "B \<ge> 0" "r \<ge> 0" "\<And>x. x \<in> path_image (part_circlepath c r a b) \<Longrightarrow> norm (f x) \<le> B"
   shows   "norm (contour_integral (part_circlepath c r a b) f) \<le> B * r * \<bar>b - a\<bar>"
 proof -
   let ?I = "integral {0..1} (\<lambda>x. f (part_circlepath c r a b x) * \<i> * of_real (r * (b - a)) *
               exp (\<i> * linepath a b x))"
   have "norm ?I \<le> integral {0..1} (\<lambda>x::real. B * 1 * (r * \<bar>b - a\<bar>) * 1)"
   proof (rule integral_norm_bound_integral, goal_cases)
     case 1
     with assms(1) show ?case
       by (simp add: contour_integrable_on vector_derivative_part_circlepath mult_ac)
   next
     case (3 x)
     with assms(2-) show ?case unfolding norm_mult norm_of_real abs_mult
       by (intro mult_mono) (auto simp: path_image_def)
   qed auto
   also have "?I = contour_integral (part_circlepath c r a b) f"
     by (simp add: contour_integral_integral vector_derivative_part_circlepath mult_ac)
   finally show ?thesis by simp
 qed
 
 lemma has_contour_integral_part_circlepath_iff:
   assumes "a < b"
   shows "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
            ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}"
 proof -
   have "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
           ((\<lambda>x. f (part_circlepath c r a b x) * vector_derivative (part_circlepath c r a b)
            (at x within {0..1})) has_integral I) {0..1}"
     unfolding has_contour_integral_def ..
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (part_circlepath c r a b x) * r * (b - a) * \<i> *
                             cis (linepath a b x)) has_integral I) {0..1}"
     by (intro has_integral_cong, subst vector_derivative_part_circlepath01)
        (simp_all add: cis_conv_exp)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (c + r * exp (\<i> * linepath (of_real a) (of_real b) x)) *
                        r * \<i> * exp (\<i> * linepath (of_real a) (of_real b) x) *
                        vector_derivative (linepath (of_real a) (of_real b)) 
                          (at x within {0..1})) has_integral I) {0..1}"
     by (intro has_integral_cong, subst vector_derivative_linepath_within)
        (auto simp: part_circlepath_def cis_conv_exp of_real_linepath [symmetric])
   also have "\<dots> \<longleftrightarrow> ((\<lambda>z. f (c + r * exp (\<i> * z)) * r * \<i> * exp (\<i> * z)) has_contour_integral I)
                       (linepath (of_real a) (of_real b))"
     by (simp add: has_contour_integral_def)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}" using assms
     by (subst has_contour_integral_linepath_Reals_iff) (simp_all add: cis_conv_exp)
   finally show ?thesis .
 qed
 
 lemma contour_integrable_part_circlepath_iff:
   assumes "a < b"
   shows "f contour_integrable_on (part_circlepath c r a b) \<longleftrightarrow>
            (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}"
   using assms by (auto simp: contour_integrable_on_def integrable_on_def 
                              has_contour_integral_part_circlepath_iff)
 
 lemma contour_integral_part_circlepath_eq:
   assumes "a < b"
   shows "contour_integral (part_circlepath c r a b) f =
            integral {a..b} (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t)"
 proof (cases "f contour_integrable_on part_circlepath c r a b")
   case True
   hence "(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}" 
     using assms by (simp add: contour_integrable_part_circlepath_iff)
   with True show ?thesis
     using has_contour_integral_part_circlepath_iff[OF assms]
           contour_integral_unique has_integral_integrable_integral by blast
 next
   case False
   hence "\<not>(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}" 
     using assms by (simp add: contour_integrable_part_circlepath_iff)
   with False show ?thesis
     by (simp add: not_integrable_contour_integral not_integrable_integral)
 qed
 
 lemma contour_integral_part_circlepath_reverse:
   "contour_integral (part_circlepath c r a b) f = -contour_integral (part_circlepath c r b a) f"
   by (subst reversepath_part_circlepath [symmetric], subst contour_integral_reversepath) simp_all
 
 lemma contour_integral_part_circlepath_reverse':
   "b < a \<Longrightarrow> contour_integral (part_circlepath c r a b) f = 
                -contour_integral (part_circlepath c r b a) f"
   by (rule contour_integral_part_circlepath_reverse)
 
 lemma finite_bounded_log: "finite {z::complex. norm z \<le> b \<and> exp z = w}"
 proof (cases "w = 0")
   case True then show ?thesis by auto
 next
   case False
   have *: "finite {x. cmod (complex_of_real (2 * real_of_int x * pi) * \<i>) \<le> b + cmod (Ln w)}"
     apply (simp add: norm_mult finite_int_iff_bounded_le)
     apply (rule_tac x="\<lfloor>(b + cmod (Ln w)) / (2*pi)\<rfloor>" in exI)
     apply (auto simp: field_split_simps le_floor_iff)
     done
   have [simp]: "\<And>P f. {z. P z \<and> (\<exists>n. z = f n)} = f ` {n. P (f n)}"
     by blast
   show ?thesis
     apply (subst exp_Ln [OF False, symmetric])
     apply (simp add: exp_eq)
     using norm_add_leD apply (fastforce intro: finite_subset [OF _ *])
     done
 qed
 
 lemma finite_bounded_log2:
   fixes a::complex
     assumes "a \<noteq> 0"
     shows "finite {z. norm z \<le> b \<and> exp(a*z) = w}"
 proof -
   have *: "finite ((\<lambda>z. z / a) ` {z. cmod z \<le> b * cmod a \<and> exp z = w})"
     by (rule finite_imageI [OF finite_bounded_log])
   show ?thesis
     by (rule finite_subset [OF _ *]) (force simp: assms norm_mult)
 qed
 
 lemma has_contour_integral_bound_part_circlepath_strong:
   assumes fi: "(f has_contour_integral i) (part_circlepath z r s t)"
       and "finite k" and le: "0 \<le> B" "0 < r" "s \<le> t"
       and B: "\<And>x. x \<in> path_image(part_circlepath z r s t) - k \<Longrightarrow> norm(f x) \<le> B"
     shows "cmod i \<le> B * r * (t - s)"
 proof -
   consider "s = t" | "s < t" using \<open>s \<le> t\<close> by linarith
   then show ?thesis
   proof cases
     case 1 with fi [unfolded has_contour_integral]
     have "i = 0"  by (simp add: vector_derivative_part_circlepath)
     with assms show ?thesis by simp
   next
     case 2
     have [simp]: "\<bar>r\<bar> = r" using \<open>r > 0\<close> by linarith
     have [simp]: "cmod (complex_of_real t - complex_of_real s) = t-s"
       by (metis "2" abs_of_pos diff_gt_0_iff_gt norm_of_real of_real_diff)
     have "finite (part_circlepath z r s t -` {y} \<inter> {0..1})" if "y \<in> k" for y
     proof -
       define w where "w = (y - z)/of_real r / exp(\<i> * of_real s)"
       have fin: "finite (of_real -` {z. cmod z \<le> 1 \<and> exp (\<i> * complex_of_real (t - s) * z) = w})"
         apply (rule finite_vimageI [OF finite_bounded_log2])
         using \<open>s < t\<close> apply (auto simp: inj_of_real)
         done
       show ?thesis
         apply (simp add: part_circlepath_def linepath_def vimage_def)
         apply (rule finite_subset [OF _ fin])
         using le
         apply (auto simp: w_def algebra_simps scaleR_conv_of_real exp_add exp_diff)
         done
     qed
     then have fin01: "finite ((part_circlepath z r s t) -` k \<inter> {0..1})"
       by (rule finite_finite_vimage_IntI [OF \<open>finite k\<close>])
     have **: "((\<lambda>x. if (part_circlepath z r s t x) \<in> k then 0
                     else f(part_circlepath z r s t x) *
                        vector_derivative (part_circlepath z r s t) (at x)) has_integral i)  {0..1}"
       by (rule has_integral_spike [OF negligible_finite [OF fin01]])  (use fi has_contour_integral in auto)
     have *: "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1; part_circlepath z r s t x \<notin> k\<rbrakk> \<Longrightarrow> cmod (f (part_circlepath z r s t x)) \<le> B"
       by (auto intro!: B [unfolded path_image_def image_def, simplified])
     show ?thesis
       apply (rule has_integral_bound [where 'a=real, simplified, OF _ **, simplified])
       using assms apply force
       apply (simp add: norm_mult vector_derivative_part_circlepath)
       using le * "2" \<open>r > 0\<close> by auto
   qed
 qed
 
 lemma has_contour_integral_bound_part_circlepath:
       "\<lbrakk>(f has_contour_integral i) (part_circlepath z r s t);
         0 \<le> B; 0 < r; s \<le> t;
         \<And>x. x \<in> path_image(part_circlepath z r s t) \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
        \<Longrightarrow> norm i \<le> B*r*(t - s)"
   by (auto intro: has_contour_integral_bound_part_circlepath_strong)
 
 lemma contour_integrable_continuous_part_circlepath:
      "continuous_on (path_image (part_circlepath z r s t)) f
       \<Longrightarrow> f contour_integrable_on (part_circlepath z r s t)"
   apply (simp add: contour_integrable_on has_contour_integral_def vector_derivative_part_circlepath path_image_def)
   apply (rule integrable_continuous_real)
   apply (fast intro: path_part_circlepath [unfolded path_def] continuous_intros continuous_on_compose2 [where g=f, OF _ _ order_refl])
   done
 
 proposition winding_number_part_circlepath_pos_less:
   assumes "s < t" and no: "norm(w - z) < r"
     shows "0 < Re (winding_number(part_circlepath z r s t) w)"
 proof -
   have "0 < r" by (meson no norm_not_less_zero not_le order.strict_trans2)
   note valid_path_part_circlepath
   moreover have " w \<notin> path_image (part_circlepath z r s t)"
     using assms by (auto simp: path_image_def image_def part_circlepath_def norm_mult linepath_def)
   moreover have "0 < r * (t - s) * (r - cmod (w - z))"
     using assms by (metis \<open>0 < r\<close> diff_gt_0_iff_gt mult_pos_pos)
   ultimately show ?thesis
     apply (rule winding_number_pos_lt [where e = "r*(t - s)*(r - norm(w - z))"])
     apply (simp add: vector_derivative_part_circlepath right_diff_distrib [symmetric] mult_ac)
     apply (rule mult_left_mono)+
     using Re_Im_le_cmod [of "w-z" "linepath s t x" for x]
     apply (simp add: exp_Euler cos_of_real sin_of_real part_circlepath_def algebra_simps cos_squared_eq [unfolded power2_eq_square])
     using assms \<open>0 < r\<close> by auto
 qed
 
 lemma simple_path_part_circlepath:
     "simple_path(part_circlepath z r s t) \<longleftrightarrow> (r \<noteq> 0 \<and> s \<noteq> t \<and> \<bar>s - t\<bar> \<le> 2*pi)"
 proof (cases "r = 0 \<or> s = t")
   case True
   then show ?thesis
     unfolding part_circlepath_def simple_path_def
     by (rule disjE) (force intro: bexI [where x = "1/4"] bexI [where x = "1/3"])+
 next
   case False then have "r \<noteq> 0" "s \<noteq> t" by auto
   have *: "\<And>x y z s t. \<i>*((1 - x) * s + x * t) = \<i>*(((1 - y) * s + y * t)) + z  \<longleftrightarrow> \<i>*(x - y) * (t - s) = z"
     by (simp add: algebra_simps)
   have abs01: "\<And>x y::real. 0 \<le> x \<and> x \<le> 1 \<and> 0 \<le> y \<and> y \<le> 1
                       \<Longrightarrow> (x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0 \<longleftrightarrow> \<bar>x - y\<bar> \<in> {0,1})"
     by auto
   have **: "\<And>x y. (\<exists>n. (complex_of_real x - of_real y) * (of_real t - of_real s) = 2 * (of_int n * of_real pi)) \<longleftrightarrow>
                   (\<exists>n. \<bar>x - y\<bar> * (t - s) = 2 * (of_int n * pi))"
     by (force simp: algebra_simps abs_if dest: arg_cong [where f=Re] arg_cong [where f=complex_of_real]
                     intro: exI [where x = "-n" for n])
   have 1: "\<bar>s - t\<bar> \<le> 2 * pi"
     if "\<And>x. 0 \<le> x \<and> x \<le> 1 \<Longrightarrow> (\<exists>n. x * (t - s) = 2 * (real_of_int n * pi)) \<longrightarrow> x = 0 \<or> x = 1"
   proof (rule ccontr)
     assume "\<not> \<bar>s - t\<bar> \<le> 2 * pi"
     then have *: "\<And>n. t - s \<noteq> of_int n * \<bar>s - t\<bar>"
       using False that [of "2*pi / \<bar>t - s\<bar>"]
       by (simp add: abs_minus_commute divide_simps)
     show False
       using * [of 1] * [of "-1"] by auto
   qed
   have 2: "\<bar>s - t\<bar> = \<bar>2 * (real_of_int n * pi) / x\<bar>" if "x \<noteq> 0" "x * (t - s) = 2 * (real_of_int n * pi)" for x n
   proof -
     have "t-s = 2 * (real_of_int n * pi)/x"
       using that by (simp add: field_simps)
     then show ?thesis by (metis abs_minus_commute)
   qed
   have abs_away: "\<And>P. (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. P \<bar>x - y\<bar>) \<longleftrightarrow> (\<forall>x::real. 0 \<le> x \<and> x \<le> 1 \<longrightarrow> P x)"
     by force
   show ?thesis using False
     apply (simp add: simple_path_def)
     apply (simp add: part_circlepath_def linepath_def exp_eq  * ** abs01  del: Set.insert_iff)
     apply (subst abs_away)
     apply (auto simp: 1)
     apply (rule ccontr)
     apply (auto simp: 2 field_split_simps abs_mult dest: of_int_leD)
     done
 qed
 
 lemma arc_part_circlepath:
   assumes "r \<noteq> 0" "s \<noteq> t" "\<bar>s - t\<bar> < 2*pi"
     shows "arc (part_circlepath z r s t)"
 proof -
   have *: "x = y" if eq: "\<i> * (linepath s t x) = \<i> * (linepath s t y) + 2 * of_int n * complex_of_real pi * \<i>"
     and x: "x \<in> {0..1}" and y: "y \<in> {0..1}" for x y n
   proof (rule ccontr)
     assume "x \<noteq> y"
     have "(linepath s t x) = (linepath s t y) + 2 * of_int n * complex_of_real pi"
       by (metis add_divide_eq_iff complex_i_not_zero mult.commute nonzero_mult_div_cancel_left eq)
     then have "s*y + t*x = s*x + (t*y + of_int n * (pi * 2))"
       by (force simp: algebra_simps linepath_def dest: arg_cong [where f=Re])
     with \<open>x \<noteq> y\<close> have st: "s-t = (of_int n * (pi * 2) / (y-x))"
       by (force simp: field_simps)
     have "\<bar>real_of_int n\<bar> < \<bar>y - x\<bar>"
       using assms \<open>x \<noteq> y\<close> by (simp add: st abs_mult field_simps)
     then show False
       using assms x y st by (auto dest: of_int_lessD)
   qed
   show ?thesis
     using assms
     apply (simp add: arc_def)
     apply (simp add: part_circlepath_def inj_on_def exp_eq)
     apply (blast intro: *)
     done
 qed
 
 subsection\<open>Special case of one complete circle\<close>
 
 definition\<^marker>\<open>tag important\<close> circlepath :: "[complex, real, real] \<Rightarrow> complex"
   where "circlepath z r \<equiv> part_circlepath z r 0 (2*pi)"
 
 lemma circlepath: "circlepath z r = (\<lambda>x. z + r * exp(2 * of_real pi * \<i> * of_real x))"
   by (simp add: circlepath_def part_circlepath_def linepath_def algebra_simps)
 
 lemma pathstart_circlepath [simp]: "pathstart (circlepath z r) = z + r"
   by (simp add: circlepath_def)
 
 lemma pathfinish_circlepath [simp]: "pathfinish (circlepath z r) = z + r"
   by (simp add: circlepath_def) (metis exp_two_pi_i mult.commute)
 
 lemma circlepath_minus: "circlepath z (-r) x = circlepath z r (x + 1/2)"
 proof -
   have "z + of_real r * exp (2 * pi * \<i> * (x + 1/2)) =
         z + of_real r * exp (2 * pi * \<i> * x + pi * \<i>)"
     by (simp add: divide_simps) (simp add: algebra_simps)
   also have "\<dots> = z - r * exp (2 * pi * \<i> * x)"
     by (simp add: exp_add)
   finally show ?thesis
     by (simp add: circlepath path_image_def sphere_def dist_norm)
 qed
 
 lemma circlepath_add1: "circlepath z r (x+1) = circlepath z r x"
   using circlepath_minus [of z r "x+1/2"] circlepath_minus [of z "-r" x]
   by (simp add: add.commute)
 
 lemma circlepath_add_half: "circlepath z r (x + 1/2) = circlepath z r (x - 1/2)"
   using circlepath_add1 [of z r "x-1/2"]
   by (simp add: add.commute)
 
 lemma path_image_circlepath_minus_subset:
      "path_image (circlepath z (-r)) \<subseteq> path_image (circlepath z r)"
   apply (simp add: path_image_def image_def circlepath_minus, clarify)
   apply (case_tac "xa \<le> 1/2", force)
   apply (force simp: circlepath_add_half)+
   done
 
 lemma path_image_circlepath_minus: "path_image (circlepath z (-r)) = path_image (circlepath z r)"
   using path_image_circlepath_minus_subset by fastforce
 
 lemma has_vector_derivative_circlepath [derivative_intros]:
  "((circlepath z r) has_vector_derivative (2 * pi * \<i> * r * exp (2 * of_real pi * \<i> * of_real x)))
    (at x within X)"
   apply (simp add: circlepath_def scaleR_conv_of_real)
   apply (rule derivative_eq_intros)
   apply (simp add: algebra_simps)
   done
 
 lemma vector_derivative_circlepath:
    "vector_derivative (circlepath z r) (at x) =
     2 * pi * \<i> * r * exp(2 * of_real pi * \<i> * x)"
 using has_vector_derivative_circlepath vector_derivative_at by blast
 
 lemma vector_derivative_circlepath01:
     "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk>
      \<Longrightarrow> vector_derivative (circlepath z r) (at x within {0..1}) =
           2 * pi * \<i> * r * exp(2 * of_real pi * \<i> * x)"
   using has_vector_derivative_circlepath
   by (auto simp: vector_derivative_at_within_ivl)
 
 lemma valid_path_circlepath [simp]: "valid_path (circlepath z r)"
   by (simp add: circlepath_def)
 
 lemma path_circlepath [simp]: "path (circlepath z r)"
   by (simp add: valid_path_imp_path)
 
 lemma path_image_circlepath_nonneg:
   assumes "0 \<le> r" shows "path_image (circlepath z r) = sphere z r"
 proof -
   have *: "x \<in> (\<lambda>u. z + (cmod (x - z)) * exp (\<i> * (of_real u * (of_real pi * 2)))) ` {0..1}" for x
   proof (cases "x = z")
     case True then show ?thesis by force
   next
     case False
     define w where "w = x - z"
     then have "w \<noteq> 0" by (simp add: False)
     have **: "\<And>t. \<lbrakk>Re w = cos t * cmod w; Im w = sin t * cmod w\<rbrakk> \<Longrightarrow> w = of_real (cmod w) * exp (\<i> * t)"
       using cis_conv_exp complex_eq_iff by auto
     show ?thesis
       apply (rule sincos_total_2pi [of "Re(w/of_real(norm w))" "Im(w/of_real(norm w))"])
       apply (simp add: divide_simps \<open>w \<noteq> 0\<close> cmod_power2 [symmetric])
       apply (rule_tac x="t / (2*pi)" in image_eqI)
       apply (simp add: field_simps \<open>w \<noteq> 0\<close>)
       using False **
       apply (auto simp: w_def)
       done
   qed
   show ?thesis
     unfolding circlepath path_image_def sphere_def dist_norm
     by (force simp: assms algebra_simps norm_mult norm_minus_commute intro: *)
 qed
 
 lemma path_image_circlepath [simp]:
     "path_image (circlepath z r) = sphere z \<bar>r\<bar>"
   using path_image_circlepath_minus
   by (force simp: path_image_circlepath_nonneg abs_if)
 
 lemma has_contour_integral_bound_circlepath_strong:
       "\<lbrakk>(f has_contour_integral i) (circlepath z r);
         finite k; 0 \<le> B; 0 < r;
         \<And>x. \<lbrakk>norm(x - z) = r; x \<notin> k\<rbrakk> \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
         \<Longrightarrow> norm i \<le> B*(2*pi*r)"
   unfolding circlepath_def
   by (auto simp: algebra_simps in_path_image_part_circlepath dest!: has_contour_integral_bound_part_circlepath_strong)
 
 lemma has_contour_integral_bound_circlepath:
       "\<lbrakk>(f has_contour_integral i) (circlepath z r);
         0 \<le> B; 0 < r; \<And>x. norm(x - z) = r \<Longrightarrow> norm(f x) \<le> B\<rbrakk>
         \<Longrightarrow> norm i \<le> B*(2*pi*r)"
   by (auto intro: has_contour_integral_bound_circlepath_strong)
 
 lemma contour_integrable_continuous_circlepath:
     "continuous_on (path_image (circlepath z r)) f
      \<Longrightarrow> f contour_integrable_on (circlepath z r)"
   by (simp add: circlepath_def contour_integrable_continuous_part_circlepath)
 
 lemma simple_path_circlepath: "simple_path(circlepath z r) \<longleftrightarrow> (r \<noteq> 0)"
   by (simp add: circlepath_def simple_path_part_circlepath)
 
 lemma notin_path_image_circlepath [simp]: "cmod (w - z) < r \<Longrightarrow> w \<notin> path_image (circlepath z r)"
   by (simp add: sphere_def dist_norm norm_minus_commute)
 
 lemma contour_integral_circlepath:
   assumes "r > 0"
   shows "contour_integral (circlepath z r) (\<lambda>w. 1 / (w - z)) = 2 * complex_of_real pi * \<i>"
 proof (rule contour_integral_unique)
   show "((\<lambda>w. 1 / (w - z)) has_contour_integral 2 * complex_of_real pi * \<i>) (circlepath z r)"
     unfolding has_contour_integral_def using assms
     apply (subst has_integral_cong)
      apply (simp add: vector_derivative_circlepath01)
     using has_integral_const_real [of _ 0 1] apply (force simp: circlepath)
     done
 qed
 
 lemma winding_number_circlepath_centre: "0 < r \<Longrightarrow> winding_number (circlepath z r) z = 1"
   apply (rule winding_number_unique_loop)
   apply (simp_all add: sphere_def valid_path_imp_path)
   apply (rule_tac x="circlepath z r" in exI)
   apply (simp add: sphere_def contour_integral_circlepath)
   done
 
 proposition winding_number_circlepath:
   assumes "norm(w - z) < r" shows "winding_number(circlepath z r) w = 1"
 proof (cases "w = z")
   case True then show ?thesis
     using assms winding_number_circlepath_centre by auto
 next
   case False
   have [simp]: "r > 0"
     using assms le_less_trans norm_ge_zero by blast
   define r' where "r' = norm(w - z)"
   have "r' < r"
     by (simp add: assms r'_def)
   have disjo: "cball z r' \<inter> sphere z r = {}"
     using \<open>r' < r\<close> by (force simp: cball_def sphere_def)
   have "winding_number(circlepath z r) w = winding_number(circlepath z r) z"
   proof (rule winding_number_around_inside [where s = "cball z r'"])
     show "winding_number (circlepath z r) z \<noteq> 0"
       by (simp add: winding_number_circlepath_centre)
     show "cball z r' \<inter> path_image (circlepath z r) = {}"
       by (simp add: disjo less_eq_real_def)
   qed (auto simp: r'_def dist_norm norm_minus_commute)
   also have "\<dots> = 1"
     by (simp add: winding_number_circlepath_centre)
   finally show ?thesis .
 qed
 
 
 text\<open> Hence the Cauchy formula for points inside a circle.\<close>
 
 theorem Cauchy_integral_circlepath:
   assumes contf: "continuous_on (cball z r) f" and holf: "f holomorphic_on (ball z r)" and wz: "norm(w - z) < r"
   shows "((\<lambda>u. f u/(u - w)) has_contour_integral (2 * of_real pi * \<i> * f w))
          (circlepath z r)"
 proof -
   have "r > 0"
     using assms le_less_trans norm_ge_zero by blast
   have "((\<lambda>u. f u / (u - w)) has_contour_integral (2 * pi) * \<i> * winding_number (circlepath z r) w * f w)
         (circlepath z r)"
   proof (rule Cauchy_integral_formula_weak [where s = "cball z r" and k = "{}"])
     show "\<And>x. x \<in> interior (cball z r) - {} \<Longrightarrow>
          f field_differentiable at x"
       using holf holomorphic_on_imp_differentiable_at by auto
     have "w \<notin> sphere z r"
       by simp (metis dist_commute dist_norm not_le order_refl wz)
     then show "path_image (circlepath z r) \<subseteq> cball z r - {w}"
       using \<open>r > 0\<close> by (auto simp add: cball_def sphere_def)
   qed (use wz in \<open>simp_all add: dist_norm norm_minus_commute contf\<close>)
   then show ?thesis
     by (simp add: winding_number_circlepath assms)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> Cauchy_integral_circlepath_simple:
   assumes "f holomorphic_on cball z r" "norm(w - z) < r"
   shows "((\<lambda>u. f u/(u - w)) has_contour_integral (2 * of_real pi * \<i> * f w))
          (circlepath z r)"
 using assms by (force simp: holomorphic_on_imp_continuous_on holomorphic_on_subset Cauchy_integral_circlepath)
 
 
 lemma no_bounded_connected_component_imp_winding_number_zero:
   assumes g: "path g" "path_image g \<subseteq> s" "pathfinish g = pathstart g" "z \<notin> s"
       and nb: "\<And>z. bounded (connected_component_set (- s) z) \<longrightarrow> z \<in> s"
   shows "winding_number g z = 0"
 apply (rule winding_number_zero_in_outside)
 apply (simp_all add: assms)
 by (metis nb [of z] \<open>path_image g \<subseteq> s\<close> \<open>z \<notin> s\<close> contra_subsetD mem_Collect_eq outside outside_mono)
 
 lemma no_bounded_path_component_imp_winding_number_zero:
   assumes g: "path g" "path_image g \<subseteq> s" "pathfinish g = pathstart g" "z \<notin> s"
       and nb: "\<And>z. bounded (path_component_set (- s) z) \<longrightarrow> z \<in> s"
   shows "winding_number g z = 0"
 apply (rule no_bounded_connected_component_imp_winding_number_zero [OF g])
 by (simp add: bounded_subset nb path_component_subset_connected_component)
 
 
 subsection\<open> Uniform convergence of path integral\<close>
 
 text\<open>Uniform convergence when the derivative of the path is bounded, and in particular for the special case of a circle.\<close>
 
 proposition contour_integral_uniform_limit:
   assumes ev_fint: "eventually (\<lambda>n::'a. (f n) contour_integrable_on \<gamma>) F"
       and ul_f: "uniform_limit (path_image \<gamma>) f l F"
       and noleB: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (vector_derivative \<gamma> (at t)) \<le> B"
       and \<gamma>: "valid_path \<gamma>"
       and [simp]: "\<not> trivial_limit F"
   shows "l contour_integrable_on \<gamma>" "((\<lambda>n. contour_integral \<gamma> (f n)) \<longlongrightarrow> contour_integral \<gamma> l) F"
 proof -
   have "0 \<le> B" by (meson noleB [of 0] atLeastAtMost_iff norm_ge_zero order_refl order_trans zero_le_one)
   { fix e::real
     assume "0 < e"
     then have "0 < e / (\<bar>B\<bar> + 1)" by simp
     then have "\<forall>\<^sub>F n in F. \<forall>x\<in>path_image \<gamma>. cmod (f n x - l x) < e / (\<bar>B\<bar> + 1)"
       using ul_f [unfolded uniform_limit_iff dist_norm] by auto
     with ev_fint
     obtain a where fga: "\<And>x. x \<in> {0..1} \<Longrightarrow> cmod (f a (\<gamma> x) - l (\<gamma> x)) < e / (\<bar>B\<bar> + 1)"
                and inta: "(\<lambda>t. f a (\<gamma> t) * vector_derivative \<gamma> (at t)) integrable_on {0..1}"
       using eventually_happens [OF eventually_conj]
       by (fastforce simp: contour_integrable_on path_image_def)
     have Ble: "B * e / (\<bar>B\<bar> + 1) \<le> e"
       using \<open>0 \<le> B\<close>  \<open>0 < e\<close> by (simp add: field_split_simps)
     have "\<exists>h. (\<forall>x\<in>{0..1}. cmod (l (\<gamma> x) * vector_derivative \<gamma> (at x) - h x) \<le> e) \<and> h integrable_on {0..1}"
     proof (intro exI conjI ballI)
       show "cmod (l (\<gamma> x) * vector_derivative \<gamma> (at x) - f a (\<gamma> x) * vector_derivative \<gamma> (at x)) \<le> e"
         if "x \<in> {0..1}" for x
         apply (rule order_trans [OF _ Ble])
         using noleB [OF that] fga [OF that] \<open>0 \<le> B\<close> \<open>0 < e\<close>
         apply (simp add: norm_mult left_diff_distrib [symmetric] norm_minus_commute divide_simps)
         apply (fastforce simp: mult_ac dest: mult_mono [OF less_imp_le])
         done
     qed (rule inta)
   }
   then show lintg: "l contour_integrable_on \<gamma>"
     unfolding contour_integrable_on by (metis (mono_tags, lifting)integrable_uniform_limit_real)
   { fix e::real
     define B' where "B' = B + 1"
     have B': "B' > 0" "B' > B" using  \<open>0 \<le> B\<close> by (auto simp: B'_def)
     assume "0 < e"
     then have ev_no': "\<forall>\<^sub>F n in F. \<forall>x\<in>path_image \<gamma>. 2 * cmod (f n x - l x) < e / B'"
       using ul_f [unfolded uniform_limit_iff dist_norm, rule_format, of "e / B' / 2"] B'
         by (simp add: field_simps)
     have ie: "integral {0..1::real} (\<lambda>x. e / 2) < e" using \<open>0 < e\<close> by simp
     have *: "cmod (f x (\<gamma> t) * vector_derivative \<gamma> (at t) - l (\<gamma> t) * vector_derivative \<gamma> (at t)) \<le> e / 2"
              if t: "t\<in>{0..1}" and leB': "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) < e / B'" for x t
     proof -
       have "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) * cmod (vector_derivative \<gamma> (at t)) \<le> e * (B/ B')"
         using mult_mono [OF less_imp_le [OF leB'] noleB] B' \<open>0 < e\<close> t by auto
       also have "\<dots> < e"
         by (simp add: B' \<open>0 < e\<close> mult_imp_div_pos_less)
       finally have "2 * cmod (f x (\<gamma> t) - l (\<gamma> t)) * cmod (vector_derivative \<gamma> (at t)) < e" .
       then show ?thesis
         by (simp add: left_diff_distrib [symmetric] norm_mult)
     qed
     have le_e: "\<And>x. \<lbrakk>\<forall>xa\<in>{0..1}. 2 * cmod (f x (\<gamma> xa) - l (\<gamma> xa)) < e / B'; f x contour_integrable_on \<gamma>\<rbrakk>
          \<Longrightarrow> cmod (integral {0..1}
                     (\<lambda>u. f x (\<gamma> u) * vector_derivative \<gamma> (at u) - l (\<gamma> u) * vector_derivative \<gamma> (at u))) < e"
       apply (rule le_less_trans [OF integral_norm_bound_integral ie])
         apply (simp add: lintg integrable_diff contour_integrable_on [symmetric])
        apply (blast intro: *)+
       done
     have "\<forall>\<^sub>F x in F. dist (contour_integral \<gamma> (f x)) (contour_integral \<gamma> l) < e"
       apply (rule eventually_mono [OF eventually_conj [OF ev_no' ev_fint]])
       apply (simp add: dist_norm contour_integrable_on path_image_def contour_integral_integral)
       apply (simp add: lintg integral_diff [symmetric] contour_integrable_on [symmetric] le_e)
       done
   }
   then show "((\<lambda>n. contour_integral \<gamma> (f n)) \<longlongrightarrow> contour_integral \<gamma> l) F"
     by (rule tendstoI)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> contour_integral_uniform_limit_circlepath:
   assumes "\<forall>\<^sub>F n::'a in F. (f n) contour_integrable_on (circlepath z r)"
       and "uniform_limit (sphere z r) f l F"
       and "\<not> trivial_limit F" "0 < r"
     shows "l contour_integrable_on (circlepath z r)"
           "((\<lambda>n. contour_integral (circlepath z r) (f n)) \<longlongrightarrow> contour_integral (circlepath z r) l) F"
   using assms by (auto simp: vector_derivative_circlepath norm_mult intro!: contour_integral_uniform_limit)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>General stepping result for derivative formulas\<close>
 
 lemma Cauchy_next_derivative:
   assumes "continuous_on (path_image \<gamma>) f'"
       and leB: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (vector_derivative \<gamma> (at t)) \<le> B"
       and int: "\<And>w. w \<in> s - path_image \<gamma> \<Longrightarrow> ((\<lambda>u. f' u / (u - w)^k) has_contour_integral f w) \<gamma>"
       and k: "k \<noteq> 0"
       and "open s"
       and \<gamma>: "valid_path \<gamma>"
       and w: "w \<in> s - path_image \<gamma>"
     shows "(\<lambda>u. f' u / (u - w)^(Suc k)) contour_integrable_on \<gamma>"
       and "(f has_field_derivative (k * contour_integral \<gamma> (\<lambda>u. f' u/(u - w)^(Suc k))))
            (at w)"  (is "?thes2")
 proof -
   have "open (s - path_image \<gamma>)" using \<open>open s\<close> closed_valid_path_image \<gamma> by blast
   then obtain d where "d>0" and d: "ball w d \<subseteq> s - path_image \<gamma>" using w
     using open_contains_ball by blast
   have [simp]: "\<And>n. cmod (1 + of_nat n) = 1 + of_nat n"
     by (metis norm_of_nat of_nat_Suc)
   have cint: "\<And>x. \<lbrakk>x \<noteq> w; cmod (x - w) < d\<rbrakk>
          \<Longrightarrow> (\<lambda>z. (f' z / (z - x) ^ k - f' z / (z - w) ^ k) / (x * k - w * k)) contour_integrable_on \<gamma>"
     apply (rule contour_integrable_div [OF contour_integrable_diff])
     using int w d
     by (force simp: dist_norm norm_minus_commute intro!: has_contour_integral_integrable)+
   have 1: "\<forall>\<^sub>F n in at w. (\<lambda>x. f' x * (inverse (x - n) ^ k - inverse (x - w) ^ k) / (n - w) / of_nat k)
                          contour_integrable_on \<gamma>"
     unfolding eventually_at
     apply (rule_tac x=d in exI)
     apply (simp add: \<open>d > 0\<close> dist_norm field_simps cint)
     done
   have bim_g: "bounded (image f' (path_image \<gamma>))"
     by (simp add: compact_imp_bounded compact_continuous_image compact_valid_path_image assms)
   then obtain C where "C > 0" and C: "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> cmod (f' (\<gamma> x)) \<le> C"
     by (force simp: bounded_pos path_image_def)
   have twom: "\<forall>\<^sub>F n in at w.
                \<forall>x\<in>path_image \<gamma>.
                 cmod ((inverse (x - n) ^ k - inverse (x - w) ^ k) / (n - w) / k - inverse (x - w) ^ Suc k) < e"
          if "0 < e" for e
   proof -
     have *: "cmod ((inverse (x - u) ^ k - inverse (x - w) ^ k) / ((u - w) * k) - inverse (x - w) ^ Suc k)   < e"
             if x: "x \<in> path_image \<gamma>" and "u \<noteq> w" and uwd: "cmod (u - w) < d/2"
                 and uw_less: "cmod (u - w) < e * (d/2) ^ (k+2) / (1 + real k)"
             for u x
     proof -
       define ff where [abs_def]:
         "ff n w =
           (if n = 0 then inverse(x - w)^k
            else if n = 1 then k / (x - w)^(Suc k)
            else (k * of_real(Suc k)) / (x - w)^(k + 2))" for n :: nat and w
       have km1: "\<And>z::complex. z \<noteq> 0 \<Longrightarrow> z ^ (k - Suc 0) = z ^ k / z"
         by (simp add: field_simps) (metis Suc_pred \<open>k \<noteq> 0\<close> neq0_conv power_Suc)
       have ff1: "(ff i has_field_derivative ff (Suc i) z) (at z within ball w (d/2))"
               if "z \<in> ball w (d/2)" "i \<le> 1" for i z
       proof -
         have "z \<notin> path_image \<gamma>"
           using \<open>x \<in> path_image \<gamma>\<close> d that ball_divide_subset_numeral by blast
         then have xz[simp]: "x \<noteq> z" using \<open>x \<in> path_image \<gamma>\<close> by blast
         then have neq: "x * x + z * z \<noteq> x * (z * 2)"
           by (blast intro: dest!: sum_sqs_eq)
         with xz have "\<And>v. v \<noteq> 0 \<Longrightarrow> (x * x + z * z) * v \<noteq> (x * (z * 2) * v)" by auto
         then have neqq: "\<And>v. v \<noteq> 0 \<Longrightarrow> x * (x * v) + z * (z * v) \<noteq> x * (z * (2 * v))"
           by (simp add: algebra_simps)
         show ?thesis using \<open>i \<le> 1\<close>
           apply (simp add: ff_def dist_norm Nat.le_Suc_eq km1, safe)
           apply (rule derivative_eq_intros | simp add: km1 | simp add: field_simps neq neqq)+
           done
       qed
       { fix a::real and b::real assume ab: "a > 0" "b > 0"
         then have "k * (1 + real k) * (1 / a) \<le> k * (1 + real k) * (4 / b) \<longleftrightarrow> b \<le> 4 * a"
           by (subst mult_le_cancel_left_pos)
             (use \<open>k \<noteq> 0\<close> in \<open>auto simp: divide_simps\<close>)
         with ab have "real k * (1 + real k) / a \<le> (real k * 4 + real k * real k * 4) / b \<longleftrightarrow> b \<le> 4 * a"
           by (simp add: field_simps)
       } note canc = this
       have ff2: "cmod (ff (Suc 1) v) \<le> real (k * (k + 1)) / (d/2) ^ (k + 2)"
                 if "v \<in> ball w (d/2)" for v
       proof -
         have lessd: "\<And>z. cmod (\<gamma> z - v) < d/2 \<Longrightarrow> cmod (w - \<gamma> z) < d"
           by (metis that norm_minus_commute norm_triangle_half_r dist_norm mem_ball)
         have "d/2 \<le> cmod (x - v)" using d x that
           using lessd d x
           by (auto simp add: dist_norm path_image_def ball_def not_less [symmetric] del: divide_const_simps)
         then have "d \<le> cmod (x - v) * 2"
           by (simp add: field_split_simps)
         then have dpow_le: "d ^ (k+2) \<le> (cmod (x - v) * 2) ^ (k+2)"
           using \<open>0 < d\<close> order_less_imp_le power_mono by blast
         have "x \<noteq> v" using that
           using \<open>x \<in> path_image \<gamma>\<close> ball_divide_subset_numeral d by fastforce
         then show ?thesis
         using \<open>d > 0\<close> apply (simp add: ff_def norm_mult norm_divide norm_power dist_norm canc)
-        using dpow_le apply (simp add: algebra_simps field_split_simps mult_less_0_iff)
+        using dpow_le apply (simp add: field_split_simps)
         done
       qed
       have ub: "u \<in> ball w (d/2)"
         using uwd by (simp add: dist_commute dist_norm)
       have "cmod (inverse (x - u) ^ k - (inverse (x - w) ^ k + of_nat k * (u - w) / ((x - w) * (x - w) ^ k)))
                   \<le> (real k * 4 + real k * real k * 4) * (cmod (u - w) * cmod (u - w)) / (d * (d * (d/2) ^ k))"
         using complex_Taylor [OF _ ff1 ff2 _ ub, of w, simplified]
         by (simp add: ff_def \<open>0 < d\<close>)
       then have "cmod (inverse (x - u) ^ k - (inverse (x - w) ^ k + of_nat k * (u - w) / ((x - w) * (x - w) ^ k)))
                   \<le> (cmod (u - w) * real k) * (1 + real k) * cmod (u - w) / (d/2) ^ (k+2)"
         by (simp add: field_simps)
       then have "cmod (inverse (x - u) ^ k - (inverse (x - w) ^ k + of_nat k * (u - w) / ((x - w) * (x - w) ^ k)))
                  / (cmod (u - w) * real k)
                   \<le> (1 + real k) * cmod (u - w) / (d/2) ^ (k+2)"
         using \<open>k \<noteq> 0\<close> \<open>u \<noteq> w\<close> by (simp add: mult_ac zero_less_mult_iff pos_divide_le_eq)
       also have "\<dots> < e"
         using uw_less \<open>0 < d\<close> by (simp add: mult_ac divide_simps)
       finally have e: "cmod (inverse (x-u)^k - (inverse (x-w)^k + of_nat k * (u-w) / ((x-w) * (x-w)^k)))
                         / cmod ((u - w) * real k)   <   e"
         by (simp add: norm_mult)
       have "x \<noteq> u"
         using uwd \<open>0 < d\<close> x d by (force simp: dist_norm ball_def norm_minus_commute)
       show ?thesis
         apply (rule le_less_trans [OF _ e])
         using \<open>k \<noteq> 0\<close> \<open>x \<noteq> u\<close> \<open>u \<noteq> w\<close>
         apply (simp add: field_simps norm_divide [symmetric])
         done
     qed
     show ?thesis
       unfolding eventually_at
       apply (rule_tac x = "min (d/2) ((e*(d/2)^(k + 2))/(Suc k))" in exI)
       apply (force simp: \<open>d > 0\<close> dist_norm that simp del: power_Suc intro: *)
       done
   qed
   have 2: "uniform_limit (path_image \<gamma>) (\<lambda>n x. f' x * (inverse (x - n) ^ k - inverse (x - w) ^ k) / (n - w) / of_nat k) (\<lambda>x. f' x / (x - w) ^ Suc k) (at w)"
     unfolding uniform_limit_iff dist_norm
   proof clarify
     fix e::real
     assume "0 < e"
     have *: "cmod (f' (\<gamma> x) * (inverse (\<gamma> x - u) ^ k - inverse (\<gamma> x - w) ^ k) / ((u - w) * k) -
                         f' (\<gamma> x) / ((\<gamma> x - w) * (\<gamma> x - w) ^ k)) < e"
               if ec: "cmod ((inverse (\<gamma> x - u) ^ k - inverse (\<gamma> x - w) ^ k) / ((u - w) * k) -
                       inverse (\<gamma> x - w) * inverse (\<gamma> x - w) ^ k) < e / C"
                  and x: "0 \<le> x" "x \<le> 1"
               for u x
     proof (cases "(f' (\<gamma> x)) = 0")
       case True then show ?thesis by (simp add: \<open>0 < e\<close>)
     next
       case False
       have "cmod (f' (\<gamma> x) * (inverse (\<gamma> x - u) ^ k - inverse (\<gamma> x - w) ^ k) / ((u - w) * k) -
                         f' (\<gamma> x) / ((\<gamma> x - w) * (\<gamma> x - w) ^ k)) =
             cmod (f' (\<gamma> x) * ((inverse (\<gamma> x - u) ^ k - inverse (\<gamma> x - w) ^ k) / ((u - w) * k) -
                              inverse (\<gamma> x - w) * inverse (\<gamma> x - w) ^ k))"
         by (simp add: field_simps)
       also have "\<dots> = cmod (f' (\<gamma> x)) *
                        cmod ((inverse (\<gamma> x - u) ^ k - inverse (\<gamma> x - w) ^ k) / ((u - w) * k) -
                              inverse (\<gamma> x - w) * inverse (\<gamma> x - w) ^ k)"
         by (simp add: norm_mult)
       also have "\<dots> < cmod (f' (\<gamma> x)) * (e/C)"
         using False mult_strict_left_mono [OF ec] by force
       also have "\<dots> \<le> e" using C
         by (metis False \<open>0 < e\<close> frac_le less_eq_real_def mult.commute pos_le_divide_eq x zero_less_norm_iff)
       finally show ?thesis .
     qed
     show "\<forall>\<^sub>F n in at w.
               \<forall>x\<in>path_image \<gamma>.
                cmod (f' x * (inverse (x - n) ^ k - inverse (x - w) ^ k) / (n - w) / of_nat k - f' x / (x - w) ^ Suc k) < e"
       using twom [OF divide_pos_pos [OF \<open>0 < e\<close> \<open>C > 0\<close>]]   unfolding path_image_def
       by (force intro: * elim: eventually_mono)
   qed
   show "(\<lambda>u. f' u / (u - w) ^ (Suc k)) contour_integrable_on \<gamma>"
     by (rule contour_integral_uniform_limit [OF 1 2 leB \<gamma>]) auto
   have *: "(\<lambda>n. contour_integral \<gamma> (\<lambda>x. f' x * (inverse (x - n) ^ k - inverse (x - w) ^ k) / (n - w) / k))
            \<midarrow>w\<rightarrow> contour_integral \<gamma> (\<lambda>u. f' u / (u - w) ^ (Suc k))"
     by (rule contour_integral_uniform_limit [OF 1 2 leB \<gamma>]) auto
   have **: "contour_integral \<gamma> (\<lambda>x. f' x * (inverse (x - u) ^ k - inverse (x - w) ^ k) / ((u - w) * k)) =
               (f u - f w) / (u - w) / k"
     if "dist u w < d" for u
   proof -
     have u: "u \<in> s - path_image \<gamma>"
       by (metis subsetD d dist_commute mem_ball that)
     show ?thesis
       apply (rule contour_integral_unique)
       apply (simp add: diff_divide_distrib algebra_simps)
       apply (intro has_contour_integral_diff has_contour_integral_div)
       using u w apply (simp_all add: field_simps int)
       done
   qed
   show ?thes2
     apply (simp add: has_field_derivative_iff del: power_Suc)
     apply (rule Lim_transform_within [OF tendsto_mult_left [OF *] \<open>0 < d\<close> ])
     apply (simp add: \<open>k \<noteq> 0\<close> **)
     done
 qed
 
 lemma Cauchy_next_derivative_circlepath:
   assumes contf: "continuous_on (path_image (circlepath z r)) f"
       and int: "\<And>w. w \<in> ball z r \<Longrightarrow> ((\<lambda>u. f u / (u - w)^k) has_contour_integral g w) (circlepath z r)"
       and k: "k \<noteq> 0"
       and w: "w \<in> ball z r"
     shows "(\<lambda>u. f u / (u - w)^(Suc k)) contour_integrable_on (circlepath z r)"
            (is "?thes1")
       and "(g has_field_derivative (k * contour_integral (circlepath z r) (\<lambda>u. f u/(u - w)^(Suc k)))) (at w)"
            (is "?thes2")
 proof -
   have "r > 0" using w
     using ball_eq_empty by fastforce
   have wim: "w \<in> ball z r - path_image (circlepath z r)"
     using w by (auto simp: dist_norm)
   show ?thes1 ?thes2
     by (rule Cauchy_next_derivative [OF contf _ int k open_ball valid_path_circlepath wim, where B = "2 * pi * \<bar>r\<bar>"];
         auto simp: vector_derivative_circlepath norm_mult)+
 qed
 
 
 text\<open> In particular, the first derivative formula.\<close>
 
 lemma Cauchy_derivative_integral_circlepath:
   assumes contf: "continuous_on (cball z r) f"
       and holf: "f holomorphic_on ball z r"
       and w: "w \<in> ball z r"
     shows "(\<lambda>u. f u/(u - w)^2) contour_integrable_on (circlepath z r)"
            (is "?thes1")
       and "(f has_field_derivative (1 / (2 * of_real pi * \<i>) * contour_integral(circlepath z r) (\<lambda>u. f u / (u - w)^2))) (at w)"
            (is "?thes2")
 proof -
   have [simp]: "r \<ge> 0" using w
     using ball_eq_empty by fastforce
   have f: "continuous_on (path_image (circlepath z r)) f"
     by (rule continuous_on_subset [OF contf]) (force simp: cball_def sphere_def)
   have int: "\<And>w. dist z w < r \<Longrightarrow>
                  ((\<lambda>u. f u / (u - w)) has_contour_integral (\<lambda>x. 2 * of_real pi * \<i> * f x) w) (circlepath z r)"
     by (rule Cauchy_integral_circlepath [OF contf holf]) (simp add: dist_norm norm_minus_commute)
   show ?thes1
     apply (simp add: power2_eq_square)
     apply (rule Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1, simplified])
     apply (blast intro: int)
     done
   have "((\<lambda>x. 2 * of_real pi * \<i> * f x) has_field_derivative contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)^2)) (at w)"
     apply (simp add: power2_eq_square)
     apply (rule Cauchy_next_derivative_circlepath [OF f _ _ w, where k=1 and g = "\<lambda>x. 2 * of_real pi * \<i> * f x", simplified])
     apply (blast intro: int)
     done
   then have fder: "(f has_field_derivative contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)^2) / (2 * of_real pi * \<i>)) (at w)"
     by (rule DERIV_cdivide [where f = "\<lambda>x. 2 * of_real pi * \<i> * f x" and c = "2 * of_real pi * \<i>", simplified])
   show ?thes2
     by simp (rule fder)
 qed
 
 subsection\<open>Existence of all higher derivatives\<close>
 
 proposition derivative_is_holomorphic:
   assumes "open S"
       and fder: "\<And>z. z \<in> S \<Longrightarrow> (f has_field_derivative f' z) (at z)"
     shows "f' holomorphic_on S"
 proof -
   have *: "\<exists>h. (f' has_field_derivative h) (at z)" if "z \<in> S" for z
   proof -
     obtain r where "r > 0" and r: "cball z r \<subseteq> S"
       using open_contains_cball \<open>z \<in> S\<close> \<open>open S\<close> by blast
     then have holf_cball: "f holomorphic_on cball z r"
       apply (simp add: holomorphic_on_def)
       using field_differentiable_at_within field_differentiable_def fder by blast
     then have "continuous_on (path_image (circlepath z r)) f"
       using \<open>r > 0\<close> by (force elim: holomorphic_on_subset [THEN holomorphic_on_imp_continuous_on])
     then have contfpi: "continuous_on (path_image (circlepath z r)) (\<lambda>x. 1/(2 * of_real pi*\<i>) * f x)"
       by (auto intro: continuous_intros)+
     have contf_cball: "continuous_on (cball z r) f" using holf_cball
       by (simp add: holomorphic_on_imp_continuous_on holomorphic_on_subset)
     have holf_ball: "f holomorphic_on ball z r" using holf_cball
       using ball_subset_cball holomorphic_on_subset by blast
     { fix w  assume w: "w \<in> ball z r"
       have intf: "(\<lambda>u. f u / (u - w)\<^sup>2) contour_integrable_on circlepath z r"
         by (blast intro: w Cauchy_derivative_integral_circlepath [OF contf_cball holf_ball])
       have fder': "(f has_field_derivative 1 / (2 * of_real pi * \<i>) * contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)\<^sup>2))
                   (at w)"
         by (blast intro: w Cauchy_derivative_integral_circlepath [OF contf_cball holf_ball])
       have f'_eq: "f' w = contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)\<^sup>2) / (2 * of_real pi * \<i>)"
         using fder' ball_subset_cball r w by (force intro: DERIV_unique [OF fder])
       have "((\<lambda>u. f u / (u - w)\<^sup>2 / (2 * of_real pi * \<i>)) has_contour_integral
                 contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)\<^sup>2) / (2 * of_real pi * \<i>))
                 (circlepath z r)"
         by (rule has_contour_integral_div [OF has_contour_integral_integral [OF intf]])
       then have "((\<lambda>u. f u / (2 * of_real pi * \<i> * (u - w)\<^sup>2)) has_contour_integral
                 contour_integral (circlepath z r) (\<lambda>u. f u / (u - w)\<^sup>2) / (2 * of_real pi * \<i>))
                 (circlepath z r)"
         by (simp add: algebra_simps)
       then have "((\<lambda>u. f u / (2 * of_real pi * \<i> * (u - w)\<^sup>2)) has_contour_integral f' w) (circlepath z r)"
         by (simp add: f'_eq)
     } note * = this
     show ?thesis
       apply (rule exI)
       apply (rule Cauchy_next_derivative_circlepath [OF contfpi, of 2 f', simplified])
       apply (simp_all add: \<open>0 < r\<close> * dist_norm)
       done
   qed
   show ?thesis
     by (simp add: holomorphic_on_open [OF \<open>open S\<close>] *)
 qed
 
 lemma holomorphic_deriv [holomorphic_intros]:
     "\<lbrakk>f holomorphic_on S; open S\<rbrakk> \<Longrightarrow> (deriv f) holomorphic_on S"
 by (metis DERIV_deriv_iff_field_differentiable at_within_open derivative_is_holomorphic holomorphic_on_def)
 
 lemma analytic_deriv [analytic_intros]: "f analytic_on S \<Longrightarrow> (deriv f) analytic_on S"
   using analytic_on_holomorphic holomorphic_deriv by auto
 
 lemma holomorphic_higher_deriv [holomorphic_intros]: "\<lbrakk>f holomorphic_on S; open S\<rbrakk> \<Longrightarrow> (deriv ^^ n) f holomorphic_on S"
   by (induction n) (auto simp: holomorphic_deriv)
 
 lemma analytic_higher_deriv [analytic_intros]: "f analytic_on S \<Longrightarrow> (deriv ^^ n) f analytic_on S"
   unfolding analytic_on_def using holomorphic_higher_deriv by blast
 
 lemma has_field_derivative_higher_deriv:
      "\<lbrakk>f holomorphic_on S; open S; x \<in> S\<rbrakk>
       \<Longrightarrow> ((deriv ^^ n) f has_field_derivative (deriv ^^ (Suc n)) f x) (at x)"
 by (metis (no_types, hide_lams) DERIV_deriv_iff_field_differentiable at_within_open comp_apply
          funpow.simps(2) holomorphic_higher_deriv holomorphic_on_def)
 
 lemma valid_path_compose_holomorphic:
   assumes "valid_path g" and holo:"f holomorphic_on S" and "open S" "path_image g \<subseteq> S"
   shows "valid_path (f \<circ> g)"
 proof (rule valid_path_compose[OF \<open>valid_path g\<close>])
   fix x assume "x \<in> path_image g"
   then show "f field_differentiable at x"
     using analytic_on_imp_differentiable_at analytic_on_open assms holo by blast
 next
   have "deriv f holomorphic_on S"
     using holomorphic_deriv holo \<open>open S\<close> by auto
   then show "continuous_on (path_image g) (deriv f)"
     using assms(4) holomorphic_on_imp_continuous_on holomorphic_on_subset by auto
 qed
 
 
 subsection\<open>Morera's theorem\<close>
 
 lemma Morera_local_triangle_ball:
   assumes "\<And>z. z \<in> S
           \<Longrightarrow> \<exists>e a. 0 < e \<and> z \<in> ball a e \<and> continuous_on (ball a e) f \<and>
                     (\<forall>b c. closed_segment b c \<subseteq> ball a e
                            \<longrightarrow> contour_integral (linepath a b) f +
                                contour_integral (linepath b c) f +
                                contour_integral (linepath c a) f = 0)"
   shows "f analytic_on S"
 proof -
   { fix z  assume "z \<in> S"
     with assms obtain e a where
             "0 < e" and z: "z \<in> ball a e" and contf: "continuous_on (ball a e) f"
         and 0: "\<And>b c. closed_segment b c \<subseteq> ball a e
                       \<Longrightarrow> contour_integral (linepath a b) f +
                           contour_integral (linepath b c) f +
                           contour_integral (linepath c a) f = 0"
       by fastforce
     have az: "dist a z < e" using mem_ball z by blast
     have sb_ball: "ball z (e - dist a z) \<subseteq> ball a e"
       by (simp add: dist_commute ball_subset_ball_iff)
     have "\<exists>e>0. f holomorphic_on ball z e"
     proof (intro exI conjI)
       have sub_ball: "\<And>y. dist a y < e \<Longrightarrow> closed_segment a y \<subseteq> ball a e"
         by (meson \<open>0 < e\<close> centre_in_ball convex_ball convex_contains_segment mem_ball)
       show "f holomorphic_on ball z (e - dist a z)"
         apply (rule holomorphic_on_subset [OF _ sb_ball])
         apply (rule derivative_is_holomorphic[OF open_ball])
         apply (rule triangle_contour_integrals_starlike_primitive [OF contf _ open_ball, of a])
            apply (simp_all add: 0 \<open>0 < e\<close> sub_ball)
         done
     qed (simp add: az)
   }
   then show ?thesis
     by (simp add: analytic_on_def)
 qed
 
 lemma Morera_local_triangle:
   assumes "\<And>z. z \<in> S
           \<Longrightarrow> \<exists>t. open t \<and> z \<in> t \<and> continuous_on t f \<and>
                   (\<forall>a b c. convex hull {a,b,c} \<subseteq> t
                               \<longrightarrow> contour_integral (linepath a b) f +
                                   contour_integral (linepath b c) f +
                                   contour_integral (linepath c a) f = 0)"
   shows "f analytic_on S"
 proof -
   { fix z  assume "z \<in> S"
     with assms obtain t where
             "open t" and z: "z \<in> t" and contf: "continuous_on t f"
         and 0: "\<And>a b c. convex hull {a,b,c} \<subseteq> t
                       \<Longrightarrow> contour_integral (linepath a b) f +
                           contour_integral (linepath b c) f +
                           contour_integral (linepath c a) f = 0"
       by force
     then obtain e where "e>0" and e: "ball z e \<subseteq> t"
       using open_contains_ball by blast
     have [simp]: "continuous_on (ball z e) f" using contf
       using continuous_on_subset e by blast
     have eq0: "\<And>b c. closed_segment b c \<subseteq> ball z e \<Longrightarrow>
                          contour_integral (linepath z b) f +
                          contour_integral (linepath b c) f +
                          contour_integral (linepath c z) f = 0"
       by (meson 0 z \<open>0 < e\<close> centre_in_ball closed_segment_subset convex_ball dual_order.trans e starlike_convex_subset)
     have "\<exists>e a. 0 < e \<and> z \<in> ball a e \<and> continuous_on (ball a e) f \<and>
                 (\<forall>b c. closed_segment b c \<subseteq> ball a e \<longrightarrow>
                        contour_integral (linepath a b) f + contour_integral (linepath b c) f + contour_integral (linepath c a) f = 0)"
       using \<open>e > 0\<close> eq0 by force
   }
   then show ?thesis
     by (simp add: Morera_local_triangle_ball)
 qed
 
 proposition Morera_triangle:
     "\<lbrakk>continuous_on S f; open S;
       \<And>a b c. convex hull {a,b,c} \<subseteq> S
               \<longrightarrow> contour_integral (linepath a b) f +
                   contour_integral (linepath b c) f +
                   contour_integral (linepath c a) f = 0\<rbrakk>
      \<Longrightarrow> f analytic_on S"
   using Morera_local_triangle by blast
 
 subsection\<open>Combining theorems for higher derivatives including Leibniz rule\<close>
 
 lemma higher_deriv_linear [simp]:
     "(deriv ^^ n) (\<lambda>w. c*w) = (\<lambda>z. if n = 0 then c*z else if n = 1 then c else 0)"
   by (induction n) auto
 
 lemma higher_deriv_const [simp]: "(deriv ^^ n) (\<lambda>w. c) = (\<lambda>w. if n=0 then c else 0)"
   by (induction n) auto
 
 lemma higher_deriv_ident [simp]:
      "(deriv ^^ n) (\<lambda>w. w) z = (if n = 0 then z else if n = 1 then 1 else 0)"
   apply (induction n, simp)
   apply (metis higher_deriv_linear lambda_one)
   done
 
 lemma higher_deriv_id [simp]:
      "(deriv ^^ n) id z = (if n = 0 then z else if n = 1 then 1 else 0)"
   by (simp add: id_def)
 
 lemma has_complex_derivative_funpow_1:
      "\<lbrakk>(f has_field_derivative 1) (at z); f z = z\<rbrakk> \<Longrightarrow> (f^^n has_field_derivative 1) (at z)"
   apply (induction n, auto)
   apply (simp add: id_def)
   by (metis DERIV_chain comp_funpow comp_id funpow_swap1 mult.right_neutral)
 
 lemma higher_deriv_uminus:
   assumes "f holomorphic_on S" "open S" and z: "z \<in> S"
     shows "(deriv ^^ n) (\<lambda>w. -(f w)) z = - ((deriv ^^ n) f z)"
 using z
 proof (induction n arbitrary: z)
   case 0 then show ?case by simp
 next
   case (Suc n z)
   have *: "((deriv ^^ n) f has_field_derivative deriv ((deriv ^^ n) f) z) (at z)"
     using Suc.prems assms has_field_derivative_higher_deriv by auto
   have "((deriv ^^ n) (\<lambda>w. - f w) has_field_derivative - deriv ((deriv ^^ n) f) z) (at z)"
     apply (rule has_field_derivative_transform_within_open [of "\<lambda>w. -((deriv ^^ n) f w)"])
        apply (rule derivative_eq_intros | rule * refl assms)+
      apply (auto simp add: Suc)
     done
   then show ?case
     by (simp add: DERIV_imp_deriv)
 qed
 
 lemma higher_deriv_add:
   fixes z::complex
   assumes "f holomorphic_on S" "g holomorphic_on S" "open S" and z: "z \<in> S"
     shows "(deriv ^^ n) (\<lambda>w. f w + g w) z = (deriv ^^ n) f z + (deriv ^^ n) g z"
 using z
 proof (induction n arbitrary: z)
   case 0 then show ?case by simp
 next
   case (Suc n z)
   have *: "((deriv ^^ n) f has_field_derivative deriv ((deriv ^^ n) f) z) (at z)"
           "((deriv ^^ n) g has_field_derivative deriv ((deriv ^^ n) g) z) (at z)"
     using Suc.prems assms has_field_derivative_higher_deriv by auto
   have "((deriv ^^ n) (\<lambda>w. f w + g w) has_field_derivative
         deriv ((deriv ^^ n) f) z + deriv ((deriv ^^ n) g) z) (at z)"
     apply (rule has_field_derivative_transform_within_open [of "\<lambda>w. (deriv ^^ n) f w + (deriv ^^ n) g w"])
        apply (rule derivative_eq_intros | rule * refl assms)+
      apply (auto simp add: Suc)
     done
   then show ?case
     by (simp add: DERIV_imp_deriv)
 qed
 
 lemma higher_deriv_diff:
   fixes z::complex
   assumes "f holomorphic_on S" "g holomorphic_on S" "open S" and z: "z \<in> S"
     shows "(deriv ^^ n) (\<lambda>w. f w - g w) z = (deriv ^^ n) f z - (deriv ^^ n) g z"
   apply (simp only: Groups.group_add_class.diff_conv_add_uminus higher_deriv_add)
   apply (subst higher_deriv_add)
   using assms holomorphic_on_minus apply (auto simp: higher_deriv_uminus)
   done
 
 lemma bb: "Suc n choose k = (n choose k) + (if k = 0 then 0 else (n choose (k - 1)))"
   by (cases k) simp_all
 
 lemma higher_deriv_mult:
   fixes z::complex
   assumes "f holomorphic_on S" "g holomorphic_on S" "open S" and z: "z \<in> S"
     shows "(deriv ^^ n) (\<lambda>w. f w * g w) z =
            (\<Sum>i = 0..n. of_nat (n choose i) * (deriv ^^ i) f z * (deriv ^^ (n - i)) g z)"
 using z
 proof (induction n arbitrary: z)
   case 0 then show ?case by simp
 next
   case (Suc n z)
   have *: "\<And>n. ((deriv ^^ n) f has_field_derivative deriv ((deriv ^^ n) f) z) (at z)"
           "\<And>n. ((deriv ^^ n) g has_field_derivative deriv ((deriv ^^ n) g) z) (at z)"
     using Suc.prems assms has_field_derivative_higher_deriv by auto
   have sumeq: "(\<Sum>i = 0..n.
                of_nat (n choose i) * (deriv ((deriv ^^ i) f) z * (deriv ^^ (n - i)) g z + deriv ((deriv ^^ (n - i)) g) z * (deriv ^^ i) f z)) =
             g z * deriv ((deriv ^^ n) f) z + (\<Sum>i = 0..n. (deriv ^^ i) f z * (of_nat (Suc n choose i) * (deriv ^^ (Suc n - i)) g z))"
     apply (simp add: bb algebra_simps sum.distrib)
     apply (subst (4) sum_Suc_reindex)
     apply (auto simp: algebra_simps Suc_diff_le intro: sum.cong)
     done
   have "((deriv ^^ n) (\<lambda>w. f w * g w) has_field_derivative
          (\<Sum>i = 0..Suc n. (Suc n choose i) * (deriv ^^ i) f z * (deriv ^^ (Suc n - i)) g z))
         (at z)"
     apply (rule has_field_derivative_transform_within_open
         [of "\<lambda>w. (\<Sum>i = 0..n. of_nat (n choose i) * (deriv ^^ i) f w * (deriv ^^ (n - i)) g w)"])
        apply (simp add: algebra_simps)
        apply (rule DERIV_cong [OF DERIV_sum])
         apply (rule DERIV_cmult)
         apply (auto intro: DERIV_mult * sumeq \<open>open S\<close> Suc.prems Suc.IH [symmetric])
     done
   then show ?case
     unfolding funpow.simps o_apply
     by (simp add: DERIV_imp_deriv)
 qed
 
 lemma higher_deriv_transform_within_open:
   fixes z::complex
   assumes "f holomorphic_on S" "g holomorphic_on S" "open S" and z: "z \<in> S"
       and fg: "\<And>w. w \<in> S \<Longrightarrow> f w = g w"
     shows "(deriv ^^ i) f z = (deriv ^^ i) g z"
 using z
 by (induction i arbitrary: z)
    (auto simp: fg intro: complex_derivative_transform_within_open holomorphic_higher_deriv assms)
 
 lemma higher_deriv_compose_linear:
   fixes z::complex
   assumes f: "f holomorphic_on T" and S: "open S" and T: "open T" and z: "z \<in> S"
       and fg: "\<And>w. w \<in> S \<Longrightarrow> u * w \<in> T"
     shows "(deriv ^^ n) (\<lambda>w. f (u * w)) z = u^n * (deriv ^^ n) f (u * z)"
 using z
 proof (induction n arbitrary: z)
   case 0 then show ?case by simp
 next
   case (Suc n z)
   have holo0: "f holomorphic_on (*) u ` S"
     by (meson fg f holomorphic_on_subset image_subset_iff)
   have holo2: "(deriv ^^ n) f holomorphic_on (*) u ` S"
     by (meson f fg holomorphic_higher_deriv holomorphic_on_subset image_subset_iff T)
   have holo3: "(\<lambda>z. u ^ n * (deriv ^^ n) f (u * z)) holomorphic_on S"
     by (intro holo2 holomorphic_on_compose [where g="(deriv ^^ n) f", unfolded o_def] holomorphic_intros)
   have holo1: "(\<lambda>w. f (u * w)) holomorphic_on S"
     apply (rule holomorphic_on_compose [where g=f, unfolded o_def])
     apply (rule holo0 holomorphic_intros)+
     done
   have "deriv ((deriv ^^ n) (\<lambda>w. f (u * w))) z = deriv (\<lambda>z. u^n * (deriv ^^ n) f (u*z)) z"
     apply (rule complex_derivative_transform_within_open [OF _ holo3 S Suc.prems])
     apply (rule holomorphic_higher_deriv [OF holo1 S])
     apply (simp add: Suc.IH)
     done
   also have "\<dots> = u^n * deriv (\<lambda>z. (deriv ^^ n) f (u * z)) z"
     apply (rule deriv_cmult)
     apply (rule analytic_on_imp_differentiable_at [OF _ Suc.prems])
     apply (rule analytic_on_compose_gen [where g="(deriv ^^ n) f" and T=T, unfolded o_def])
-      apply (simp add: analytic_on_linear)
+      apply (simp)
      apply (simp add: analytic_on_open f holomorphic_higher_deriv T)
     apply (blast intro: fg)
     done
   also have "\<dots> = u * u ^ n * deriv ((deriv ^^ n) f) (u * z)"
       apply (subst complex_derivative_chain [where g = "(deriv ^^ n) f" and f = "(*) u", unfolded o_def])
       apply (rule derivative_intros)
       using Suc.prems field_differentiable_def f fg has_field_derivative_higher_deriv T apply blast
-      apply (simp add: deriv_linear)
+      apply (simp)
       done
   finally show ?case
     by simp
 qed
 
 lemma higher_deriv_add_at:
   assumes "f analytic_on {z}" "g analytic_on {z}"
     shows "(deriv ^^ n) (\<lambda>w. f w + g w) z = (deriv ^^ n) f z + (deriv ^^ n) g z"
 proof -
   have "f analytic_on {z} \<and> g analytic_on {z}"
     using assms by blast
   with higher_deriv_add show ?thesis
     by (auto simp: analytic_at_two)
 qed
 
 lemma higher_deriv_diff_at:
   assumes "f analytic_on {z}" "g analytic_on {z}"
     shows "(deriv ^^ n) (\<lambda>w. f w - g w) z = (deriv ^^ n) f z - (deriv ^^ n) g z"
 proof -
   have "f analytic_on {z} \<and> g analytic_on {z}"
     using assms by blast
   with higher_deriv_diff show ?thesis
     by (auto simp: analytic_at_two)
 qed
 
 lemma higher_deriv_uminus_at:
    "f analytic_on {z}  \<Longrightarrow> (deriv ^^ n) (\<lambda>w. -(f w)) z = - ((deriv ^^ n) f z)"
   using higher_deriv_uminus
     by (auto simp: analytic_at)
 
 lemma higher_deriv_mult_at:
   assumes "f analytic_on {z}" "g analytic_on {z}"
     shows "(deriv ^^ n) (\<lambda>w. f w * g w) z =
            (\<Sum>i = 0..n. of_nat (n choose i) * (deriv ^^ i) f z * (deriv ^^ (n - i)) g z)"
 proof -
   have "f analytic_on {z} \<and> g analytic_on {z}"
     using assms by blast
   with higher_deriv_mult show ?thesis
     by (auto simp: analytic_at_two)
 qed
 
 
 text\<open> Nonexistence of isolated singularities and a stronger integral formula.\<close>
 
 proposition no_isolated_singularity:
   fixes z::complex
   assumes f: "continuous_on S f" and holf: "f holomorphic_on (S - K)" and S: "open S" and K: "finite K"
     shows "f holomorphic_on S"
 proof -
   { fix z
     assume "z \<in> S" and cdf: "\<And>x. x \<in> S - K \<Longrightarrow> f field_differentiable at x"
     have "f field_differentiable at z"
     proof (cases "z \<in> K")
       case False then show ?thesis by (blast intro: cdf \<open>z \<in> S\<close>)
     next
       case True
       with finite_set_avoid [OF K, of z]
       obtain d where "d>0" and d: "\<And>x. \<lbrakk>x\<in>K; x \<noteq> z\<rbrakk> \<Longrightarrow> d \<le> dist z x"
         by blast
       obtain e where "e>0" and e: "ball z e \<subseteq> S"
         using  S \<open>z \<in> S\<close> by (force simp: open_contains_ball)
       have fde: "continuous_on (ball z (min d e)) f"
         by (metis Int_iff ball_min_Int continuous_on_subset e f subsetI)
       have cont: "{a,b,c} \<subseteq> ball z (min d e) \<Longrightarrow> continuous_on (convex hull {a, b, c}) f" for a b c
         by (simp add: hull_minimal continuous_on_subset [OF fde])
       have fd: "\<lbrakk>{a,b,c} \<subseteq> ball z (min d e); x \<in> interior (convex hull {a, b, c}) - K\<rbrakk>
             \<Longrightarrow> f field_differentiable at x" for a b c x
         by (metis cdf Diff_iff Int_iff ball_min_Int subsetD convex_ball e interior_mono interior_subset subset_hull)
       obtain g where "\<And>w. w \<in> ball z (min d e) \<Longrightarrow> (g has_field_derivative f w) (at w within ball z (min d e))"
         apply (rule contour_integral_convex_primitive
                      [OF convex_ball fde Cauchy_theorem_triangle_cofinite [OF _ K]])
         using cont fd by auto
       then have "f holomorphic_on ball z (min d e)"
         by (metis open_ball at_within_open derivative_is_holomorphic)
       then show ?thesis
         unfolding holomorphic_on_def
         by (metis open_ball \<open>0 < d\<close> \<open>0 < e\<close> at_within_open centre_in_ball min_less_iff_conj)
     qed
   }
   with holf S K show ?thesis
     by (simp add: holomorphic_on_open open_Diff finite_imp_closed field_differentiable_def [symmetric])
 qed
 
 lemma no_isolated_singularity':
   fixes z::complex
   assumes f: "\<And>z. z \<in> K \<Longrightarrow> (f \<longlongrightarrow> f z) (at z within S)"
       and holf: "f holomorphic_on (S - K)" and S: "open S" and K: "finite K"
     shows "f holomorphic_on S"
 proof (rule no_isolated_singularity[OF _ assms(2-)])
   show "continuous_on S f" unfolding continuous_on_def
   proof
     fix z assume z: "z \<in> S"
     show "(f \<longlongrightarrow> f z) (at z within S)"
     proof (cases "z \<in> K")
       case False
       from holf have "continuous_on (S - K) f"
         by (rule holomorphic_on_imp_continuous_on)
       with z False have "(f \<longlongrightarrow> f z) (at z within (S - K))"
         by (simp add: continuous_on_def)
       also from z K S False have "at z within (S - K) = at z within S"
         by (subst (1 2) at_within_open) (auto intro: finite_imp_closed)
       finally show "(f \<longlongrightarrow> f z) (at z within S)" .
     qed (insert assms z, simp_all)
   qed
 qed
 
 proposition Cauchy_integral_formula_convex:
   assumes S: "convex S" and K: "finite K" and contf: "continuous_on S f"
     and fcd: "(\<And>x. x \<in> interior S - K \<Longrightarrow> f field_differentiable at x)"
     and z: "z \<in> interior S" and vpg: "valid_path \<gamma>"
     and pasz: "path_image \<gamma> \<subseteq> S - {z}" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
   shows "((\<lambda>w. f w / (w - z)) has_contour_integral (2*pi * \<i> * winding_number \<gamma> z * f z)) \<gamma>"
 proof -
   have *: "\<And>x. x \<in> interior S \<Longrightarrow> f field_differentiable at x"
     unfolding holomorphic_on_open [symmetric] field_differentiable_def
     using no_isolated_singularity [where S = "interior S"]
     by (meson K contf continuous_at_imp_continuous_on continuous_on_interior fcd
           field_differentiable_at_within field_differentiable_def holomorphic_onI
           holomorphic_on_imp_differentiable_at open_interior)
   show ?thesis
     by (rule Cauchy_integral_formula_weak [OF S finite.emptyI contf]) (use * assms in auto)
 qed
 
 text\<open> Formula for higher derivatives.\<close>
 
 lemma Cauchy_has_contour_integral_higher_derivative_circlepath:
   assumes contf: "continuous_on (cball z r) f"
       and holf: "f holomorphic_on ball z r"
       and w: "w \<in> ball z r"
     shows "((\<lambda>u. f u / (u - w) ^ (Suc k)) has_contour_integral ((2 * pi * \<i>) / (fact k) * (deriv ^^ k) f w))
            (circlepath z r)"
 using w
 proof (induction k arbitrary: w)
   case 0 then show ?case
     using assms by (auto simp: Cauchy_integral_circlepath dist_commute dist_norm)
 next
   case (Suc k)
   have [simp]: "r > 0" using w
     using ball_eq_empty by fastforce
   have f: "continuous_on (path_image (circlepath z r)) f"
     by (rule continuous_on_subset [OF contf]) (force simp: cball_def sphere_def less_imp_le)
   obtain X where X: "((\<lambda>u. f u / (u - w) ^ Suc (Suc k)) has_contour_integral X) (circlepath z r)"
     using Cauchy_next_derivative_circlepath(1) [OF f Suc.IH _ Suc.prems]
     by (auto simp: contour_integrable_on_def)
   then have con: "contour_integral (circlepath z r) ((\<lambda>u. f u / (u - w) ^ Suc (Suc k))) = X"
     by (rule contour_integral_unique)
   have "\<And>n. ((deriv ^^ n) f has_field_derivative deriv ((deriv ^^ n) f) w) (at w)"
     using Suc.prems assms has_field_derivative_higher_deriv by auto
   then have dnf_diff: "\<And>n. (deriv ^^ n) f field_differentiable (at w)"
     by (force simp: field_differentiable_def)
   have "deriv (\<lambda>w. complex_of_real (2 * pi) * \<i> / (fact k) * (deriv ^^ k) f w) w =
           of_nat (Suc k) * contour_integral (circlepath z r) (\<lambda>u. f u / (u - w) ^ Suc (Suc k))"
     by (force intro!: DERIV_imp_deriv Cauchy_next_derivative_circlepath [OF f Suc.IH _ Suc.prems])
   also have "\<dots> = of_nat (Suc k) * X"
     by (simp only: con)
   finally have "deriv (\<lambda>w. ((2 * pi) * \<i> / (fact k)) * (deriv ^^ k) f w) w = of_nat (Suc k) * X" .
   then have "((2 * pi) * \<i> / (fact k)) * deriv (\<lambda>w. (deriv ^^ k) f w) w = of_nat (Suc k) * X"
     by (metis deriv_cmult dnf_diff)
   then have "deriv (\<lambda>w. (deriv ^^ k) f w) w = of_nat (Suc k) * X / ((2 * pi) * \<i> / (fact k))"
     by (simp add: field_simps)
   then show ?case
   using of_nat_eq_0_iff X by fastforce
 qed
 
 lemma Cauchy_higher_derivative_integral_circlepath:
   assumes contf: "continuous_on (cball z r) f"
       and holf: "f holomorphic_on ball z r"
       and w: "w \<in> ball z r"
     shows "(\<lambda>u. f u / (u - w)^(Suc k)) contour_integrable_on (circlepath z r)"
            (is "?thes1")
       and "(deriv ^^ k) f w = (fact k) / (2 * pi * \<i>) * contour_integral(circlepath z r) (\<lambda>u. f u/(u - w)^(Suc k))"
            (is "?thes2")
 proof -
   have *: "((\<lambda>u. f u / (u - w) ^ Suc k) has_contour_integral (2 * pi) * \<i> / (fact k) * (deriv ^^ k) f w)
            (circlepath z r)"
     using Cauchy_has_contour_integral_higher_derivative_circlepath [OF assms]
     by simp
   show ?thes1 using *
     using contour_integrable_on_def by blast
   show ?thes2
     unfolding contour_integral_unique [OF *] by (simp add: field_split_simps)
 qed
 
 corollary Cauchy_contour_integral_circlepath:
   assumes "continuous_on (cball z r) f" "f holomorphic_on ball z r" "w \<in> ball z r"
     shows "contour_integral(circlepath z r) (\<lambda>u. f u/(u - w)^(Suc k)) = (2 * pi * \<i>) * (deriv ^^ k) f w / (fact k)"
 by (simp add: Cauchy_higher_derivative_integral_circlepath [OF assms])
 
 lemma Cauchy_contour_integral_circlepath_2:
   assumes "continuous_on (cball z r) f" "f holomorphic_on ball z r" "w \<in> ball z r"
     shows "contour_integral(circlepath z r) (\<lambda>u. f u/(u - w)^2) = (2 * pi * \<i>) * deriv f w"
   using Cauchy_contour_integral_circlepath [OF assms, of 1]
   by (simp add: power2_eq_square)
 
 
 subsection\<open>A holomorphic function is analytic, i.e. has local power series\<close>
 
 theorem holomorphic_power_series:
   assumes holf: "f holomorphic_on ball z r"
       and w: "w \<in> ball z r"
     shows "((\<lambda>n. (deriv ^^ n) f z / (fact n) * (w - z)^n) sums f w)"
 proof -
   \<comment> \<open>Replacing \<^term>\<open>r\<close> and the original (weak) premises with stronger ones\<close>
   obtain r where "r > 0" and holfc: "f holomorphic_on cball z r" and w: "w \<in> ball z r"
   proof
     have "cball z ((r + dist w z) / 2) \<subseteq> ball z r"
       using w by (simp add: dist_commute field_sum_of_halves subset_eq)
     then show "f holomorphic_on cball z ((r + dist w z) / 2)"
       by (rule holomorphic_on_subset [OF holf])
     have "r > 0"
       using w by clarsimp (metis dist_norm le_less_trans norm_ge_zero)
     then show "0 < (r + dist w z) / 2"
       by simp (use zero_le_dist [of w z] in linarith)
   qed (use w in \<open>auto simp: dist_commute\<close>)
   then have holf: "f holomorphic_on ball z r"
     using ball_subset_cball holomorphic_on_subset by blast
   have contf: "continuous_on (cball z r) f"
     by (simp add: holfc holomorphic_on_imp_continuous_on)
   have cint: "\<And>k. (\<lambda>u. f u / (u - z) ^ Suc k) contour_integrable_on circlepath z r"
     by (rule Cauchy_higher_derivative_integral_circlepath [OF contf holf]) (simp add: \<open>0 < r\<close>)
   obtain B where "0 < B" and B: "\<And>u. u \<in> cball z r \<Longrightarrow> norm(f u) \<le> B"
     by (metis (no_types) bounded_pos compact_cball compact_continuous_image compact_imp_bounded contf image_eqI)
   obtain k where k: "0 < k" "k \<le> r" and wz_eq: "norm(w - z) = r - k"
              and kle: "\<And>u. norm(u - z) = r \<Longrightarrow> k \<le> norm(u - w)"
   proof
     show "\<And>u. cmod (u - z) = r \<Longrightarrow> r - dist z w \<le> cmod (u - w)"
       by (metis add_diff_eq diff_add_cancel dist_norm norm_diff_ineq)
   qed (use w in \<open>auto simp: dist_norm norm_minus_commute\<close>)
   have ul: "uniform_limit (sphere z r) (\<lambda>n x. (\<Sum>k<n. (w - z) ^ k * (f x / (x - z) ^ Suc k))) (\<lambda>x. f x / (x - w)) sequentially"
     unfolding uniform_limit_iff dist_norm
   proof clarify
     fix e::real
     assume "0 < e"
     have rr: "0 \<le> (r - k) / r" "(r - k) / r < 1" using  k by auto
     obtain n where n: "((r - k) / r) ^ n < e / B * k"
       using real_arch_pow_inv [of "e/B*k" "(r - k)/r"] \<open>0 < e\<close> \<open>0 < B\<close> k by force
     have "norm ((\<Sum>k<N. (w - z) ^ k * f u / (u - z) ^ Suc k) - f u / (u - w)) < e"
          if "n \<le> N" and r: "r = dist z u"  for N u
     proof -
       have N: "((r - k) / r) ^ N < e / B * k"
         apply (rule le_less_trans [OF power_decreasing n])
         using  \<open>n \<le> N\<close> k by auto
       have u [simp]: "(u \<noteq> z) \<and> (u \<noteq> w)"
         using \<open>0 < r\<close> r w by auto
       have wzu_not1: "(w - z) / (u - z) \<noteq> 1"
         by (metis (no_types) dist_norm divide_eq_1_iff less_irrefl mem_ball norm_minus_commute r w)
       have "norm ((\<Sum>k<N. (w - z) ^ k * f u / (u - z) ^ Suc k) * (u - w) - f u)
             = norm ((\<Sum>k<N. (((w - z) / (u - z)) ^ k)) * f u * (u - w) / (u - z) - f u)"
         unfolding sum_distrib_right sum_divide_distrib power_divide by (simp add: algebra_simps)
       also have "\<dots> = norm ((((w - z) / (u - z)) ^ N - 1) * (u - w) / (((w - z) / (u - z) - 1) * (u - z)) - 1) * norm (f u)"
         using \<open>0 < B\<close>
         apply (auto simp: geometric_sum [OF wzu_not1])
         apply (simp add: field_simps norm_mult [symmetric])
         done
       also have "\<dots> = norm ((u-z) ^ N * (w - u) - ((w - z) ^ N - (u-z) ^ N) * (u-w)) / (r ^ N * norm (u-w)) * norm (f u)"
         using \<open>0 < r\<close> r by (simp add: divide_simps norm_mult norm_divide norm_power dist_norm norm_minus_commute)
       also have "\<dots> = norm ((w - z) ^ N * (w - u)) / (r ^ N * norm (u - w)) * norm (f u)"
         by (simp add: algebra_simps)
       also have "\<dots> = norm (w - z) ^ N * norm (f u) / r ^ N"
         by (simp add: norm_mult norm_power norm_minus_commute)
       also have "\<dots> \<le> (((r - k)/r)^N) * B"
         using \<open>0 < r\<close> w k
         apply (simp add: divide_simps)
         apply (rule mult_mono [OF power_mono])
         apply (auto simp: norm_divide wz_eq norm_power dist_norm norm_minus_commute B r)
         done
       also have "\<dots> < e * k"
         using \<open>0 < B\<close> N by (simp add: divide_simps)
       also have "\<dots> \<le> e * norm (u - w)"
         using r kle \<open>0 < e\<close> by (simp add: dist_commute dist_norm)
       finally show ?thesis
         by (simp add: field_split_simps norm_divide del: power_Suc)
     qed
     with \<open>0 < r\<close> show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>sphere z r.
                 norm ((\<Sum>k<n. (w - z) ^ k * (f x / (x - z) ^ Suc k)) - f x / (x - w)) < e"
       by (auto simp: mult_ac less_imp_le eventually_sequentially Ball_def)
   qed
   have eq: "\<forall>\<^sub>F x in sequentially.
              contour_integral (circlepath z r) (\<lambda>u. \<Sum>k<x. (w - z) ^ k * (f u / (u - z) ^ Suc k)) =
              (\<Sum>k<x. contour_integral (circlepath z r) (\<lambda>u. f u / (u - z) ^ Suc k) * (w - z) ^ k)"
     apply (rule eventuallyI)
     apply (subst contour_integral_sum, simp)
     using contour_integrable_lmul [OF cint, of "(w - z) ^ a" for a] apply (simp add: field_simps)
     apply (simp only: contour_integral_lmul cint algebra_simps)
     done
   have cic: "\<And>u. (\<lambda>y. \<Sum>k<u. (w - z) ^ k * (f y / (y - z) ^ Suc k)) contour_integrable_on circlepath z r"
     apply (intro contour_integrable_sum contour_integrable_lmul, simp)
     using \<open>0 < r\<close> by (force intro!: Cauchy_higher_derivative_integral_circlepath [OF contf holf])
   have "(\<lambda>k. contour_integral (circlepath z r) (\<lambda>u. f u/(u - z)^(Suc k)) * (w - z)^k)
         sums contour_integral (circlepath z r) (\<lambda>u. f u/(u - w))"
     unfolding sums_def
     apply (intro Lim_transform_eventually [OF _ eq] contour_integral_uniform_limit_circlepath [OF eventuallyI ul] cic)
     using \<open>0 < r\<close> apply auto
     done
   then have "(\<lambda>k. contour_integral (circlepath z r) (\<lambda>u. f u/(u - z)^(Suc k)) * (w - z)^k)
              sums (2 * of_real pi * \<i> * f w)"
     using w by (auto simp: dist_commute dist_norm contour_integral_unique [OF Cauchy_integral_circlepath_simple [OF holfc]])
   then have "(\<lambda>k. contour_integral (circlepath z r) (\<lambda>u. f u / (u - z) ^ Suc k) * (w - z)^k / (\<i> * (of_real pi * 2)))
             sums ((2 * of_real pi * \<i> * f w) / (\<i> * (complex_of_real pi * 2)))"
     by (rule sums_divide)
   then have "(\<lambda>n. (w - z) ^ n * contour_integral (circlepath z r) (\<lambda>u. f u / (u - z) ^ Suc n) / (\<i> * (of_real pi * 2)))
             sums f w"
     by (simp add: field_simps)
   then show ?thesis
     by (simp add: field_simps \<open>0 < r\<close> Cauchy_higher_derivative_integral_circlepath [OF contf holf])
 qed
 
 
 subsection\<open>The Liouville theorem and the Fundamental Theorem of Algebra\<close>
 
 text\<open> These weak Liouville versions don't even need the derivative formula.\<close>
 
 lemma Liouville_weak_0:
   assumes holf: "f holomorphic_on UNIV" and inf: "(f \<longlongrightarrow> 0) at_infinity"
     shows "f z = 0"
 proof (rule ccontr)
   assume fz: "f z \<noteq> 0"
   with inf [unfolded Lim_at_infinity, rule_format, of "norm(f z)/2"]
   obtain B where B: "\<And>x. B \<le> cmod x \<Longrightarrow> norm (f x) * 2 < cmod (f z)"
     by (auto simp: dist_norm)
   define R where "R = 1 + \<bar>B\<bar> + norm z"
   have "R > 0" unfolding R_def
   proof -
     have "0 \<le> cmod z + \<bar>B\<bar>"
       by (metis (full_types) add_nonneg_nonneg norm_ge_zero real_norm_def)
     then show "0 < 1 + \<bar>B\<bar> + cmod z"
       by linarith
   qed
   have *: "((\<lambda>u. f u / (u - z)) has_contour_integral 2 * complex_of_real pi * \<i> * f z) (circlepath z R)"
     apply (rule Cauchy_integral_circlepath)
     using \<open>R > 0\<close> apply (auto intro: holomorphic_on_subset [OF holf] holomorphic_on_imp_continuous_on)+
     done
   have "cmod (x - z) = R \<Longrightarrow> cmod (f x) * 2 < cmod (f z)" for x
     unfolding R_def
     by (rule B) (use norm_triangle_ineq4 [of x z] in auto)
   with \<open>R > 0\<close> fz show False
     using has_contour_integral_bound_circlepath [OF *, of "norm(f z)/2/R"]
     by (auto simp: less_imp_le norm_mult norm_divide field_split_simps)
 qed
 
 proposition Liouville_weak:
   assumes "f holomorphic_on UNIV" and "(f \<longlongrightarrow> l) at_infinity"
     shows "f z = l"
   using Liouville_weak_0 [of "\<lambda>z. f z - l"]
-  by (simp add: assms holomorphic_on_const holomorphic_on_diff LIM_zero)
+  by (simp add: assms holomorphic_on_diff LIM_zero)
 
 proposition Liouville_weak_inverse:
   assumes "f holomorphic_on UNIV" and unbounded: "\<And>B. eventually (\<lambda>x. norm (f x) \<ge> B) at_infinity"
     obtains z where "f z = 0"
 proof -
   { assume f: "\<And>z. f z \<noteq> 0"
     have 1: "(\<lambda>x. 1 / f x) holomorphic_on UNIV"
-      by (simp add: holomorphic_on_divide holomorphic_on_const assms f)
+      by (simp add: holomorphic_on_divide assms f)
     have 2: "((\<lambda>x. 1 / f x) \<longlongrightarrow> 0) at_infinity"
       apply (rule tendstoI [OF eventually_mono])
       apply (rule_tac B="2/e" in unbounded)
-      apply (simp add: dist_norm norm_divide field_split_simps mult_ac)
+      apply (simp add: dist_norm norm_divide field_split_simps)
       done
     have False
       using Liouville_weak_0 [OF 1 2] f by simp
   }
   then show ?thesis
     using that by blast
 qed
 
 text\<open> In particular we get the Fundamental Theorem of Algebra.\<close>
 
 theorem fundamental_theorem_of_algebra:
     fixes a :: "nat \<Rightarrow> complex"
   assumes "a 0 = 0 \<or> (\<exists>i \<in> {1..n}. a i \<noteq> 0)"
   obtains z where "(\<Sum>i\<le>n. a i * z^i) = 0"
 using assms
 proof (elim disjE bexE)
   assume "a 0 = 0" then show ?thesis
     by (auto simp: that [of 0])
 next
   fix i
   assume i: "i \<in> {1..n}" and nz: "a i \<noteq> 0"
   have 1: "(\<lambda>z. \<Sum>i\<le>n. a i * z^i) holomorphic_on UNIV"
     by (rule holomorphic_intros)+
   show thesis
   proof (rule Liouville_weak_inverse [OF 1])
     show "\<forall>\<^sub>F x in at_infinity. B \<le> cmod (\<Sum>i\<le>n. a i * x ^ i)" for B
       using i polyfun_extremal nz by force
   qed (use that in auto)
 qed
 
 subsection\<open>Weierstrass convergence theorem\<close>
 
 lemma holomorphic_uniform_limit:
   assumes cont: "eventually (\<lambda>n. continuous_on (cball z r) (f n) \<and> (f n) holomorphic_on ball z r) F"
       and ulim: "uniform_limit (cball z r) f g F"
       and F:  "\<not> trivial_limit F"
   obtains "continuous_on (cball z r) g" "g holomorphic_on ball z r"
 proof (cases r "0::real" rule: linorder_cases)
   case less then show ?thesis by (force simp: ball_empty less_imp_le continuous_on_def holomorphic_on_def intro: that)
 next
   case equal then show ?thesis
     by (force simp: holomorphic_on_def intro: that)
 next
   case greater
   have contg: "continuous_on (cball z r) g"
     using cont uniform_limit_theorem [OF eventually_mono ulim F]  by blast
   have "path_image (circlepath z r) \<subseteq> cball z r"
     using \<open>0 < r\<close> by auto
   then have 1: "continuous_on (path_image (circlepath z r)) (\<lambda>x. 1 / (2 * complex_of_real pi * \<i>) * g x)"
     by (intro continuous_intros continuous_on_subset [OF contg])
   have 2: "((\<lambda>u. 1 / (2 * of_real pi * \<i>) * g u / (u - w) ^ 1) has_contour_integral g w) (circlepath z r)"
        if w: "w \<in> ball z r" for w
   proof -
     define d where "d = (r - norm(w - z))"
     have "0 < d"  "d \<le> r" using w by (auto simp: norm_minus_commute d_def dist_norm)
     have dle: "\<And>u. cmod (z - u) = r \<Longrightarrow> d \<le> cmod (u - w)"
       unfolding d_def by (metis add_diff_eq diff_add_cancel norm_diff_ineq norm_minus_commute)
     have ev_int: "\<forall>\<^sub>F n in F. (\<lambda>u. f n u / (u - w)) contour_integrable_on circlepath z r"
       apply (rule eventually_mono [OF cont])
       using w
       apply (auto intro: Cauchy_higher_derivative_integral_circlepath [where k=0, simplified])
       done
     have ul_less: "uniform_limit (sphere z r) (\<lambda>n x. f n x / (x - w)) (\<lambda>x. g x / (x - w)) F"
       using greater \<open>0 < d\<close>
       apply (clarsimp simp add: uniform_limit_iff dist_norm norm_divide diff_divide_distrib [symmetric] divide_simps)
       apply (rule_tac e1="e * d" in eventually_mono [OF uniform_limitD [OF ulim]])
        apply (force simp: dist_norm intro: dle mult_left_mono less_le_trans)+
       done
     have g_cint: "(\<lambda>u. g u/(u - w)) contour_integrable_on circlepath z r"
       by (rule contour_integral_uniform_limit_circlepath [OF ev_int ul_less F \<open>0 < r\<close>])
     have cif_tends_cig: "((\<lambda>n. contour_integral(circlepath z r) (\<lambda>u. f n u / (u - w))) \<longlongrightarrow> contour_integral(circlepath z r) (\<lambda>u. g u/(u - w))) F"
       by (rule contour_integral_uniform_limit_circlepath [OF ev_int ul_less F \<open>0 < r\<close>])
     have f_tends_cig: "((\<lambda>n. 2 * of_real pi * \<i> * f n w) \<longlongrightarrow> contour_integral (circlepath z r) (\<lambda>u. g u / (u - w))) F"
     proof (rule Lim_transform_eventually)
       show "\<forall>\<^sub>F x in F. contour_integral (circlepath z r) (\<lambda>u. f x u / (u - w))
                      = 2 * of_real pi * \<i> * f x w"
         apply (rule eventually_mono [OF cont contour_integral_unique [OF Cauchy_integral_circlepath]])
         using w\<open>0 < d\<close> d_def by auto
     qed (auto simp: cif_tends_cig)
     have "\<And>e. 0 < e \<Longrightarrow> \<forall>\<^sub>F n in F. dist (f n w) (g w) < e"
       by (rule eventually_mono [OF uniform_limitD [OF ulim]]) (use w in auto)
     then have "((\<lambda>n. 2 * of_real pi * \<i> * f n w) \<longlongrightarrow> 2 * of_real pi * \<i> * g w) F"
       by (rule tendsto_mult_left [OF tendstoI])
     then have "((\<lambda>u. g u / (u - w)) has_contour_integral 2 * of_real pi * \<i> * g w) (circlepath z r)"
       using has_contour_integral_integral [OF g_cint] tendsto_unique [OF F f_tends_cig] w
       by fastforce
     then have "((\<lambda>u. g u / (2 * of_real pi * \<i> * (u - w))) has_contour_integral g w) (circlepath z r)"
       using has_contour_integral_div [where c = "2 * of_real pi * \<i>"]
       by (force simp: field_simps)
     then show ?thesis
       by (simp add: dist_norm)
   qed
   show ?thesis
     using Cauchy_next_derivative_circlepath(2) [OF 1 2, simplified]
     by (fastforce simp add: holomorphic_on_open contg intro: that)
 qed
 
 
 text\<open> Version showing that the limit is the limit of the derivatives.\<close>
 
 proposition has_complex_derivative_uniform_limit:
   fixes z::complex
   assumes cont: "eventually (\<lambda>n. continuous_on (cball z r) (f n) \<and>
                                (\<forall>w \<in> ball z r. ((f n) has_field_derivative (f' n w)) (at w))) F"
       and ulim: "uniform_limit (cball z r) f g F"
       and F:  "\<not> trivial_limit F" and "0 < r"
   obtains g' where
       "continuous_on (cball z r) g"
       "\<And>w. w \<in> ball z r \<Longrightarrow> (g has_field_derivative (g' w)) (at w) \<and> ((\<lambda>n. f' n w) \<longlongrightarrow> g' w) F"
 proof -
   let ?conint = "contour_integral (circlepath z r)"
   have g: "continuous_on (cball z r) g" "g holomorphic_on ball z r"
     by (rule holomorphic_uniform_limit [OF eventually_mono [OF cont] ulim F];
              auto simp: holomorphic_on_open field_differentiable_def)+
   then obtain g' where g': "\<And>x. x \<in> ball z r \<Longrightarrow> (g has_field_derivative g' x) (at x)"
     using DERIV_deriv_iff_has_field_derivative
     by (fastforce simp add: holomorphic_on_open)
   then have derg: "\<And>x. x \<in> ball z r \<Longrightarrow> deriv g x = g' x"
     by (simp add: DERIV_imp_deriv)
   have tends_f'n_g': "((\<lambda>n. f' n w) \<longlongrightarrow> g' w) F" if w: "w \<in> ball z r" for w
   proof -
     have eq_f': "?conint (\<lambda>x. f n x / (x - w)\<^sup>2) - ?conint (\<lambda>x. g x / (x - w)\<^sup>2) = (f' n w - g' w) * (2 * of_real pi * \<i>)"
              if cont_fn: "continuous_on (cball z r) (f n)"
              and fnd: "\<And>w. w \<in> ball z r \<Longrightarrow> (f n has_field_derivative f' n w) (at w)" for n
     proof -
       have hol_fn: "f n holomorphic_on ball z r"
         using fnd by (force simp: holomorphic_on_open)
       have "(f n has_field_derivative 1 / (2 * of_real pi * \<i>) * ?conint (\<lambda>u. f n u / (u - w)\<^sup>2)) (at w)"
         by (rule Cauchy_derivative_integral_circlepath [OF cont_fn hol_fn w])
       then have f': "f' n w = 1 / (2 * of_real pi * \<i>) * ?conint (\<lambda>u. f n u / (u - w)\<^sup>2)"
         using DERIV_unique [OF fnd] w by blast
       show ?thesis
         by (simp add: f' Cauchy_contour_integral_circlepath_2 [OF g w] derg [OF w] field_split_simps)
     qed
     define d where "d = (r - norm(w - z))^2"
     have "d > 0"
       using w by (simp add: dist_commute dist_norm d_def)
     have dle: "d \<le> cmod ((y - w)\<^sup>2)" if "r = cmod (z - y)" for y
     proof -
       have "w \<in> ball z (cmod (z - y))"
         using that w by fastforce
       then have "cmod (w - z) \<le> cmod (z - y)"
         by (simp add: dist_complex_def norm_minus_commute)
       moreover have "cmod (z - y) - cmod (w - z) \<le> cmod (y - w)"
         by (metis diff_add_cancel diff_add_eq_diff_diff_swap norm_minus_commute norm_triangle_ineq2)
       ultimately show ?thesis
         using that by (simp add: d_def norm_power power_mono)
     qed
     have 1: "\<forall>\<^sub>F n in F. (\<lambda>x. f n x / (x - w)\<^sup>2) contour_integrable_on circlepath z r"
       by (force simp: holomorphic_on_open intro: w Cauchy_derivative_integral_circlepath eventually_mono [OF cont])
     have 2: "uniform_limit (sphere z r) (\<lambda>n x. f n x / (x - w)\<^sup>2) (\<lambda>x. g x / (x - w)\<^sup>2) F"
       unfolding uniform_limit_iff
     proof clarify
       fix e::real
       assume "0 < e"
       with \<open>r > 0\<close> show "\<forall>\<^sub>F n in F. \<forall>x\<in>sphere z r. dist (f n x / (x - w)\<^sup>2) (g x / (x - w)\<^sup>2) < e"
         apply (simp add: norm_divide field_split_simps sphere_def dist_norm)
         apply (rule eventually_mono [OF uniform_limitD [OF ulim], of "e*d"])
          apply (simp add: \<open>0 < d\<close>)
         apply (force simp: dist_norm dle intro: less_le_trans)
         done
     qed
     have "((\<lambda>n. contour_integral (circlepath z r) (\<lambda>x. f n x / (x - w)\<^sup>2))
              \<longlongrightarrow> contour_integral (circlepath z r) ((\<lambda>x. g x / (x - w)\<^sup>2))) F"
       by (rule contour_integral_uniform_limit_circlepath [OF 1 2 F \<open>0 < r\<close>])
     then have tendsto_0: "((\<lambda>n. 1 / (2 * of_real pi * \<i>) * (?conint (\<lambda>x. f n x / (x - w)\<^sup>2) - ?conint (\<lambda>x. g x / (x - w)\<^sup>2))) \<longlongrightarrow> 0) F"
       using Lim_null by (force intro!: tendsto_mult_right_zero)
     have "((\<lambda>n. f' n w - g' w) \<longlongrightarrow> 0) F"
       apply (rule Lim_transform_eventually [OF tendsto_0])
       apply (force simp: divide_simps intro: eq_f' eventually_mono [OF cont])
       done
     then show ?thesis using Lim_null by blast
   qed
   obtain g' where "\<And>w. w \<in> ball z r \<Longrightarrow> (g has_field_derivative (g' w)) (at w) \<and> ((\<lambda>n. f' n w) \<longlongrightarrow> g' w) F"
       by (blast intro: tends_f'n_g' g')
   then show ?thesis using g
     using that by blast
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some more simple/convenient versions for applications\<close>
 
 lemma holomorphic_uniform_sequence:
   assumes S: "open S"
       and hol_fn: "\<And>n. (f n) holomorphic_on S"
       and ulim_g: "\<And>x. x \<in> S \<Longrightarrow> \<exists>d. 0 < d \<and> cball x d \<subseteq> S \<and> uniform_limit (cball x d) f g sequentially"
   shows "g holomorphic_on S"
 proof -
   have "\<exists>f'. (g has_field_derivative f') (at z)" if "z \<in> S" for z
   proof -
     obtain r where "0 < r" and r: "cball z r \<subseteq> S"
                and ul: "uniform_limit (cball z r) f g sequentially"
       using ulim_g [OF \<open>z \<in> S\<close>] by blast
     have *: "\<forall>\<^sub>F n in sequentially. continuous_on (cball z r) (f n) \<and> f n holomorphic_on ball z r"
     proof (intro eventuallyI conjI)
       show "continuous_on (cball z r) (f x)" for x
         using hol_fn holomorphic_on_imp_continuous_on holomorphic_on_subset r by blast
       show "f x holomorphic_on ball z r" for x
         by (metis hol_fn holomorphic_on_subset interior_cball interior_subset r)
     qed
     show ?thesis
       apply (rule holomorphic_uniform_limit [OF *])
       using \<open>0 < r\<close> centre_in_ball ul
       apply (auto simp: holomorphic_on_open)
       done
   qed
   with S show ?thesis
     by (simp add: holomorphic_on_open)
 qed
 
 lemma has_complex_derivative_uniform_sequence:
   fixes S :: "complex set"
   assumes S: "open S"
       and hfd: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_field_derivative f' n x) (at x)"
       and ulim_g: "\<And>x. x \<in> S
              \<Longrightarrow> \<exists>d. 0 < d \<and> cball x d \<subseteq> S \<and> uniform_limit (cball x d) f g sequentially"
   shows "\<exists>g'. \<forall>x \<in> S. (g has_field_derivative g' x) (at x) \<and> ((\<lambda>n. f' n x) \<longlongrightarrow> g' x) sequentially"
 proof -
   have y: "\<exists>y. (g has_field_derivative y) (at z) \<and> (\<lambda>n. f' n z) \<longlonglongrightarrow> y" if "z \<in> S" for z
   proof -
     obtain r where "0 < r" and r: "cball z r \<subseteq> S"
                and ul: "uniform_limit (cball z r) f g sequentially"
       using ulim_g [OF \<open>z \<in> S\<close>] by blast
     have *: "\<forall>\<^sub>F n in sequentially. continuous_on (cball z r) (f n) \<and>
                                    (\<forall>w \<in> ball z r. ((f n) has_field_derivative (f' n w)) (at w))"
     proof (intro eventuallyI conjI ballI)
       show "continuous_on (cball z r) (f x)" for x
         by (meson S continuous_on_subset hfd holomorphic_on_imp_continuous_on holomorphic_on_open r)
       show "w \<in> ball z r \<Longrightarrow> (f x has_field_derivative f' x w) (at w)" for w x
         using ball_subset_cball hfd r by blast
     qed
     show ?thesis
       by (rule has_complex_derivative_uniform_limit [OF *, of g]) (use \<open>0 < r\<close> ul in \<open>force+\<close>)
   qed
   show ?thesis
     by (rule bchoice) (blast intro: y)
 qed
 
 subsection\<open>On analytic functions defined by a series\<close>
 
 lemma series_and_derivative_comparison:
   fixes S :: "complex set"
   assumes S: "open S"
       and h: "summable h"
       and hfd: "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
       and to_g: "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. norm (f n x) \<le> h n"
   obtains g g' where "\<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> ((\<lambda>n. f' n x) sums g' x) \<and> (g has_field_derivative g' x) (at x)"
 proof -
   obtain g where g: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f i x) g sequentially"
     using Weierstrass_m_test_ev [OF to_g h]  by force
   have *: "\<exists>d>0. cball x d \<subseteq> S \<and> uniform_limit (cball x d) (\<lambda>n x. \<Sum>i<n. f i x) g sequentially"
          if "x \<in> S" for x
   proof -
     obtain d where "d>0" and d: "cball x d \<subseteq> S"
       using open_contains_cball [of "S"] \<open>x \<in> S\<close> S by blast
     show ?thesis
     proof (intro conjI exI)
       show "uniform_limit (cball x d) (\<lambda>n x. \<Sum>i<n. f i x) g sequentially"
         using d g uniform_limit_on_subset by (force simp: dist_norm eventually_sequentially)
     qed (use \<open>d > 0\<close> d in auto)
   qed
   have "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. \<Sum>i<n. f i x) \<longlonglongrightarrow> g x"
     by (metis tendsto_uniform_limitI [OF g])
   moreover have "\<exists>g'. \<forall>x\<in>S. (g has_field_derivative g' x) (at x) \<and> (\<lambda>n. \<Sum>i<n. f' i x) \<longlonglongrightarrow> g' x"
     by (rule has_complex_derivative_uniform_sequence [OF S]) (auto intro: * hfd DERIV_sum)+
   ultimately show ?thesis
     by (metis sums_def that)
 qed
 
 text\<open>A version where we only have local uniform/comparative convergence.\<close>
 
 lemma series_and_derivative_comparison_local:
   fixes S :: "complex set"
   assumes S: "open S"
       and hfd: "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
       and to_g: "\<And>x. x \<in> S \<Longrightarrow> \<exists>d h. 0 < d \<and> summable h \<and> (\<forall>\<^sub>F n in sequentially. \<forall>y\<in>ball x d \<inter> S. norm (f n y) \<le> h n)"
   shows "\<exists>g g'. \<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> ((\<lambda>n. f' n x) sums g' x) \<and> (g has_field_derivative g' x) (at x)"
 proof -
   have "\<exists>y. (\<lambda>n. f n z) sums (\<Sum>n. f n z) \<and> (\<lambda>n. f' n z) sums y \<and> ((\<lambda>x. \<Sum>n. f n x) has_field_derivative y) (at z)"
        if "z \<in> S" for z
   proof -
     obtain d h where "0 < d" "summable h" and le_h: "\<forall>\<^sub>F n in sequentially. \<forall>y\<in>ball z d \<inter> S. norm (f n y) \<le> h n"
       using to_g \<open>z \<in> S\<close> by meson
     then obtain r where "r>0" and r: "ball z r \<subseteq> ball z d \<inter> S" using \<open>z \<in> S\<close> S
       by (metis Int_iff open_ball centre_in_ball open_Int open_contains_ball_eq)
     have 1: "open (ball z d \<inter> S)"
       by (simp add: open_Int S)
     have 2: "\<And>n x. x \<in> ball z d \<inter> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
       by (auto simp: hfd)
     obtain g g' where gg': "\<forall>x \<in> ball z d \<inter> S. ((\<lambda>n. f n x) sums g x) \<and>
                                     ((\<lambda>n. f' n x) sums g' x) \<and> (g has_field_derivative g' x) (at x)"
       by (auto intro: le_h series_and_derivative_comparison [OF 1 \<open>summable h\<close> hfd])
     then have "(\<lambda>n. f' n z) sums g' z"
       by (meson \<open>0 < r\<close> centre_in_ball contra_subsetD r)
     moreover have "(\<lambda>n. f n z) sums (\<Sum>n. f n z)"
       using  summable_sums centre_in_ball \<open>0 < d\<close> \<open>summable h\<close> le_h
       by (metis (full_types) Int_iff gg' summable_def that)
     moreover have "((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' z) (at z)"
     proof (rule has_field_derivative_transform_within)
       show "\<And>x. dist x z < r \<Longrightarrow> g x = (\<Sum>n. f n x)"
         by (metis subsetD dist_commute gg' mem_ball r sums_unique)
     qed (use \<open>0 < r\<close> gg' \<open>z \<in> S\<close> \<open>0 < d\<close> in auto)
     ultimately show ?thesis by auto
   qed
   then show ?thesis
     by (rule_tac x="\<lambda>x. suminf (\<lambda>n. f n x)" in exI) meson
 qed
 
 
 text\<open>Sometimes convenient to compare with a complex series of positive reals. (?)\<close>
 
 lemma series_and_derivative_comparison_complex:
   fixes S :: "complex set"
   assumes S: "open S"
       and hfd: "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
       and to_g: "\<And>x. x \<in> S \<Longrightarrow> \<exists>d h. 0 < d \<and> summable h \<and> range h \<subseteq> \<real>\<^sub>\<ge>\<^sub>0 \<and> (\<forall>\<^sub>F n in sequentially. \<forall>y\<in>ball x d \<inter> S. cmod(f n y) \<le> cmod (h n))"
   shows "\<exists>g g'. \<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> ((\<lambda>n. f' n x) sums g' x) \<and> (g has_field_derivative g' x) (at x)"
 apply (rule series_and_derivative_comparison_local [OF S hfd], assumption)
 apply (rule ex_forward [OF to_g], assumption)
 apply (erule exE)
 apply (rule_tac x="Re \<circ> h" in exI)
 apply (force simp: summable_Re o_def nonneg_Reals_cmod_eq_Re image_subset_iff)
 done
 
 text\<open>Sometimes convenient to compare with a complex series of positive reals. (?)\<close>
 lemma series_differentiable_comparison_complex:
   fixes S :: "complex set"
   assumes S: "open S"
     and hfd: "\<And>n x. x \<in> S \<Longrightarrow> f n field_differentiable (at x)"
     and to_g: "\<And>x. x \<in> S \<Longrightarrow> \<exists>d h. 0 < d \<and> summable h \<and> range h \<subseteq> \<real>\<^sub>\<ge>\<^sub>0 \<and> (\<forall>\<^sub>F n in sequentially. \<forall>y\<in>ball x d \<inter> S. cmod(f n y) \<le> cmod (h n))"
   obtains g where "\<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> g field_differentiable (at x)"
 proof -
   have hfd': "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative deriv (f n) x) (at x)"
     using hfd field_differentiable_derivI by blast
   have "\<exists>g g'. \<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> ((\<lambda>n. deriv (f n) x) sums g' x) \<and> (g has_field_derivative g' x) (at x)"
     by (metis series_and_derivative_comparison_complex [OF S hfd' to_g])
   then show ?thesis
     using field_differentiable_def that by blast
 qed
 
 text\<open>In particular, a power series is analytic inside circle of convergence.\<close>
 
 lemma power_series_and_derivative_0:
   fixes a :: "nat \<Rightarrow> complex" and r::real
   assumes "summable (\<lambda>n. a n * r^n)"
     shows "\<exists>g g'. \<forall>z. cmod z < r \<longrightarrow>
              ((\<lambda>n. a n * z^n) sums g z) \<and> ((\<lambda>n. of_nat n * a n * z^(n - 1)) sums g' z) \<and> (g has_field_derivative g' z) (at z)"
 proof (cases "0 < r")
   case True
     have der: "\<And>n z. ((\<lambda>x. a n * x ^ n) has_field_derivative of_nat n * a n * z ^ (n - 1)) (at z)"
       by (rule derivative_eq_intros | simp)+
     have y_le: "\<lbrakk>cmod (z - y) * 2 < r - cmod z\<rbrakk> \<Longrightarrow> cmod y \<le> cmod (of_real r + of_real (cmod z)) / 2" for z y
       using \<open>r > 0\<close>
       apply (auto simp: algebra_simps norm_mult norm_divide norm_power simp flip: of_real_add)
       using norm_triangle_ineq2 [of y z]
       apply (simp only: diff_le_eq norm_minus_commute mult_2)
       done
     have "summable (\<lambda>n. a n * complex_of_real r ^ n)"
       using assms \<open>r > 0\<close> by simp
     moreover have "\<And>z. cmod z < r \<Longrightarrow> cmod ((of_real r + of_real (cmod z)) / 2) < cmod (of_real r)"
       using \<open>r > 0\<close>
       by (simp flip: of_real_add)
     ultimately have sum: "\<And>z. cmod z < r \<Longrightarrow> summable (\<lambda>n. of_real (cmod (a n)) * ((of_real r + complex_of_real (cmod z)) / 2) ^ n)"
       by (rule power_series_conv_imp_absconv_weak)
     have "\<exists>g g'. \<forall>z \<in> ball 0 r. (\<lambda>n.  (a n) * z ^ n) sums g z \<and>
                (\<lambda>n. of_nat n * (a n) * z ^ (n - 1)) sums g' z \<and> (g has_field_derivative g' z) (at z)"
       apply (rule series_and_derivative_comparison_complex [OF open_ball der])
       apply (rule_tac x="(r - norm z)/2" in exI)
       apply (rule_tac x="\<lambda>n. of_real(norm(a n)*((r + norm z)/2)^n)" in exI)
       using \<open>r > 0\<close>
       apply (auto simp: sum eventually_sequentially norm_mult norm_power dist_norm intro!: mult_left_mono power_mono y_le)
       done
   then show ?thesis
     by (simp add: ball_def)
 next
   case False then show ?thesis
     apply (simp add: not_less)
     using less_le_trans norm_not_less_zero by blast
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> power_series_and_derivative:
   fixes a :: "nat \<Rightarrow> complex" and r::real
   assumes "summable (\<lambda>n. a n * r^n)"
     obtains g g' where "\<forall>z \<in> ball w r.
              ((\<lambda>n. a n * (z - w) ^ n) sums g z) \<and> ((\<lambda>n. of_nat n * a n * (z - w) ^ (n - 1)) sums g' z) \<and>
               (g has_field_derivative g' z) (at z)"
   using power_series_and_derivative_0 [OF assms]
   apply clarify
   apply (rule_tac g="(\<lambda>z. g(z - w))" in that)
   using DERIV_shift [where z="-w"]
   apply (auto simp: norm_minus_commute Ball_def dist_norm)
   done
 
 proposition\<^marker>\<open>tag unimportant\<close> power_series_holomorphic:
   assumes "\<And>w. w \<in> ball z r \<Longrightarrow> ((\<lambda>n. a n*(w - z)^n) sums f w)"
     shows "f holomorphic_on ball z r"
 proof -
   have "\<exists>f'. (f has_field_derivative f') (at w)" if w: "dist z w < r" for w
   proof -
     have inb: "z + complex_of_real ((dist z w + r) / 2) \<in> ball z r"
     proof -
       have wz: "cmod (w - z) < r" using w
         by (auto simp: field_split_simps dist_norm norm_minus_commute)
       then have "0 \<le> r"
         by (meson less_eq_real_def norm_ge_zero order_trans)
       show ?thesis
         using w by (simp add: dist_norm \<open>0\<le>r\<close> flip: of_real_add)
     qed
     have sum: "summable (\<lambda>n. a n * of_real (((cmod (z - w) + r) / 2) ^ n))"
       using assms [OF inb] by (force simp: summable_def dist_norm)
     obtain g g' where gg': "\<And>u. u \<in> ball z ((cmod (z - w) + r) / 2) \<Longrightarrow>
                                (\<lambda>n. a n * (u - z) ^ n) sums g u \<and>
                                (\<lambda>n. of_nat n * a n * (u - z) ^ (n - 1)) sums g' u \<and> (g has_field_derivative g' u) (at u)"
       by (rule power_series_and_derivative [OF sum, of z]) fastforce
     have [simp]: "g u = f u" if "cmod (u - w) < (r - cmod (z - w)) / 2" for u
     proof -
       have less: "cmod (z - u) * 2 < cmod (z - w) + r"
         using that dist_triangle2 [of z u w]
         by (simp add: dist_norm [symmetric] algebra_simps)
       show ?thesis
         apply (rule sums_unique2 [of "\<lambda>n. a n*(u - z)^n"])
         using gg' [of u] less w
         apply (auto simp: assms dist_norm)
         done
     qed
     have "(f has_field_derivative g' w) (at w)"
       by (rule has_field_derivative_transform_within [where d="(r - norm(z - w))/2"])
       (use w gg' [of w] in \<open>(force simp: dist_norm)+\<close>)
     then show ?thesis ..
   qed
   then show ?thesis by (simp add: holomorphic_on_open)
 qed
 
 corollary holomorphic_iff_power_series:
      "f holomorphic_on ball z r \<longleftrightarrow>
       (\<forall>w \<in> ball z r. (\<lambda>n. (deriv ^^ n) f z / (fact n) * (w - z)^n) sums f w)"
   apply (intro iffI ballI holomorphic_power_series, assumption+)
   apply (force intro: power_series_holomorphic [where a = "\<lambda>n. (deriv ^^ n) f z / (fact n)"])
   done
 
 lemma power_series_analytic:
      "(\<And>w. w \<in> ball z r \<Longrightarrow> (\<lambda>n. a n*(w - z)^n) sums f w) \<Longrightarrow> f analytic_on ball z r"
   by (force simp: analytic_on_open intro!: power_series_holomorphic)
 
 lemma analytic_iff_power_series:
      "f analytic_on ball z r \<longleftrightarrow>
       (\<forall>w \<in> ball z r. (\<lambda>n. (deriv ^^ n) f z / (fact n) * (w - z)^n) sums f w)"
   by (simp add: analytic_on_open holomorphic_iff_power_series)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Equality between holomorphic functions, on open ball then connected set\<close>
 
 lemma holomorphic_fun_eq_on_ball:
    "\<lbrakk>f holomorphic_on ball z r; g holomorphic_on ball z r;
      w \<in> ball z r;
      \<And>n. (deriv ^^ n) f z = (deriv ^^ n) g z\<rbrakk>
      \<Longrightarrow> f w = g w"
   apply (rule sums_unique2 [of "\<lambda>n. (deriv ^^ n) f z / (fact n) * (w - z)^n"])
   apply (auto simp: holomorphic_iff_power_series)
   done
 
 lemma holomorphic_fun_eq_0_on_ball:
    "\<lbrakk>f holomorphic_on ball z r;  w \<in> ball z r;
      \<And>n. (deriv ^^ n) f z = 0\<rbrakk>
      \<Longrightarrow> f w = 0"
   apply (rule sums_unique2 [of "\<lambda>n. (deriv ^^ n) f z / (fact n) * (w - z)^n"])
   apply (auto simp: holomorphic_iff_power_series)
   done
 
 lemma holomorphic_fun_eq_0_on_connected:
   assumes holf: "f holomorphic_on S" and "open S"
       and cons: "connected S"
       and der: "\<And>n. (deriv ^^ n) f z = 0"
       and "z \<in> S" "w \<in> S"
     shows "f w = 0"
 proof -
   have *: "ball x e \<subseteq> (\<Inter>n. {w \<in> S. (deriv ^^ n) f w = 0})"
     if "\<forall>u. (deriv ^^ u) f x = 0" "ball x e \<subseteq> S" for x e
   proof -
     have "\<And>x' n. dist x x' < e \<Longrightarrow> (deriv ^^ n) f x' = 0"
       apply (rule holomorphic_fun_eq_0_on_ball [OF holomorphic_higher_deriv])
          apply (rule holomorphic_on_subset [OF holf])
       using that apply simp_all
       by (metis funpow_add o_apply)
     with that show ?thesis by auto
   qed
   have 1: "openin (top_of_set S) (\<Inter>n. {w \<in> S. (deriv ^^ n) f w = 0})"
     apply (rule open_subset, force)
     using \<open>open S\<close>
     apply (simp add: open_contains_ball Ball_def)
     apply (erule all_forward)
     using "*" by auto blast+
   have 2: "closedin (top_of_set S) (\<Inter>n. {w \<in> S. (deriv ^^ n) f w = 0})"
     using assms
     by (auto intro: continuous_closedin_preimage_constant holomorphic_on_imp_continuous_on holomorphic_higher_deriv)
   obtain e where "e>0" and e: "ball w e \<subseteq> S" using openE [OF \<open>open S\<close> \<open>w \<in> S\<close>] .
   then have holfb: "f holomorphic_on ball w e"
     using holf holomorphic_on_subset by blast
   have 3: "(\<Inter>n. {w \<in> S. (deriv ^^ n) f w = 0}) = S \<Longrightarrow> f w = 0"
     using \<open>e>0\<close> e by (force intro: holomorphic_fun_eq_0_on_ball [OF holfb])
   show ?thesis
     using cons der \<open>z \<in> S\<close>
     apply (simp add: connected_clopen)
     apply (drule_tac x="\<Inter>n. {w \<in> S. (deriv ^^ n) f w = 0}" in spec)
     apply (auto simp: 1 2 3)
     done
 qed
 
 lemma holomorphic_fun_eq_on_connected:
   assumes "f holomorphic_on S" "g holomorphic_on S" and "open S"  "connected S"
       and "\<And>n. (deriv ^^ n) f z = (deriv ^^ n) g z"
       and "z \<in> S" "w \<in> S"
     shows "f w = g w"
 proof (rule holomorphic_fun_eq_0_on_connected [of "\<lambda>x. f x - g x" S z, simplified])
   show "(\<lambda>x. f x - g x) holomorphic_on S"
     by (intro assms holomorphic_intros)
   show "\<And>n. (deriv ^^ n) (\<lambda>x. f x - g x) z = 0"
     using assms higher_deriv_diff by auto
 qed (use assms in auto)
 
 lemma holomorphic_fun_eq_const_on_connected:
   assumes holf: "f holomorphic_on S" and "open S"
       and cons: "connected S"
       and der: "\<And>n. 0 < n \<Longrightarrow> (deriv ^^ n) f z = 0"
       and "z \<in> S" "w \<in> S"
     shows "f w = f z"
 proof (rule holomorphic_fun_eq_0_on_connected [of "\<lambda>w. f w - f z" S z, simplified])
   show "(\<lambda>w. f w - f z) holomorphic_on S"
     by (intro assms holomorphic_intros)
   show "\<And>n. (deriv ^^ n) (\<lambda>w. f w - f z) z = 0"
     by (subst higher_deriv_diff) (use assms in \<open>auto intro: holomorphic_intros\<close>)
 qed (use assms in auto)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some basic lemmas about poles/singularities\<close>
 
 lemma pole_lemma:
   assumes holf: "f holomorphic_on S" and a: "a \<in> interior S"
     shows "(\<lambda>z. if z = a then deriv f a
                  else (f z - f a) / (z - a)) holomorphic_on S" (is "?F holomorphic_on S")
 proof -
   have F1: "?F field_differentiable (at u within S)" if "u \<in> S" "u \<noteq> a" for u
   proof -
     have fcd: "f field_differentiable at u within S"
       using holf holomorphic_on_def by (simp add: \<open>u \<in> S\<close>)
     have cd: "(\<lambda>z. (f z - f a) / (z - a)) field_differentiable at u within S"
       by (rule fcd derivative_intros | simp add: that)+
     have "0 < dist a u" using that dist_nz by blast
     then show ?thesis
       by (rule field_differentiable_transform_within [OF _ _ _ cd]) (auto simp: \<open>u \<in> S\<close>)
   qed
   have F2: "?F field_differentiable at a" if "0 < e" "ball a e \<subseteq> S" for e
   proof -
     have holfb: "f holomorphic_on ball a e"
       by (rule holomorphic_on_subset [OF holf \<open>ball a e \<subseteq> S\<close>])
     have 2: "?F holomorphic_on ball a e - {a}"
       apply (simp add: holomorphic_on_def flip: field_differentiable_def)
       using mem_ball that
       apply (auto intro: F1 field_differentiable_within_subset)
       done
     have "isCont (\<lambda>z. if z = a then deriv f a else (f z - f a) / (z - a)) x"
             if "dist a x < e" for x
     proof (cases "x=a")
       case True
       then have "f field_differentiable at a"
         using holfb \<open>0 < e\<close> holomorphic_on_imp_differentiable_at by auto
       with True show ?thesis
         by (auto simp: continuous_at has_field_derivative_iff simp flip: DERIV_deriv_iff_field_differentiable
                 elim: rev_iffD1 [OF _ LIM_equal])
     next
       case False with 2 that show ?thesis
         by (force simp: holomorphic_on_open open_Diff field_differentiable_def [symmetric] field_differentiable_imp_continuous_at)
     qed
     then have 1: "continuous_on (ball a e) ?F"
       by (clarsimp simp:  continuous_on_eq_continuous_at)
     have "?F holomorphic_on ball a e"
       by (auto intro: no_isolated_singularity [OF 1 2])
     with that show ?thesis
       by (simp add: holomorphic_on_open field_differentiable_def [symmetric]
                     field_differentiable_at_within)
   qed
   show ?thesis
   proof
     fix x assume "x \<in> S" show "?F field_differentiable at x within S"
     proof (cases "x=a")
       case True then show ?thesis
       using a by (auto simp: mem_interior intro: field_differentiable_at_within F2)
     next
       case False with F1 \<open>x \<in> S\<close>
       show ?thesis by blast
     qed
   qed
 qed
 
 lemma pole_theorem:
   assumes holg: "g holomorphic_on S" and a: "a \<in> interior S"
       and eq: "\<And>z. z \<in> S - {a} \<Longrightarrow> g z = (z - a) * f z"
     shows "(\<lambda>z. if z = a then deriv g a
                  else f z - g a/(z - a)) holomorphic_on S"
   using pole_lemma [OF holg a]
   by (rule holomorphic_transform) (simp add: eq field_split_simps)
 
 lemma pole_lemma_open:
   assumes "f holomorphic_on S" "open S"
     shows "(\<lambda>z. if z = a then deriv f a else (f z - f a)/(z - a)) holomorphic_on S"
 proof (cases "a \<in> S")
   case True with assms interior_eq pole_lemma
     show ?thesis by fastforce
 next
   case False with assms show ?thesis
     apply (simp add: holomorphic_on_def field_differentiable_def [symmetric], clarify)
     apply (rule field_differentiable_transform_within [where f = "\<lambda>z. (f z - f a)/(z - a)" and d = 1])
     apply (rule derivative_intros | force)+
     done
 qed
 
 lemma pole_theorem_open:
   assumes holg: "g holomorphic_on S" and S: "open S"
       and eq: "\<And>z. z \<in> S - {a} \<Longrightarrow> g z = (z - a) * f z"
     shows "(\<lambda>z. if z = a then deriv g a
                  else f z - g a/(z - a)) holomorphic_on S"
   using pole_lemma_open [OF holg S]
   by (rule holomorphic_transform) (auto simp: eq divide_simps)
 
 lemma pole_theorem_0:
   assumes holg: "g holomorphic_on S" and a: "a \<in> interior S"
       and eq: "\<And>z. z \<in> S - {a} \<Longrightarrow> g z = (z - a) * f z"
       and [simp]: "f a = deriv g a" "g a = 0"
     shows "f holomorphic_on S"
   using pole_theorem [OF holg a eq]
   by (rule holomorphic_transform) (auto simp: eq field_split_simps)
 
 lemma pole_theorem_open_0:
   assumes holg: "g holomorphic_on S" and S: "open S"
       and eq: "\<And>z. z \<in> S - {a} \<Longrightarrow> g z = (z - a) * f z"
       and [simp]: "f a = deriv g a" "g a = 0"
     shows "f holomorphic_on S"
   using pole_theorem_open [OF holg S eq]
   by (rule holomorphic_transform) (auto simp: eq field_split_simps)
 
 lemma pole_theorem_analytic:
   assumes g: "g analytic_on S"
       and eq: "\<And>z. z \<in> S
              \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>w \<in> ball z d - {a}. g w = (w - a) * f w)"
     shows "(\<lambda>z. if z = a then deriv g a else f z - g a/(z - a)) analytic_on S" (is "?F analytic_on S")
   unfolding analytic_on_def
 proof
   fix x
   assume "x \<in> S"
   with g obtain e where "0 < e" and e: "g holomorphic_on ball x e"
     by (auto simp add: analytic_on_def)
   obtain d where "0 < d" and d: "\<And>w. w \<in> ball x d - {a} \<Longrightarrow> g w = (w - a) * f w"
     using \<open>x \<in> S\<close> eq by blast
   have "?F holomorphic_on ball x (min d e)"
     using d e \<open>x \<in> S\<close> by (fastforce simp: holomorphic_on_subset subset_ball intro!: pole_theorem_open)
   then show "\<exists>e>0. ?F holomorphic_on ball x e"
     using \<open>0 < d\<close> \<open>0 < e\<close> not_le by fastforce
 qed
 
 lemma pole_theorem_analytic_0:
   assumes g: "g analytic_on S"
       and eq: "\<And>z. z \<in> S \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>w \<in> ball z d - {a}. g w = (w - a) * f w)"
       and [simp]: "f a = deriv g a" "g a = 0"
     shows "f analytic_on S"
 proof -
   have [simp]: "(\<lambda>z. if z = a then deriv g a else f z - g a / (z - a)) = f"
     by auto
   show ?thesis
     using pole_theorem_analytic [OF g eq] by simp
 qed
 
 lemma pole_theorem_analytic_open_superset:
   assumes g: "g analytic_on S" and "S \<subseteq> T" "open T"
       and eq: "\<And>z. z \<in> T - {a} \<Longrightarrow> g z = (z - a) * f z"
     shows "(\<lambda>z. if z = a then deriv g a
                  else f z - g a/(z - a)) analytic_on S"
 proof (rule pole_theorem_analytic [OF g])
   fix z
   assume "z \<in> S"
   then obtain e where "0 < e" and e: "ball z e \<subseteq> T"
     using assms openE by blast
   then show "\<exists>d>0. \<forall>w\<in>ball z d - {a}. g w = (w - a) * f w"
     using eq by auto
 qed
 
 lemma pole_theorem_analytic_open_superset_0:
   assumes g: "g analytic_on S" "S \<subseteq> T" "open T" "\<And>z. z \<in> T - {a} \<Longrightarrow> g z = (z - a) * f z"
       and [simp]: "f a = deriv g a" "g a = 0"
     shows "f analytic_on S"
 proof -
   have [simp]: "(\<lambda>z. if z = a then deriv g a else f z - g a / (z - a)) = f"
     by auto
   have "(\<lambda>z. if z = a then deriv g a else f z - g a/(z - a)) analytic_on S"
     by (rule pole_theorem_analytic_open_superset [OF g])
   then show ?thesis by simp
 qed
 
 
 subsection\<open>General, homology form of Cauchy's theorem\<close>
 
 text\<open>Proof is based on Dixon's, as presented in Lang's "Complex Analysis" book (page 147).\<close>
 
 lemma contour_integral_continuous_on_linepath_2D:
   assumes "open U" and cont_dw: "\<And>w. w \<in> U \<Longrightarrow> F w contour_integrable_on (linepath a b)"
       and cond_uu: "continuous_on (U \<times> U) (\<lambda>(x,y). F x y)"
       and abu: "closed_segment a b \<subseteq> U"
     shows "continuous_on U (\<lambda>w. contour_integral (linepath a b) (F w))"
 proof -
   have *: "\<exists>d>0. \<forall>x'\<in>U. dist x' w < d \<longrightarrow>
                          dist (contour_integral (linepath a b) (F x'))
                               (contour_integral (linepath a b) (F w)) \<le> \<epsilon>"
           if "w \<in> U" "0 < \<epsilon>" "a \<noteq> b" for w \<epsilon>
   proof -
     obtain \<delta> where "\<delta>>0" and \<delta>: "cball w \<delta> \<subseteq> U" using open_contains_cball \<open>open U\<close> \<open>w \<in> U\<close> by force
     let ?TZ = "cball w \<delta>  \<times> closed_segment a b"
     have "uniformly_continuous_on ?TZ (\<lambda>(x,y). F x y)"
     proof (rule compact_uniformly_continuous)
       show "continuous_on ?TZ (\<lambda>(x,y). F x y)"
         by (rule continuous_on_subset[OF cond_uu]) (use SigmaE \<delta> abu in blast)
       show "compact ?TZ"
         by (simp add: compact_Times)
     qed
     then obtain \<eta> where "\<eta>>0"
         and \<eta>: "\<And>x x'. \<lbrakk>x\<in>?TZ; x'\<in>?TZ; dist x' x < \<eta>\<rbrakk> \<Longrightarrow>
                          dist ((\<lambda>(x,y). F x y) x') ((\<lambda>(x,y). F x y) x) < \<epsilon>/norm(b - a)"
       apply (rule uniformly_continuous_onE [where e = "\<epsilon>/norm(b - a)"])
       using \<open>0 < \<epsilon>\<close> \<open>a \<noteq> b\<close> by auto
     have \<eta>: "\<lbrakk>norm (w - x1) \<le> \<delta>;   x2 \<in> closed_segment a b;
               norm (w - x1') \<le> \<delta>;  x2' \<in> closed_segment a b; norm ((x1', x2') - (x1, x2)) < \<eta>\<rbrakk>
               \<Longrightarrow> norm (F x1' x2' - F x1 x2) \<le> \<epsilon> / cmod (b - a)"
              for x1 x2 x1' x2'
       using \<eta> [of "(x1,x2)" "(x1',x2')"] by (force simp: dist_norm)
     have le_ee: "cmod (contour_integral (linepath a b) (\<lambda>x. F x' x - F w x)) \<le> \<epsilon>"
                 if "x' \<in> U" "cmod (x' - w) < \<delta>" "cmod (x' - w) < \<eta>"  for x'
     proof -
       have "(\<lambda>x. F x' x - F w x) contour_integrable_on linepath a b"
         by (simp add: \<open>w \<in> U\<close> cont_dw contour_integrable_diff that)
       then have "cmod (contour_integral (linepath a b) (\<lambda>x. F x' x - F w x)) \<le> \<epsilon>/norm(b - a) * norm(b - a)"
         apply (rule has_contour_integral_bound_linepath [OF has_contour_integral_integral _ \<eta>])
         using \<open>0 < \<epsilon>\<close> \<open>0 < \<delta>\<close> that apply (auto simp: norm_minus_commute)
         done
       also have "\<dots> = \<epsilon>" using \<open>a \<noteq> b\<close> by simp
       finally show ?thesis .
     qed
     show ?thesis
       apply (rule_tac x="min \<delta> \<eta>" in exI)
       using \<open>0 < \<delta>\<close> \<open>0 < \<eta>\<close>
       apply (auto simp: dist_norm contour_integral_diff [OF cont_dw cont_dw, symmetric] \<open>w \<in> U\<close> intro: le_ee)
       done
   qed
   show ?thesis
   proof (cases "a=b")
     case True
     then show ?thesis by simp
   next
     case False
     show ?thesis
       by (rule continuous_onI) (use False in \<open>auto intro: *\<close>)
   qed
 qed
 
 text\<open>This version has \<^term>\<open>polynomial_function \<gamma>\<close> as an additional assumption.\<close>
 lemma Cauchy_integral_formula_global_weak:
   assumes "open U" and holf: "f holomorphic_on U"
         and z: "z \<in> U" and \<gamma>: "polynomial_function \<gamma>"
         and pasz: "path_image \<gamma> \<subseteq> U - {z}" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
         and zero: "\<And>w. w \<notin> U \<Longrightarrow> winding_number \<gamma> w = 0"
       shows "((\<lambda>w. f w / (w - z)) has_contour_integral (2*pi * \<i> * winding_number \<gamma> z * f z)) \<gamma>"
 proof -
   obtain \<gamma>' where pf\<gamma>': "polynomial_function \<gamma>'" and \<gamma>': "\<And>x. (\<gamma> has_vector_derivative (\<gamma>' x)) (at x)"
     using has_vector_derivative_polynomial_function [OF \<gamma>] by blast
   then have "bounded(path_image \<gamma>')"
     by (simp add: path_image_def compact_imp_bounded compact_continuous_image continuous_on_polymonial_function)
   then obtain B where "B>0" and B: "\<And>x. x \<in> path_image \<gamma>' \<Longrightarrow> norm x \<le> B"
     using bounded_pos by force
   define d where [abs_def]: "d z w = (if w = z then deriv f z else (f w - f z)/(w - z))" for z w
   define v where "v = {w. w \<notin> path_image \<gamma> \<and> winding_number \<gamma> w = 0}"
   have "path \<gamma>" "valid_path \<gamma>" using \<gamma>
     by (auto simp: path_polynomial_function valid_path_polynomial_function)
   then have ov: "open v"
     by (simp add: v_def open_winding_number_levelsets loop)
   have uv_Un: "U \<union> v = UNIV"
     using pasz zero by (auto simp: v_def)
   have conf: "continuous_on U f"
     by (metis holf holomorphic_on_imp_continuous_on)
   have hol_d: "(d y) holomorphic_on U" if "y \<in> U" for y
   proof -
     have *: "(\<lambda>c. if c = y then deriv f y else (f c - f y) / (c - y)) holomorphic_on U"
       by (simp add: holf pole_lemma_open \<open>open U\<close>)
     then have "isCont (\<lambda>x. if x = y then deriv f y else (f x - f y) / (x - y)) y"
       using at_within_open field_differentiable_imp_continuous_at holomorphic_on_def that \<open>open U\<close> by fastforce
     then have "continuous_on U (d y)"
       apply (simp add: d_def continuous_on_eq_continuous_at \<open>open U\<close>, clarify)
       using * holomorphic_on_def
       by (meson field_differentiable_within_open field_differentiable_imp_continuous_at \<open>open U\<close>)
     moreover have "d y holomorphic_on U - {y}"
     proof -
       have "\<And>w. w \<in> U - {y} \<Longrightarrow>
                  (\<lambda>w. if w = y then deriv f y else (f w - f y) / (w - y)) field_differentiable at w"
         apply (rule_tac d="dist w y" and f = "\<lambda>w. (f w - f y)/(w - y)" in field_differentiable_transform_within)
            apply (auto simp: dist_pos_lt dist_commute intro!: derivative_intros)
         using \<open>open U\<close> holf holomorphic_on_imp_differentiable_at by blast
       then show ?thesis
         unfolding field_differentiable_def by (simp add: d_def holomorphic_on_open \<open>open U\<close> open_delete)
     qed
     ultimately show ?thesis
       by (rule no_isolated_singularity) (auto simp: \<open>open U\<close>)
   qed
   have cint_fxy: "(\<lambda>x. (f x - f y) / (x - y)) contour_integrable_on \<gamma>" if "y \<notin> path_image \<gamma>" for y
   proof (rule contour_integrable_holomorphic_simple [where S = "U-{y}"])
     show "(\<lambda>x. (f x - f y) / (x - y)) holomorphic_on U - {y}"
       by (force intro: holomorphic_intros holomorphic_on_subset [OF holf])
     show "path_image \<gamma> \<subseteq> U - {y}"
       using pasz that by blast
   qed (auto simp: \<open>open U\<close> open_delete \<open>valid_path \<gamma>\<close>)
   define h where
     "h z = (if z \<in> U then contour_integral \<gamma> (d z) else contour_integral \<gamma> (\<lambda>w. f w/(w - z)))" for z
   have U: "((d z) has_contour_integral h z) \<gamma>" if "z \<in> U" for z
   proof -
     have "d z holomorphic_on U"
       by (simp add: hol_d that)
     with that show ?thesis
     apply (simp add: h_def)
       by (meson Diff_subset \<open>open U\<close> \<open>valid_path \<gamma>\<close> contour_integrable_holomorphic_simple has_contour_integral_integral pasz subset_trans)
   qed
   have V: "((\<lambda>w. f w / (w - z)) has_contour_integral h z) \<gamma>" if z: "z \<in> v" for z
   proof -
     have 0: "0 = (f z) * 2 * of_real (2 * pi) * \<i> * winding_number \<gamma> z"
       using v_def z by auto
     then have "((\<lambda>x. 1 / (x - z)) has_contour_integral 0) \<gamma>"
      using z v_def  has_contour_integral_winding_number [OF \<open>valid_path \<gamma>\<close>] by fastforce
     then have "((\<lambda>x. f z * (1 / (x - z))) has_contour_integral 0) \<gamma>"
       using has_contour_integral_lmul by fastforce
     then have "((\<lambda>x. f z / (x - z)) has_contour_integral 0) \<gamma>"
       by (simp add: field_split_simps)
     moreover have "((\<lambda>x. (f x - f z) / (x - z)) has_contour_integral contour_integral \<gamma> (d z)) \<gamma>"
       using z
       apply (auto simp: v_def)
       apply (metis (no_types, lifting) contour_integrable_eq d_def has_contour_integral_eq has_contour_integral_integral cint_fxy)
       done
     ultimately have *: "((\<lambda>x. f z / (x - z) + (f x - f z) / (x - z)) has_contour_integral (0 + contour_integral \<gamma> (d z))) \<gamma>"
       by (rule has_contour_integral_add)
     have "((\<lambda>w. f w / (w - z)) has_contour_integral contour_integral \<gamma> (d z)) \<gamma>"
             if  "z \<in> U"
       using * by (auto simp: divide_simps has_contour_integral_eq)
     moreover have "((\<lambda>w. f w / (w - z)) has_contour_integral contour_integral \<gamma> (\<lambda>w. f w / (w - z))) \<gamma>"
             if "z \<notin> U"
       apply (rule has_contour_integral_integral [OF contour_integrable_holomorphic_simple [where S=U]])
       using U pasz \<open>valid_path \<gamma>\<close> that
       apply (auto intro: holomorphic_on_imp_continuous_on hol_d)
        apply (rule continuous_intros conf holomorphic_intros holf assms | force)+
       done
     ultimately show ?thesis
       using z by (simp add: h_def)
   qed
   have znot: "z \<notin> path_image \<gamma>"
     using pasz by blast
   obtain d0 where "d0>0" and d0: "\<And>x y. x \<in> path_image \<gamma> \<Longrightarrow> y \<in> - U \<Longrightarrow> d0 \<le> dist x y"
     using separate_compact_closed [of "path_image \<gamma>" "-U"] pasz \<open>open U\<close>
     by (fastforce simp add: \<open>path \<gamma>\<close> compact_path_image)
   obtain dd where "0 < dd" and dd: "{y + k | y k. y \<in> path_image \<gamma> \<and> k \<in> ball 0 dd} \<subseteq> U"
     apply (rule that [of "d0/2"])
     using \<open>0 < d0\<close>
     apply (auto simp: dist_norm dest: d0)
     done
   have "\<And>x x'. \<lbrakk>x \<in> path_image \<gamma>; dist x x' * 2 < dd\<rbrakk> \<Longrightarrow> \<exists>y k. x' = y + k \<and> y \<in> path_image \<gamma> \<and> dist 0 k * 2 \<le> dd"
     apply (rule_tac x=x in exI)
     apply (rule_tac x="x'-x" in exI)
     apply (force simp: dist_norm)
     done
   then have 1: "path_image \<gamma> \<subseteq> interior {y + k |y k. y \<in> path_image \<gamma> \<and> k \<in> cball 0 (dd / 2)}"
     apply (clarsimp simp add: mem_interior)
     using \<open>0 < dd\<close>
     apply (rule_tac x="dd/2" in exI, auto)
     done
   obtain T where "compact T" and subt: "path_image \<gamma> \<subseteq> interior T" and T: "T \<subseteq> U"
     apply (rule that [OF _ 1])
     apply (fastforce simp add: \<open>valid_path \<gamma>\<close> compact_valid_path_image intro!: compact_sums)
     apply (rule order_trans [OF _ dd])
     using \<open>0 < dd\<close> by fastforce
   obtain L where "L>0"
            and L: "\<And>f B. \<lbrakk>f holomorphic_on interior T; \<And>z. z\<in>interior T \<Longrightarrow> cmod (f z) \<le> B\<rbrakk> \<Longrightarrow>
                          cmod (contour_integral \<gamma> f) \<le> L * B"
       using contour_integral_bound_exists [OF open_interior \<open>valid_path \<gamma>\<close> subt]
       by blast
   have "bounded(f ` T)"
     by (meson \<open>compact T\<close> compact_continuous_image compact_imp_bounded conf continuous_on_subset T)
   then obtain D where "D>0" and D: "\<And>x. x \<in> T \<Longrightarrow> norm (f x) \<le> D"
     by (auto simp: bounded_pos)
   obtain C where "C>0" and C: "\<And>x. x \<in> T \<Longrightarrow> norm x \<le> C"
     using \<open>compact T\<close> bounded_pos compact_imp_bounded by force
   have "dist (h y) 0 \<le> e" if "0 < e" and le: "D * L / e + C \<le> cmod y" for e y
   proof -
     have "D * L / e > 0"  using \<open>D>0\<close> \<open>L>0\<close> \<open>e>0\<close> by simp
     with le have ybig: "norm y > C" by force
     with C have "y \<notin> T"  by force
     then have ynot: "y \<notin> path_image \<gamma>"
       using subt interior_subset by blast
     have [simp]: "winding_number \<gamma> y = 0"
       apply (rule winding_number_zero_outside [of _ "cball 0 C"])
       using ybig interior_subset subt
       apply (force simp: loop \<open>path \<gamma>\<close> dist_norm intro!: C)+
       done
     have [simp]: "h y = contour_integral \<gamma> (\<lambda>w. f w/(w - y))"
       by (rule contour_integral_unique [symmetric]) (simp add: v_def ynot V)
     have holint: "(\<lambda>w. f w / (w - y)) holomorphic_on interior T"
       apply (rule holomorphic_on_divide)
       using holf holomorphic_on_subset interior_subset T apply blast
       apply (rule holomorphic_intros)+
       using \<open>y \<notin> T\<close> interior_subset by auto
     have leD: "cmod (f z / (z - y)) \<le> D * (e / L / D)" if z: "z \<in> interior T" for z
     proof -
       have "D * L / e + cmod z \<le> cmod y"
         using le C [of z] z using interior_subset by force
       then have DL2: "D * L / e \<le> cmod (z - y)"
         using norm_triangle_ineq2 [of y z] by (simp add: norm_minus_commute)
       have "cmod (f z / (z - y)) = cmod (f z) * inverse (cmod (z - y))"
         by (simp add: norm_mult norm_inverse Fields.field_class.field_divide_inverse)
       also have "\<dots> \<le> D * (e / L / D)"
         apply (rule mult_mono)
         using that D interior_subset apply blast
         using \<open>L>0\<close> \<open>e>0\<close> \<open>D>0\<close> DL2
-        apply (auto simp: norm_divide field_split_simps algebra_simps)
+        apply (auto simp: norm_divide field_split_simps)
         done
       finally show ?thesis .
     qed
     have "dist (h y) 0 = cmod (contour_integral \<gamma> (\<lambda>w. f w / (w - y)))"
       by (simp add: dist_norm)
     also have "\<dots> \<le> L * (D * (e / L / D))"
       by (rule L [OF holint leD])
     also have "\<dots> = e"
       using  \<open>L>0\<close> \<open>0 < D\<close> by auto
     finally show ?thesis .
   qed
   then have "(h \<longlongrightarrow> 0) at_infinity"
     by (meson Lim_at_infinityI)
   moreover have "h holomorphic_on UNIV"
   proof -
     have con_ff: "continuous (at (x,z)) (\<lambda>(x,y). (f y - f x) / (y - x))"
                  if "x \<in> U" "z \<in> U" "x \<noteq> z" for x z
       using that conf
       apply (simp add: split_def continuous_on_eq_continuous_at \<open>open U\<close>)
       apply (simp | rule continuous_intros continuous_within_compose2 [where g=f])+
       done
     have con_fstsnd: "continuous_on UNIV (\<lambda>x. (fst x - snd x) ::complex)"
       by (rule continuous_intros)+
     have open_uu_Id: "open (U \<times> U - Id)"
       apply (rule open_Diff)
       apply (simp add: open_Times \<open>open U\<close>)
       using continuous_closed_preimage_constant [OF con_fstsnd closed_UNIV, of 0]
       apply (auto simp: Id_fstsnd_eq algebra_simps)
       done
     have con_derf: "continuous (at z) (deriv f)" if "z \<in> U" for z
       apply (rule continuous_on_interior [of U])
       apply (simp add: holf holomorphic_deriv holomorphic_on_imp_continuous_on \<open>open U\<close>)
       by (simp add: interior_open that \<open>open U\<close>)
     have tendsto_f': "((\<lambda>(x,y). if y = x then deriv f (x)
                                 else (f (y) - f (x)) / (y - x)) \<longlongrightarrow> deriv f x)
                       (at (x, x) within U \<times> U)" if "x \<in> U" for x
     proof (rule Lim_withinI)
       fix e::real assume "0 < e"
       obtain k1 where "k1>0" and k1: "\<And>x'. norm (x' - x) \<le> k1 \<Longrightarrow> norm (deriv f x' - deriv f x) < e"
         using \<open>0 < e\<close> continuous_within_E [OF con_derf [OF \<open>x \<in> U\<close>]]
         by (metis UNIV_I dist_norm)
       obtain k2 where "k2>0" and k2: "ball x k2 \<subseteq> U"
         by (blast intro: openE [OF \<open>open U\<close>] \<open>x \<in> U\<close>)
       have neq: "norm ((f z' - f x') / (z' - x') - deriv f x) \<le> e"
                     if "z' \<noteq> x'" and less_k1: "norm (x'-x, z'-x) < k1" and less_k2: "norm (x'-x, z'-x) < k2"
                  for x' z'
       proof -
         have cs_less: "w \<in> closed_segment x' z' \<Longrightarrow> cmod (w - x) \<le> norm (x'-x, z'-x)" for w
           apply (drule segment_furthest_le [where y=x])
           by (metis (no_types) dist_commute dist_norm norm_fst_le norm_snd_le order_trans)
         have derf_le: "w \<in> closed_segment x' z' \<Longrightarrow> z' \<noteq> x' \<Longrightarrow> cmod (deriv f w - deriv f x) \<le> e" for w
           by (blast intro: cs_less less_k1 k1 [unfolded divide_const_simps dist_norm] less_imp_le le_less_trans)
         have f_has_der: "\<And>x. x \<in> U \<Longrightarrow> (f has_field_derivative deriv f x) (at x within U)"
           by (metis DERIV_deriv_iff_field_differentiable at_within_open holf holomorphic_on_def \<open>open U\<close>)
         have "closed_segment x' z' \<subseteq> U"
           by (rule order_trans [OF _ k2]) (simp add: cs_less  le_less_trans [OF _ less_k2] dist_complex_def norm_minus_commute subset_iff)
         then have cint_derf: "(deriv f has_contour_integral f z' - f x') (linepath x' z')"
           using contour_integral_primitive [OF f_has_der valid_path_linepath] pasz  by simp
         then have *: "((\<lambda>x. deriv f x / (z' - x')) has_contour_integral (f z' - f x') / (z' - x')) (linepath x' z')"
           by (rule has_contour_integral_div)
         have "norm ((f z' - f x') / (z' - x') - deriv f x) \<le> e/norm(z' - x') * norm(z' - x')"
           apply (rule has_contour_integral_bound_linepath [OF has_contour_integral_diff [OF *]])
           using has_contour_integral_div [where c = "z' - x'", OF has_contour_integral_const_linepath [of "deriv f x" z' x']]
                  \<open>e > 0\<close>  \<open>z' \<noteq> x'\<close>
           apply (auto simp: norm_divide divide_simps derf_le)
           done
         also have "\<dots> \<le> e" using \<open>0 < e\<close> by simp
         finally show ?thesis .
       qed
       show "\<exists>d>0. \<forall>xa\<in>U \<times> U.
                   0 < dist xa (x, x) \<and> dist xa (x, x) < d \<longrightarrow>
                   dist (case xa of (x, y) \<Rightarrow> if y = x then deriv f x else (f y - f x) / (y - x)) (deriv f x) \<le> e"
         apply (rule_tac x="min k1 k2" in exI)
         using \<open>k1>0\<close> \<open>k2>0\<close> \<open>e>0\<close>
         apply (force simp: dist_norm neq intro: dual_order.strict_trans2 k1 less_imp_le norm_fst_le)
         done
     qed
     have con_pa_f: "continuous_on (path_image \<gamma>) f"
       by (meson holf holomorphic_on_imp_continuous_on holomorphic_on_subset interior_subset subt T)
     have le_B: "\<And>T. T \<in> {0..1} \<Longrightarrow> cmod (vector_derivative \<gamma> (at T)) \<le> B"
       apply (rule B)
       using \<gamma>' using path_image_def vector_derivative_at by fastforce
     have f_has_cint: "\<And>w. w \<in> v - path_image \<gamma> \<Longrightarrow> ((\<lambda>u. f u / (u - w) ^ 1) has_contour_integral h w) \<gamma>"
       by (simp add: V)
     have cond_uu: "continuous_on (U \<times> U) (\<lambda>(x,y). d x y)"
       apply (simp add: continuous_on_eq_continuous_within d_def continuous_within tendsto_f')
       apply (simp add: tendsto_within_open_NO_MATCH open_Times \<open>open U\<close>, clarify)
       apply (rule Lim_transform_within_open [OF _ open_uu_Id, where f = "(\<lambda>(x,y). (f y - f x) / (y - x))"])
       using con_ff
       apply (auto simp: continuous_within)
       done
     have hol_dw: "(\<lambda>z. d z w) holomorphic_on U" if "w \<in> U" for w
     proof -
       have "continuous_on U ((\<lambda>(x,y). d x y) \<circ> (\<lambda>z. (w,z)))"
         by (rule continuous_on_compose continuous_intros continuous_on_subset [OF cond_uu] | force intro: that)+
       then have *: "continuous_on U (\<lambda>z. if w = z then deriv f z else (f w - f z) / (w - z))"
         by (rule rev_iffD1 [OF _ continuous_on_cong [OF refl]]) (simp add: d_def field_simps)
       have **: "\<And>x. \<lbrakk>x \<in> U; x \<noteq> w\<rbrakk> \<Longrightarrow> (\<lambda>z. if w = z then deriv f z else (f w - f z) / (w - z)) field_differentiable at x"
         apply (rule_tac f = "\<lambda>x. (f w - f x)/(w - x)" and d = "dist x w" in field_differentiable_transform_within)
         apply (rule \<open>open U\<close> derivative_intros holomorphic_on_imp_differentiable_at [OF holf] | force simp: dist_commute)+
         done
       show ?thesis
         unfolding d_def
         apply (rule no_isolated_singularity [OF * _ \<open>open U\<close>, where K = "{w}"])
         apply (auto simp: field_differentiable_def [symmetric] holomorphic_on_open open_Diff \<open>open U\<close> **)
         done
     qed
     { fix a b
       assume abu: "closed_segment a b \<subseteq> U"
       then have "\<And>w. w \<in> U \<Longrightarrow> (\<lambda>z. d z w) contour_integrable_on (linepath a b)"
         by (metis hol_dw continuous_on_subset contour_integrable_continuous_linepath holomorphic_on_imp_continuous_on)
       then have cont_cint_d: "continuous_on U (\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w))"
         apply (rule contour_integral_continuous_on_linepath_2D [OF \<open>open U\<close> _ _ abu])
         apply (auto intro: continuous_on_swap_args cond_uu)
         done
       have cont_cint_d\<gamma>: "continuous_on {0..1} ((\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w)) \<circ> \<gamma>)"
       proof (rule continuous_on_compose)
         show "continuous_on {0..1} \<gamma>"
           using \<open>path \<gamma>\<close> path_def by blast
         show "continuous_on (\<gamma> ` {0..1}) (\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w))"
           using pasz unfolding path_image_def
           by (auto intro!: continuous_on_subset [OF cont_cint_d])
       qed
       have cint_cint: "(\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w)) contour_integrable_on \<gamma>"
         apply (simp add: contour_integrable_on)
         apply (rule integrable_continuous_real)
         apply (rule continuous_on_mult [OF cont_cint_d\<gamma> [unfolded o_def]])
         using pf\<gamma>'
         by (simp add: continuous_on_polymonial_function vector_derivative_at [OF \<gamma>'])
       have "contour_integral (linepath a b) h = contour_integral (linepath a b) (\<lambda>z. contour_integral \<gamma> (d z))"
         using abu  by (force simp: h_def intro: contour_integral_eq)
       also have "\<dots> =  contour_integral \<gamma> (\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w))"
         apply (rule contour_integral_swap)
         apply (rule continuous_on_subset [OF cond_uu])
         using abu pasz \<open>valid_path \<gamma>\<close>
         apply (auto intro!: continuous_intros)
         by (metis \<gamma>' continuous_on_eq path_def path_polynomial_function pf\<gamma>' vector_derivative_at)
       finally have cint_h_eq:
           "contour_integral (linepath a b) h =
                     contour_integral \<gamma> (\<lambda>w. contour_integral (linepath a b) (\<lambda>z. d z w))" .
       note cint_cint cint_h_eq
     } note cint_h = this
     have conthu: "continuous_on U h"
     proof (simp add: continuous_on_sequentially, clarify)
       fix a x
       assume x: "x \<in> U" and au: "\<forall>n. a n \<in> U" and ax: "a \<longlonglongrightarrow> x"
       then have A1: "\<forall>\<^sub>F n in sequentially. d (a n) contour_integrable_on \<gamma>"
         by (meson U contour_integrable_on_def eventuallyI)
       obtain dd where "dd>0" and dd: "cball x dd \<subseteq> U" using open_contains_cball \<open>open U\<close> x by force
       have A2: "uniform_limit (path_image \<gamma>) (\<lambda>n. d (a n)) (d x) sequentially"
         unfolding uniform_limit_iff dist_norm
       proof clarify
         fix ee::real
         assume "0 < ee"
         show "\<forall>\<^sub>F n in sequentially. \<forall>\<xi>\<in>path_image \<gamma>. cmod (d (a n) \<xi> - d x \<xi>) < ee"
         proof -
           let ?ddpa = "{(w,z) |w z. w \<in> cball x dd \<and> z \<in> path_image \<gamma>}"
           have "uniformly_continuous_on ?ddpa (\<lambda>(x,y). d x y)"
             apply (rule compact_uniformly_continuous [OF continuous_on_subset[OF cond_uu]])
             using dd pasz \<open>valid_path \<gamma>\<close>
              apply (auto simp: compact_Times compact_valid_path_image simp del: mem_cball)
             done
           then obtain kk where "kk>0"
             and kk: "\<And>x x'. \<lbrakk>x \<in> ?ddpa; x' \<in> ?ddpa; dist x' x < kk\<rbrakk> \<Longrightarrow>
                              dist ((\<lambda>(x,y). d x y) x') ((\<lambda>(x,y). d x y) x) < ee"
             by (rule uniformly_continuous_onE [where e = ee]) (use \<open>0 < ee\<close> in auto)
           have kk: "\<lbrakk>norm (w - x) \<le> dd; z \<in> path_image \<gamma>; norm ((w, z) - (x, z)) < kk\<rbrakk> \<Longrightarrow> norm (d w z - d x z) < ee"
             for  w z
             using \<open>dd>0\<close> kk [of "(x,z)" "(w,z)"] by (force simp: norm_minus_commute dist_norm)
           show ?thesis
             using ax unfolding lim_sequentially eventually_sequentially
             apply (drule_tac x="min dd kk" in spec)
             using \<open>dd > 0\<close> \<open>kk > 0\<close>
             apply (fastforce simp: kk dist_norm)
             done
         qed
       qed
       have "(\<lambda>n. contour_integral \<gamma> (d (a n))) \<longlonglongrightarrow> contour_integral \<gamma> (d x)"
         by (rule contour_integral_uniform_limit [OF A1 A2 le_B]) (auto simp: \<open>valid_path \<gamma>\<close>)
       then have tendsto_hx: "(\<lambda>n. contour_integral \<gamma> (d (a n))) \<longlonglongrightarrow> h x"
         by (simp add: h_def x)
       then show "(h \<circ> a) \<longlonglongrightarrow> h x"
         by (simp add: h_def x au o_def)
     qed
     show ?thesis
     proof (simp add: holomorphic_on_open field_differentiable_def [symmetric], clarify)
       fix z0
       consider "z0 \<in> v" | "z0 \<in> U" using uv_Un by blast
       then show "h field_differentiable at z0"
       proof cases
         assume "z0 \<in> v" then show ?thesis
           using Cauchy_next_derivative [OF con_pa_f le_B f_has_cint _ ov] V f_has_cint \<open>valid_path \<gamma>\<close>
           by (auto simp: field_differentiable_def v_def)
       next
         assume "z0 \<in> U" then
         obtain e where "e>0" and e: "ball z0 e \<subseteq> U" by (blast intro: openE [OF \<open>open U\<close>])
         have *: "contour_integral (linepath a b) h + contour_integral (linepath b c) h + contour_integral (linepath c a) h = 0"
                 if abc_subset: "convex hull {a, b, c} \<subseteq> ball z0 e"  for a b c
         proof -
           have *: "\<And>x1 x2 z. z \<in> U \<Longrightarrow> closed_segment x1 x2 \<subseteq> U \<Longrightarrow> (\<lambda>w. d w z) contour_integrable_on linepath x1 x2"
             using  hol_dw holomorphic_on_imp_continuous_on \<open>open U\<close>
             by (auto intro!: contour_integrable_holomorphic_simple)
           have abc: "closed_segment a b \<subseteq> U"  "closed_segment b c \<subseteq> U"  "closed_segment c a \<subseteq> U"
             using that e segments_subset_convex_hull by fastforce+
           have eq0: "\<And>w. w \<in> U \<Longrightarrow> contour_integral (linepath a b +++ linepath b c +++ linepath c a) (\<lambda>z. d z w) = 0"
             apply (rule contour_integral_unique [OF Cauchy_theorem_triangle])
             apply (rule holomorphic_on_subset [OF hol_dw])
             using e abc_subset by auto
           have "contour_integral \<gamma>
                    (\<lambda>x. contour_integral (linepath a b) (\<lambda>z. d z x) +
                         (contour_integral (linepath b c) (\<lambda>z. d z x) +
                          contour_integral (linepath c a) (\<lambda>z. d z x)))  =  0"
             apply (rule contour_integral_eq_0)
             using abc pasz U
             apply (subst contour_integral_join [symmetric], auto intro: eq0 *)+
             done
           then show ?thesis
             by (simp add: cint_h abc contour_integrable_add contour_integral_add [symmetric] add_ac)
         qed
         show ?thesis
           using e \<open>e > 0\<close>
           by (auto intro!: holomorphic_on_imp_differentiable_at [OF _ open_ball] analytic_imp_holomorphic
                            Morera_triangle continuous_on_subset [OF conthu] *)
       qed
     qed
   qed
   ultimately have [simp]: "h z = 0" for z
     by (meson Liouville_weak)
   have "((\<lambda>w. 1 / (w - z)) has_contour_integral complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z) \<gamma>"
     by (rule has_contour_integral_winding_number [OF \<open>valid_path \<gamma>\<close> znot])
   then have "((\<lambda>w. f z * (1 / (w - z))) has_contour_integral complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z * f z) \<gamma>"
     by (metis mult.commute has_contour_integral_lmul)
   then have 1: "((\<lambda>w. f z / (w - z)) has_contour_integral complex_of_real (2 * pi) * \<i> * winding_number \<gamma> z * f z) \<gamma>"
     by (simp add: field_split_simps)
   moreover have 2: "((\<lambda>w. (f w - f z) / (w - z)) has_contour_integral 0) \<gamma>"
     using U [OF z] pasz d_def by (force elim: has_contour_integral_eq [where g = "\<lambda>w. (f w - f z)/(w - z)"])
   show ?thesis
     using has_contour_integral_add [OF 1 2]  by (simp add: diff_divide_distrib)
 qed
 
 theorem Cauchy_integral_formula_global:
     assumes S: "open S" and holf: "f holomorphic_on S"
         and z: "z \<in> S" and vpg: "valid_path \<gamma>"
         and pasz: "path_image \<gamma> \<subseteq> S - {z}" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
         and zero: "\<And>w. w \<notin> S \<Longrightarrow> winding_number \<gamma> w = 0"
       shows "((\<lambda>w. f w / (w - z)) has_contour_integral (2*pi * \<i> * winding_number \<gamma> z * f z)) \<gamma>"
 proof -
   have "path \<gamma>" using vpg by (blast intro: valid_path_imp_path)
   have hols: "(\<lambda>w. f w / (w - z)) holomorphic_on S - {z}" "(\<lambda>w. 1 / (w - z)) holomorphic_on S - {z}"
     by (rule holomorphic_intros holomorphic_on_subset [OF holf] | force)+
   then have cint_fw: "(\<lambda>w. f w / (w - z)) contour_integrable_on \<gamma>"
     by (meson contour_integrable_holomorphic_simple holomorphic_on_imp_continuous_on open_delete S vpg pasz)
   obtain d where "d>0"
       and d: "\<And>g h. \<lbrakk>valid_path g; valid_path h; \<forall>t\<in>{0..1}. cmod (g t - \<gamma> t) < d \<and> cmod (h t - \<gamma> t) < d;
                      pathstart h = pathstart g \<and> pathfinish h = pathfinish g\<rbrakk>
                      \<Longrightarrow> path_image h \<subseteq> S - {z} \<and> (\<forall>f. f holomorphic_on S - {z} \<longrightarrow> contour_integral h f = contour_integral g f)"
     using contour_integral_nearby_ends [OF _ \<open>path \<gamma>\<close> pasz] S by (simp add: open_Diff) metis
   obtain p where polyp: "polynomial_function p"
              and ps: "pathstart p = pathstart \<gamma>" and pf: "pathfinish p = pathfinish \<gamma>" and led: "\<forall>t\<in>{0..1}. cmod (p t - \<gamma> t) < d"
     using path_approx_polynomial_function [OF \<open>path \<gamma>\<close> \<open>d > 0\<close>] by blast
   then have ploop: "pathfinish p = pathstart p" using loop by auto
   have vpp: "valid_path p"  using polyp valid_path_polynomial_function by blast
   have [simp]: "z \<notin> path_image \<gamma>" using pasz by blast
   have paps: "path_image p \<subseteq> S - {z}" and cint_eq: "(\<And>f. f holomorphic_on S - {z} \<Longrightarrow> contour_integral p f = contour_integral \<gamma> f)"
     using pf ps led d [OF vpg vpp] \<open>d > 0\<close> by auto
   have wn_eq: "winding_number p z = winding_number \<gamma> z"
     using vpp paps
     by (simp add: subset_Diff_insert vpg valid_path_polynomial_function winding_number_valid_path cint_eq hols)
   have "winding_number p w = winding_number \<gamma> w" if "w \<notin> S" for w
   proof -
     have hol: "(\<lambda>v. 1 / (v - w)) holomorphic_on S - {z}"
       using that by (force intro: holomorphic_intros holomorphic_on_subset [OF holf])
    have "w \<notin> path_image p" "w \<notin> path_image \<gamma>" using paps pasz that by auto
    then show ?thesis
     using vpp vpg by (simp add: subset_Diff_insert valid_path_polynomial_function winding_number_valid_path cint_eq [OF hol])
   qed
   then have wn0: "\<And>w. w \<notin> S \<Longrightarrow> winding_number p w = 0"
     by (simp add: zero)
   show ?thesis
     using Cauchy_integral_formula_global_weak [OF S holf z polyp paps ploop wn0] hols
     by (metis wn_eq cint_eq has_contour_integral_eqpath cint_fw cint_eq)
 qed
 
 theorem Cauchy_theorem_global:
     assumes S: "open S" and holf: "f holomorphic_on S"
         and vpg: "valid_path \<gamma>" and loop: "pathfinish \<gamma> = pathstart \<gamma>"
         and pas: "path_image \<gamma> \<subseteq> S"
         and zero: "\<And>w. w \<notin> S \<Longrightarrow> winding_number \<gamma> w = 0"
       shows "(f has_contour_integral 0) \<gamma>"
 proof -
   obtain z where "z \<in> S" and znot: "z \<notin> path_image \<gamma>"
   proof -
     have "compact (path_image \<gamma>)"
       using compact_valid_path_image vpg by blast
     then have "path_image \<gamma> \<noteq> S"
       by (metis (no_types) compact_open path_image_nonempty S)
     with pas show ?thesis by (blast intro: that)
   qed
   then have pasz: "path_image \<gamma> \<subseteq> S - {z}" using pas by blast
   have hol: "(\<lambda>w. (w - z) * f w) holomorphic_on S"
     by (rule holomorphic_intros holf)+
   show ?thesis
     using Cauchy_integral_formula_global [OF S hol \<open>z \<in> S\<close> vpg pasz loop zero]
     by (auto simp: znot elim!: has_contour_integral_eq)
 qed
 
 corollary Cauchy_theorem_global_outside:
     assumes "open S" "f holomorphic_on S" "valid_path \<gamma>"  "pathfinish \<gamma> = pathstart \<gamma>" "path_image \<gamma> \<subseteq> S"
             "\<And>w. w \<notin> S \<Longrightarrow> w \<in> outside(path_image \<gamma>)"
       shows "(f has_contour_integral 0) \<gamma>"
 by (metis Cauchy_theorem_global assms winding_number_zero_in_outside valid_path_imp_path)
 
 lemma simply_connected_imp_winding_number_zero:
   assumes "simply_connected S" "path g"
            "path_image g \<subseteq> S" "pathfinish g = pathstart g" "z \<notin> S"
     shows "winding_number g z = 0"
 proof -
   have hom: "homotopic_loops S g (linepath (pathstart g) (pathstart g))"
     by (meson assms homotopic_paths_imp_homotopic_loops pathfinish_linepath simply_connected_eq_contractible_path)
   then have "homotopic_paths (- {z}) g (linepath (pathstart g) (pathstart g))"
     by (meson \<open>z \<notin> S\<close> homotopic_loops_imp_homotopic_paths_null homotopic_paths_subset subset_Compl_singleton)
   then have "winding_number g z = winding_number(linepath (pathstart g) (pathstart g)) z"
     by (rule winding_number_homotopic_paths)
   also have "\<dots> = 0"
     using assms by (force intro: winding_number_trivial)
   finally show ?thesis .
 qed
 
 lemma Cauchy_theorem_simply_connected:
   assumes "open S" "simply_connected S" "f holomorphic_on S" "valid_path g"
            "path_image g \<subseteq> S" "pathfinish g = pathstart g"
     shows "(f has_contour_integral 0) g"
 using assms
 apply (simp add: simply_connected_eq_contractible_path)
 apply (auto intro!: Cauchy_theorem_null_homotopic [where a = "pathstart g"]
                          homotopic_paths_imp_homotopic_loops)
 using valid_path_imp_path by blast
 
 proposition\<^marker>\<open>tag unimportant\<close> holomorphic_logarithm_exists:
   assumes A: "convex A" "open A"
       and f: "f holomorphic_on A" "\<And>x. x \<in> A \<Longrightarrow> f x \<noteq> 0"
       and z0: "z0 \<in> A"
     obtains g where "g holomorphic_on A" and "\<And>x. x \<in> A \<Longrightarrow> exp (g x) = f x"
 proof -
   note f' = holomorphic_derivI [OF f(1) A(2)]
   obtain g where g: "\<And>x. x \<in> A \<Longrightarrow> (g has_field_derivative deriv f x / f x) (at x)"
   proof (rule holomorphic_convex_primitive' [OF A])
     show "(\<lambda>x. deriv f x / f x) holomorphic_on A"
       by (intro holomorphic_intros f A)
   qed (auto simp: A at_within_open[of _ A])
   define h where "h = (\<lambda>x. -g z0 + ln (f z0) + g x)"
   from g and A have g_holo: "g holomorphic_on A"
     by (auto simp: holomorphic_on_def at_within_open[of _ A] field_differentiable_def)
   hence h_holo: "h holomorphic_on A"
     by (auto simp: h_def intro!: holomorphic_intros)
   have "\<exists>c. \<forall>x\<in>A. f x / exp (h x) - 1 = c"
   proof (rule has_field_derivative_zero_constant, goal_cases)
     case (2 x)
     note [simp] = at_within_open[OF _ \<open>open A\<close>]
     from 2 and z0 and f show ?case
       by (auto simp: h_def exp_diff field_simps intro!: derivative_eq_intros g f')
   qed fact+
   then obtain c where c: "\<And>x. x \<in> A \<Longrightarrow> f x / exp (h x) - 1 = c"
     by blast
   from c[OF z0] and z0 and f have "c = 0"
     by (simp add: h_def)
   with c have "\<And>x. x \<in> A \<Longrightarrow> exp (h x) = f x" by simp
   from that[OF h_holo this] show ?thesis .
 qed
 
 end
diff --git a/src/HOL/Analysis/Change_Of_Vars.thy b/src/HOL/Analysis/Change_Of_Vars.thy
--- a/src/HOL/Analysis/Change_Of_Vars.thy
+++ b/src/HOL/Analysis/Change_Of_Vars.thy
@@ -1,3474 +1,3474 @@
 (*  Title:      HOL/Analysis/Change_Of_Vars.thy
     Authors:    LC Paulson, based on material from HOL Light
 *)
 
 section\<open>Change of Variables Theorems\<close>
 
 theory Change_Of_Vars
   imports Vitali_Covering_Theorem Determinants
 
 begin
 
 subsection \<open>Measurable Shear and Stretch\<close>
 
 proposition
   fixes a :: "real^'n"
   assumes "m \<noteq> n" and ab_ne: "cbox a b \<noteq> {}" and an: "0 \<le> a$n"
   shows measurable_shear_interval: "(\<lambda>x. \<chi> i. if i = m then x$m + x$n else x$i) ` (cbox a b) \<in> lmeasurable"
        (is  "?f ` _ \<in> _")
    and measure_shear_interval: "measure lebesgue ((\<lambda>x. \<chi> i. if i = m then x$m + x$n else x$i) ` cbox a b)
                = measure lebesgue (cbox a b)" (is "?Q")
 proof -
   have lin: "linear ?f"
     by (rule linearI) (auto simp: plus_vec_def scaleR_vec_def algebra_simps)
   show fab: "?f ` cbox a b \<in> lmeasurable"
     by (simp add: lin measurable_linear_image_interval)
   let ?c = "\<chi> i. if i = m then b$m + b$n else b$i"
   let ?mn = "axis m 1 - axis n (1::real)"
   have eq1: "measure lebesgue (cbox a ?c)
             = measure lebesgue (?f ` cbox a b)
             + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m})
             + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})"
   proof (rule measure_Un3_negligible)
     show "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m} \<in> lmeasurable" "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} \<in> lmeasurable"
       by (auto simp: convex_Int convex_halfspace_le convex_halfspace_ge bounded_Int measurable_convex)
     have "negligible {x. ?mn \<bullet> x = a$m}"
       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
     moreover have "?f ` cbox a b \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}) \<subseteq> {x. ?mn \<bullet> x = a$m}"
       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
     ultimately show "negligible ((?f ` cbox a b) \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}))"
       by (rule negligible_subset)
     have "negligible {x. ?mn \<bullet> x = b$m}"
       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
     moreover have "(?f ` cbox a b) \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}) \<subseteq> {x. ?mn \<bullet> x = b$m}"
       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
     ultimately show "negligible (?f ` cbox a b \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}))"
       by (rule negligible_subset)
     have "negligible {x. ?mn \<bullet> x = b$m}"
       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
     moreover have "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})) \<subseteq> {x. ?mn \<bullet> x = b$m}"
       using \<open>m \<noteq> n\<close> ab_ne
       apply (auto simp: algebra_simps mem_box_cart inner_axis')
       apply (drule_tac x=m in spec)+
       apply simp
       done
     ultimately show "negligible (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter> (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}))"
       by (rule negligible_subset)
     show "?f ` cbox a b \<union> cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<union> cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} = cbox a ?c" (is "?lhs = _")
     proof
       show "?lhs \<subseteq> cbox a ?c"
         by (auto simp: mem_box_cart add_mono) (meson add_increasing2 an order_trans)
       show "cbox a ?c \<subseteq> ?lhs"
         apply (auto simp: algebra_simps image_iff inner_axis' lambda_add_Galois [OF \<open>m \<noteq> n\<close>])
         apply (auto simp: mem_box_cart split: if_split_asm)
         done
     qed
   qed (fact fab)
   let ?d = "\<chi> i. if i = m then a $ m - b $ m else 0"
   have eq2: "measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m}) + measure lebesgue (cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m})
            = measure lebesgue (cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i))"
   proof (rule measure_translate_add[of "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m}" "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m}"
      "(\<chi> i. if i = m then a$m - b$m else 0)" "cbox a (\<chi> i. if i = m then a$m + b$n else b$i)"])
     show "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a$m}) \<in> lmeasurable"
       "cbox a ?c \<inter> {x. ?mn \<bullet> x \<ge> b$m} \<in> lmeasurable"
       by (auto simp: convex_Int convex_halfspace_le convex_halfspace_ge bounded_Int measurable_convex)
     have "\<And>x. \<lbrakk>x $ n + a $ m \<le> x $ m\<rbrakk>
          \<Longrightarrow> x \<in> (+) (\<chi> i. if i = m then a $ m - b $ m else 0) ` {x. x $ n + b $ m \<le> x $ m}"
       using \<open>m \<noteq> n\<close>
       by (rule_tac x="x - (\<chi> i. if i = m then a$m - b$m else 0)" in image_eqI)
          (simp_all add: mem_box_cart)
     then have imeq: "(+) ?d ` {x. b $ m \<le> ?mn \<bullet> x} = {x. a $ m \<le> ?mn \<bullet> x}"
       using \<open>m \<noteq> n\<close> by (auto simp: mem_box_cart inner_axis' algebra_simps)
     have "\<And>x. \<lbrakk>0 \<le> a $ n; x $ n + a $ m \<le> x $ m;
                 \<forall>i. i \<noteq> m \<longrightarrow> a $ i \<le> x $ i \<and> x $ i \<le> b $ i\<rbrakk>
          \<Longrightarrow> a $ m \<le> x $ m"
       using \<open>m \<noteq> n\<close>  by force
     then have "(+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x})
             = cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i) \<inter> {x. a $ m \<le> ?mn \<bullet> x}"
       using an ab_ne
       apply (simp add: cbox_translation [symmetric] translation_Int interval_ne_empty_cart imeq)
       apply (auto simp: mem_box_cart inner_axis' algebra_simps if_distrib all_if_distrib)
       by (metis (full_types) add_mono mult_2_right)
     then show "cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<union>
           (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x}) =
           cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i)"  (is "?lhs = ?rhs")
       using an \<open>m \<noteq> n\<close>
       apply (auto simp: mem_box_cart inner_axis' algebra_simps if_distrib all_if_distrib, force)
         apply (drule_tac x=n in spec)+
       by (meson ab_ne add_mono_thms_linordered_semiring(3) dual_order.trans interval_ne_empty_cart(1))
     have "negligible{x. ?mn \<bullet> x = a$m}"
       by (metis \<open>m \<noteq> n\<close> axis_index_axis eq_iff_diff_eq_0 negligible_hyperplane)
     moreover have "(cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter>
                                  (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x})) \<subseteq> {x. ?mn \<bullet> x = a$m}"
       using \<open>m \<noteq> n\<close> antisym_conv by (fastforce simp: algebra_simps mem_box_cart inner_axis')
     ultimately show "negligible (cbox a ?c \<inter> {x. ?mn \<bullet> x \<le> a $ m} \<inter>
                                  (+) ?d ` (cbox a ?c \<inter> {x. b $ m \<le> ?mn \<bullet> x}))"
       by (rule negligible_subset)
   qed
   have ac_ne: "cbox a ?c \<noteq> {}"
     using ab_ne an
     by (clarsimp simp: interval_eq_empty_cart) (meson add_less_same_cancel1 le_less_linear less_le_trans)
   have ax_ne: "cbox a (\<chi> i. if i = m then a $ m + b $ n else b $ i) \<noteq> {}"
     using ab_ne an
     by (clarsimp simp: interval_eq_empty_cart) (meson add_less_same_cancel1 le_less_linear less_le_trans)
   have eq3: "measure lebesgue (cbox a ?c) = measure lebesgue (cbox a (\<chi> i. if i = m then a$m + b$n else b$i)) + measure lebesgue (cbox a b)"
     by (simp add: content_cbox_if_cart ab_ne ac_ne ax_ne algebra_simps prod.delta_remove
              if_distrib [of "\<lambda>u. u - z" for z] prod.remove)
   show ?Q
     using eq1 eq2 eq3
     by (simp add: algebra_simps)
 qed
 
 
 proposition
   fixes S :: "(real^'n) set"
   assumes "S \<in> lmeasurable"
   shows measurable_stretch: "((\<lambda>x. \<chi> k. m k * x$k) ` S) \<in> lmeasurable" (is  "?f ` S \<in> _")
     and measure_stretch: "measure lebesgue ((\<lambda>x. \<chi> k. m k * x$k) ` S) = \<bar>prod m UNIV\<bar> * measure lebesgue S"
     (is "?MEQ")
 proof -
   have "(?f ` S) \<in> lmeasurable \<and> ?MEQ"
   proof (cases "\<forall>k. m k \<noteq> 0")
     case True
     have m0: "0 < \<bar>prod m UNIV\<bar>"
       using True by simp
     have "(indicat_real (?f ` S) has_integral \<bar>prod m UNIV\<bar> * measure lebesgue S) UNIV"
     proof (clarsimp simp add: has_integral_alt [where i=UNIV])
       fix e :: "real"
       assume "e > 0"
       have "(indicat_real S has_integral (measure lebesgue S)) UNIV"
         using assms lmeasurable_iff_has_integral by blast
       then obtain B where "B>0"
         and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow>
                         \<exists>z. (indicat_real S has_integral z) (cbox a b) \<and>
                             \<bar>z - measure lebesgue S\<bar> < e / \<bar>prod m UNIV\<bar>"
         by (simp add: has_integral_alt [where i=UNIV]) (metis (full_types) divide_pos_pos m0  m0 \<open>e > 0\<close>)
       show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
                   (\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox a b) \<and>
                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e)"
       proof (intro exI conjI allI)
         let ?C = "Max (range (\<lambda>k. \<bar>m k\<bar>)) * B"
         show "?C > 0"
           using True \<open>B > 0\<close> by (simp add: Max_gr_iff)
         show "ball 0 ?C \<subseteq> cbox u v \<longrightarrow>
                   (\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox u v) \<and>
                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e)" for u v
         proof
           assume uv: "ball 0 ?C \<subseteq> cbox u v"
           with \<open>?C > 0\<close> have cbox_ne: "cbox u v \<noteq> {}"
             using centre_in_ball by blast
           let ?\<alpha> = "\<lambda>k. u$k / m k"
           let ?\<beta> = "\<lambda>k. v$k / m k"
           have invm0: "\<And>k. inverse (m k) \<noteq> 0"
             using True by auto
           have "ball 0 B \<subseteq> (\<lambda>x. \<chi> k. x $ k / m k) ` ball 0 ?C"
           proof clarsimp
             fix x :: "real^'n"
             assume x: "norm x < B"
             have [simp]: "\<bar>Max (range (\<lambda>k. \<bar>m k\<bar>))\<bar> = Max (range (\<lambda>k. \<bar>m k\<bar>))"
               by (meson Max_ge abs_ge_zero abs_of_nonneg finite finite_imageI order_trans rangeI)
             have "norm (\<chi> k. m k * x $ k) \<le> norm (Max (range (\<lambda>k. \<bar>m k\<bar>)) *\<^sub>R x)"
               by (rule norm_le_componentwise_cart) (auto simp: abs_mult intro: mult_right_mono)
             also have "\<dots> < ?C"
               using x by simp (metis \<open>B > 0\<close> \<open>?C > 0\<close> mult.commute real_mult_less_iff1 zero_less_mult_pos)
             finally have "norm (\<chi> k. m k * x $ k) < ?C" .
             then show "x \<in> (\<lambda>x. \<chi> k. x $ k / m k) ` ball 0 ?C"
               using stretch_Galois [of "inverse \<circ> m"] True by (auto simp: image_iff field_simps)
           qed
           then have Bsub: "ball 0 B \<subseteq> cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k))"
             using cbox_ne uv image_stretch_interval_cart [of "inverse \<circ> m" u v, symmetric]
             by (force simp: field_simps)
           obtain z where zint: "(indicat_real S has_integral z) (cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k)))"
                    and zless: "\<bar>z - measure lebesgue S\<bar> < e / \<bar>prod m UNIV\<bar>"
             using B [OF Bsub] by blast
           have ind: "indicat_real (?f ` S) = (\<lambda>x. indicator S (\<chi> k. x$k / m k))"
             using True stretch_Galois [of m] by (force simp: indicator_def)
           show "\<exists>z. (indicat_real (?f ` S) has_integral z) (cbox u v) \<and>
                        \<bar>z - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e"
           proof (simp add: ind, intro conjI exI)
             have "((\<lambda>x. indicat_real S (\<chi> k. x $ k/ m k)) has_integral z *\<^sub>R \<bar>prod m UNIV\<bar>)
                 ((\<lambda>x. \<chi> k. x $ k * m k) ` cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k)))"
               using True has_integral_stretch_cart [OF zint, of "inverse \<circ> m"]
               by (simp add: field_simps prod_dividef)
             moreover have "((\<lambda>x. \<chi> k. x $ k * m k) ` cbox (\<chi> k. min (?\<alpha> k) (?\<beta> k)) (\<chi> k. max (?\<alpha> k) (?\<beta> k))) = cbox u v"
               using True image_stretch_interval_cart [of "inverse \<circ> m" u v, symmetric]
                 image_stretch_interval_cart [of "\<lambda>k. 1" u v, symmetric] \<open>cbox u v \<noteq> {}\<close>
               by (simp add: field_simps image_comp o_def)
             ultimately show "((\<lambda>x. indicat_real S (\<chi> k. x $ k/ m k)) has_integral z *\<^sub>R \<bar>prod m UNIV\<bar>) (cbox u v)"
               by simp
             have "\<bar>z *\<^sub>R \<bar>prod m UNIV\<bar> - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar>
                  = \<bar>prod m UNIV\<bar> * \<bar>z - measure lebesgue S\<bar>"
               by (metis (no_types, hide_lams) abs_abs abs_scaleR mult.commute real_scaleR_def right_diff_distrib')
             also have "\<dots> < e"
               using zless True by (simp add: field_simps)
             finally show "\<bar>z *\<^sub>R \<bar>prod m UNIV\<bar> - \<bar>prod m UNIV\<bar> * measure lebesgue S\<bar> < e" .
           qed
         qed
       qed
     qed
     then show ?thesis
       by (auto simp: has_integral_integrable integral_unique lmeasure_integral_UNIV measurable_integrable)
   next
     case False
     then obtain k where "m k = 0" and prm: "prod m UNIV = 0"
       by auto
     have nfS: "negligible (?f ` S)"
       by (rule negligible_subset [OF negligible_standard_hyperplane_cart]) (use \<open>m k = 0\<close> in auto)
     then have "(?f ` S) \<in> lmeasurable"
       by (simp add: negligible_iff_measure)
     with nfS show ?thesis
       by (simp add: prm negligible_iff_measure0)
   qed
   then show "(?f ` S) \<in> lmeasurable" ?MEQ
     by metis+
 qed
 
 
 proposition
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes "linear f" "S \<in> lmeasurable"
   shows measurable_linear_image: "(f ` S) \<in> lmeasurable"
     and measure_linear_image: "measure lebesgue (f ` S) = \<bar>det (matrix f)\<bar> * measure lebesgue S" (is "?Q f S")
 proof -
   have "\<forall>S \<in> lmeasurable. (f ` S) \<in> lmeasurable \<and> ?Q f S"
   proof (rule induct_linear_elementary [OF \<open>linear f\<close>]; intro ballI)
     fix f g and S :: "(real,'n) vec set"
     assume "linear f" and "linear g"
       and f [rule_format]: "\<forall>S \<in> lmeasurable. f ` S \<in> lmeasurable \<and> ?Q f S"
       and g [rule_format]: "\<forall>S \<in> lmeasurable. g ` S \<in> lmeasurable \<and> ?Q g S"
       and S: "S \<in> lmeasurable"
     then have gS: "g ` S \<in> lmeasurable"
       by blast
     show "(f \<circ> g) ` S \<in> lmeasurable \<and> ?Q (f \<circ> g) S"
       using f [OF gS] g [OF S] matrix_compose [OF \<open>linear g\<close> \<open>linear f\<close>]
       by (simp add: o_def image_comp abs_mult det_mul)
   next
     fix f :: "real^'n::_ \<Rightarrow> real^'n::_" and i and S :: "(real^'n::_) set"
     assume "linear f" and 0: "\<And>x. f x $ i = 0" and "S \<in> lmeasurable"
     then have "\<not> inj f"
       by (metis (full_types) linear_injective_imp_surjective one_neq_zero surjE vec_component)
     have detf: "det (matrix f) = 0"
       using \<open>\<not> inj f\<close> det_nz_iff_inj[OF \<open>linear f\<close>] by blast
     show "f ` S \<in> lmeasurable \<and> ?Q f S"
     proof
       show "f ` S \<in> lmeasurable"
         using lmeasurable_iff_indicator_has_integral \<open>linear f\<close> \<open>\<not> inj f\<close> negligible_UNIV negligible_linear_singular_image by blast
       have "measure lebesgue (f ` S) = 0"
         by (meson \<open>\<not> inj f\<close> \<open>linear f\<close> negligible_imp_measure0 negligible_linear_singular_image)
       also have "\<dots> = \<bar>det (matrix f)\<bar> * measure lebesgue S"
         by (simp add: detf)
       finally show "?Q f S" .
     qed
   next
     fix c and S :: "(real^'n::_) set"
     assume "S \<in> lmeasurable"
     show "(\<lambda>a. \<chi> i. c i * a $ i) ` S \<in> lmeasurable \<and> ?Q (\<lambda>a. \<chi> i. c i * a $ i) S"
     proof
       show "(\<lambda>a. \<chi> i. c i * a $ i) ` S \<in> lmeasurable"
         by (simp add: \<open>S \<in> lmeasurable\<close> measurable_stretch)
       show "?Q (\<lambda>a. \<chi> i. c i * a $ i) S"
         by (simp add: measure_stretch [OF \<open>S \<in> lmeasurable\<close>, of c] axis_def matrix_def det_diagonal)
     qed
   next
     fix m :: "'n" and n :: "'n" and S :: "(real, 'n) vec set"
     assume "m \<noteq> n" and "S \<in> lmeasurable"
     let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i"
     have lin: "linear ?h"
       by (rule linearI) (simp_all add: plus_vec_def scaleR_vec_def)
     have meq: "measure lebesgue ((\<lambda>v::(real, 'n) vec. \<chi> i. v $ Fun.swap m n id i) ` cbox a b)
              = measure lebesgue (cbox a b)" for a b
     proof (cases "cbox a b = {}")
       case True then show ?thesis
         by simp
     next
       case False
       then have him: "?h ` (cbox a b) \<noteq> {}"
         by blast
       have eq: "?h ` (cbox a b) = cbox (?h a) (?h b)"
         by (auto simp: image_iff lambda_swap_Galois mem_box_cart) (metis swap_id_eq)+
       show ?thesis
         using him prod.permute [OF permutes_swap_id, where S=UNIV and g="\<lambda>i. (b - a)$i", symmetric]
         by (simp add: eq content_cbox_cart False)
     qed
     have "(\<chi> i j. if Fun.swap m n id i = j then 1 else 0) = (\<chi> i j. if j = Fun.swap m n id i then 1 else (0::real))"
       by (auto intro!: Cart_lambda_cong)
     then have "matrix ?h = transpose(\<chi> i j. mat 1 $ i $ Fun.swap m n id j)"
       by (auto simp: matrix_eq transpose_def axis_def mat_def matrix_def)
     then have 1: "\<bar>det (matrix ?h)\<bar> = 1"
       by (simp add: det_permute_columns permutes_swap_id sign_swap_id abs_mult)
     show "?h ` S \<in> lmeasurable \<and> ?Q ?h S"
     proof
       show "?h ` S \<in> lmeasurable" "?Q ?h S"
         using measure_linear_sufficient [OF lin \<open>S \<in> lmeasurable\<close>] meq 1 by force+
     qed
   next
     fix m n :: "'n" and S :: "(real, 'n) vec set"
     assume "m \<noteq> n" and "S \<in> lmeasurable"
     let ?h = "\<lambda>v::(real, 'n) vec. \<chi> i. if i = m then v $ m + v $ n else v $ i"
     have lin: "linear ?h"
       by (rule linearI) (auto simp: algebra_simps plus_vec_def scaleR_vec_def vec_eq_iff)
     consider "m < n" | " n < m"
       using \<open>m \<noteq> n\<close> less_linear by blast
     then have 1: "det(matrix ?h) = 1"
     proof cases
       assume "m < n"
       have *: "matrix ?h $ i $ j = (0::real)" if "j < i" for i j :: 'n
       proof -
         have "axis j 1 = (\<chi> n. if n = j then 1 else (0::real))"
           using axis_def by blast
         then have "(\<chi> p q. if p = m then axis q 1 $ m + axis q 1 $ n else axis q 1 $ p) $ i $ j = (0::real)"
           using \<open>j < i\<close> axis_def \<open>m < n\<close> by auto
         with \<open>m < n\<close> show ?thesis
           by (auto simp: matrix_def axis_def cong: if_cong)
       qed
       show ?thesis
         using \<open>m \<noteq> n\<close> by (subst det_upperdiagonal [OF *]) (auto simp: matrix_def axis_def cong: if_cong)
     next
       assume "n < m"
       have *: "matrix ?h $ i $ j = (0::real)" if "j > i" for i j :: 'n
       proof -
         have "axis j 1 = (\<chi> n. if n = j then 1 else (0::real))"
           using axis_def by blast
         then have "(\<chi> p q. if p = m then axis q 1 $ m + axis q 1 $ n else axis q 1 $ p) $ i $ j = (0::real)"
           using \<open>j > i\<close> axis_def \<open>m > n\<close> by auto
         with \<open>m > n\<close> show ?thesis
           by (auto simp: matrix_def axis_def cong: if_cong)
       qed
       show ?thesis
         using \<open>m \<noteq> n\<close>
         by (subst det_lowerdiagonal [OF *]) (auto simp: matrix_def axis_def cong: if_cong)
     qed
     have meq: "measure lebesgue (?h ` (cbox a b)) = measure lebesgue (cbox a b)" for a b
     proof (cases "cbox a b = {}")
       case True then show ?thesis by simp
     next
       case False
       then have ne: "(+) (\<chi> i. if i = n then - a $ n else 0) ` cbox a b \<noteq> {}"
         by auto
       let ?v = "\<chi> i. if i = n then - a $ n else 0"
       have "?h ` cbox a b
             = (+) (\<chi> i. if i = m \<or> i = n then a $ n else 0) ` ?h ` (+) ?v ` (cbox a b)"
         using \<open>m \<noteq> n\<close> unfolding image_comp o_def by (force simp: vec_eq_iff)
       then have "measure lebesgue (?h ` (cbox a b))
                = measure lebesgue ((\<lambda>v. \<chi> i. if i = m then v $ m + v $ n else v $ i) `
                                    (+) ?v ` cbox a b)"
         by (rule ssubst) (rule measure_translation)
       also have "\<dots> = measure lebesgue ((\<lambda>v. \<chi> i. if i = m then v $ m + v $ n else v $ i) ` cbox (?v +a) (?v + b))"
         by (metis (no_types, lifting) cbox_translation)
       also have "\<dots> = measure lebesgue ((+) (\<chi> i. if i = n then - a $ n else 0) ` cbox a b)"
         apply (subst measure_shear_interval)
         using \<open>m \<noteq> n\<close> ne apply auto
         apply (simp add: cbox_translation)
         by (metis cbox_borel cbox_translation measure_completion sets_lborel)
       also have "\<dots> = measure lebesgue (cbox a b)"
         by (rule measure_translation)
         finally show ?thesis .
       qed
     show "?h ` S \<in> lmeasurable \<and> ?Q ?h S"
       using measure_linear_sufficient [OF lin \<open>S \<in> lmeasurable\<close>] meq 1 by force
   qed
   with assms show "(f ` S) \<in> lmeasurable" "?Q f S"
     by metis+
 qed
 
 
 lemma
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes f: "orthogonal_transformation f" and S: "S \<in> lmeasurable"
   shows measurable_orthogonal_image: "f ` S \<in> lmeasurable"
     and measure_orthogonal_image: "measure lebesgue (f ` S) = measure lebesgue S"
 proof -
   have "linear f"
     by (simp add: f orthogonal_transformation_linear)
   then show "f ` S \<in> lmeasurable"
     by (metis S measurable_linear_image)
   show "measure lebesgue (f ` S) = measure lebesgue S"
     by (simp add: measure_linear_image \<open>linear f\<close> S f)
 qed
 
 proposition measure_semicontinuous_with_hausdist_explicit:
   assumes "bounded S" and neg: "negligible(frontier S)" and "e > 0"
   obtains d where "d > 0"
                   "\<And>T. \<lbrakk>T \<in> lmeasurable; \<And>y. y \<in> T \<Longrightarrow> \<exists>x. x \<in> S \<and> dist x y < d\<rbrakk>
                         \<Longrightarrow> measure lebesgue T < measure lebesgue S + e"
 proof (cases "S = {}")
   case True
   with that \<open>e > 0\<close> show ?thesis by force
 next
   case False
   then have frS: "frontier S \<noteq> {}"
     using \<open>bounded S\<close> frontier_eq_empty not_bounded_UNIV by blast
   have "S \<in> lmeasurable"
     by (simp add: \<open>bounded S\<close> measurable_Jordan neg)
   have null: "(frontier S) \<in> null_sets lebesgue"
     by (metis neg negligible_iff_null_sets)
   have "frontier S \<in> lmeasurable" and mS0: "measure lebesgue (frontier S) = 0"
     using neg negligible_imp_measurable negligible_iff_measure by blast+
   with \<open>e > 0\<close> sets_lebesgue_outer_open
   obtain U where "open U"
     and U: "frontier S \<subseteq> U" "U - frontier S \<in> lmeasurable" "emeasure lebesgue (U - frontier S) < e"
     by (metis fmeasurableD)
   with null have "U \<in> lmeasurable"
     by (metis borel_open measurable_Diff_null_set sets_completionI_sets sets_lborel)
   have "measure lebesgue (U - frontier S) = measure lebesgue U"
     using mS0 by (simp add: \<open>U \<in> lmeasurable\<close> fmeasurableD measure_Diff_null_set null)
   with U have mU: "measure lebesgue U < e"
     by (simp add: emeasure_eq_measure2 ennreal_less_iff)
   show ?thesis
   proof
     have "U \<noteq> UNIV"
       using \<open>U \<in> lmeasurable\<close> by auto
     then have "- U \<noteq> {}"
       by blast
     with \<open>open U\<close> \<open>frontier S \<subseteq> U\<close> show "setdist (frontier S) (- U) > 0"
       by (auto simp: \<open>bounded S\<close> open_closed compact_frontier_bounded setdist_gt_0_compact_closed frS)
     fix T
     assume "T \<in> lmeasurable"
       and T: "\<And>t. t \<in> T \<Longrightarrow> \<exists>y. y \<in> S \<and> dist y t < setdist (frontier S) (- U)"
     then have "measure lebesgue T - measure lebesgue S \<le> measure lebesgue (T - S)"
       by (simp add: \<open>S \<in> lmeasurable\<close> measure_diff_le_measure_setdiff)
     also have "\<dots>  \<le> measure lebesgue U"
     proof -
       have "T - S \<subseteq> U"
       proof clarify
         fix x
         assume "x \<in> T" and "x \<notin> S"
         then obtain y where "y \<in> S" and y: "dist y x < setdist (frontier S) (- U)"
           using T by blast
         have "closed_segment x y \<inter> frontier S \<noteq> {}"
           using connected_Int_frontier \<open>x \<notin> S\<close> \<open>y \<in> S\<close> by blast
         then obtain z where z: "z \<in> closed_segment x y" "z \<in> frontier S"
           by auto
         with y have "dist z x < setdist(frontier S) (- U)"
           by (auto simp: dist_commute dest!: dist_in_closed_segment)
         with z have False if "x \<in> -U"
           using setdist_le_dist [OF \<open>z \<in> frontier S\<close> that] by auto
         then show "x \<in> U"
           by blast
       qed
       then show ?thesis
         by (simp add: \<open>S \<in> lmeasurable\<close> \<open>T \<in> lmeasurable\<close> \<open>U \<in> lmeasurable\<close> fmeasurableD measure_mono_fmeasurable sets.Diff)
     qed
     finally have "measure lebesgue T - measure lebesgue S \<le> measure lebesgue U" .
     with mU show "measure lebesgue T < measure lebesgue S + e"
       by linarith
   qed
 qed
 
 proposition
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes S: "S \<in> lmeasurable"
   and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   and bounded: "\<And>x. x \<in> S \<Longrightarrow> \<bar>det (matrix (f' x))\<bar> \<le> B"
   shows measurable_bounded_differentiable_image:
        "f ` S \<in> lmeasurable"
     and measure_bounded_differentiable_image:
        "measure lebesgue (f ` S) \<le> B * measure lebesgue S" (is "?M")
 proof -
   have "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) \<le> B * measure lebesgue S"
   proof (cases "B < 0")
     case True
     then have "S = {}"
       by (meson abs_ge_zero bounded empty_iff equalityI less_le_trans linorder_not_less subsetI)
     then show ?thesis
       by auto
   next
     case False
     then have "B \<ge> 0"
       by arith
     let ?\<mu> = "measure lebesgue"
     have f_diff: "f differentiable_on S"
       using deriv by (auto simp: differentiable_on_def differentiable_def)
     have eps: "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> (B+e) * ?\<mu> S" (is "?ME")
               if "e > 0" for e
     proof -
       have eps_d: "f ` S \<in> lmeasurable"  "?\<mu> (f ` S) \<le> (B+e) * (?\<mu> S + d)" (is "?MD")
                   if "d > 0" for d
       proof -
         obtain T where T: "open T" "S \<subseteq> T" and TS: "(T-S) \<in> lmeasurable" and "emeasure lebesgue (T-S) < ennreal d"
           using S \<open>d > 0\<close> sets_lebesgue_outer_open by blast
         then have "?\<mu> (T-S) < d"
           by (metis emeasure_eq_measure2 ennreal_leI not_less)
         with S T TS have "T \<in> lmeasurable" and Tless: "?\<mu> T < ?\<mu> S + d"
           by (auto simp: measurable_measure_Diff dest!: fmeasurable_Diff_D)
         have "\<exists>r. 0 < r \<and> r < d \<and> ball x r \<subseteq> T \<and> f ` (S \<inter> ball x r) \<in> lmeasurable \<and>
                   ?\<mu> (f ` (S \<inter> ball x r)) \<le> (B + e) * ?\<mu> (ball x r)"
           if "x \<in> S" "d > 0" for x d
         proof -
           have lin: "linear (f' x)"
             and lim0: "((\<lambda>y. (f y - (f x + f' x (y - x))) /\<^sub>R norm(y - x)) \<longlongrightarrow> 0) (at x within S)"
             using deriv \<open>x \<in> S\<close> by (auto simp: has_derivative_within bounded_linear.linear field_simps)
           have bo: "bounded (f' x ` ball 0 1)"
             by (simp add: bounded_linear_image linear_linear lin)
           have neg: "negligible (frontier (f' x ` ball 0 1))"
             using deriv has_derivative_linear \<open>x \<in> S\<close>
             by (auto intro!: negligible_convex_frontier [OF convex_linear_image])
           have 0: "0 < e * unit_ball_vol (real CARD('n))"
             using  \<open>e > 0\<close> by simp
           obtain k where "k > 0" and k:
                   "\<And>U. \<lbrakk>U \<in> lmeasurable; \<And>y. y \<in> U \<Longrightarrow> \<exists>z. z \<in> f' x ` ball 0 1 \<and> dist z y < k\<rbrakk>
                         \<Longrightarrow> ?\<mu> U < ?\<mu> (f' x ` ball 0 1) + e * unit_ball_vol (CARD('n))"
             using measure_semicontinuous_with_hausdist_explicit [OF bo neg 0] by blast
           obtain l where "l > 0" and l: "ball x l \<subseteq> T"
             using \<open>x \<in> S\<close> \<open>open T\<close> \<open>S \<subseteq> T\<close> openE by blast
           obtain \<zeta> where "0 < \<zeta>"
             and \<zeta>: "\<And>y. \<lbrakk>y \<in> S; y \<noteq> x; dist y x < \<zeta>\<rbrakk>
                         \<Longrightarrow> norm (f y - (f x + f' x (y - x))) / norm (y - x) < k"
             using lim0 \<open>k > 0\<close> by (simp add: Lim_within) (auto simp add: field_simps)
           define r where "r \<equiv> min (min l (\<zeta>/2)) (min 1 (d/2))"
           show ?thesis
           proof (intro exI conjI)
             show "r > 0" "r < d"
               using \<open>l > 0\<close> \<open>\<zeta> > 0\<close> \<open>d > 0\<close> by (auto simp: r_def)
             have "r \<le> l"
               by (auto simp: r_def)
             with l show "ball x r \<subseteq> T"
               by auto
             have ex_lessK: "\<exists>x' \<in> ball 0 1. dist (f' x x') ((f y - f x) /\<^sub>R r) < k"
               if "y \<in> S" and "dist x y < r" for y
             proof (cases "y = x")
               case True
               with lin linear_0 \<open>k > 0\<close> that show ?thesis
                 by (rule_tac x=0 in bexI) (auto simp: linear_0)
             next
               case False
               then show ?thesis
               proof (rule_tac x="(y - x) /\<^sub>R r" in bexI)
                 have "f' x ((y - x) /\<^sub>R r) = f' x (y - x) /\<^sub>R r"
                   by (simp add: lin linear_scale)
                 then have "dist (f' x ((y - x) /\<^sub>R r)) ((f y - f x) /\<^sub>R r) = norm (f' x (y - x) /\<^sub>R r - (f y - f x) /\<^sub>R r)"
                   by (simp add: dist_norm)
                 also have "\<dots> = norm (f' x (y - x) - (f y - f x)) / r"
                   using \<open>r > 0\<close> by (simp add: divide_simps scale_right_diff_distrib [symmetric])
                 also have "\<dots> \<le> norm (f y - (f x + f' x (y - x))) / norm (y - x)"
                   using that \<open>r > 0\<close> False by (simp add: algebra_simps field_split_simps dist_norm norm_minus_commute mult_right_mono)
                 also have "\<dots> < k"
                   using that \<open>0 < \<zeta>\<close> by (simp add: dist_commute r_def  \<zeta> [OF \<open>y \<in> S\<close> False])
                 finally show "dist (f' x ((y - x) /\<^sub>R r)) ((f y - f x) /\<^sub>R r) < k" .
                 show "(y - x) /\<^sub>R r \<in> ball 0 1"
                   using that \<open>r > 0\<close> by (simp add: dist_norm divide_simps norm_minus_commute)
               qed
             qed
             let ?rfs = "(\<lambda>x. x /\<^sub>R r) ` (+) (- f x) ` f ` (S \<inter> ball x r)"
             have rfs_mble: "?rfs \<in> lmeasurable"
             proof (rule bounded_set_imp_lmeasurable)
               have "f differentiable_on S \<inter> ball x r"
                 using f_diff by (auto simp: fmeasurableD differentiable_on_subset)
               with S show "?rfs \<in> sets lebesgue"
                 by (auto simp: sets.Int intro!: lebesgue_sets_translation differentiable_image_in_sets_lebesgue)
               let ?B = "(\<lambda>(x, y). x + y) ` (f' x ` ball 0 1 \<times> ball 0 k)"
               have "bounded ?B"
                 by (simp add: bounded_plus [OF bo])
               moreover have "?rfs \<subseteq> ?B"
                 apply (auto simp: dist_norm image_iff dest!: ex_lessK)
                 by (metis (no_types, hide_lams) add.commute diff_add_cancel dist_0_norm dist_commute dist_norm mem_ball)
               ultimately show "bounded (?rfs)"
                 by (rule bounded_subset)
             qed
             then have "(\<lambda>x. r *\<^sub>R x) ` ?rfs \<in> lmeasurable"
               by (simp add: measurable_linear_image)
             with \<open>r > 0\<close> have "(+) (- f x) ` f ` (S \<inter> ball x r) \<in> lmeasurable"
               by (simp add: image_comp o_def)
             then have "(+) (f x) ` (+) (- f x) ` f ` (S \<inter> ball x r) \<in> lmeasurable"
               using  measurable_translation by blast
             then show fsb: "f ` (S \<inter> ball x r) \<in> lmeasurable"
               by (simp add: image_comp o_def)
             have "?\<mu> (f ` (S \<inter> ball x r)) = ?\<mu> (?rfs) * r ^ CARD('n)"
               using \<open>r > 0\<close> fsb
               by (simp add: measure_linear_image measure_translation_subtract measurable_translation_subtract field_simps cong: image_cong_simp)
             also have "\<dots> \<le> (\<bar>det (matrix (f' x))\<bar> * unit_ball_vol (CARD('n)) + e * unit_ball_vol (CARD('n))) * r ^ CARD('n)"
             proof -
               have "?\<mu> (?rfs) < ?\<mu> (f' x ` ball 0 1) + e * unit_ball_vol (CARD('n))"
                 using rfs_mble by (force intro: k dest!: ex_lessK)
               then have "?\<mu> (?rfs) < \<bar>det (matrix (f' x))\<bar> * unit_ball_vol (CARD('n)) + e * unit_ball_vol (CARD('n))"
                 by (simp add: lin measure_linear_image [of "f' x"] content_ball)
               with \<open>r > 0\<close> show ?thesis
                 by auto
             qed
             also have "\<dots> \<le> (B + e) * ?\<mu> (ball x r)"
               using bounded [OF \<open>x \<in> S\<close>] \<open>r > 0\<close> by (simp add: content_ball algebra_simps)
             finally show "?\<mu> (f ` (S \<inter> ball x r)) \<le> (B + e) * ?\<mu> (ball x r)" .
           qed
         qed
         then obtain r where
           r0d: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow> 0 < r x d \<and> r x d < d"
           and rT: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow> ball x (r x d) \<subseteq> T"
           and r: "\<And>x d. \<lbrakk>x \<in> S; d > 0\<rbrakk> \<Longrightarrow>
                   (f ` (S \<inter> ball x (r x d))) \<in> lmeasurable \<and>
                   ?\<mu> (f ` (S \<inter> ball x (r x d))) \<le> (B + e) * ?\<mu> (ball x (r x d))"
           by metis
         obtain C where "countable C" and Csub: "C \<subseteq> {(x,r x t) |x t. x \<in> S \<and> 0 < t}"
           and pwC: "pairwise (\<lambda>i j. disjnt (ball (fst i) (snd i)) (ball (fst j) (snd j))) C"
           and negC: "negligible(S - (\<Union>i \<in> C. ball (fst i) (snd i)))"
           apply (rule Vitali_covering_theorem_balls [of S "{(x,r x t) |x t. x \<in> S \<and> 0 < t}" fst snd])
            apply auto
           by (metis dist_eq_0_iff r0d)
         let ?UB = "(\<Union>(x,s) \<in> C. ball x s)"
         have eq: "f ` (S \<inter> ?UB) = (\<Union>(x,s) \<in> C. f ` (S \<inter> ball x s))"
           by auto
         have mle: "?\<mu> (\<Union>(x,s) \<in> K. f ` (S \<inter> ball x s)) \<le> (B + e) * (?\<mu> S + d)"  (is "?l \<le> ?r")
           if "K \<subseteq> C" and "finite K" for K
         proof -
           have gt0: "b > 0" if "(a, b) \<in> K" for a b
             using Csub that \<open>K \<subseteq> C\<close> r0d by auto
           have inj: "inj_on (\<lambda>(x, y). ball x y) K"
             by (force simp: inj_on_def ball_eq_ball_iff dest: gt0)
           have disjnt: "disjoint ((\<lambda>(x, y). ball x y) ` K)"
             using pwC that
             apply (clarsimp simp: pairwise_def case_prod_unfold ball_eq_ball_iff)
             by (metis subsetD fst_conv snd_conv)
           have "?l \<le> (\<Sum>i\<in>K. ?\<mu> (case i of (x, s) \<Rightarrow> f ` (S \<inter> ball x s)))"
           proof (rule measure_UNION_le [OF \<open>finite K\<close>], clarify)
             fix x r
             assume "(x,r) \<in> K"
             then have "x \<in> S"
               using Csub \<open>K \<subseteq> C\<close> by auto
             show "f ` (S \<inter> ball x r) \<in> sets lebesgue"
               by (meson Int_lower1 S differentiable_on_subset f_diff fmeasurableD lmeasurable_ball order_refl sets.Int differentiable_image_in_sets_lebesgue)
           qed
           also have "\<dots> \<le> (\<Sum>(x,s) \<in> K. (B + e) * ?\<mu> (ball x s))"
             apply (rule sum_mono)
             using Csub r \<open>K \<subseteq> C\<close> by auto
           also have "\<dots> = (B + e) * (\<Sum>(x,s) \<in> K. ?\<mu> (ball x s))"
             by (simp add: prod.case_distrib sum_distrib_left)
           also have "\<dots> = (B + e) * sum ?\<mu> ((\<lambda>(x, y). ball x y) ` K)"
             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> by (simp add: inj sum.reindex prod.case_distrib)
           also have "\<dots> = (B + e) * ?\<mu> (\<Union>(x,s) \<in> K. ball x s)"
             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> that
             by (subst measure_Union') (auto simp: disjnt measure_Union')
           also have "\<dots> \<le> (B + e) * ?\<mu> T"
             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> that apply simp
             apply (rule measure_mono_fmeasurable [OF _ _ \<open>T \<in> lmeasurable\<close>])
             using Csub rT by force+
           also have "\<dots> \<le> (B + e) * (?\<mu> S + d)"
             using \<open>B \<ge> 0\<close> \<open>e > 0\<close> Tless by simp
           finally show ?thesis .
         qed
         have fSUB_mble: "(f ` (S \<inter> ?UB)) \<in> lmeasurable"
           unfolding eq using Csub r False \<open>e > 0\<close> that
           by (auto simp: intro!: fmeasurable_UN_bound [OF \<open>countable C\<close> _ mle])
         have fSUB_meas: "?\<mu> (f ` (S \<inter> ?UB)) \<le> (B + e) * (?\<mu> S + d)"  (is "?MUB")
           unfolding eq using Csub r False \<open>e > 0\<close> that
           by (auto simp: intro!: measure_UN_bound [OF \<open>countable C\<close> _ mle])
         have neg: "negligible ((f ` (S \<inter> ?UB) - f ` S) \<union> (f ` S - f ` (S \<inter> ?UB)))"
         proof (rule negligible_subset [OF negligible_differentiable_image_negligible [OF order_refl negC, where f=f]])
           show "f differentiable_on S - (\<Union>i\<in>C. ball (fst i) (snd i))"
             by (meson DiffE differentiable_on_subset subsetI f_diff)
         qed force
         show "f ` S \<in> lmeasurable"
           by (rule lmeasurable_negligible_symdiff [OF fSUB_mble neg])
         show ?MD
           using fSUB_meas measure_negligible_symdiff [OF fSUB_mble neg] by simp
       qed
       show "f ` S \<in> lmeasurable"
         using eps_d [of 1] by simp
       show ?ME
       proof (rule field_le_epsilon)
         fix \<delta> :: real
         assume "0 < \<delta>"
         then show "?\<mu> (f ` S) \<le> (B + e) * ?\<mu> S + \<delta>"
           using eps_d [of "\<delta> / (B+e)"] \<open>e > 0\<close> \<open>B \<ge> 0\<close> by (auto simp: divide_simps mult_ac)
       qed
     qed
     show ?thesis
     proof (cases "?\<mu> S = 0")
       case True
       with eps have "?\<mu> (f ` S) = 0"
         by (metis mult_zero_right not_le zero_less_measure_iff)
       then show ?thesis
         using eps [of 1] by (simp add: True)
     next
       case False
       have "?\<mu> (f ` S) \<le> B * ?\<mu> S"
       proof (rule field_le_epsilon)
         fix e :: real
         assume "e > 0"
         then show "?\<mu> (f ` S) \<le> B * ?\<mu> S + e"
           using eps [of "e / ?\<mu> S"] False by (auto simp: algebra_simps zero_less_measure_iff)
       qed
       with eps [of 1] show ?thesis by auto
     qed
   qed
   then show "f ` S \<in> lmeasurable" ?M by blast+
 qed
 
 lemma m_diff_image_weak:
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes S: "S \<in> lmeasurable"
     and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   shows "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
 proof -
   let ?\<mu> = "measure lebesgue"
   have aint_S: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
     using int unfolding absolutely_integrable_on_def by auto
   define m where "m \<equiv> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
   have *: "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> m + e * ?\<mu> S"
     if "e > 0" for e
   proof -
     define T where "T \<equiv> \<lambda>n. {x \<in> S. n * e \<le> \<bar>det (matrix (f' x))\<bar> \<and>
                                      \<bar>det (matrix (f' x))\<bar> < (Suc n) * e}"
     have meas_t: "T n \<in> lmeasurable" for n
     proof -
       have *: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) \<in> borel_measurable (lebesgue_on S)"
         using aint_S by (simp add: S borel_measurable_restrict_space_iff fmeasurableD set_integrable_def)
       have [intro]: "x \<in> sets (lebesgue_on S) \<Longrightarrow> x \<in> sets lebesgue" for x
         using S sets_restrict_space_subset by blast
       have "{x \<in> S. real n * e \<le> \<bar>det (matrix (f' x))\<bar>} \<in> sets lebesgue"
         using * by (auto simp: borel_measurable_iff_halfspace_ge space_restrict_space)
       then have 1: "{x \<in> S. real n * e \<le> \<bar>det (matrix (f' x))\<bar>} \<in> lmeasurable"
         using S by (simp add: fmeasurableI2)
       have "{x \<in> S. \<bar>det (matrix (f' x))\<bar> < (1 + real n) * e} \<in> sets lebesgue"
         using * by (auto simp: borel_measurable_iff_halfspace_less space_restrict_space)
       then have 2: "{x \<in> S. \<bar>det (matrix (f' x))\<bar> < (1 + real n) * e} \<in> lmeasurable"
         using S by (simp add: fmeasurableI2)
       show ?thesis
         using fmeasurable.Int [OF 1 2] by (simp add: T_def Int_def cong: conj_cong)
     qed
     have aint_T: "\<And>k. (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on T k"
       using set_integrable_subset [OF aint_S] meas_t T_def by blast
     have Seq: "S = (\<Union>n. T n)"
       apply (auto simp: T_def)
       apply (rule_tac x="nat(floor(abs(det(matrix(f' x))) / e))" in exI)
       using that apply auto
       using of_int_floor_le pos_le_divide_eq apply blast
       by (metis add.commute pos_divide_less_eq real_of_int_floor_add_one_gt)
     have meas_ft: "f ` T n \<in> lmeasurable" for n
     proof (rule measurable_bounded_differentiable_image)
       show "T n \<in> lmeasurable"
         by (simp add: meas_t)
     next
       fix x :: "(real,'n) vec"
       assume "x \<in> T n"
       show "(f has_derivative f' x) (at x within T n)"
         by (metis (no_types, lifting) \<open>x \<in> T n\<close> deriv has_derivative_within_subset mem_Collect_eq subsetI T_def)
       show "\<bar>det (matrix (f' x))\<bar> \<le> (Suc n) * e"
         using \<open>x \<in> T n\<close> T_def by auto
     next
       show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T n"
         using aint_T absolutely_integrable_on_def by blast
     qed
     have disT: "disjoint (range T)"
       unfolding disjoint_def
     proof clarsimp
       show "T m \<inter> T n = {}" if "T m \<noteq> T n" for m n
         using that
       proof (induction m n rule: linorder_less_wlog)
         case (less m n)
         with \<open>e > 0\<close> show ?case
           unfolding T_def
           proof (clarsimp simp add: Collect_conj_eq [symmetric])
             fix x
             assume "e > 0"  "m < n"  "n * e \<le> \<bar>det (matrix (f' x))\<bar>"  "\<bar>det (matrix (f' x))\<bar> < (1 + real m) * e"
             then have "n < 1 + real m"
               by (metis (no_types, hide_lams) less_le_trans mult.commute not_le real_mult_le_cancel_iff2)
             then show "False"
               using less.hyps by linarith
           qed
       qed auto
     qed
     have injT: "inj_on T ({n. T n \<noteq> {}})"
       unfolding inj_on_def
     proof clarsimp
       show "m = n" if "T m = T n" "T n \<noteq> {}" for m n
         using that
       proof (induction m n rule: linorder_less_wlog)
         case (less m n)
         have False if "T n \<subseteq> T m" "x \<in> T n" for x
           using \<open>e > 0\<close> \<open>m < n\<close> that
           apply (auto simp: T_def  mult.commute intro: less_le_trans dest!: subsetD)
           by (metis add.commute less_le_trans nat_less_real_le not_le real_mult_le_cancel_iff2)
         then show ?case
           using less.prems by blast
       qed auto
     qed
     have sum_eq_Tim: "(\<Sum>k\<le>n. f (T k)) = sum f (T ` {..n})" if "f {} = 0" for f :: "_ \<Rightarrow> real" and n
     proof (subst sum.reindex_nontrivial)
       fix i j  assume "i \<in> {..n}" "j \<in> {..n}" "i \<noteq> j" "T i = T j"
       with that  injT [unfolded inj_on_def] show "f (T i) = 0"
         by simp metis
     qed (use atMost_atLeast0 in auto)
     let ?B = "m + e * ?\<mu> S"
     have "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> ?B" for n
     proof -
       have "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> (\<Sum>k\<le>n. ((k+1) * e) * ?\<mu>(T k))"
       proof (rule sum_mono [OF measure_bounded_differentiable_image])
         show "(f has_derivative f' x) (at x within T k)" if "x \<in> T k" for k x
           using that unfolding T_def by (blast intro: deriv has_derivative_within_subset)
         show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T k" for k
           using absolutely_integrable_on_def aint_T by blast
         show "\<bar>det (matrix (f' x))\<bar> \<le> real (k + 1) * e" if "x \<in> T k" for k x
           using T_def that by auto
       qed (use meas_t in auto)
       also have "\<dots> \<le> (\<Sum>k\<le>n. (k * e) * ?\<mu>(T k)) + (\<Sum>k\<le>n. e * ?\<mu>(T k))"
         by (simp add: algebra_simps sum.distrib)
       also have "\<dots> \<le> ?B"
       proof (rule add_mono)
         have "(\<Sum>k\<le>n. real k * e * ?\<mu> (T k)) = (\<Sum>k\<le>n. integral (T k) (\<lambda>x. k * e))"
           by (simp add: lmeasure_integral [OF meas_t]
                    flip: integral_mult_right integral_mult_left)
         also have "\<dots> \<le> (\<Sum>k\<le>n. integral (T k) (\<lambda>x.  (abs (det (matrix (f' x))))))"
         proof (rule sum_mono)
           fix k
           assume "k \<in> {..n}"
           show "integral (T k) (\<lambda>x. k * e) \<le> integral (T k) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
           proof (rule integral_le [OF integrable_on_const [OF meas_t]])
             show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on T k"
               using absolutely_integrable_on_def aint_T by blast
           next
             fix x assume "x \<in> T k"
             show "k * e \<le> \<bar>det (matrix (f' x))\<bar>"
               using \<open>x \<in> T k\<close> T_def by blast
           qed
         qed
         also have "\<dots> = sum (\<lambda>T. integral T (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)) (T ` {..n})"
           by (auto intro: sum_eq_Tim)
         also have "\<dots> = integral (\<Union>k\<le>n. T k) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
         proof (rule integral_unique [OF has_integral_Union, symmetric])
           fix S  assume "S \<in> T ` {..n}"
           then show "((\<lambda>x. \<bar>det (matrix (f' x))\<bar>) has_integral integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)) S"
           using absolutely_integrable_on_def aint_T by blast
         next
           show "pairwise (\<lambda>S S'. negligible (S \<inter> S')) (T ` {..n})"
             using disT unfolding disjnt_iff by (auto simp: pairwise_def intro!: empty_imp_negligible)
         qed auto
         also have "\<dots> \<le> m"
           unfolding m_def
         proof (rule integral_subset_le)
           have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on (\<Union>k\<le>n. T k)"
             apply (rule set_integrable_subset [OF aint_S])
              apply (intro measurable meas_t fmeasurableD)
             apply (force simp: Seq)
             done
           then show "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on (\<Union>k\<le>n. T k)"
             using absolutely_integrable_on_def by blast
         qed (use Seq int in auto)
         finally show "(\<Sum>k\<le>n. real k * e * ?\<mu> (T k)) \<le> m" .
       next
         have "(\<Sum>k\<le>n. ?\<mu> (T k)) = sum ?\<mu> (T ` {..n})"
           by (auto intro: sum_eq_Tim)
         also have "\<dots> = ?\<mu> (\<Union>k\<le>n. T k)"
           using S disT by (auto simp: pairwise_def meas_t intro: measure_Union' [symmetric])
         also have "\<dots> \<le> ?\<mu> S"
           using S by (auto simp: Seq intro: meas_t fmeasurableD measure_mono_fmeasurable)
         finally have "(\<Sum>k\<le>n. ?\<mu> (T k)) \<le> ?\<mu> S" .
         then show "(\<Sum>k\<le>n. e * ?\<mu> (T k)) \<le> e * ?\<mu> S"
           by (metis less_eq_real_def ordered_comm_semiring_class.comm_mult_left_mono sum_distrib_left that)
       qed
       finally show "(\<Sum>k\<le>n. ?\<mu> (f ` T k)) \<le> ?B" .
     qed
     moreover have "measure lebesgue (\<Union>k\<le>n. f ` T k) \<le> (\<Sum>k\<le>n. ?\<mu> (f ` T k))" for n
       by (simp add: fmeasurableD meas_ft measure_UNION_le)
     ultimately have B_ge_m: "?\<mu> (\<Union>k\<le>n. (f ` T k)) \<le> ?B" for n
       by (meson order_trans)
     have "(\<Union>n. f ` T n) \<in> lmeasurable"
       by (rule fmeasurable_countable_Union [OF meas_ft B_ge_m])
     moreover have "?\<mu> (\<Union>n. f ` T n) \<le> m + e * ?\<mu> S"
       by (rule measure_countable_Union_le [OF meas_ft B_ge_m])
     ultimately show "f ` S \<in> lmeasurable" "?\<mu> (f ` S) \<le> m + e * ?\<mu> S"
       by (auto simp: Seq image_Union)
   qed
   show ?thesis
   proof
     show "f ` S \<in> lmeasurable"
       using * linordered_field_no_ub by blast
     let ?x = "m - ?\<mu> (f ` S)"
     have False if "?\<mu> (f ` S) > integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
     proof -
       have ml: "m < ?\<mu> (f ` S)"
         using m_def that by blast
       then have "?\<mu> S \<noteq> 0"
         using "*"(2) bgauge_existence_lemma by fastforce
       with ml have 0: "0 < - (m - ?\<mu> (f ` S))/2 / ?\<mu> S"
         using that zero_less_measure_iff by force
       then show ?thesis
         using * [OF 0] that by (auto simp: field_split_simps m_def split: if_split_asm)
     qed
     then show "?\<mu> (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
       by fastforce
   qed
 qed
 
 
 theorem
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes S: "S \<in> sets lebesgue"
     and deriv: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and int: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   shows measurable_differentiable_image: "f ` S \<in> lmeasurable"
     and measure_differentiable_image:
        "measure lebesgue (f ` S) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" (is "?M")
 proof -
   let ?I = "\<lambda>n::nat. cbox (vec (-n)) (vec n) \<inter> S"
   let ?\<mu> = "measure lebesgue"
   have "x \<in> cbox (vec (- real (nat \<lceil>norm x\<rceil>))) (vec (real (nat \<lceil>norm x\<rceil>)))" for x :: "real^'n::_"
     apply (auto simp: mem_box_cart)
     apply (metis abs_le_iff component_le_norm_cart minus_le_iff of_nat_ceiling order.trans)
     by (meson abs_le_D1 norm_bound_component_le_cart real_nat_ceiling_ge)
   then have Seq: "S = (\<Union>n. ?I n)"
     by auto
   have fIn: "f ` ?I n \<in> lmeasurable"
        and mfIn: "?\<mu> (f ` ?I n) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" (is ?MN) for n
   proof -
     have In: "?I n \<in> lmeasurable"
       by (simp add: S bounded_Int bounded_set_imp_lmeasurable sets.Int)
     moreover have "\<And>x. x \<in> ?I n \<Longrightarrow> (f has_derivative f' x) (at x within ?I n)"
       by (meson Int_iff deriv has_derivative_within_subset subsetI)
     moreover have int_In: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on ?I n"
     proof -
       have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
         using int absolutely_integrable_integrable_bound by force
       then have "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on ?I n"
         by (metis (no_types) Int_lower1 In fmeasurableD inf_commute set_integrable_subset)
       then show ?thesis
         using absolutely_integrable_on_def by blast
     qed
     ultimately have "f ` ?I n \<in> lmeasurable" "?\<mu> (f ` ?I n) \<le> integral (?I n) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
       using m_diff_image_weak by metis+
     moreover have "integral (?I n) (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
       by (simp add: int_In int integral_subset_le)
     ultimately show "f ` ?I n \<in> lmeasurable" ?MN
       by auto
   qed
   have "?I k \<subseteq> ?I n" if "k \<le> n" for k n
     by (rule Int_mono) (use that in \<open>auto simp: subset_interval_imp_cart\<close>)
   then have "(\<Union>k\<le>n. f ` ?I k) = f ` ?I n" for n
     by (fastforce simp add:)
   with mfIn have "?\<mu> (\<Union>k\<le>n. f ` ?I k) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)" for n
     by simp
   then have "(\<Union>n. f ` ?I n) \<in> lmeasurable" "?\<mu> (\<Union>n. f ` ?I n) \<le> integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
     by (rule fmeasurable_countable_Union [OF fIn] measure_countable_Union_le [OF fIn])+
   then show "f ` S \<in> lmeasurable" ?M
     by (metis Seq image_UN)+
 qed
 
 
 lemma borel_measurable_simple_function_limit_increasing:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   shows "(f \<in> borel_measurable lebesgue \<and> (\<forall>x. 0 \<le> f x)) \<longleftrightarrow>
          (\<exists>g. (\<forall>n x. 0 \<le> g n x \<and> g n x \<le> f x) \<and> (\<forall>n x. g n x \<le> (g(Suc n) x)) \<and>
               (\<forall>n. g n \<in> borel_measurable lebesgue) \<and> (\<forall>n. finite(range (g n))) \<and>
               (\<forall>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x))"
          (is "?lhs = ?rhs")
 proof
   assume f: ?lhs
   have leb_f: "{x. a \<le> f x \<and> f x < b} \<in> sets lebesgue" for a b
   proof -
     have "{x. a \<le> f x \<and> f x < b} = {x. f x < b} - {x. f x < a}"
       by auto
     also have "\<dots> \<in> sets lebesgue"
       using borel_measurable_vimage_halfspace_component_lt [of f UNIV] f by auto
     finally show ?thesis .
   qed
   have "g n x \<le> f x"
         if inc_g: "\<And>n x. 0 \<le> g n x \<and> g n x \<le> g (Suc n) x"
            and meas_g: "\<And>n. g n \<in> borel_measurable lebesgue"
            and fin: "\<And>n. finite(range (g n))" and lim: "\<And>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x" for g n x
   proof -
     have "\<exists>r>0. \<forall>N. \<exists>n\<ge>N. dist (g n x) (f x) \<ge> r" if "g n x > f x"
     proof -
       have g: "g n x \<le> g (N + n) x" for N
         by (rule transitive_stepwise_le) (use inc_g in auto)
       have "\<exists>na\<ge>N. g n x - f x \<le> dist (g na x) (f x)" for N
         apply (rule_tac x="N+n" in exI)
         using g [of N] by (auto simp: dist_norm)
       with that show ?thesis
         using diff_gt_0_iff_gt by blast
     qed
     with lim show ?thesis
       apply (auto simp: lim_sequentially)
       by (meson less_le_not_le not_le_imp_less)
   qed
   moreover
   let ?\<Omega> = "\<lambda>n k. indicator {y. k/2^n \<le> f y \<and> f y < (k+1)/2^n}"
   let ?g = "\<lambda>n x. (\<Sum>k::real | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x)"
   have "\<exists>g. (\<forall>n x. 0 \<le> g n x \<and> g n x \<le> (g(Suc n) x)) \<and>
              (\<forall>n. g n \<in> borel_measurable lebesgue) \<and> (\<forall>n. finite(range (g n))) \<and>(\<forall>x. (\<lambda>n. g n x) \<longlonglongrightarrow> f x)"
   proof (intro exI allI conjI)
     show "0 \<le> ?g n x" for n x
     proof (clarify intro!: ordered_comm_monoid_add_class.sum_nonneg)
       fix k::real
       assume "k \<in> \<int>" and k: "\<bar>k\<bar> \<le> 2 ^ (2*n)"
       show "0 \<le> k/2^n * ?\<Omega> n k x"
         using f \<open>k \<in> \<int>\<close> apply (auto simp: indicator_def field_split_simps Ints_def)
         apply (drule spec [where x=x])
         using zero_le_power [of "2::real" n] mult_nonneg_nonneg [of "f x" "2^n"]
         by linarith
     qed
     show "?g n x \<le> ?g (Suc n) x" for n x
     proof -
       have "?g n x =
             (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n).
               k/2^n * (indicator {y. k/2^n \<le> f y \<and> f y < (k+1/2)/2^n} x +
               indicator {y. (k+1/2)/2^n \<le> f y \<and> f y < (k+1)/2^n} x))"
         by (rule sum.cong [OF refl]) (simp add: indicator_def field_split_simps)
       also have "\<dots> = (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * indicator {y. k/2^n \<le> f y \<and> f y < (k+1/2)/2^n} x) +
                        (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * indicator {y. (k+1/2)/2^n \<le> f y \<and> f y < (k+1)/2^n} x)"
         by (simp add:  comm_monoid_add_class.sum.distrib algebra_simps)
       also have "\<dots> = (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). (2 * k)/2 ^ Suc n * indicator {y. (2 * k)/2 ^ Suc n \<le> f y \<and> f y < (2 * k+1)/2 ^ Suc n} x) +
                        (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). (2 * k)/2 ^ Suc n * indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < ((2 * k+1) + 1)/2 ^ Suc n} x)"
         by (force simp: field_simps indicator_def intro: sum.cong)
       also have "\<dots> \<le> (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2 * Suc n). k/2 ^ Suc n * (indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x))"
                 (is "?a + _ \<le> ?b")
       proof -
         have *: "\<lbrakk>sum f I \<le> sum h I; a + sum h I \<le> b\<rbrakk> \<Longrightarrow> a + sum f I \<le> b" for I a b f and h :: "real\<Rightarrow>real"
           by linarith
         let ?h = "\<lambda>k. (2*k+1)/2 ^ Suc n *
                       (indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < ((2*k+1) + 1)/2 ^ Suc n} x)"
         show ?thesis
         proof (rule *)
           show "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n).
                   2 * k/2 ^ Suc n * indicator {y. (2 * k+1)/2 ^ Suc n \<le> f y \<and> f y < (2 * k+1 + 1)/2 ^ Suc n} x)
                 \<le> sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}"
             by (rule sum_mono) (simp add: indicator_def field_split_simps)
         next
           have \<alpha>: "?a = (\<Sum>k \<in> (*)2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
                          k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
             by (auto simp: inj_on_def field_simps comm_monoid_add_class.sum.reindex)
           have \<beta>: "sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}
                    = (\<Sum>k \<in> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
                       k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
             by (auto simp: inj_on_def field_simps comm_monoid_add_class.sum.reindex)
           have 0: "(*) 2 ` {k \<in> \<int>. P k} \<inter> (\<lambda>x. 2 * x + 1) ` {k \<in> \<int>. P k} = {}" for P :: "real \<Rightarrow> bool"
           proof -
             have "2 * i \<noteq> 2 * j + 1" for i j :: int by arith
             thus ?thesis
               unfolding Ints_def by auto (use of_int_eq_iff in fastforce)
           qed
           have "?a + sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}
                 = (\<Sum>k \<in> (*)2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}.
                   k/2 ^ Suc n * indicator {y. k/2 ^ Suc n \<le> f y \<and> f y < (k+1)/2 ^ Suc n} x)"
             unfolding \<alpha> \<beta>
             using finite_abs_int_segment [of "2 ^ (2*n)"]
             by (subst sum_Un) (auto simp: 0)
           also have "\<dots> \<le> ?b"
           proof (rule sum_mono2)
             show "finite {k::real. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)}"
               by (rule finite_abs_int_segment)
             show "(*) 2 ` {k::real. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2^(2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2^(2*n)} \<subseteq> {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)}"
               apply auto
               using one_le_power [of "2::real" "2*n"]  by linarith
             have *: "\<lbrakk>x \<in> (S \<union> T) - U; \<And>x. x \<in> S \<Longrightarrow> x \<in> U; \<And>x. x \<in> T \<Longrightarrow> x \<in> U\<rbrakk> \<Longrightarrow> P x" for S T U P
               by blast
             have "0 \<le> b" if "b \<in> \<int>" "f x * (2 * 2^n) < b + 1" for b
             proof -
               have "0 \<le> f x * (2 * 2^n)"
                 by (simp add: f)
               also have "\<dots> < b+1"
                 by (simp add: that)
               finally show "0 \<le> b"
                 using \<open>b \<in> \<int>\<close> by (auto simp: elim!: Ints_cases)
             qed
             then show "0 \<le> b/2 ^ Suc n * indicator {y. b/2 ^ Suc n \<le> f y \<and> f y < (b + 1)/2 ^ Suc n} x"
                   if "b \<in> {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2 * Suc n)} -
                           ((*) 2 ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<union> (\<lambda>x. 2*x + 1) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)})" for b
               using that by (simp add: indicator_def divide_simps)
           qed
           finally show "?a + sum ?h {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)} \<le> ?b" .
         qed
       qed
       finally show ?thesis .
     qed
     show "?g n \<in> borel_measurable lebesgue" for n
       apply (intro borel_measurable_indicator borel_measurable_times borel_measurable_sum)
       using leb_f sets_restrict_UNIV by auto
     show "finite (range (?g n))" for n
     proof -
       have "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x)
               \<in> (\<lambda>k. k/2^n) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)}" for x
       proof (cases "\<exists>k. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n) \<and> k/2^n \<le> f x \<and> f x < (k+1)/2^n")
         case True
         then show ?thesis
           by (blast intro: indicator_sum_eq)
       next
         case False
         then have "(\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) = 0"
           by auto
         then show ?thesis by force
       qed
       then have "range (?g n) \<subseteq> ((\<lambda>k. (k/2^n)) ` {k. k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n)})"
         by auto
       moreover have "finite ((\<lambda>k::real. (k/2^n)) ` {k \<in> \<int>. \<bar>k\<bar> \<le> 2 ^ (2*n)})"
         by (intro finite_imageI finite_abs_int_segment)
       ultimately show ?thesis
         by (rule finite_subset)
     qed
     show "(\<lambda>n. ?g n x) \<longlonglongrightarrow> f x" for x
     proof (clarsimp simp add: lim_sequentially)
       fix e::real
       assume "e > 0"
       obtain N1 where N1: "2 ^ N1 > abs(f x)"
         using real_arch_pow by fastforce
       obtain N2 where N2: "(1/2) ^ N2 < e"
         using real_arch_pow_inv \<open>e > 0\<close> by fastforce
       have "dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) (f x) < e" if "N1 + N2 \<le> n" for n
       proof -
         let ?m = "real_of_int \<lfloor>2^n * f x\<rfloor>"
         have "\<bar>?m\<bar> \<le> 2^n * 2^N1"
           using N1 apply (simp add: f)
           by (meson floor_mono le_floor_iff less_le_not_le mult_le_cancel_left_pos zero_less_numeral zero_less_power)
         also have "\<dots> \<le> 2 ^ (2*n)"
           by (metis that add_leD1 add_le_cancel_left mult.commute mult_2_right one_less_numeral_iff
                     power_add power_increasing_iff semiring_norm(76))
         finally have m_le: "\<bar>?m\<bar> \<le> 2 ^ (2*n)" .
         have "?m/2^n \<le> f x" "f x < (?m + 1)/2^n"
           by (auto simp: mult.commute pos_divide_le_eq mult_imp_less_div_pos)
         then have eq: "dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k/2^n * ?\<Omega> n k x) (f x)
                      = dist (?m/2^n) (f x)"
           by (subst indicator_sum_eq [of ?m]) (auto simp: m_le)
         have "\<bar>2^n\<bar> * \<bar>?m/2^n - f x\<bar> = \<bar>2^n * (?m/2^n - f x)\<bar>"
           by (simp add: abs_mult)
         also have "\<dots> < 2 ^ N2 * e"
           using N2 by (simp add: divide_simps mult.commute) linarith
         also have "\<dots> \<le> \<bar>2^n\<bar> * e"
           using that \<open>e > 0\<close> by auto
         finally have "dist (?m/2^n) (f x) < e"
           by (simp add: dist_norm)
         then show ?thesis
           using eq by linarith
       qed
       then show "\<exists>no. \<forall>n\<ge>no. dist (\<Sum>k | k \<in> \<int> \<and> \<bar>k\<bar> \<le> 2 ^ (2*n). k * ?\<Omega> n k x/2^n) (f x) < e"
         by force
     qed
   qed
   ultimately show ?rhs
     by metis
 next
   assume RHS: ?rhs
   with borel_measurable_simple_function_limit [of f UNIV, unfolded lebesgue_on_UNIV_eq]
   show ?lhs
     by (blast intro: order_trans)
 qed
 
 subsection\<open>Borel measurable Jacobian determinant\<close>
 
 lemma lemma_partial_derivatives0:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" and lim0: "((\<lambda>x. f x /\<^sub>R norm x) \<longlongrightarrow> 0) (at 0 within S)"
     and lb: "\<And>v. v \<noteq> 0 \<Longrightarrow> (\<exists>k>0. \<forall>e>0. \<exists>x. x \<in> S - {0} \<and> norm x < e \<and> k * norm x \<le> \<bar>v \<bullet> x\<bar>)"
   shows "f x = 0"
 proof -
   interpret linear f by fact
   have "dim {x. f x = 0} \<le> DIM('a)"
     by (rule dim_subset_UNIV)
   moreover have False if less: "dim {x. f x = 0} < DIM('a)"
   proof -
     obtain d where "d \<noteq> 0" and d: "\<And>y. f y = 0 \<Longrightarrow> d \<bullet> y = 0"
       using orthogonal_to_subspace_exists [OF less] orthogonal_def
       by (metis (mono_tags, lifting) mem_Collect_eq span_base)
     then obtain k where "k > 0"
       and k: "\<And>e. e > 0 \<Longrightarrow> \<exists>y. y \<in> S - {0} \<and> norm y < e \<and> k * norm y \<le> \<bar>d \<bullet> y\<bar>"
       using lb by blast
     have "\<exists>h. \<forall>n. ((h n \<in> S \<and> h n \<noteq> 0 \<and> k * norm (h n) \<le> \<bar>d \<bullet> h n\<bar>) \<and> norm (h n) < 1 / real (Suc n)) \<and>
                norm (h (Suc n)) < norm (h n)"
     proof (rule dependent_nat_choice)
       show "\<exists>y. (y \<in> S \<and> y \<noteq> 0 \<and> k * norm y \<le> \<bar>d \<bullet> y\<bar>) \<and> norm y < 1 / real (Suc 0)"
         by simp (metis DiffE insertCI k not_less not_one_le_zero)
     qed (use k [of "min (norm x) (1/(Suc n + 1))" for x n] in auto)
     then obtain \<alpha> where \<alpha>: "\<And>n. \<alpha> n \<in> S - {0}" and kd: "\<And>n. k * norm(\<alpha> n) \<le> \<bar>d \<bullet> \<alpha> n\<bar>"
          and norm_lt: "\<And>n. norm(\<alpha> n) < 1/(Suc n)"
       by force
     let ?\<beta> = "\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)"
     have com: "\<And>g. (\<forall>n. g n \<in> sphere (0::'a) 1)
               \<Longrightarrow> \<exists>l \<in> sphere 0 1. \<exists>\<rho>::nat\<Rightarrow>nat. strict_mono \<rho> \<and> (g \<circ> \<rho>) \<longlonglongrightarrow> l"
       using compact_sphere compact_def by metis
     moreover have "\<forall>n. ?\<beta> n \<in> sphere 0 1"
       using \<alpha> by auto
     ultimately obtain l::'a and \<rho>::"nat\<Rightarrow>nat"
        where l: "l \<in> sphere 0 1" and "strict_mono \<rho>" and to_l: "(?\<beta> \<circ> \<rho>) \<longlonglongrightarrow> l"
       by meson
     moreover have "continuous (at l) (\<lambda>x. (\<bar>d \<bullet> x\<bar> - k))"
       by (intro continuous_intros)
     ultimately have lim_dl: "((\<lambda>x. (\<bar>d \<bullet> x\<bar> - k)) \<circ> (?\<beta> \<circ> \<rho>)) \<longlonglongrightarrow> (\<bar>d \<bullet> l\<bar> - k)"
       by (meson continuous_imp_tendsto)
     have "\<forall>\<^sub>F i in sequentially. 0 \<le> ((\<lambda>x. \<bar>d \<bullet> x\<bar> - k) \<circ> ((\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>)) i"
       using \<alpha> kd by (auto simp: field_split_simps)
     then have "k \<le> \<bar>d \<bullet> l\<bar>"
       using tendsto_lowerbound [OF lim_dl, of 0] by auto
     moreover have "d \<bullet> l = 0"
     proof (rule d)
       show "f l = 0"
       proof (rule LIMSEQ_unique [of "f \<circ> ?\<beta> \<circ> \<rho>"])
         have "isCont f l"
           using \<open>linear f\<close> linear_continuous_at linear_conv_bounded_linear by blast
         then show "(f \<circ> (\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>) \<longlonglongrightarrow> f l"
           unfolding comp_assoc
           using to_l continuous_imp_tendsto by blast
         have "\<alpha> \<longlonglongrightarrow> 0"
           using norm_lt LIMSEQ_norm_0 by metis
         with \<open>strict_mono \<rho>\<close> have "(\<alpha> \<circ> \<rho>) \<longlonglongrightarrow> 0"
           by (metis LIMSEQ_subseq_LIMSEQ)
         with lim0 \<alpha> have "((\<lambda>x. f x /\<^sub>R norm x) \<circ> (\<alpha> \<circ> \<rho>)) \<longlonglongrightarrow> 0"
           by (force simp: tendsto_at_iff_sequentially)
         then show "(f \<circ> (\<lambda>n. \<alpha> n /\<^sub>R norm (\<alpha> n)) \<circ> \<rho>) \<longlonglongrightarrow> 0"
           by (simp add: o_def scale)
       qed
     qed
     ultimately show False
       using \<open>k > 0\<close> by auto
   qed
   ultimately have dim: "dim {x. f x = 0} = DIM('a)"
     by force
   then show ?thesis
     using dim_eq_full
     by (metis (mono_tags, lifting) eq_0_on_span eucl.span_Basis linear_axioms linear_eq_stdbasis
         mem_Collect_eq module_hom_zero span_base span_raw_def)
 qed
 
 lemma lemma_partial_derivatives:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" and lim: "((\<lambda>x. f (x - a) /\<^sub>R norm (x - a)) \<longlongrightarrow> 0) (at a within S)"
     and lb: "\<And>v. v \<noteq> 0 \<Longrightarrow> (\<exists>k>0.  \<forall>e>0. \<exists>x \<in> S - {a}. norm(a - x) < e \<and> k * norm(a - x) \<le> \<bar>v \<bullet> (x - a)\<bar>)"
   shows "f x = 0"
 proof -
   have "((\<lambda>x. f x /\<^sub>R norm x) \<longlongrightarrow> 0) (at 0 within (\<lambda>x. x-a) ` S)"
     using lim by (simp add: Lim_within dist_norm)
   then show ?thesis
   proof (rule lemma_partial_derivatives0 [OF \<open>linear f\<close>])
     fix v :: "'a"
     assume v: "v \<noteq> 0"
     show "\<exists>k>0. \<forall>e>0. \<exists>x. x \<in> (\<lambda>x. x - a) ` S - {0} \<and> norm x < e \<and> k * norm x \<le> \<bar>v \<bullet> x\<bar>"
       using lb [OF v] by (force simp:  norm_minus_commute)
   qed
 qed
 
 
 proposition borel_measurable_partial_derivatives:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n"
   assumes S: "S \<in> sets lebesgue"
     and f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   shows "(\<lambda>x. (matrix(f' x)$m$n)) \<in> borel_measurable (lebesgue_on S)"
 proof -
   have contf: "continuous_on S f"
     using continuous_on_eq_continuous_within f has_derivative_continuous by blast
   have "{x \<in> S.  (matrix (f' x)$m$n) \<le> b} \<in> sets lebesgue" for b
   proof (rule sets_negligible_symdiff)
     let ?T = "{x \<in> S. \<forall>e>0. \<exists>d>0. \<exists>A. A$m$n < b \<and> (\<forall>i j. A$i$j \<in> \<rat>) \<and>
                        (\<forall>y \<in> S. norm(y - x) < d \<longrightarrow> norm(f y - f x - A *v (y - x)) \<le> e * norm(y - x))}"
     let ?U = "S \<inter>
               (\<Inter>e \<in> {e \<in> \<rat>. e > 0}.
                 \<Union>A \<in> {A. A$m$n < b \<and> (\<forall>i j. A$i$j \<in> \<rat>)}.
                   \<Union>d \<in> {d \<in> \<rat>. 0 < d}.
                      S \<inter> (\<Inter>y \<in> S. {x \<in> S. norm(y - x) < d \<longrightarrow> norm(f y - f x - A *v (y - x)) \<le> e * norm(y - x)}))"
     have "?T = ?U"
     proof (intro set_eqI iffI)
       fix x
       assume xT: "x \<in> ?T"
       then show "x \<in> ?U"
       proof (clarsimp simp add:)
         fix q :: real
         assume "q \<in> \<rat>" "q > 0"
         then obtain d A where "d > 0" and A: "A $ m $ n < b" "\<And>i j. A $ i $ j \<in> \<rat>"
           "\<And>y. \<lbrakk>y\<in>S;  norm (y - x) < d\<rbrakk> \<Longrightarrow> norm (f y - f x - A *v (y - x)) \<le> q * norm (y - x)"
           using xT by auto
         then obtain \<delta> where "d > \<delta>" "\<delta> > 0" "\<delta> \<in> \<rat>"
           using Rats_dense_in_real by blast
         with A show "\<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
                          (\<exists>s. s \<in> \<rat> \<and> 0 < s \<and> (\<forall>y\<in>S. norm (y - x) < s \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> q * norm (y - x)))"
           by force
       qed
     next
       fix x
       assume xU: "x \<in> ?U"
       then show "x \<in> ?T"
       proof clarsimp
         fix e :: "real"
         assume "e > 0"
         then obtain \<epsilon> where \<epsilon>: "e > \<epsilon>" "\<epsilon> > 0" "\<epsilon> \<in> \<rat>"
           using Rats_dense_in_real by blast
         with xU obtain A r where "x \<in> S" and Ar: "A $ m $ n < b" "\<forall>i j. A $ i $ j \<in> \<rat>" "r \<in> \<rat>" "r > 0"
           and "\<forall>y\<in>S. norm (y - x) < r \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> \<epsilon> * norm (y - x)"
           by (auto simp: split: if_split_asm)
         then have "\<forall>y\<in>S. norm (y - x) < r \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)"
           by (meson \<open>e > \<epsilon>\<close> less_eq_real_def mult_right_mono norm_ge_zero order_trans)
         then show "\<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and> (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
           using \<open>x \<in> S\<close> Ar by blast
       qed
     qed
     moreover have "?U \<in> sets lebesgue"
     proof -
       have coQ: "countable {e \<in> \<rat>. 0 < e}"
         using countable_Collect countable_rat by blast
       have ne: "{e \<in> \<rat>. (0::real) < e} \<noteq> {}"
         using zero_less_one Rats_1 by blast
       have coA: "countable {A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>)}"
       proof (rule countable_subset)
         show "countable {A. \<forall>i j. A $ i $ j \<in> \<rat>}"
           using countable_vector [OF countable_vector, of "\<lambda>i j. \<rat>"] by (simp add: countable_rat)
       qed blast
       have *: "\<lbrakk>U \<noteq> {} \<Longrightarrow> closedin (top_of_set S) (S \<inter> \<Inter> U)\<rbrakk>
                \<Longrightarrow> closedin (top_of_set S) (S \<inter> \<Inter> U)" for U
         by fastforce
       have eq: "{x::(real,'m)vec. P x \<and> (Q x \<longrightarrow> R x)} = {x. P x \<and> \<not> Q x} \<union> {x. P x \<and> R x}" for P Q R
         by auto
       have sets: "S \<inter> (\<Inter>y\<in>S. {x \<in> S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)})
                   \<in> sets lebesgue" for e A d
       proof -
         have clo: "closedin (top_of_set S)
                      {x \<in> S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x)}"
           for y
         proof -
           have cont1: "continuous_on S (\<lambda>x. norm (y - x))"
           and  cont2: "continuous_on S (\<lambda>x. e * norm (y - x) - norm (f y - f x - (A *v y - A *v x)))"
             by (force intro: contf continuous_intros)+
           have clo1: "closedin (top_of_set S) {x \<in> S. d \<le> norm (y - x)}"
             using continuous_closedin_preimage [OF cont1, of "{d..}"] by (simp add: vimage_def Int_def)
           have clo2: "closedin (top_of_set S)
                        {x \<in> S. norm (f y - f x - (A *v y - A *v x)) \<le> e * norm (y - x)}"
             using continuous_closedin_preimage [OF cont2, of "{0..}"] by (simp add: vimage_def Int_def)
           show ?thesis
             by (auto simp: eq not_less matrix_vector_mult_diff_distrib intro: clo1 clo2)
         qed
         show ?thesis
           by (rule lebesgue_closedin [of S]) (force intro: * S clo)+
       qed
       show ?thesis
         by (intro sets sets.Int S sets.countable_UN'' sets.countable_INT'' coQ coA) auto
     qed
     ultimately show "?T \<in> sets lebesgue"
       by simp
     let ?M = "(?T - {x \<in> S. matrix (f' x) $ m $ n \<le> b} \<union> ({x \<in> S. matrix (f' x) $ m $ n \<le> b} - ?T))"
     let ?\<Theta> = "\<lambda>x v. \<forall>\<xi>>0. \<exists>e>0. \<forall>y \<in> S-{x}. norm (x - y) < e \<longrightarrow> \<bar>v \<bullet> (y - x)\<bar> < \<xi> * norm (x - y)"
     have nN: "negligible {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
       unfolding negligible_eq_zero_density
     proof clarsimp
       fix x v and r e :: "real"
       assume "x \<in> S" "v \<noteq> 0" "r > 0" "e > 0"
       and Theta [rule_format]: "?\<Theta> x v"
       moreover have "(norm v * e / 2) / CARD('m) ^ CARD('m) > 0"
         by (simp add: \<open>v \<noteq> 0\<close> \<open>e > 0\<close>)
       ultimately obtain d where "d > 0"
          and dless: "\<And>y. \<lbrakk>y \<in> S - {x}; norm (x - y) < d\<rbrakk> \<Longrightarrow>
                         \<bar>v \<bullet> (y - x)\<bar> < ((norm v * e / 2) / CARD('m) ^ CARD('m)) * norm (x - y)"
         by metis
       let ?W = "ball x (min d r) \<inter> {y. \<bar>v \<bullet> (y - x)\<bar> < (norm v * e/2 * min d r) / CARD('m) ^ CARD('m)}"
       have "open {x. \<bar>v \<bullet> (x - a)\<bar> < b}" for a b
         by (intro open_Collect_less continuous_intros)
       show "\<exists>d>0. d \<le> r \<and>
             (\<exists>U. {x' \<in> S. \<exists>v\<noteq>0. ?\<Theta> x' v} \<inter> ball x d \<subseteq> U \<and>
                  U \<in> lmeasurable \<and> measure lebesgue U < e * content (ball x d))"
       proof (intro exI conjI)
         show "0 < min d r" "min d r \<le> r"
           using \<open>r > 0\<close> \<open>d > 0\<close> by auto
         show "{x' \<in> S. \<exists>v. v \<noteq> 0 \<and> (\<forall>\<xi>>0. \<exists>e>0. \<forall>z\<in>S - {x'}. norm (x' - z) < e \<longrightarrow> \<bar>v \<bullet> (z - x')\<bar> < \<xi> * norm (x' - z))} \<inter> ball x (min d r) \<subseteq> ?W"
           proof (clarsimp simp: dist_norm norm_minus_commute)
             fix y w
             assume "y \<in> S" "w \<noteq> 0"
               and less [rule_format]:
                     "\<forall>\<xi>>0. \<exists>e>0. \<forall>z\<in>S - {y}. norm (y - z) < e \<longrightarrow> \<bar>w \<bullet> (z - y)\<bar> < \<xi> * norm (y - z)"
               and d: "norm (y - x) < d" and r: "norm (y - x) < r"
             show "\<bar>v \<bullet> (y - x)\<bar> < norm v * e * min d r / (2 * real CARD('m) ^ CARD('m))"
             proof (cases "y = x")
               case True
               with \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> \<open>v \<noteq> 0\<close> show ?thesis
                 by simp
             next
               case False
               have "\<bar>v \<bullet> (y - x)\<bar> < norm v * e / 2 / real (CARD('m) ^ CARD('m)) * norm (x - y)"
                 apply (rule dless)
                 using False \<open>y \<in> S\<close> d by (auto simp: norm_minus_commute)
               also have "\<dots> \<le> norm v * e * min d r / (2 * real CARD('m) ^ CARD('m))"
                 using d r \<open>e > 0\<close> by (simp add: field_simps norm_minus_commute mult_left_mono)
               finally show ?thesis .
             qed
           qed
           show "?W \<in> lmeasurable"
             by (simp add: fmeasurable_Int_fmeasurable borel_open)
           obtain k::'m where True
             by metis
           obtain T where T: "orthogonal_transformation T" and v: "v = T(norm v *\<^sub>R axis k (1::real))"
             using rotation_rightward_line by metis
           define b where "b \<equiv> norm v"
           have "b > 0"
             using \<open>v \<noteq> 0\<close> by (auto simp: b_def)
           obtain eqb: "inv T v = b *\<^sub>R axis k (1::real)" and "inj T" "bij T" and invT: "orthogonal_transformation (inv T)"
             by (metis UNIV_I b_def  T v bij_betw_inv_into_left orthogonal_transformation_inj orthogonal_transformation_bij orthogonal_transformation_inv)
           let ?v = "\<chi> i. min d r / CARD('m)"
           let ?v' = "\<chi> i. if i = k then (e/2 * min d r) / CARD('m) ^ CARD('m) else min d r"
           let ?x' = "inv T x"
           let ?W' = "(ball ?x' (min d r) \<inter> {y. \<bar>(y - ?x')$k\<bar> < e * min d r / (2 * CARD('m) ^ CARD('m))})"
           have abs: "x - e \<le> y \<and> y \<le> x + e \<longleftrightarrow> abs(y - x) \<le> e" for x y e::real
             by auto
           have "?W = T ` ?W'"
           proof -
             have 1: "T ` (ball (inv T x) (min d r)) = ball x (min d r)"
               by (simp add: T image_orthogonal_transformation_ball orthogonal_transformation_surj surj_f_inv_f)
             have 2: "{y. \<bar>v \<bullet> (y - x)\<bar> < b * e * min d r / (2 * real CARD('m) ^ CARD('m))} =
                       T ` {y. \<bar>y $ k - ?x' $ k\<bar> < e * min d r / (2 * real CARD('m) ^ CARD('m))}"
             proof -
               have *: "\<bar>T (b *\<^sub>R axis k 1) \<bullet> (y - x)\<bar> = b * \<bar>inv T y $ k - ?x' $ k\<bar>" for y
               proof -
                 have "\<bar>T (b *\<^sub>R axis k 1) \<bullet> (y - x)\<bar> = \<bar>(b *\<^sub>R axis k 1) \<bullet> inv T (y - x)\<bar>"
                   by (metis (no_types, hide_lams) b_def eqb invT orthogonal_transformation_def v)
                 also have "\<dots> = b * \<bar>(axis k 1) \<bullet> inv T (y - x)\<bar>"
                   using \<open>b > 0\<close> by (simp add: abs_mult)
                 also have "\<dots> = b * \<bar>inv T y $ k - ?x' $ k\<bar>"
                   using orthogonal_transformation_linear [OF invT]
                   by (simp add: inner_axis' linear_diff)
                 finally show ?thesis
                   by simp
               qed
               show ?thesis
                 using v b_def [symmetric]
                 using \<open>b > 0\<close> by (simp add: * bij_image_Collect_eq [OF \<open>bij T\<close>] mult_less_cancel_left_pos times_divide_eq_right [symmetric] del: times_divide_eq_right)
             qed
             show ?thesis
               using \<open>b > 0\<close> by (simp add: image_Int \<open>inj T\<close> 1 2 b_def [symmetric])
           qed
           moreover have "?W' \<in> lmeasurable"
             by (auto intro: fmeasurable_Int_fmeasurable)
           ultimately have "measure lebesgue ?W = measure lebesgue ?W'"
             by (metis measure_orthogonal_image T)
           also have "\<dots> \<le> measure lebesgue (cbox (?x' - ?v') (?x' + ?v'))"
           proof (rule measure_mono_fmeasurable)
             show "?W' \<subseteq> cbox (?x' - ?v') (?x' + ?v')"
               apply (clarsimp simp add: mem_box_cart abs dist_norm norm_minus_commute simp del: min_less_iff_conj min.bounded_iff)
               by (metis component_le_norm_cart less_eq_real_def le_less_trans vector_minus_component)
           qed auto
           also have "\<dots> \<le> e/2 * measure lebesgue (cbox (?x' - ?v) (?x' + ?v))"
           proof -
             have "cbox (?x' - ?v) (?x' + ?v) \<noteq> {}"
               using \<open>r > 0\<close> \<open>d > 0\<close> by (auto simp: interval_eq_empty_cart divide_less_0_iff)
             with \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> show ?thesis
               apply (simp add: content_cbox_if_cart mem_box_cart)
               apply (auto simp: prod_nonneg)
-              apply (simp add: abs if_distrib prod.delta_remove prod_constant field_simps power_diff split: if_split_asm)
+              apply (simp add: abs if_distrib prod.delta_remove field_simps power_diff split: if_split_asm)
               done
           qed
           also have "\<dots> \<le> e/2 * measure lebesgue (cball ?x' (min d r))"
           proof (rule mult_left_mono [OF measure_mono_fmeasurable])
             have *: "norm (?x' - y) \<le> min d r"
               if y: "\<And>i. \<bar>?x' $ i - y $ i\<bar> \<le> min d r / real CARD('m)" for y
             proof -
               have "norm (?x' - y) \<le> (\<Sum>i\<in>UNIV. \<bar>(?x' - y) $ i\<bar>)"
                 by (rule norm_le_l1_cart)
               also have "\<dots> \<le> real CARD('m) * (min d r / real CARD('m))"
                 by (rule sum_bounded_above) (use y in auto)
               finally show ?thesis
                 by simp
             qed
             show "cbox (?x' - ?v) (?x' + ?v) \<subseteq> cball ?x' (min d r)"
               apply (clarsimp simp only: mem_box_cart dist_norm mem_cball intro!: *)
               by (simp add: abs_diff_le_iff abs_minus_commute)
           qed (use \<open>e > 0\<close> in auto)
           also have "\<dots> < e * content (cball ?x' (min d r))"
             using \<open>r > 0\<close> \<open>d > 0\<close> \<open>e > 0\<close> by auto
           also have "\<dots> = e * content (ball x (min d r))"
             using \<open>r > 0\<close> \<open>d > 0\<close> by (simp add: content_cball content_ball)
           finally show "measure lebesgue ?W < e * content (ball x (min d r))" .
       qed
     qed
     have *: "(\<And>x. (x \<notin> S) \<Longrightarrow> (x \<in> T \<longleftrightarrow> x \<in> U)) \<Longrightarrow> (T - U) \<union> (U - T) \<subseteq> S" for S T U :: "(real,'m) vec set"
       by blast
     have MN: "?M \<subseteq> {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
     proof (rule *)
       fix x
       assume x: "x \<notin> {x \<in> S. \<exists>v\<noteq>0. ?\<Theta> x v}"
       show "(x \<in> ?T) \<longleftrightarrow> (x \<in> {x \<in> S. matrix (f' x) $ m $ n \<le> b})"
       proof (cases "x \<in> S")
         case True
         then have x: "\<not> ?\<Theta> x v" if "v \<noteq> 0" for v
           using x that by force
         show ?thesis
         proof (rule iffI; clarsimp)
           assume b: "\<forall>e>0. \<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
                                     (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
                      (is "\<forall>e>0. \<exists>d>0. \<exists>A. ?\<Phi> e d A")
           then have "\<forall>k. \<exists>d>0. \<exists>A. ?\<Phi> (1 / Suc k) d A"
             by (metis (no_types, hide_lams) less_Suc_eq_0_disj of_nat_0_less_iff zero_less_divide_1_iff)
           then obtain \<delta> A where \<delta>: "\<And>k. \<delta> k > 0"
                            and Ab: "\<And>k. A k $ m $ n < b"
                            and A: "\<And>k y. \<lbrakk>y \<in> S; norm (y - x) < \<delta> k\<rbrakk> \<Longrightarrow>
                                           norm (f y - f x - A k *v (y - x)) \<le> 1/(Suc k) * norm (y - x)"
             by metis
           have "\<forall>i j. \<exists>a. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> a"
           proof (intro allI)
             fix i j
             have vax: "(A n *v axis j 1) $ i = A n $ i $ j" for n
               by (metis cart_eq_inner_axis matrix_vector_mul_component)
             let ?CA = "{x. Cauchy (\<lambda>n. (A n) *v x)}"
             have "subspace ?CA"
               unfolding subspace_def convergent_eq_Cauchy [symmetric]
                 by (force simp: algebra_simps intro: tendsto_intros)
             then have CA_eq: "?CA = span ?CA"
               by (metis span_eq_iff)
             also have "\<dots> = UNIV"
             proof -
               have "dim ?CA \<le> CARD('m)"
                 using dim_subset_UNIV[of ?CA]
                 by auto
               moreover have "False" if less: "dim ?CA < CARD('m)"
               proof -
                 obtain d where "d \<noteq> 0" and d: "\<And>y. y \<in> span ?CA \<Longrightarrow> orthogonal d y"
                   using less by (force intro: orthogonal_to_subspace_exists [of ?CA])
                 with x [OF \<open>d \<noteq> 0\<close>] obtain \<xi> where "\<xi> > 0"
                   and \<xi>: "\<And>e. e > 0 \<Longrightarrow> \<exists>y \<in> S - {x}. norm (x - y) < e \<and> \<xi> * norm (x - y) \<le> \<bar>d \<bullet> (y - x)\<bar>"
                   by (fastforce simp: not_le Bex_def)
                 obtain \<gamma> z where \<gamma>Sx: "\<And>i. \<gamma> i \<in> S - {x}"
                            and \<gamma>le:   "\<And>i. \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar>"
                            and \<gamma>x:    "\<gamma> \<longlonglongrightarrow> x"
                            and z:     "(\<lambda>n. (\<gamma> n - x) /\<^sub>R norm (\<gamma> n - x)) \<longlonglongrightarrow> z"
                 proof -
                   have "\<exists>\<gamma>. (\<forall>i. (\<gamma> i \<in> S - {x} \<and>
                                   \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar> \<and> norm(\<gamma> i - x) < 1/Suc i) \<and>
                                  norm(\<gamma>(Suc i) - x) < norm(\<gamma> i - x))"
                   proof (rule dependent_nat_choice)
                     show "\<exists>y. y \<in> S - {x} \<and> \<xi> * norm (y - x) \<le> \<bar>d \<bullet> (y - x)\<bar> \<and> norm (y - x) < 1 / Suc 0"
                       using \<xi> [of 1] by (auto simp: dist_norm norm_minus_commute)
                   next
                     fix y i
                     assume "y \<in> S - {x} \<and> \<xi> * norm (y - x) \<le> \<bar>d \<bullet> (y - x)\<bar> \<and> norm (y - x) < 1/Suc i"
                     then have "min (norm(y - x)) (1/((Suc i) + 1)) > 0"
                       by auto
                     then obtain y' where "y' \<in> S - {x}" and y': "norm (x - y') < min (norm (y - x)) (1/((Suc i) + 1))"
                                          "\<xi> * norm (x - y') \<le> \<bar>d \<bullet> (y' - x)\<bar>"
                       using \<xi> by metis
                     with \<xi> show "\<exists>y'. (y' \<in> S - {x} \<and> \<xi> * norm (y' - x) \<le> \<bar>d \<bullet> (y' - x)\<bar> \<and>
                               norm (y' - x) < 1/(Suc (Suc i))) \<and> norm (y' - x) < norm (y - x)"
                       by (auto simp: dist_norm norm_minus_commute)
                   qed
                   then obtain \<gamma> where
                         \<gamma>Sx: "\<And>i. \<gamma> i \<in> S - {x}"
                         and \<gamma>le: "\<And>i. \<xi> * norm(\<gamma> i - x) \<le> \<bar>d \<bullet> (\<gamma> i - x)\<bar>"
                         and \<gamma>conv: "\<And>i. norm(\<gamma> i - x) < 1/(Suc i)"
                     by blast
                   let ?f = "\<lambda>i. (\<gamma> i - x) /\<^sub>R norm (\<gamma> i - x)"
                   have "?f i \<in> sphere 0 1" for i
                     using \<gamma>Sx by auto
                   then obtain l \<rho> where "l \<in> sphere 0 1" "strict_mono \<rho>" and l: "(?f \<circ> \<rho>) \<longlonglongrightarrow> l"
                     using compact_sphere [of "0::(real,'m) vec" 1]  unfolding compact_def by meson
                   show thesis
                   proof
                     show "(\<gamma> \<circ> \<rho>) i \<in> S - {x}" "\<xi> * norm ((\<gamma> \<circ> \<rho>) i - x) \<le> \<bar>d \<bullet> ((\<gamma> \<circ> \<rho>) i - x)\<bar>" for i
                       using \<gamma>Sx \<gamma>le by auto
                     have "\<gamma> \<longlonglongrightarrow> x"
                     proof (clarsimp simp add: LIMSEQ_def dist_norm)
                       fix r :: "real"
                       assume "r > 0"
                       with real_arch_invD obtain no where "no \<noteq> 0" "real no > 1/r"
                         by (metis divide_less_0_1_iff not_less_iff_gr_or_eq of_nat_0_eq_iff reals_Archimedean2)
                       with \<gamma>conv show "\<exists>no. \<forall>n\<ge>no. norm (\<gamma> n - x) < r"
                         by (metis \<open>r > 0\<close> add.commute divide_inverse inverse_inverse_eq inverse_less_imp_less less_trans mult.left_neutral nat_le_real_less of_nat_Suc)
                     qed
                     with \<open>strict_mono \<rho>\<close> show "(\<gamma> \<circ> \<rho>) \<longlonglongrightarrow> x"
                       by (metis LIMSEQ_subseq_LIMSEQ)
                     show "(\<lambda>n. ((\<gamma> \<circ> \<rho>) n - x) /\<^sub>R norm ((\<gamma> \<circ> \<rho>) n - x)) \<longlonglongrightarrow> l"
                       using l by (auto simp: o_def)
                   qed
                 qed
                 have "isCont (\<lambda>x. (\<bar>d \<bullet> x\<bar> - \<xi>)) z"
                   by (intro continuous_intros)
                 from isCont_tendsto_compose [OF this z]
                 have lim: "(\<lambda>y. \<bar>d \<bullet> ((\<gamma> y - x) /\<^sub>R norm (\<gamma> y - x))\<bar> - \<xi>) \<longlonglongrightarrow> \<bar>d \<bullet> z\<bar> - \<xi>"
                   by auto
                 moreover have "\<forall>\<^sub>F i in sequentially. 0 \<le> \<bar>d \<bullet> ((\<gamma> i - x) /\<^sub>R norm (\<gamma> i - x))\<bar> - \<xi>"
                 proof (rule eventuallyI)
                   fix n
                   show "0 \<le> \<bar>d \<bullet> ((\<gamma> n - x) /\<^sub>R norm (\<gamma> n - x))\<bar> - \<xi>"
                   using \<gamma>le [of n] \<gamma>Sx by (auto simp: abs_mult divide_simps)
                 qed
                 ultimately have "\<xi> \<le> \<bar>d \<bullet> z\<bar>"
                   using tendsto_lowerbound [where a=0] by fastforce
                 have "Cauchy (\<lambda>n. (A n) *v z)"
                 proof (clarsimp simp add: Cauchy_def)
                   fix \<epsilon> :: "real"
                   assume "0 < \<epsilon>"
                   then obtain N::nat where "N > 0" and N: "\<epsilon>/2 > 1/N"
                     by (metis half_gt_zero inverse_eq_divide neq0_conv real_arch_inverse)
                   show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (A m *v z) (A n *v z) < \<epsilon>"
                   proof (intro exI allI impI)
                     fix i j
                     assume ij: "N \<le> i" "N \<le> j"
                     let ?V = "\<lambda>i k. A i *v ((\<gamma> k - x) /\<^sub>R norm (\<gamma> k - x))"
                     have "\<forall>\<^sub>F k in sequentially. dist (\<gamma> k) x < min (\<delta> i) (\<delta> j)"
                       using \<gamma>x [unfolded tendsto_iff] by (meson min_less_iff_conj \<delta>)
                     then have even: "\<forall>\<^sub>F k in sequentially. norm (?V i k - ?V j k) - 2 / N \<le> 0"
                     proof (rule eventually_mono, clarsimp)
                       fix p
                       assume p: "dist (\<gamma> p) x < \<delta> i" "dist (\<gamma> p) x < \<delta> j"
                       let ?C = "\<lambda>k. f (\<gamma> p) - f x - A k *v (\<gamma> p - x)"
                       have "norm ((A i - A j) *v (\<gamma> p - x)) = norm (?C j - ?C i)"
                         by (simp add: algebra_simps)
                       also have "\<dots> \<le> norm (?C j) + norm (?C i)"
                         using norm_triangle_ineq4 by blast
                       also have "\<dots> \<le> 1/(Suc j) * norm (\<gamma> p - x) + 1/(Suc i) * norm (\<gamma> p - x)"
                         by (metis A Diff_iff \<gamma>Sx dist_norm p add_mono)
                       also have "\<dots> \<le> 1/N * norm (\<gamma> p - x) + 1/N * norm (\<gamma> p - x)"
                         apply (intro add_mono mult_right_mono)
                         using ij \<open>N > 0\<close> by (auto simp: field_simps)
                       also have "\<dots> = 2 / N * norm (\<gamma> p - x)"
                         by simp
                       finally have no_le: "norm ((A i - A j) *v (\<gamma> p - x)) \<le> 2 / N * norm (\<gamma> p - x)" .
                       have "norm (?V i p - ?V j p) =
                             norm ((A i - A j) *v ((\<gamma> p - x) /\<^sub>R norm (\<gamma> p - x)))"
                         by (simp add: algebra_simps)
                       also have "\<dots> = norm ((A i - A j) *v (\<gamma> p - x)) / norm (\<gamma> p - x)"
                         by (simp add: divide_inverse matrix_vector_mult_scaleR)
                       also have "\<dots> \<le> 2 / N"
                         using no_le by (auto simp: field_split_simps)
                       finally show "norm (?V i p - ?V j p) \<le> 2 / N" .
                     qed
                     have "isCont (\<lambda>w. (norm(A i *v w - A j *v w) - 2 / N)) z"
                       by (intro continuous_intros)
                     from isCont_tendsto_compose [OF this z]
                     have lim: "(\<lambda>w. norm (A i *v ((\<gamma> w - x) /\<^sub>R norm (\<gamma> w - x)) -
                                     A j *v ((\<gamma> w - x) /\<^sub>R norm (\<gamma> w - x))) - 2 / N)
                                \<longlonglongrightarrow> norm (A i *v z - A j *v z) - 2 / N"
                       by auto
                     have "dist (A i *v z) (A j *v z) \<le> 2 / N"
                       using tendsto_upperbound [OF lim even] by (auto simp: dist_norm)
                     with N show "dist (A i *v z) (A j *v z) < \<epsilon>"
                       by linarith
                   qed
                 qed
                 then have "d \<bullet> z = 0"
                   using CA_eq d orthogonal_def by auto
                 then show False
                   using \<open>0 < \<xi>\<close> \<open>\<xi> \<le> \<bar>d \<bullet> z\<bar>\<close> by auto
               qed
               ultimately show ?thesis
                 using dim_eq_full by fastforce
             qed
             finally have "?CA = UNIV" .
             then have "Cauchy (\<lambda>n. (A n) *v axis j 1)"
               by auto
             then obtain L where "(\<lambda>n. A n *v axis j 1) \<longlonglongrightarrow> L"
               by (auto simp: Cauchy_convergent_iff convergent_def)
             then have "(\<lambda>x. (A x *v axis j 1) $ i) \<longlonglongrightarrow> L $ i"
               by (rule tendsto_vec_nth)
             then show "\<exists>a. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> a"
               by (force simp: vax)
           qed
           then obtain B where B: "\<And>i j. (\<lambda>n. A n $ i $ j) \<longlonglongrightarrow> B $ i $ j"
             by (auto simp: lambda_skolem)
           have lin_df: "linear (f' x)"
                and lim_df: "((\<lambda>y. (1 / norm (y - x)) *\<^sub>R (f y - (f x + f' x (y - x)))) \<longlongrightarrow> 0) (at x within S)"
             using \<open>x \<in> S\<close> assms by (auto simp: has_derivative_within linear_linear)
           moreover
           interpret linear "f' x" by fact
           have "(matrix (f' x) - B) *v w = 0" for w
           proof (rule lemma_partial_derivatives [of "(*v) (matrix (f' x) - B)"])
             show "linear ((*v) (matrix (f' x) - B))"
               by (rule matrix_vector_mul_linear)
             have "((\<lambda>y. ((f x + f' x (y - x)) - f y) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
               using tendsto_minus [OF lim_df] by (simp add: algebra_simps field_split_simps)
             then show "((\<lambda>y. (matrix (f' x) - B) *v (y - x) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
             proof (rule Lim_transform)
               have "((\<lambda>y. ((f y + B *v x - (f x + B *v y)) /\<^sub>R norm (y - x))) \<longlongrightarrow> 0) (at x within S)"
               proof (clarsimp simp add: Lim_within dist_norm)
                 fix e :: "real"
                 assume "e > 0"
                 then obtain q::nat where "q \<noteq> 0" and qe2: "1/q < e/2"
                   by (metis divide_pos_pos inverse_eq_divide real_arch_inverse zero_less_numeral)
                 let ?g = "\<lambda>p. sum  (\<lambda>i. sum (\<lambda>j. abs((A p - B)$i$j)) UNIV) UNIV"
                 have "(\<lambda>k. onorm (\<lambda>y. (A k - B) *v y)) \<longlonglongrightarrow> 0"
                 proof (rule Lim_null_comparison)
                   show "\<forall>\<^sub>F k in sequentially. norm (onorm (\<lambda>y. (A k - B) *v y)) \<le> ?g k"
                   proof (rule eventually_sequentiallyI)
                     fix k :: "nat"
                     assume "0 \<le> k"
                     have "0 \<le> onorm ((*v) (A k - B))"
                       using matrix_vector_mul_bounded_linear
                       by (rule onorm_pos_le)
                     then show "norm (onorm ((*v) (A k - B))) \<le> (\<Sum>i\<in>UNIV. \<Sum>j\<in>UNIV. \<bar>(A k - B) $ i $ j\<bar>)"
                       by (simp add: onorm_le_matrix_component_sum del: vector_minus_component)
                   qed
                 next
                   show "?g \<longlonglongrightarrow> 0"
                     using B Lim_null tendsto_rabs_zero_iff by (fastforce intro!: tendsto_null_sum)
                 qed
                 with \<open>e > 0\<close> obtain p where "\<And>n. n \<ge> p \<Longrightarrow> \<bar>onorm ((*v) (A n - B))\<bar> < e/2"
                   unfolding lim_sequentially by (metis diff_zero dist_real_def divide_pos_pos zero_less_numeral)
                 then have pqe2: "\<bar>onorm ((*v) (A (p + q) - B))\<bar> < e/2" (*17 [`abs (onorm (\y. A (p + q) ** y - B ** y)) < e / &2`]*)
                   using le_add1 by blast
                 show "\<exists>d>0. \<forall>y\<in>S. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow>
                            inverse (norm (y - x)) * norm (f y + B *v x - (f x + B *v y)) < e"
                 proof (intro exI, safe)
                   show "0 < \<delta>(p + q)"
                     by (simp add: \<delta>)
                 next
                   fix y
                   assume y: "y \<in> S" "norm (y - x) < \<delta>(p + q)" and "y \<noteq> x"
                   have *: "\<lbrakk>norm(b - c) < e - d; norm(y - x - b) \<le> d\<rbrakk> \<Longrightarrow> norm(y - x - c) < e"
                     for b c d e x and y:: "real^'n"
                     using norm_triangle_ineq2 [of "y - x - c" "y - x - b"] by simp
                   have "norm (f y - f x - B *v (y - x)) < e * norm (y - x)"
                   proof (rule *)
                     show "norm (f y - f x - A (p + q) *v (y - x)) \<le> norm (y - x) / (Suc (p + q))"
                       using A [OF y] by simp
                     have "norm (A (p + q) *v (y - x) - B *v (y - x)) \<le> onorm(\<lambda>x. (A(p + q) - B) *v x) * norm(y - x)"
                       by (metis linear_linear matrix_vector_mul_linear matrix_vector_mult_diff_rdistrib onorm)
                     also have "\<dots> < (e/2) * norm (y - x)"
                       using \<open>y \<noteq> x\<close> pqe2 by auto
                     also have "\<dots> \<le> (e - 1 / (Suc (p + q))) * norm (y - x)"
                     proof (rule mult_right_mono)
                       have "1 / Suc (p + q) \<le> 1 / q"
                         using \<open>q \<noteq> 0\<close> by (auto simp: field_split_simps)
                       also have "\<dots> < e/2"
                         using qe2 by auto
                       finally show "e / 2 \<le> e - 1 / real (Suc (p + q))"
                         by linarith
                     qed auto
                     finally show "norm (A (p + q) *v (y - x) - B *v (y - x)) < e * norm (y - x) - norm (y - x) / real (Suc (p + q))"
                       by (simp add: algebra_simps)
                   qed
                   then show "inverse (norm (y - x)) * norm (f y + B *v x - (f x + B *v y)) < e"
                     using \<open>y \<noteq> x\<close> by (simp add: field_split_simps algebra_simps)
                 qed
               qed
               then show "((\<lambda>y. (matrix (f' x) - B) *v (y - x) /\<^sub>R
                            norm (y - x) - (f x + f' x (y - x) - f y) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0)
                           (at x within S)"
                 by (simp add: algebra_simps diff lin_df matrix_vector_mul_linear scalar_mult_eq_scaleR)
             qed
           qed (use x in \<open>simp; auto simp: not_less\<close>)
           ultimately have "f' x = (*v) B"
             by (force simp: algebra_simps scalar_mult_eq_scaleR)
           show "matrix (f' x) $ m $ n \<le> b"
           proof (rule tendsto_upperbound [of "\<lambda>i. (A i $ m $ n)" _ sequentially])
             show "(\<lambda>i. A i $ m $ n) \<longlonglongrightarrow> matrix (f' x) $ m $ n"
               by (simp add: B \<open>f' x = (*v) B\<close>)
             show "\<forall>\<^sub>F i in sequentially. A i $ m $ n \<le> b"
               by (simp add: Ab less_eq_real_def)
           qed auto
         next
           fix e :: "real"
           assume "x \<in> S" and b: "matrix (f' x) $ m $ n \<le> b" and "e > 0"
           then obtain d where "d>0"
             and d: "\<And>y. y\<in>S \<Longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow> norm (f y - f x - f' x (y - x)) / (norm (y - x))
                   < e/2"
             using f [OF \<open>x \<in> S\<close>]
             by (simp add: Deriv.has_derivative_at_within Lim_within)
               (auto simp add: field_simps dest: spec [of _ "e/2"])
           let ?A = "matrix(f' x) - (\<chi> i j. if i = m \<and> j = n then e / 4 else 0)"
           obtain B where BRats: "\<And>i j. B$i$j \<in> \<rat>" and Bo_e6: "onorm((*v) (?A - B)) < e/6"
             using matrix_rational_approximation \<open>e > 0\<close>
             by (metis zero_less_divide_iff zero_less_numeral)
           show "\<exists>d>0. \<exists>A. A $ m $ n < b \<and> (\<forall>i j. A $ i $ j \<in> \<rat>) \<and>
                 (\<forall>y\<in>S. norm (y - x) < d \<longrightarrow> norm (f y - f x - A *v (y - x)) \<le> e * norm (y - x))"
           proof (intro exI conjI ballI allI impI)
             show "d>0"
               by (rule \<open>d>0\<close>)
             show "B $ m $ n < b"
             proof -
               have "\<bar>matrix ((*v) (?A - B)) $ m $ n\<bar> \<le> onorm ((*v) (?A - B))"
                 using component_le_onorm [OF matrix_vector_mul_linear, of _ m n] by metis
               then show ?thesis
                 using b Bo_e6 by simp
             qed
             show "B $ i $ j \<in> \<rat>" for i j
               using BRats by auto
             show "norm (f y - f x - B *v (y - x)) \<le> e * norm (y - x)"
               if "y \<in> S" and y: "norm (y - x) < d" for y
             proof (cases "y = x")
               case True then show ?thesis
                 by simp
             next
               case False
               have *: "norm(d' - d) \<le> e/2 \<Longrightarrow> norm(y - (x + d')) < e/2 \<Longrightarrow> norm(y - x - d) \<le> e" for d d' e and x y::"real^'n"
                 using norm_triangle_le [of "d' - d" "y - (x + d')"] by simp
               show ?thesis
               proof (rule *)
                 have split246: "\<lbrakk>norm y \<le> e / 6; norm(x - y) \<le> e / 4\<rbrakk> \<Longrightarrow> norm x \<le> e/2" if "e > 0" for e and x y :: "real^'n"
                   using norm_triangle_le [of y "x-y" "e/2"] \<open>e > 0\<close> by simp
                 have "linear (f' x)"
                   using True f has_derivative_linear by blast
                 then have "norm (f' x (y - x) - B *v (y - x)) = norm ((matrix (f' x) - B) *v (y - x))"
                   by (simp add: matrix_vector_mult_diff_rdistrib)
                 also have "\<dots> \<le> (e * norm (y - x)) / 2"
                 proof (rule split246)
                   have "norm ((?A - B) *v (y - x)) / norm (y - x) \<le> onorm(\<lambda>x. (?A - B) *v x)"
                     by (rule le_onorm) auto
                   also have  "\<dots> < e/6"
                     by (rule Bo_e6)
                   finally have "norm ((?A - B) *v (y - x)) / norm (y - x) < e / 6" .
                   then show "norm ((?A - B) *v (y - x)) \<le> e * norm (y - x) / 6"
                     by (simp add: field_split_simps False)
                   have "norm ((matrix (f' x) - B) *v (y - x) - ((?A - B) *v (y - x))) = norm ((\<chi> i j. if i = m \<and> j = n then e / 4 else 0) *v (y - x))"
                     by (simp add: algebra_simps)
                   also have "\<dots> = norm((e/4) *\<^sub>R (y - x)$n *\<^sub>R axis m (1::real))"
                   proof -
                     have "(\<Sum>j\<in>UNIV. (if i = m \<and> j = n then e / 4 else 0) * (y $ j - x $ j)) * 4 = e * (y $ n - x $ n) * axis m 1 $ i" for i
                     proof (cases "i=m")
                       case True then show ?thesis
                         by (auto simp: if_distrib [of "\<lambda>z. z * _"] cong: if_cong)
                     next
                       case False then show ?thesis
                         by (simp add: axis_def)
                     qed
                     then have "(\<chi> i j. if i = m \<and> j = n then e / 4 else 0) *v (y - x) = (e/4) *\<^sub>R (y - x)$n *\<^sub>R axis m (1::real)"
                       by (auto simp: vec_eq_iff matrix_vector_mult_def)
                     then show ?thesis
                       by metis
                   qed
                   also have "\<dots> \<le> e * norm (y - x) / 4"
                     using \<open>e > 0\<close> apply (simp add: norm_mult abs_mult)
                     by (metis component_le_norm_cart vector_minus_component)
                   finally show "norm ((matrix (f' x) - B) *v (y - x) - ((?A - B) *v (y - x))) \<le> e * norm (y - x) / 4" .
                   show "0 < e * norm (y - x)"
                     by (simp add: False \<open>e > 0\<close>)
                 qed
                 finally show "norm (f' x (y - x) - B *v (y - x)) \<le> (e * norm (y - x)) / 2" .
                 show "norm (f y - (f x + f' x (y - x))) < (e * norm (y - x)) / 2"
                   using False d [OF \<open>y \<in> S\<close>] y by (simp add: dist_norm field_simps)
               qed
             qed
           qed
         qed
       qed auto
     qed
     show "negligible ?M"
       using negligible_subset [OF nN MN] .
   qed
   then show ?thesis
     by (simp add: borel_measurable_vimage_halfspace_component_le sets_restrict_space_iff assms)
 qed
 
 
 theorem borel_measurable_det_Jacobian:
  fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes S: "S \<in> sets lebesgue" and f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   shows "(\<lambda>x. det(matrix(f' x))) \<in> borel_measurable (lebesgue_on S)"
   unfolding det_def
   by (intro measurable) (auto intro: f borel_measurable_partial_derivatives [OF S])
 
 text\<open>The localisation wrt S uses the same argument for many similar results.\<close>
 (*See HOL Light's MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_BOREL, etc.*)
 theorem borel_measurable_lebesgue_on_preimage_borel:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<in> sets lebesgue"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>T. T \<in> sets borel \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue)"
 proof -
   have "{x. (if x \<in> S then f x else 0) \<in> T} \<in> sets lebesgue \<longleftrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue"
          if "T \<in> sets borel" for T
     proof (cases "0 \<in> T")
       case True
       then have "{x \<in> S. f x \<in> T} = {x. (if x \<in> S then f x else 0) \<in> T} \<inter> S"
                 "{x. (if x \<in> S then f x else 0) \<in> T} = {x \<in> S. f x \<in> T} \<union> -S"
         by auto
       then show ?thesis
         by (metis (no_types, lifting) Compl_in_sets_lebesgue assms sets.Int sets.Un)
     next
       case False
       then have "{x. (if x \<in> S then f x else 0) \<in> T} = {x \<in> S. f x \<in> T}"
         by auto
       then show ?thesis
         by auto
     qed
     then show ?thesis
       unfolding borel_measurable_lebesgue_preimage_borel borel_measurable_if [OF assms, symmetric]
       by blast
 qed
 
 lemma sets_lebesgue_almost_borel:
   assumes "S \<in> sets lebesgue"
   obtains B N where "B \<in> sets borel" "negligible N" "B \<union> N = S"
 proof -
   obtain T N N' where "S = T \<union> N" "N \<subseteq> N'" "N' \<in> null_sets lborel" "T \<in> sets borel"
     using sets_completionE [OF assms] by auto
   then show thesis
     by (metis negligible_iff_null_sets negligible_subset null_sets_completionI that)
 qed
 
 lemma double_lebesgue_sets:
  assumes S: "S \<in> sets lebesgue" and T: "T \<in> sets lebesgue" and fim: "f ` S \<subseteq> T"
  shows "(\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue) \<longleftrightarrow>
           f \<in> borel_measurable (lebesgue_on S) \<and>
           (\<forall>U. negligible U \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue)"
          (is "?lhs \<longleftrightarrow> _ \<and> ?rhs")
   unfolding borel_measurable_lebesgue_on_preimage_borel [OF S]
 proof (intro iffI allI conjI impI, safe)
   fix V :: "'b set"
   assume *: "\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
     and "V \<in> sets borel"
   then have V: "V \<in> sets lebesgue"
     by simp
   have "{x \<in> S. f x \<in> V} = {x \<in> S. f x \<in> T \<inter> V}"
     using fim by blast
   also have "{x \<in> S. f x \<in> T \<inter> V} \<in> sets lebesgue"
     using T V * le_inf_iff by blast
   finally show "{x \<in> S. f x \<in> V} \<in> sets lebesgue" .
 next
   fix U :: "'b set"
   assume "\<forall>U. U \<in> sets lebesgue \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
          "negligible U" "U \<subseteq> T"
   then show "{x \<in> S. f x \<in> U} \<in> sets lebesgue"
     using negligible_imp_sets by blast
 next
   fix U :: "'b set"
   assume 1 [rule_format]: "(\<forall>T. T \<in> sets borel \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets lebesgue)"
      and 2 [rule_format]: "\<forall>U. negligible U \<and> U \<subseteq> T \<longrightarrow> {x \<in> S. f x \<in> U} \<in> sets lebesgue"
      and "U \<in> sets lebesgue" "U \<subseteq> T"
   then obtain C N where C: "C \<in> sets borel \<and> negligible N \<and> C \<union> N = U"
     using sets_lebesgue_almost_borel
     by metis
   then have "{x \<in> S. f x \<in> C} \<in> sets lebesgue"
     by (blast intro: 1)
   moreover have "{x \<in> S. f x \<in> N} \<in> sets lebesgue"
     using C \<open>U \<subseteq> T\<close> by (blast intro: 2)
   moreover have "{x \<in> S. f x \<in> C \<union> N} = {x \<in> S. f x \<in> C} \<union> {x \<in> S. f x \<in> N}"
     by auto
   ultimately show "{x \<in> S. f x \<in> U} \<in> sets lebesgue"
     using C by auto
 qed
 
 
 subsection\<open>Simplest case of Sard's theorem (we don't need continuity of derivative)\<close>
 
 lemma Sard_lemma00:
   fixes P :: "'b::euclidean_space set"
   assumes "a \<ge> 0" and a: "a *\<^sub>R i \<noteq> 0" and i: "i \<in> Basis"
     and P: "P \<subseteq> {x. a *\<^sub>R i \<bullet> x = 0}"
     and "0 \<le> m" "0 \<le> e"
  obtains S where "S \<in> lmeasurable"
             and "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
             and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (DIM('b) - 1)"
 proof -
   have "a > 0"
     using assms by simp
   let ?v = "(\<Sum>j\<in>Basis. (if j = i then e else m) *\<^sub>R j)"
   show thesis
   proof
     have "- e \<le> x \<bullet> i" "x \<bullet> i \<le> e"
       if "t \<in> P" "norm (x - t) \<le> e" for x t
       using \<open>a > 0\<close> that Basis_le_norm [of i "x-t"] P i
       by (auto simp: inner_commute algebra_simps)
     moreover have "- m \<le> x \<bullet> j" "x \<bullet> j \<le> m"
       if "norm x \<le> m" "t \<in> P" "norm (x - t) \<le> e" "j \<in> Basis" and "j \<noteq> i"
       for x t j
       using that Basis_le_norm [of j x] by auto
     ultimately
     show "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> cbox (-?v) ?v"
       by (auto simp: mem_box)
     have *: "\<forall>k\<in>Basis. - ?v \<bullet> k \<le> ?v \<bullet> k"
       using \<open>0 \<le> m\<close> \<open>0 \<le> e\<close> by (auto simp: inner_Basis)
     have 2: "2 ^ DIM('b) = 2 * 2 ^ (DIM('b) - Suc 0)"
       by (metis DIM_positive Suc_pred power_Suc)
     show "measure lebesgue (cbox (-?v) ?v) \<le> 2 * e * (2 * m) ^ (DIM('b) - 1)"
       using \<open>i \<in> Basis\<close>
       by (simp add: content_cbox [OF *] prod.distrib prod.If_cases Diff_eq [symmetric] 2)
   qed blast
 qed
 
 text\<open>As above, but reorienting the vector (HOL Light's @text{GEOM\_BASIS\_MULTIPLE\_TAC})\<close>
 lemma Sard_lemma0:
   fixes P :: "(real^'n::{finite,wellorder}) set"
   assumes "a \<noteq> 0"
     and P: "P \<subseteq> {x. a \<bullet> x = 0}" and "0 \<le> m" "0 \<le> e"
   obtains S where "S \<in> lmeasurable"
     and "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
     and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
 proof -
   obtain T and k::'n where T: "orthogonal_transformation T" and a: "a = T (norm a *\<^sub>R axis k (1::real))"
     using rotation_rightward_line by metis
   have Tinv [simp]: "T (inv T x) = x" for x
     by (simp add: T orthogonal_transformation_surj surj_f_inv_f)
   obtain S where S: "S \<in> lmeasurable"
     and subS: "{z. norm z \<le> m \<and> (\<exists>t \<in> T-`P. norm(z - t) \<le> e)} \<subseteq> S"
     and mS: "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
   proof (rule Sard_lemma00 [of "norm a" "axis k (1::real)" "T-`P" m e])
     have "norm a *\<^sub>R axis k 1 \<bullet> x = 0" if "T x \<in> P" for x
     proof -
       have "a \<bullet> T x = 0"
         using P that by blast
       then show ?thesis
         by (metis (no_types, lifting) T a orthogonal_orthogonal_transformation orthogonal_def)
     qed
     then show "T -` P \<subseteq> {x. norm a *\<^sub>R axis k 1 \<bullet> x = 0}"
       by auto
   qed (use assms T in auto)
   show thesis
   proof
     show "T ` S \<in> lmeasurable"
       using S measurable_orthogonal_image T by blast
     have "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> T ` {z. norm z \<le> m \<and> (\<exists>t\<in>T -` P. norm (z - t) \<le> e)}"
     proof clarsimp
       fix x t
       assume "norm x \<le> m" "t \<in> P" "norm (x - t) \<le> e"
       then have "norm (inv T x) \<le> m"
         using orthogonal_transformation_inv [OF T] by (simp add: orthogonal_transformation_norm)
       moreover have "\<exists>t\<in>T -` P. norm (inv T x - t) \<le> e"
       proof
         have "T (inv T x - inv T t) = x - t"
           using T linear_diff orthogonal_transformation_def
           by (metis (no_types, hide_lams) Tinv)
         then have "norm (inv T x - inv T t) = norm (x - t)"
           by (metis T orthogonal_transformation_norm)
         then show "norm (inv T x - inv T t) \<le> e"
           using \<open>norm (x - t) \<le> e\<close> by linarith
        next
          show "inv T t \<in> T -` P"
            using \<open>t \<in> P\<close> by force
       qed
       ultimately show "x \<in> T ` {z. norm z \<le> m \<and> (\<exists>t\<in>T -` P. norm (z - t) \<le> e)}"
         by force
     qed
     then show "{z. norm z \<le> m \<and> (\<exists>t\<in>P. norm (z - t) \<le> e)} \<subseteq> T ` S"
       using image_mono [OF subS] by (rule order_trans)
     show "measure lebesgue (T ` S) \<le> 2 * e * (2 * m) ^ (CARD('n) - 1)"
       using mS T by (simp add: S measure_orthogonal_image)
   qed
 qed
 
 text\<open>As above, but translating the sets (HOL Light's @text{GEN\_GEOM\_ORIGIN\_TAC})\<close>
 lemma Sard_lemma1:
   fixes P :: "(real^'n::{finite,wellorder}) set"
    assumes P: "dim P < CARD('n)" and "0 \<le> m" "0 \<le> e"
  obtains S where "S \<in> lmeasurable"
             and "{z. norm(z - w) \<le> m \<and> (\<exists>t \<in> P. norm(z - w - t) \<le> e)} \<subseteq> S"
             and "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
 proof -
   obtain a where "a \<noteq> 0" "P \<subseteq> {x. a \<bullet> x = 0}"
     using lowdim_subset_hyperplane [of P] P span_base by auto
   then obtain S where S: "S \<in> lmeasurable"
     and subS: "{z. norm z \<le> m \<and> (\<exists>t \<in> P. norm(z - t) \<le> e)} \<subseteq> S"
     and mS: "measure lebesgue S \<le> (2 * e) * (2 * m) ^ (CARD('n) - 1)"
     by (rule Sard_lemma0 [OF _ _ \<open>0 \<le> m\<close> \<open>0 \<le> e\<close>])
   show thesis
   proof
     show "(+)w ` S \<in> lmeasurable"
       by (metis measurable_translation S)
     show "{z. norm (z - w) \<le> m \<and> (\<exists>t\<in>P. norm (z - w - t) \<le> e)} \<subseteq> (+)w ` S"
       using subS by force
     show "measure lebesgue ((+)w ` S) \<le> 2 * e * (2 * m) ^ (CARD('n) - 1)"
       by (metis measure_translation mS)
   qed
 qed
 
 lemma Sard_lemma2:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n::{finite,wellorder}"
   assumes mlen: "CARD('m) \<le> CARD('n)" (is "?m \<le> ?n")
     and "B > 0" "bounded S"
     and derS: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and rank: "\<And>x. x \<in> S \<Longrightarrow> rank(matrix(f' x)) < CARD('n)"
     and B: "\<And>x. x \<in> S \<Longrightarrow> onorm(f' x) \<le> B"
   shows "negligible(f ` S)"
 proof -
   have lin_f': "\<And>x. x \<in> S \<Longrightarrow> linear(f' x)"
     using derS has_derivative_linear by blast
   show ?thesis
   proof (clarsimp simp add: negligible_outer_le)
     fix e :: "real"
     assume "e > 0"
     obtain c where csub: "S \<subseteq> cbox (- (vec c)) (vec c)" and "c > 0"
     proof -
       obtain b where b: "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> b"
         using \<open>bounded S\<close> by (auto simp: bounded_iff)
       show thesis
       proof
         have "- \<bar>b\<bar> - 1 \<le> x $ i \<and> x $ i \<le> \<bar>b\<bar> + 1" if "x \<in> S" for x i
           using component_le_norm_cart [of x i] b [OF that] by auto
         then show "S \<subseteq> cbox (- vec (\<bar>b\<bar> + 1)) (vec (\<bar>b\<bar> + 1))"
           by (auto simp: mem_box_cart)
       qed auto
     qed
     then have box_cc: "box (- (vec c)) (vec c) \<noteq> {}" and cbox_cc: "cbox (- (vec c)) (vec c) \<noteq> {}"
       by (auto simp: interval_eq_empty_cart)
     obtain d where "d > 0" "d \<le> B"
              and d: "(d * 2) * (4 * B) ^ (?n - 1) \<le> e / (2*c) ^ ?m / ?m ^ ?m"
       apply (rule that [of "min B (e / (2*c) ^ ?m / ?m ^ ?m / (4 * B) ^ (?n - 1) / 2)"])
       using \<open>B > 0\<close> \<open>c > 0\<close> \<open>e > 0\<close>
       by (simp_all add: divide_simps min_mult_distrib_right)
     have "\<exists>r. 0 < r \<and> r \<le> 1/2 \<and>
               (x \<in> S
                \<longrightarrow> (\<forall>y. y \<in> S \<and> norm(y - x) < r
                        \<longrightarrow> norm(f y - f x - f' x (y - x)) \<le> d * norm(y - x)))" for x
     proof (cases "x \<in> S")
       case True
       then obtain r where "r > 0"
               and "\<And>y. \<lbrakk>y \<in> S; norm (y - x) < r\<rbrakk>
                        \<Longrightarrow> norm (f y - f x - f' x (y - x)) \<le> d * norm (y - x)"
         using derS \<open>d > 0\<close> by (force simp: has_derivative_within_alt)
       then show ?thesis
         by (rule_tac x="min r (1/2)" in exI) simp
     next
       case False
       then show ?thesis
         by (rule_tac x="1/2" in exI) simp
     qed
     then obtain r where r12: "\<And>x. 0 < r x \<and> r x \<le> 1/2"
             and r: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S; norm(y - x) < r x\<rbrakk>
                           \<Longrightarrow> norm(f y - f x - f' x (y - x)) \<le> d * norm(y - x)"
       by metis
     then have ga: "gauge (\<lambda>x. ball x (r x))"
       by (auto simp: gauge_def)
     obtain \<D> where \<D>: "countable \<D>" and sub_cc: "\<Union>\<D> \<subseteq> cbox (- vec c) (vec c)"
       and cbox: "\<And>K. K \<in> \<D> \<Longrightarrow> interior K \<noteq> {} \<and> (\<exists>u v. K = cbox u v)"
       and djointish: "pairwise (\<lambda>A B. interior A \<inter> interior B = {}) \<D>"
       and covered: "\<And>K. K \<in> \<D> \<Longrightarrow> \<exists>x \<in> S \<inter> K. K \<subseteq> ball x (r x)"
       and close: "\<And>u v. cbox u v \<in> \<D> \<Longrightarrow> \<exists>n. \<forall>i::'m. v $ i - u $ i = 2*c / 2^n"
       and covers: "S \<subseteq> \<Union>\<D>"
       apply (rule covering_lemma [OF csub box_cc ga])
       apply (auto simp: Basis_vec_def cart_eq_inner_axis [symmetric])
       done
     let ?\<mu> = "measure lebesgue"
     have "\<exists>T. T \<in> lmeasurable \<and> f ` (K \<inter> S) \<subseteq> T \<and> ?\<mu> T \<le> e / (2*c) ^ ?m * ?\<mu> K"
       if "K \<in> \<D>" for K
     proof -
       obtain u v where uv: "K = cbox u v"
         using cbox \<open>K \<in> \<D>\<close> by blast
       then have uv_ne: "cbox u v \<noteq> {}"
         using cbox that by fastforce
       obtain x where x: "x \<in> S \<inter> cbox u v" "cbox u v \<subseteq> ball x (r x)"
         using \<open>K \<in> \<D>\<close> covered uv by blast
       then have "dim (range (f' x)) < ?n"
         using rank_dim_range [of "matrix (f' x)"] x rank[of x]
         by (auto simp: matrix_works scalar_mult_eq_scaleR lin_f')
       then obtain T where T: "T \<in> lmeasurable"
             and subT: "{z. norm(z - f x) \<le> (2 * B) * norm(v - u) \<and> (\<exists>t \<in> range (f' x). norm(z - f x - t) \<le> d * norm(v - u))} \<subseteq> T"
             and measT: "?\<mu> T \<le> (2 * (d * norm(v - u))) * (2 * ((2 * B) * norm(v - u))) ^ (?n - 1)"
                         (is "_ \<le> ?DVU")
         apply (rule Sard_lemma1 [of "range (f' x)" "(2 * B) * norm(v - u)" "d * norm(v - u)" "f x"])
         using \<open>B > 0\<close> \<open>d > 0\<close> by simp_all
       show ?thesis
       proof (intro exI conjI)
         have "f ` (K \<inter> S) \<subseteq> {z. norm(z - f x) \<le> (2 * B) * norm(v - u) \<and> (\<exists>t \<in> range (f' x). norm(z - f x - t) \<le> d * norm(v - u))}"
           unfolding uv
         proof (clarsimp simp: mult.assoc, intro conjI)
           fix y
           assume y: "y \<in> cbox u v" and "y \<in> S"
           then have "norm (y - x) < r x"
             by (metis dist_norm mem_ball norm_minus_commute subsetCE x(2))
           then have le_dyx: "norm (f y - f x - f' x (y - x)) \<le> d * norm (y - x)"
             using r [of x y] x \<open>y \<in> S\<close> by blast
           have yx_le: "norm (y - x) \<le> norm (v - u)"
           proof (rule norm_le_componentwise_cart)
             show "norm ((y - x) $ i) \<le> norm ((v - u) $ i)" for i
               using x y by (force simp: mem_box_cart dest!: spec [where x=i])
           qed
           have *: "\<lbrakk>norm(y - x - z) \<le> d; norm z \<le> B; d \<le> B\<rbrakk> \<Longrightarrow> norm(y - x) \<le> 2 * B"
             for x y z :: "real^'n::_" and d B
             using norm_triangle_ineq2 [of "y - x" z] by auto
           show "norm (f y - f x) \<le> 2 * (B * norm (v - u))"
           proof (rule * [OF le_dyx])
             have "norm (f' x (y - x)) \<le> onorm (f' x) * norm (y - x)"
               using onorm [of "f' x" "y-x"] by (meson IntE lin_f' linear_linear x(1))
             also have "\<dots> \<le> B * norm (v - u)"
             proof (rule mult_mono)
               show "onorm (f' x) \<le> B"
                 using B x by blast
             qed (use \<open>B > 0\<close> yx_le in auto)
             finally show "norm (f' x (y - x)) \<le> B * norm (v - u)" .
             show "d * norm (y - x) \<le> B * norm (v - u)"
               using \<open>B > 0\<close> by (auto intro: mult_mono [OF \<open>d \<le> B\<close> yx_le])
           qed
           show "\<exists>t. norm (f y - f x - f' x t) \<le> d * norm (v - u)"
             apply (rule_tac x="y-x" in exI)
             using \<open>d > 0\<close> yx_le le_dyx mult_left_mono [where c=d]
             by (meson order_trans real_mult_le_cancel_iff2)
         qed
         with subT show "f ` (K \<inter> S) \<subseteq> T" by blast
         show "?\<mu> T \<le> e / (2*c) ^ ?m * ?\<mu> K"
         proof (rule order_trans [OF measT])
           have "?DVU = (d * 2 * (4 * B) ^ (?n - 1)) * norm (v - u)^?n"
             using \<open>c > 0\<close>
             apply (simp add: algebra_simps power_mult_distrib)
             by (metis Suc_pred power_Suc zero_less_card_finite)
           also have "\<dots> \<le> (e / (2*c) ^ ?m / (?m ^ ?m)) * norm(v - u) ^ ?n"
             by (rule mult_right_mono [OF d]) auto
           also have "\<dots> \<le> e / (2*c) ^ ?m * ?\<mu> K"
           proof -
             have "u \<in> ball (x) (r x)" "v \<in> ball x (r x)"
               using box_ne_empty(1) contra_subsetD [OF x(2)] mem_box(2) uv_ne by fastforce+
             moreover have "r x \<le> 1/2"
               using r12 by auto
             ultimately have "norm (v - u) \<le> 1"
               using norm_triangle_half_r [of x u 1 v]
               by (metis (no_types, hide_lams) dist_commute dist_norm less_eq_real_def less_le_trans mem_ball)
             then have "norm (v - u) ^ ?n \<le> norm (v - u) ^ ?m"
               by (simp add: power_decreasing [OF mlen])
             also have "\<dots> \<le> ?\<mu> K * real (?m ^ ?m)"
             proof -
               obtain n where n: "\<And>i. v$i - u$i = 2 * c / 2^n"
                 using close [of u v] \<open>K \<in> \<D>\<close> uv by blast
               have "norm (v - u) ^ ?m \<le> (\<Sum>i\<in>UNIV. \<bar>(v - u) $ i\<bar>) ^ ?m"
                 by (intro norm_le_l1_cart power_mono) auto
               also have "\<dots> \<le> (\<Prod>i\<in>UNIV. v $ i - u $ i) * real CARD('m) ^ CARD('m)"
                 by (simp add: n field_simps \<open>c > 0\<close> less_eq_real_def)
               also have "\<dots> = ?\<mu> K * real (?m ^ ?m)"
                 by (simp add: uv uv_ne content_cbox_cart)
               finally show ?thesis .
             qed
             finally have *: "1 / real (?m ^ ?m) * norm (v - u) ^ ?n \<le> ?\<mu> K"
               by (simp add: field_split_simps)
             show ?thesis
               using mult_left_mono [OF *, of "e / (2*c) ^ ?m"] \<open>c > 0\<close> \<open>e > 0\<close> by auto
           qed
           finally show "?DVU \<le> e / (2*c) ^ ?m * ?\<mu> K" .
         qed
       qed (use T in auto)
     qed
     then obtain g where meas_g: "\<And>K. K \<in> \<D> \<Longrightarrow> g K \<in> lmeasurable"
                     and sub_g: "\<And>K. K \<in> \<D> \<Longrightarrow> f ` (K \<inter> S) \<subseteq> g K"
                     and le_g: "\<And>K. K \<in> \<D> \<Longrightarrow> ?\<mu> (g K) \<le> e / (2*c)^?m * ?\<mu> K"
       by metis
     have le_e: "?\<mu> (\<Union>i\<in>\<F>. g i) \<le> e"
       if "\<F> \<subseteq> \<D>" "finite \<F>" for \<F>
     proof -
       have "?\<mu> (\<Union>i\<in>\<F>. g i) \<le> (\<Sum>i\<in>\<F>. ?\<mu> (g i))"
         using meas_g \<open>\<F> \<subseteq> \<D>\<close> by (auto intro: measure_UNION_le [OF \<open>finite \<F>\<close>])
       also have "\<dots> \<le> (\<Sum>K\<in>\<F>. e / (2*c) ^ ?m * ?\<mu> K)"
         using \<open>\<F> \<subseteq> \<D>\<close> sum_mono [OF le_g] by (meson le_g subsetCE sum_mono)
       also have "\<dots> = e / (2*c) ^ ?m * (\<Sum>K\<in>\<F>. ?\<mu> K)"
         by (simp add: sum_distrib_left)
       also have "\<dots> \<le> e"
       proof -
         have "\<F> division_of \<Union>\<F>"
         proof (rule division_ofI)
           show "K \<subseteq> \<Union>\<F>"  "K \<noteq> {}" "\<exists>a b. K = cbox a b" if "K \<in> \<F>" for K
             using \<open>K \<in> \<F>\<close> covered cbox \<open>\<F> \<subseteq> \<D>\<close> by (auto simp: Union_upper)
           show "interior K \<inter> interior L = {}" if "K \<in> \<F>" and "L \<in> \<F>" and "K \<noteq> L" for K L
             by (metis (mono_tags, lifting) \<open>\<F> \<subseteq> \<D>\<close> pairwiseD djointish pairwise_subset that)
         qed (use that in auto)
         then have "sum ?\<mu> \<F> \<le> ?\<mu> (\<Union>\<F>)"
           by (simp add: content_division)
         also have "\<dots> \<le> ?\<mu> (cbox (- vec c) (vec c) :: (real, 'm) vec set)"
         proof (rule measure_mono_fmeasurable)
           show "\<Union>\<F> \<subseteq> cbox (- vec c) (vec c)"
             by (meson Sup_subset_mono sub_cc order_trans \<open>\<F> \<subseteq> \<D>\<close>)
         qed (use \<open>\<F> division_of \<Union>\<F>\<close> lmeasurable_division in auto)
         also have "\<dots> = content (cbox (- vec c) (vec c) :: (real, 'm) vec set)"
           by simp
         also have "\<dots> \<le> (2 ^ ?m * c ^ ?m)"
           using \<open>c > 0\<close> by (simp add: content_cbox_if_cart)
         finally have "sum ?\<mu> \<F> \<le> (2 ^ ?m * c ^ ?m)" .
         then show ?thesis
           using \<open>e > 0\<close> \<open>c > 0\<close> by (auto simp: field_split_simps mult_less_0_iff)
       qed
       finally show ?thesis .
     qed
     show "\<exists>T. f ` S \<subseteq> T \<and> T \<in> lmeasurable \<and> ?\<mu> T \<le> e"
     proof (intro exI conjI)
       show "f ` S \<subseteq> \<Union> (g ` \<D>)"
         using covers sub_g by force
       show "\<Union> (g ` \<D>) \<in> lmeasurable"
         by (rule fmeasurable_UN_bound [OF \<open>countable \<D>\<close> meas_g le_e])
       show "?\<mu> (\<Union> (g ` \<D>)) \<le> e"
         by (rule measure_UN_bound [OF \<open>countable \<D>\<close> meas_g le_e])
     qed
   qed
 qed
 
 
 theorem baby_Sard:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n::{finite,wellorder}"
   assumes mlen: "CARD('m) \<le> CARD('n)"
     and der: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and rank: "\<And>x. x \<in> S \<Longrightarrow> rank(matrix(f' x)) < CARD('n)"
   shows "negligible(f ` S)"
 proof -
   let ?U = "\<lambda>n. {x \<in> S. norm(x) \<le> n \<and> onorm(f' x) \<le> real n}"
   have "\<And>x. x \<in> S \<Longrightarrow> \<exists>n. norm x \<le> real n \<and> onorm (f' x) \<le> real n"
     by (meson linear order_trans real_arch_simple)
   then have eq: "S = (\<Union>n. ?U n)"
     by auto
   have "negligible (f ` ?U n)" for n
   proof (rule Sard_lemma2 [OF mlen])
     show "0 < real n + 1"
       by auto
     show "bounded (?U n)"
       using bounded_iff by blast
     show "(f has_derivative f' x) (at x within ?U n)" if "x \<in> ?U n" for x
       using der that by (force intro: has_derivative_subset)
   qed (use rank in auto)
   then show ?thesis
     by (subst eq) (simp add: image_Union negligible_Union_nat)
 qed
 
 
 subsection\<open>A one-way version of change-of-variables not assuming injectivity. \<close>
 
 lemma integral_on_image_ubound_weak:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real"
   assumes S: "S \<in> sets lebesgue"
       and f: "f \<in> borel_measurable (lebesgue_on (g ` S))"
       and nonneg_fg:  "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
       and der_g:   "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and det_int_fg: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
       and meas_gim: "\<And>T. \<lbrakk>T \<subseteq> g ` S; T \<in> sets lebesgue\<rbrakk> \<Longrightarrow> {x \<in> S. g x \<in> T} \<in> sets lebesgue"
     shows "f integrable_on (g ` S) \<and>
            integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
          (is "_ \<and> _ \<le> ?b")
 proof -
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar>"
   have cont_g: "continuous_on S g"
     using der_g has_derivative_continuous_on by blast
   have [simp]: "space (lebesgue_on S) = S"
     by (simp add: S)
   have gS_in_sets_leb: "g ` S \<in> sets lebesgue"
     apply (rule differentiable_image_in_sets_lebesgue)
     using der_g by (auto simp: S differentiable_def differentiable_on_def)
   obtain h where nonneg_h: "\<And>n x. 0 \<le> h n x"
     and h_le_f: "\<And>n x. x \<in> S \<Longrightarrow> h n (g x) \<le> f (g x)"
     and h_inc: "\<And>n x. h n x \<le> h (Suc n) x"
     and h_meas: "\<And>n. h n \<in> borel_measurable lebesgue"
     and fin_R: "\<And>n. finite(range (h n))"
     and lim: "\<And>x. x \<in> g ` S \<Longrightarrow> (\<lambda>n. h n x) \<longlonglongrightarrow> f x"
   proof -
     let ?f = "\<lambda>x. if x \<in> g ` S then f x else 0"
     have "?f \<in> borel_measurable lebesgue \<and> (\<forall>x. 0 \<le> ?f x)"
       by (auto simp: gS_in_sets_leb f nonneg_fg measurable_restrict_space_iff [symmetric])
     then show ?thesis
       apply (clarsimp simp add: borel_measurable_simple_function_limit_increasing)
       apply (rename_tac h)
       by (rule_tac h=h in that) (auto split: if_split_asm)
   qed
   have h_lmeas: "{t. h n (g t) = y} \<inter> S \<in> sets lebesgue" for y n
   proof -
     have "space (lebesgue_on (UNIV::(real,'n) vec set)) = UNIV"
       by simp
     then have "((h n) -`{y} \<inter> g ` S) \<in> sets (lebesgue_on (g ` S))"
       by (metis Int_commute borel_measurable_vimage h_meas image_eqI inf_top.right_neutral sets_restrict_space space_borel space_completion space_lborel)
     then have "({u. h n u = y} \<inter> g ` S) \<in> sets lebesgue"
       using gS_in_sets_leb
       by (simp add: integral_indicator fmeasurableI2 sets_restrict_space_iff vimage_def)
     then have "{x \<in> S. g x \<in> ({u. h n u = y} \<inter> g ` S)} \<in> sets lebesgue"
       using meas_gim[of "({u. h n u = y} \<inter> g ` S)"] by force
     moreover have "{t. h n (g t) = y} \<inter> S = {x \<in> S. g x \<in> ({u. h n u = y} \<inter> g ` S)}"
       by blast
     ultimately show ?thesis
       by auto
   qed
   have hint: "h n integrable_on g ` S \<and> integral (g ` S) (h n) \<le> integral S (\<lambda>x. ?D x * h n (g x))"
           (is "?INT \<and> ?lhs \<le> ?rhs")  for n
   proof -
     let ?R = "range (h n)"
     have hn_eq: "h n = (\<lambda>x. \<Sum>y\<in>?R. y * indicat_real {x. h n x = y} x)"
       by (simp add: indicator_def if_distrib fin_R cong: if_cong)
     have yind: "(\<lambda>t. y * indicator{x. h n x = y} t) integrable_on (g ` S) \<and>
                 (integral (g ` S) (\<lambda>t. y * indicator {x. h n x = y} t))
                  \<le> integral S (\<lambda>t. \<bar>det (matrix (g' t))\<bar> * y * indicator {x. h n x = y} (g t))"
        if y: "y \<in> ?R" for y::real
     proof (cases "y=0")
       case True
       then show ?thesis using gS_in_sets_leb integrable_0 by force
     next
       case False
       with that have "y > 0"
         using less_eq_real_def nonneg_h by fastforce
       have "(\<lambda>x. if x \<in> {t. h n (g t) = y} then ?D x else 0) integrable_on S"
       proof (rule measurable_bounded_by_integrable_imp_integrable)
         have "(\<lambda>x. ?D x) \<in> borel_measurable (lebesgue_on ({t. h n (g t) = y} \<inter> S))"
           apply (intro borel_measurable_abs borel_measurable_det_Jacobian [OF h_lmeas, where f=g])
           by (meson der_g IntD2 has_derivative_within_subset inf_le2)
         then have "(\<lambda>x. if x \<in> {t. h n (g t) = y} \<inter> S then ?D x else 0) \<in> borel_measurable lebesgue"
           by (rule borel_measurable_if_I [OF _ h_lmeas])
         then show "(\<lambda>x. if x \<in> {t. h n (g t) = y} then ?D x else 0) \<in> borel_measurable (lebesgue_on S)"
           by (simp add: if_if_eq_conj Int_commute borel_measurable_if [OF S, symmetric])
         show "(\<lambda>x. ?D x *\<^sub>R f (g x) /\<^sub>R y) integrable_on S"
           by (rule integrable_cmul) (use det_int_fg in auto)
         show "norm (if x \<in> {t. h n (g t) = y} then ?D x else 0) \<le> ?D x *\<^sub>R f (g x) /\<^sub>R y"
           if "x \<in> S" for x
           using nonneg_h [of n x] \<open>y > 0\<close> nonneg_fg [of x] h_le_f [of x n] that
           by (auto simp: divide_simps mult_left_mono)
       qed (use S in auto)
       then have int_det: "(\<lambda>t. \<bar>det (matrix (g' t))\<bar>) integrable_on ({t. h n (g t) = y} \<inter> S)"
         using integrable_restrict_Int by force
       have "(g ` ({t. h n (g t) = y} \<inter> S)) \<in> lmeasurable"
         apply (rule measurable_differentiable_image [OF h_lmeas])
          apply (blast intro: has_derivative_within_subset [OF der_g])
         apply (rule int_det)
         done
       moreover have "g ` ({t. h n (g t) = y} \<inter> S) = {x. h n x = y} \<inter> g ` S"
         by blast
       moreover have "measure lebesgue (g ` ({t. h n (g t) = y} \<inter> S))
                      \<le> integral ({t. h n (g t) = y} \<inter> S) (\<lambda>t. \<bar>det (matrix (g' t))\<bar>)"
         apply (rule measure_differentiable_image [OF h_lmeas _ int_det])
         apply (blast intro: has_derivative_within_subset [OF der_g])
         done
       ultimately show ?thesis
         using \<open>y > 0\<close> integral_restrict_Int [of S "{t. h n (g t) = y}" "\<lambda>t. \<bar>det (matrix (g' t))\<bar> * y"]
         apply (simp add: integrable_on_indicator integrable_on_cmult_iff integral_indicator)
         apply (simp add: indicator_def if_distrib cong: if_cong)
         done
     qed
     have hn_int: "h n integrable_on g ` S"
       apply (subst hn_eq)
       using yind by (force intro: integrable_sum [OF fin_R])
     then show ?thesis
     proof
       have "?lhs = integral (g ` S) (\<lambda>x. \<Sum>y\<in>range (h n). y * indicat_real {x. h n x = y} x)"
         by (metis hn_eq)
       also have "\<dots> = (\<Sum>y\<in>range (h n). integral (g ` S) (\<lambda>x. y * indicat_real {x. h n x = y} x))"
         by (rule integral_sum [OF fin_R]) (use yind in blast)
       also have "\<dots> \<le> (\<Sum>y\<in>range (h n). integral S (\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)))"
         using yind by (force intro: sum_mono)
       also have "\<dots> = integral S (\<lambda>u. \<Sum>y\<in>range (h n). \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u))"
       proof (rule integral_sum [OF fin_R, symmetric])
         fix y assume y: "y \<in> ?R"
         with nonneg_h have "y \<ge> 0"
           by auto
         show "(\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)) integrable_on S"
         proof (rule measurable_bounded_by_integrable_imp_integrable)
           have "(\<lambda>x. indicat_real {x. h n x = y} (g x)) \<in> borel_measurable (lebesgue_on S)"
             using h_lmeas S
             by (auto simp: indicator_vimage [symmetric] borel_measurable_indicator_iff sets_restrict_space_iff)
           then show "(\<lambda>u. \<bar>det (matrix (g' u))\<bar> * y * indicat_real {x. h n x = y} (g u)) \<in> borel_measurable (lebesgue_on S)"
             by (intro borel_measurable_times borel_measurable_abs borel_measurable_const borel_measurable_det_Jacobian [OF S der_g])
         next
           fix x
           assume "x \<in> S"
           have "y * indicat_real {x. h n x = y} (g x) \<le> f (g x)"
             by (metis (full_types) \<open>x \<in> S\<close> h_le_f indicator_def mem_Collect_eq mult.right_neutral mult_zero_right nonneg_fg)
           with \<open>y \<ge> 0\<close> show "norm (?D x * y * indicat_real {x. h n x = y} (g x)) \<le> ?D x * f(g x)"
             by (simp add: abs_mult mult.assoc mult_left_mono)
         qed (use S det_int_fg in auto)
       qed
       also have "\<dots> = integral S (\<lambda>T. \<bar>det (matrix (g' T))\<bar> *
                                         (\<Sum>y\<in>range (h n). y * indicat_real {x. h n x = y} (g T)))"
         by (simp add: sum_distrib_left mult.assoc)
       also have "\<dots> = ?rhs"
         by (metis hn_eq)
       finally show "integral (g ` S) (h n) \<le> ?rhs" .
     qed
   qed
   have le: "integral S (\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) \<le> ?b" for n
   proof (rule integral_le)
     show "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) integrable_on S"
     proof (rule measurable_bounded_by_integrable_imp_integrable)
       have "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> *\<^sub>R h n (g T)) \<in> borel_measurable (lebesgue_on S)"
       proof (intro borel_measurable_scaleR borel_measurable_abs borel_measurable_det_Jacobian \<open>S \<in> sets lebesgue\<close>)
         have eq: "{x \<in> S. f x \<le> a} = (\<Union>b \<in> (f ` S) \<inter> atMost a. {x. f x = b} \<inter> S)" for f and a::real
           by auto
         have "finite ((\<lambda>x. h n (g x)) ` S \<inter> {..a})" for a
           by (force intro: finite_subset [OF _ fin_R])
         with h_lmeas [of n] show "(\<lambda>x. h n (g x)) \<in> borel_measurable (lebesgue_on S)"
           apply (simp add: borel_measurable_vimage_halfspace_component_le \<open>S \<in> sets lebesgue\<close> sets_restrict_space_iff eq)
           by (metis (mono_tags) SUP_inf sets.finite_UN)
       qed (use der_g in blast)
       then show "(\<lambda>T. \<bar>det (matrix (g' T))\<bar> * h n (g T)) \<in> borel_measurable (lebesgue_on S)"
         by simp
       show "norm (?D x * h n (g x)) \<le> ?D x *\<^sub>R f (g x)"
         if "x \<in> S" for x
         by (simp add: h_le_f mult_left_mono nonneg_h that)
     qed (use S det_int_fg in auto)
     show "?D x * h n (g x) \<le> ?D x * f (g x)" if "x \<in> S" for x
       by (simp add: \<open>x \<in> S\<close> h_le_f mult_left_mono)
     show "(\<lambda>x. ?D x * f (g x)) integrable_on S"
       using det_int_fg by blast
   qed
   have "f integrable_on g ` S \<and> (\<lambda>k. integral (g ` S) (h k)) \<longlonglongrightarrow> integral (g ` S) f"
   proof (rule monotone_convergence_increasing)
     have "\<bar>integral (g ` S) (h n)\<bar> \<le> integral S (\<lambda>x. ?D x * f (g x))" for n
     proof -
       have "\<bar>integral (g ` S) (h n)\<bar> = integral (g ` S) (h n)"
         using hint by (simp add: integral_nonneg nonneg_h)
       also have "\<dots> \<le> integral S (\<lambda>x. ?D x * f (g x))"
         using hint le by (meson order_trans)
       finally show ?thesis .
     qed
     then show "bounded (range (\<lambda>k. integral (g ` S) (h k)))"
       by (force simp: bounded_iff)
   qed (use h_inc lim hint in auto)
   moreover have "integral (g ` S) (h n) \<le> integral S (\<lambda>x. ?D x * f (g x))" for n
     using hint by (blast intro: le order_trans)
   ultimately show ?thesis
     by (auto intro: Lim_bounded)
 qed
 
 
 lemma integral_on_image_ubound_nonneg:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real"
   assumes nonneg_fg: "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
       and der_g:   "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
   shows "f integrable_on (g ` S) \<and> integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
          (is "_ \<and> _ \<le> ?b")
 proof -
   let ?D = "\<lambda>x. det (matrix (g' x))"
   define S' where "S' \<equiv> {x \<in> S. ?D x * f(g x) \<noteq> 0}"
   then have der_gS': "\<And>x. x \<in> S' \<Longrightarrow> (g has_derivative g' x) (at x within S')"
     by (metis (mono_tags, lifting) der_g has_derivative_within_subset mem_Collect_eq subset_iff)
   have "(\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) integrable_on UNIV"
     by (simp add: integrable_restrict_UNIV intS)
   then have Df_borel: "(\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> borel_measurable lebesgue"
     using integrable_imp_measurable lebesgue_on_UNIV_eq by force
   have S': "S' \<in> sets lebesgue"
   proof -
     from Df_borel borel_measurable_vimage_open [of _ UNIV]
     have "{x. (if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> T} \<in> sets lebesgue"
       if "open T" for T
       using that unfolding lebesgue_on_UNIV_eq
       by (fastforce simp add: dest!: spec)
     then have "{x. (if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0) \<in> -{0}} \<in> sets lebesgue"
       using open_Compl by blast
     then show ?thesis
       by (simp add: S'_def conj_ac split: if_split_asm cong: conj_cong)
   qed
   then have gS': "g ` S' \<in> sets lebesgue"
   proof (rule differentiable_image_in_sets_lebesgue)
     show "g differentiable_on S'"
       using der_g unfolding S'_def differentiable_def differentiable_on_def
       by (blast intro: has_derivative_within_subset)
   qed auto
   have f: "f \<in> borel_measurable (lebesgue_on (g ` S'))"
   proof (clarsimp simp add: borel_measurable_vimage_open)
     fix T :: "real set"
     assume "open T"
     have "{x \<in> g ` S'. f x \<in> T} = g ` {x \<in> S'. f(g x) \<in> T}"
       by blast
     moreover have "g ` {x \<in> S'. f(g x) \<in> T} \<in> sets lebesgue"
     proof (rule differentiable_image_in_sets_lebesgue)
       let ?h = "\<lambda>x. \<bar>?D x\<bar> * f (g x) /\<^sub>R \<bar>?D x\<bar>"
       have "(\<lambda>x. if x \<in> S' then \<bar>?D x\<bar> * f (g x) else 0) = (\<lambda>x. if x \<in> S then \<bar>?D x\<bar> * f (g x) else 0)"
         by (auto simp: S'_def)
       also have "\<dots> \<in> borel_measurable lebesgue"
         by (rule Df_borel)
       finally have *: "(\<lambda>x. \<bar>?D x\<bar> * f (g x)) \<in> borel_measurable (lebesgue_on S')"
         by (simp add: borel_measurable_if_D)
       have "?h \<in> borel_measurable (lebesgue_on S')"
         by (intro * S' der_gS' borel_measurable_det_Jacobian measurable) (blast intro: der_gS')
       moreover have "?h x = f(g x)" if "x \<in> S'" for x
         using that by (auto simp: S'_def)
       ultimately have "(\<lambda>x. f(g x)) \<in> borel_measurable (lebesgue_on S')"
         by (metis (no_types, lifting) measurable_lebesgue_cong)
       then show "{x \<in> S'. f (g x) \<in> T} \<in> sets lebesgue"
         by (simp add: \<open>S' \<in> sets lebesgue\<close> \<open>open T\<close> borel_measurable_vimage_open sets_restrict_space_iff)
       show "g differentiable_on {x \<in> S'. f (g x) \<in> T}"
         using der_g unfolding S'_def differentiable_def differentiable_on_def
         by (blast intro: has_derivative_within_subset)
     qed auto
     ultimately have "{x \<in> g ` S'. f x \<in> T} \<in> sets lebesgue"
       by metis
     then show "{x \<in> g ` S'. f x \<in> T} \<in> sets (lebesgue_on (g ` S'))"
       by (simp add: \<open>g ` S' \<in> sets lebesgue\<close> sets_restrict_space_iff)
   qed
   have intS': "(\<lambda>x. \<bar>?D x\<bar> * f (g x)) integrable_on S'"
     using intS
     by (rule integrable_spike_set) (auto simp: S'_def intro: empty_imp_negligible)
   have lebS': "{x \<in> S'. g x \<in> T} \<in> sets lebesgue" if "T \<subseteq> g ` S'" "T \<in> sets lebesgue" for T
   proof -
     have "g \<in> borel_measurable (lebesgue_on S')"
       using der_gS' has_derivative_continuous_on S'
       by (blast intro: continuous_imp_measurable_on_sets_lebesgue)
     moreover have "{x \<in> S'. g x \<in> U} \<in> sets lebesgue" if "negligible U" "U \<subseteq> g ` S'" for U
     proof (intro negligible_imp_sets negligible_differentiable_vimage that)
       fix x
       assume x: "x \<in> S'"
       then have "linear (g' x)"
         using der_gS' has_derivative_linear by blast
       with x show "inj (g' x)"
         by (auto simp: S'_def det_nz_iff_inj)
     qed (use der_gS' in auto)
     ultimately show ?thesis
       using double_lebesgue_sets [OF S' gS' order_refl] that by blast
   qed
   have int_gS': "f integrable_on g ` S' \<and> integral (g ` S') f \<le> integral S' (\<lambda>x. \<bar>?D x\<bar> * f(g x))"
     using integral_on_image_ubound_weak [OF S' f nonneg_fg der_gS' intS' lebS'] S'_def by blast
   have "negligible (g ` {x \<in> S. det(matrix(g' x)) = 0})"
   proof (rule baby_Sard, simp_all)
     fix x
     assume x: "x \<in> S \<and> det (matrix (g' x)) = 0"
     then show "(g has_derivative g' x) (at x within {x \<in> S. det (matrix (g' x)) = 0})"
       by (metis (no_types, lifting) der_g has_derivative_within_subset mem_Collect_eq subsetI)
     then show "rank (matrix (g' x)) < CARD('n)"
       using det_nz_iff_inj matrix_vector_mul_linear x
       by (fastforce simp add: less_rank_noninjective)
   qed
   then have negg: "negligible (g ` S - g ` {x \<in> S. ?D x \<noteq> 0})"
     by (rule negligible_subset) (auto simp: S'_def)
   have null: "g ` {x \<in> S. ?D x \<noteq> 0} - g ` S = {}"
     by (auto simp: S'_def)
   let ?F = "{x \<in> S. f (g x) \<noteq> 0}"
   have eq: "g ` S' = g ` ?F \<inter> g ` {x \<in> S. ?D x \<noteq> 0}"
     by (auto simp: S'_def image_iff)
   show ?thesis
   proof
     have "((\<lambda>x. if x \<in> g ` ?F then f x else 0) integrable_on g ` {x \<in> S. ?D x \<noteq> 0})"
       using int_gS' eq integrable_restrict_Int [where f=f]
       by simp
     then have "f integrable_on g ` {x \<in> S. ?D x \<noteq> 0}"
       by (auto simp: image_iff elim!: integrable_eq)
     then show "f integrable_on g ` S"
       apply (rule integrable_spike_set [OF _ empty_imp_negligible negligible_subset])
       using negg null by auto
     have "integral (g ` S) f = integral (g ` {x \<in> S. ?D x \<noteq> 0}) f"
       using negg by (auto intro: negligible_subset integral_spike_set)
     also have "\<dots> = integral (g ` {x \<in> S. ?D x \<noteq> 0}) (\<lambda>x. if x \<in> g ` ?F then f x else 0)"
       by (auto simp: image_iff intro!: integral_cong)
     also have "\<dots> = integral (g ` S') f"
       using  eq integral_restrict_Int by simp
     also have "\<dots> \<le> integral S' (\<lambda>x. \<bar>?D x\<bar> * f(g x))"
       by (metis int_gS')
     also have "\<dots> \<le> ?b"
       by (rule integral_subset_le [OF _ intS' intS]) (use nonneg_fg S'_def in auto)
     finally show "integral (g ` S) f \<le> ?b" .
   qed
 qed
 
 
 lemma absolutely_integrable_on_image_real:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) absolutely_integrable_on S"
   shows "f absolutely_integrable_on (g ` S)"
 proof -
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f (g x)"
   let ?N = "{x \<in> S. f (g x) < 0}" and ?P = "{x \<in> S. f (g x) > 0}"
   have eq: "{x. (if x \<in> S then ?D x else 0) > 0} = {x \<in> S. ?D x > 0}"
            "{x. (if x \<in> S then ?D x else 0) < 0} = {x \<in> S. ?D x < 0}"
     by auto
   have "?D integrable_on S"
     using intS absolutely_integrable_on_def by blast
   then have "(\<lambda>x. if x \<in> S then ?D x else 0) integrable_on UNIV"
     by (simp add: integrable_restrict_UNIV)
   then have D_borel: "(\<lambda>x. if x \<in> S then ?D x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
     using integrable_imp_measurable lebesgue_on_UNIV_eq by blast
   then have Dlt: "{x \<in> S. ?D x < 0} \<in> sets lebesgue"
     unfolding borel_measurable_vimage_halfspace_component_lt
     by (drule_tac x=0 in spec) (auto simp: eq)
   from D_borel have Dgt: "{x \<in> S. ?D x > 0} \<in> sets lebesgue"
     unfolding borel_measurable_vimage_halfspace_component_gt
     by (drule_tac x=0 in spec) (auto simp: eq)
 
   have dfgbm: "?D \<in> borel_measurable (lebesgue_on S)"
     using intS absolutely_integrable_on_def integrable_imp_measurable by blast
   have der_gN: "(g has_derivative g' x) (at x within ?N)" if "x \<in> ?N" for x
       using der_g has_derivative_within_subset that by force
   have "(\<lambda>x. - f x) integrable_on g ` ?N \<and>
          integral (g ` ?N) (\<lambda>x. - f x) \<le> integral ?N (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x))"
   proof (rule integral_on_image_ubound_nonneg [OF _ der_gN])
     have 1: "?D integrable_on {x \<in> S. ?D x < 0}"
       using Dlt
       by (auto intro: set_lebesgue_integral_eq_integral [OF set_integrable_subset] intS)
     have "uminus \<circ> (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x)) integrable_on ?N"
       by (simp add: o_def mult_less_0_iff empty_imp_negligible integrable_spike_set [OF 1])
     then show "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * - f (g x)) integrable_on ?N"
       by (simp add: integrable_neg_iff o_def)
   qed auto
   then have "f integrable_on g ` ?N"
     by (simp add: integrable_neg_iff)
   moreover have "g ` ?N = {y \<in> g ` S. f y < 0}"
     by auto
   ultimately have "f integrable_on {y \<in> g ` S. f y < 0}"
     by simp
   then have N: "f absolutely_integrable_on {y \<in> g ` S. f y < 0}"
     by (rule absolutely_integrable_absolutely_integrable_ubound) auto
 
   have der_gP: "(g has_derivative g' x) (at x within ?P)" if "x \<in> ?P" for x
       using der_g has_derivative_within_subset that by force
   have "f integrable_on g ` ?P \<and> integral (g ` ?P) f \<le> integral ?P ?D"
   proof (rule integral_on_image_ubound_nonneg [OF _ der_gP])
     have "?D integrable_on {x \<in> S. 0 < ?D x}"
       using Dgt
       by (auto intro: set_lebesgue_integral_eq_integral [OF set_integrable_subset] intS)
     then show "?D integrable_on ?P"
       apply (rule integrable_spike_set)
       by (auto simp: zero_less_mult_iff empty_imp_negligible)
   qed auto
   then have "f integrable_on g ` ?P"
     by metis
   moreover have "g ` ?P = {y \<in> g ` S. f y > 0}"
     by auto
   ultimately have "f integrable_on {y \<in> g ` S. f y > 0}"
     by simp
   then have P: "f absolutely_integrable_on {y \<in> g ` S. f y > 0}"
     by (rule absolutely_integrable_absolutely_integrable_lbound) auto
   have "(\<lambda>x. if x \<in> g ` S \<and> f x < 0 \<or> x \<in> g ` S \<and> 0 < f x then f x else 0) = (\<lambda>x. if x \<in> g ` S then f x else 0)"
     by auto
   then show ?thesis
     using absolutely_integrable_Un [OF N P] absolutely_integrable_restrict_UNIV [symmetric, where f=f]
     by simp
 qed
 
 
 proposition absolutely_integrable_on_image:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and intS: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S"
   shows "f absolutely_integrable_on (g ` S)"
   apply (rule absolutely_integrable_componentwise [OF absolutely_integrable_on_image_real [OF der_g]])
   using absolutely_integrable_component [OF intS]  by auto
 
 proposition integral_on_image_ubound:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
   assumes"\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f(g x)"
     and "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S"
   shows "integral (g ` S) f \<le> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x))"
   using integral_on_image_ubound_nonneg [OF assms] by simp
 
 
 subsection\<open>Change-of-variables theorem\<close>
 
 text\<open>The classic change-of-variables theorem. We have two versions with quite general hypotheses,
 the first that the transforming function has a continuous inverse, the second that the base set is
 Lebesgue measurable.\<close>
 lemma cov_invertible_nonneg_le:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
     and f0: "\<And>y. y \<in> T \<Longrightarrow> 0 \<le> f y"
     and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
     and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
     and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
   shows "f integrable_on T \<and> (integral T f) \<le> b \<longleftrightarrow>
              (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) integrable_on S \<and>
              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) \<le> b"
         (is "?lhs = ?rhs")
 proof -
   have Teq: "T = g`S" and Seq: "S = h`T"
     using hg gh image_iff by fastforce+
   have gS: "g differentiable_on S"
     by (meson der_g differentiable_def differentiable_on_def)
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f (g x)"
   show ?thesis
   proof
     assume ?lhs
     then have fT: "f integrable_on T" and intf: "integral T f \<le> b"
       by blast+
     show ?rhs
     proof
       let ?fgh = "\<lambda>x. \<bar>det (matrix (h' x))\<bar> * (\<bar>det (matrix (g' (h x)))\<bar> * f (g (h x)))"
       have ddf: "?fgh x = f x"
         if "x \<in> T" for x
       proof -
         have "matrix (h' x) ** matrix (g' (h x)) = mat 1"
           using that id[OF that] der_g[of "h x"] gh[OF that] left_inverse_linear has_derivative_linear
           by (subst matrix_compose[symmetric]) (force simp: matrix_id_mat_1 has_derivative_linear)+
         then have "\<bar>det (matrix (h' x))\<bar> * \<bar>det (matrix (g' (h x)))\<bar> = 1"
           by (metis abs_1 abs_mult det_I det_mul)
         then show ?thesis
           by (simp add: gh that)
       qed
       have "?D integrable_on (h ` T)"
       proof (intro set_lebesgue_integral_eq_integral absolutely_integrable_on_image_real)
         show "(\<lambda>x. ?fgh x) absolutely_integrable_on T"
         proof (subst absolutely_integrable_on_iff_nonneg)
           show "(\<lambda>x. ?fgh x) integrable_on T"
             using ddf fT integrable_eq by force
         qed (simp add: zero_le_mult_iff f0 gh)
       qed (use der_h in auto)
       with Seq show "(\<lambda>x. ?D x) integrable_on S"
         by simp
       have "integral S (\<lambda>x. ?D x) \<le> integral T (\<lambda>x. ?fgh x)"
         unfolding Seq
       proof (rule integral_on_image_ubound)
         show "(\<lambda>x. ?fgh x) integrable_on T"
         using ddf fT integrable_eq by force
       qed (use f0 gh der_h in auto)
       also have "\<dots> = integral T f"
         by (force simp: ddf intro: integral_cong)
       also have "\<dots> \<le> b"
         by (rule intf)
       finally show "integral S (\<lambda>x. ?D x) \<le> b" .
     qed
   next
     assume R: ?rhs
     then have "f integrable_on g ` S"
       using der_g f0 hg integral_on_image_ubound_nonneg by blast
     moreover have "integral (g ` S) f \<le> integral S (\<lambda>x. ?D x)"
       by (rule integral_on_image_ubound [OF f0 der_g]) (use R Teq in auto)
     ultimately show ?lhs
       using R by (simp add: Teq)
   qed
 qed
 
 
 lemma cov_invertible_nonneg_eq:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
   assumes "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
       and "\<And>y. y \<in> T \<Longrightarrow> 0 \<le> f y"
       and "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
       and "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
       and "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) has_integral b) S \<longleftrightarrow> (f has_integral b) T"
   using cov_invertible_nonneg_le [OF assms]
   by (simp add: has_integral_iff) (meson eq_iff)
 
 
 lemma cov_invertible_real:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real" and g :: "real^'n::_ \<Rightarrow> real^'n::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
       and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
       and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
       and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)) = b \<longleftrightarrow>
          f absolutely_integrable_on T \<and> integral T f = b"
          (is "?lhs = ?rhs")
 proof -
   have Teq: "T = g`S" and Seq: "S = h`T"
     using hg gh image_iff by fastforce+
   let ?DP = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x)" and ?DN = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> * -f(g x)"
   have "+": "(?DP has_integral b) {x \<in> S. f (g x) > 0} \<longleftrightarrow> (f has_integral b) {y \<in> T. f y > 0}" for b
   proof (rule cov_invertible_nonneg_eq)
     have *: "(\<lambda>x. f (g x)) -` Y \<inter> {x \<in> S. f (g x) > 0}
           = ((\<lambda>x. f (g x)) -` Y \<inter> S) \<inter> {x \<in> S. f (g x) > 0}" for Y
       by auto
     show "(g has_derivative g' x) (at x within {x \<in> S. f (g x) > 0})" if "x \<in> {x \<in> S. f (g x) > 0}" for x
       using that der_g has_derivative_within_subset by fastforce
     show "(h has_derivative h' y) (at y within {y \<in> T. f y > 0})" if "y \<in> {y \<in> T. f y > 0}" for y
       using that der_h has_derivative_within_subset by fastforce
   qed (use gh hg id in auto)
   have "-": "(?DN has_integral b) {x \<in> S. f (g x) < 0} \<longleftrightarrow> ((\<lambda>x. - f x) has_integral b) {y \<in> T. f y < 0}" for b
   proof (rule cov_invertible_nonneg_eq)
     have *: "(\<lambda>x. - f (g x)) -` y \<inter> {x \<in> S. f (g x) < 0}
           = ((\<lambda>x. f (g x)) -` uminus ` y \<inter> S) \<inter> {x \<in> S. f (g x) < 0}" for y
       using image_iff by fastforce
     show "(g has_derivative g' x) (at x within {x \<in> S. f (g x) < 0})" if "x \<in> {x \<in> S. f (g x) < 0}" for x
       using that der_g has_derivative_within_subset by fastforce
     show "(h has_derivative h' y) (at y within {y \<in> T. f y < 0})" if "y \<in> {y \<in> T. f y < 0}" for y
       using that der_h has_derivative_within_subset by fastforce
   qed (use gh hg id in auto)
   show ?thesis
   proof
     assume LHS: ?lhs
     have eq: "{x. (if x \<in> S then ?DP x else 0) > 0} = {x \<in> S. ?DP x > 0}"
       "{x. (if x \<in> S then ?DP x else 0) < 0} = {x \<in> S. ?DP x < 0}"
       by auto
     have "?DP integrable_on S"
       using LHS absolutely_integrable_on_def by blast
     then have "(\<lambda>x. if x \<in> S then ?DP x else 0) integrable_on UNIV"
       by (simp add: integrable_restrict_UNIV)
     then have D_borel: "(\<lambda>x. if x \<in> S then ?DP x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
       using integrable_imp_measurable lebesgue_on_UNIV_eq by blast
     then have SN: "{x \<in> S. ?DP x < 0} \<in> sets lebesgue"
       unfolding borel_measurable_vimage_halfspace_component_lt
       by (drule_tac x=0 in spec) (auto simp: eq)
     from D_borel have SP: "{x \<in> S. ?DP x > 0} \<in> sets lebesgue"
       unfolding borel_measurable_vimage_halfspace_component_gt
       by (drule_tac x=0 in spec) (auto simp: eq)
     have "?DP absolutely_integrable_on {x \<in> S. ?DP x > 0}"
       using LHS by (fast intro!: set_integrable_subset [OF _, of _ S] SP)
     then have aP: "?DP absolutely_integrable_on {x \<in> S. f (g x) > 0}"
       by (rule absolutely_integrable_spike_set) (auto simp: zero_less_mult_iff empty_imp_negligible)
     have "?DP absolutely_integrable_on {x \<in> S. ?DP x < 0}"
       using LHS by (fast intro!: set_integrable_subset [OF _, of _ S] SN)
     then have aN: "?DP absolutely_integrable_on {x \<in> S. f (g x) < 0}"
       by (rule absolutely_integrable_spike_set) (auto simp: mult_less_0_iff empty_imp_negligible)
     have fN: "f integrable_on {y \<in> T. f y < 0}"
              "integral {y \<in> T. f y < 0} f = integral {x \<in> S. f (g x) < 0} ?DP"
       using "-" [of "integral {x \<in> S. f(g x) < 0} ?DN"] aN
       by (auto simp: set_lebesgue_integral_eq_integral has_integral_iff integrable_neg_iff)
     have faN: "f absolutely_integrable_on {y \<in> T. f y < 0}"
       apply (rule absolutely_integrable_integrable_bound [where g = "\<lambda>x. - f x"])
       using fN by (auto simp: integrable_neg_iff)
     have fP: "f integrable_on {y \<in> T. f y > 0}"
              "integral {y \<in> T. f y > 0} f = integral {x \<in> S. f (g x) > 0} ?DP"
       using "+" [of "integral {x \<in> S. f(g x) > 0} ?DP"] aP
       by (auto simp: set_lebesgue_integral_eq_integral has_integral_iff integrable_neg_iff)
     have faP: "f absolutely_integrable_on {y \<in> T. f y > 0}"
       apply (rule absolutely_integrable_integrable_bound [where g = f])
       using fP by auto
     have fa: "f absolutely_integrable_on ({y \<in> T. f y < 0} \<union> {y \<in> T. f y > 0})"
       by (rule absolutely_integrable_Un [OF faN faP])
     show ?rhs
     proof
       have eq: "((if x \<in> T \<and> f x < 0 \<or> x \<in> T \<and> 0 < f x then 1 else 0) * f x)
               = (if x \<in> T then 1 else 0) * f x" for x
         by auto
       show "f absolutely_integrable_on T"
         using fa by (simp add: indicator_def set_integrable_def eq)
       have [simp]: "{y \<in> T. f y < 0} \<inter> {y \<in> T. 0 < f y} = {}" for T and f :: "(real^'n::_) \<Rightarrow> real"
         by auto
       have "integral T f = integral ({y \<in> T. f y < 0} \<union> {y \<in> T. f y > 0}) f"
         by (intro empty_imp_negligible integral_spike_set) (auto simp: eq)
       also have "\<dots> = integral {y \<in> T. f y < 0} f + integral {y \<in> T. f y > 0} f"
         using fN fP by simp
       also have "\<dots> = integral {x \<in> S. f (g x) < 0} ?DP + integral {x \<in> S. 0 < f (g x)} ?DP"
         by (simp add: fN fP)
       also have "\<dots> = integral ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. 0 < f (g x)}) ?DP"
         using aP aN by (simp add: set_lebesgue_integral_eq_integral)
       also have "\<dots> = integral S ?DP"
         by (intro empty_imp_negligible integral_spike_set) auto
       also have "\<dots> = b"
         using LHS by simp
       finally show "integral T f = b" .
     qed
   next
     assume RHS: ?rhs
     have eq: "{x. (if x \<in> T then f x else 0) > 0} = {x \<in> T. f x > 0}"
              "{x. (if x \<in> T then f x else 0) < 0} = {x \<in> T. f x < 0}"
       by auto
     have "f integrable_on T"
       using RHS absolutely_integrable_on_def by blast
     then have "(\<lambda>x. if x \<in> T then f x else 0) integrable_on UNIV"
       by (simp add: integrable_restrict_UNIV)
     then have D_borel: "(\<lambda>x. if x \<in> T then f x else 0) \<in> borel_measurable (lebesgue_on UNIV)"
       using integrable_imp_measurable lebesgue_on_UNIV_eq by blast
     then have TN: "{x \<in> T. f x < 0} \<in> sets lebesgue"
       unfolding borel_measurable_vimage_halfspace_component_lt
       by (drule_tac x=0 in spec) (auto simp: eq)
     from D_borel have TP: "{x \<in> T. f x > 0} \<in> sets lebesgue"
       unfolding borel_measurable_vimage_halfspace_component_gt
       by (drule_tac x=0 in spec) (auto simp: eq)
     have aint: "f absolutely_integrable_on {y. y \<in> T \<and> 0 < (f y)}"
                "f absolutely_integrable_on {y. y \<in> T \<and> (f y) < 0}"
          and intT: "integral T f = b"
       using set_integrable_subset [of _ T] TP TN RHS
       by blast+
     show ?lhs
     proof
       have fN: "f integrable_on {v \<in> T. f v < 0}"
         using absolutely_integrable_on_def aint by blast
       then have DN: "(?DN has_integral integral {y \<in> T. f y < 0} (\<lambda>x. - f x)) {x \<in> S. f (g x) < 0}"
         using "-" [of "integral {y \<in> T. f y < 0} (\<lambda>x. - f x)"]
         by (simp add: has_integral_neg_iff integrable_integral)
       have aDN: "?DP absolutely_integrable_on {x \<in> S. f (g x) < 0}"
         apply (rule absolutely_integrable_integrable_bound [where g = ?DN])
         using DN hg by (fastforce simp: abs_mult integrable_neg_iff)+
       have fP: "f integrable_on {v \<in> T. f v > 0}"
         using absolutely_integrable_on_def aint by blast
       then have DP: "(?DP has_integral integral {y \<in> T. f y > 0} f) {x \<in> S. f (g x) > 0}"
         using "+" [of "integral {y \<in> T. f y > 0} f"]
         by (simp add: has_integral_neg_iff integrable_integral)
       have aDP: "?DP absolutely_integrable_on {x \<in> S. f (g x) > 0}"
         apply (rule absolutely_integrable_integrable_bound [where g = ?DP])
         using DP hg by (fastforce simp: integrable_neg_iff)+
       have eq: "(if x \<in> S then 1 else 0) * ?DP x = (if x \<in> S \<and> f (g x) < 0 \<or> x \<in> S \<and> f (g x) > 0 then 1 else 0) * ?DP x" for x
         by force
       have "?DP absolutely_integrable_on ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. f (g x) > 0})"
         by (rule absolutely_integrable_Un [OF aDN aDP])
       then show I: "?DP absolutely_integrable_on S"
         by (simp add: indicator_def eq set_integrable_def)
       have [simp]: "{y \<in> S. f y < 0} \<inter> {y \<in> S. 0 < f y} = {}" for S and f :: "(real^'n::_) \<Rightarrow> real"
         by auto
       have "integral S ?DP = integral ({x \<in> S. f (g x) < 0} \<union> {x \<in> S. f (g x) > 0}) ?DP"
         by (intro empty_imp_negligible integral_spike_set) auto
       also have "\<dots> = integral {x \<in> S. f (g x) < 0} ?DP + integral {x \<in> S. 0 < f (g x)} ?DP"
         using aDN aDP by (simp add: set_lebesgue_integral_eq_integral)
       also have "\<dots> = - integral {y \<in> T. f y < 0} (\<lambda>x. - f x) + integral {y \<in> T. f y > 0} f"
         using DN DP by (auto simp: has_integral_iff)
       also have "\<dots> = integral ({x \<in> T. f x < 0} \<union> {x \<in> T. 0 < f x}) f"
         by (simp add: fN fP)
       also have "\<dots> = integral T f"
         by (intro empty_imp_negligible integral_spike_set) auto
       also have "\<dots> = b"
         using intT by simp
       finally show "integral S ?DP = b" .
     qed
   qed
 qed
 
 
 lemma cv_inv_version3:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and der_h: "\<And>y. y \<in> T \<Longrightarrow> (h has_derivative h' y) (at y within T)"
     and hg: "\<And>x. x \<in> S \<Longrightarrow> g x \<in> T \<and> h(g x) = x"
     and gh: "\<And>y. y \<in> T \<Longrightarrow> h y \<in> S \<and> g(h y) = y"
     and id: "\<And>y. y \<in> T \<Longrightarrow> h' y \<circ> g'(h y) = id"
   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
          \<longleftrightarrow> f absolutely_integrable_on T \<and> integral T f = b"
 proof -
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)"
   have "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> * f(g x) $ i) absolutely_integrable_on S \<and> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> * (f(g x) $ i)) = b $ i) \<longleftrightarrow>
         ((\<lambda>x. f x $ i) absolutely_integrable_on T \<and> integral T (\<lambda>x. f x $ i) = b $ i)" for i
     by (rule cov_invertible_real [OF der_g der_h hg gh id])
   then have "?D absolutely_integrable_on S \<and> (?D has_integral b) S \<longleftrightarrow>
         f absolutely_integrable_on T \<and> (f has_integral b) T"
     unfolding absolutely_integrable_componentwise_iff [where f=f] has_integral_componentwise_iff [of f]
               absolutely_integrable_componentwise_iff [where f="?D"] has_integral_componentwise_iff [of ?D]
     by (auto simp: all_conj_distrib Basis_vec_def cart_eq_inner_axis [symmetric]
            has_integral_iff set_lebesgue_integral_eq_integral)
   then show ?thesis
     using absolutely_integrable_on_def by blast
 qed
 
 
 lemma cv_inv_version4:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S) \<and> invertible(matrix(g' x))"
     and hg: "\<And>x. x \<in> S \<Longrightarrow> continuous_on (g ` S) h \<and> h(g x) = x"
   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
          \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
 proof -
   have "\<forall>x. \<exists>h'. x \<in> S
            \<longrightarrow> (g has_derivative g' x) (at x within S) \<and> linear h' \<and> g' x \<circ> h' = id \<and> h' \<circ> g' x = id"
     using der_g matrix_invertible has_derivative_linear by blast
   then obtain h' where h':
     "\<And>x. x \<in> S
            \<Longrightarrow> (g has_derivative g' x) (at x within S) \<and>
                linear (h' x) \<and> g' x \<circ> (h' x) = id \<and> (h' x) \<circ> g' x = id"
     by metis
   show ?thesis
   proof (rule cv_inv_version3)
     show "\<And>y. y \<in> g ` S \<Longrightarrow> (h has_derivative h' (h y)) (at y within g ` S)"
       using h' hg
       by (force simp: continuous_on_eq_continuous_within intro!: has_derivative_inverse_within)
   qed (use h' hg in auto)
 qed
 
 
 theorem has_absolute_integral_change_of_variables_invertible:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and hg: "\<And>x. x \<in> S \<Longrightarrow> h(g x) = x"
       and conth: "continuous_on (g ` S) h"
   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and> integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b \<longleftrightarrow>
          f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
     (is "?lhs = ?rhs")
 proof -
   let ?S = "{x \<in> S. invertible (matrix (g' x))}" and ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)"
   have *: "?D absolutely_integrable_on ?S \<and> integral ?S ?D = b
            \<longleftrightarrow> f absolutely_integrable_on (g ` ?S) \<and> integral (g ` ?S) f = b"
   proof (rule cv_inv_version4)
     show "(g has_derivative g' x) (at x within ?S) \<and> invertible (matrix (g' x))"
       if "x \<in> ?S" for x
       using der_g that has_derivative_within_subset that by fastforce
     show "continuous_on (g ` ?S) h \<and> h (g x) = x"
       if "x \<in> ?S" for x
       using that continuous_on_subset [OF conth]  by (simp add: hg image_mono)
   qed
   have "(g has_derivative g' x) (at x within {x \<in> S. rank (matrix (g' x)) < CARD('m)})" if "x \<in> S" for x
     by (metis (no_types, lifting) der_g has_derivative_within_subset mem_Collect_eq subsetI that)
   then have "negligible (g ` {x \<in> S. \<not> invertible (matrix (g' x))})"
     by (auto simp: invertible_det_nz det_eq_0_rank intro: baby_Sard)
   then have neg: "negligible {x \<in> g ` S. x \<notin> g ` ?S \<and> f x \<noteq> 0}"
     by (auto intro: negligible_subset)
   have [simp]: "{x \<in> g ` ?S. x \<notin> g ` S \<and> f x \<noteq> 0} = {}"
     by auto
   have "?D absolutely_integrable_on ?S \<and> integral ?S ?D = b
     \<longleftrightarrow> ?D absolutely_integrable_on S \<and> integral S ?D = b"
     apply (intro conj_cong absolutely_integrable_spike_set_eq)
       apply(auto simp: integral_spike_set invertible_det_nz empty_imp_negligible neg)
     done
   moreover
   have "f absolutely_integrable_on (g ` ?S) \<and> integral (g ` ?S) f = b
     \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
     by (auto intro!: conj_cong absolutely_integrable_spike_set_eq integral_spike_set neg)
   ultimately
   show ?thesis
     using "*" by blast
 qed
 
 
 
 theorem has_absolute_integral_change_of_variables_compact:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "compact S"
       and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
       and inj: "inj_on g S"
   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
              integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
       \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b)"
 proof -
   obtain h where hg: "\<And>x. x \<in> S \<Longrightarrow> h(g x) = x"
     using inj by (metis the_inv_into_f_f)
   have conth: "continuous_on (g ` S) h"
     by (metis \<open>compact S\<close> continuous_on_inv der_g has_derivative_continuous_on hg)
   show ?thesis
     by (rule has_absolute_integral_change_of_variables_invertible [OF der_g hg conth])
 qed
 
 
 lemma has_absolute_integral_change_of_variables_compact_family:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes compact: "\<And>n::nat. compact (F n)"
       and der_g: "\<And>x. x \<in> (\<Union>n. F n) \<Longrightarrow> (g has_derivative g' x) (at x within (\<Union>n. F n))"
       and inj: "inj_on g (\<Union>n. F n)"
   shows "((\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on (\<Union>n. F n) \<and>
              integral (\<Union>n. F n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
       \<longleftrightarrow> f absolutely_integrable_on (g ` (\<Union>n. F n)) \<and> integral (g ` (\<Union>n. F n)) f = b)"
 proof -
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)"
   let ?U = "\<lambda>n. \<Union>m\<le>n. F m"
   let ?lift = "vec::real\<Rightarrow>real^1"
   have F_leb: "F m \<in> sets lebesgue" for m
     by (simp add: compact borel_compact)
   have iff: "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)) absolutely_integrable_on (?U n) \<and>
              integral (?U n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)) = b
          \<longleftrightarrow> f absolutely_integrable_on (g ` (?U n)) \<and> integral (g ` (?U n)) f = b" for n b and f :: "real^'m::_ \<Rightarrow> real^'k"
   proof (rule has_absolute_integral_change_of_variables_compact)
     show "compact (?U n)"
       by (simp add: compact compact_UN)
     show "(g has_derivative g' x) (at x within (?U n))"
       if "x \<in> ?U n" for x
       using that by (blast intro!: has_derivative_within_subset [OF der_g])
     show "inj_on g (?U n)"
       using inj by (auto simp: inj_on_def)
   qed
   show ?thesis
     unfolding image_UN
   proof safe
     assume DS: "?D absolutely_integrable_on (\<Union>n. F n)"
       and b: "b = integral (\<Union>n. F n) ?D"
     have DU: "\<And>n. ?D absolutely_integrable_on (?U n)"
              "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
       using integral_countable_UN [OF DS F_leb] by auto
     with iff have fag: "f absolutely_integrable_on g ` (?U n)"
       and fg_int: "integral (\<Union>m\<le>n. g ` F m) f = integral (?U n) ?D" for n
       by (auto simp: image_UN)
     let ?h = "\<lambda>x. if x \<in> (\<Union>m. g ` F m) then norm(f x) else 0"
     have "(\<lambda>x. if x \<in> (\<Union>m. g ` F m) then f x else 0) absolutely_integrable_on UNIV"
     proof (rule dominated_convergence_absolutely_integrable)
       show "(\<lambda>x. if x \<in> (\<Union>m\<le>k. g ` F m) then f x else 0) absolutely_integrable_on UNIV" for k
         unfolding absolutely_integrable_restrict_UNIV
         using fag by (simp add: image_UN)
       let ?nf = "\<lambda>n x. if x \<in> (\<Union>m\<le>n. g ` F m) then norm(f x) else 0"
       show "?h integrable_on UNIV"
       proof (rule monotone_convergence_increasing [THEN conjunct1])
         show "?nf k integrable_on UNIV" for k
           using fag
           unfolding integrable_restrict_UNIV absolutely_integrable_on_def by (simp add: image_UN)
         { fix n
           have "(norm \<circ> ?D) absolutely_integrable_on ?U n"
             by (intro absolutely_integrable_norm DU)
           then have "integral (g ` ?U n) (norm \<circ> f) = integral (?U n) (norm \<circ> ?D)"
             using iff [of n "vec \<circ> norm \<circ> f" "integral (?U n) (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R (?lift \<circ> norm \<circ> f) (g x))"]
             unfolding absolutely_integrable_on_1_iff integral_on_1_eq by (auto simp: o_def)
         }
         moreover have "bounded (range (\<lambda>k. integral (?U k) (norm \<circ> ?D)))"
           unfolding bounded_iff
         proof (rule exI, clarify)
           fix k
           show "norm (integral (?U k) (norm \<circ> ?D)) \<le> integral (\<Union>n. F n) (norm \<circ> ?D)"
             unfolding integral_restrict_UNIV [of _ "norm \<circ> ?D", symmetric]
           proof (rule integral_norm_bound_integral)
             show "(\<lambda>x. if x \<in> \<Union> (F ` {..k}) then (norm \<circ> ?D) x else 0) integrable_on UNIV"
               "(\<lambda>x. if x \<in> (\<Union>n. F n) then (norm \<circ> ?D) x else 0) integrable_on UNIV"
               using DU(1) DS
               unfolding absolutely_integrable_on_def o_def integrable_restrict_UNIV by auto
           qed auto
         qed
         ultimately show "bounded (range (\<lambda>k. integral UNIV (?nf k)))"
           by (simp add: integral_restrict_UNIV image_UN [symmetric] o_def)
       next
         show "(\<lambda>k. if x \<in> (\<Union>m\<le>k. g ` F m) then norm (f x) else 0)
               \<longlonglongrightarrow> (if x \<in> (\<Union>m. g ` F m) then norm (f x) else 0)" for x
           by (force intro: tendsto_eventually eventually_sequentiallyI)
       qed auto
     next
       show "(\<lambda>k. if x \<in> (\<Union>m\<le>k. g ` F m) then f x else 0)
             \<longlonglongrightarrow> (if x \<in> (\<Union>m. g ` F m) then f x else 0)" for x
       proof clarsimp
         fix m y
         assume "y \<in> F m"
         show "(\<lambda>k. if \<exists>x\<in>{..k}. g y \<in> g ` F x then f (g y) else 0) \<longlonglongrightarrow> f (g y)"
           using \<open>y \<in> F m\<close> by (force intro: tendsto_eventually eventually_sequentiallyI [of m])
       qed
     qed auto
     then show fai: "f absolutely_integrable_on (\<Union>m. g ` F m)"
       using absolutely_integrable_restrict_UNIV by blast
     show "integral ((\<Union>x. g ` F x)) f = integral (\<Union>n. F n) ?D"
     proof (rule LIMSEQ_unique)
       show "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>x. g ` F x) f"
         unfolding fg_int [symmetric]
       proof (rule integral_countable_UN [OF fai])
         show "g ` F m \<in> sets lebesgue" for m
         proof (rule differentiable_image_in_sets_lebesgue [OF F_leb])
           show "g differentiable_on F m"
             by (meson der_g differentiableI UnionI differentiable_on_def differentiable_on_subset rangeI subsetI)
         qed auto
       qed
     next
       show "(\<lambda>n. integral (?U n) ?D) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
         by (rule DU)
     qed
   next
     assume fs: "f absolutely_integrable_on (\<Union>x. g ` F x)"
       and b: "b = integral ((\<Union>x. g ` F x)) f"
     have gF_leb: "g ` F m \<in> sets lebesgue" for m
     proof (rule differentiable_image_in_sets_lebesgue [OF F_leb])
       show "g differentiable_on F m"
         using der_g unfolding differentiable_def differentiable_on_def
         by (meson Sup_upper UNIV_I UnionI has_derivative_within_subset image_eqI)
     qed auto
     have fgU: "\<And>n. f absolutely_integrable_on (\<Union>m\<le>n. g ` F m)"
       "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>m. g ` F m) f"
       using integral_countable_UN [OF fs gF_leb] by auto
     with iff have DUn: "?D absolutely_integrable_on ?U n"
       and D_int: "integral (?U n) ?D = integral (\<Union>m\<le>n. g ` F m) f" for n
       by (auto simp: image_UN)
     let ?h = "\<lambda>x. if x \<in> (\<Union>n. F n) then norm(?D x) else 0"
     have "(\<lambda>x. if x \<in> (\<Union>n. F n) then ?D x else 0) absolutely_integrable_on UNIV"
     proof (rule dominated_convergence_absolutely_integrable)
       show "(\<lambda>x. if x \<in> ?U k then ?D x else 0) absolutely_integrable_on UNIV" for k
         unfolding absolutely_integrable_restrict_UNIV using DUn by simp
       let ?nD = "\<lambda>n x. if x \<in> ?U n then norm(?D x) else 0"
       show "?h integrable_on UNIV"
       proof (rule monotone_convergence_increasing [THEN conjunct1])
         show "?nD k integrable_on UNIV" for k
           using DUn
           unfolding integrable_restrict_UNIV absolutely_integrable_on_def by (simp add: image_UN)
         { fix n::nat
           have "(norm \<circ> f) absolutely_integrable_on (\<Union>m\<le>n. g ` F m)"
             apply (rule absolutely_integrable_norm)
             using fgU by blast
           then have "integral (?U n) (norm \<circ> ?D) = integral (g ` ?U n) (norm \<circ> f)"
             using iff [of n "?lift \<circ> norm \<circ> f" "integral (g ` ?U n) (?lift \<circ> norm \<circ> f)"]
             unfolding absolutely_integrable_on_1_iff integral_on_1_eq image_UN by (auto simp: o_def)
         }
         moreover have "bounded (range (\<lambda>k. integral (g ` ?U k) (norm \<circ> f)))"
           unfolding bounded_iff
         proof (rule exI, clarify)
           fix k
           show "norm (integral (g ` ?U k) (norm \<circ> f)) \<le> integral (g ` (\<Union>n. F n)) (norm \<circ> f)"
             unfolding integral_restrict_UNIV [of _ "norm \<circ> f", symmetric]
           proof (rule integral_norm_bound_integral)
             show "(\<lambda>x. if x \<in> g ` ?U k then (norm \<circ> f) x else 0) integrable_on UNIV"
                  "(\<lambda>x. if x \<in> g ` (\<Union>n. F n) then (norm \<circ> f) x else 0) integrable_on UNIV"
               using fgU fs
               unfolding absolutely_integrable_on_def o_def integrable_restrict_UNIV
               by (auto simp: image_UN)
           qed auto
         qed
         ultimately show "bounded (range (\<lambda>k. integral UNIV (?nD k)))"
           unfolding integral_restrict_UNIV image_UN [symmetric] o_def by simp
       next
         show "(\<lambda>k. if x \<in> ?U k then norm (?D x) else 0) \<longlonglongrightarrow> (if x \<in> (\<Union>n. F n) then norm (?D x) else 0)" for x
           by (force intro: tendsto_eventually eventually_sequentiallyI)
       qed auto
     next
       show "(\<lambda>k. if x \<in> ?U k then ?D x else 0) \<longlonglongrightarrow> (if x \<in> (\<Union>n. F n) then ?D x else 0)" for x
       proof clarsimp
         fix n
         assume "x \<in> F n"
         show "(\<lambda>m. if \<exists>j\<in>{..m}. x \<in> F j then ?D x else 0) \<longlonglongrightarrow> ?D x"
           using \<open>x \<in> F n\<close> by (auto intro!: tendsto_eventually eventually_sequentiallyI [of n])
       qed
     qed auto
     then show Dai: "?D absolutely_integrable_on (\<Union>n. F n)"
       unfolding absolutely_integrable_restrict_UNIV by simp
     show "integral (\<Union>n. F n) ?D = integral ((\<Union>x. g ` F x)) f"
     proof (rule LIMSEQ_unique)
       show "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>x. g ` F x) f"
         by (rule fgU)
       show "(\<lambda>n. integral (\<Union>m\<le>n. g ` F m) f) \<longlonglongrightarrow> integral (\<Union>n. F n) ?D"
         unfolding D_int [symmetric] by (rule integral_countable_UN [OF Dai F_leb])
     qed
   qed
 qed
 
 
 theorem has_absolute_integral_change_of_variables:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes S: "S \<in> sets lebesgue"
     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and inj: "inj_on g S"
   shows "(\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) = b
      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
 proof -
   obtain C N where "fsigma C" and N: "N \<in> null_sets lebesgue" and CNS: "C \<union> N = S" and "disjnt C N"
     using lebesgue_set_almost_fsigma [OF S] .
   then obtain F :: "nat \<Rightarrow> (real^'m::_) set"
     where F: "range F \<subseteq> Collect compact" and Ceq: "C = Union(range F)"
     using fsigma_Union_compact by metis
   have "negligible N"
     using N by (simp add: negligible_iff_null_sets)
   let ?D = "\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f (g x)"
   have "?D absolutely_integrable_on C \<and> integral C ?D = b
     \<longleftrightarrow> f absolutely_integrable_on (g ` C) \<and> integral (g ` C) f = b"
     unfolding Ceq
   proof (rule has_absolute_integral_change_of_variables_compact_family)
     fix n x
     assume "x \<in> \<Union>(F ` UNIV)"
     then show "(g has_derivative g' x) (at x within \<Union>(F ` UNIV))"
       using Ceq \<open>C \<union> N = S\<close> der_g has_derivative_within_subset by blast
   next
     have "\<Union>(F ` UNIV) \<subseteq> S"
       using Ceq \<open>C \<union> N = S\<close> by blast
     then show "inj_on g (\<Union>(F ` UNIV))"
       using inj by (meson inj_on_subset)
   qed (use F in auto)
   moreover
   have "?D absolutely_integrable_on C \<and> integral C ?D = b
     \<longleftrightarrow> ?D absolutely_integrable_on S \<and> integral S ?D = b"
   proof (rule conj_cong)
     have neg: "negligible {x \<in> C - S. ?D x \<noteq> 0}" "negligible {x \<in> S - C. ?D x \<noteq> 0}"
       using CNS by (blast intro: negligible_subset [OF \<open>negligible N\<close>])+
     then show "(?D absolutely_integrable_on C) = (?D absolutely_integrable_on S)"
       by (rule absolutely_integrable_spike_set_eq)
     show "(integral C ?D = b) \<longleftrightarrow> (integral S ?D = b)"
       using integral_spike_set [OF neg] by simp
   qed
   moreover
   have "f absolutely_integrable_on (g ` C) \<and> integral (g ` C) f = b
     \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
   proof (rule conj_cong)
     have "g differentiable_on N"
       by (metis CNS der_g differentiable_def differentiable_on_def differentiable_on_subset sup.cobounded2)
     with \<open>negligible N\<close>
     have neg_gN: "negligible (g ` N)"
       by (blast intro: negligible_differentiable_image_negligible)
     have neg: "negligible {x \<in> g ` C - g ` S. f x \<noteq> 0}"
               "negligible {x \<in> g ` S - g ` C. f x \<noteq> 0}"
       using CNS by (blast intro: negligible_subset [OF neg_gN])+
     then show "(f absolutely_integrable_on g ` C) = (f absolutely_integrable_on g ` S)"
       by (rule absolutely_integrable_spike_set_eq)
     show "(integral (g ` C) f = b) \<longleftrightarrow> (integral (g ` S) f = b)"
       using integral_spike_set [OF neg] by simp
   qed
   ultimately show ?thesis
     by simp
 qed
 
 
 corollary absolutely_integrable_change_of_variables:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "S \<in> sets lebesgue"
     and "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and "inj_on g S"
   shows "f absolutely_integrable_on (g ` S)
      \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S"
   using assms has_absolute_integral_change_of_variables by blast
 
 corollary integral_change_of_variables:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes S: "S \<in> sets lebesgue"
     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative g' x) (at x within S)"
     and inj: "inj_on g S"
     and disj: "(f absolutely_integrable_on (g ` S) \<or>
         (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S)"
   shows "integral (g ` S) f = integral S (\<lambda>x. \<bar>det (matrix (g' x))\<bar> *\<^sub>R f(g x))"
   using has_absolute_integral_change_of_variables [OF S der_g inj] disj
   by blast
 
 lemma has_absolute_integral_change_of_variables_1:
   fixes f :: "real \<Rightarrow> real^'n::{finite,wellorder}" and g :: "real \<Rightarrow> real"
   assumes S: "S \<in> sets lebesgue"
     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_vector_derivative g' x) (at x within S)"
     and inj: "inj_on g S"
   shows "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) = b
      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
 proof -
   let ?lift = "vec :: real \<Rightarrow> real^1"
   let ?drop = "(\<lambda>x::real^1. x $ 1)"
   have S': "?lift ` S \<in> sets lebesgue"
     by (auto intro: differentiable_image_in_sets_lebesgue [OF S] differentiable_vec)
   have "((\<lambda>x. vec (g (x $ 1))) has_derivative (*\<^sub>R) (g' z)) (at (vec z) within ?lift ` S)"
     if "z \<in> S" for z
     using der_g [OF that]
     by (simp add: has_vector_derivative_def has_derivative_vector_1)
   then have der': "\<And>x. x \<in> ?lift ` S \<Longrightarrow>
         (?lift \<circ> g \<circ> ?drop has_derivative (*\<^sub>R) (g' (?drop x))) (at x within ?lift ` S)"
     by (auto simp: o_def)
   have inj': "inj_on (vec \<circ> g \<circ> ?drop) (vec ` S)"
     using inj by (simp add: inj_on_def)
   let ?fg = "\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)"
   have "((\<lambda>x. ?fg x $ i) absolutely_integrable_on S \<and> ((\<lambda>x. ?fg x $ i) has_integral b $ i) S
     \<longleftrightarrow> (\<lambda>x. f x $ i) absolutely_integrable_on g ` S \<and> ((\<lambda>x. f x $ i) has_integral b $ i) (g ` S))" for i
     using has_absolute_integral_change_of_variables [OF S' der' inj', of "\<lambda>x. ?lift(f (?drop x) $ i)" "?lift (b$i)"]
     unfolding integrable_on_1_iff integral_on_1_eq absolutely_integrable_on_1_iff absolutely_integrable_drop absolutely_integrable_on_def
     by (auto simp: image_comp o_def integral_vec1_eq has_integral_iff)
   then have "?fg absolutely_integrable_on S \<and> (?fg has_integral b) S
          \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> (f has_integral b) (g ` S)"
     unfolding has_integral_componentwise_iff [where y=b]
            absolutely_integrable_componentwise_iff [where f=f]
            absolutely_integrable_componentwise_iff [where f = ?fg]
     by (force simp: Basis_vec_def cart_eq_inner_axis)
   then show ?thesis
     using absolutely_integrable_on_def by blast
 qed
 
 
 corollary absolutely_integrable_change_of_variables_1:
   fixes f :: "real \<Rightarrow> real^'n::{finite,wellorder}" and g :: "real \<Rightarrow> real"
   assumes S: "S \<in> sets lebesgue"
     and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_vector_derivative g' x) (at x within S)"
     and inj: "inj_on g S"
   shows "(f absolutely_integrable_on g ` S \<longleftrightarrow>
              (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S)"
   using has_absolute_integral_change_of_variables_1 [OF assms] by auto
 
 
 subsection\<open>Change of variables for integrals: special case of linear function\<close>
 
 lemma has_absolute_integral_change_of_variables_linear:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "linear g"
   shows "(\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
            integral S (\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) = b
      \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
 proof (cases "det(matrix g) = 0")
   case True
   then have "negligible(g ` S)"
     using assms det_nz_iff_inj negligible_linear_singular_image by blast
   with True show ?thesis
     by (auto simp: absolutely_integrable_on_def integrable_negligible integral_negligible)
 next
   case False
   then obtain h where h: "\<And>x. x \<in> S \<Longrightarrow> h (g x) = x" "linear h"
     using assms det_nz_iff_inj linear_injective_isomorphism by blast
   show ?thesis
   proof (rule has_absolute_integral_change_of_variables_invertible)
     show "(g has_derivative g) (at x within S)" for x
       by (simp add: assms linear_imp_has_derivative)
     show "continuous_on (g ` S) h"
       using continuous_on_eq_continuous_within has_derivative_continuous linear_imp_has_derivative h by blast
   qed (use h in auto)
 qed
 
 lemma absolutely_integrable_change_of_variables_linear:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "linear g"
   shows "(\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S
      \<longleftrightarrow> f absolutely_integrable_on (g ` S)"
   using assms has_absolute_integral_change_of_variables_linear by blast
 
 lemma absolutely_integrable_on_linear_image:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "linear g"
   shows "f absolutely_integrable_on (g ` S)
      \<longleftrightarrow> (f \<circ> g) absolutely_integrable_on S \<or> det(matrix g) = 0"
   unfolding assms absolutely_integrable_change_of_variables_linear [OF assms, symmetric] absolutely_integrable_on_scaleR_iff
   by (auto simp: set_integrable_def)
 
 lemma integral_change_of_variables_linear:
   fixes f :: "real^'m::{finite,wellorder} \<Rightarrow> real^'n" and g :: "real^'m::_ \<Rightarrow> real^'m::_"
   assumes "linear g"
       and "f absolutely_integrable_on (g ` S) \<or> (f \<circ> g) absolutely_integrable_on S"
     shows "integral (g ` S) f = \<bar>det (matrix g)\<bar> *\<^sub>R integral S (f \<circ> g)"
 proof -
   have "((\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f (g x)) absolutely_integrable_on S) \<or> (f absolutely_integrable_on g ` S)"
     using absolutely_integrable_on_linear_image assms by blast
   moreover
   have ?thesis if "((\<lambda>x. \<bar>det (matrix g)\<bar> *\<^sub>R f (g x)) absolutely_integrable_on S)" "(f absolutely_integrable_on g ` S)"
     using has_absolute_integral_change_of_variables_linear [OF \<open>linear g\<close>] that
     by (auto simp: o_def)
   ultimately show ?thesis
     using absolutely_integrable_change_of_variables_linear [OF \<open>linear g\<close>]
     by blast
 qed
 
 subsection\<open>Change of variable for measure\<close>
 
 lemma has_measure_differentiable_image:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes "S \<in> sets lebesgue"
       and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
       and "inj_on f S"
   shows "f ` S \<in> lmeasurable \<and> measure lebesgue (f ` S) = m
      \<longleftrightarrow> ((\<lambda>x. \<bar>det (matrix (f' x))\<bar>) has_integral m) S"
   using has_absolute_integral_change_of_variables [OF assms, of "\<lambda>x. (1::real^1)" "vec m"]
   unfolding absolutely_integrable_on_1_iff integral_on_1_eq integrable_on_1_iff absolutely_integrable_on_def
   by (auto simp: has_integral_iff lmeasurable_iff_integrable_on lmeasure_integral)
 
 lemma measurable_differentiable_image_eq:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes "S \<in> sets lebesgue"
       and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
       and "inj_on f S"
   shows "f ` S \<in> lmeasurable \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   using has_measure_differentiable_image [OF assms]
   by blast
 
 lemma measurable_differentiable_image_alt:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes "S \<in> sets lebesgue"
     and "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and "inj_on f S"
   shows "f ` S \<in> lmeasurable \<longleftrightarrow> (\<lambda>x. \<bar>det (matrix (f' x))\<bar>) absolutely_integrable_on S"
   using measurable_differentiable_image_eq [OF assms]
   by (simp only: absolutely_integrable_on_iff_nonneg)
 
 lemma measure_differentiable_image_eq:
   fixes f :: "real^'n::{finite,wellorder} \<Rightarrow> real^'n::_"
   assumes S: "S \<in> sets lebesgue"
     and der_f: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and inj: "inj_on f S"
     and intS: "(\<lambda>x. \<bar>det (matrix (f' x))\<bar>) integrable_on S"
   shows "measure lebesgue (f ` S) = integral S (\<lambda>x. \<bar>det (matrix (f' x))\<bar>)"
   using measurable_differentiable_image_eq [OF S der_f inj]
         assms has_measure_differentiable_image by blast
 
 end
diff --git a/src/HOL/Analysis/Connected.thy b/src/HOL/Analysis/Connected.thy
--- a/src/HOL/Analysis/Connected.thy
+++ b/src/HOL/Analysis/Connected.thy
@@ -1,741 +1,741 @@
 (*  Author:     L C Paulson, University of Cambridge
     Material split off from Topology_Euclidean_Space
 *)
 
 section \<open>Connected Components\<close>
 
 theory Connected
   imports
     Abstract_Topology_2
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Connectedness\<close>
 
 lemma connected_local:
  "connected S \<longleftrightarrow>
   \<not> (\<exists>e1 e2.
       openin (top_of_set S) e1 \<and>
       openin (top_of_set S) e2 \<and>
       S \<subseteq> e1 \<union> e2 \<and>
       e1 \<inter> e2 = {} \<and>
       e1 \<noteq> {} \<and>
       e2 \<noteq> {})"
   unfolding connected_def openin_open
   by safe blast+
 
 lemma exists_diff:
   fixes P :: "'a set \<Rightarrow> bool"
   shows "(\<exists>S. P (- S)) \<longleftrightarrow> (\<exists>S. P S)"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   have ?rhs if ?lhs
     using that by blast
   moreover have "P (- (- S))" if "P S" for S
   proof -
     have "S = - (- S)" by simp
     with that show ?thesis by metis
   qed
   ultimately show ?thesis by metis
 qed
 
 lemma connected_clopen: "connected S \<longleftrightarrow>
   (\<forall>T. openin (top_of_set S) T \<and>
      closedin (top_of_set S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   have "\<not> connected S \<longleftrightarrow>
     (\<exists>e1 e2. open e1 \<and> open (- e2) \<and> S \<subseteq> e1 \<union> (- e2) \<and> e1 \<inter> (- e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (- e2) \<inter> S \<noteq> {})"
     unfolding connected_def openin_open closedin_closed
     by (metis double_complement)
   then have th0: "connected S \<longleftrightarrow>
     \<not> (\<exists>e2 e1. closed e2 \<and> open e1 \<and> S \<subseteq> e1 \<union> (- e2) \<and> e1 \<inter> (- e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (- e2) \<inter> S \<noteq> {})"
     (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)")
     by (simp add: closed_def) metis
   have th1: "?rhs \<longleftrightarrow> \<not> (\<exists>t' t. closed t'\<and>t = S\<inter>t' \<and> t\<noteq>{} \<and> t\<noteq>S \<and> (\<exists>t'. open t' \<and> t = S \<inter> t'))"
     (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
     unfolding connected_def openin_open closedin_closed by auto
   have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" for e2
   proof -
     have "?P e2 e1 \<longleftrightarrow> (\<exists>t. closed e2 \<and> t = S\<inter>e2 \<and> open e1 \<and> t = S\<inter>e1 \<and> t\<noteq>{} \<and> t \<noteq> S)" for e1
       by auto
     then show ?thesis
       by metis
   qed
   then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)"
     by blast
   then show ?thesis
     by (simp add: th0 th1)
 qed
 
 subsection \<open>Connected components, considered as a connectedness relation or a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "connected_component s x y \<equiv> \<exists>t. connected t \<and> t \<subseteq> s \<and> x \<in> t \<and> y \<in> t"
 
 abbreviation "connected_component_set s x \<equiv> Collect (connected_component s x)"
 
 lemma connected_componentI:
   "connected t \<Longrightarrow> t \<subseteq> s \<Longrightarrow> x \<in> t \<Longrightarrow> y \<in> t \<Longrightarrow> connected_component s x y"
   by (auto simp: connected_component_def)
 
 lemma connected_component_in: "connected_component s x y \<Longrightarrow> x \<in> s \<and> y \<in> s"
   by (auto simp: connected_component_def)
 
 lemma connected_component_refl: "x \<in> s \<Longrightarrow> connected_component s x x"
   by (auto simp: connected_component_def) (use connected_sing in blast)
 
 lemma connected_component_refl_eq [simp]: "connected_component s x x \<longleftrightarrow> x \<in> s"
   by (auto simp: connected_component_refl) (auto simp: connected_component_def)
 
 lemma connected_component_sym: "connected_component s x y \<Longrightarrow> connected_component s y x"
   by (auto simp: connected_component_def)
 
 lemma connected_component_trans:
   "connected_component s x y \<Longrightarrow> connected_component s y z \<Longrightarrow> connected_component s x z"
   unfolding connected_component_def
   by (metis Int_iff Un_iff Un_subset_iff equals0D connected_Un)
 
 lemma connected_component_of_subset:
   "connected_component s x y \<Longrightarrow> s \<subseteq> t \<Longrightarrow> connected_component t x y"
   by (auto simp: connected_component_def)
 
 lemma connected_component_Union: "connected_component_set s x = \<Union>{t. connected t \<and> x \<in> t \<and> t \<subseteq> s}"
   by (auto simp: connected_component_def)
 
 lemma connected_connected_component [iff]: "connected (connected_component_set s x)"
   by (auto simp: connected_component_Union intro: connected_Union)
 
 lemma connected_iff_eq_connected_component_set:
   "connected s \<longleftrightarrow> (\<forall>x \<in> s. connected_component_set s x = s)"
 proof (cases "s = {}")
   case True
   then show ?thesis by simp
 next
   case False
   then obtain x where "x \<in> s" by auto
   show ?thesis
   proof
     assume "connected s"
     then show "\<forall>x \<in> s. connected_component_set s x = s"
       by (force simp: connected_component_def)
   next
     assume "\<forall>x \<in> s. connected_component_set s x = s"
     then show "connected s"
       by (metis \<open>x \<in> s\<close> connected_connected_component)
   qed
 qed
 
 lemma connected_component_subset: "connected_component_set s x \<subseteq> s"
   using connected_component_in by blast
 
 lemma connected_component_eq_self: "connected s \<Longrightarrow> x \<in> s \<Longrightarrow> connected_component_set s x = s"
   by (simp add: connected_iff_eq_connected_component_set)
 
 lemma connected_iff_connected_component:
   "connected s \<longleftrightarrow> (\<forall>x \<in> s. \<forall>y \<in> s. connected_component s x y)"
   using connected_component_in by (auto simp: connected_iff_eq_connected_component_set)
 
 lemma connected_component_maximal:
   "x \<in> t \<Longrightarrow> connected t \<Longrightarrow> t \<subseteq> s \<Longrightarrow> t \<subseteq> (connected_component_set s x)"
   using connected_component_eq_self connected_component_of_subset by blast
 
 lemma connected_component_mono:
   "s \<subseteq> t \<Longrightarrow> connected_component_set s x \<subseteq> connected_component_set t x"
   by (simp add: Collect_mono connected_component_of_subset)
 
 lemma connected_component_eq_empty [simp]: "connected_component_set s x = {} \<longleftrightarrow> x \<notin> s"
   using connected_component_refl by (fastforce simp: connected_component_in)
 
 lemma connected_component_set_empty [simp]: "connected_component_set {} x = {}"
   using connected_component_eq_empty by blast
 
 lemma connected_component_eq:
   "y \<in> connected_component_set s x \<Longrightarrow> (connected_component_set s y = connected_component_set s x)"
   by (metis (no_types, lifting)
       Collect_cong connected_component_sym connected_component_trans mem_Collect_eq)
 
 lemma closed_connected_component:
   assumes s: "closed s"
   shows "closed (connected_component_set s x)"
 proof (cases "x \<in> s")
   case False
   then show ?thesis
     by (metis connected_component_eq_empty closed_empty)
 next
   case True
   show ?thesis
     unfolding closure_eq [symmetric]
   proof
     show "closure (connected_component_set s x) \<subseteq> connected_component_set s x"
       apply (rule connected_component_maximal)
         apply (simp add: closure_def True)
        apply (simp add: connected_imp_connected_closure)
       apply (simp add: s closure_minimal connected_component_subset)
       done
   next
     show "connected_component_set s x \<subseteq> closure (connected_component_set s x)"
       by (simp add: closure_subset)
   qed
 qed
 
 lemma connected_component_disjoint:
   "connected_component_set s a \<inter> connected_component_set s b = {} \<longleftrightarrow>
     a \<notin> connected_component_set s b"
   apply (auto simp: connected_component_eq)
   using connected_component_eq connected_component_sym
   apply blast
   done
 
 lemma connected_component_nonoverlap:
   "connected_component_set s a \<inter> connected_component_set s b = {} \<longleftrightarrow>
     a \<notin> s \<or> b \<notin> s \<or> connected_component_set s a \<noteq> connected_component_set s b"
   apply (auto simp: connected_component_in)
   using connected_component_refl_eq
     apply blast
    apply (metis connected_component_eq mem_Collect_eq)
   apply (metis connected_component_eq mem_Collect_eq)
   done
 
 lemma connected_component_overlap:
   "connected_component_set s a \<inter> connected_component_set s b \<noteq> {} \<longleftrightarrow>
     a \<in> s \<and> b \<in> s \<and> connected_component_set s a = connected_component_set s b"
   by (auto simp: connected_component_nonoverlap)
 
 lemma connected_component_sym_eq: "connected_component s x y \<longleftrightarrow> connected_component s y x"
   using connected_component_sym by blast
 
 lemma connected_component_eq_eq:
   "connected_component_set s x = connected_component_set s y \<longleftrightarrow>
     x \<notin> s \<and> y \<notin> s \<or> x \<in> s \<and> y \<in> s \<and> connected_component s x y"
   apply (cases "y \<in> s", simp)
    apply (metis connected_component_eq connected_component_eq_empty connected_component_refl_eq mem_Collect_eq)
   apply (cases "x \<in> s", simp)
    apply (metis connected_component_eq_empty)
   using connected_component_eq_empty
   apply blast
   done
 
 lemma connected_iff_connected_component_eq:
   "connected s \<longleftrightarrow> (\<forall>x \<in> s. \<forall>y \<in> s. connected_component_set s x = connected_component_set s y)"
   by (simp add: connected_component_eq_eq connected_iff_connected_component)
 
 lemma connected_component_idemp:
   "connected_component_set (connected_component_set s x) x = connected_component_set s x"
   apply (rule subset_antisym)
    apply (simp add: connected_component_subset)
   apply (metis connected_component_eq_empty connected_component_maximal
       connected_component_refl_eq connected_connected_component mem_Collect_eq set_eq_subset)
   done
 
 lemma connected_component_unique:
   "\<lbrakk>x \<in> c; c \<subseteq> s; connected c;
     \<And>c'. x \<in> c' \<and> c' \<subseteq> s \<and> connected c'
               \<Longrightarrow> c' \<subseteq> c\<rbrakk>
         \<Longrightarrow> connected_component_set s x = c"
 apply (rule subset_antisym)
 apply (meson connected_component_maximal connected_component_subset connected_connected_component contra_subsetD)
 by (simp add: connected_component_maximal)
 
 lemma joinable_connected_component_eq:
   "\<lbrakk>connected t; t \<subseteq> s;
     connected_component_set s x \<inter> t \<noteq> {};
     connected_component_set s y \<inter> t \<noteq> {}\<rbrakk>
     \<Longrightarrow> connected_component_set s x = connected_component_set s y"
 apply (simp add: ex_in_conv [symmetric])
 apply (rule connected_component_eq)
 by (metis (no_types, hide_lams) connected_component_eq_eq connected_component_in connected_component_maximal subsetD mem_Collect_eq)
 
 
 lemma Union_connected_component: "\<Union>(connected_component_set s ` s) = s"
   apply (rule subset_antisym)
   apply (simp add: SUP_least connected_component_subset)
   using connected_component_refl_eq
   by force
 
 
 lemma complement_connected_component_unions:
     "s - connected_component_set s x =
      \<Union>(connected_component_set s ` s - {connected_component_set s x})"
   apply (subst Union_connected_component [symmetric], auto)
   apply (metis connected_component_eq_eq connected_component_in)
   by (metis connected_component_eq mem_Collect_eq)
 
 lemma connected_component_intermediate_subset:
         "\<lbrakk>connected_component_set u a \<subseteq> t; t \<subseteq> u\<rbrakk>
         \<Longrightarrow> connected_component_set t a = connected_component_set u a"
   apply (case_tac "a \<in> u")
   apply (simp add: connected_component_maximal connected_component_mono subset_antisym)
   using connected_component_eq_empty by blast
 
 
 subsection \<open>The set of connected components of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> components:: "'a::topological_space set \<Rightarrow> 'a set set"
   where "components s \<equiv> connected_component_set s ` s"
 
 lemma components_iff: "s \<in> components u \<longleftrightarrow> (\<exists>x. x \<in> u \<and> s = connected_component_set u x)"
   by (auto simp: components_def)
 
 lemma componentsI: "x \<in> u \<Longrightarrow> connected_component_set u x \<in> components u"
   by (auto simp: components_def)
 
 lemma componentsE:
   assumes "s \<in> components u"
   obtains x where "x \<in> u" "s = connected_component_set u x"
   using assms by (auto simp: components_def)
 
 lemma Union_components [simp]: "\<Union>(components u) = u"
   apply (rule subset_antisym)
   using Union_connected_component components_def apply fastforce
   apply (metis Union_connected_component components_def set_eq_subset)
   done
 
 lemma pairwise_disjoint_components: "pairwise (\<lambda>X Y. X \<inter> Y = {}) (components u)"
   apply (simp add: pairwise_def)
   apply (auto simp: components_iff)
   apply (metis connected_component_eq_eq connected_component_in)+
   done
 
 lemma in_components_nonempty: "c \<in> components s \<Longrightarrow> c \<noteq> {}"
     by (metis components_iff connected_component_eq_empty)
 
 lemma in_components_subset: "c \<in> components s \<Longrightarrow> c \<subseteq> s"
   using Union_components by blast
 
 lemma in_components_connected: "c \<in> components s \<Longrightarrow> connected c"
   by (metis components_iff connected_connected_component)
 
 lemma in_components_maximal:
   "c \<in> components s \<longleftrightarrow>
     c \<noteq> {} \<and> c \<subseteq> s \<and> connected c \<and> (\<forall>d. d \<noteq> {} \<and> c \<subseteq> d \<and> d \<subseteq> s \<and> connected d \<longrightarrow> d = c)"
   apply (rule iffI)
    apply (simp add: in_components_nonempty in_components_connected)
    apply (metis (full_types) components_iff connected_component_eq_self connected_component_intermediate_subset connected_component_refl in_components_subset mem_Collect_eq rev_subsetD)
   apply (metis bot.extremum_uniqueI components_iff connected_component_eq_empty connected_component_maximal connected_component_subset connected_connected_component subset_emptyI)
   done
 
 lemma joinable_components_eq:
   "connected t \<and> t \<subseteq> s \<and> c1 \<in> components s \<and> c2 \<in> components s \<and> c1 \<inter> t \<noteq> {} \<and> c2 \<inter> t \<noteq> {} \<Longrightarrow> c1 = c2"
   by (metis (full_types) components_iff joinable_connected_component_eq)
 
 lemma closed_components: "\<lbrakk>closed s; c \<in> components s\<rbrakk> \<Longrightarrow> closed c"
   by (metis closed_connected_component components_iff)
 
 lemma components_nonoverlap:
     "\<lbrakk>c \<in> components s; c' \<in> components s\<rbrakk> \<Longrightarrow> (c \<inter> c' = {}) \<longleftrightarrow> (c \<noteq> c')"
   apply (auto simp: in_components_nonempty components_iff)
     using connected_component_refl apply blast
    apply (metis connected_component_eq_eq connected_component_in)
   by (metis connected_component_eq mem_Collect_eq)
 
 lemma components_eq: "\<lbrakk>c \<in> components s; c' \<in> components s\<rbrakk> \<Longrightarrow> (c = c' \<longleftrightarrow> c \<inter> c' \<noteq> {})"
   by (metis components_nonoverlap)
 
 lemma components_eq_empty [simp]: "components s = {} \<longleftrightarrow> s = {}"
   by (simp add: components_def)
 
 lemma components_empty [simp]: "components {} = {}"
   by simp
 
 lemma connected_eq_connected_components_eq: "connected s \<longleftrightarrow> (\<forall>c \<in> components s. \<forall>c' \<in> components s. c = c')"
   by (metis (no_types, hide_lams) components_iff connected_component_eq_eq connected_iff_connected_component)
 
 lemma components_eq_sing_iff: "components s = {s} \<longleftrightarrow> connected s \<and> s \<noteq> {}"
   apply (rule iffI)
   using in_components_connected apply fastforce
   apply safe
   using Union_components apply fastforce
    apply (metis components_iff connected_component_eq_self)
   using in_components_maximal
   apply auto
   done
 
 lemma components_eq_sing_exists: "(\<exists>a. components s = {a}) \<longleftrightarrow> connected s \<and> s \<noteq> {}"
   apply (rule iffI)
   using connected_eq_connected_components_eq apply fastforce
   apply (metis components_eq_sing_iff)
   done
 
 lemma connected_eq_components_subset_sing: "connected s \<longleftrightarrow> components s \<subseteq> {s}"
   by (metis Union_components components_empty components_eq_sing_iff connected_empty insert_subset order_refl subset_singletonD)
 
 lemma connected_eq_components_subset_sing_exists: "connected s \<longleftrightarrow> (\<exists>a. components s \<subseteq> {a})"
   by (metis components_eq_sing_exists connected_eq_components_subset_sing empty_iff subset_iff subset_singletonD)
 
 lemma in_components_self: "s \<in> components s \<longleftrightarrow> connected s \<and> s \<noteq> {}"
   by (metis components_empty components_eq_sing_iff empty_iff in_components_connected insertI1)
 
 lemma components_maximal: "\<lbrakk>c \<in> components s; connected t; t \<subseteq> s; c \<inter> t \<noteq> {}\<rbrakk> \<Longrightarrow> t \<subseteq> c"
   apply (simp add: components_def ex_in_conv [symmetric], clarify)
   by (meson connected_component_def connected_component_trans)
 
 lemma exists_component_superset: "\<lbrakk>t \<subseteq> s; s \<noteq> {}; connected t\<rbrakk> \<Longrightarrow> \<exists>c. c \<in> components s \<and> t \<subseteq> c"
   apply (cases "t = {}", force)
   apply (metis components_def ex_in_conv connected_component_maximal contra_subsetD image_eqI)
   done
 
 lemma components_intermediate_subset: "\<lbrakk>s \<in> components u; s \<subseteq> t; t \<subseteq> u\<rbrakk> \<Longrightarrow> s \<in> components t"
   apply (auto simp: components_iff)
   apply (metis connected_component_eq_empty connected_component_intermediate_subset)
   done
 
 lemma in_components_unions_complement: "c \<in> components s \<Longrightarrow> s - c = \<Union>(components s - {c})"
   by (metis complement_connected_component_unions components_def components_iff)
 
 lemma connected_intermediate_closure:
   assumes cs: "connected s" and st: "s \<subseteq> t" and ts: "t \<subseteq> closure s"
   shows "connected t"
 proof (rule connectedI)
   fix A B
   assume A: "open A" and B: "open B" and Alap: "A \<inter> t \<noteq> {}" and Blap: "B \<inter> t \<noteq> {}"
     and disj: "A \<inter> B \<inter> t = {}" and cover: "t \<subseteq> A \<union> B"
   have disjs: "A \<inter> B \<inter> s = {}"
     using disj st by auto
   have "A \<inter> closure s \<noteq> {}"
     using Alap Int_absorb1 ts by blast
   then have Alaps: "A \<inter> s \<noteq> {}"
     by (simp add: A open_Int_closure_eq_empty)
   have "B \<inter> closure s \<noteq> {}"
     using Blap Int_absorb1 ts by blast
   then have Blaps: "B \<inter> s \<noteq> {}"
     by (simp add: B open_Int_closure_eq_empty)
   then show False
     using cs [unfolded connected_def] A B disjs Alaps Blaps cover st
     by blast
 qed
 
 lemma closedin_connected_component: "closedin (top_of_set s) (connected_component_set s x)"
 proof (cases "connected_component_set s x = {}")
   case True
   then show ?thesis
     by (metis closedin_empty)
 next
   case False
   then obtain y where y: "connected_component s x y"
     by blast
   have *: "connected_component_set s x \<subseteq> s \<inter> closure (connected_component_set s x)"
     by (auto simp: closure_def connected_component_in)
   have "connected_component s x y \<Longrightarrow> s \<inter> closure (connected_component_set s x) \<subseteq> connected_component_set s x"
     apply (rule connected_component_maximal, simp)
     using closure_subset connected_component_in apply fastforce
     using * connected_intermediate_closure apply blast+
     done
   with y * show ?thesis
     by (auto simp: closedin_closed)
 qed
 
 lemma closedin_component:
    "C \<in> components s \<Longrightarrow> closedin (top_of_set s) C"
   using closedin_connected_component componentsE by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Proving a function is constant on a connected set
   by proving that a level set is open\<close>
 
 lemma continuous_levelset_openin_cases:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
         openin (top_of_set s) {x \<in> s. f x = a}
         \<Longrightarrow> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
   unfolding connected_clopen
   using continuous_closedin_preimage_constant by auto
 
 lemma continuous_levelset_openin:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
         openin (top_of_set s) {x \<in> s. f x = a} \<Longrightarrow>
         (\<exists>x \<in> s. f x = a)  \<Longrightarrow> (\<forall>x \<in> s. f x = a)"
   using continuous_levelset_openin_cases[of s f ]
   by meson
 
 lemma continuous_levelset_open:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes "connected s"
     and "continuous_on s f"
     and "open {x \<in> s. f x = a}"
     and "\<exists>x \<in> s.  f x = a"
   shows "\<forall>x \<in> s. f x = a"
   using continuous_levelset_openin[OF assms(1,2), of a, unfolded openin_open]
   using assms (3,4)
   by fast
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Preservation of Connectedness\<close>
 
 lemma homeomorphic_connectedness:
   assumes "s homeomorphic t"
   shows "connected s \<longleftrightarrow> connected t"
 using assms unfolding homeomorphic_def homeomorphism_def by (metis connected_continuous_image)
 
 lemma connected_monotone_quotient_preimage:
   assumes "connected T"
       and contf: "continuous_on S f" and fim: "f ` S = T"
       and opT: "\<And>U. U \<subseteq> T
                  \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                      openin (top_of_set T) U"
       and connT: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
     shows "connected S"
 proof (rule connectedI)
   fix U V
   assume "open U" and "open V" and "U \<inter> S \<noteq> {}" and "V \<inter> S \<noteq> {}"
     and "U \<inter> V \<inter> S = {}" and "S \<subseteq> U \<union> V"
   moreover
   have disjoint: "f ` (S \<inter> U) \<inter> f ` (S \<inter> V) = {}"
   proof -
     have False if "y \<in> f ` (S \<inter> U) \<inter> f ` (S \<inter> V)" for y
     proof -
       have "y \<in> T"
         using fim that by blast
       show ?thesis
         using connectedD [OF connT [OF \<open>y \<in> T\<close>] \<open>open U\<close> \<open>open V\<close>]
               \<open>S \<subseteq> U \<union> V\<close> \<open>U \<inter> V \<inter> S = {}\<close> that by fastforce
     qed
     then show ?thesis by blast
   qed
   ultimately have UU: "(S \<inter> f -` f ` (S \<inter> U)) = S \<inter> U" and VV: "(S \<inter> f -` f ` (S \<inter> V)) = S \<inter> V"
     by auto
   have opeU: "openin (top_of_set T) (f ` (S \<inter> U))"
     by (metis UU \<open>open U\<close> fim image_Int_subset le_inf_iff opT openin_open_Int)
   have opeV: "openin (top_of_set T) (f ` (S \<inter> V))"
     by (metis opT fim VV \<open>open V\<close> openin_open_Int image_Int_subset inf.bounded_iff)
   have "T \<subseteq> f ` (S \<inter> U) \<union> f ` (S \<inter> V)"
     using \<open>S \<subseteq> U \<union> V\<close> fim by auto
   then show False
     using \<open>connected T\<close> disjoint opeU opeV \<open>U \<inter> S \<noteq> {}\<close> \<open>V \<inter> S \<noteq> {}\<close>
     by (auto simp: connected_openin)
 qed
 
 lemma connected_open_monotone_preimage:
   assumes contf: "continuous_on S f" and fim: "f ` S = T"
     and ST: "\<And>C. openin (top_of_set S) C \<Longrightarrow> openin (top_of_set T) (f ` C)"
     and connT: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
     and "connected C" "C \<subseteq> T"
   shows "connected (S \<inter> f -` C)"
 proof -
   have contf': "continuous_on (S \<inter> f -` C) f"
     by (meson contf continuous_on_subset inf_le1)
   have eqC: "f ` (S \<inter> f -` C) = C"
     using \<open>C \<subseteq> T\<close> fim by blast
   show ?thesis
   proof (rule connected_monotone_quotient_preimage [OF \<open>connected C\<close> contf' eqC])
     show "connected (S \<inter> f -` C \<inter> f -` {y})" if "y \<in> C" for y
     proof -
       have "S \<inter> f -` C \<inter> f -` {y} = S \<inter> f -` {y}"
         using that by blast
       moreover have "connected (S \<inter> f -` {y})"
         using \<open>C \<subseteq> T\<close> connT that by blast
       ultimately show ?thesis
         by metis
     qed
     have "\<And>U. openin (top_of_set (S \<inter> f -` C)) U
                \<Longrightarrow> openin (top_of_set C) (f ` U)"
       using open_map_restrict [OF _ ST \<open>C \<subseteq> T\<close>] by metis
     then show "\<And>D. D \<subseteq> C
           \<Longrightarrow> openin (top_of_set (S \<inter> f -` C)) (S \<inter> f -` C \<inter> f -` D) =
               openin (top_of_set C) D"
       using open_map_imp_quotient_map [of "(S \<inter> f -` C)" f] contf' by (simp add: eqC)
   qed
 qed
 
 
 lemma connected_closed_monotone_preimage:
   assumes contf: "continuous_on S f" and fim: "f ` S = T"
     and ST: "\<And>C. closedin (top_of_set S) C \<Longrightarrow> closedin (top_of_set T) (f ` C)"
     and connT: "\<And>y. y \<in> T \<Longrightarrow> connected (S \<inter> f -` {y})"
     and "connected C" "C \<subseteq> T"
   shows "connected (S \<inter> f -` C)"
 proof -
   have contf': "continuous_on (S \<inter> f -` C) f"
     by (meson contf continuous_on_subset inf_le1)
   have eqC: "f ` (S \<inter> f -` C) = C"
     using \<open>C \<subseteq> T\<close> fim by blast
   show ?thesis
   proof (rule connected_monotone_quotient_preimage [OF \<open>connected C\<close> contf' eqC])
     show "connected (S \<inter> f -` C \<inter> f -` {y})" if "y \<in> C" for y
     proof -
       have "S \<inter> f -` C \<inter> f -` {y} = S \<inter> f -` {y}"
         using that by blast
       moreover have "connected (S \<inter> f -` {y})"
         using \<open>C \<subseteq> T\<close> connT that by blast
       ultimately show ?thesis
         by metis
     qed
     have "\<And>U. closedin (top_of_set (S \<inter> f -` C)) U
                \<Longrightarrow> closedin (top_of_set C) (f ` U)"
       using closed_map_restrict [OF _ ST \<open>C \<subseteq> T\<close>] by metis
     then show "\<And>D. D \<subseteq> C
           \<Longrightarrow> openin (top_of_set (S \<inter> f -` C)) (S \<inter> f -` C \<inter> f -` D) =
               openin (top_of_set C) D"
       using closed_map_imp_quotient_map [of "(S \<inter> f -` C)" f] contf' by (simp add: eqC)
   qed
 qed
 
 
 subsection\<open>Lemmas about components\<close>
 
 text  \<open>See Newman IV, 3.3 and 3.4.\<close>
 
 lemma connected_Un_clopen_in_complement:
   fixes S U :: "'a::metric_space set"
   assumes "connected S" "connected U" "S \<subseteq> U" 
       and opeT: "openin (top_of_set (U - S)) T" 
       and cloT: "closedin (top_of_set (U - S)) T"
     shows "connected (S \<union> T)"
 proof -
   have *: "\<lbrakk>\<And>x y. P x y \<longleftrightarrow> P y x; \<And>x y. P x y \<Longrightarrow> S \<subseteq> x \<or> S \<subseteq> y;
             \<And>x y. \<lbrakk>P x y; S \<subseteq> x\<rbrakk> \<Longrightarrow> False\<rbrakk> \<Longrightarrow> \<not>(\<exists>x y. (P x y))" for P
     by metis
   show ?thesis
     unfolding connected_closedin_eq
   proof (rule *)
     fix H1 H2
     assume H: "closedin (top_of_set (S \<union> T)) H1 \<and> 
                closedin (top_of_set (S \<union> T)) H2 \<and>
                H1 \<union> H2 = S \<union> T \<and> H1 \<inter> H2 = {} \<and> H1 \<noteq> {} \<and> H2 \<noteq> {}"
     then have clo: "closedin (top_of_set S) (S \<inter> H1)"
                    "closedin (top_of_set S) (S \<inter> H2)"
       by (metis Un_upper1 closedin_closed_subset inf_commute)+
     have Seq: "S \<inter> (H1 \<union> H2) = S"
       by (simp add: H)
     have "S \<inter> ((S \<union> T) \<inter> H1) \<union> S \<inter> ((S \<union> T) \<inter> H2) = S"
       using Seq by auto
     moreover have "H1 \<inter> (S \<inter> ((S \<union> T) \<inter> H2)) = {}"
       using H by blast
     ultimately have "S \<inter> H1 = {} \<or> S \<inter> H2 = {}"
       by (metis (no_types) H Int_assoc \<open>S \<inter> (H1 \<union> H2) = S\<close> \<open>connected S\<close>
           clo Seq connected_closedin inf_bot_right inf_le1)
     then show "S \<subseteq> H1 \<or> S \<subseteq> H2"
       using H \<open>connected S\<close> unfolding connected_closedin by blast
   next
     fix H1 H2
     assume H: "closedin (top_of_set (S \<union> T)) H1 \<and>
                closedin (top_of_set (S \<union> T)) H2 \<and>
                H1 \<union> H2 = S \<union> T \<and> H1 \<inter> H2 = {} \<and> H1 \<noteq> {} \<and> H2 \<noteq> {}" 
        and "S \<subseteq> H1"
     then have H2T: "H2 \<subseteq> T"
       by auto
     have "T \<subseteq> U"
       using Diff_iff opeT openin_imp_subset by auto
     with \<open>S \<subseteq> U\<close> have Ueq: "U = (U - S) \<union> (S \<union> T)" 
       by auto
     have "openin (top_of_set ((U - S) \<union> (S \<union> T))) H2"
     proof (rule openin_subtopology_Un)
       show "openin (top_of_set (S \<union> T)) H2"
         using \<open>H2 \<subseteq> T\<close> apply (auto simp: openin_closedin_eq)
         by (metis Diff_Diff_Int Diff_disjoint Diff_partition Diff_subset H Int_absorb1 Un_Diff)
       then show "openin (top_of_set (U - S)) H2"
         by (meson H2T Un_upper2 opeT openin_subset_trans openin_trans)
     qed
     moreover have "closedin (top_of_set ((U - S) \<union> (S \<union> T))) H2"
     proof (rule closedin_subtopology_Un)
       show "closedin (top_of_set (U - S)) H2"
         using H H2T cloT closedin_subset_trans 
         by (blast intro: closedin_subtopology_Un closedin_trans)
     qed (simp add: H)
     ultimately
     have H2: "H2 = {} \<or> H2 = U"
       using Ueq \<open>connected U\<close> unfolding connected_clopen by metis   
     then have "H2 \<subseteq> S"
       by (metis Diff_partition H Un_Diff_cancel Un_subset_iff \<open>H2 \<subseteq> T\<close> assms(3) inf.orderE opeT openin_imp_subset)
     moreover have "T \<subseteq> H2 - S"
       by (metis (no_types) H2 H opeT openin_closedin_eq topspace_euclidean_subtopology)
     ultimately show False
       using H \<open>S \<subseteq> H1\<close> by blast
   qed blast
 qed
 
 
 proposition component_diff_connected:
   fixes S :: "'a::metric_space set"
   assumes "connected S" "connected U" "S \<subseteq> U" and C: "C \<in> components (U - S)"
   shows "connected(U - C)"
   using \<open>connected S\<close> unfolding connected_closedin_eq not_ex de_Morgan_conj
 proof clarify
   fix H3 H4 
   assume clo3: "closedin (top_of_set (U - C)) H3" 
     and clo4: "closedin (top_of_set (U - C)) H4" 
     and "H3 \<union> H4 = U - C" and "H3 \<inter> H4 = {}" and "H3 \<noteq> {}" and "H4 \<noteq> {}"
     and * [rule_format]:
     "\<forall>H1 H2. \<not> closedin (top_of_set S) H1 \<or>
                       \<not> closedin (top_of_set S) H2 \<or>
                       H1 \<union> H2 \<noteq> S \<or> H1 \<inter> H2 \<noteq> {} \<or> \<not> H1 \<noteq> {} \<or> \<not> H2 \<noteq> {}"
   then have "H3 \<subseteq> U-C" and ope3: "openin (top_of_set (U - C)) (U - C - H3)"
     and "H4 \<subseteq> U-C" and ope4: "openin (top_of_set (U - C)) (U - C - H4)"
     by (auto simp: closedin_def)
   have "C \<noteq> {}" "C \<subseteq> U-S" "connected C"
     using C in_components_nonempty in_components_subset in_components_maximal by blast+
   have cCH3: "connected (C \<union> H3)"
   proof (rule connected_Un_clopen_in_complement [OF \<open>connected C\<close> \<open>connected U\<close> _ _ clo3])
     show "openin (top_of_set (U - C)) H3"
       apply (simp add: openin_closedin_eq \<open>H3 \<subseteq> U - C\<close>)
       apply (simp add: closedin_subtopology)
       by (metis Diff_cancel Diff_triv Un_Diff clo4 \<open>H3 \<inter> H4 = {}\<close> \<open>H3 \<union> H4 = U - C\<close> closedin_closed inf_commute sup_bot.left_neutral)
   qed (use clo3 \<open>C \<subseteq> U - S\<close> in auto)
   have cCH4: "connected (C \<union> H4)"
   proof (rule connected_Un_clopen_in_complement [OF \<open>connected C\<close> \<open>connected U\<close> _ _ clo4])
     show "openin (top_of_set (U - C)) H4"
       apply (simp add: openin_closedin_eq \<open>H4 \<subseteq> U - C\<close>)
       apply (simp add: closedin_subtopology)
       by (metis Diff_cancel Int_commute Un_Diff Un_Diff_Int \<open>H3 \<inter> H4 = {}\<close> \<open>H3 \<union> H4 = U - C\<close> clo3 closedin_closed)
   qed (use clo4 \<open>C \<subseteq> U - S\<close> in auto)
   have "closedin (top_of_set S) (S \<inter> H3)" "closedin (top_of_set S) (S \<inter> H4)"
     using clo3 clo4 \<open>S \<subseteq> U\<close> \<open>C \<subseteq> U - S\<close> by (auto simp: closedin_closed)
   moreover have "S \<inter> H3 \<noteq> {}"      
     using components_maximal [OF C cCH3] \<open>C \<noteq> {}\<close> \<open>C \<subseteq> U - S\<close> \<open>H3 \<noteq> {}\<close> \<open>H3 \<subseteq> U - C\<close> by auto
   moreover have "S \<inter> H4 \<noteq> {}"
     using components_maximal [OF C cCH4] \<open>C \<noteq> {}\<close> \<open>C \<subseteq> U - S\<close> \<open>H4 \<noteq> {}\<close> \<open>H4 \<subseteq> U - C\<close> by auto
   ultimately show False
     using * [of "S \<inter> H3" "S \<inter> H4"] \<open>H3 \<inter> H4 = {}\<close> \<open>C \<subseteq> U - S\<close> \<open>H3 \<union> H4 = U - C\<close> \<open>S \<subseteq> U\<close> 
     by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Constancy of a function from a connected set into a finite, disconnected or discrete set\<close>
 
 text\<open>Still missing: versions for a set that is smaller than R, or countable.\<close>
 
 lemma continuous_disconnected_range_constant:
   assumes S: "connected S"
       and conf: "continuous_on S f"
       and fim: "f ` S \<subseteq> t"
       and cct: "\<And>y. y \<in> t \<Longrightarrow> connected_component_set t y = {y}"
     shows "f constant_on S"
 proof (cases "S = {}")
   case True then show ?thesis
     by (simp add: constant_on_def)
 next
   case False
   { fix x assume "x \<in> S"
     then have "f ` S \<subseteq> {f x}"
     by (metis connected_continuous_image conf connected_component_maximal fim image_subset_iff rev_image_eqI S cct)
   }
   with False show ?thesis
     unfolding constant_on_def by blast
 qed
 
 
 text\<open>This proof requires the existence of two separate values of the range type.\<close>
 lemma finite_range_constant_imp_connected:
   assumes "\<And>f::'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1.
               \<lbrakk>continuous_on S f; finite(f ` S)\<rbrakk> \<Longrightarrow> f constant_on S"
     shows "connected S"
 proof -
   { fix t u
     assume clt: "closedin (top_of_set S) t"
        and clu: "closedin (top_of_set S) u"
        and tue: "t \<inter> u = {}" and tus: "t \<union> u = S"
     have conif: "continuous_on S (\<lambda>x. if x \<in> t then 0 else 1)"
       apply (subst tus [symmetric])
       apply (rule continuous_on_cases_local)
       using clt clu tue
-      apply (auto simp: tus continuous_on_const)
+      apply (auto simp: tus)
       done
     have fi: "finite ((\<lambda>x. if x \<in> t then 0 else 1) ` S)"
       by (rule finite_subset [of _ "{0,1}"]) auto
     have "t = {} \<or> u = {}"
       using assms [OF conif fi] tus [symmetric]
       by (auto simp: Ball_def constant_on_def) (metis IntI empty_iff one_neq_zero tue)
   }
   then show ?thesis
     by (simp add: connected_closedin_eq)
 qed
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Continuous_Extension.thy b/src/HOL/Analysis/Continuous_Extension.thy
--- a/src/HOL/Analysis/Continuous_Extension.thy
+++ b/src/HOL/Analysis/Continuous_Extension.thy
@@ -1,537 +1,537 @@
 (*  Title:      HOL/Analysis/Continuous_Extension.thy
     Authors:    LC Paulson, based on material from HOL Light
 *)
 
 section \<open>Continuous Extensions of Functions\<close>
 
 theory Continuous_Extension
 imports Starlike
 begin
 
 subsection\<open>Partitions of unity subordinate to locally finite open coverings\<close>
 
 text\<open>A difference from HOL Light: all summations over infinite sets equal zero,
    so the "support" must be made explicit in the summation below!\<close>
 
 proposition subordinate_partition_of_unity:
   fixes S :: "'a::metric_space set"
   assumes "S \<subseteq> \<Union>\<C>" and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
       and fin: "\<And>x. x \<in> S \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<C>. U \<inter> V \<noteq> {}}"
   obtains F :: "['a set, 'a] \<Rightarrow> real"
     where "\<And>U. U \<in> \<C> \<Longrightarrow> continuous_on S (F U) \<and> (\<forall>x \<in> S. 0 \<le> F U x)"
       and "\<And>x U. \<lbrakk>U \<in> \<C>; x \<in> S; x \<notin> U\<rbrakk> \<Longrightarrow> F U x = 0"
       and "\<And>x. x \<in> S \<Longrightarrow> supp_sum (\<lambda>W. F W x) \<C> = 1"
       and "\<And>x. x \<in> S \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<C>. \<exists>x\<in>V. F U x \<noteq> 0}"
 proof (cases "\<exists>W. W \<in> \<C> \<and> S \<subseteq> W")
   case True
     then obtain W where "W \<in> \<C>" "S \<subseteq> W" by metis
     then show ?thesis
       by (rule_tac F = "\<lambda>V x. if V = W then 1 else 0" in that) (auto simp: supp_sum_def support_on_def)
 next
   case False
     have nonneg: "0 \<le> supp_sum (\<lambda>V. setdist {x} (S - V)) \<C>" for x
       by (simp add: supp_sum_def sum_nonneg)
     have sd_pos: "0 < setdist {x} (S - V)" if "V \<in> \<C>" "x \<in> S" "x \<in> V" for V x
     proof -
       have "closedin (top_of_set S) (S - V)"
         by (simp add: Diff_Diff_Int closedin_def opC openin_open_Int \<open>V \<in> \<C>\<close>)
       with that False  setdist_pos_le [of "{x}" "S - V"]
       show ?thesis
         using setdist_gt_0_closedin by fastforce
     qed
     have ss_pos: "0 < supp_sum (\<lambda>V. setdist {x} (S - V)) \<C>" if "x \<in> S" for x
     proof -
       obtain U where "U \<in> \<C>" "x \<in> U" using \<open>x \<in> S\<close> \<open>S \<subseteq> \<Union>\<C>\<close>
         by blast
       obtain V where "open V" "x \<in> V" "finite {U \<in> \<C>. U \<inter> V \<noteq> {}}"
         using \<open>x \<in> S\<close> fin by blast
       then have *: "finite {A \<in> \<C>. \<not> S \<subseteq> A \<and> x \<notin> closure (S - A)}"
         using closure_def that by (blast intro: rev_finite_subset)
       have "x \<notin> closure (S - U)"
         using \<open>U \<in> \<C>\<close> \<open>x \<in> U\<close> opC open_Int_closure_eq_empty by fastforce
       then show ?thesis
         apply (simp add: setdist_eq_0_sing_1 supp_sum_def support_on_def)
         apply (rule ordered_comm_monoid_add_class.sum_pos2 [OF *, of U])
         using \<open>U \<in> \<C>\<close> \<open>x \<in> U\<close> False
         apply (auto simp: sd_pos that)
         done
     qed
     define F where
       "F \<equiv> \<lambda>W x. if x \<in> S then setdist {x} (S - W) / supp_sum (\<lambda>V. setdist {x} (S - V)) \<C> else 0"
     show ?thesis
     proof (rule_tac F = F in that)
       have "continuous_on S (F U)" if "U \<in> \<C>" for U
       proof -
         have *: "continuous_on S (\<lambda>x. supp_sum (\<lambda>V. setdist {x} (S - V)) \<C>)"
         proof (clarsimp simp add: continuous_on_eq_continuous_within)
           fix x assume "x \<in> S"
           then obtain X where "open X" and x: "x \<in> S \<inter> X" and finX: "finite {U \<in> \<C>. U \<inter> X \<noteq> {}}"
             using assms by blast
           then have OSX: "openin (top_of_set S) (S \<inter> X)" by blast
           have sumeq: "\<And>x. x \<in> S \<inter> X \<Longrightarrow>
                      (\<Sum>V | V \<in> \<C> \<and> V \<inter> X \<noteq> {}. setdist {x} (S - V))
                      = supp_sum (\<lambda>V. setdist {x} (S - V)) \<C>"
             apply (simp add: supp_sum_def)
             apply (rule sum.mono_neutral_right [OF finX])
             apply (auto simp: setdist_eq_0_sing_1 support_on_def subset_iff)
             apply (meson DiffI closure_subset disjoint_iff_not_equal subsetCE)
             done
           show "continuous (at x within S) (\<lambda>x. supp_sum (\<lambda>V. setdist {x} (S - V)) \<C>)"
             apply (rule continuous_transform_within_openin
                      [where f = "\<lambda>x. (sum (\<lambda>V. setdist {x} (S - V)) {V \<in> \<C>. V \<inter> X \<noteq> {}})"
                         and S ="S \<inter> X"])
             apply (rule continuous_intros continuous_at_setdist continuous_at_imp_continuous_at_within OSX x)+
             apply (simp add: sumeq)
             done
         qed
         show ?thesis
           apply (simp add: F_def)
           apply (rule continuous_intros *)+
           using ss_pos apply force
           done
       qed
       moreover have "\<lbrakk>U \<in> \<C>; x \<in> S\<rbrakk> \<Longrightarrow> 0 \<le> F U x" for U x
-        using nonneg [of x] by (simp add: F_def field_split_simps setdist_pos_le)
+        using nonneg [of x] by (simp add: F_def field_split_simps)
       ultimately show "\<And>U. U \<in> \<C> \<Longrightarrow> continuous_on S (F U) \<and> (\<forall>x\<in>S. 0 \<le> F U x)"
         by metis
     next
       show "\<And>x U. \<lbrakk>U \<in> \<C>; x \<in> S; x \<notin> U\<rbrakk> \<Longrightarrow> F U x = 0"
         by (simp add: setdist_eq_0_sing_1 closure_def F_def)
     next
       show "supp_sum (\<lambda>W. F W x) \<C> = 1" if "x \<in> S" for x
         using that ss_pos [OF that]
         by (simp add: F_def field_split_simps supp_sum_divide_distrib [symmetric])
     next
       show "\<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<C>. \<exists>x\<in>V. F U x \<noteq> 0}" if "x \<in> S" for x
         using fin [OF that] that
         by (fastforce simp: setdist_eq_0_sing_1 closure_def F_def elim!: rev_finite_subset)
     qed
 qed
 
 
 subsection\<open>Urysohn's Lemma for Euclidean Spaces\<close>
 
 text \<open>For Euclidean spaces the proof is easy using distances.\<close>
 
 lemma Urysohn_both_ne:
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "S \<inter> T = {}" "S \<noteq> {}" "T \<noteq> {}" "a \<noteq> b"
   obtains f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
     where "continuous_on U f"
           "\<And>x. x \<in> U \<Longrightarrow> f x \<in> closed_segment a b"
           "\<And>x. x \<in> U \<Longrightarrow> (f x = a \<longleftrightarrow> x \<in> S)"
           "\<And>x. x \<in> U \<Longrightarrow> (f x = b \<longleftrightarrow> x \<in> T)"
 proof -
   have S0: "\<And>x. x \<in> U \<Longrightarrow> setdist {x} S = 0 \<longleftrightarrow> x \<in> S"
     using \<open>S \<noteq> {}\<close>  US setdist_eq_0_closedin  by auto
   have T0: "\<And>x. x \<in> U \<Longrightarrow> setdist {x} T = 0 \<longleftrightarrow> x \<in> T"
     using \<open>T \<noteq> {}\<close>  UT setdist_eq_0_closedin  by auto
   have sdpos: "0 < setdist {x} S + setdist {x} T" if "x \<in> U" for x
   proof -
     have "\<not> (setdist {x} S = 0 \<and> setdist {x} T = 0)"
       using assms by (metis IntI empty_iff setdist_eq_0_closedin that)
     then show ?thesis
       by (metis add.left_neutral add.right_neutral add_pos_pos linorder_neqE_linordered_idom not_le setdist_pos_le)
   qed
   define f where "f \<equiv> \<lambda>x. a + (setdist {x} S / (setdist {x} S + setdist {x} T)) *\<^sub>R (b - a)"
   show ?thesis
   proof (rule_tac f = f in that)
     show "continuous_on U f"
       using sdpos unfolding f_def
       by (intro continuous_intros | force)+
     show "f x \<in> closed_segment a b" if "x \<in> U" for x
         unfolding f_def
       apply (simp add: closed_segment_def)
       apply (rule_tac x="(setdist {x} S / (setdist {x} S + setdist {x} T))" in exI)
       using sdpos that apply (simp add: algebra_simps)
       done
     show "\<And>x. x \<in> U \<Longrightarrow> (f x = a \<longleftrightarrow> x \<in> S)"
       using S0 \<open>a \<noteq> b\<close> f_def sdpos by force
     show "(f x = b \<longleftrightarrow> x \<in> T)" if "x \<in> U" for x
     proof -
       have "f x = b \<longleftrightarrow> (setdist {x} S / (setdist {x} S + setdist {x} T)) = 1"
         unfolding f_def
         apply (rule iffI)
          apply (metis  \<open>a \<noteq> b\<close> add_diff_cancel_left' eq_iff_diff_eq_0 pth_1 real_vector.scale_right_imp_eq, force)
         done
       also have "...  \<longleftrightarrow> setdist {x} T = 0 \<and> setdist {x} S \<noteq> 0"
         using sdpos that
         by (simp add: field_split_simps) linarith
       also have "...  \<longleftrightarrow> x \<in> T"
         using \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> \<open>S \<inter> T = {}\<close> that
         by (force simp: S0 T0)
       finally show ?thesis .
     qed
   qed
 qed
 
 proposition Urysohn_local_strong:
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "S \<inter> T = {}" "a \<noteq> b"
   obtains f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     where "continuous_on U f"
           "\<And>x. x \<in> U \<Longrightarrow> f x \<in> closed_segment a b"
           "\<And>x. x \<in> U \<Longrightarrow> (f x = a \<longleftrightarrow> x \<in> S)"
           "\<And>x. x \<in> U \<Longrightarrow> (f x = b \<longleftrightarrow> x \<in> T)"
 proof (cases "S = {}")
   case True show ?thesis
   proof (cases "T = {}")
     case True show ?thesis
     proof (rule_tac f = "\<lambda>x. midpoint a b" in that)
       show "continuous_on U (\<lambda>x. midpoint a b)"
         by (intro continuous_intros)
       show "midpoint a b \<in> closed_segment a b"
         using csegment_midpoint_subset by blast
       show "(midpoint a b = a) = (x \<in> S)" for x
         using \<open>S = {}\<close> \<open>a \<noteq> b\<close> by simp
       show "(midpoint a b = b) = (x \<in> T)" for x
         using \<open>T = {}\<close> \<open>a \<noteq> b\<close> by simp
     qed
   next
     case False
     show ?thesis
     proof (cases "T = U")
       case True with \<open>S = {}\<close> \<open>a \<noteq> b\<close> show ?thesis
-        by (rule_tac f = "\<lambda>x. b" in that) (auto simp: continuous_on_const)
+        by (rule_tac f = "\<lambda>x. b" in that) (auto)
     next
       case False
       with UT closedin_subset obtain c where c: "c \<in> U" "c \<notin> T"
         by fastforce
       obtain f where f: "continuous_on U f"
                 "\<And>x. x \<in> U \<Longrightarrow> f x \<in> closed_segment (midpoint a b) b"
                 "\<And>x. x \<in> U \<Longrightarrow> (f x = midpoint a b \<longleftrightarrow> x = c)"
                 "\<And>x. x \<in> U \<Longrightarrow> (f x = b \<longleftrightarrow> x \<in> T)"
         apply (rule Urysohn_both_ne [of U "{c}" T "midpoint a b" "b"])
         using c \<open>T \<noteq> {}\<close> assms apply simp_all
         done
       show ?thesis
         apply (rule_tac f=f in that)
         using \<open>S = {}\<close> \<open>T \<noteq> {}\<close> f csegment_midpoint_subset notin_segment_midpoint [OF \<open>a \<noteq> b\<close>]
         apply force+
         done
     qed
   qed
 next
   case False
   show ?thesis
   proof (cases "T = {}")
     case True show ?thesis
     proof (cases "S = U")
       case True with \<open>T = {}\<close> \<open>a \<noteq> b\<close> show ?thesis
-        by (rule_tac f = "\<lambda>x. a" in that) (auto simp: continuous_on_const)
+        by (rule_tac f = "\<lambda>x. a" in that) (auto)
     next
       case False
       with US closedin_subset obtain c where c: "c \<in> U" "c \<notin> S"
         by fastforce
       obtain f where f: "continuous_on U f"
                 "\<And>x. x \<in> U \<Longrightarrow> f x \<in> closed_segment a (midpoint a b)"
                 "\<And>x. x \<in> U \<Longrightarrow> (f x = midpoint a b \<longleftrightarrow> x = c)"
                 "\<And>x. x \<in> U \<Longrightarrow> (f x = a \<longleftrightarrow> x \<in> S)"
         apply (rule Urysohn_both_ne [of U S "{c}" a "midpoint a b"])
         using c \<open>S \<noteq> {}\<close> assms apply simp_all
         apply (metis midpoint_eq_endpoint)
         done
       show ?thesis
         apply (rule_tac f=f in that)
         using \<open>S \<noteq> {}\<close> \<open>T = {}\<close> f  \<open>a \<noteq> b\<close>
         apply simp_all
         apply (metis (no_types) closed_segment_commute csegment_midpoint_subset midpoint_sym subset_iff)
         apply (metis closed_segment_commute midpoint_sym notin_segment_midpoint)
         done
     qed
   next
     case False
     show ?thesis
       using Urysohn_both_ne [OF US UT \<open>S \<inter> T = {}\<close> \<open>S \<noteq> {}\<close> \<open>T \<noteq> {}\<close> \<open>a \<noteq> b\<close>] that
       by blast
   qed
 qed
 
 lemma Urysohn_local:
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "S \<inter> T = {}"
   obtains f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     where "continuous_on U f"
           "\<And>x. x \<in> U \<Longrightarrow> f x \<in> closed_segment a b"
           "\<And>x. x \<in> S \<Longrightarrow> f x = a"
           "\<And>x. x \<in> T \<Longrightarrow> f x = b"
 proof (cases "a = b")
   case True then show ?thesis
-    by (rule_tac f = "\<lambda>x. b" in that) (auto simp: continuous_on_const)
+    by (rule_tac f = "\<lambda>x. b" in that) (auto)
 next
   case False
   then show ?thesis
     apply (rule Urysohn_local_strong [OF assms])
     apply (erule that, assumption)
     apply (meson US closedin_singleton closedin_trans)
     apply (meson UT closedin_singleton closedin_trans)
     done
 qed
 
 lemma Urysohn_strong:
   assumes US: "closed S"
       and UT: "closed T"
       and "S \<inter> T = {}" "a \<noteq> b"
   obtains f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     where "continuous_on UNIV f"
           "\<And>x. f x \<in> closed_segment a b"
           "\<And>x. f x = a \<longleftrightarrow> x \<in> S"
           "\<And>x. f x = b \<longleftrightarrow> x \<in> T"
 using assms by (auto intro: Urysohn_local_strong [of UNIV S T])
 
 proposition Urysohn:
   assumes US: "closed S"
       and UT: "closed T"
       and "S \<inter> T = {}"
   obtains f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     where "continuous_on UNIV f"
           "\<And>x. f x \<in> closed_segment a b"
           "\<And>x. x \<in> S \<Longrightarrow> f x = a"
           "\<And>x. x \<in> T \<Longrightarrow> f x = b"
   using assms by (auto intro: Urysohn_local [of UNIV S T a b])
 
 
 subsection\<open>Dugundji's Extension Theorem and Tietze Variants\<close>
 
 text \<open>See \cite{dugundji}.\<close>
 
 theorem Dugundji:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> 'b::real_inner"
   assumes "convex C" "C \<noteq> {}"
       and cloin: "closedin (top_of_set U) S"
       and contf: "continuous_on S f" and "f ` S \<subseteq> C"
   obtains g where "continuous_on U g" "g ` U \<subseteq> C"
                   "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof (cases "S = {}")
   case True then show thesis
     apply (rule_tac g="\<lambda>x. SOME y. y \<in> C" in that)
       apply (rule continuous_intros)
      apply (meson all_not_in_conv \<open>C \<noteq> {}\<close> image_subsetI someI_ex, simp)
     done
 next
   case False
   then have sd_pos: "\<And>x. \<lbrakk>x \<in> U; x \<notin> S\<rbrakk> \<Longrightarrow> 0 < setdist {x} S"
     using setdist_eq_0_closedin [OF cloin] le_less setdist_pos_le by fastforce
   define \<B> where "\<B> = {ball x (setdist {x} S / 2) |x. x \<in> U - S}"
   have [simp]: "\<And>T. T \<in> \<B> \<Longrightarrow> open T"
     by (auto simp: \<B>_def)
   have USS: "U - S \<subseteq> \<Union>\<B>"
     by (auto simp: sd_pos \<B>_def)
   obtain \<C> where USsub: "U - S \<subseteq> \<Union>\<C>"
        and nbrhd: "\<And>U. U \<in> \<C> \<Longrightarrow> open U \<and> (\<exists>T. T \<in> \<B> \<and> U \<subseteq> T)"
        and fin: "\<And>x. x \<in> U - S \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U. U \<in> \<C> \<and> U \<inter> V \<noteq> {}}"
     by (rule paracompact [OF USS]) auto
   have "\<exists>v a. v \<in> U \<and> v \<notin> S \<and> a \<in> S \<and>
               T \<subseteq> ball v (setdist {v} S / 2) \<and>
               dist v a \<le> 2 * setdist {v} S" if "T \<in> \<C>" for T
   proof -
     obtain v where v: "T \<subseteq> ball v (setdist {v} S / 2)" "v \<in> U" "v \<notin> S"
       using \<open>T \<in> \<C>\<close> nbrhd by (force simp: \<B>_def)
     then obtain a where "a \<in> S" "dist v a < 2 * setdist {v} S"
       using setdist_ltE [of "{v}" S "2 * setdist {v} S"]
       using False sd_pos by force
     with v show ?thesis
       apply (rule_tac x=v in exI)
       apply (rule_tac x=a in exI, auto)
       done
   qed
   then obtain \<V> \<A> where
     VA: "\<And>T. T \<in> \<C> \<Longrightarrow> \<V> T \<in> U \<and> \<V> T \<notin> S \<and> \<A> T \<in> S \<and>
               T \<subseteq> ball (\<V> T) (setdist {\<V> T} S / 2) \<and>
               dist (\<V> T) (\<A> T) \<le> 2 * setdist {\<V> T} S"
     by metis
   have sdle: "setdist {\<V> T} S \<le> 2 * setdist {v} S" if "T \<in> \<C>" "v \<in> T" for T v
     using setdist_Lipschitz [of "\<V> T" S v] VA [OF \<open>T \<in> \<C>\<close>] \<open>v \<in> T\<close> by auto
   have d6: "dist a (\<A> T) \<le> 6 * dist a v" if "T \<in> \<C>" "v \<in> T" "a \<in> S" for T v a
   proof -
     have "dist (\<V> T) v < setdist {\<V> T} S / 2"
       using that VA mem_ball by blast
     also have "\<dots> \<le> setdist {v} S"
       using sdle [OF \<open>T \<in> \<C>\<close> \<open>v \<in> T\<close>] by simp
     also have vS: "setdist {v} S \<le> dist a v"
       by (simp add: setdist_le_dist setdist_sym \<open>a \<in> S\<close>)
     finally have VTV: "dist (\<V> T) v < dist a v" .
     have VTS: "setdist {\<V> T} S \<le> 2 * dist a v"
       using sdle that vS by force
     have "dist a (\<A> T) \<le> dist a v + dist v (\<V> T) + dist (\<V> T) (\<A> T)"
       by (metis add.commute add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
     also have "\<dots> \<le> dist a v + dist a v + dist (\<V> T) (\<A> T)"
       using VTV by (simp add: dist_commute)
     also have "\<dots> \<le> 2 * dist a v + 2 * setdist {\<V> T} S"
       using VA [OF \<open>T \<in> \<C>\<close>] by auto
     finally show ?thesis
       using VTS by linarith
   qed
   obtain H :: "['a set, 'a] \<Rightarrow> real"
     where Hcont: "\<And>Z. Z \<in> \<C> \<Longrightarrow> continuous_on (U-S) (H Z)"
       and Hge0: "\<And>Z x. \<lbrakk>Z \<in> \<C>; x \<in> U-S\<rbrakk> \<Longrightarrow> 0 \<le> H Z x"
       and Heq0: "\<And>x Z. \<lbrakk>Z \<in> \<C>; x \<in> U-S; x \<notin> Z\<rbrakk> \<Longrightarrow> H Z x = 0"
       and H1: "\<And>x. x \<in> U-S \<Longrightarrow> supp_sum (\<lambda>W. H W x) \<C> = 1"
       and Hfin: "\<And>x. x \<in> U-S \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<C>. \<exists>x\<in>V. H U x \<noteq> 0}"
     apply (rule subordinate_partition_of_unity [OF USsub _ fin])
     using nbrhd by auto
   define g where "g \<equiv> \<lambda>x. if x \<in> S then f x else supp_sum (\<lambda>T. H T x *\<^sub>R f(\<A> T)) \<C>"
   show ?thesis
   proof (rule that)
     show "continuous_on U g"
     proof (clarsimp simp: continuous_on_eq_continuous_within)
       fix a assume "a \<in> U"
       show "continuous (at a within U) g"
       proof (cases "a \<in> S")
         case True show ?thesis
         proof (clarsimp simp add: continuous_within_topological)
           fix W
           assume "open W" "g a \<in> W"
           then obtain e where "0 < e" and e: "ball (f a) e \<subseteq> W"
             using openE True g_def by auto
           have "continuous (at a within S) f"
             using True contf continuous_on_eq_continuous_within by blast
           then obtain d where "0 < d"
                         and d: "\<And>x. \<lbrakk>x \<in> S; dist x a < d\<rbrakk> \<Longrightarrow> dist (f x) (f a) < e"
             using continuous_within_eps_delta \<open>0 < e\<close> by force
           have "g y \<in> ball (f a) e" if "y \<in> U" and y: "y \<in> ball a (d / 6)" for y
           proof (cases "y \<in> S")
             case True
             then have "dist (f a) (f y) < e"
               by (metis ball_divide_subset_numeral dist_commute in_mono mem_ball y d)
             then show ?thesis
               by (simp add: True g_def)
           next
             case False
             have *: "dist (f (\<A> T)) (f a) < e" if "T \<in> \<C>" "H T y \<noteq> 0" for T
             proof -
               have "y \<in> T"
                 using Heq0 that False \<open>y \<in> U\<close> by blast
               have "dist (\<A> T) a < d"
                 using d6 [OF \<open>T \<in> \<C>\<close> \<open>y \<in> T\<close> \<open>a \<in> S\<close>] y
                 by (simp add: dist_commute mult.commute)
               then show ?thesis
                 using VA [OF \<open>T \<in> \<C>\<close>] by (auto simp: d)
             qed
             have "supp_sum (\<lambda>T. H T y *\<^sub>R f (\<A> T)) \<C> \<in> ball (f a) e"
               apply (rule convex_supp_sum [OF convex_ball])
               apply (simp_all add: False H1 Hge0 \<open>y \<in> U\<close>)
               by (metis dist_commute *)
             then show ?thesis
               by (simp add: False g_def)
           qed
           then show "\<exists>A. open A \<and> a \<in> A \<and> (\<forall>y\<in>U. y \<in> A \<longrightarrow> g y \<in> W)"
             apply (rule_tac x = "ball a (d / 6)" in exI)
             using e \<open>0 < d\<close> by fastforce
         qed
       next
         case False
         obtain N where N: "open N" "a \<in> N"
                    and finN: "finite {U \<in> \<C>. \<exists>a\<in>N. H U a \<noteq> 0}"
           using Hfin False \<open>a \<in> U\<close> by auto
         have oUS: "openin (top_of_set U) (U - S)"
           using cloin by (simp add: openin_diff)
         have HcontU: "continuous (at a within U) (H T)" if "T \<in> \<C>" for T
           using Hcont [OF \<open>T \<in> \<C>\<close>] False  \<open>a \<in> U\<close> \<open>T \<in> \<C>\<close>
           apply (simp add: continuous_on_eq_continuous_within continuous_within)
           apply (rule Lim_transform_within_set)
           using oUS
             apply (force simp: eventually_at openin_contains_ball dist_commute dest!: bspec)+
           done
         show ?thesis
         proof (rule continuous_transform_within_openin [OF _ oUS])
           show "continuous (at a within U) (\<lambda>x. supp_sum (\<lambda>T. H T x *\<^sub>R f (\<A> T)) \<C>)"
           proof (rule continuous_transform_within_openin)
             show "continuous (at a within U)
                     (\<lambda>x. \<Sum>T\<in>{U \<in> \<C>. \<exists>x\<in>N. H U x \<noteq> 0}. H T x *\<^sub>R f (\<A> T))"
               by (force intro: continuous_intros HcontU)+
           next
             show "openin (top_of_set U) ((U - S) \<inter> N)"
               using N oUS openin_trans by blast
           next
             show "a \<in> (U - S) \<inter> N" using False \<open>a \<in> U\<close> N by blast
           next
             show "\<And>x. x \<in> (U - S) \<inter> N \<Longrightarrow>
                          (\<Sum>T \<in> {U \<in> \<C>. \<exists>x\<in>N. H U x \<noteq> 0}. H T x *\<^sub>R f (\<A> T))
                          = supp_sum (\<lambda>T. H T x *\<^sub>R f (\<A> T)) \<C>"
               by (auto simp: supp_sum_def support_on_def
                        intro: sum.mono_neutral_right [OF finN])
           qed
         next
           show "a \<in> U - S" using False \<open>a \<in> U\<close> by blast
         next
           show "\<And>x. x \<in> U - S \<Longrightarrow> supp_sum (\<lambda>T. H T x *\<^sub>R f (\<A> T)) \<C> = g x"
             by (simp add: g_def)
         qed
       qed
     qed
     show "g ` U \<subseteq> C"
       using \<open>f ` S \<subseteq> C\<close> VA
       by (fastforce simp: g_def Hge0 intro!: convex_supp_sum [OF \<open>convex C\<close>] H1)
     show "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
       by (simp add: g_def)
   qed
 qed
 
 
 corollary Tietze:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> 'b::real_inner"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
     and "0 \<le> B"
     and "\<And>x. x \<in> S \<Longrightarrow> norm(f x) \<le> B"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     "\<And>x. x \<in> U \<Longrightarrow> norm(g x) \<le> B"
   using assms by (auto simp: image_subset_iff intro: Dugundji [of "cball 0 B" U S f])
 
 corollary\<^marker>\<open>tag unimportant\<close> Tietze_closed_interval:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> 'b::euclidean_space"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
     and "cbox a b \<noteq> {}"
     and "\<And>x. x \<in> S \<Longrightarrow> f x \<in> cbox a b"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     "\<And>x. x \<in> U \<Longrightarrow> g x \<in> cbox a b"
   apply (rule Dugundji [of "cbox a b" U S f])
   using assms by auto
 
 corollary\<^marker>\<open>tag unimportant\<close> Tietze_closed_interval_1:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> real"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
     and "a \<le> b"
     and "\<And>x. x \<in> S \<Longrightarrow> f x \<in> cbox a b"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     "\<And>x. x \<in> U \<Longrightarrow> g x \<in> cbox a b"
   apply (rule Dugundji [of "cbox a b" U S f])
   using assms by (auto simp: image_subset_iff)
 
 corollary\<^marker>\<open>tag unimportant\<close> Tietze_open_interval:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> 'b::euclidean_space"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
     and "box a b \<noteq> {}"
     and "\<And>x. x \<in> S \<Longrightarrow> f x \<in> box a b"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     "\<And>x. x \<in> U \<Longrightarrow> g x \<in> box a b"
   apply (rule Dugundji [of "box a b" U S f])
   using assms by auto
 
 corollary\<^marker>\<open>tag unimportant\<close> Tietze_open_interval_1:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> real"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
     and "a < b"
     and no: "\<And>x. x \<in> S \<Longrightarrow> f x \<in> box a b"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     "\<And>x. x \<in> U \<Longrightarrow> g x \<in> box a b"
   apply (rule Dugundji [of "box a b" U S f])
   using assms by (auto simp: image_subset_iff)
 
 corollary\<^marker>\<open>tag unimportant\<close> Tietze_unbounded:
   fixes f :: "'a::{metric_space,second_countable_topology} \<Rightarrow> 'b::real_inner"
   assumes "continuous_on S f"
     and "closedin (top_of_set U) S"
   obtains g where "continuous_on U g" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   apply (rule Dugundji [of UNIV U S f])
   using assms by auto
 
 end
diff --git a/src/HOL/Analysis/Convex_Euclidean_Space.thy b/src/HOL/Analysis/Convex_Euclidean_Space.thy
--- a/src/HOL/Analysis/Convex_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy
@@ -1,2275 +1,2275 @@
 (* Title:      HOL/Analysis/Convex_Euclidean_Space.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 
 section \<open>Convex Sets and Functions on (Normed) Euclidean Spaces\<close>
 
 theory Convex_Euclidean_Space
 imports
   Convex
   Topology_Euclidean_Space
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological Properties of Convex Sets and Functions\<close>
 
 lemma aff_dim_cball:
   fixes a :: "'n::euclidean_space"
   assumes "e > 0"
   shows "aff_dim (cball a e) = int (DIM('n))"
 proof -
   have "(\<lambda>x. a + x) ` (cball 0 e) \<subseteq> cball a e"
     unfolding cball_def dist_norm by auto
   then have "aff_dim (cball (0 :: 'n::euclidean_space) e) \<le> aff_dim (cball a e)"
     using aff_dim_translation_eq[of a "cball 0 e"]
           aff_dim_subset[of "(+) a ` cball 0 e" "cball a e"]
     by auto
   moreover have "aff_dim (cball (0 :: 'n::euclidean_space) e) = int (DIM('n))"
     using hull_inc[of "(0 :: 'n::euclidean_space)" "cball 0 e"]
       centre_in_cball[of "(0 :: 'n::euclidean_space)"] assms
     by (simp add: dim_cball[of e] aff_dim_zero[of "cball 0 e"])
   ultimately show ?thesis
     using aff_dim_le_DIM[of "cball a e"] by auto
 qed
 
 lemma aff_dim_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
     and "S \<noteq> {}"
   shows "aff_dim S = int (DIM('n))"
 proof -
   obtain x where "x \<in> S"
     using assms by auto
   then obtain e where e: "e > 0" "cball x e \<subseteq> S"
     using open_contains_cball[of S] assms by auto
   then have "aff_dim (cball x e) \<le> aff_dim S"
     using aff_dim_subset by auto
   with e show ?thesis
     using aff_dim_cball[of e x] aff_dim_le_DIM[of S] by auto
 qed
 
 lemma low_dim_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "\<not> aff_dim S = int (DIM('n))"
   shows "interior S = {}"
 proof -
   have "aff_dim(interior S) \<le> aff_dim S"
     using interior_subset aff_dim_subset[of "interior S" S] by auto
   then show ?thesis
     using aff_dim_open[of "interior S"] aff_dim_le_DIM[of S] assms by auto
 qed
 
 corollary empty_interior_lowdim:
   fixes S :: "'n::euclidean_space set"
   shows "dim S < DIM ('n) \<Longrightarrow> interior S = {}"
 by (metis low_dim_interior affine_hull_UNIV dim_affine_hull less_not_refl dim_UNIV)
 
 corollary aff_dim_nonempty_interior:
   fixes S :: "'a::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> aff_dim S = DIM('a)"
 by (metis low_dim_interior)
 
 
 subsection \<open>Relative interior of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_interior S =
   {x. \<exists>T. openin (top_of_set (affine hull S)) T \<and> x \<in> T \<and> T \<subseteq> S}"
 
 lemma rel_interior_mono:
    "\<lbrakk>S \<subseteq> T; affine hull S = affine hull T\<rbrakk>
    \<Longrightarrow> (rel_interior S) \<subseteq> (rel_interior T)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_maximal:
    "\<lbrakk>T \<subseteq> S; openin(top_of_set (affine hull S)) T\<rbrakk> \<Longrightarrow> T \<subseteq> (rel_interior S)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior:
   "rel_interior S = {x \<in> S. \<exists>T. open T \<and> x \<in> T \<and> T \<inter> affine hull S \<subseteq> S}"
   unfolding rel_interior_def[of S] openin_open[of "affine hull S"]
   apply auto
 proof -
   fix x T
   assume *: "x \<in> S" "open T" "x \<in> T" "T \<inter> affine hull S \<subseteq> S"
   then have **: "x \<in> T \<inter> affine hull S"
     using hull_inc by auto
   show "\<exists>Tb. (\<exists>Ta. open Ta \<and> Tb = affine hull S \<inter> Ta) \<and> x \<in> Tb \<and> Tb \<subseteq> S"
     apply (rule_tac x = "T \<inter> (affine hull S)" in exI)
     using * **
     apply auto
     done
 qed
 
 lemma mem_rel_interior: "x \<in> rel_interior S \<longleftrightarrow> (\<exists>T. open T \<and> x \<in> T \<inter> S \<and> T \<inter> affine hull S \<subseteq> S)"
   by (auto simp: rel_interior)
 
 lemma mem_rel_interior_ball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S)"
   apply (simp add: rel_interior, safe)
   apply (force simp: open_contains_ball)
   apply (rule_tac x = "ball x e" in exI, simp)
   done
 
 lemma rel_interior_ball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_ball [of _ S] by auto
 
 lemma mem_rel_interior_cball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S)"
   apply (simp add: rel_interior, safe)
   apply (force simp: open_contains_cball)
   apply (rule_tac x = "ball x e" in exI)
   apply (simp add: subset_trans [OF ball_subset_cball], auto)
   done
 
 lemma rel_interior_cball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_cball [of _ S] by auto
 
 lemma rel_interior_empty [simp]: "rel_interior {} = {}"
    by (auto simp: rel_interior_def)
 
 lemma affine_hull_sing [simp]: "affine hull {a :: 'n::euclidean_space} = {a}"
   by (metis affine_hull_eq affine_sing)
 
 lemma rel_interior_sing [simp]:
     fixes a :: "'n::euclidean_space"  shows "rel_interior {a} = {a}"
   apply (auto simp: rel_interior_ball)
   apply (rule_tac x=1 in exI, force)
   done
 
 lemma subset_rel_interior:
   fixes S T :: "'n::euclidean_space set"
   assumes "S \<subseteq> T"
     and "affine hull S = affine hull T"
   shows "rel_interior S \<subseteq> rel_interior T"
   using assms by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset: "rel_interior S \<subseteq> S"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset_closure: "rel_interior S \<subseteq> closure S"
   using rel_interior_subset by (auto simp: closure_def)
 
 lemma interior_subset_rel_interior: "interior S \<subseteq> rel_interior S"
   by (auto simp: rel_interior interior_def)
 
 lemma interior_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "aff_dim S = int(DIM('n))"
   shows "rel_interior S = interior S"
 proof -
   have "affine hull S = UNIV"
     using assms affine_hull_UNIV[of S] by auto
   then show ?thesis
     unfolding rel_interior interior_def by auto
 qed
 
 lemma rel_interior_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "affine hull S = UNIV"
   shows "rel_interior S = interior S"
   using assms unfolding rel_interior interior_def by auto
 
 lemma rel_interior_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
   shows "rel_interior S = S"
   by (metis assms interior_eq interior_subset_rel_interior rel_interior_subset set_eq_subset)
 
 lemma interior_ball [simp]: "interior (ball x e) = ball x e"
   by (simp add: interior_open)
 
 lemma interior_rel_interior_gen:
   fixes S :: "'n::euclidean_space set"
   shows "interior S = (if aff_dim S = int(DIM('n)) then rel_interior S else {})"
   by (metis interior_rel_interior low_dim_interior)
 
 lemma rel_interior_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> rel_interior S = interior S"
 by (metis interior_rel_interior_gen)
 
 lemma affine_hull_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> affine hull S = UNIV"
 by (metis affine_hull_UNIV interior_rel_interior_gen)
 
 lemma rel_interior_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior (affine hull S) = affine hull S"
 proof -
   have *: "rel_interior (affine hull S) \<subseteq> affine hull S"
     using rel_interior_subset by auto
   {
     fix x
     assume x: "x \<in> affine hull S"
     define e :: real where "e = 1"
     then have "e > 0" "ball x e \<inter> affine hull (affine hull S) \<subseteq> affine hull S"
       using hull_hull[of _ S] by auto
     then have "x \<in> rel_interior (affine hull S)"
       using x rel_interior_ball[of "affine hull S"] by auto
   }
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_UNIV [simp]: "rel_interior (UNIV :: ('n::euclidean_space) set) = UNIV"
   by (metis open_UNIV rel_interior_open)
 
 lemma rel_interior_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding  mem_rel_interior_ball by auto
   {
     fix y
     assume as: "dist (x - e *\<^sub>R (x - c)) y < e * d" "y \<in> affine hull S"
     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
       using \<open>e > 0\<close> by (auto simp: scaleR_left_diff_distrib scaleR_right_diff_distrib)
     have "x \<in> affine hull S"
       using assms hull_subset[of S] by auto
     moreover have "1 / e + - ((1 - e) / e) = 1"
       using \<open>e > 0\<close> left_diff_distrib[of "1" "(1-e)" "1/e"] by auto
     ultimately have **: "(1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x \<in> affine hull S"
       using as affine_affine_hull[of S] mem_affine[of "affine hull S" y x "(1 / e)" "-((1 - e) / e)"]
       by (simp add: algebra_simps)
     have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = \<bar>1/e\<bar> * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
       unfolding dist_norm norm_scaleR[symmetric]
       apply (rule arg_cong[where f=norm])
       using \<open>e > 0\<close>
       apply (auto simp: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
       done
     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
     also have "\<dots> < d"
       using as[unfolded dist_norm] and \<open>e > 0\<close>
       by (auto simp:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
     finally have "y \<in> S"
       apply (subst *)
       apply (rule assms(1)[unfolded convex_alt,rule_format])
       apply (rule d[THEN subsetD])
       unfolding mem_ball
       using assms(3-5) **
       apply auto
       done
   }
   then have "ball (x - e *\<^sub>R (x - c)) (e*d) \<inter> affine hull S \<subseteq> S"
     by auto
   moreover have "e * d > 0"
     using \<open>e > 0\<close> \<open>d > 0\<close> by simp
   moreover have c: "c \<in> S"
     using assms rel_interior_subset by auto
   moreover from c have "x - e *\<^sub>R (x - c) \<in> S"
     using convexD_alt[of S x c e]
     apply (simp add: algebra_simps)
     using assms
     apply auto
     done
   ultimately show ?thesis
     using mem_rel_interior_ball[of "x - e *\<^sub>R (x - c)" S] \<open>e > 0\<close> by auto
 qed
 
 lemma interior_real_atLeast [simp]:
   fixes a :: real
   shows "interior {a..} = {a<..}"
 proof -
   {
     fix y
     assume "a < y"
     then have "y \<in> interior {a..}"
       apply (simp add: mem_interior)
       apply (rule_tac x="(y-a)" in exI)
       apply (auto simp: dist_norm)
       done
   }
   moreover
   {
     fix y
     assume "y \<in> interior {a..}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {a..}"
       using mem_interior_cball[of y "{a..}"] by auto
     moreover from e have "y - e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<le> y - e" by blast
     then have "a < y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma continuous_ge_on_Ioo:
   assumes "continuous_on {c..d} g" "\<And>x. x \<in> {c<..<d} \<Longrightarrow> g x \<ge> a" "c < d" "x \<in> {c..d}"
   shows "g (x::real) \<ge> (a::real)"
 proof-
   from assms(3) have "{c..d} = closure {c<..<d}" by (rule closure_greaterThanLessThan[symmetric])
   also from assms(2) have "{c<..<d} \<subseteq> (g -` {a..} \<inter> {c..d})" by auto
   hence "closure {c<..<d} \<subseteq> closure (g -` {a..} \<inter> {c..d})" by (rule closure_mono)
   also from assms(1) have "closed (g -` {a..} \<inter> {c..d})"
     by (auto simp: continuous_on_closed_vimage)
   hence "closure (g -` {a..} \<inter> {c..d}) = g -` {a..} \<inter> {c..d}" by simp
   finally show ?thesis using \<open>x \<in> {c..d}\<close> by auto
 qed
 
 lemma interior_real_atMost [simp]:
   fixes a :: real
   shows "interior {..a} = {..<a}"
 proof -
   {
     fix y
     assume "a > y"
     then have "y \<in> interior {..a}"
       apply (simp add: mem_interior)
       apply (rule_tac x="(a-y)" in exI)
       apply (auto simp: dist_norm)
       done
   }
   moreover
   {
     fix y
     assume "y \<in> interior {..a}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {..a}"
       using mem_interior_cball[of y "{..a}"] by auto
     moreover from e have "y + e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<ge> y + e" by auto
     then have "a > y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma interior_atLeastAtMost_real [simp]: "interior {a..b} = {a<..<b :: real}"
 proof-
   have "{a..b} = {a..} \<inter> {..b}" by auto
   also have "interior \<dots> = {a<..} \<inter> {..<b}"
     by (simp add: interior_real_atLeast interior_real_atMost)
   also have "\<dots> = {a<..<b}" by auto
   finally show ?thesis .
 qed
 
 lemma interior_atLeastLessThan [simp]:
   fixes a::real shows "interior {a..<b} = {a<..<b}"
   by (metis atLeastLessThan_def greaterThanLessThan_def interior_atLeastAtMost_real interior_Int interior_interior interior_real_atLeast)
 
 lemma interior_lessThanAtMost [simp]:
   fixes a::real shows "interior {a<..b} = {a<..<b}"
   by (metis atLeastAtMost_def greaterThanAtMost_def interior_atLeastAtMost_real interior_Int
             interior_interior interior_real_atLeast)
 
 lemma interior_greaterThanLessThan_real [simp]: "interior {a<..<b} = {a<..<b :: real}"
   by (metis interior_atLeastAtMost_real interior_interior)
 
 lemma frontier_real_atMost [simp]:
   fixes a :: real
   shows "frontier {..a} = {a}"
   unfolding frontier_def by (auto simp: interior_real_atMost)
 
 lemma frontier_real_atLeast [simp]: "frontier {a..} = {a::real}"
   by (auto simp: frontier_def)
 
 lemma frontier_real_greaterThan [simp]: "frontier {a<..} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma frontier_real_lessThan [simp]: "frontier {..<a} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma rel_interior_real_box [simp]:
   fixes a b :: real
   assumes "a < b"
   shows "rel_interior {a .. b} = {a <..< b}"
 proof -
   have "box a b \<noteq> {}"
     using assms
     unfolding set_eq_iff
     by (auto intro!: exI[of _ "(a + b) / 2"] simp: box_def)
   then show ?thesis
     using interior_rel_interior_gen[of "cbox a b", symmetric]
     by (simp split: if_split_asm del: box_real add: box_real[symmetric] interior_cbox)
 qed
 
 lemma rel_interior_real_semiline [simp]:
   fixes a :: real
   shows "rel_interior {a..} = {a<..}"
 proof -
   have *: "{a<..} \<noteq> {}"
     unfolding set_eq_iff by (auto intro!: exI[of _ "a + 1"])
   then show ?thesis using interior_real_atLeast interior_rel_interior_gen[of "{a..}"]
     by (auto split: if_split_asm)
 qed
 
 subsubsection \<open>Relative open sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_open S \<longleftrightarrow> rel_interior S = S"
 
 lemma rel_open: "rel_open S \<longleftrightarrow> openin (top_of_set (affine hull S)) S"
   unfolding rel_open_def rel_interior_def
   apply auto
   using openin_subopen[of "top_of_set (affine hull S)" S]
   apply auto
   done
 
 lemma openin_rel_interior: "openin (top_of_set (affine hull S)) (rel_interior S)"
   apply (simp add: rel_interior_def)
   apply (subst openin_subopen, blast)
   done
 
 lemma openin_set_rel_interior:
    "openin (top_of_set S) (rel_interior S)"
 by (rule openin_subset_trans [OF openin_rel_interior rel_interior_subset hull_subset])
 
 lemma affine_rel_open:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "rel_open S"
   unfolding rel_open_def
   using assms rel_interior_affine_hull[of S] affine_hull_eq[of S]
   by metis
 
 lemma affine_closed:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "closed S"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain L where L: "subspace L" "affine_parallel S L"
       using assms affine_parallel_subspace[of S] by auto
     then obtain a where a: "S = ((+) a ` L)"
       using affine_parallel_def[of L S] affine_parallel_commut by auto
     from L have "closed L" using closed_subspace by auto
     then have "closed S"
       using closed_translation a by auto
   }
   then show ?thesis by auto
 qed
 
 lemma closure_affine_hull:
   fixes S :: "'n::euclidean_space set"
   shows "closure S \<subseteq> affine hull S"
   by (intro closure_minimal hull_subset affine_closed affine_affine_hull)
 
 lemma closure_same_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "affine hull (closure S) = affine hull S"
 proof -
   have "affine hull (closure S) \<subseteq> affine hull S"
     using hull_mono[of "closure S" "affine hull S" "affine"]
       closure_affine_hull[of S] hull_hull[of "affine" S]
     by auto
   moreover have "affine hull (closure S) \<supseteq> affine hull S"
     using hull_mono[of "S" "closure S" "affine"] closure_subset by auto
   ultimately show ?thesis by auto
 qed
 
 lemma closure_aff_dim [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim (closure S) = aff_dim S"
 proof -
   have "aff_dim S \<le> aff_dim (closure S)"
     using aff_dim_subset closure_subset by auto
   moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)"
     using aff_dim_subset closure_affine_hull by blast
   moreover have "aff_dim (affine hull S) = aff_dim S"
     using aff_dim_affine_hull by auto
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_closure_convex_shrink:
   fixes S :: "_::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> closure S"
     and "e > 0"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding mem_rel_interior_ball by auto
   have "\<exists>y \<in> S. norm (y - x) * (1 - e) < e * d"
   proof (cases "x \<in> S")
     case True
     then show ?thesis using \<open>e > 0\<close> \<open>d > 0\<close>
       apply (rule_tac bexI[where x=x], auto)
       done
   next
     case False
     then have x: "x islimpt S"
       using assms(3)[unfolded closure_def] by auto
     show ?thesis
     proof (cases "e = 1")
       case True
       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding True
         using \<open>d > 0\<close>
         apply auto
         done
     next
       case False
       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding dist_norm
         using pos_less_divide_eq[OF *]
         apply auto
         done
     qed
   qed
   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
     by auto
   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
     unfolding z_def using \<open>e > 0\<close>
     by (auto simp: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
   have zball: "z \<in> ball c d"
     using mem_ball z_def dist_norm[of c]
     using y and assms(4,5)
     by (simp add: norm_minus_commute) (simp add: field_simps)
   have "x \<in> affine hull S"
     using closure_affine_hull assms by auto
   moreover have "y \<in> affine hull S"
     using \<open>y \<in> S\<close> hull_subset[of S] by auto
   moreover have "c \<in> affine hull S"
     using assms rel_interior_subset hull_subset[of S] by auto
   ultimately have "z \<in> affine hull S"
     using z_def affine_affine_hull[of S]
       mem_affine_3_minus [of "affine hull S" c x y "(1 - e) / e"]
       assms
     by simp
   then have "z \<in> S" using d zball by auto
   obtain d1 where "d1 > 0" and d1: "ball z d1 \<le> ball c d"
     using zball open_ball[of c d] openE[of "ball c d" z] by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> ball c d \<inter> affine hull S"
     by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> S"
     using d by auto
   then have "z \<in> rel_interior S"
     using mem_rel_interior_ball using \<open>d1 > 0\<close> \<open>z \<in> S\<close> by auto
   then have "y - e *\<^sub>R (y - z) \<in> rel_interior S"
     using rel_interior_convex_shrink[of S z y e] assms \<open>y \<in> S\<close> by auto
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_eq:
    "rel_interior s = s \<longleftrightarrow> openin(top_of_set (affine hull s)) s"
 using rel_open rel_open_def by blast
 
 lemma rel_interior_openin:
    "openin(top_of_set (affine hull s)) s \<Longrightarrow> rel_interior s = s"
 by (simp add: rel_interior_eq)
 
 lemma rel_interior_affine:
   fixes S :: "'n::euclidean_space set"
   shows  "affine S \<Longrightarrow> rel_interior S = S"
 using affine_rel_open rel_open_def by auto
 
 lemma rel_interior_eq_closure:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior S = closure S \<longleftrightarrow> affine S"
 proof (cases "S = {}")
   case True
  then show ?thesis
     by auto
 next
   case False show ?thesis
   proof
     assume eq: "rel_interior S = closure S"
     have "S = {} \<or> S = affine hull S"
       apply (rule connected_clopen [THEN iffD1, rule_format])
        apply (simp add: affine_imp_convex convex_connected)
       apply (rule conjI)
        apply (metis eq closure_subset openin_rel_interior rel_interior_subset subset_antisym)
       apply (metis closed_subset closure_subset_eq eq hull_subset rel_interior_subset)
       done
     with False have "affine hull S = S"
       by auto
     then show "affine S"
       by (metis affine_hull_eq)
   next
     assume "affine S"
     then show "rel_interior S = closure S"
       by (simp add: rel_interior_affine affine_closed)
   qed
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Relative interior preserves under linear transformations\<close>
 
 lemma rel_interior_translation_aux:
   fixes a :: "'n::euclidean_space"
   shows "((\<lambda>x. a + x) ` rel_interior S) \<subseteq> rel_interior ((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain T where "open T" "x \<in> T \<inter> S" "T \<inter> affine hull S \<subseteq> S"
       using mem_rel_interior[of x S] by auto
     then have "open ((\<lambda>x. a + x) ` T)"
       and "a + x \<in> ((\<lambda>x. a + x) ` T) \<inter> ((\<lambda>x. a + x) ` S)"
       and "((\<lambda>x. a + x) ` T) \<inter> affine hull ((\<lambda>x. a + x) ` S) \<subseteq> (\<lambda>x. a + x) ` S"
       using affine_hull_translation[of a S] open_translation[of T a] x by auto
     then have "a + x \<in> rel_interior ((\<lambda>x. a + x) ` S)"
       using mem_rel_interior[of "a+x" "((\<lambda>x. a + x) ` S)"] by auto
   }
   then show ?thesis by auto
 qed
 
 lemma rel_interior_translation:
   fixes a :: "'n::euclidean_space"
   shows "rel_interior ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` rel_interior S"
 proof -
   have "(\<lambda>x. (-a) + x) ` rel_interior ((\<lambda>x. a + x) ` S) \<subseteq> rel_interior S"
     using rel_interior_translation_aux[of "-a" "(\<lambda>x. a + x) ` S"]
       translation_assoc[of "-a" "a"]
     by auto
   then have "((\<lambda>x. a + x) ` rel_interior S) \<supseteq> rel_interior ((\<lambda>x. a + x) ` S)"
     using translation_inverse_subset[of a "rel_interior ((+) a ` S)" "rel_interior S"]
     by auto
   then show ?thesis
     using rel_interior_translation_aux[of a S] by auto
 qed
 
 
 lemma affine_hull_linear_image:
   assumes "bounded_linear f"
   shows "f ` (affine hull s) = affine hull f ` s"
 proof -
   interpret f: bounded_linear f by fact
   have "affine {x. f x \<in> affine hull f ` s}"
     unfolding affine_def
     by (auto simp: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format])
   moreover have "affine {x. x \<in> f ` (affine hull s)}"
     using affine_affine_hull[unfolded affine_def, of s]
     unfolding affine_def by (auto simp: f.scaleR [symmetric] f.add [symmetric])
   ultimately show ?thesis
     by (auto simp: hull_inc elim!: hull_induct)
 qed 
 
 
 lemma rel_interior_injective_on_span_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
     and S :: "'m::euclidean_space set"
   assumes "bounded_linear f"
     and "inj_on f (span S)"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
 proof -
   {
     fix z
     assume z: "z \<in> rel_interior (f ` S)"
     then have "z \<in> f ` S"
       using rel_interior_subset[of "f ` S"] by auto
     then obtain x where x: "x \<in> S" "f x = z" by auto
     obtain e2 where e2: "e2 > 0" "cball z e2 \<inter> affine hull (f ` S) \<subseteq> (f ` S)"
       using z rel_interior_cball[of "f ` S"] by auto
     obtain K where K: "K > 0" "\<And>x. norm (f x) \<le> norm x * K"
      using assms Real_Vector_Spaces.bounded_linear.pos_bounded[of f] by auto
     define e1 where "e1 = 1 / K"
     then have e1: "e1 > 0" "\<And>x. e1 * norm (f x) \<le> norm x"
       using K pos_le_divide_eq[of e1] by auto
     define e where "e = e1 * e2"
     then have "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball x e \<inter> affine hull S"
       then have h1: "f y \<in> affine hull (f ` S)"
         using affine_hull_linear_image[of f S] assms by auto
       from y have "norm (x-y) \<le> e1 * e2"
         using cball_def[of x e] dist_norm[of x y] e_def by auto
       moreover have "f x - f y = f (x - y)"
         using assms linear_diff[of f x y] linear_conv_bounded_linear[of f] by auto
       moreover have "e1 * norm (f (x-y)) \<le> norm (x - y)"
         using e1 by auto
       ultimately have "e1 * norm ((f x)-(f y)) \<le> e1 * e2"
         by auto
       then have "f y \<in> cball z e2"
         using cball_def[of "f x" e2] dist_norm[of "f x" "f y"] e1 x by auto
       then have "f y \<in> f ` S"
         using y e2 h1 by auto
       then have "y \<in> S"
         using assms y hull_subset[of S] affine_hull_subset_span
           inj_on_image_mem_iff [OF \<open>inj_on f (span S)\<close>]
         by (metis Int_iff span_superset subsetCE)
     }
     then have "z \<in> f ` (rel_interior S)"
       using mem_rel_interior_cball[of x S] \<open>e > 0\<close> x by auto
   }
   moreover
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain e2 where e2: "e2 > 0" "cball x e2 \<inter> affine hull S \<subseteq> S"
       using rel_interior_cball[of S] by auto
     have "x \<in> S" using x rel_interior_subset by auto
     then have *: "f x \<in> f ` S" by auto
     have "\<forall>x\<in>span S. f x = 0 \<longrightarrow> x = 0"
       using assms subspace_span linear_conv_bounded_linear[of f]
         linear_injective_on_subspace_0[of f "span S"]
       by auto
     then obtain e1 where e1: "e1 > 0" "\<forall>x \<in> span S. e1 * norm x \<le> norm (f x)"
       using assms injective_imp_isometric[of "span S" f]
         subspace_span[of S] closed_subspace[of "span S"]
       by auto
     define e where "e = e1 * e2"
     hence "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball (f x) e \<inter> affine hull (f ` S)"
       then have "y \<in> f ` (affine hull S)"
         using affine_hull_linear_image[of f S] assms by auto
       then obtain xy where xy: "xy \<in> affine hull S" "f xy = y" by auto
       with y have "norm (f x - f xy) \<le> e1 * e2"
         using cball_def[of "f x" e] dist_norm[of "f x" y] e_def by auto
       moreover have "f x - f xy = f (x - xy)"
         using assms linear_diff[of f x xy] linear_conv_bounded_linear[of f] by auto
       moreover have *: "x - xy \<in> span S"
         using subspace_diff[of "span S" x xy] subspace_span \<open>x \<in> S\<close> xy
           affine_hull_subset_span[of S] span_superset
         by auto
       moreover from * have "e1 * norm (x - xy) \<le> norm (f (x - xy))"
         using e1 by auto
       ultimately have "e1 * norm (x - xy) \<le> e1 * e2"
         by auto
       then have "xy \<in> cball x e2"
         using cball_def[of x e2] dist_norm[of x xy] e1 by auto
       then have "y \<in> f ` S"
         using xy e2 by auto
     }
     then have "f x \<in> rel_interior (f ` S)"
       using mem_rel_interior_cball[of "(f x)" "(f ` S)"] * \<open>e > 0\<close> by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_injective_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "bounded_linear f"
     and "inj f"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
   using assms rel_interior_injective_on_span_linear_image[of f S]
     subset_inj_on[of f "UNIV" "span S"]
   by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Openness and compactness are preserved by convex hull operation\<close>
 
 lemma open_convex_hull[intro]:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (convex hull S)"
 proof (clarsimp simp: open_contains_cball convex_hull_explicit)
   fix T and u :: "'a\<Rightarrow>real"
   assume obt: "finite T" "T\<subseteq>S" "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1" 
 
   from assms[unfolded open_contains_cball] obtain b
     where b: "\<And>x. x\<in>S \<Longrightarrow> 0 < b x \<and> cball x (b x) \<subseteq> S" by metis
   have "b ` T \<noteq> {}"
     using obt by auto
   define i where "i = b ` T"
   let ?\<Phi> = "\<lambda>y. \<exists>F. finite F \<and> F \<subseteq> S \<and> (\<exists>u. (\<forall>x\<in>F. 0 \<le> u x) \<and> sum u F = 1 \<and> (\<Sum>v\<in>F. u v *\<^sub>R v) = y)"
   let ?a = "\<Sum>v\<in>T. u v *\<^sub>R v"
   show "\<exists>e > 0. cball ?a e \<subseteq> {y. ?\<Phi> y}"
   proof (intro exI subsetI conjI)
     show "0 < Min i"
       unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` T\<noteq>{}\<close>]
       using b \<open>T\<subseteq>S\<close> by auto
   next
     fix y
     assume "y \<in> cball ?a (Min i)"
     then have y: "norm (?a - y) \<le> Min i"
       unfolding dist_norm[symmetric] by auto
     { fix x
       assume "x \<in> T"
       then have "Min i \<le> b x"
         by (simp add: i_def obt(1))
       then have "x + (y - ?a) \<in> cball x (b x)"
         using y unfolding mem_cball dist_norm by auto
       moreover have "x \<in> S"
         using \<open>x\<in>T\<close> \<open>T\<subseteq>S\<close> by auto
       ultimately have "x + (y - ?a) \<in> S"
         using y b by blast
     }
     moreover
     have *: "inj_on (\<lambda>v. v + (y - ?a)) T"
       unfolding inj_on_def by auto
     have "(\<Sum>v\<in>(\<lambda>v. v + (y - ?a)) ` T. u (v - (y - ?a)) *\<^sub>R v) = y"
       unfolding sum.reindex[OF *] o_def using obt(4)
       by (simp add: sum.distrib sum_subtractf scaleR_left.sum[symmetric] scaleR_right_distrib)
     ultimately show "y \<in> {y. ?\<Phi> y}"
     proof (intro CollectI exI conjI)
       show "finite ((\<lambda>v. v + (y - ?a)) ` T)"
         by (simp add: obt(1))
       show "sum (\<lambda>v. u (v - (y - ?a))) ((\<lambda>v. v + (y - ?a)) ` T) = 1"
         unfolding sum.reindex[OF *] o_def using obt(4) by auto
     qed (use obt(1, 3) in auto)
   qed
 qed
 
 lemma compact_convex_combinations:
   fixes S T :: "'a::real_normed_vector set"
   assumes "compact S" "compact T"
   shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T}"
 proof -
   let ?X = "{0..1} \<times> S \<times> T"
   let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
   have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T} = ?h ` ?X"
     by force
   have "continuous_on ?X (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
     unfolding continuous_on by (rule ballI) (intro tendsto_intros)
   with assms show ?thesis
     by (simp add: * compact_Times compact_continuous_image)
 qed
 
 lemma finite_imp_compact_convex_hull:
   fixes S :: "'a::real_normed_vector set"
   assumes "finite S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by simp
 next
   case False
   with assms show ?thesis
   proof (induct rule: finite_ne_induct)
     case (singleton x)
     show ?case by simp
   next
     case (insert x A)
     let ?f = "\<lambda>(u, y::'a). u *\<^sub>R x + (1 - u) *\<^sub>R y"
     let ?T = "{0..1::real} \<times> (convex hull A)"
     have "continuous_on ?T ?f"
       unfolding split_def continuous_on by (intro ballI tendsto_intros)
     moreover have "compact ?T"
       by (intro compact_Times compact_Icc insert)
     ultimately have "compact (?f ` ?T)"
       by (rule compact_continuous_image)
     also have "?f ` ?T = convex hull (insert x A)"
       unfolding convex_hull_insert [OF \<open>A \<noteq> {}\<close>]
       apply safe
       apply (rule_tac x=a in exI, simp)
       apply (rule_tac x="1 - a" in exI, simp, fast)
       apply (rule_tac x="(u, b)" in image_eqI, simp_all)
       done
     finally show "compact (convex hull (insert x A))" .
   qed
 qed
 
 lemma compact_convex_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis using compact_empty by simp
 next
   case False
   then obtain w where "w \<in> S" by auto
   show ?thesis
     unfolding caratheodory[of S]
   proof (induct ("DIM('a) + 1"))
     case 0
     have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> S \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
       using compact_empty by auto
     from 0 show ?case unfolding * by simp
   next
     case (Suc n)
     show ?case
     proof (cases "n = 0")
       case True
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = S"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "x \<in> S"
         proof (cases "card T = 0")
           case True
           then show ?thesis
             using T(4) unfolding card_0_eq[OF T(1)] by simp
         next
           case False
           then have "card T = Suc 0" using T(3) \<open>n=0\<close> by auto
           then obtain a where "T = {a}" unfolding card_Suc_eq by auto
           then show ?thesis using T(2,4) by simp
         qed
       next
         fix x assume "x\<in>S"
         then show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           apply (rule_tac x="{x}" in exI)
           unfolding convex_hull_singleton
           apply auto
           done
       qed
       then show ?thesis using assms by simp
     next
       case False
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} =
         {(1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
           0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> {x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> x \<in> convex hull T}}"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         then obtain u v c T where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
           "0 \<le> c \<and> c \<le> 1" "u \<in> S" "finite T" "T \<subseteq> S" "card T \<le> n"  "v \<in> convex hull T"
           by auto
         moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u T"
           apply (rule convexD_alt)
           using obt(2) and convex_convex_hull and hull_subset[of "insert u T" convex]
           using obt(7) and hull_mono[of T "insert u T"]
           apply auto
           done
         ultimately show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           apply (rule_tac x="insert u T" in exI)
           apply (auto simp: card_insert_if)
           done
       next
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         proof (cases "card T = Suc n")
           case False
           then have "card T \<le> n" using T(3) by auto
           then show ?thesis
             apply (rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI)
             using \<open>w\<in>S\<close> and T
             apply (auto intro!: exI[where x=T])
             done
         next
           case True
           then obtain a u where au: "T = insert a u" "a\<notin>u"
             apply (drule_tac card_eq_SucD, auto)
             done
           show ?thesis
           proof (cases "u = {}")
             case True
             then have "x = a" using T(4)[unfolded au] by auto
             show ?thesis unfolding \<open>x = a\<close>
               apply (rule_tac x=a in exI)
               apply (rule_tac x=a in exI)
               apply (rule_tac x=1 in exI)
               using T and \<open>n \<noteq> 0\<close>
               unfolding au
               apply (auto intro!: exI[where x="{a}"])
               done
           next
             case False
             obtain ux vx b where obt: "ux\<ge>0" "vx\<ge>0" "ux + vx = 1"
               "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
               using T(4)[unfolded au convex_hull_insert[OF False]]
               by auto
             have *: "1 - vx = ux" using obt(3) by auto
             show ?thesis
               apply (rule_tac x=a in exI)
               apply (rule_tac x=b in exI)
               apply (rule_tac x=vx in exI)
               using obt and T(1-3)
               unfolding au and * using card_insert_disjoint[OF _ au(2)]
               apply (auto intro!: exI[where x=u])
               done
           qed
         qed
       qed
       then show ?thesis
         using compact_convex_combinations[OF assms Suc] by simp
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Extremal points of a simplex are some vertices\<close>
 
 lemma dist_increases_online:
   fixes a b d :: "'a::real_inner"
   assumes "d \<noteq> 0"
   shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
 proof (cases "inner a d - inner b d > 0")
   case True
   then have "0 < inner d d + (inner a d * 2 - inner b d * 2)"
     apply (rule_tac add_pos_pos)
     using assms
     apply auto
     done
   then show ?thesis
     apply (rule_tac disjI2)
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     apply  (simp add: algebra_simps inner_commute)
     done
 next
   case False
   then have "0 < inner d d + (inner b d * 2 - inner a d * 2)"
     apply (rule_tac add_pos_nonneg)
     using assms
     apply auto
     done
   then show ?thesis
     apply (rule_tac disjI1)
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     apply (simp add: algebra_simps inner_commute)
     done
 qed
 
 lemma norm_increases_online:
   fixes d :: "'a::real_inner"
   shows "d \<noteq> 0 \<Longrightarrow> norm (a + d) > norm a \<or> norm(a - d) > norm a"
   using dist_increases_online[of d a 0] unfolding dist_norm by auto
 
 lemma simplex_furthest_lt:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
   shows "\<forall>x \<in> convex hull S.  x \<notin> S \<longrightarrow> (\<exists>y \<in> convex hull S. norm (x - a) < norm(y - a))"
   using assms
 proof induct
   fix x S
   assume as: "finite S" "x\<notin>S" "\<forall>x\<in>convex hull S. x \<notin> S \<longrightarrow> (\<exists>y\<in>convex hull S. norm (x - a) < norm (y - a))"
   show "\<forall>xa\<in>convex hull insert x S. xa \<notin> insert x S \<longrightarrow>
     (\<exists>y\<in>convex hull insert x S. norm (xa - a) < norm (y - a))"
   proof (intro impI ballI, cases "S = {}")
     case False
     fix y
     assume y: "y \<in> convex hull insert x S" "y \<notin> insert x S"
     obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "y = u *\<^sub>R x + v *\<^sub>R b"
       using y(1)[unfolded convex_hull_insert[OF False]] by auto
     show "\<exists>z\<in>convex hull insert x S. norm (y - a) < norm (z - a)"
     proof (cases "y \<in> convex hull S")
       case True
       then obtain z where "z \<in> convex hull S" "norm (y - a) < norm (z - a)"
         using as(3)[THEN bspec[where x=y]] and y(2) by auto
       then show ?thesis
         apply (rule_tac x=z in bexI)
         unfolding convex_hull_insert[OF False]
         apply auto
         done
     next
       case False
       show ?thesis
         using obt(3)
       proof (cases "u = 0", case_tac[!] "v = 0")
         assume "u = 0" "v \<noteq> 0"
         then have "y = b" using obt by auto
         then show ?thesis using False and obt(4) by auto
       next
         assume "u \<noteq> 0" "v = 0"
         then have "y = x" using obt by auto
         then show ?thesis using y(2) by auto
       next
         assume "u \<noteq> 0" "v \<noteq> 0"
         then obtain w where w: "w>0" "w<u" "w<v"
           using field_lbound_gt_zero[of u v] and obt(1,2) by auto
         have "x \<noteq> b"
         proof
           assume "x = b"
           then have "y = b" unfolding obt(5)
             using obt(3) by (auto simp: scaleR_left_distrib[symmetric])
           then show False using obt(4) and False by simp
         qed
         then have *: "w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
         show ?thesis
           using dist_increases_online[OF *, of a y]
         proof (elim disjE)
           assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u + w \<ge> 0" "v - w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         next
           assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u - w \<ge> 0" "v + w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         qed
       qed auto
     qed
   qed auto
 qed (auto simp: assms)
 
 lemma simplex_furthest_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>y\<in>S. \<forall>x\<in> convex hull S. norm (x - a) \<le> norm (y - a)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain x where x: "x \<in> convex hull S" "\<forall>y\<in>convex hull S. norm (y - a) \<le> norm (x - a)"
     using distance_attains_sup[OF finite_imp_compact_convex_hull[OF \<open>finite S\<close>], of a]
     unfolding dist_commute[of a]
     unfolding dist_norm
     by auto
   show ?thesis
   proof (cases "x \<in> S")
     case False
     then obtain y where "y \<in> convex hull S" "norm (x - a) < norm (y - a)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1)
       by auto
     then show ?thesis
       using x(2)[THEN bspec[where x=y]] by auto
   next
     case True
     with x show ?thesis by auto
   qed
 qed
 
 lemma simplex_furthest_le_exists:
   fixes S :: "('a::real_inner) set"
   shows "finite S \<Longrightarrow> \<forall>x\<in>(convex hull S). \<exists>y\<in>S. norm (x - a) \<le> norm (y - a)"
   using simplex_furthest_le[of S] by (cases "S = {}") auto
 
 lemma simplex_extremal_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>u\<in>S. \<exists>v\<in>S. \<forall>x\<in>convex hull S. \<forall>y \<in> convex hull S. norm (x - y) \<le> norm (u - v)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain u v where obt: "u \<in> convex hull S" "v \<in> convex hull S"
     "\<forall>x\<in>convex hull S. \<forall>y\<in>convex hull S. norm (x - y) \<le> norm (u - v)"
     using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]]
     by (auto simp: dist_norm)
   then show ?thesis
   proof (cases "u\<notin>S \<or> v\<notin>S", elim disjE)
     assume "u \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (u - v) < norm (y - v)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2)
       by auto
   next
     assume "v \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (v - u) < norm (y - u)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
       by (auto simp: norm_minus_commute)
   qed auto
 qed
 
 lemma simplex_extremal_le_exists:
   fixes S :: "'a::real_inner set"
   shows "finite S \<Longrightarrow> x \<in> convex hull S \<Longrightarrow> y \<in> convex hull S \<Longrightarrow>
     \<exists>u\<in>S. \<exists>v\<in>S. norm (x - y) \<le> norm (u - v)"
   using convex_hull_empty simplex_extremal_le[of S]
   by(cases "S = {}") auto
 
 
 subsection \<open>Closest point of a convex set is unique, with a continuous projection\<close>
 
 definition\<^marker>\<open>tag important\<close> closest_point :: "'a::{real_inner,heine_borel} set \<Rightarrow> 'a \<Rightarrow> 'a"
   where "closest_point S a = (SOME x. x \<in> S \<and> (\<forall>y\<in>S. dist a x \<le> dist a y))"
 
 lemma closest_point_exists:
   assumes "closed S"
     and "S \<noteq> {}"
   shows "closest_point S a \<in> S"
     and "\<forall>y\<in>S. dist a (closest_point S a) \<le> dist a y"
   unfolding closest_point_def
   apply(rule_tac[!] someI2_ex)
   apply (auto intro: distance_attains_inf[OF assms(1,2), of a])
   done
 
 lemma closest_point_in_set: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S a \<in> S"
   by (meson closest_point_exists)
 
 lemma closest_point_le: "closed S \<Longrightarrow> x \<in> S \<Longrightarrow> dist a (closest_point S a) \<le> dist a x"
   using closest_point_exists[of S] by auto
 
 lemma closest_point_self:
   assumes "x \<in> S"
   shows "closest_point S x = x"
   unfolding closest_point_def
   apply (rule some1_equality, rule ex1I[of _ x])
   using assms
   apply auto
   done
 
 lemma closest_point_refl: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S x = x \<longleftrightarrow> x \<in> S"
   using closest_point_in_set[of S x] closest_point_self[of x S]
   by auto
 
 lemma closer_points_lemma:
   assumes "inner y z > 0"
   shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
 proof -
   have z: "inner z z > 0"
     unfolding inner_gt_zero_iff using assms by auto
   have "norm (v *\<^sub>R z - y) < norm y"
     if "0 < v" and "v \<le> inner y z / inner z z" for v
     unfolding norm_lt using z assms that
     by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>])
   then show ?thesis
     using assms z
     by (rule_tac x = "inner y z / inner z z" in exI) auto
 qed
 
 lemma closer_point_lemma:
   assumes "inner (y - x) (z - x) > 0"
   shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
 proof -
   obtain u where "u > 0"
     and u: "\<forall>v>0. v \<le> u \<longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)"
     using closer_points_lemma[OF assms] by auto
   show ?thesis
     apply (rule_tac x="min u 1" in exI)
     using u[THEN spec[where x="min u 1"]] and \<open>u > 0\<close>
     unfolding dist_norm by (auto simp: norm_minus_commute field_simps)
 qed
 
 lemma any_closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "inner (a - x) (y - x) \<le> 0"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then obtain u where u: "u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a"
     using closer_point_lemma[of a x y] by auto
   let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y"
   have "?z \<in> S"
     using convexD_alt[OF assms(1,3,4), of u] using u by auto
   then show False
     using assms(5)[THEN bspec[where x="?z"]] and u(3)
     by (auto simp: dist_commute algebra_simps)
 qed
 
 lemma any_closest_point_unique:
   fixes x :: "'a::real_inner"
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S"
     "\<forall>z\<in>S. dist a x \<le> dist a z" "\<forall>z\<in>S. dist a y \<le> dist a z"
   shows "x = y"
   using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
   unfolding norm_pths(1) and norm_le_square
   by (auto simp: algebra_simps)
 
 lemma closest_point_unique:
   assumes "convex S" "closed S" "x \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "x = closest_point S a"
   using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point S a"]
   using closest_point_exists[OF assms(2)] and assms(3) by auto
 
 lemma closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S"
   shows "inner (a - closest_point S a) (x - closest_point S a) \<le> 0"
   apply (rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
   using closest_point_exists[OF assms(2)] and assms(3)
   apply auto
   done
 
 lemma closest_point_lt:
   assumes "convex S" "closed S" "x \<in> S" "x \<noteq> closest_point S a"
   shows "dist a (closest_point S a) < dist a x"
   apply (rule ccontr)
   apply (rule_tac notE[OF assms(4)])
   apply (rule closest_point_unique[OF assms(1-3), of a])
   using closest_point_le[OF assms(2), of _ a]
   apply fastforce
   done
 
 lemma setdist_closest_point:
     "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> setdist {a} S = dist a (closest_point S a)"
   apply (rule setdist_unique)
   using closest_point_le
   apply (auto simp: closest_point_in_set)
   done
 
 lemma closest_point_lipschitz:
   assumes "convex S"
     and "closed S" "S \<noteq> {}"
   shows "dist (closest_point S x) (closest_point S y) \<le> dist x y"
 proof -
   have "inner (x - closest_point S x) (closest_point S y - closest_point S x) \<le> 0"
     and "inner (y - closest_point S y) (closest_point S x - closest_point S y) \<le> 0"
     apply (rule_tac[!] any_closest_point_dot[OF assms(1-2)])
     using closest_point_exists[OF assms(2-3)]
     apply auto
     done
   then show ?thesis unfolding dist_norm and norm_le
     using inner_ge_zero[of "(x - closest_point S x) - (y - closest_point S y)"]
     by (simp add: inner_add inner_diff inner_commute)
 qed
 
 lemma continuous_at_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous (at x) (closest_point S)"
   unfolding continuous_at_eps_delta
   using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
 
 lemma continuous_on_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous_on t (closest_point S)"
   by (metis continuous_at_imp_continuous_on continuous_at_closest_point[OF assms])
 
 proposition closest_point_in_rel_interior:
   assumes "closed S" "S \<noteq> {}" and x: "x \<in> affine hull S"
     shows "closest_point S x \<in> rel_interior S \<longleftrightarrow> x \<in> rel_interior S"
 proof (cases "x \<in> S")
   case True
   then show ?thesis
     by (simp add: closest_point_self)
 next
   case False
   then have "False" if asm: "closest_point S x \<in> rel_interior S"
   proof -
     obtain e where "e > 0" and clox: "closest_point S x \<in> S"
                and e: "cball (closest_point S x) e \<inter> affine hull S \<subseteq> S"
       using asm mem_rel_interior_cball by blast
     then have clo_notx: "closest_point S x \<noteq> x"
       using \<open>x \<notin> S\<close> by auto
     define y where "y \<equiv> closest_point S x -
                         (min 1 (e / norm(closest_point S x - x))) *\<^sub>R (closest_point S x - x)"
     have "x - y = (1 - min 1 (e / norm (closest_point S x - x))) *\<^sub>R (x - closest_point S x)"
       by (simp add: y_def algebra_simps)
     then have "norm (x - y) = abs ((1 - min 1 (e / norm (closest_point S x - x)))) * norm(x - closest_point S x)"
       by simp
     also have "\<dots> < norm(x - closest_point S x)"
       using clo_notx \<open>e > 0\<close>
       by (auto simp: mult_less_cancel_right2 field_split_simps)
     finally have no_less: "norm (x - y) < norm (x - closest_point S x)" .
     have "y \<in> affine hull S"
       unfolding y_def
       by (meson affine_affine_hull clox hull_subset mem_affine_3_minus2 subsetD x)
     moreover have "dist (closest_point S x) y \<le> e"
       using \<open>e > 0\<close> by (auto simp: y_def min_mult_distrib_right)
     ultimately have "y \<in> S"
       using subsetD [OF e] by simp
     then have "dist x (closest_point S x) \<le> dist x y"
       by (simp add: closest_point_le \<open>closed S\<close>)
     with no_less show False
       by (simp add: dist_norm)
   qed
   moreover have "x \<notin> rel_interior S"
     using rel_interior_subset False by blast
   ultimately show ?thesis by blast
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Various point-to-set separating/supporting hyperplane theorems\<close>
 
 lemma supporting_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
     and "z \<notin> S"
   shows "\<exists>a b. \<exists>y\<in>S. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>S. inner a x \<ge> b)"
 proof -
   obtain y where "y \<in> S" and y: "\<forall>x\<in>S. dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2-3)])
   show ?thesis
   proof (intro exI bexI conjI ballI)
     show "(y - z) \<bullet> z < (y - z) \<bullet> y"
       by (metis \<open>y \<in> S\<close> assms(4) diff_gt_0_iff_gt inner_commute inner_diff_left inner_gt_zero_iff right_minus_eq)
     show "(y - z) \<bullet> y \<le> (y - z) \<bullet> x" if "x \<in> S" for x
     proof (rule ccontr)
       have *: "\<And>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
         using assms(1)[unfolded convex_alt] and y and \<open>x\<in>S\<close> and \<open>y\<in>S\<close> by auto
       assume "\<not> (y - z) \<bullet> y \<le> (y - z) \<bullet> x"
       then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z"
         using closer_point_lemma[of z y x] by (auto simp: inner_diff)
       then show False
         using *[of v] by (auto simp: dist_commute algebra_simps)
     qed
   qed (use \<open>y \<in> S\<close> in auto)
 qed
 
 lemma separating_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "z \<notin> S"
   shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: gt_ex)
 next
   case False
   obtain y where "y \<in> S" and y: "\<And>x. x \<in> S \<Longrightarrow> dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2) False])
   show ?thesis
   proof (intro exI conjI ballI)
     show "(y - z) \<bullet> z < inner (y - z) z + (norm (y - z))\<^sup>2 / 2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
   next
     fix x
     assume "x \<in> S"
     have "False" if *: "0 < inner (z - y) (x - y)"
     proof -
       obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z"
         using * closer_point_lemma by blast
       then show False using y[of "y + u *\<^sub>R (x - y)"] convexD_alt [OF \<open>convex S\<close>]
         using \<open>x\<in>S\<close> \<open>y\<in>S\<close> by (auto simp: dist_commute algebra_simps)
     qed
     moreover have "0 < (norm (y - z))\<^sup>2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
     then have "0 < inner (y - z) (y - z)"
       unfolding power2_norm_eq_inner by simp
     ultimately show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
       by (force simp: field_simps power2_norm_eq_inner inner_commute inner_diff)
   qed 
 qed
 
 lemma separating_hyperplane_closed_0:
   assumes "convex (S::('a::euclidean_space) set)"
     and "closed S"
     and "0 \<notin> S"
   shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   have "(SOME i. i\<in>Basis) \<noteq> (0::'a)"
     by (metis Basis_zero SOME_Basis)
   then show ?thesis
     using True zero_less_one by blast
 next
   case False
   then show ?thesis
     using False using separating_hyperplane_closed_point[OF assms]
     by (metis all_not_in_conv inner_zero_left inner_zero_right less_eq_real_def not_le)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Now set-to-set for closed/compact sets\<close>
 
 lemma separating_hyperplane_closed_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "closed S"
     and "convex T"
     and "compact T"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof (cases "S = {}")
   case True
   obtain b where b: "b > 0" "\<forall>x\<in>T. norm x \<le> b"
     using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto
   obtain z :: 'a where z: "norm z = b + 1"
     using vector_choose_size[of "b + 1"] and b(1) by auto
   then have "z \<notin> T" using b(2)[THEN bspec[where x=z]] by auto
   then obtain a b where ab: "inner a z < b" "\<forall>x\<in>T. b < inner a x"
     using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z]
     by auto
   then show ?thesis
     using True by auto
 next
   case False
   then obtain y where "y \<in> S" by auto
   obtain a b where "0 < b" "\<forall>x \<in> (\<Union>x\<in> S. \<Union>y \<in> T. {x - y}). b < inner a x"
     using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
     using closed_compact_differences[OF assms(2,4)]
     using assms(6) by auto 
   then have ab: "\<forall>x\<in>S. \<forall>y\<in>T. b + inner a y < inner a x"
     apply -
     apply rule
     apply rule
     apply (erule_tac x="x - y" in ballE)
     apply (auto simp: inner_diff)
     done
   define k where "k = (SUP x\<in>T. a \<bullet> x)"
   show ?thesis
     apply (rule_tac x="-a" in exI)
     apply (rule_tac x="-(k + b / 2)" in exI)
     apply (intro conjI ballI)
     unfolding inner_minus_left and neg_less_iff_less
   proof -
     fix x assume "x \<in> T"
     then have "inner a x - b / 2 < k"
       unfolding k_def
     proof (subst less_cSUP_iff)
       show "T \<noteq> {}" by fact
       show "bdd_above ((\<bullet>) a ` T)"
         using ab[rule_format, of y] \<open>y \<in> S\<close>
         by (intro bdd_aboveI2[where M="inner a y - b"]) (auto simp: field_simps intro: less_imp_le)
     qed (auto intro!: bexI[of _ x] \<open>0<b\<close>)
     then show "inner a x < k + b / 2"
       by auto
   next
     fix x
     assume "x \<in> S"
     then have "k \<le> inner a x - b"
       unfolding k_def
       apply (rule_tac cSUP_least)
       using assms(5)
       using ab[THEN bspec[where x=x]]
       apply auto
       done
     then show "k + b / 2 < inner a x"
       using \<open>0 < b\<close> by auto
   qed
 qed
 
 lemma separating_hyperplane_compact_closed:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "compact S"
     and "S \<noteq> {}"
     and "convex T"
     and "closed T"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof -
   obtain a b where "(\<forall>x\<in>T. inner a x < b) \<and> (\<forall>x\<in>S. b < inner a x)"
     using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6)
     by auto
   then show ?thesis
     apply (rule_tac x="-a" in exI)
     apply (rule_tac x="-b" in exI, auto)
     done
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>General case without assuming closure and getting non-strict separation\<close>
 
 lemma separating_hyperplane_set_0:
   assumes "convex S" "(0::'a::euclidean_space) \<notin> S"
   shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>S. 0 \<le> inner a x)"
 proof -
   let ?k = "\<lambda>c. {x::'a. 0 \<le> inner c x}"
   have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` S" "finite f" for f
   proof -
     obtain c where c: "f = ?k ` c" "c \<subseteq> S" "finite c"
       using finite_subset_image[OF as(2,1)] by auto
     then obtain a b where ab: "a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
       using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
       using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
       using subset_hull[of convex, OF assms(1), symmetric, of c]
       by force
     then have "\<exists>x. norm x = 1 \<and> (\<forall>y\<in>c. 0 \<le> inner y x)"
       apply (rule_tac x = "inverse(norm a) *\<^sub>R a" in exI)
       using hull_subset[of c convex]
       unfolding subset_eq and inner_scaleR
       by (auto simp: inner_commute del: ballE elim!: ballE)
     then show "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}"
       unfolding c(1) frontier_cball sphere_def dist_norm by auto
   qed
   have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` S)) \<noteq> {}"
     apply (rule compact_imp_fip)
     apply (rule compact_frontier[OF compact_cball])
     using * closed_halfspace_ge
     by auto
   then obtain x where "norm x = 1" "\<forall>y\<in>S. x\<in>?k y"
     unfolding frontier_cball dist_norm sphere_def by auto
   then show ?thesis
     by (metis inner_commute mem_Collect_eq norm_eq_zero zero_neq_one)
 qed
 
 lemma separating_hyperplane_sets:
   fixes S T :: "'a::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "S \<noteq> {}"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>S. inner a x \<le> b) \<and> (\<forall>x\<in>T. inner a x \<ge> b)"
 proof -
   from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
   obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> T \<and> y \<in> S}. 0 \<le> inner a x"
     using assms(3-5) by force
   then have *: "\<And>x y. x \<in> T \<Longrightarrow> y \<in> S \<Longrightarrow> inner a y \<le> inner a x"
     by (force simp: inner_diff)
   then have bdd: "bdd_above (((\<bullet>) a)`S)"
     using \<open>T \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *])
   show ?thesis
     using \<open>a\<noteq>0\<close>
     by (intro exI[of _ a] exI[of _ "SUP x\<in>S. a \<bullet> x"])
        (auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>S \<noteq> {}\<close> *)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More convexity generalities\<close>
 
 lemma convex_closure [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (closure S)"
   apply (rule convexI)
   apply (unfold closure_sequential, elim exE)
   apply (rule_tac x="\<lambda>n. u *\<^sub>R xa n + v *\<^sub>R xb n" in exI)
   apply (rule,rule)
   apply (rule convexD [OF assms])
   apply (auto del: tendsto_const intro!: tendsto_intros)
   done
 
 lemma convex_interior [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (interior S)"
   unfolding convex_alt Ball_def mem_interior
 proof clarify
   fix x y u
   assume u: "0 \<le> u" "u \<le> (1::real)"
   fix e d
   assume ed: "ball x e \<subseteq> S" "ball y d \<subseteq> S" "0<d" "0<e"
   show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> S"
   proof (intro exI conjI subsetI)
     fix z
     assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
     then have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> S"
       apply (rule_tac assms[unfolded convex_alt, rule_format])
       using ed(1,2) and u
       unfolding subset_eq mem_ball Ball_def dist_norm
       apply (auto simp: algebra_simps)
       done
     then show "z \<in> S"
       using u by (auto simp: algebra_simps)
   qed(insert u ed(3-4), auto)
 qed
 
 lemma convex_hull_eq_empty[simp]: "convex hull S = {} \<longleftrightarrow> S = {}"
   using hull_subset[of S convex] convex_hull_empty by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convex set as intersection of halfspaces\<close>
 
 lemma convex_halfspace_intersection:
   fixes s :: "('a::euclidean_space) set"
   assumes "closed s" "convex s"
   shows "s = \<Inter>{h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
   apply (rule set_eqI, rule)
   unfolding Inter_iff Ball_def mem_Collect_eq
   apply (rule,rule,erule conjE)
 proof -
   fix x
   assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
   then have "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}"
     by blast
   then show "x \<in> s"
     apply (rule_tac ccontr)
     apply (drule separating_hyperplane_closed_point[OF assms(2,1)])
     apply (erule exE)+
     apply (erule_tac x="-a" in allE)
     apply (erule_tac x="-b" in allE, auto)
     done
 qed auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of general and special intervals\<close>
 
 lemma is_interval_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "is_interval S"
   shows "convex S"
 proof (rule convexI)
   fix x y and u v :: real
   assume as: "x \<in> S" "y \<in> S" "0 \<le> u" "0 \<le> v" "u + v = 1"
   then have *: "u = 1 - v" "1 - v \<ge> 0" and **: "v = 1 - u" "1 - u \<ge> 0"
     by auto
   {
     fix a b
     assume "\<not> b \<le> u * a + v * b"
     then have "u * a < (1 - v) * b"
       unfolding not_le using as(4) by (auto simp: field_simps)
     then have "a < b"
       unfolding * using as(4) *(2)
       apply (rule_tac mult_left_less_imp_less[of "1 - v"])
       apply (auto simp: field_simps)
       done
     then have "a \<le> u * a + v * b"
       unfolding * using as(4)
       by (auto simp: field_simps intro!:mult_right_mono)
   }
   moreover
   {
     fix a b
     assume "\<not> u * a + v * b \<le> a"
     then have "v * b > (1 - u) * a"
       unfolding not_le using as(4) by (auto simp: field_simps)
     then have "a < b"
       unfolding * using as(4)
       apply (rule_tac mult_left_less_imp_less)
       apply (auto simp: field_simps)
       done
     then have "u * a + v * b \<le> b"
       unfolding **
       using **(2) as(3)
       by (auto simp: field_simps intro!:mult_right_mono)
   }
   ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> S"
     apply -
     apply (rule assms[unfolded is_interval_def, rule_format, OF as(1,2)])
     using as(3-) DIM_positive[where 'a='a]
     apply (auto simp: inner_simps)
     done
 qed
 
 lemma is_interval_connected:
   fixes S :: "'a::euclidean_space set"
   shows "is_interval S \<Longrightarrow> connected S"
   using is_interval_convex convex_connected by auto
 
 lemma convex_box [simp]: "convex (cbox a b)" "convex (box a (b::'a::euclidean_space))"
   apply (rule_tac[!] is_interval_convex)+
   using is_interval_box is_interval_cbox
   apply auto
   done
 
 text\<open>A non-singleton connected set is perfect (i.e. has no isolated points). \<close>
 lemma connected_imp_perfect:
   fixes a :: "'a::metric_space"
   assumes "connected S" "a \<in> S" and S: "\<And>x. S \<noteq> {x}"
   shows "a islimpt S"
 proof -
   have False if "a \<in> T" "open T" "\<And>y. \<lbrakk>y \<in> S; y \<in> T\<rbrakk> \<Longrightarrow> y = a" for T
   proof -
     obtain e where "e > 0" and e: "cball a e \<subseteq> T"
       using \<open>open T\<close> \<open>a \<in> T\<close> by (auto simp: open_contains_cball)
     have "openin (top_of_set S) {a}"
       unfolding openin_open using that \<open>a \<in> S\<close> by blast
     moreover have "closedin (top_of_set S) {a}"
       by (simp add: assms)
     ultimately show "False"
       using \<open>connected S\<close> connected_clopen S by blast
   qed
   then show ?thesis
     unfolding islimpt_def by blast
 qed
 
 lemma connected_imp_perfect_aff_dim:
      "\<lbrakk>connected S; aff_dim S \<noteq> 0; a \<in> S\<rbrakk> \<Longrightarrow> a islimpt S"
   using aff_dim_sing connected_imp_perfect by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>On \<open>real\<close>, \<open>is_interval\<close>, \<open>convex\<close> and \<open>connected\<close> are all equivalent\<close>
 
 lemma mem_is_interval_1_I:
   fixes a b c::real
   assumes "is_interval S"
   assumes "a \<in> S" "c \<in> S"
   assumes "a \<le> b" "b \<le> c"
   shows "b \<in> S"
   using assms is_interval_1 by blast
 
 lemma is_interval_connected_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> connected s"
   apply rule
   apply (rule is_interval_connected, assumption)
   unfolding is_interval_1
   apply rule
   apply rule
   apply rule
   apply rule
   apply (erule conjE)
   apply (rule ccontr)       
 proof -
   fix a b x
   assume as: "connected s" "a \<in> s" "b \<in> s" "a \<le> x" "x \<le> b" "x \<notin> s"
   then have *: "a < x" "x < b"
     unfolding not_le [symmetric] by auto
   let ?halfl = "{..<x} "
   let ?halfr = "{x<..}"
   {
     fix y
     assume "y \<in> s"
     with \<open>x \<notin> s\<close> have "x \<noteq> y" by auto
     then have "y \<in> ?halfr \<union> ?halfl" by auto
   }
   moreover have "a \<in> ?halfl" "b \<in> ?halfr" using * by auto
   then have "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}"
     using as(2-3) by auto
   ultimately show False
     apply (rule_tac notE[OF as(1)[unfolded connected_def]])
     apply (rule_tac x = ?halfl in exI)
     apply (rule_tac x = ?halfr in exI, rule)
     apply (rule open_lessThan, rule)
     apply (rule open_greaterThan, auto)
     done
 qed
 
 lemma is_interval_convex_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> convex s"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma connected_compact_interval_1:
      "connected S \<and> compact S \<longleftrightarrow> (\<exists>a b. S = {a..b::real})"
   by (auto simp: is_interval_connected_1 [symmetric] is_interval_compact)
 
 lemma connected_convex_1:
   fixes s :: "real set"
   shows "connected s \<longleftrightarrow> convex s"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma connected_convex_1_gen:
   fixes s :: "'a :: euclidean_space set"
   assumes "DIM('a) = 1"
   shows "connected s \<longleftrightarrow> convex s"
 proof -
   obtain f:: "'a \<Rightarrow> real" where linf: "linear f" and "inj f"
     using subspace_isomorphism[OF subspace_UNIV subspace_UNIV,
         where 'a='a and 'b=real]
     unfolding Euclidean_Space.dim_UNIV
     by (auto simp: assms)
   then have "f -` (f ` s) = s"
     by (simp add: inj_vimage_image_eq)
   then show ?thesis
     by (metis connected_convex_1 convex_linear_vimage linf convex_connected connected_linear_image)
 qed
 
 lemma [simp]:
   fixes r s::real
   shows is_interval_io: "is_interval {..<r}"
     and is_interval_oi: "is_interval {r<..}"
     and is_interval_oo: "is_interval {r<..<s}"
     and is_interval_oc: "is_interval {r<..s}"
     and is_interval_co: "is_interval {r..<s}"
   by (simp_all add: is_interval_convex_1)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Another intermediate value theorem formulation\<close>
 
 lemma ivt_increasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f a)\<bullet>k \<le> y" "y \<le> (f b)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
 proof -
   have "f a \<in> f ` cbox a b" "f b \<in> f ` cbox a b"
     apply (rule_tac[!] imageI)
     using assms(1)
     apply auto
     done
   then show ?thesis
     using connected_ivt_component[of "f ` cbox a b" "f a" "f b" k y]
     by (simp add: connected_continuous_image assms)
 qed
 
 lemma ivt_increasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f a\<bullet>k \<le> y \<Longrightarrow> y \<le> f b\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_increasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 lemma ivt_decreasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f b)\<bullet>k \<le> y"
     and "y \<le> (f a)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   apply (subst neg_equal_iff_equal[symmetric])
   using ivt_increasing_component_on_1[of a b "\<lambda>x. - f x" k "- y"]
   using assms using continuous_on_minus
   apply auto
   done
 
 lemma ivt_decreasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f b\<bullet>k \<le> y \<Longrightarrow> y \<le> f a\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_decreasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within an interval\<close>
 
 lemma convex_hull_eq_real_cbox:
   fixes x y :: real assumes "x \<le> y"
   shows "convex hull {x, y} = cbox x y"
 proof (rule hull_unique)
   show "{x, y} \<subseteq> cbox x y" using \<open>x \<le> y\<close> by auto
   show "convex (cbox x y)"
     by (rule convex_box)
 next
   fix S assume "{x, y} \<subseteq> S" and "convex S"
   then show "cbox x y \<subseteq> S"
     unfolding is_interval_convex_1 [symmetric] is_interval_def Basis_real_def
     by - (clarify, simp (no_asm_use), fast)
 qed
 
 lemma unit_interval_convex_hull:
   "cbox (0::'a::euclidean_space) One = convex hull {x. \<forall>i\<in>Basis. (x\<bullet>i = 0) \<or> (x\<bullet>i = 1)}"
   (is "?int = convex hull ?points")
 proof -
   have One[simp]: "\<And>i. i \<in> Basis \<Longrightarrow> One \<bullet> i = 1"
     by (simp add: inner_sum_left sum.If_cases inner_Basis)
   have "?int = {x. \<forall>i\<in>Basis. x \<bullet> i \<in> cbox 0 1}"
     by (auto simp: cbox_def)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` cbox 0 1)"
     by (simp only: box_eq_set_sum_Basis)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (convex hull {0, 1}))"
     by (simp only: convex_hull_eq_real_cbox zero_le_one)
   also have "\<dots> = (\<Sum>i\<in>Basis. convex hull ((\<lambda>x. x *\<^sub>R i) ` {0, 1}))"
     by (simp add: convex_hull_linear_image)
   also have "\<dots> = convex hull (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` {0, 1})"
     by (simp only: convex_hull_set_sum)
   also have "\<dots> = convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}}"
     by (simp only: box_eq_set_sum_Basis)
   also have "convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}} = convex hull ?points"
     by simp
   finally show ?thesis .
 qed
 
 text \<open>And this is a finite set of vertices.\<close>
 
 lemma unit_cube_convex_hull:
   obtains S :: "'a::euclidean_space set"
   where "finite S" and "cbox 0 (\<Sum>Basis) = convex hull S"
 proof
   show "finite {x::'a. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
   proof (rule finite_subset, clarify)
     show "finite ((\<lambda>S. \<Sum>i\<in>Basis. (if i \<in> S then 1 else 0) *\<^sub>R i) ` Pow Basis)"
       using finite_Basis by blast
     fix x :: 'a
     assume as: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1"
     show "x \<in> (\<lambda>S. \<Sum>i\<in>Basis. (if i\<in>S then 1 else 0) *\<^sub>R i) ` Pow Basis"
       apply (rule image_eqI[where x="{i. i\<in>Basis \<and> x\<bullet>i = 1}"])
       using as
        apply (subst euclidean_eq_iff, auto)
       done
   qed
   show "cbox 0 One = convex hull {x. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
     using unit_interval_convex_hull by blast
 qed 
 
 text \<open>Hence any cube (could do any nonempty interval).\<close>
 
 lemma cube_convex_hull:
   assumes "d > 0"
   obtains S :: "'a::euclidean_space set" where
     "finite S" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull S"
 proof -
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   have *: "cbox (x - ?d) (x + ?d) = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 (\<Sum>Basis)"
   proof (intro set_eqI iffI)
     fix y
     assume "y \<in> cbox (x - ?d) (x + ?d)"
     then have "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> cbox 0 (\<Sum>Basis)"
       using assms by (simp add: mem_box inner_simps) (simp add: field_simps)
     with \<open>0 < d\<close> show "y \<in> (\<lambda>y. x - sum ((*\<^sub>R) d) Basis + (2 * d) *\<^sub>R y) ` cbox 0 One"
       by (auto intro: image_eqI[where x= "inverse (2 * d) *\<^sub>R (y - (x - ?d))"])
   next
     fix y
     assume "y \<in> (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 One"
     then obtain z where z: "z \<in> cbox 0 One" "y = x - ?d + (2*d) *\<^sub>R z"
       by auto
     then show "y \<in> cbox (x - ?d) (x + ?d)"
       using z assms by (auto simp: mem_box inner_simps)
   qed
   obtain S where "finite S" "cbox 0 (\<Sum>Basis::'a) = convex hull S"
     using unit_cube_convex_hull by auto
   then show ?thesis
     by (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` S"]) (auto simp: convex_hull_affinity *)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Representation of any interval as a finite convex hull\<close>
 
 lemma image_stretch_interval:
   "(\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k)) *\<^sub>R k) ` cbox a (b::'a::euclidean_space) =
   (if (cbox a b) = {} then {} else
     cbox (\<Sum>k\<in>Basis. (min (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k::'a)
      (\<Sum>k\<in>Basis. (max (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k))"
 proof cases
   assume *: "cbox a b \<noteq> {}"
   show ?thesis
     unfolding box_ne_empty if_not_P[OF *]
     apply (simp add: cbox_def image_Collect set_eq_iff euclidean_eq_iff[where 'a='a] ball_conj_distrib[symmetric])
     apply (subst choice_Basis_iff[symmetric])
   proof (intro allI ball_cong refl)
     fix x i :: 'a assume "i \<in> Basis"
     with * have a_le_b: "a \<bullet> i \<le> b \<bullet> i"
       unfolding box_ne_empty by auto
     show "(\<exists>xa. x \<bullet> i = m i * xa \<and> a \<bullet> i \<le> xa \<and> xa \<le> b \<bullet> i) \<longleftrightarrow>
         min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) \<le> x \<bullet> i \<and> x \<bullet> i \<le> max (m i * (a \<bullet> i)) (m i * (b \<bullet> i))"
     proof (cases "m i = 0")
       case True
       with a_le_b show ?thesis by auto
     next
       case False
       then have *: "\<And>a b. a = m i * b \<longleftrightarrow> b = a / m i"
         by (auto simp: field_simps)
       from False have
           "min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (a \<bullet> i) else m i * (b \<bullet> i))"
           "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (b \<bullet> i) else m i * (a \<bullet> i))"
         using a_le_b by (auto simp: min_def max_def mult_le_cancel_left)
       with False show ?thesis using a_le_b
         unfolding * by (auto simp: le_divide_eq divide_le_eq ac_simps)
     qed
   qed
 qed simp
 
 lemma interval_image_stretch_interval:
   "\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` cbox a (b::'a::euclidean_space) = cbox u (v::'a::euclidean_space)"
   unfolding image_stretch_interval by auto
 
 lemma cbox_translation: "cbox (c + a) (c + b) = image (\<lambda>x. c + x) (cbox a b)"
   using image_affinity_cbox [of 1 c a b]
   using box_ne_empty [of "a+c" "b+c"]  box_ne_empty [of a b]
   by (auto simp: inner_left_distrib add.commute)
 
 lemma cbox_image_unit_interval:
   fixes a :: "'a::euclidean_space"
   assumes "cbox a b \<noteq> {}"
     shows "cbox a b =
            (+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` cbox 0 One"
 using assms
 apply (simp add: box_ne_empty image_stretch_interval cbox_translation [symmetric])
 apply (simp add: min_def max_def algebra_simps sum_subtractf euclidean_representation)
 done
 
 lemma closed_interval_as_convex_hull:
   fixes a :: "'a::euclidean_space"
   obtains S where "finite S" "cbox a b = convex hull S"
 proof (cases "cbox a b = {}")
   case True with convex_hull_empty that show ?thesis
     by blast
 next
   case False
   obtain S::"'a set" where "finite S" and eq: "cbox 0 One = convex hull S"
     by (blast intro: unit_cube_convex_hull)
   have lin: "linear (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k)"
     by (rule linear_compose_sum) (auto simp: algebra_simps linearI)
   have "finite ((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` S)"
     by (rule finite_imageI \<open>finite S\<close>)+
   then show ?thesis
     apply (rule that)
     apply (simp add: convex_hull_translation convex_hull_linear_image [OF lin, symmetric])
     apply (simp add: eq [symmetric] cbox_image_unit_interval [OF False])
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounded convex function on open set is continuous\<close>
 
 lemma convex_on_bounded_continuous:
   fixes S :: "('a::real_normed_vector) set"
   assumes "open S"
     and "convex_on S f"
     and "\<forall>x\<in>S. \<bar>f x\<bar> \<le> b"
   shows "continuous_on S f"
   apply (rule continuous_at_imp_continuous_on)
   unfolding continuous_at_real_range
 proof (rule,rule,rule)
   fix x and e :: real
   assume "x \<in> S" "e > 0"
   define B where "B = \<bar>b\<bar> + 1"
   then have B:  "0 < B""\<And>x. x\<in>S \<Longrightarrow> \<bar>f x\<bar> \<le> B"
     using assms(3) by auto 
   obtain k where "k > 0" and k: "cball x k \<subseteq> S"
     using \<open>x \<in> S\<close> assms(1) open_contains_cball_eq by blast
   show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
   proof (intro exI conjI allI impI)
     fix y
     assume as: "norm (y - x) < min (k / 2) (e / (2 * B) * k)"
     show "\<bar>f y - f x\<bar> < e"
     proof (cases "y = x")
       case False
       define t where "t = k / norm (y - x)"
       have "2 < t" "0<t"
         unfolding t_def using as False and \<open>k>0\<close>
         by (auto simp:field_simps)
       have "y \<in> S"
         apply (rule k[THEN subsetD])
         unfolding mem_cball dist_norm
         apply (rule order_trans[of _ "2 * norm (x - y)"])
         using as
         by (auto simp: field_simps norm_minus_commute)
       {
         define w where "w = x + t *\<^sub>R (y - x)"
         have "w \<in> S"
           using \<open>k>0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
         have "(1 / t) *\<^sub>R x + - x + ((t - 1) / t) *\<^sub>R x = (1 / t - 1 + (t - 1) / t) *\<^sub>R x"
           by (auto simp: algebra_simps)
         also have "\<dots> = 0"
           using \<open>t > 0\<close> by (auto simp:field_simps)
         finally have w: "(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y"
           unfolding w_def using False and \<open>t > 0\<close>
           by (auto simp: algebra_simps)
         have 2: "2 * B < e * t"
           unfolding t_def using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
           by (auto simp:field_simps)
         have "f y - f x \<le> (f w - f x) / t"
           using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
           using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> S\<close> \<open>w \<in> S\<close>
           by (auto simp:field_simps)
         also have "... < e"
           using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>x\<in>S\<close>] 2 \<open>t > 0\<close> by (auto simp: field_simps)
         finally have th1: "f y - f x < e" .
       }
       moreover
       {
         define w where "w = x - t *\<^sub>R (y - x)"
         have "w \<in> S"
           using \<open>k > 0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
         have "(1 / (1 + t)) *\<^sub>R x + (t / (1 + t)) *\<^sub>R x = (1 / (1 + t) + t / (1 + t)) *\<^sub>R x"
           by (auto simp: algebra_simps)
         also have "\<dots> = x"
           using \<open>t > 0\<close> by (auto simp:field_simps)
         finally have w: "(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x"
           unfolding w_def using False and \<open>t > 0\<close>
           by (auto simp: algebra_simps)
         have "2 * B < e * t"
           unfolding t_def
           using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
           by (auto simp:field_simps)
         then have *: "(f w - f y) / t < e"
           using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>y\<in>S\<close>]
           using \<open>t > 0\<close>
           by (auto simp:field_simps)
         have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
           using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
           using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> S\<close> \<open>w \<in> S\<close>
           by (auto simp:field_simps)
         also have "\<dots> = (f w + t * f y) / (1 + t)"
           using \<open>t > 0\<close> by (simp add: add_divide_distrib) 
         also have "\<dots> < e + f y"
           using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp: field_simps)
         finally have "f x - f y < e" by auto
       }
       ultimately show ?thesis by auto
     qed (insert \<open>0<e\<close>, auto)
   qed (insert \<open>0<e\<close> \<open>0<k\<close> \<open>0<B\<close>, auto simp: field_simps)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Upper bound on a ball implies upper and lower bounds\<close>
 
 lemma convex_bounds_lemma:
   fixes x :: "'a::real_normed_vector"
   assumes "convex_on (cball x e) f"
     and "\<forall>y \<in> cball x e. f y \<le> b"
   shows "\<forall>y \<in> cball x e. \<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
   apply rule
 proof (cases "0 \<le> e")
   case True
   fix y
   assume y: "y \<in> cball x e"
   define z where "z = 2 *\<^sub>R x - y"
   have *: "x - (2 *\<^sub>R x - y) = y - x"
     by (simp add: scaleR_2)
   have z: "z \<in> cball x e"
     using y unfolding z_def mem_cball dist_norm * by (auto simp: norm_minus_commute)
   have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x"
     unfolding z_def by (auto simp: algebra_simps)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using assms(1)[unfolded convex_on_def,rule_format, OF y z, of "1/2" "1/2"]
     using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z]
     by (auto simp:field_simps)
 next
   case False
   fix y
   assume "y \<in> cball x e"
   then have "dist x y < 0"
     using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using zero_le_dist[of x y] by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence a convex function on an open set is continuous\<close>
 
 lemma real_of_nat_ge_one_iff: "1 \<le> real (n::nat) \<longleftrightarrow> 1 \<le> n"
   by auto
 
 lemma convex_on_continuous:
   assumes "open (s::('a::euclidean_space) set)" "convex_on s f"
   shows "continuous_on s f"
   unfolding continuous_on_eq_continuous_at[OF assms(1)]
 proof
   note dimge1 = DIM_positive[where 'a='a]
   fix x
   assume "x \<in> s"
   then obtain e where e: "cball x e \<subseteq> s" "e > 0"
     using assms(1) unfolding open_contains_cball by auto
   define d where "d = e / real DIM('a)"
   have "0 < d"
     unfolding d_def using \<open>e > 0\<close> dimge1 by auto
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   obtain c
     where c: "finite c"
     and c1: "convex hull c \<subseteq> cball x e"
     and c2: "cball x d \<subseteq> convex hull c"
   proof
     define c where "c = (\<Sum>i\<in>Basis. (\<lambda>a. a *\<^sub>R i) ` {x\<bullet>i - d, x\<bullet>i + d})"
     show "finite c"
       unfolding c_def by (simp add: finite_set_sum)
     have 1: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cbox (x \<bullet> i - d) (x \<bullet> i + d)}"
       unfolding box_eq_set_sum_Basis
       unfolding c_def convex_hull_set_sum
       apply (subst convex_hull_linear_image [symmetric])
       apply (simp add: linear_iff scaleR_add_left)
       apply (rule sum.cong [OF refl])
       apply (rule image_cong [OF _ refl])
       apply (rule convex_hull_eq_real_cbox)
       apply (cut_tac \<open>0 < d\<close>, simp)
       done
     then have 2: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cball (x \<bullet> i) d}"
       by (simp add: dist_norm abs_le_iff algebra_simps)
     show "cball x d \<subseteq> convex hull c"
       unfolding 2
       by (clarsimp simp: dist_norm) (metis inner_commute inner_diff_right norm_bound_Basis_le)
     have e': "e = (\<Sum>(i::'a)\<in>Basis. d)"
-      by (simp add: d_def DIM_positive)
+      by (simp add: d_def)
     show "convex hull c \<subseteq> cball x e"
       unfolding 2
       apply clarsimp
       apply (subst euclidean_dist_l2)
       apply (rule order_trans [OF L2_set_le_sum])
       apply (rule zero_le_dist)
       unfolding e'
       apply (rule sum_mono, simp)
       done
   qed
   define k where "k = Max (f ` c)"
   have "convex_on (convex hull c) f"
     apply(rule convex_on_subset[OF assms(2)])
     apply(rule subset_trans[OF c1 e(1)])
     done
   then have k: "\<forall>y\<in>convex hull c. f y \<le> k"
     apply (rule_tac convex_on_convex_hull_bound, assumption)
     by (simp add: k_def c)
   have "e \<le> e * real DIM('a)"
     using e(2) real_of_nat_ge_one_iff by auto
   then have "d \<le> e"
     by (simp add: d_def field_split_simps)
   then have dsube: "cball x d \<subseteq> cball x e"
     by (rule subset_cball)
   have conv: "convex_on (cball x d) f"
     using \<open>convex_on (convex hull c) f\<close> c2 convex_on_subset by blast
   then have "\<forall>y\<in>cball x d. \<bar>f y\<bar> \<le> k + 2 * \<bar>f x\<bar>"
     by (rule convex_bounds_lemma) (use c2 k in blast)
   then have "continuous_on (ball x d) f"
     apply (rule_tac convex_on_bounded_continuous)
     apply (rule open_ball, rule convex_on_subset[OF conv])
     apply (rule ball_subset_cball, force)
     done
   then show "continuous (at x) f"
     unfolding continuous_on_eq_continuous_at[OF open_ball]
     using \<open>d > 0\<close> by auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Extended_Real_Limits.thy b/src/HOL/Analysis/Extended_Real_Limits.thy
--- a/src/HOL/Analysis/Extended_Real_Limits.thy
+++ b/src/HOL/Analysis/Extended_Real_Limits.thy
@@ -1,1782 +1,1782 @@
 (*  Title:      HOL/Analysis/Extended_Real_Limits.thy
     Author:     Johannes Hölzl, TU München
     Author:     Robert Himmelmann, TU München
     Author:     Armin Heller, TU München
     Author:     Bogdan Grechuk, University of Edinburgh
 *)
 
 section \<open>Limits on the Extended Real Number Line\<close> (* TO FIX: perhaps put all Nonstandard Analysis related
 topics together? *)
 
 theory Extended_Real_Limits
 imports
   Topology_Euclidean_Space
   "HOL-Library.Extended_Real"
   "HOL-Library.Extended_Nonnegative_Real"
   "HOL-Library.Indicator_Function"
 begin
 
 lemma compact_UNIV:
   "compact (UNIV :: 'a::{complete_linorder,linorder_topology,second_countable_topology} set)"
   using compact_complete_linorder
   by (auto simp: seq_compact_eq_compact[symmetric] seq_compact_def)
 
 lemma compact_eq_closed:
   fixes S :: "'a::{complete_linorder,linorder_topology,second_countable_topology} set"
   shows "compact S \<longleftrightarrow> closed S"
   using closed_Int_compact[of S, OF _ compact_UNIV] compact_imp_closed
   by auto
 
 lemma closed_contains_Sup_cl:
   fixes S :: "'a::{complete_linorder,linorder_topology,second_countable_topology} set"
   assumes "closed S"
     and "S \<noteq> {}"
   shows "Sup S \<in> S"
 proof -
   from compact_eq_closed[of S] compact_attains_sup[of S] assms
   obtain s where S: "s \<in> S" "\<forall>t\<in>S. t \<le> s"
     by auto
   then have "Sup S = s"
     by (auto intro!: Sup_eqI)
   with S show ?thesis
     by simp
 qed
 
 lemma closed_contains_Inf_cl:
   fixes S :: "'a::{complete_linorder,linorder_topology,second_countable_topology} set"
   assumes "closed S"
     and "S \<noteq> {}"
   shows "Inf S \<in> S"
 proof -
   from compact_eq_closed[of S] compact_attains_inf[of S] assms
   obtain s where S: "s \<in> S" "\<forall>t\<in>S. s \<le> t"
     by auto
   then have "Inf S = s"
     by (auto intro!: Inf_eqI)
   with S show ?thesis
     by simp
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> enat :: second_countable_topology
 proof
   show "\<exists>B::enat set set. countable B \<and> open = generate_topology B"
   proof (intro exI conjI)
     show "countable (range lessThan \<union> range greaterThan::enat set set)"
       by auto
   qed (simp add: open_enat_def)
 qed
 
 instance\<^marker>\<open>tag unimportant\<close> ereal :: second_countable_topology
 proof (standard, intro exI conjI)
   let ?B = "(\<Union>r\<in>\<rat>. {{..< r}, {r <..}} :: ereal set set)"
   show "countable ?B"
     by (auto intro: countable_rat)
   show "open = generate_topology ?B"
   proof (intro ext iffI)
     fix S :: "ereal set"
     assume "open S"
     then show "generate_topology ?B S"
       unfolding open_generated_order
     proof induct
       case (Basis b)
       then obtain e where "b = {..<e} \<or> b = {e<..}"
         by auto
       moreover have "{..<e} = \<Union>{{..<x}|x. x \<in> \<rat> \<and> x < e}" "{e<..} = \<Union>{{x<..}|x. x \<in> \<rat> \<and> e < x}"
         by (auto dest: ereal_dense3
                  simp del: ex_simps
                  simp add: ex_simps[symmetric] conj_commute Rats_def image_iff)
       ultimately show ?case
         by (auto intro: generate_topology.intros)
     qed (auto intro: generate_topology.intros)
   next
     fix S
     assume "generate_topology ?B S"
     then show "open S"
       by induct auto
   qed
 qed
 
 text \<open>This is a copy from \<open>ereal :: second_countable_topology\<close>. Maybe find a common super class of
 topological spaces where the rational numbers are densely embedded ?\<close>
 instance ennreal :: second_countable_topology
 proof (standard, intro exI conjI)
   let ?B = "(\<Union>r\<in>\<rat>. {{..< r}, {r <..}} :: ennreal set set)"
   show "countable ?B"
     by (auto intro: countable_rat)
   show "open = generate_topology ?B"
   proof (intro ext iffI)
     fix S :: "ennreal set"
     assume "open S"
     then show "generate_topology ?B S"
       unfolding open_generated_order
     proof induct
       case (Basis b)
       then obtain e where "b = {..<e} \<or> b = {e<..}"
         by auto
       moreover have "{..<e} = \<Union>{{..<x}|x. x \<in> \<rat> \<and> x < e}" "{e<..} = \<Union>{{x<..}|x. x \<in> \<rat> \<and> e < x}"
         by (auto dest: ennreal_rat_dense
                  simp del: ex_simps
                  simp add: ex_simps[symmetric] conj_commute Rats_def image_iff)
       ultimately show ?case
         by (auto intro: generate_topology.intros)
     qed (auto intro: generate_topology.intros)
   next
     fix S
     assume "generate_topology ?B S"
     then show "open S"
       by induct auto
   qed
 qed
 
 lemma ereal_open_closed_aux:
   fixes S :: "ereal set"
   assumes "open S"
     and "closed S"
     and S: "(-\<infinity>) \<notin> S"
   shows "S = {}"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have *: "Inf S \<in> S"
 
     by (metis assms(2) closed_contains_Inf_cl)
   {
     assume "Inf S = -\<infinity>"
     then have False
       using * assms(3) by auto
   }
   moreover
   {
     assume "Inf S = \<infinity>"
     then have "S = {\<infinity>}"
       by (metis Inf_eq_PInfty \<open>S \<noteq> {}\<close>)
     then have False
       by (metis assms(1) not_open_singleton)
   }
   moreover
   {
     assume fin: "\<bar>Inf S\<bar> \<noteq> \<infinity>"
     from ereal_open_cont_interval[OF assms(1) * fin]
     obtain e where e: "e > 0" "{Inf S - e<..<Inf S + e} \<subseteq> S" .
     then obtain b where b: "Inf S - e < b" "b < Inf S"
       using fin ereal_between[of "Inf S" e] dense[of "Inf S - e"]
       by auto
     then have "b \<in> {Inf S - e <..< Inf S + e}"
       using e fin ereal_between[of "Inf S" e]
       by auto
     then have "b \<in> S"
       using e by auto
     then have False
       using b by (metis complete_lattice_class.Inf_lower leD)
   }
   ultimately show False
     by auto
 qed
 
 lemma ereal_open_closed:
   fixes S :: "ereal set"
   shows "open S \<and> closed S \<longleftrightarrow> S = {} \<or> S = UNIV"
 proof -
   {
     assume lhs: "open S \<and> closed S"
     {
       assume "-\<infinity> \<notin> S"
       then have "S = {}"
         using lhs ereal_open_closed_aux by auto
     }
     moreover
     {
       assume "-\<infinity> \<in> S"
       then have "- S = {}"
         using lhs ereal_open_closed_aux[of "-S"] by auto
     }
     ultimately have "S = {} \<or> S = UNIV"
       by auto
   }
   then show ?thesis
     by auto
 qed
 
 lemma ereal_open_atLeast:
   fixes x :: ereal
   shows "open {x..} \<longleftrightarrow> x = -\<infinity>"
 proof
   assume "x = -\<infinity>"
   then have "{x..} = UNIV"
     by auto
   then show "open {x..}"
     by auto
 next
   assume "open {x..}"
   then have "open {x..} \<and> closed {x..}"
     by auto
   then have "{x..} = UNIV"
     unfolding ereal_open_closed by auto
   then show "x = -\<infinity>"
     by (simp add: bot_ereal_def atLeast_eq_UNIV_iff)
 qed
 
 lemma mono_closed_real:
   fixes S :: "real set"
   assumes mono: "\<forall>y z. y \<in> S \<and> y \<le> z \<longrightarrow> z \<in> S"
     and "closed S"
   shows "S = {} \<or> S = UNIV \<or> (\<exists>a. S = {a..})"
 proof -
   {
     assume "S \<noteq> {}"
     { assume ex: "\<exists>B. \<forall>x\<in>S. B \<le> x"
       then have *: "\<forall>x\<in>S. Inf S \<le> x"
         using cInf_lower[of _ S] ex by (metis bdd_below_def)
       then have "Inf S \<in> S"
         apply (subst closed_contains_Inf)
         using ex \<open>S \<noteq> {}\<close> \<open>closed S\<close>
         apply auto
         done
       then have "\<forall>x. Inf S \<le> x \<longleftrightarrow> x \<in> S"
         using mono[rule_format, of "Inf S"] *
         by auto
       then have "S = {Inf S ..}"
         by auto
       then have "\<exists>a. S = {a ..}"
         by auto
     }
     moreover
     {
       assume "\<not> (\<exists>B. \<forall>x\<in>S. B \<le> x)"
       then have nex: "\<forall>B. \<exists>x\<in>S. x < B"
         by (simp add: not_le)
       {
         fix y
         obtain x where "x\<in>S" and "x < y"
           using nex by auto
         then have "y \<in> S"
           using mono[rule_format, of x y] by auto
       }
       then have "S = UNIV"
         by auto
     }
     ultimately have "S = UNIV \<or> (\<exists>a. S = {a ..})"
       by blast
   }
   then show ?thesis
     by blast
 qed
 
 lemma mono_closed_ereal:
   fixes S :: "real set"
   assumes mono: "\<forall>y z. y \<in> S \<and> y \<le> z \<longrightarrow> z \<in> S"
     and "closed S"
   shows "\<exists>a. S = {x. a \<le> ereal x}"
 proof -
   {
     assume "S = {}"
     then have ?thesis
       apply (rule_tac x=PInfty in exI)
       apply auto
       done
   }
   moreover
   {
     assume "S = UNIV"
     then have ?thesis
       apply (rule_tac x="-\<infinity>" in exI)
       apply auto
       done
   }
   moreover
   {
     assume "\<exists>a. S = {a ..}"
     then obtain a where "S = {a ..}"
       by auto
     then have ?thesis
       apply (rule_tac x="ereal a" in exI)
       apply auto
       done
   }
   ultimately show ?thesis
     using mono_closed_real[of S] assms by auto
 qed
 
 lemma Liminf_within:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::complete_lattice"
   shows "Liminf (at x within S) f = (SUP e\<in>{0<..}. INF y\<in>(S \<inter> ball x e - {x}). f y)"
   unfolding Liminf_def eventually_at
 proof (rule SUP_eq, simp_all add: Ball_def Bex_def, safe)
   fix P d
   assume "0 < d" and "\<forall>y. y \<in> S \<longrightarrow> y \<noteq> x \<and> dist y x < d \<longrightarrow> P y"
   then have "S \<inter> ball x d - {x} \<subseteq> {x. P x}"
     by (auto simp: zero_less_dist_iff dist_commute)
   then show "\<exists>r>0. Inf (f ` (Collect P)) \<le> Inf (f ` (S \<inter> ball x r - {x}))"
     by (intro exI[of _ d] INF_mono conjI \<open>0 < d\<close>) auto
 next
   fix d :: real
   assume "0 < d"
   then show "\<exists>P. (\<exists>d>0. \<forall>xa. xa \<in> S \<longrightarrow> xa \<noteq> x \<and> dist xa x < d \<longrightarrow> P xa) \<and>
     Inf (f ` (S \<inter> ball x d - {x})) \<le> Inf (f ` (Collect P))"
     by (intro exI[of _ "\<lambda>y. y \<in> S \<inter> ball x d - {x}"])
        (auto intro!: INF_mono exI[of _ d] simp: dist_commute)
 qed
 
 lemma Limsup_within:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::complete_lattice"
   shows "Limsup (at x within S) f = (INF e\<in>{0<..}. SUP y\<in>(S \<inter> ball x e - {x}). f y)"
   unfolding Limsup_def eventually_at
 proof (rule INF_eq, simp_all add: Ball_def Bex_def, safe)
   fix P d
   assume "0 < d" and "\<forall>y. y \<in> S \<longrightarrow> y \<noteq> x \<and> dist y x < d \<longrightarrow> P y"
   then have "S \<inter> ball x d - {x} \<subseteq> {x. P x}"
     by (auto simp: zero_less_dist_iff dist_commute)
   then show "\<exists>r>0. Sup (f ` (S \<inter> ball x r - {x})) \<le> Sup (f ` (Collect P))"
     by (intro exI[of _ d] SUP_mono conjI \<open>0 < d\<close>) auto
 next
   fix d :: real
   assume "0 < d"
   then show "\<exists>P. (\<exists>d>0. \<forall>xa. xa \<in> S \<longrightarrow> xa \<noteq> x \<and> dist xa x < d \<longrightarrow> P xa) \<and>
     Sup (f ` (Collect P)) \<le> Sup (f ` (S \<inter> ball x d - {x}))"
     by (intro exI[of _ "\<lambda>y. y \<in> S \<inter> ball x d - {x}"])
        (auto intro!: SUP_mono exI[of _ d] simp: dist_commute)
 qed
 
 lemma Liminf_at:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::complete_lattice"
   shows "Liminf (at x) f = (SUP e\<in>{0<..}. INF y\<in>(ball x e - {x}). f y)"
   using Liminf_within[of x UNIV f] by simp
 
 lemma Limsup_at:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::complete_lattice"
   shows "Limsup (at x) f = (INF e\<in>{0<..}. SUP y\<in>(ball x e - {x}). f y)"
   using Limsup_within[of x UNIV f] by simp
 
 lemma min_Liminf_at:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::complete_linorder"
   shows "min (f x) (Liminf (at x) f) = (SUP e\<in>{0<..}. INF y\<in>ball x e. f y)"
   apply (simp add: inf_min [symmetric] Liminf_at)
   apply (subst inf_commute)
   apply (subst SUP_inf)
   apply auto
   apply (metis (no_types, lifting) INF_insert centre_in_ball greaterThan_iff image_cong inf_commute insert_Diff)
   done
 
 
 subsection \<open>Extended-Real.thy\<close> (*FIX ME change title *)
 
 lemma sum_constant_ereal:
   fixes a::ereal
   shows "(\<Sum>i\<in>I. a) = a * card I"
 apply (cases "finite I", induct set: finite, simp_all)
 apply (cases a, auto, metis (no_types, hide_lams) add.commute mult.commute semiring_normalization_rules(3))
 done
 
 lemma real_lim_then_eventually_real:
   assumes "(u \<longlongrightarrow> ereal l) F"
   shows "eventually (\<lambda>n. u n = ereal(real_of_ereal(u n))) F"
 proof -
   have "ereal l \<in> {-\<infinity><..<(\<infinity>::ereal)}" by simp
   moreover have "open {-\<infinity><..<(\<infinity>::ereal)}" by simp
   ultimately have "eventually (\<lambda>n. u n \<in> {-\<infinity><..<(\<infinity>::ereal)}) F" using assms tendsto_def by blast
   moreover have "\<And>x. x \<in> {-\<infinity><..<(\<infinity>::ereal)} \<Longrightarrow> x = ereal(real_of_ereal x)" using ereal_real by auto
   ultimately show ?thesis by (metis (mono_tags, lifting) eventually_mono)
 qed
 
 lemma ereal_Inf_cmult:
   assumes "c>(0::real)"
   shows "Inf {ereal c * x |x. P x} = ereal c * Inf {x. P x}"
 proof -
   have "(\<lambda>x::ereal. c * x) (Inf {x::ereal. P x}) = Inf ((\<lambda>x::ereal. c * x)`{x::ereal. P x})"
     apply (rule mono_bij_Inf)
     apply (simp add: assms ereal_mult_left_mono less_imp_le mono_def)
     apply (rule bij_betw_byWitness[of _ "\<lambda>x. (x::ereal) / c"], auto simp add: assms ereal_mult_divide)
     using assms ereal_divide_eq apply auto
     done
   then show ?thesis by (simp only: setcompr_eq_image[symmetric])
 qed
 
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Continuity of addition\<close>
 
 text \<open>The next few lemmas remove an unnecessary assumption in \<open>tendsto_add_ereal\<close>, culminating
 in \<open>tendsto_add_ereal_general\<close> which essentially says that the addition
 is continuous on ereal times ereal, except at \<open>(-\<infinity>, \<infinity>)\<close> and \<open>(\<infinity>, -\<infinity>)\<close>.
 It is much more convenient in many situations, see for instance the proof of
 \<open>tendsto_sum_ereal\<close> below.\<close>
 
 lemma tendsto_add_ereal_PInf:
   fixes y :: ereal
   assumes y: "y \<noteq> -\<infinity>"
   assumes f: "(f \<longlongrightarrow> \<infinity>) F" and g: "(g \<longlongrightarrow> y) F"
   shows "((\<lambda>x. f x + g x) \<longlongrightarrow> \<infinity>) F"
 proof -
   have "\<exists>C. eventually (\<lambda>x. g x > ereal C) F"
   proof (cases y)
     case (real r)
     have "y > y-1" using y real by (simp add: ereal_between(1))
     then have "eventually (\<lambda>x. g x > y - 1) F" using g y order_tendsto_iff by auto
     moreover have "y-1 = ereal(real_of_ereal(y-1))"
       by (metis real ereal_eq_1(1) ereal_minus(1) real_of_ereal.simps(1))
     ultimately have "eventually (\<lambda>x. g x > ereal(real_of_ereal(y - 1))) F" by simp
     then show ?thesis by auto
   next
     case (PInf)
     have "eventually (\<lambda>x. g x > ereal 0) F" using g PInf by (simp add: tendsto_PInfty)
     then show ?thesis by auto
   qed (simp add: y)
   then obtain C::real where ge: "eventually (\<lambda>x. g x > ereal C) F" by auto
 
   {
     fix M::real
     have "eventually (\<lambda>x. f x > ereal(M - C)) F" using f by (simp add: tendsto_PInfty)
     then have "eventually (\<lambda>x. (f x > ereal (M-C)) \<and> (g x > ereal C)) F"
       by (auto simp add: ge eventually_conj_iff)
     moreover have "\<And>x. ((f x > ereal (M-C)) \<and> (g x > ereal C)) \<Longrightarrow> (f x + g x > ereal M)"
       using ereal_add_strict_mono2 by fastforce
     ultimately have "eventually (\<lambda>x. f x + g x > ereal M) F" using eventually_mono by force
   }
   then show ?thesis by (simp add: tendsto_PInfty)
 qed
 
 text\<open>One would like to deduce the next lemma from the previous one, but the fact
 that \<open>- (x + y)\<close> is in general different from \<open>(- x) + (- y)\<close> in ereal creates difficulties,
 so it is more efficient to copy the previous proof.\<close>
 
 lemma tendsto_add_ereal_MInf:
   fixes y :: ereal
   assumes y: "y \<noteq> \<infinity>"
   assumes f: "(f \<longlongrightarrow> -\<infinity>) F" and g: "(g \<longlongrightarrow> y) F"
   shows "((\<lambda>x. f x + g x) \<longlongrightarrow> -\<infinity>) F"
 proof -
   have "\<exists>C. eventually (\<lambda>x. g x < ereal C) F"
   proof (cases y)
     case (real r)
     have "y < y+1" using y real by (simp add: ereal_between(1))
     then have "eventually (\<lambda>x. g x < y + 1) F" using g y order_tendsto_iff by force
     moreover have "y+1 = ereal(real_of_ereal (y+1))" by (simp add: real)
     ultimately have "eventually (\<lambda>x. g x < ereal(real_of_ereal(y + 1))) F" by simp
     then show ?thesis by auto
   next
     case (MInf)
     have "eventually (\<lambda>x. g x < ereal 0) F" using g MInf by (simp add: tendsto_MInfty)
     then show ?thesis by auto
   qed (simp add: y)
   then obtain C::real where ge: "eventually (\<lambda>x. g x < ereal C) F" by auto
 
   {
     fix M::real
     have "eventually (\<lambda>x. f x < ereal(M - C)) F" using f by (simp add: tendsto_MInfty)
     then have "eventually (\<lambda>x. (f x < ereal (M- C)) \<and> (g x < ereal C)) F"
       by (auto simp add: ge eventually_conj_iff)
     moreover have "\<And>x. ((f x < ereal (M-C)) \<and> (g x < ereal C)) \<Longrightarrow> (f x + g x < ereal M)"
       using ereal_add_strict_mono2 by fastforce
     ultimately have "eventually (\<lambda>x. f x + g x < ereal M) F" using eventually_mono by force
   }
   then show ?thesis by (simp add: tendsto_MInfty)
 qed
 
 lemma tendsto_add_ereal_general1:
   fixes x y :: ereal
   assumes y: "\<bar>y\<bar> \<noteq> \<infinity>"
   assumes f: "(f \<longlongrightarrow> x) F" and g: "(g \<longlongrightarrow> y) F"
   shows "((\<lambda>x. f x + g x) \<longlongrightarrow> x + y) F"
 proof (cases x)
   case (real r)
   have a: "\<bar>x\<bar> \<noteq> \<infinity>" by (simp add: real)
   show ?thesis by (rule tendsto_add_ereal[OF a, OF y, OF f, OF g])
 next
   case PInf
   then show ?thesis using tendsto_add_ereal_PInf assms by force
 next
   case MInf
   then show ?thesis using tendsto_add_ereal_MInf assms
     by (metis abs_ereal.simps(3) ereal_MInfty_eq_plus)
 qed
 
 lemma tendsto_add_ereal_general2:
   fixes x y :: ereal
   assumes x: "\<bar>x\<bar> \<noteq> \<infinity>"
       and f: "(f \<longlongrightarrow> x) F" and g: "(g \<longlongrightarrow> y) F"
   shows "((\<lambda>x. f x + g x) \<longlongrightarrow> x + y) F"
 proof -
   have "((\<lambda>x. g x + f x) \<longlongrightarrow> x + y) F"
     using tendsto_add_ereal_general1[OF x, OF g, OF f] add.commute[of "y", of "x"] by simp
   moreover have "\<And>x. g x + f x = f x + g x" using add.commute by auto
   ultimately show ?thesis by simp
 qed
 
 text \<open>The next lemma says that the addition is continuous on \<open>ereal\<close>, except at
 the pairs \<open>(-\<infinity>, \<infinity>)\<close> and \<open>(\<infinity>, -\<infinity>)\<close>.\<close>
 
 lemma tendsto_add_ereal_general [tendsto_intros]:
   fixes x y :: ereal
   assumes "\<not>((x=\<infinity> \<and> y=-\<infinity>) \<or> (x=-\<infinity> \<and> y=\<infinity>))"
       and f: "(f \<longlongrightarrow> x) F" and g: "(g \<longlongrightarrow> y) F"
   shows "((\<lambda>x. f x + g x) \<longlongrightarrow> x + y) F"
 proof (cases x)
   case (real r)
   show ?thesis
     apply (rule tendsto_add_ereal_general2) using real assms by auto
 next
   case (PInf)
   then have "y \<noteq> -\<infinity>" using assms by simp
   then show ?thesis using tendsto_add_ereal_PInf PInf assms by auto
 next
   case (MInf)
   then have "y \<noteq> \<infinity>" using assms by simp
   then show ?thesis using tendsto_add_ereal_MInf MInf f g by (metis ereal_MInfty_eq_plus)
 qed
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Continuity of multiplication\<close>
 
 text \<open>In the same way as for addition, we prove that the multiplication is continuous on
 ereal times ereal, except at \<open>(\<infinity>, 0)\<close> and \<open>(-\<infinity>, 0)\<close> and \<open>(0, \<infinity>)\<close> and \<open>(0, -\<infinity>)\<close>,
 starting with specific situations.\<close>
 
 lemma tendsto_mult_real_ereal:
   assumes "(u \<longlongrightarrow> ereal l) F" "(v \<longlongrightarrow> ereal m) F"
   shows "((\<lambda>n. u n * v n) \<longlongrightarrow> ereal l * ereal m) F"
 proof -
   have ureal: "eventually (\<lambda>n. u n = ereal(real_of_ereal(u n))) F" by (rule real_lim_then_eventually_real[OF assms(1)])
   then have "((\<lambda>n. ereal(real_of_ereal(u n))) \<longlongrightarrow> ereal l) F" using assms by auto
   then have limu: "((\<lambda>n. real_of_ereal(u n)) \<longlongrightarrow> l) F" by auto
   have vreal: "eventually (\<lambda>n. v n = ereal(real_of_ereal(v n))) F" by (rule real_lim_then_eventually_real[OF assms(2)])
   then have "((\<lambda>n. ereal(real_of_ereal(v n))) \<longlongrightarrow> ereal m) F" using assms by auto
   then have limv: "((\<lambda>n. real_of_ereal(v n)) \<longlongrightarrow> m) F" by auto
 
   {
     fix n assume "u n = ereal(real_of_ereal(u n))" "v n = ereal(real_of_ereal(v n))"
     then have "ereal(real_of_ereal(u n) * real_of_ereal(v n)) = u n * v n" by (metis times_ereal.simps(1))
   }
   then have *: "eventually (\<lambda>n. ereal(real_of_ereal(u n) * real_of_ereal(v n)) = u n * v n) F"
     using eventually_elim2[OF ureal vreal] by auto
 
   have "((\<lambda>n. real_of_ereal(u n) * real_of_ereal(v n)) \<longlongrightarrow> l * m) F" using tendsto_mult[OF limu limv] by auto
   then have "((\<lambda>n. ereal(real_of_ereal(u n)) * real_of_ereal(v n)) \<longlongrightarrow> ereal(l * m)) F" by auto
   then show ?thesis using * filterlim_cong by fastforce
 qed
 
 lemma tendsto_mult_ereal_PInf:
   fixes f g::"_ \<Rightarrow> ereal"
   assumes "(f \<longlongrightarrow> l) F" "l>0" "(g \<longlongrightarrow> \<infinity>) F"
   shows "((\<lambda>x. f x * g x) \<longlongrightarrow> \<infinity>) F"
 proof -
   obtain a::real where "0 < ereal a" "a < l" using assms(2) using ereal_dense2 by blast
   have *: "eventually (\<lambda>x. f x > a) F" using \<open>a < l\<close> assms(1) by (simp add: order_tendsto_iff)
   {
     fix K::real
     define M where "M = max K 1"
     then have "M > 0" by simp
     then have "ereal(M/a) > 0" using \<open>ereal a > 0\<close> by simp
     then have "\<And>x. ((f x > a) \<and> (g x > M/a)) \<Longrightarrow> (f x * g x > ereal a * ereal(M/a))"
       using ereal_mult_mono_strict'[where ?c = "M/a", OF \<open>0 < ereal a\<close>] by auto
     moreover have "ereal a * ereal(M/a) = M" using \<open>ereal a > 0\<close> by simp
     ultimately have "\<And>x. ((f x > a) \<and> (g x > M/a)) \<Longrightarrow> (f x * g x > M)" by simp
     moreover have "M \<ge> K" unfolding M_def by simp
     ultimately have Imp: "\<And>x. ((f x > a) \<and> (g x > M/a)) \<Longrightarrow> (f x * g x > K)"
       using ereal_less_eq(3) le_less_trans by blast
 
     have "eventually (\<lambda>x. g x > M/a) F" using assms(3) by (simp add: tendsto_PInfty)
     then have "eventually (\<lambda>x. (f x > a) \<and> (g x > M/a)) F"
       using * by (auto simp add: eventually_conj_iff)
     then have "eventually (\<lambda>x. f x * g x > K) F" using eventually_mono Imp by force
   }
   then show ?thesis by (auto simp add: tendsto_PInfty)
 qed
 
 lemma tendsto_mult_ereal_pos:
   fixes f g::"_ \<Rightarrow> ereal"
   assumes "(f \<longlongrightarrow> l) F" "(g \<longlongrightarrow> m) F" "l>0" "m>0"
   shows "((\<lambda>x. f x * g x) \<longlongrightarrow> l * m) F"
 proof (cases)
   assume *: "l = \<infinity> \<or> m = \<infinity>"
   then show ?thesis
   proof (cases)
     assume "m = \<infinity>"
     then show ?thesis using tendsto_mult_ereal_PInf assms by auto
   next
     assume "\<not>(m = \<infinity>)"
     then have "l = \<infinity>" using * by simp
     then have "((\<lambda>x. g x * f x) \<longlongrightarrow> l * m) F" using tendsto_mult_ereal_PInf assms by auto
     moreover have "\<And>x. g x * f x = f x * g x" using mult.commute by auto
     ultimately show ?thesis by simp
   qed
 next
   assume "\<not>(l = \<infinity> \<or> m = \<infinity>)"
   then have "l < \<infinity>" "m < \<infinity>" by auto
   then obtain lr mr where "l = ereal lr" "m = ereal mr"
     using \<open>l>0\<close> \<open>m>0\<close> by (metis ereal_cases ereal_less(6) not_less_iff_gr_or_eq)
   then show ?thesis using tendsto_mult_real_ereal assms by auto
 qed
 
 text \<open>We reduce the general situation to the positive case by multiplying by suitable signs.
 Unfortunately, as ereal is not a ring, all the neat sign lemmas are not available there. We
 give the bare minimum we need.\<close>
 
 lemma ereal_sgn_abs:
   fixes l::ereal
   shows "sgn(l) * l = abs(l)"
 apply (cases l) by (auto simp add: sgn_if ereal_less_uminus_reorder)
 
 lemma sgn_squared_ereal:
   assumes "l \<noteq> (0::ereal)"
   shows "sgn(l) * sgn(l) = 1"
 apply (cases l) using assms by (auto simp add: one_ereal_def sgn_if)
 
 lemma tendsto_mult_ereal [tendsto_intros]:
   fixes f g::"_ \<Rightarrow> ereal"
   assumes "(f \<longlongrightarrow> l) F" "(g \<longlongrightarrow> m) F" "\<not>((l=0 \<and> abs(m) = \<infinity>) \<or> (m=0 \<and> abs(l) = \<infinity>))"
   shows "((\<lambda>x. f x * g x) \<longlongrightarrow> l * m) F"
 proof (cases)
   assume "l=0 \<or> m=0"
   then have "abs(l) \<noteq> \<infinity>" "abs(m) \<noteq> \<infinity>" using assms(3) by auto
   then obtain lr mr where "l = ereal lr" "m = ereal mr" by auto
   then show ?thesis using tendsto_mult_real_ereal assms by auto
 next
   have sgn_finite: "\<And>a::ereal. abs(sgn a) \<noteq> \<infinity>"
     by (metis MInfty_neq_ereal(2) PInfty_neq_ereal(2) abs_eq_infinity_cases ereal_times(1) ereal_times(3) ereal_uminus_eq_reorder sgn_ereal.elims)
   then have sgn_finite2: "\<And>a b::ereal. abs(sgn a * sgn b) \<noteq> \<infinity>"
     by (metis abs_eq_infinity_cases abs_ereal.simps(2) abs_ereal.simps(3) ereal_mult_eq_MInfty ereal_mult_eq_PInfty)
   assume "\<not>(l=0 \<or> m=0)"
   then have "l \<noteq> 0" "m \<noteq> 0" by auto
   then have "abs(l) > 0" "abs(m) > 0"
     by (metis abs_ereal_ge0 abs_ereal_less0 abs_ereal_pos ereal_uminus_uminus ereal_uminus_zero less_le not_less)+
   then have "sgn(l) * l > 0" "sgn(m) * m > 0" using ereal_sgn_abs by auto
   moreover have "((\<lambda>x. sgn(l) * f x) \<longlongrightarrow> (sgn(l) * l)) F"
     by (rule tendsto_cmult_ereal, auto simp add: sgn_finite assms(1))
   moreover have "((\<lambda>x. sgn(m) * g x) \<longlongrightarrow> (sgn(m) * m)) F"
     by (rule tendsto_cmult_ereal, auto simp add: sgn_finite assms(2))
   ultimately have *: "((\<lambda>x. (sgn(l) * f x) * (sgn(m) * g x)) \<longlongrightarrow> (sgn(l) * l) * (sgn(m) * m)) F"
     using tendsto_mult_ereal_pos by force
   have "((\<lambda>x. (sgn(l) * sgn(m)) * ((sgn(l) * f x) * (sgn(m) * g x))) \<longlongrightarrow> (sgn(l) * sgn(m)) * ((sgn(l) * l) * (sgn(m) * m))) F"
     by (rule tendsto_cmult_ereal, auto simp add: sgn_finite2 *)
   moreover have "\<And>x. (sgn(l) * sgn(m)) * ((sgn(l) * f x) * (sgn(m) * g x)) = f x * g x"
     by (metis mult.left_neutral sgn_squared_ereal[OF \<open>l \<noteq> 0\<close>] sgn_squared_ereal[OF \<open>m \<noteq> 0\<close>] mult.assoc mult.commute)
   moreover have "(sgn(l) * sgn(m)) * ((sgn(l) * l) * (sgn(m) * m)) = l * m"
     by (metis mult.left_neutral sgn_squared_ereal[OF \<open>l \<noteq> 0\<close>] sgn_squared_ereal[OF \<open>m \<noteq> 0\<close>] mult.assoc mult.commute)
   ultimately show ?thesis by auto
 qed
 
 lemma tendsto_cmult_ereal_general [tendsto_intros]:
   fixes f::"_ \<Rightarrow> ereal" and c::ereal
   assumes "(f \<longlongrightarrow> l) F" "\<not> (l=0 \<and> abs(c) = \<infinity>)"
   shows "((\<lambda>x. c * f x) \<longlongrightarrow> c * l) F"
 by (cases "c = 0", auto simp add: assms tendsto_mult_ereal)
 
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Continuity of division\<close>
 
 lemma tendsto_inverse_ereal_PInf:
   fixes u::"_ \<Rightarrow> ereal"
   assumes "(u \<longlongrightarrow> \<infinity>) F"
   shows "((\<lambda>x. 1/ u x) \<longlongrightarrow> 0) F"
 proof -
   {
     fix e::real assume "e>0"
     have "1/e < \<infinity>" by auto
     then have "eventually (\<lambda>n. u n > 1/e) F" using assms(1) by (simp add: tendsto_PInfty)
     moreover
     {
       fix z::ereal assume "z>1/e"
       then have "z>0" using \<open>e>0\<close> using less_le_trans not_le by fastforce
       then have "1/z \<ge> 0" by auto
       moreover have "1/z < e" using \<open>e>0\<close> \<open>z>1/e\<close>
         apply (cases z) apply auto
         by (metis (mono_tags, hide_lams) less_ereal.simps(2) less_ereal.simps(4) divide_less_eq ereal_divide_less_pos ereal_less(4)
             ereal_less_eq(4) less_le_trans mult_eq_0_iff not_le not_one_less_zero times_ereal.simps(1))
       ultimately have "1/z \<ge> 0" "1/z < e" by auto
     }
     ultimately have "eventually (\<lambda>n. 1/u n<e) F" "eventually (\<lambda>n. 1/u n\<ge>0) F" by (auto simp add: eventually_mono)
   } note * = this
   show ?thesis
   proof (subst order_tendsto_iff, auto)
     fix a::ereal assume "a<0"
     then show "eventually (\<lambda>n. 1/u n > a) F" using *(2) eventually_mono less_le_trans linordered_field_no_ub by fastforce
   next
     fix a::ereal assume "a>0"
     then obtain e::real where "e>0" "a>e" using ereal_dense2 ereal_less(2) by blast
     then have "eventually (\<lambda>n. 1/u n < e) F" using *(1) by auto
     then show "eventually (\<lambda>n. 1/u n < a) F" using \<open>a>e\<close> by (metis (mono_tags, lifting) eventually_mono less_trans)
   qed
 qed
 
 text \<open>The next lemma deserves to exist by itself, as it is so common and useful.\<close>
 
 lemma tendsto_inverse_real [tendsto_intros]:
   fixes u::"_ \<Rightarrow> real"
   shows "(u \<longlongrightarrow> l) F \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> ((\<lambda>x. 1/ u x) \<longlongrightarrow> 1/l) F"
   using tendsto_inverse unfolding inverse_eq_divide .
 
 lemma tendsto_inverse_ereal [tendsto_intros]:
   fixes u::"_ \<Rightarrow> ereal"
   assumes "(u \<longlongrightarrow> l) F" "l \<noteq> 0"
   shows "((\<lambda>x. 1/ u x) \<longlongrightarrow> 1/l) F"
 proof (cases l)
   case (real r)
   then have "r \<noteq> 0" using assms(2) by auto
   then have "1/l = ereal(1/r)" using real by (simp add: one_ereal_def)
   define v where "v = (\<lambda>n. real_of_ereal(u n))"
   have ureal: "eventually (\<lambda>n. u n = ereal(v n)) F" unfolding v_def using real_lim_then_eventually_real assms(1) real by auto
   then have "((\<lambda>n. ereal(v n)) \<longlongrightarrow> ereal r) F" using assms real v_def by auto
   then have *: "((\<lambda>n. v n) \<longlongrightarrow> r) F" by auto
   then have "((\<lambda>n. 1/v n) \<longlongrightarrow> 1/r) F" using \<open>r \<noteq> 0\<close> tendsto_inverse_real by auto
   then have lim: "((\<lambda>n. ereal(1/v n)) \<longlongrightarrow> 1/l) F" using \<open>1/l = ereal(1/r)\<close> by auto
 
   have "r \<in> -{0}" "open (-{(0::real)})" using \<open>r \<noteq> 0\<close> by auto
   then have "eventually (\<lambda>n. v n \<in> -{0}) F" using * using topological_tendstoD by blast
   then have "eventually (\<lambda>n. v n \<noteq> 0) F" by auto
   moreover
   {
     fix n assume H: "v n \<noteq> 0" "u n = ereal(v n)"
     then have "ereal(1/v n) = 1/ereal(v n)" by (simp add: one_ereal_def)
     then have "ereal(1/v n) = 1/u n" using H(2) by simp
   }
   ultimately have "eventually (\<lambda>n. ereal(1/v n) = 1/u n) F" using ureal eventually_elim2 by force
   with Lim_transform_eventually[OF lim this] show ?thesis by simp
 next
   case (PInf)
   then have "1/l = 0" by auto
   then show ?thesis using tendsto_inverse_ereal_PInf assms PInf by auto
 next
   case (MInf)
   then have "1/l = 0" by auto
   have "1/z = -1/ -z" if "z < 0" for z::ereal
     apply (cases z) using divide_ereal_def \<open> z < 0 \<close> by auto
   moreover have "eventually (\<lambda>n. u n < 0) F" by (metis (no_types) MInf assms(1) tendsto_MInfty zero_ereal_def)
   ultimately have *: "eventually (\<lambda>n. -1/-u n = 1/u n) F" by (simp add: eventually_mono)
 
   define v where "v = (\<lambda>n. - u n)"
   have "(v \<longlongrightarrow> \<infinity>) F" unfolding v_def using MInf assms(1) tendsto_uminus_ereal by fastforce
   then have "((\<lambda>n. 1/v n) \<longlongrightarrow> 0) F" using tendsto_inverse_ereal_PInf by auto
   then have "((\<lambda>n. -1/v n) \<longlongrightarrow> 0) F" using tendsto_uminus_ereal by fastforce
   then show ?thesis unfolding v_def using Lim_transform_eventually[OF _ *] \<open> 1/l = 0 \<close> by auto
 qed
 
 lemma tendsto_divide_ereal [tendsto_intros]:
   fixes f g::"_ \<Rightarrow> ereal"
   assumes "(f \<longlongrightarrow> l) F" "(g \<longlongrightarrow> m) F" "m \<noteq> 0" "\<not>(abs(l) = \<infinity> \<and> abs(m) = \<infinity>)"
   shows "((\<lambda>x. f x / g x) \<longlongrightarrow> l / m) F"
 proof -
   define h where "h = (\<lambda>x. 1/ g x)"
   have *: "(h \<longlongrightarrow> 1/m) F" unfolding h_def using assms(2) assms(3) tendsto_inverse_ereal by auto
   have "((\<lambda>x. f x * h x) \<longlongrightarrow> l * (1/m)) F"
     apply (rule tendsto_mult_ereal[OF assms(1) *]) using assms(3) assms(4) by (auto simp add: divide_ereal_def)
   moreover have "f x * h x = f x / g x" for x unfolding h_def by (simp add: divide_ereal_def)
   moreover have "l * (1/m) = l/m" by (simp add: divide_ereal_def)
   ultimately show ?thesis unfolding h_def using Lim_transform_eventually by auto
 qed
 
 
 subsubsection \<open>Further limits\<close>
 
 text \<open>The assumptions of @{thm tendsto_diff_ereal} are too strong, we weaken them here.\<close>
 
 lemma tendsto_diff_ereal_general [tendsto_intros]:
   fixes u v::"'a \<Rightarrow> ereal"
   assumes "(u \<longlongrightarrow> l) F" "(v \<longlongrightarrow> m) F" "\<not>((l = \<infinity> \<and> m = \<infinity>) \<or> (l = -\<infinity> \<and> m = -\<infinity>))"
   shows "((\<lambda>n. u n - v n) \<longlongrightarrow> l - m) F"
 proof -
   have "((\<lambda>n. u n + (-v n)) \<longlongrightarrow> l + (-m)) F"
     apply (intro tendsto_intros assms) using assms by (auto simp add: ereal_uminus_eq_reorder)
   then show ?thesis by (simp add: minus_ereal_def)
 qed
 
 lemma id_nat_ereal_tendsto_PInf [tendsto_intros]:
   "(\<lambda> n::nat. real n) \<longlonglongrightarrow> \<infinity>"
 by (simp add: filterlim_real_sequentially tendsto_PInfty_eq_at_top)
 
 lemma tendsto_at_top_pseudo_inverse [tendsto_intros]:
   fixes u::"nat \<Rightarrow> nat"
   assumes "LIM n sequentially. u n :> at_top"
   shows "LIM n sequentially. Inf {N. u N \<ge> n} :> at_top"
 proof -
   {
     fix C::nat
     define M where "M = Max {u n| n. n \<le> C}+1"
     {
       fix n assume "n \<ge> M"
       have "eventually (\<lambda>N. u N \<ge> n) sequentially" using assms
         by (simp add: filterlim_at_top)
       then have *: "{N. u N \<ge> n} \<noteq> {}" by force
 
       have "N > C" if "u N \<ge> n" for N
       proof (rule ccontr)
         assume "\<not>(N > C)"
         have "u N \<le> Max {u n| n. n \<le> C}"
           apply (rule Max_ge) using \<open>\<not>(N > C)\<close> by auto
         then show False using \<open>u N \<ge> n\<close> \<open>n \<ge> M\<close> unfolding M_def by auto
       qed
       then have **: "{N. u N \<ge> n} \<subseteq> {C..}" by fastforce
       have "Inf {N. u N \<ge> n} \<ge> C"
         by (metis "*" "**" Inf_nat_def1 atLeast_iff subset_eq)
     }
     then have "eventually (\<lambda>n. Inf {N. u N \<ge> n} \<ge> C) sequentially"
       using eventually_sequentially by auto
   }
   then show ?thesis using filterlim_at_top by auto
 qed
 
 lemma pseudo_inverse_finite_set:
   fixes u::"nat \<Rightarrow> nat"
   assumes "LIM n sequentially. u n :> at_top"
   shows "finite {N. u N \<le> n}"
 proof -
   fix n
   have "eventually (\<lambda>N. u N \<ge> n+1) sequentially" using assms
     by (simp add: filterlim_at_top)
   then obtain N1 where N1: "\<And>N. N \<ge> N1 \<Longrightarrow> u N \<ge> n + 1"
     using eventually_sequentially by auto
   have "{N. u N \<le> n} \<subseteq> {..<N1}"
     apply auto using N1 by (metis Suc_eq_plus1 not_less not_less_eq_eq)
   then show "finite {N. u N \<le> n}" by (simp add: finite_subset)
 qed
 
 lemma tendsto_at_top_pseudo_inverse2 [tendsto_intros]:
   fixes u::"nat \<Rightarrow> nat"
   assumes "LIM n sequentially. u n :> at_top"
   shows "LIM n sequentially. Max {N. u N \<le> n} :> at_top"
 proof -
   {
     fix N0::nat
     have "N0 \<le> Max {N. u N \<le> n}" if "n \<ge> u N0" for n
       apply (rule Max.coboundedI) using pseudo_inverse_finite_set[OF assms] that by auto
     then have "eventually (\<lambda>n. N0 \<le> Max {N. u N \<le> n}) sequentially"
       using eventually_sequentially by blast
   }
   then show ?thesis using filterlim_at_top by auto
 qed
 
 lemma ereal_truncation_top [tendsto_intros]:
   fixes x::ereal
   shows "(\<lambda>n::nat. min x n) \<longlonglongrightarrow> x"
 proof (cases x)
   case (real r)
   then obtain K::nat where "K>0" "K > abs(r)" using reals_Archimedean2 gr0I by auto
   then have "min x n = x" if "n \<ge> K" for n apply (subst real, subst real, auto) using that eq_iff by fastforce
   then have "eventually (\<lambda>n. min x n = x) sequentially" using eventually_at_top_linorder by blast
   then show ?thesis by (simp add: tendsto_eventually)
 next
   case (PInf)
   then have "min x n = n" for n::nat by (auto simp add: min_def)
   then show ?thesis using id_nat_ereal_tendsto_PInf PInf by auto
 next
   case (MInf)
   then have "min x n = x" for n::nat by (auto simp add: min_def)
   then show ?thesis by auto
 qed
 
 lemma ereal_truncation_real_top [tendsto_intros]:
   fixes x::ereal
   assumes "x \<noteq> - \<infinity>"
   shows "(\<lambda>n::nat. real_of_ereal(min x n)) \<longlonglongrightarrow> x"
 proof (cases x)
   case (real r)
   then obtain K::nat where "K>0" "K > abs(r)" using reals_Archimedean2 gr0I by auto
   then have "min x n = x" if "n \<ge> K" for n apply (subst real, subst real, auto) using that eq_iff by fastforce
   then have "real_of_ereal(min x n) = r" if "n \<ge> K" for n using real that by auto
   then have "eventually (\<lambda>n. real_of_ereal(min x n) = r) sequentially" using eventually_at_top_linorder by blast
   then have "(\<lambda>n. real_of_ereal(min x n)) \<longlonglongrightarrow> r" by (simp add: tendsto_eventually)
   then show ?thesis using real by auto
 next
   case (PInf)
   then have "real_of_ereal(min x n) = n" for n::nat by (auto simp add: min_def)
   then show ?thesis using id_nat_ereal_tendsto_PInf PInf by auto
 qed (simp add: assms)
 
 lemma ereal_truncation_bottom [tendsto_intros]:
   fixes x::ereal
   shows "(\<lambda>n::nat. max x (- real n)) \<longlonglongrightarrow> x"
 proof (cases x)
   case (real r)
   then obtain K::nat where "K>0" "K > abs(r)" using reals_Archimedean2 gr0I by auto
   then have "max x (-real n) = x" if "n \<ge> K" for n apply (subst real, subst real, auto) using that eq_iff by fastforce
   then have "eventually (\<lambda>n. max x (-real n) = x) sequentially" using eventually_at_top_linorder by blast
   then show ?thesis by (simp add: tendsto_eventually)
 next
   case (MInf)
   then have "max x (-real n) = (-1)* ereal(real n)" for n::nat by (auto simp add: max_def)
   moreover have "(\<lambda>n. (-1)* ereal(real n)) \<longlonglongrightarrow> -\<infinity>"
     using tendsto_cmult_ereal[of "-1", OF _ id_nat_ereal_tendsto_PInf] by (simp add: one_ereal_def)
   ultimately show ?thesis using MInf by auto
 next
   case (PInf)
   then have "max x (-real n) = x" for n::nat by (auto simp add: max_def)
   then show ?thesis by auto
 qed
 
 lemma ereal_truncation_real_bottom [tendsto_intros]:
   fixes x::ereal
   assumes "x \<noteq> \<infinity>"
   shows "(\<lambda>n::nat. real_of_ereal(max x (- real n))) \<longlonglongrightarrow> x"
 proof (cases x)
   case (real r)
   then obtain K::nat where "K>0" "K > abs(r)" using reals_Archimedean2 gr0I by auto
   then have "max x (-real n) = x" if "n \<ge> K" for n apply (subst real, subst real, auto) using that eq_iff by fastforce
   then have "real_of_ereal(max x (-real n)) = r" if "n \<ge> K" for n using real that by auto
   then have "eventually (\<lambda>n. real_of_ereal(max x (-real n)) = r) sequentially" using eventually_at_top_linorder by blast
   then have "(\<lambda>n. real_of_ereal(max x (-real n))) \<longlonglongrightarrow> r" by (simp add: tendsto_eventually)
   then show ?thesis using real by auto
 next
   case (MInf)
   then have "real_of_ereal(max x (-real n)) = (-1)* ereal(real n)" for n::nat by (auto simp add: max_def)
   moreover have "(\<lambda>n. (-1)* ereal(real n)) \<longlonglongrightarrow> -\<infinity>"
     using tendsto_cmult_ereal[of "-1", OF _ id_nat_ereal_tendsto_PInf] by (simp add: one_ereal_def)
   ultimately show ?thesis using MInf by auto
 qed (simp add: assms)
 
 text \<open>the next one is copied from \<open>tendsto_sum\<close>.\<close>
 lemma tendsto_sum_ereal [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> ereal"
   assumes "\<And>i. i \<in> S \<Longrightarrow> (f i \<longlongrightarrow> a i) F"
           "\<And>i. abs(a i) \<noteq> \<infinity>"
   shows "((\<lambda>x. \<Sum>i\<in>S. f i x) \<longlongrightarrow> (\<Sum>i\<in>S. a i)) F"
 proof (cases "finite S")
   assume "finite S" then show ?thesis using assms
     by (induct, simp, simp add: tendsto_add_ereal_general2 assms)
 qed(simp)
 
 
 lemma continuous_ereal_abs:
   "continuous_on (UNIV::ereal set) abs"
 proof -
   have "continuous_on ({..0} \<union> {(0::ereal)..}) abs"
     apply (rule continuous_on_closed_Un, auto)
     apply (rule iffD1[OF continuous_on_cong, of "{..0}" _ "\<lambda>x. -x"])
     using less_eq_ereal_def apply (auto simp add: continuous_uminus_ereal)
     apply (rule iffD1[OF continuous_on_cong, of "{0..}" _ "\<lambda>x. x"])
-      apply (auto simp add: continuous_on_id)
+      apply (auto)
     done
   moreover have "(UNIV::ereal set) = {..0} \<union> {(0::ereal)..}" by auto
   ultimately show ?thesis by auto
 qed
 
 lemmas continuous_on_compose_ereal_abs[continuous_intros] =
   continuous_on_compose2[OF continuous_ereal_abs _ subset_UNIV]
 
 lemma tendsto_abs_ereal [tendsto_intros]:
   assumes "(u \<longlongrightarrow> (l::ereal)) F"
   shows "((\<lambda>n. abs(u n)) \<longlongrightarrow> abs l) F"
 using continuous_ereal_abs assms by (metis UNIV_I continuous_on tendsto_compose)
 
 lemma ereal_minus_real_tendsto_MInf [tendsto_intros]:
   "(\<lambda>x. ereal (- real x)) \<longlonglongrightarrow> - \<infinity>"
 by (subst uminus_ereal.simps(1)[symmetric], intro tendsto_intros)
 
 
 subsection \<open>Extended-Nonnegative-Real.thy\<close> (*FIX title *)
 
 lemma tendsto_diff_ennreal_general [tendsto_intros]:
   fixes u v::"'a \<Rightarrow> ennreal"
   assumes "(u \<longlongrightarrow> l) F" "(v \<longlongrightarrow> m) F" "\<not>(l = \<infinity> \<and> m = \<infinity>)"
   shows "((\<lambda>n. u n - v n) \<longlongrightarrow> l - m) F"
 proof -
   have "((\<lambda>n. e2ennreal(enn2ereal(u n) - enn2ereal(v n))) \<longlongrightarrow> e2ennreal(enn2ereal l - enn2ereal m)) F"
     apply (intro tendsto_intros) using assms by  auto
   then show ?thesis by auto
 qed
 
 lemma tendsto_mult_ennreal [tendsto_intros]:
   fixes l m::ennreal
   assumes "(u \<longlongrightarrow> l) F" "(v \<longlongrightarrow> m) F" "\<not>((l = 0 \<and> m = \<infinity>) \<or> (l = \<infinity> \<and> m = 0))"
   shows "((\<lambda>n. u n * v n) \<longlongrightarrow> l * m) F"
 proof -
   have "((\<lambda>n. e2ennreal(enn2ereal (u n) * enn2ereal (v n))) \<longlongrightarrow> e2ennreal(enn2ereal l * enn2ereal m)) F"
     apply (intro tendsto_intros) using assms apply auto
     using enn2ereal_inject zero_ennreal.rep_eq by fastforce+
   moreover have "e2ennreal(enn2ereal (u n) * enn2ereal (v n)) = u n * v n" for n
     by (subst times_ennreal.abs_eq[symmetric], auto simp add: eq_onp_same_args)
   moreover have "e2ennreal(enn2ereal l * enn2ereal m)  = l * m"
     by (subst times_ennreal.abs_eq[symmetric], auto simp add: eq_onp_same_args)
   ultimately show ?thesis
     by auto
 qed
 
 
 subsection \<open>monoset\<close> (*FIX ME title *)
 
 definition (in order) mono_set:
   "mono_set S \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> x \<in> S \<longrightarrow> y \<in> S)"
 
 lemma (in order) mono_greaterThan [intro, simp]: "mono_set {B<..}" unfolding mono_set by auto
 lemma (in order) mono_atLeast [intro, simp]: "mono_set {B..}" unfolding mono_set by auto
 lemma (in order) mono_UNIV [intro, simp]: "mono_set UNIV" unfolding mono_set by auto
 lemma (in order) mono_empty [intro, simp]: "mono_set {}" unfolding mono_set by auto
 
 lemma (in complete_linorder) mono_set_iff:
   fixes S :: "'a set"
   defines "a \<equiv> Inf S"
   shows "mono_set S \<longleftrightarrow> S = {a <..} \<or> S = {a..}" (is "_ = ?c")
 proof
   assume "mono_set S"
   then have mono: "\<And>x y. x \<le> y \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S"
     by (auto simp: mono_set)
   show ?c
   proof cases
     assume "a \<in> S"
     show ?c
       using mono[OF _ \<open>a \<in> S\<close>]
       by (auto intro: Inf_lower simp: a_def)
   next
     assume "a \<notin> S"
     have "S = {a <..}"
     proof safe
       fix x assume "x \<in> S"
       then have "a \<le> x"
         unfolding a_def by (rule Inf_lower)
       then show "a < x"
         using \<open>x \<in> S\<close> \<open>a \<notin> S\<close> by (cases "a = x") auto
     next
       fix x assume "a < x"
       then obtain y where "y < x" "y \<in> S"
         unfolding a_def Inf_less_iff ..
       with mono[of y x] show "x \<in> S"
         by auto
     qed
     then show ?c ..
   qed
 qed auto
 
 lemma ereal_open_mono_set:
   fixes S :: "ereal set"
   shows "open S \<and> mono_set S \<longleftrightarrow> S = UNIV \<or> S = {Inf S <..}"
   by (metis Inf_UNIV atLeast_eq_UNIV_iff ereal_open_atLeast
     ereal_open_closed mono_set_iff open_ereal_greaterThan)
 
 lemma ereal_closed_mono_set:
   fixes S :: "ereal set"
   shows "closed S \<and> mono_set S \<longleftrightarrow> S = {} \<or> S = {Inf S ..}"
   by (metis Inf_UNIV atLeast_eq_UNIV_iff closed_ereal_atLeast
     ereal_open_closed mono_empty mono_set_iff open_ereal_greaterThan)
 
 lemma ereal_Liminf_Sup_monoset:
   fixes f :: "'a \<Rightarrow> ereal"
   shows "Liminf net f =
     Sup {l. \<forall>S. open S \<longrightarrow> mono_set S \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) net}"
     (is "_ = Sup ?A")
 proof (safe intro!: Liminf_eqI complete_lattice_class.Sup_upper complete_lattice_class.Sup_least)
   fix P
   assume P: "eventually P net"
   fix S
   assume S: "mono_set S" "Inf (f ` (Collect P)) \<in> S"
   {
     fix x
     assume "P x"
     then have "Inf (f ` (Collect P)) \<le> f x"
       by (intro complete_lattice_class.INF_lower) simp
     with S have "f x \<in> S"
       by (simp add: mono_set)
   }
   with P show "eventually (\<lambda>x. f x \<in> S) net"
     by (auto elim: eventually_mono)
 next
   fix y l
   assume S: "\<forall>S. open S \<longrightarrow> mono_set S \<longrightarrow> l \<in> S \<longrightarrow> eventually  (\<lambda>x. f x \<in> S) net"
   assume P: "\<forall>P. eventually P net \<longrightarrow> Inf (f ` (Collect P)) \<le> y"
   show "l \<le> y"
   proof (rule dense_le)
     fix B
     assume "B < l"
     then have "eventually (\<lambda>x. f x \<in> {B <..}) net"
       by (intro S[rule_format]) auto
     then have "Inf (f ` {x. B < f x}) \<le> y"
       using P by auto
     moreover have "B \<le> Inf (f ` {x. B < f x})"
       by (intro INF_greatest) auto
     ultimately show "B \<le> y"
       by simp
   qed
 qed
 
 lemma ereal_Limsup_Inf_monoset:
   fixes f :: "'a \<Rightarrow> ereal"
   shows "Limsup net f =
     Inf {l. \<forall>S. open S \<longrightarrow> mono_set (uminus ` S) \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) net}"
     (is "_ = Inf ?A")
 proof (safe intro!: Limsup_eqI complete_lattice_class.Inf_lower complete_lattice_class.Inf_greatest)
   fix P
   assume P: "eventually P net"
   fix S
   assume S: "mono_set (uminus`S)" "Sup (f ` (Collect P)) \<in> S"
   {
     fix x
     assume "P x"
     then have "f x \<le> Sup (f ` (Collect P))"
       by (intro complete_lattice_class.SUP_upper) simp
     with S(1)[unfolded mono_set, rule_format, of "- Sup (f ` (Collect P))" "- f x"] S(2)
     have "f x \<in> S"
       by (simp add: inj_image_mem_iff) }
   with P show "eventually (\<lambda>x. f x \<in> S) net"
     by (auto elim: eventually_mono)
 next
   fix y l
   assume S: "\<forall>S. open S \<longrightarrow> mono_set (uminus ` S) \<longrightarrow> l \<in> S \<longrightarrow> eventually  (\<lambda>x. f x \<in> S) net"
   assume P: "\<forall>P. eventually P net \<longrightarrow> y \<le> Sup (f ` (Collect P))"
   show "y \<le> l"
   proof (rule dense_ge)
     fix B
     assume "l < B"
     then have "eventually (\<lambda>x. f x \<in> {..< B}) net"
       by (intro S[rule_format]) auto
     then have "y \<le> Sup (f ` {x. f x < B})"
       using P by auto
     moreover have "Sup (f ` {x. f x < B}) \<le> B"
       by (intro SUP_least) auto
     ultimately show "y \<le> B"
       by simp
   qed
 qed
 
 lemma liminf_bounded_open:
   fixes x :: "nat \<Rightarrow> ereal"
   shows "x0 \<le> liminf x \<longleftrightarrow> (\<forall>S. open S \<longrightarrow> mono_set S \<longrightarrow> x0 \<in> S \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. x n \<in> S))"
   (is "_ \<longleftrightarrow> ?P x0")
 proof
   assume "?P x0"
   then show "x0 \<le> liminf x"
     unfolding ereal_Liminf_Sup_monoset eventually_sequentially
     by (intro complete_lattice_class.Sup_upper) auto
 next
   assume "x0 \<le> liminf x"
   {
     fix S :: "ereal set"
     assume om: "open S" "mono_set S" "x0 \<in> S"
     {
       assume "S = UNIV"
       then have "\<exists>N. \<forall>n\<ge>N. x n \<in> S"
         by auto
     }
     moreover
     {
       assume "S \<noteq> UNIV"
       then obtain B where B: "S = {B<..}"
         using om ereal_open_mono_set by auto
       then have "B < x0"
         using om by auto
       then have "\<exists>N. \<forall>n\<ge>N. x n \<in> S"
         unfolding B
         using \<open>x0 \<le> liminf x\<close> liminf_bounded_iff
         by auto
     }
     ultimately have "\<exists>N. \<forall>n\<ge>N. x n \<in> S"
       by auto
   }
   then show "?P x0"
     by auto
 qed
 
 lemma limsup_finite_then_bounded:
   fixes u::"nat \<Rightarrow> real"
   assumes "limsup u < \<infinity>"
   shows "\<exists>C. \<forall>n. u n \<le> C"
 proof -
   obtain C where C: "limsup u < C" "C < \<infinity>" using assms ereal_dense2 by blast
   then have "C = ereal(real_of_ereal C)" using ereal_real by force
   have "eventually (\<lambda>n. u n < C) sequentially" using C(1) unfolding Limsup_def
     apply (auto simp add: INF_less_iff)
     using SUP_lessD eventually_mono by fastforce
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> u n < C" using eventually_sequentially by auto
   define D where "D = max (real_of_ereal C) (Max {u n |n. n \<le> N})"
   have "\<And>n. u n \<le> D"
   proof -
     fix n show "u n \<le> D"
     proof (cases)
       assume *: "n \<le> N"
       have "u n \<le> Max {u n |n. n \<le> N}" by (rule Max_ge, auto simp add: *)
       then show "u n \<le> D" unfolding D_def by linarith
     next
       assume "\<not>(n \<le> N)"
       then have "n \<ge> N" by simp
       then have "u n < C" using N by auto
       then have "u n < real_of_ereal C" using \<open>C = ereal(real_of_ereal C)\<close> less_ereal.simps(1) by fastforce
       then show "u n \<le> D" unfolding D_def by linarith
     qed
   qed
   then show ?thesis by blast
 qed
 
 lemma liminf_finite_then_bounded_below:
   fixes u::"nat \<Rightarrow> real"
   assumes "liminf u > -\<infinity>"
   shows "\<exists>C. \<forall>n. u n \<ge> C"
 proof -
   obtain C where C: "liminf u > C" "C > -\<infinity>" using assms using ereal_dense2 by blast
   then have "C = ereal(real_of_ereal C)" using ereal_real by force
   have "eventually (\<lambda>n. u n > C) sequentially" using C(1) unfolding Liminf_def
     apply (auto simp add: less_SUP_iff)
     using eventually_elim2 less_INF_D by fastforce
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> u n > C" using eventually_sequentially by auto
   define D where "D = min (real_of_ereal C) (Min {u n |n. n \<le> N})"
   have "\<And>n. u n \<ge> D"
   proof -
     fix n show "u n \<ge> D"
     proof (cases)
       assume *: "n \<le> N"
       have "u n \<ge> Min {u n |n. n \<le> N}" by (rule Min_le, auto simp add: *)
       then show "u n \<ge> D" unfolding D_def by linarith
     next
       assume "\<not>(n \<le> N)"
       then have "n \<ge> N" by simp
       then have "u n > C" using N by auto
       then have "u n > real_of_ereal C" using \<open>C = ereal(real_of_ereal C)\<close> less_ereal.simps(1) by fastforce
       then show "u n \<ge> D" unfolding D_def by linarith
     qed
   qed
   then show ?thesis by blast
 qed
 
 lemma liminf_upper_bound:
   fixes u:: "nat \<Rightarrow> ereal"
   assumes "liminf u < l"
   shows "\<exists>N>k. u N < l"
 by (metis assms gt_ex less_le_trans liminf_bounded_iff not_less)
 
 lemma limsup_shift:
   "limsup (\<lambda>n. u (n+1)) = limsup u"
 proof -
   have "(SUP m\<in>{n+1..}. u m) = (SUP m\<in>{n..}. u (m + 1))" for n
     apply (rule SUP_eq) using Suc_le_D by auto
   then have a: "(INF n. SUP m\<in>{n..}. u (m + 1)) = (INF n. (SUP m\<in>{n+1..}. u m))" by auto
   have b: "(INF n. (SUP m\<in>{n+1..}. u m)) = (INF n\<in>{1..}. (SUP m\<in>{n..}. u m))"
     apply (rule INF_eq) using Suc_le_D by auto
   have "(INF n\<in>{1..}. v n) = (INF n. v n)" if "decseq v" for v::"nat \<Rightarrow> 'a"
     apply (rule INF_eq) using \<open>decseq v\<close> decseq_Suc_iff by auto
   moreover have "decseq (\<lambda>n. (SUP m\<in>{n..}. u m))" by (simp add: SUP_subset_mono decseq_def)
   ultimately have c: "(INF n\<in>{1..}. (SUP m\<in>{n..}. u m)) = (INF n. (SUP m\<in>{n..}. u m))" by simp
   have "(INF n. Sup (u ` {n..})) = (INF n. SUP m\<in>{n..}. u (m + 1))" using a b c by simp
   then show ?thesis by (auto cong: limsup_INF_SUP)
 qed
 
 lemma limsup_shift_k:
   "limsup (\<lambda>n. u (n+k)) = limsup u"
 proof (induction k)
   case (Suc k)
   have "limsup (\<lambda>n. u (n+k+1)) = limsup (\<lambda>n. u (n+k))" using limsup_shift[where ?u="\<lambda>n. u(n+k)"] by simp
   then show ?case using Suc.IH by simp
 qed (auto)
 
 lemma liminf_shift:
   "liminf (\<lambda>n. u (n+1)) = liminf u"
 proof -
   have "(INF m\<in>{n+1..}. u m) = (INF m\<in>{n..}. u (m + 1))" for n
     apply (rule INF_eq) using Suc_le_D by (auto)
   then have a: "(SUP n. INF m\<in>{n..}. u (m + 1)) = (SUP n. (INF m\<in>{n+1..}. u m))" by auto
   have b: "(SUP n. (INF m\<in>{n+1..}. u m)) = (SUP n\<in>{1..}. (INF m\<in>{n..}. u m))"
     apply (rule SUP_eq) using Suc_le_D by (auto)
   have "(SUP n\<in>{1..}. v n) = (SUP n. v n)" if "incseq v" for v::"nat \<Rightarrow> 'a"
     apply (rule SUP_eq) using \<open>incseq v\<close> incseq_Suc_iff by auto
   moreover have "incseq (\<lambda>n. (INF m\<in>{n..}. u m))" by (simp add: INF_superset_mono mono_def)
   ultimately have c: "(SUP n\<in>{1..}. (INF m\<in>{n..}. u m)) = (SUP n. (INF m\<in>{n..}. u m))" by simp
   have "(SUP n. Inf (u ` {n..})) = (SUP n. INF m\<in>{n..}. u (m + 1))" using a b c by simp
   then show ?thesis by (auto cong: liminf_SUP_INF)
 qed
 
 lemma liminf_shift_k:
   "liminf (\<lambda>n. u (n+k)) = liminf u"
 proof (induction k)
   case (Suc k)
   have "liminf (\<lambda>n. u (n+k+1)) = liminf (\<lambda>n. u (n+k))" using liminf_shift[where ?u="\<lambda>n. u(n+k)"] by simp
   then show ?case using Suc.IH by simp
 qed (auto)
 
 lemma Limsup_obtain:
   fixes u::"_ \<Rightarrow> 'a :: complete_linorder"
   assumes "Limsup F u > c"
   shows "\<exists>i. u i > c"
 proof -
   have "(INF P\<in>{P. eventually P F}. SUP x\<in>{x. P x}. u x) > c" using assms by (simp add: Limsup_def)
   then show ?thesis by (metis eventually_True mem_Collect_eq less_INF_D less_SUP_iff)
 qed
 
 text \<open>The next lemma is extremely useful, as it often makes it possible to reduce statements
 about limsups to statements about limits.\<close>
 
 lemma limsup_subseq_lim:
   fixes u::"nat \<Rightarrow> 'a :: {complete_linorder, linorder_topology}"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (u o r) \<longlonglongrightarrow> limsup u"
 proof (cases)
   assume "\<forall>n. \<exists>p>n. \<forall>m\<ge>p. u m \<le> u p"
   then have "\<exists>r. \<forall>n. (\<forall>m\<ge>r n. u m \<le> u (r n)) \<and> r n < r (Suc n)"
     by (intro dependent_nat_choice) (auto simp: conj_commute)
   then obtain r :: "nat \<Rightarrow> nat" where "strict_mono r" and mono: "\<And>n m. r n \<le> m \<Longrightarrow> u m \<le> u (r n)"
     by (auto simp: strict_mono_Suc_iff)
   define umax where "umax = (\<lambda>n. (SUP m\<in>{n..}. u m))"
   have "decseq umax" unfolding umax_def by (simp add: SUP_subset_mono antimono_def)
   then have "umax \<longlonglongrightarrow> limsup u" unfolding umax_def by (metis LIMSEQ_INF limsup_INF_SUP)
   then have *: "(umax o r) \<longlonglongrightarrow> limsup u" by (simp add: LIMSEQ_subseq_LIMSEQ \<open>strict_mono r\<close>)
   have "\<And>n. umax(r n) = u(r n)" unfolding umax_def using mono
     by (metis SUP_le_iff antisym atLeast_def mem_Collect_eq order_refl)
   then have "umax o r = u o r" unfolding o_def by simp
   then have "(u o r) \<longlonglongrightarrow> limsup u" using * by simp
   then show ?thesis using \<open>strict_mono r\<close> by blast
 next
   assume "\<not> (\<forall>n. \<exists>p>n. (\<forall>m\<ge>p. u m \<le> u p))"
   then obtain N where N: "\<And>p. p > N \<Longrightarrow> \<exists>m>p. u p < u m" by (force simp: not_le le_less)
   have "\<exists>r. \<forall>n. N < r n \<and> r n < r (Suc n) \<and> (\<forall>i\<in> {N<..r (Suc n)}. u i \<le> u (r (Suc n)))"
   proof (rule dependent_nat_choice)
     fix x assume "N < x"
     then have a: "finite {N<..x}" "{N<..x} \<noteq> {}" by simp_all
     have "Max {u i |i. i \<in> {N<..x}} \<in> {u i |i. i \<in> {N<..x}}" apply (rule Max_in) using a by (auto)
     then obtain p where "p \<in> {N<..x}" and upmax: "u p = Max{u i |i. i \<in> {N<..x}}" by auto
     define U where "U = {m. m > p \<and> u p < u m}"
     have "U \<noteq> {}" unfolding U_def using N[of p] \<open>p \<in> {N<..x}\<close> by auto
     define y where "y = Inf U"
     then have "y \<in> U" using \<open>U \<noteq> {}\<close> by (simp add: Inf_nat_def1)
     have a: "\<And>i. i \<in> {N<..x} \<Longrightarrow> u i \<le> u p"
     proof -
       fix i assume "i \<in> {N<..x}"
       then have "u i \<in> {u i |i. i \<in> {N<..x}}" by blast
       then show "u i \<le> u p" using upmax by simp
     qed
     moreover have "u p < u y" using \<open>y \<in> U\<close> U_def by auto
     ultimately have "y \<notin> {N<..x}" using not_le by blast
     moreover have "y > N" using \<open>y \<in> U\<close> U_def \<open>p \<in> {N<..x}\<close> by auto
     ultimately have "y > x" by auto
 
     have "\<And>i. i \<in> {N<..y} \<Longrightarrow> u i \<le> u y"
     proof -
       fix i assume "i \<in> {N<..y}" show "u i \<le> u y"
       proof (cases)
         assume "i = y"
         then show ?thesis by simp
       next
         assume "\<not>(i=y)"
         then have i:"i \<in> {N<..<y}" using \<open>i \<in> {N<..y}\<close> by simp
         have "u i \<le> u p"
         proof (cases)
           assume "i \<le> x"
           then have "i \<in> {N<..x}" using i by simp
           then show ?thesis using a by simp
         next
           assume "\<not>(i \<le> x)"
           then have "i > x" by simp
           then have *: "i > p" using \<open>p \<in> {N<..x}\<close> by simp
           have "i < Inf U" using i y_def by simp
           then have "i \<notin> U" using Inf_nat_def not_less_Least by auto
           then show ?thesis using U_def * by auto
         qed
         then show "u i \<le> u y" using \<open>u p < u y\<close> by auto
       qed
     qed
     then have "N < y \<and> x < y \<and> (\<forall>i\<in>{N<..y}. u i \<le> u y)" using \<open>y > x\<close> \<open>y > N\<close> by auto
     then show "\<exists>y>N. x < y \<and> (\<forall>i\<in>{N<..y}. u i \<le> u y)" by auto
   qed (auto)
   then obtain r where r: "\<forall>n. N < r n \<and> r n < r (Suc n) \<and> (\<forall>i\<in> {N<..r (Suc n)}. u i \<le> u (r (Suc n)))" by auto
   have "strict_mono r" using r by (auto simp: strict_mono_Suc_iff)
   have "incseq (u o r)" unfolding o_def using r by (simp add: incseq_SucI order.strict_implies_order)
   then have "(u o r) \<longlonglongrightarrow> (SUP n. (u o r) n)" using LIMSEQ_SUP by blast
   then have "limsup (u o r) = (SUP n. (u o r) n)" by (simp add: lim_imp_Limsup)
   moreover have "limsup (u o r) \<le> limsup u" using \<open>strict_mono r\<close> by (simp add: limsup_subseq_mono)
   ultimately have "(SUP n. (u o r) n) \<le> limsup u" by simp
 
   {
     fix i assume i: "i \<in> {N<..}"
     obtain n where "i < r (Suc n)" using \<open>strict_mono r\<close> using Suc_le_eq seq_suble by blast
     then have "i \<in> {N<..r(Suc n)}" using i by simp
     then have "u i \<le> u (r(Suc n))" using r by simp
     then have "u i \<le> (SUP n. (u o r) n)" unfolding o_def by (meson SUP_upper2 UNIV_I)
   }
   then have "(SUP i\<in>{N<..}. u i) \<le> (SUP n. (u o r) n)" using SUP_least by blast
   then have "limsup u \<le> (SUP n. (u o r) n)" unfolding Limsup_def
     by (metis (mono_tags, lifting) INF_lower2 atLeast_Suc_greaterThan atLeast_def eventually_ge_at_top mem_Collect_eq)
   then have "limsup u = (SUP n. (u o r) n)" using \<open>(SUP n. (u o r) n) \<le> limsup u\<close> by simp
   then have "(u o r) \<longlonglongrightarrow> limsup u" using \<open>(u o r) \<longlonglongrightarrow> (SUP n. (u o r) n)\<close> by simp
   then show ?thesis using \<open>strict_mono r\<close> by auto
 qed
 
 lemma liminf_subseq_lim:
   fixes u::"nat \<Rightarrow> 'a :: {complete_linorder, linorder_topology}"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (u o r) \<longlonglongrightarrow> liminf u"
 proof (cases)
   assume "\<forall>n. \<exists>p>n. \<forall>m\<ge>p. u m \<ge> u p"
   then have "\<exists>r. \<forall>n. (\<forall>m\<ge>r n. u m \<ge> u (r n)) \<and> r n < r (Suc n)"
     by (intro dependent_nat_choice) (auto simp: conj_commute)
   then obtain r :: "nat \<Rightarrow> nat" where "strict_mono r" and mono: "\<And>n m. r n \<le> m \<Longrightarrow> u m \<ge> u (r n)"
     by (auto simp: strict_mono_Suc_iff)
   define umin where "umin = (\<lambda>n. (INF m\<in>{n..}. u m))"
   have "incseq umin" unfolding umin_def by (simp add: INF_superset_mono incseq_def)
   then have "umin \<longlonglongrightarrow> liminf u" unfolding umin_def by (metis LIMSEQ_SUP liminf_SUP_INF)
   then have *: "(umin o r) \<longlonglongrightarrow> liminf u" by (simp add: LIMSEQ_subseq_LIMSEQ \<open>strict_mono r\<close>)
   have "\<And>n. umin(r n) = u(r n)" unfolding umin_def using mono
     by (metis le_INF_iff antisym atLeast_def mem_Collect_eq order_refl)
   then have "umin o r = u o r" unfolding o_def by simp
   then have "(u o r) \<longlonglongrightarrow> liminf u" using * by simp
   then show ?thesis using \<open>strict_mono r\<close> by blast
 next
   assume "\<not> (\<forall>n. \<exists>p>n. (\<forall>m\<ge>p. u m \<ge> u p))"
   then obtain N where N: "\<And>p. p > N \<Longrightarrow> \<exists>m>p. u p > u m" by (force simp: not_le le_less)
   have "\<exists>r. \<forall>n. N < r n \<and> r n < r (Suc n) \<and> (\<forall>i\<in> {N<..r (Suc n)}. u i \<ge> u (r (Suc n)))"
   proof (rule dependent_nat_choice)
     fix x assume "N < x"
     then have a: "finite {N<..x}" "{N<..x} \<noteq> {}" by simp_all
     have "Min {u i |i. i \<in> {N<..x}} \<in> {u i |i. i \<in> {N<..x}}" apply (rule Min_in) using a by (auto)
     then obtain p where "p \<in> {N<..x}" and upmin: "u p = Min{u i |i. i \<in> {N<..x}}" by auto
     define U where "U = {m. m > p \<and> u p > u m}"
     have "U \<noteq> {}" unfolding U_def using N[of p] \<open>p \<in> {N<..x}\<close> by auto
     define y where "y = Inf U"
     then have "y \<in> U" using \<open>U \<noteq> {}\<close> by (simp add: Inf_nat_def1)
     have a: "\<And>i. i \<in> {N<..x} \<Longrightarrow> u i \<ge> u p"
     proof -
       fix i assume "i \<in> {N<..x}"
       then have "u i \<in> {u i |i. i \<in> {N<..x}}" by blast
       then show "u i \<ge> u p" using upmin by simp
     qed
     moreover have "u p > u y" using \<open>y \<in> U\<close> U_def by auto
     ultimately have "y \<notin> {N<..x}" using not_le by blast
     moreover have "y > N" using \<open>y \<in> U\<close> U_def \<open>p \<in> {N<..x}\<close> by auto
     ultimately have "y > x" by auto
 
     have "\<And>i. i \<in> {N<..y} \<Longrightarrow> u i \<ge> u y"
     proof -
       fix i assume "i \<in> {N<..y}" show "u i \<ge> u y"
       proof (cases)
         assume "i = y"
         then show ?thesis by simp
       next
         assume "\<not>(i=y)"
         then have i:"i \<in> {N<..<y}" using \<open>i \<in> {N<..y}\<close> by simp
         have "u i \<ge> u p"
         proof (cases)
           assume "i \<le> x"
           then have "i \<in> {N<..x}" using i by simp
           then show ?thesis using a by simp
         next
           assume "\<not>(i \<le> x)"
           then have "i > x" by simp
           then have *: "i > p" using \<open>p \<in> {N<..x}\<close> by simp
           have "i < Inf U" using i y_def by simp
           then have "i \<notin> U" using Inf_nat_def not_less_Least by auto
           then show ?thesis using U_def * by auto
         qed
         then show "u i \<ge> u y" using \<open>u p > u y\<close> by auto
       qed
     qed
     then have "N < y \<and> x < y \<and> (\<forall>i\<in>{N<..y}. u i \<ge> u y)" using \<open>y > x\<close> \<open>y > N\<close> by auto
     then show "\<exists>y>N. x < y \<and> (\<forall>i\<in>{N<..y}. u i \<ge> u y)" by auto
   qed (auto)
   then obtain r :: "nat \<Rightarrow> nat" 
     where r: "\<forall>n. N < r n \<and> r n < r (Suc n) \<and> (\<forall>i\<in> {N<..r (Suc n)}. u i \<ge> u (r (Suc n)))" by auto
   have "strict_mono r" using r by (auto simp: strict_mono_Suc_iff)
   have "decseq (u o r)" unfolding o_def using r by (simp add: decseq_SucI order.strict_implies_order)
   then have "(u o r) \<longlonglongrightarrow> (INF n. (u o r) n)" using LIMSEQ_INF by blast
   then have "liminf (u o r) = (INF n. (u o r) n)" by (simp add: lim_imp_Liminf)
   moreover have "liminf (u o r) \<ge> liminf u" using \<open>strict_mono r\<close> by (simp add: liminf_subseq_mono)
   ultimately have "(INF n. (u o r) n) \<ge> liminf u" by simp
 
   {
     fix i assume i: "i \<in> {N<..}"
     obtain n where "i < r (Suc n)" using \<open>strict_mono r\<close> using Suc_le_eq seq_suble by blast
     then have "i \<in> {N<..r(Suc n)}" using i by simp
     then have "u i \<ge> u (r(Suc n))" using r by simp
     then have "u i \<ge> (INF n. (u o r) n)" unfolding o_def by (meson INF_lower2 UNIV_I)
   }
   then have "(INF i\<in>{N<..}. u i) \<ge> (INF n. (u o r) n)" using INF_greatest by blast
   then have "liminf u \<ge> (INF n. (u o r) n)" unfolding Liminf_def
     by (metis (mono_tags, lifting) SUP_upper2 atLeast_Suc_greaterThan atLeast_def eventually_ge_at_top mem_Collect_eq)
   then have "liminf u = (INF n. (u o r) n)" using \<open>(INF n. (u o r) n) \<ge> liminf u\<close> by simp
   then have "(u o r) \<longlonglongrightarrow> liminf u" using \<open>(u o r) \<longlonglongrightarrow> (INF n. (u o r) n)\<close> by simp
   then show ?thesis using \<open>strict_mono r\<close> by auto
 qed
 
 text \<open>The following statement about limsups is reduced to a statement about limits using
 subsequences thanks to \<open>limsup_subseq_lim\<close>. The statement for limits follows for instance from
 \<open>tendsto_add_ereal_general\<close>.\<close>
 
 lemma ereal_limsup_add_mono:
   fixes u v::"nat \<Rightarrow> ereal"
   shows "limsup (\<lambda>n. u n + v n) \<le> limsup u + limsup v"
 proof (cases)
   assume "(limsup u = \<infinity>) \<or> (limsup v = \<infinity>)"
   then have "limsup u + limsup v = \<infinity>" by simp
   then show ?thesis by auto
 next
   assume "\<not>((limsup u = \<infinity>) \<or> (limsup v = \<infinity>))"
   then have "limsup u < \<infinity>" "limsup v < \<infinity>" by auto
 
   define w where "w = (\<lambda>n. u n + v n)"
   obtain r where r: "strict_mono r" "(w o r) \<longlonglongrightarrow> limsup w" using limsup_subseq_lim by auto
   obtain s where s: "strict_mono s" "(u o r o s) \<longlonglongrightarrow> limsup (u o r)" using limsup_subseq_lim by auto
   obtain t where t: "strict_mono t" "(v o r o s o t) \<longlonglongrightarrow> limsup (v o r o s)" using limsup_subseq_lim by auto
 
   define a where "a = r o s o t"
   have "strict_mono a" using r s t by (simp add: a_def strict_mono_o)
   have l:"(w o a) \<longlonglongrightarrow> limsup w"
          "(u o a) \<longlonglongrightarrow> limsup (u o r)"
          "(v o a) \<longlonglongrightarrow> limsup (v o r o s)"
   apply (metis (no_types, lifting) r(2) s(1) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) s(2) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) t(2) a_def comp_assoc)
   done
 
   have "limsup (u o r) \<le> limsup u" by (simp add: limsup_subseq_mono r(1))
   then have a: "limsup (u o r) \<noteq> \<infinity>" using \<open>limsup u < \<infinity>\<close> by auto
   have "limsup (v o r o s) \<le> limsup v" 
     by (simp add: comp_assoc limsup_subseq_mono r(1) s(1) strict_mono_o)
   then have b: "limsup (v o r o s) \<noteq> \<infinity>" using \<open>limsup v < \<infinity>\<close> by auto
 
   have "(\<lambda>n. (u o a) n + (v o a) n) \<longlonglongrightarrow> limsup (u o r) + limsup (v o r o s)"
     using l tendsto_add_ereal_general a b by fastforce
   moreover have "(\<lambda>n. (u o a) n + (v o a) n) = (w o a)" unfolding w_def by auto
   ultimately have "(w o a) \<longlonglongrightarrow> limsup (u o r) + limsup (v o r o s)" by simp
   then have "limsup w = limsup (u o r) + limsup (v o r o s)" using l(1) LIMSEQ_unique by blast
   then have "limsup w \<le> limsup u + limsup v"
     using \<open>limsup (u o r) \<le> limsup u\<close> \<open>limsup (v o r o s) \<le> limsup v\<close> add_mono by simp
   then show ?thesis unfolding w_def by simp
 qed
 
 text \<open>There is an asymmetry between liminfs and limsups in \<open>ereal\<close>, as \<open>\<infinity> + (-\<infinity>) = \<infinity>\<close>.
 This explains why there are more assumptions in the next lemma dealing with liminfs that in the
 previous one about limsups.\<close>
 
 lemma ereal_liminf_add_mono:
   fixes u v::"nat \<Rightarrow> ereal"
   assumes "\<not>((liminf u = \<infinity> \<and> liminf v = -\<infinity>) \<or> (liminf u = -\<infinity> \<and> liminf v = \<infinity>))"
   shows "liminf (\<lambda>n. u n + v n) \<ge> liminf u + liminf v"
 proof (cases)
   assume "(liminf u = -\<infinity>) \<or> (liminf v = -\<infinity>)"
   then have *: "liminf u + liminf v = -\<infinity>" using assms by auto
   show ?thesis by (simp add: *)
 next
   assume "\<not>((liminf u = -\<infinity>) \<or> (liminf v = -\<infinity>))"
   then have "liminf u > -\<infinity>" "liminf v > -\<infinity>" by auto
 
   define w where "w = (\<lambda>n. u n + v n)"
   obtain r where r: "strict_mono r" "(w o r) \<longlonglongrightarrow> liminf w" using liminf_subseq_lim by auto
   obtain s where s: "strict_mono s" "(u o r o s) \<longlonglongrightarrow> liminf (u o r)" using liminf_subseq_lim by auto
   obtain t where t: "strict_mono t" "(v o r o s o t) \<longlonglongrightarrow> liminf (v o r o s)" using liminf_subseq_lim by auto
 
   define a where "a = r o s o t"
   have "strict_mono a" using r s t by (simp add: a_def strict_mono_o)
   have l:"(w o a) \<longlonglongrightarrow> liminf w"
          "(u o a) \<longlonglongrightarrow> liminf (u o r)"
          "(v o a) \<longlonglongrightarrow> liminf (v o r o s)"
   apply (metis (no_types, lifting) r(2) s(1) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) s(2) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) t(2) a_def comp_assoc)
   done
 
   have "liminf (u o r) \<ge> liminf u" by (simp add: liminf_subseq_mono r(1))
   then have a: "liminf (u o r) \<noteq> -\<infinity>" using \<open>liminf u > -\<infinity>\<close> by auto
   have "liminf (v o r o s) \<ge> liminf v" 
     by (simp add: comp_assoc liminf_subseq_mono r(1) s(1) strict_mono_o)
   then have b: "liminf (v o r o s) \<noteq> -\<infinity>" using \<open>liminf v > -\<infinity>\<close> by auto
 
   have "(\<lambda>n. (u o a) n + (v o a) n) \<longlonglongrightarrow> liminf (u o r) + liminf (v o r o s)"
     using l tendsto_add_ereal_general a b by fastforce
   moreover have "(\<lambda>n. (u o a) n + (v o a) n) = (w o a)" unfolding w_def by auto
   ultimately have "(w o a) \<longlonglongrightarrow> liminf (u o r) + liminf (v o r o s)" by simp
   then have "liminf w = liminf (u o r) + liminf (v o r o s)" using l(1) LIMSEQ_unique by blast
   then have "liminf w \<ge> liminf u + liminf v"
     using \<open>liminf (u o r) \<ge> liminf u\<close> \<open>liminf (v o r o s) \<ge> liminf v\<close> add_mono by simp
   then show ?thesis unfolding w_def by simp
 qed
 
 lemma ereal_limsup_lim_add:
   fixes u v::"nat \<Rightarrow> ereal"
   assumes "u \<longlonglongrightarrow> a" "abs(a) \<noteq> \<infinity>"
   shows "limsup (\<lambda>n. u n + v n) = a + limsup v"
 proof -
   have "limsup u = a" using assms(1) using tendsto_iff_Liminf_eq_Limsup trivial_limit_at_top_linorder by blast
   have "(\<lambda>n. -u n) \<longlonglongrightarrow> -a" using assms(1) by auto
   then have "limsup (\<lambda>n. -u n) = -a" using tendsto_iff_Liminf_eq_Limsup trivial_limit_at_top_linorder by blast
 
   have "limsup (\<lambda>n. u n + v n) \<le> limsup u + limsup v"
     by (rule ereal_limsup_add_mono)
   then have up: "limsup (\<lambda>n. u n + v n) \<le> a + limsup v" using \<open>limsup u = a\<close> by simp
 
   have a: "limsup (\<lambda>n. (u n + v n) + (-u n)) \<le> limsup (\<lambda>n. u n + v n) + limsup (\<lambda>n. -u n)"
     by (rule ereal_limsup_add_mono)
   have "eventually (\<lambda>n. u n = ereal(real_of_ereal(u n))) sequentially" using assms
     real_lim_then_eventually_real by auto
   moreover have "\<And>x. x = ereal(real_of_ereal(x)) \<Longrightarrow> x + (-x) = 0"
     by (metis plus_ereal.simps(1) right_minus uminus_ereal.simps(1) zero_ereal_def)
   ultimately have "eventually (\<lambda>n. u n + (-u n) = 0) sequentially"
     by (metis (mono_tags, lifting) eventually_mono)
   moreover have "\<And>n. u n + (-u n) = 0 \<Longrightarrow> u n + v n + (-u n) = v n"
     by (metis add.commute add.left_commute add.left_neutral)
   ultimately have "eventually (\<lambda>n. u n + v n + (-u n) = v n) sequentially"
     using eventually_mono by force
   then have "limsup v = limsup (\<lambda>n. u n + v n + (-u n))" using Limsup_eq by force
   then have "limsup v \<le> limsup (\<lambda>n. u n + v n) -a" using a \<open>limsup (\<lambda>n. -u n) = -a\<close> by (simp add: minus_ereal_def)
   then have "limsup (\<lambda>n. u n + v n) \<ge> a + limsup v" using assms(2) by (metis add.commute ereal_le_minus)
   then show ?thesis using up by simp
 qed
 
 lemma ereal_limsup_lim_mult:
   fixes u v::"nat \<Rightarrow> ereal"
   assumes "u \<longlonglongrightarrow> a" "a>0" "a \<noteq> \<infinity>"
   shows "limsup (\<lambda>n. u n * v n) = a * limsup v"
 proof -
   define w where "w = (\<lambda>n. u n * v n)"
   obtain r where r: "strict_mono r" "(v o r) \<longlonglongrightarrow> limsup v" using limsup_subseq_lim by auto
   have "(u o r) \<longlonglongrightarrow> a" using assms(1) LIMSEQ_subseq_LIMSEQ r by auto
   with tendsto_mult_ereal[OF this r(2)] have "(\<lambda>n. (u o r) n * (v o r) n) \<longlonglongrightarrow> a * limsup v" using assms(2) assms(3) by auto
   moreover have "\<And>n. (w o r) n = (u o r) n * (v o r) n" unfolding w_def by auto
   ultimately have "(w o r) \<longlonglongrightarrow> a * limsup v" unfolding w_def by presburger
   then have "limsup (w o r) = a * limsup v" by (simp add: tendsto_iff_Liminf_eq_Limsup)
   then have I: "limsup w \<ge> a * limsup v" by (metis limsup_subseq_mono r(1))
 
   obtain s where s: "strict_mono s" "(w o s) \<longlonglongrightarrow> limsup w" using limsup_subseq_lim by auto
   have *: "(u o s) \<longlonglongrightarrow> a" using assms(1) LIMSEQ_subseq_LIMSEQ s by auto
   have "eventually (\<lambda>n. (u o s) n > 0) sequentially" using assms(2) * order_tendsto_iff by blast
   moreover have "eventually (\<lambda>n. (u o s) n < \<infinity>) sequentially" using assms(3) * order_tendsto_iff by blast
   moreover have "(w o s) n / (u o s) n = (v o s) n" if "(u o s) n > 0" "(u o s) n < \<infinity>" for n
     unfolding w_def using that by (auto simp add: ereal_divide_eq)
   ultimately have "eventually (\<lambda>n. (w o s) n / (u o s) n = (v o s) n) sequentially" using eventually_elim2 by force
   moreover have "(\<lambda>n. (w o s) n / (u o s) n) \<longlonglongrightarrow> (limsup w) / a"
     apply (rule tendsto_divide_ereal[OF s(2) *]) using assms(2) assms(3) by auto
   ultimately have "(v o s) \<longlonglongrightarrow> (limsup w) / a" using Lim_transform_eventually by fastforce
   then have "limsup (v o s) = (limsup w) / a" by (simp add: tendsto_iff_Liminf_eq_Limsup)
   then have "limsup v \<ge> (limsup w) / a" by (metis limsup_subseq_mono s(1))
   then have "a * limsup v \<ge> limsup w" using assms(2) assms(3) by (simp add: ereal_divide_le_pos)
   then show ?thesis using I unfolding w_def by auto
 qed
 
 lemma ereal_liminf_lim_mult:
   fixes u v::"nat \<Rightarrow> ereal"
   assumes "u \<longlonglongrightarrow> a" "a>0" "a \<noteq> \<infinity>"
   shows "liminf (\<lambda>n. u n * v n) = a * liminf v"
 proof -
   define w where "w = (\<lambda>n. u n * v n)"
   obtain r where r: "strict_mono r" "(v o r) \<longlonglongrightarrow> liminf v" using liminf_subseq_lim by auto
   have "(u o r) \<longlonglongrightarrow> a" using assms(1) LIMSEQ_subseq_LIMSEQ r by auto
   with tendsto_mult_ereal[OF this r(2)] have "(\<lambda>n. (u o r) n * (v o r) n) \<longlonglongrightarrow> a * liminf v" using assms(2) assms(3) by auto
   moreover have "\<And>n. (w o r) n = (u o r) n * (v o r) n" unfolding w_def by auto
   ultimately have "(w o r) \<longlonglongrightarrow> a * liminf v" unfolding w_def by presburger
   then have "liminf (w o r) = a * liminf v" by (simp add: tendsto_iff_Liminf_eq_Limsup)
   then have I: "liminf w \<le> a * liminf v" by (metis liminf_subseq_mono r(1))
 
   obtain s where s: "strict_mono s" "(w o s) \<longlonglongrightarrow> liminf w" using liminf_subseq_lim by auto
   have *: "(u o s) \<longlonglongrightarrow> a" using assms(1) LIMSEQ_subseq_LIMSEQ s by auto
   have "eventually (\<lambda>n. (u o s) n > 0) sequentially" using assms(2) * order_tendsto_iff by blast
   moreover have "eventually (\<lambda>n. (u o s) n < \<infinity>) sequentially" using assms(3) * order_tendsto_iff by blast
   moreover have "(w o s) n / (u o s) n = (v o s) n" if "(u o s) n > 0" "(u o s) n < \<infinity>" for n
     unfolding w_def using that by (auto simp add: ereal_divide_eq)
   ultimately have "eventually (\<lambda>n. (w o s) n / (u o s) n = (v o s) n) sequentially" using eventually_elim2 by force
   moreover have "(\<lambda>n. (w o s) n / (u o s) n) \<longlonglongrightarrow> (liminf w) / a"
     apply (rule tendsto_divide_ereal[OF s(2) *]) using assms(2) assms(3) by auto
   ultimately have "(v o s) \<longlonglongrightarrow> (liminf w) / a" using Lim_transform_eventually by fastforce
   then have "liminf (v o s) = (liminf w) / a" by (simp add: tendsto_iff_Liminf_eq_Limsup)
   then have "liminf v \<le> (liminf w) / a" by (metis liminf_subseq_mono s(1))
   then have "a * liminf v \<le> liminf w" using assms(2) assms(3) by (simp add: ereal_le_divide_pos)
   then show ?thesis using I unfolding w_def by auto
 qed
 
 lemma ereal_liminf_lim_add:
   fixes u v::"nat \<Rightarrow> ereal"
   assumes "u \<longlonglongrightarrow> a" "abs(a) \<noteq> \<infinity>"
   shows "liminf (\<lambda>n. u n + v n) = a + liminf v"
 proof -
   have "liminf u = a" using assms(1) tendsto_iff_Liminf_eq_Limsup trivial_limit_at_top_linorder by blast
   then have *: "abs(liminf u) \<noteq> \<infinity>" using assms(2) by auto
   have "(\<lambda>n. -u n) \<longlonglongrightarrow> -a" using assms(1) by auto
   then have "liminf (\<lambda>n. -u n) = -a" using tendsto_iff_Liminf_eq_Limsup trivial_limit_at_top_linorder by blast
   then have **: "abs(liminf (\<lambda>n. -u n)) \<noteq> \<infinity>" using assms(2) by auto
 
   have "liminf (\<lambda>n. u n + v n) \<ge> liminf u + liminf v"
     apply (rule ereal_liminf_add_mono) using * by auto
   then have up: "liminf (\<lambda>n. u n + v n) \<ge> a + liminf v" using \<open>liminf u = a\<close> by simp
 
   have a: "liminf (\<lambda>n. (u n + v n) + (-u n)) \<ge> liminf (\<lambda>n. u n + v n) + liminf (\<lambda>n. -u n)"
     apply (rule ereal_liminf_add_mono) using ** by auto
   have "eventually (\<lambda>n. u n = ereal(real_of_ereal(u n))) sequentially" using assms
     real_lim_then_eventually_real by auto
   moreover have "\<And>x. x = ereal(real_of_ereal(x)) \<Longrightarrow> x + (-x) = 0"
     by (metis plus_ereal.simps(1) right_minus uminus_ereal.simps(1) zero_ereal_def)
   ultimately have "eventually (\<lambda>n. u n + (-u n) = 0) sequentially"
     by (metis (mono_tags, lifting) eventually_mono)
   moreover have "\<And>n. u n + (-u n) = 0 \<Longrightarrow> u n + v n + (-u n) = v n"
     by (metis add.commute add.left_commute add.left_neutral)
   ultimately have "eventually (\<lambda>n. u n + v n + (-u n) = v n) sequentially"
     using eventually_mono by force
   then have "liminf v = liminf (\<lambda>n. u n + v n + (-u n))" using Liminf_eq by force
   then have "liminf v \<ge> liminf (\<lambda>n. u n + v n) -a" using a \<open>liminf (\<lambda>n. -u n) = -a\<close> by (simp add: minus_ereal_def)
   then have "liminf (\<lambda>n. u n + v n) \<le> a + liminf v" using assms(2) by (metis add.commute ereal_minus_le)
   then show ?thesis using up by simp
 qed
 
 lemma ereal_liminf_limsup_add:
   fixes u v::"nat \<Rightarrow> ereal"
   shows "liminf (\<lambda>n. u n + v n) \<le> liminf u + limsup v"
 proof (cases)
   assume "limsup v = \<infinity> \<or> liminf u = \<infinity>"
   then show ?thesis by auto
 next
   assume "\<not>(limsup v = \<infinity> \<or> liminf u = \<infinity>)"
   then have "limsup v < \<infinity>" "liminf u < \<infinity>" by auto
 
   define w where "w = (\<lambda>n. u n + v n)"
   obtain r where r: "strict_mono r" "(u o r) \<longlonglongrightarrow> liminf u" using liminf_subseq_lim by auto
   obtain s where s: "strict_mono s" "(w o r o s) \<longlonglongrightarrow> liminf (w o r)" using liminf_subseq_lim by auto
   obtain t where t: "strict_mono t" "(v o r o s o t) \<longlonglongrightarrow> limsup (v o r o s)" using limsup_subseq_lim by auto
 
   define a where "a = r o s o t"
   have "strict_mono a" using r s t by (simp add: a_def strict_mono_o)
   have l:"(u o a) \<longlonglongrightarrow> liminf u"
          "(w o a) \<longlonglongrightarrow> liminf (w o r)"
          "(v o a) \<longlonglongrightarrow> limsup (v o r o s)"
   apply (metis (no_types, lifting) r(2) s(1) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) s(2) t(1) LIMSEQ_subseq_LIMSEQ a_def comp_assoc)
   apply (metis (no_types, lifting) t(2) a_def comp_assoc)
   done
 
   have "liminf (w o r) \<ge> liminf w" by (simp add: liminf_subseq_mono r(1))
   have "limsup (v o r o s) \<le> limsup v" 
     by (simp add: comp_assoc limsup_subseq_mono r(1) s(1) strict_mono_o)
   then have b: "limsup (v o r o s) < \<infinity>" using \<open>limsup v < \<infinity>\<close> by auto
 
   have "(\<lambda>n. (u o a) n + (v o a) n) \<longlonglongrightarrow> liminf u + limsup (v o r o s)"
     apply (rule tendsto_add_ereal_general) using b \<open>liminf u < \<infinity>\<close> l(1) l(3) by force+
   moreover have "(\<lambda>n. (u o a) n + (v o a) n) = (w o a)" unfolding w_def by auto
   ultimately have "(w o a) \<longlonglongrightarrow> liminf u + limsup (v o r o s)" by simp
   then have "liminf (w o r) = liminf u + limsup (v o r o s)" using l(2) using LIMSEQ_unique by blast
   then have "liminf w \<le> liminf u + limsup v"
     using \<open>liminf (w o r) \<ge> liminf w\<close> \<open>limsup (v o r o s) \<le> limsup v\<close>
     by (metis add_mono_thms_linordered_semiring(2) le_less_trans not_less)
   then show ?thesis unfolding w_def by simp
 qed
 
 lemma ereal_liminf_limsup_minus:
   fixes u v::"nat \<Rightarrow> ereal"
   shows "liminf (\<lambda>n. u n - v n) \<le> limsup u - limsup v"
   unfolding minus_ereal_def
   apply (subst add.commute)
   apply (rule order_trans[OF ereal_liminf_limsup_add])
   using ereal_Limsup_uminus[of sequentially "\<lambda>n. - v n"]
   apply (simp add: add.commute)
   done
 
 
 lemma liminf_minus_ennreal:
   fixes u v::"nat \<Rightarrow> ennreal"
   shows "(\<And>n. v n \<le> u n) \<Longrightarrow> liminf (\<lambda>n. u n - v n) \<le> limsup u - limsup v"
   unfolding liminf_SUP_INF limsup_INF_SUP
   including ennreal.lifting
 proof (transfer, clarsimp)
   fix v u :: "nat \<Rightarrow> ereal" assume *: "\<forall>x. 0 \<le> v x" "\<forall>x. 0 \<le> u x" "\<And>n. v n \<le> u n"
   moreover have "0 \<le> limsup u - limsup v"
     using * by (intro ereal_diff_positive Limsup_mono always_eventually) simp
   moreover have "0 \<le> Sup (u ` {x..})" for x
     using * by (intro SUP_upper2[of x]) auto
   moreover have "0 \<le> Sup (v ` {x..})" for x
     using * by (intro SUP_upper2[of x]) auto
   ultimately show "(SUP n. INF n\<in>{n..}. max 0 (u n - v n))
             \<le> max 0 ((INF x. max 0 (Sup (u ` {x..}))) - (INF x. max 0 (Sup (v ` {x..}))))"
     by (auto simp: * ereal_diff_positive max.absorb2 liminf_SUP_INF[symmetric] limsup_INF_SUP[symmetric] ereal_liminf_limsup_minus)
 qed
 
 subsection "Relate extended reals and the indicator function"
 
 lemma ereal_indicator_le_0: "(indicator S x::ereal) \<le> 0 \<longleftrightarrow> x \<notin> S"
   by (auto split: split_indicator simp: one_ereal_def)
 
 lemma ereal_indicator: "ereal (indicator A x) = indicator A x"
   by (auto simp: indicator_def one_ereal_def)
 
 lemma ereal_mult_indicator: "ereal (x * indicator A y) = ereal x * indicator A y"
   by (simp split: split_indicator)
 
 lemma ereal_indicator_mult: "ereal (indicator A y * x) = indicator A y * ereal x"
   by (simp split: split_indicator)
 
 lemma ereal_indicator_nonneg[simp, intro]: "0 \<le> (indicator A x ::ereal)"
   unfolding indicator_def by auto
 
 lemma indicator_inter_arith_ereal: "indicator A x * indicator B x = (indicator (A \<inter> B) x :: ereal)"
   by (simp split: split_indicator)
 
 end
diff --git a/src/HOL/Analysis/Function_Topology.thy b/src/HOL/Analysis/Function_Topology.thy
--- a/src/HOL/Analysis/Function_Topology.thy
+++ b/src/HOL/Analysis/Function_Topology.thy
@@ -1,2062 +1,2061 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr with additions from LCP
     License: BSD
 *)
 
 theory Function_Topology
 imports Topology_Euclidean_Space Abstract_Limits
 begin
 
 
 section \<open>Function Topology\<close>
 
 text \<open>We want to define the general product topology.
 
 The product topology on a product of topological spaces is generated by
 the sets which are products of open sets along finitely many coordinates, and the whole
 space along the other coordinates. This is the coarsest topology for which the projection
 to each factor is continuous.
 
 To form a product of objects in Isabelle/HOL, all these objects should be subsets of a common type
 'a. The product is then \<^term>\<open>Pi\<^sub>E I X\<close>, the set of elements from \<open>'i\<close> to \<open>'a\<close> such that the \<open>i\<close>-th
 coordinate belongs to \<open>X i\<close> for all \<open>i \<in> I\<close>.
 
 Hence, to form a product of topological spaces, all these spaces should be subsets of a common type.
 This means that type classes can not be used to define such a product if one wants to take the
 product of different topological spaces (as the type 'a can only be given one structure of
 topological space using type classes). On the other hand, one can define different topologies (as
 introduced in \<open>thy\<close>) on one type, and these topologies do not need to
 share the same maximal open set. Hence, one can form a product of topologies in this sense, and
 this works well. The big caveat is that it does not interact well with the main body of
 topology in Isabelle/HOL defined in terms of type classes... For instance, continuity of maps
 is not defined in this setting.
 
 As the product of different topological spaces is very important in several areas of
 mathematics (for instance adeles), I introduce below the product topology in terms of topologies,
 and reformulate afterwards the consequences in terms of type classes (which are of course very
 handy for applications).
 
 Given this limitation, it looks to me that it would be very beneficial to revamp the theory
 of topological spaces in Isabelle/HOL in terms of topologies, and keep the statements involving
 type classes as consequences of more general statements in terms of topologies (but I am
 probably too naive here).
 
 Here is an example of a reformulation using topologies. Let
 @{text [display]
 \<open>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)))\<close>}
 be the natural continuity definition of a map from the topology \<open>T1\<close> to the topology \<open>T2\<close>. Then
 the current \<open>continuous_on\<close> (with type classes) can be redefined as
 @{text [display] \<open>continuous_on s f =
     continuous_map (top_of_set s) (topology euclidean) f\<close>}
 
 In fact, I need \<open>continuous_map\<close> to express the continuity of the projection on subfactors
 for the product topology, in Lemma~\<open>continuous_on_restrict_product_topology\<close>, and I show
 the above equivalence in Lemma~\<open>continuous_map_iff_continuous\<close>.
 
 I only develop the basics of the product topology in this theory. The most important missing piece
 is Tychonov theorem, stating that a product of compact spaces is always compact for the product
 topology, even when the product is not finite (or even countable).
 
 I realized afterwards that this theory has a lot in common with \<^file>\<open>~~/src/HOL/Library/Finite_Map.thy\<close>.
 \<close>
 
 subsection \<open>The product topology\<close>
 
 text \<open>We can now define the product topology, as generated by
 the sets which are products of open sets along finitely many coordinates, and the whole
 space along the other coordinates. Equivalently, it is generated by sets which are one open
 set along one single coordinate, and the whole space along other coordinates. In fact, this is only
 equivalent for nonempty products, but for the empty product the first formulation is better
 (the second one gives an empty product space, while an empty product should have exactly one
 point, equal to \<open>undefined\<close> along all coordinates.
 
 So, we use the first formulation, which moreover seems to give rise to more straightforward proofs.
 \<close>
 
 definition\<^marker>\<open>tag important\<close> product_topology::"('i \<Rightarrow> ('a topology)) \<Rightarrow> ('i set) \<Rightarrow> (('i \<Rightarrow> 'a) topology)"
   where "product_topology T I =
     topology_generated_by {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}}"
 
 abbreviation powertop_real :: "'a set \<Rightarrow> ('a \<Rightarrow> real) topology"
   where "powertop_real \<equiv> product_topology (\<lambda>i. euclideanreal)"
 
 text \<open>The total set of the product topology is the product of the total sets
 along each coordinate.\<close>
 
 proposition product_topology:
   "product_topology X I =
    topology
     (arbitrary union_of
        ((finite intersection_of
         (\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (X i) U))
         relative_to (\<Pi>\<^sub>E i\<in>I. topspace (X i))))"
   (is "_ = topology (_ union_of ((_ intersection_of ?\<Psi>) relative_to ?TOP))")
 proof -
   let ?\<Omega> = "(\<lambda>F. \<exists>Y. F = Pi\<^sub>E I Y \<and> (\<forall>i. openin (X i) (Y i)) \<and> finite {i. Y i \<noteq> topspace (X i)})"
   have *: "(finite' intersection_of ?\<Omega>) A = (finite intersection_of ?\<Psi> relative_to ?TOP) A" for A
   proof -
     have 1: "\<exists>U. (\<exists>\<U>. finite \<U> \<and> \<U> \<subseteq> Collect ?\<Psi> \<and> \<Inter>\<U> = U) \<and> ?TOP \<inter> U = \<Inter>\<U>"
       if \<U>: "\<U> \<subseteq> Collect ?\<Omega>" and "finite' \<U>" "A = \<Inter>\<U>" "\<U> \<noteq> {}" for \<U>
     proof -
       have "\<forall>U \<in> \<U>. \<exists>Y. U = Pi\<^sub>E I Y \<and> (\<forall>i. openin (X i) (Y i)) \<and> finite {i. Y i \<noteq> topspace (X i)}"
         using \<U> by auto
       then obtain Y where Y: "\<And>U. U \<in> \<U> \<Longrightarrow> U = Pi\<^sub>E I (Y U) \<and> (\<forall>i. openin (X i) (Y U i)) \<and> finite {i. (Y U) i \<noteq> topspace (X i)}"
         by metis
       obtain U where "U \<in> \<U>"
         using \<open>\<U> \<noteq> {}\<close> by blast
       let ?F = "\<lambda>U. (\<lambda>i. {f. f i \<in> Y U i}) ` {i \<in> I. Y U i \<noteq> topspace (X i)}"
       show ?thesis
       proof (intro conjI exI)
         show "finite (\<Union>U\<in>\<U>. ?F U)"
           using Y \<open>finite' \<U>\<close> by auto
         show "?TOP \<inter> \<Inter>(\<Union>U\<in>\<U>. ?F U) = \<Inter>\<U>"
         proof
           have *: "f \<in> U"
             if "U \<in> \<U>" and "\<forall>V\<in>\<U>. \<forall>i. i \<in> I \<and> Y V i \<noteq> topspace (X i) \<longrightarrow> f i \<in> Y V i"
               and "\<forall>i\<in>I. f i \<in> topspace (X i)" and "f \<in> extensional I" for f U
           proof -
             have "Pi\<^sub>E I (Y U) = U"
               using Y \<open>U \<in> \<U>\<close> by blast
             then show "f \<in> U"
               using that unfolding PiE_def Pi_def by blast
           qed
           show "?TOP \<inter> \<Inter>(\<Union>U\<in>\<U>. ?F U) \<subseteq> \<Inter>\<U>"
             by (auto simp: PiE_iff *)
           show "\<Inter>\<U> \<subseteq> ?TOP \<inter> \<Inter>(\<Union>U\<in>\<U>. ?F U)"
             using Y openin_subset \<open>finite' \<U>\<close> by fastforce
         qed
       qed (use Y openin_subset in \<open>blast+\<close>)
     qed
     have 2: "\<exists>\<U>'. finite' \<U>' \<and> \<U>' \<subseteq> Collect ?\<Omega> \<and> \<Inter>\<U>' = ?TOP \<inter> \<Inter>\<U>"
       if \<U>: "\<U> \<subseteq> Collect ?\<Psi>" and "finite \<U>" for \<U>
     proof (cases "\<U>={}")
       case True
       then show ?thesis
         apply (rule_tac x="{?TOP}" in exI, simp)
         apply (rule_tac x="\<lambda>i. topspace (X i)" in exI)
         apply force
         done
     next
       case False
       then obtain U where "U \<in> \<U>"
         by blast
       have "\<forall>U \<in> \<U>. \<exists>i Y. U = {f. f i \<in> Y} \<and> i \<in> I \<and> openin (X i) Y"
         using \<U> by auto
       then obtain J Y where
         Y: "\<And>U. U \<in> \<U> \<Longrightarrow> U = {f. f (J U) \<in> Y U} \<and> J U \<in> I \<and> openin (X (J U)) (Y U)"
         by metis
       let ?G = "\<lambda>U. \<Pi>\<^sub>E i\<in>I. if i = J U then Y U else topspace (X i)"
       show ?thesis
       proof (intro conjI exI)
         show "finite (?G ` \<U>)" "?G ` \<U> \<noteq> {}"
           using \<open>finite \<U>\<close> \<open>U \<in> \<U>\<close> by blast+
         have *: "\<And>U. U \<in> \<U> \<Longrightarrow> openin (X (J U)) (Y U)"
           using Y by force
         show "?G ` \<U> \<subseteq> {Pi\<^sub>E I Y |Y. (\<forall>i. openin (X i) (Y i)) \<and> finite {i. Y i \<noteq> topspace (X i)}}"
           apply clarsimp
           apply (rule_tac x=" (\<lambda>i. if i = J U then Y U else topspace (X i))" in exI)
           apply (auto simp: *)
           done
       next
         show "(\<Inter>U\<in>\<U>. ?G U) = ?TOP \<inter> \<Inter>\<U>"
         proof
           have "(\<Pi>\<^sub>E i\<in>I. if i = J U then Y U else topspace (X i)) \<subseteq> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
             apply (clarsimp simp: PiE_iff Ball_def all_conj_distrib split: if_split_asm)
             using Y \<open>U \<in> \<U>\<close> openin_subset by blast+
           then have "(\<Inter>U\<in>\<U>. ?G U) \<subseteq> ?TOP"
             using \<open>U \<in> \<U>\<close>
             by fastforce
           moreover have "(\<Inter>U\<in>\<U>. ?G U) \<subseteq> \<Inter>\<U>"
             using PiE_mem Y by fastforce
           ultimately show "(\<Inter>U\<in>\<U>. ?G U) \<subseteq> ?TOP \<inter> \<Inter>\<U>"
             by auto
         qed (use Y in fastforce)
       qed
     qed
     show ?thesis
       unfolding relative_to_def intersection_of_def
       by (safe; blast dest!: 1 2)
   qed
   show ?thesis
     unfolding product_topology_def generate_topology_on_eq
     apply (rule arg_cong [where f = topology])
     apply (rule arg_cong [where f = "(union_of)arbitrary"])
     apply (force simp: *)
     done
 qed
 
 lemma topspace_product_topology [simp]:
   "topspace (product_topology T I) = (\<Pi>\<^sub>E i\<in>I. topspace(T i))"
 proof
   show "topspace (product_topology T I) \<subseteq> (\<Pi>\<^sub>E i\<in>I. topspace (T i))"
     unfolding product_topology_def topology_generated_by_topspace
     unfolding topspace_def by auto
   have "(\<Pi>\<^sub>E i\<in>I. topspace (T i)) \<in> {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}}"
     using openin_topspace not_finite_existsD by auto
   then show "(\<Pi>\<^sub>E i\<in>I. topspace (T i)) \<subseteq> topspace (product_topology T I)"
     unfolding product_topology_def using PiE_def by (auto simp add: topology_generated_by_topspace)
 qed
 
 lemma product_topology_basis:
   assumes "\<And>i. openin (T i) (X i)" "finite {i. X i \<noteq> topspace (T i)}"
   shows "openin (product_topology T I) (\<Pi>\<^sub>E i\<in>I. X i)"
   unfolding product_topology_def
   by (rule topology_generated_by_Basis) (use assms in auto)
 
 proposition product_topology_open_contains_basis:
   assumes "openin (product_topology T I) U" "x \<in> U"
   shows "\<exists>X. x \<in> (\<Pi>\<^sub>E i\<in>I. X i) \<and> (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)} \<and> (\<Pi>\<^sub>E i\<in>I. X i) \<subseteq> U"
 proof -
   have "generate_topology_on {(\<Pi>\<^sub>E i\<in>I. X i) |X. (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}} U"
     using assms unfolding product_topology_def by (intro openin_topology_generated_by) auto
   then have "\<And>x. x\<in>U \<Longrightarrow> \<exists>X. x \<in> (\<Pi>\<^sub>E i\<in>I. X i) \<and> (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)} \<and> (\<Pi>\<^sub>E i\<in>I. X i) \<subseteq> U"
   proof induction
     case (Int U V x)
     then obtain XU XV where H:
       "x \<in> Pi\<^sub>E I XU" "(\<forall>i. openin (T i) (XU i))" "finite {i. XU i \<noteq> topspace (T i)}" "Pi\<^sub>E I XU \<subseteq> U"
       "x \<in> Pi\<^sub>E I XV" "(\<forall>i. openin (T i) (XV i))" "finite {i. XV i \<noteq> topspace (T i)}" "Pi\<^sub>E I XV \<subseteq> V"
       by auto meson
     define X where "X = (\<lambda>i. XU i \<inter> XV i)"
     have "Pi\<^sub>E I X \<subseteq> Pi\<^sub>E I XU \<inter> Pi\<^sub>E I XV"
       unfolding X_def by (auto simp add: PiE_iff)
     then have "Pi\<^sub>E I X \<subseteq> U \<inter> V" using H by auto
     moreover have "\<forall>i. openin (T i) (X i)"
       unfolding X_def using H by auto
     moreover have "finite {i. X i \<noteq> topspace (T i)}"
       apply (rule rev_finite_subset[of "{i. XU i \<noteq> topspace (T i)} \<union> {i. XV i \<noteq> topspace (T i)}"])
       unfolding X_def using H by auto
     moreover have "x \<in> Pi\<^sub>E I X"
       unfolding X_def using H by auto
     ultimately show ?case
       by auto
   next
     case (UN K x)
     then obtain k where "k \<in> K" "x \<in> k" by auto
     with UN have "\<exists>X. x \<in> Pi\<^sub>E I X \<and> (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)} \<and> Pi\<^sub>E I X \<subseteq> k"
       by simp
     then obtain X where "x \<in> Pi\<^sub>E I X \<and> (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)} \<and> Pi\<^sub>E I X \<subseteq> k"
       by blast
     then have "x \<in> Pi\<^sub>E I X \<and> (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)} \<and> Pi\<^sub>E I X \<subseteq> (\<Union>K)"
       using \<open>k \<in> K\<close> by auto
     then show ?case
       by auto
   qed auto
   then show ?thesis using \<open>x \<in> U\<close> by auto
 qed
 
 lemma product_topology_empty_discrete:
    "product_topology T {} = discrete_topology {(\<lambda>x. undefined)}"
   by (simp add: subtopology_eq_discrete_topology_sing)
 
 lemma openin_product_topology:
    "openin (product_topology X I) =
     arbitrary union_of
           ((finite intersection_of (\<lambda>F. (\<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (X i) U)))
            relative_to topspace (product_topology X I))"
   apply (subst product_topology)
   apply (simp add: topology_inverse' [OF istopology_subbase])
   done
 
 lemma subtopology_PiE:
   "subtopology (product_topology X I) (\<Pi>\<^sub>E i\<in>I. (S i)) = product_topology (\<lambda>i. subtopology (X i) (S i)) I"
 proof -
   let ?P = "\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (X i) U"
   let ?X = "\<Pi>\<^sub>E i\<in>I. topspace (X i)"
   have "finite intersection_of ?P relative_to ?X \<inter> Pi\<^sub>E I S =
         finite intersection_of (?P relative_to ?X \<inter> Pi\<^sub>E I S) relative_to ?X \<inter> Pi\<^sub>E I S"
     by (rule finite_intersection_of_relative_to)
   also have "\<dots> = finite intersection_of
                       ((\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> (openin (X i) relative_to S i) U)
                        relative_to ?X \<inter> Pi\<^sub>E I S)
                    relative_to ?X \<inter> Pi\<^sub>E I S"
     apply (rule arg_cong2 [where f = "(relative_to)"])
      apply (rule arg_cong [where f = "(intersection_of)finite"])
      apply (rule ext)
      apply (auto simp: relative_to_def intersection_of_def)
     done
   finally
   have "finite intersection_of ?P relative_to ?X \<inter> Pi\<^sub>E I S =
         finite intersection_of
           (\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> (openin (X i) relative_to S i) U)
           relative_to ?X \<inter> Pi\<^sub>E I S"
     by (metis finite_intersection_of_relative_to)
   then show ?thesis
   unfolding topology_eq
   apply clarify
   apply (simp add: openin_product_topology flip: openin_relative_to)
-  apply (simp add: arbitrary_union_of_relative_to topspace_product_topology topspace_subtopology flip: PiE_Int)
+  apply (simp add: arbitrary_union_of_relative_to flip: PiE_Int)
   done
 qed
 
 lemma product_topology_base_alt:
    "finite intersection_of (\<lambda>F. (\<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (X i) U))
     relative_to (\<Pi>\<^sub>E i\<in>I. topspace (X i)) =
     (\<lambda>F. (\<exists>U. F =  Pi\<^sub>E I U \<and> finite {i \<in> I. U i \<noteq> topspace(X i)} \<and> (\<forall>i \<in> I. openin (X i) (U i))))"
    (is "?lhs = ?rhs")
 proof -
   have "(\<forall>F. ?lhs F \<longrightarrow> ?rhs F)"
     unfolding all_relative_to all_intersection_of topspace_product_topology
   proof clarify
     fix \<F>
     assume "finite \<F>" and "\<F> \<subseteq> {{f. f i \<in> U} |i U. i \<in> I \<and> openin (X i) U}"
     then show "\<exists>U. (\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> \<Inter>\<F> = Pi\<^sub>E I U \<and>
           finite {i \<in> I. U i \<noteq> topspace (X i)} \<and> (\<forall>i\<in>I. openin (X i) (U i))"
     proof (induction)
       case (insert F \<F>)
       then obtain U where eq: "(\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> \<Inter>\<F> = Pi\<^sub>E I U"
         and fin: "finite {i \<in> I. U i \<noteq> topspace (X i)}"
         and ope: "\<And>i. i \<in> I \<Longrightarrow> openin (X i) (U i)"
         by auto
       obtain i V where "F = {f. f i \<in> V}" "i \<in> I" "openin (X i) V"
         using insert by auto
       let ?U = "\<lambda>j. U j \<inter> (if j = i then V else topspace(X j))"
       show ?case
       proof (intro exI conjI)
         show "(\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> \<Inter>(insert F \<F>) = Pi\<^sub>E I ?U"
         using eq  PiE_mem \<open>i \<in> I\<close>  by (auto simp: \<open>F = {f. f i \<in> V}\<close>) fastforce
       next
         show "finite {i \<in> I. ?U i \<noteq> topspace (X i)}"
           by (rule rev_finite_subset [OF finite.insertI [OF fin]]) auto
       next
         show "\<forall>i\<in>I. openin (X i) (?U i)"
           by (simp add: \<open>openin (X i) V\<close> ope openin_Int)
       qed
     qed (auto intro: dest: not_finite_existsD)
   qed
   moreover have "(\<forall>F. ?rhs F \<longrightarrow> ?lhs F)"
   proof clarify
     fix U :: "'a \<Rightarrow> 'b set"
     assume fin: "finite {i \<in> I. U i \<noteq> topspace (X i)}" and ope: "\<forall>i\<in>I. openin (X i) (U i)"
     let ?U = "\<Inter>i\<in>{i \<in> I. U i \<noteq> topspace (X i)}. {x. x i \<in> U i}"
     show "?lhs (Pi\<^sub>E I U)"
       unfolding relative_to_def topspace_product_topology
     proof (intro exI conjI)
       show "(finite intersection_of (\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (X i) U)) ?U"
         using fin ope by (intro finite_intersection_of_Inter finite_intersection_of_inc) auto
       show "(\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> ?U = Pi\<^sub>E I U"
         using ope openin_subset by fastforce
     qed
   qed
   ultimately show ?thesis
     by meson
 qed
 
 corollary openin_product_topology_alt:
   "openin (product_topology X I) S \<longleftrightarrow>
     (\<forall>x \<in> S. \<exists>U. finite {i \<in> I. U i \<noteq> topspace(X i)} \<and>
                  (\<forall>i \<in> I. openin (X i) (U i)) \<and> x \<in> Pi\<^sub>E I U \<and> Pi\<^sub>E I U \<subseteq> S)"
   unfolding openin_product_topology arbitrary_union_of_alt product_topology_base_alt topspace_product_topology
   apply safe
   apply (drule bspec; blast)+
   done
 
 lemma closure_of_product_topology:
   "(product_topology X I) closure_of (PiE I S) = PiE I (\<lambda>i. (X i) closure_of (S i))"
 proof -
   have *: "(\<forall>T. f \<in> T \<and> openin (product_topology X I) T \<longrightarrow> (\<exists>y\<in>Pi\<^sub>E I S. y \<in> T))
        \<longleftrightarrow> (\<forall>i \<in> I. \<forall>T. f i \<in> T \<and> openin (X i) T \<longrightarrow> S i \<inter> T \<noteq> {})"
     (is "?lhs = ?rhs")
     if top: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> topspace (X i)" and ext:  "f \<in> extensional I" for f
   proof
     assume L[rule_format]: ?lhs
     show ?rhs
     proof clarify
       fix i T
       assume "i \<in> I" "f i \<in> T" "openin (X i) T" "S i \<inter> T = {}"
       then have "openin (product_topology X I) ((\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<inter> {x. x i \<in> T})"
         by (force simp: openin_product_topology intro: arbitrary_union_of_inc relative_to_inc finite_intersection_of_inc)
       then show "False"
         using L [of "topspace (product_topology X I) \<inter> {f. f i \<in> T}"] \<open>S i \<inter> T = {}\<close> \<open>f i \<in> T\<close> \<open>i \<in> I\<close>
         by (auto simp: top ext PiE_iff)
     qed
   next
     assume R [rule_format]: ?rhs
     show ?lhs
     proof (clarsimp simp: openin_product_topology union_of_def arbitrary_def)
       fix \<U> U
       assume
         \<U>: "\<U> \<subseteq> Collect
            (finite intersection_of (\<lambda>F. \<exists>i U. F = {x. x i \<in> U} \<and> i \<in> I \<and> openin (X i) U) relative_to
             (\<Pi>\<^sub>E i\<in>I. topspace (X i)))" and
         "f \<in> U" "U \<in> \<U>"
       then have "(finite intersection_of (\<lambda>F. \<exists>i U. F = {x. x i \<in> U} \<and> i \<in> I \<and> openin (X i) U)
                  relative_to (\<Pi>\<^sub>E i\<in>I. topspace (X i))) U"
         by blast
       with \<open>f \<in> U\<close> \<open>U \<in> \<U>\<close>
       obtain \<T> where "finite \<T>"
         and \<T>: "\<And>C. C \<in> \<T> \<Longrightarrow> \<exists>i \<in> I. \<exists>V. openin (X i) V \<and> C = {x. x i \<in> V}"
         and "topspace (product_topology X I) \<inter> \<Inter> \<T> \<subseteq> U" "f \<in> topspace (product_topology X I) \<inter> \<Inter> \<T>"
         apply (clarsimp simp add: relative_to_def intersection_of_def)
         apply (rule that, auto dest!: subsetD)
         done
       then have "f \<in> PiE I (topspace \<circ> X)" "f \<in> \<Inter>\<T>" and subU: "PiE I (topspace \<circ> X) \<inter> \<Inter>\<T> \<subseteq> U"
         by (auto simp: PiE_iff)
       have *: "f i \<in> topspace (X i) \<inter> \<Inter>{U. openin (X i) U \<and> {x. x i \<in> U} \<in> \<T>}
              \<and> openin (X i) (topspace (X i) \<inter> \<Inter>{U. openin (X i) U \<and> {x. x i \<in> U} \<in> \<T>})"
         if "i \<in> I" for i
       proof -
         have "finite ((\<lambda>U. {x. x i \<in> U}) -` \<T>)"
         proof (rule finite_vimageI [OF \<open>finite \<T>\<close>])
           show "inj (\<lambda>U. {x. x i \<in> U})"
             by (auto simp: inj_on_def)
         qed
         then have fin: "finite {U. openin (X i) U \<and> {x. x i \<in> U} \<in> \<T>}"
           by (rule rev_finite_subset) auto
         have "openin (X i) (\<Inter> (insert (topspace (X i)) {U. openin (X i) U \<and> {x. x i \<in> U} \<in> \<T>}))"
           by (rule openin_Inter) (auto simp: fin)
         then show ?thesis
           using \<open>f \<in> \<Inter> \<T>\<close> by (fastforce simp: that top)
       qed
       define \<Phi> where "\<Phi> \<equiv> \<lambda>i. topspace (X i) \<inter> \<Inter>{U. openin (X i) U \<and> {f. f i \<in> U} \<in> \<T>}"
       have "\<forall>i \<in> I. \<exists>x. x \<in> S i \<inter> \<Phi> i"
         using R [OF _ *] unfolding \<Phi>_def by blast
       then obtain \<theta> where \<theta> [rule_format]: "\<forall>i \<in> I. \<theta> i \<in> S i \<inter> \<Phi> i"
         by metis
       show "\<exists>y\<in>Pi\<^sub>E I S. \<exists>x\<in>\<U>. y \<in> x"
       proof
         show "\<exists>U \<in> \<U>. (\<lambda>i \<in> I. \<theta> i) \<in> U"
         proof
           have "restrict \<theta> I \<in> PiE I (topspace \<circ> X) \<inter> \<Inter>\<T>"
             using \<T> by (fastforce simp: \<Phi>_def PiE_def dest: \<theta>)
           then show "restrict \<theta> I \<in> U"
             using subU by blast
         qed (rule \<open>U \<in> \<U>\<close>)
       next
         show "(\<lambda>i \<in> I. \<theta> i) \<in> Pi\<^sub>E I S"
           using \<theta> by simp
       qed
     qed
   qed
   show ?thesis
     apply (simp add: * closure_of_def PiE_iff set_eq_iff cong: conj_cong)
     by metis
 qed
 
 corollary closedin_product_topology:
    "closedin (product_topology X I) (PiE I S) \<longleftrightarrow> PiE I S = {} \<or> (\<forall>i \<in> I. closedin (X i) (S i))"
   apply (simp add: PiE_eq PiE_eq_empty_iff closure_of_product_topology flip: closure_of_eq)
   apply (metis closure_of_empty)
   done
 
 corollary closedin_product_topology_singleton:
    "f \<in> extensional I \<Longrightarrow> closedin (product_topology X I) {f} \<longleftrightarrow> (\<forall>i \<in> I. closedin (X i) {f i})"
   using PiE_singleton closedin_product_topology [of X I]
   by (metis (no_types, lifting) all_not_in_conv insertI1)
 
 lemma product_topology_empty:
    "product_topology X {} = topology (\<lambda>S. S \<in> {{},{\<lambda>k. undefined}})"
   unfolding product_topology union_of_def intersection_of_def arbitrary_def relative_to_def
   by (auto intro: arg_cong [where f=topology])
 
 lemma openin_product_topology_empty: "openin (product_topology X {}) S \<longleftrightarrow> S \<in> {{},{\<lambda>k. undefined}}"
   unfolding union_of_def intersection_of_def arbitrary_def relative_to_def openin_product_topology
   by auto
 
 
 subsubsection \<open>The basic property of the product topology is the continuity of projections:\<close>
 
 lemma continuous_map_product_coordinates [simp]:
   assumes "i \<in> I"
   shows "continuous_map (product_topology T I) (T i) (\<lambda>x. x i)"
 proof -
   {
     fix U assume "openin (T i) U"
     define X where "X = (\<lambda>j. if j = i then U else topspace (T j))"
     then have *: "(\<lambda>x. x i) -` U \<inter> (\<Pi>\<^sub>E i\<in>I. topspace (T i)) = (\<Pi>\<^sub>E j\<in>I. X j)"
       unfolding X_def using assms openin_subset[OF \<open>openin (T i) U\<close>]
       by (auto simp add: PiE_iff, auto, metis subsetCE)
     have **: "(\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}"
       unfolding X_def using \<open>openin (T i) U\<close> by auto
     have "openin (product_topology T I) ((\<lambda>x. x i) -` U \<inter> (\<Pi>\<^sub>E i\<in>I. topspace (T i)))"
       unfolding product_topology_def
       apply (rule topology_generated_by_Basis)
       apply (subst *)
       using ** by auto
   }
   then show ?thesis unfolding continuous_map_alt
     by (auto simp add: assms PiE_iff)
 qed
 
 lemma continuous_map_coordinatewise_then_product [intro]:
   assumes "\<And>i. i \<in> I \<Longrightarrow> continuous_map T1 (T i) (\<lambda>x. f x i)"
           "\<And>i x. i \<notin> I \<Longrightarrow> x \<in> topspace T1 \<Longrightarrow> f x i = undefined"
   shows "continuous_map T1 (product_topology T I) f"
 unfolding product_topology_def
 proof (rule continuous_on_generated_topo)
   fix U assume "U \<in> {Pi\<^sub>E I X |X. (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}}"
   then obtain X where H: "U = Pi\<^sub>E I X" "\<And>i. openin (T i) (X i)" "finite {i. X i \<noteq> topspace (T i)}"
     by blast
   define J where "J = {i \<in> I. X i \<noteq> topspace (T i)}"
   have "finite J" "J \<subseteq> I" unfolding J_def using H(3) by auto
   have "(\<lambda>x. f x i)-`(topspace(T i)) \<inter> topspace T1 = topspace T1" if "i \<in> I" for i
     using that assms(1) by (simp add: continuous_map_preimage_topspace)
   then have *: "(\<lambda>x. f x i)-`(X i) \<inter> topspace T1 = topspace T1" if "i \<in> I-J" for i
     using that unfolding J_def by auto
   have "f-`U \<inter> topspace T1 = (\<Inter>i\<in>I. (\<lambda>x. f x i)-`(X i) \<inter> topspace T1) \<inter> (topspace T1)"
     by (subst H(1), auto simp add: PiE_iff assms)
   also have "... = (\<Inter>i\<in>J. (\<lambda>x. f x i)-`(X i) \<inter> topspace T1) \<inter> (topspace T1)"
     using * \<open>J \<subseteq> I\<close> by auto
   also have "openin T1 (...)"
     apply (rule openin_INT)
     apply (simp add: \<open>finite J\<close>)
     using H(2) assms(1) \<open>J \<subseteq> I\<close> by auto
   ultimately show "openin T1 (f-`U \<inter> topspace T1)" by simp
 next
   show "f `topspace T1 \<subseteq> \<Union>{Pi\<^sub>E I X |X. (\<forall>i. openin (T i) (X i)) \<and> finite {i. X i \<noteq> topspace (T i)}}"
     apply (subst topology_generated_by_topspace[symmetric])
     apply (subst product_topology_def[symmetric])
     apply (simp only: topspace_product_topology)
     apply (auto simp add: PiE_iff)
     using assms unfolding continuous_map_def by auto
 qed
 
 lemma continuous_map_product_then_coordinatewise [intro]:
   assumes "continuous_map T1 (product_topology T I) f"
   shows "\<And>i. i \<in> I \<Longrightarrow> continuous_map T1 (T i) (\<lambda>x. f x i)"
         "\<And>i x. i \<notin> I \<Longrightarrow> x \<in> topspace T1 \<Longrightarrow> f x i = undefined"
 proof -
   fix i assume "i \<in> I"
   have "(\<lambda>x. f x i) = (\<lambda>y. y i) o f" by auto
   also have "continuous_map T1 (T i) (...)"
     apply (rule continuous_map_compose[of _ "product_topology T I"])
     using assms \<open>i \<in> I\<close> by auto
   ultimately show "continuous_map T1 (T i) (\<lambda>x. f x i)"
     by simp
 next
   fix i x assume "i \<notin> I" "x \<in> topspace T1"
   have "f x \<in> topspace (product_topology T I)"
     using assms \<open>x \<in> topspace T1\<close> unfolding continuous_map_def by auto
   then have "f x \<in> (\<Pi>\<^sub>E i\<in>I. topspace (T i))"
     using topspace_product_topology by metis
   then show "f x i = undefined"
     using \<open>i \<notin> I\<close> by (auto simp add: PiE_iff extensional_def)
 qed
 
 lemma continuous_on_restrict:
   assumes "J \<subseteq> I"
   shows "continuous_map (product_topology T I) (product_topology T J) (\<lambda>x. restrict x J)"
 proof (rule continuous_map_coordinatewise_then_product)
   fix i assume "i \<in> J"
   then have "(\<lambda>x. restrict x J i) = (\<lambda>x. x i)" unfolding restrict_def by auto
   then show "continuous_map (product_topology T I) (T i) (\<lambda>x. restrict x J i)"
     using \<open>i \<in> J\<close> \<open>J \<subseteq> I\<close> by auto
 next
   fix i assume "i \<notin> J"
   then show "restrict x J i = undefined" for x::"'a \<Rightarrow> 'b"
     unfolding restrict_def by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Powers of a single topological space as a topological space, using type classes\<close>
 
 instantiation "fun" :: (type, topological_space) topological_space
 begin
 
 definition\<^marker>\<open>tag important\<close> open_fun_def:
   "open U = openin (product_topology (\<lambda>i. euclidean) UNIV) U"
 
 instance proof
   have "topspace (product_topology (\<lambda>(i::'a). euclidean::('b topology)) UNIV) = UNIV"
     unfolding topspace_product_topology topspace_euclidean by auto
   then show "open (UNIV::('a \<Rightarrow> 'b) set)"
     unfolding open_fun_def by (metis openin_topspace)
 qed (auto simp add: open_fun_def)
 
 end
 
 lemma open_PiE [intro?]:
   fixes X::"'i \<Rightarrow> ('b::topological_space) set"
   assumes "\<And>i. open (X i)" "finite {i. X i \<noteq> UNIV}"
   shows "open (Pi\<^sub>E UNIV X)"
     by (simp add: assms open_fun_def product_topology_basis)
 
 lemma euclidean_product_topology:
   "product_topology (\<lambda>i. euclidean::('b::topological_space) topology) UNIV = euclidean"
 by (metis open_openin topology_eq open_fun_def)
 
 proposition product_topology_basis':
   fixes x::"'i \<Rightarrow> 'a" and U::"'i \<Rightarrow> ('b::topological_space) set"
   assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> open (U i)"
   shows "open {f. \<forall>i\<in>I. f (x i) \<in> U i}"
 proof -
   define J where "J = x`I"
   define V where "V = (\<lambda>y. if y \<in> J then \<Inter>{U i|i. i\<in>I \<and> x i = y} else UNIV)"
   define X where "X = (\<lambda>y. if y \<in> J then V y else UNIV)"
   have *: "open (X i)" for i
     unfolding X_def V_def using assms by auto
   have **: "finite {i. X i \<noteq> UNIV}"
     unfolding X_def V_def J_def using assms(1) by auto
   have "open (Pi\<^sub>E UNIV X)"
     by (simp add: "*" "**" open_PiE)
   moreover have "Pi\<^sub>E UNIV X = {f. \<forall>i\<in>I. f (x i) \<in> U i}"
     apply (auto simp add: PiE_iff) unfolding X_def V_def J_def
     proof (auto)
       fix f :: "'a \<Rightarrow> 'b" and i :: 'i
       assume a1: "i \<in> I"
       assume a2: "\<forall>i. f i \<in> (if i \<in> x`I then if i \<in> x`I then \<Inter>{U ia |ia. ia \<in> I \<and> x ia = i} else UNIV else UNIV)"
       have f3: "x i \<in> x`I"
         using a1 by blast
       have "U i \<in> {U ia |ia. ia \<in> I \<and> x ia = x i}"
         using a1 by blast
       then show "f (x i) \<in> U i"
         using f3 a2 by (meson Inter_iff)
     qed
   ultimately show ?thesis by simp
 qed
 
 text \<open>The results proved in the general situation of products of possibly different
 spaces have their counterparts in this simpler setting.\<close>
 
 lemma continuous_on_product_coordinates [simp]:
   "continuous_on UNIV (\<lambda>x. x i::('b::topological_space))"
   using continuous_map_product_coordinates [of _ UNIV "\<lambda>i. euclidean"]
     by (metis (no_types) continuous_map_iff_continuous euclidean_product_topology iso_tuple_UNIV_I subtopology_UNIV)
 
 lemma continuous_on_coordinatewise_then_product [continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b \<Rightarrow> 'c::topological_space"
   assumes "\<And>i. continuous_on S (\<lambda>x. f x i)"
   shows "continuous_on S f"
   using continuous_map_coordinatewise_then_product [of UNIV, where T = "\<lambda>i. euclidean"]
   by (metis UNIV_I assms continuous_map_iff_continuous euclidean_product_topology)
 
 lemma continuous_on_product_then_coordinatewise_UNIV:
   assumes "continuous_on UNIV f"
   shows "continuous_on UNIV (\<lambda>x. f x i)"
   unfolding continuous_map_iff_continuous2 [symmetric]
   by (rule continuous_map_product_then_coordinatewise [where I=UNIV]) (use assms in \<open>auto simp: euclidean_product_topology\<close>)
 
 lemma continuous_on_product_then_coordinatewise:
   assumes "continuous_on S f"
   shows "continuous_on S (\<lambda>x. f x i)"
 proof -
   have "continuous_on S ((\<lambda>q. q i) \<circ> f)"
     by (metis assms continuous_on_compose continuous_on_id
         continuous_on_product_then_coordinatewise_UNIV continuous_on_subset subset_UNIV)
   then show ?thesis
     by auto
 qed
 
 lemma continuous_on_coordinatewise_iff:
   fixes f :: "('a \<Rightarrow> real) \<Rightarrow> 'b \<Rightarrow> real"
   shows "continuous_on (A \<inter> S) f \<longleftrightarrow> (\<forall>i. continuous_on (A \<inter> S) (\<lambda>x. f x i))"
   by (auto simp: continuous_on_product_then_coordinatewise continuous_on_coordinatewise_then_product)
 
 lemma continuous_map_span_sum:
   fixes B :: "'a::real_inner set"
   assumes biB: "\<And>i. i \<in> I \<Longrightarrow> b i \<in> B"
   shows "continuous_map euclidean (top_of_set (span B)) (\<lambda>x. \<Sum>i\<in>I. x i *\<^sub>R b i)"
 proof (rule continuous_map_euclidean_top_of_set)
   show "(\<lambda>x. \<Sum>i\<in>I. x i *\<^sub>R b i) -` span B = UNIV"
     by auto (meson biB lessThan_iff span_base span_scale span_sum)
   show "continuous_on UNIV (\<lambda>x. \<Sum>i\<in> I. x i *\<^sub>R b i)"
     by (intro continuous_intros) auto
 qed
 
 subsubsection\<^marker>\<open>tag important\<close> \<open>Topological countability for product spaces\<close>
 
 text \<open>The next two lemmas are useful to prove first or second countability
 of product spaces, but they have more to do with countability and could
 be put in the corresponding theory.\<close>
 
 lemma countable_nat_product_event_const:
   fixes F::"'a set" and a::'a
   assumes "a \<in> F" "countable F"
   shows "countable {x::(nat \<Rightarrow> 'a). (\<forall>i. x i \<in> F) \<and> finite {i. x i \<noteq> a}}"
 proof -
   have *: "{x::(nat \<Rightarrow> 'a). (\<forall>i. x i \<in> F) \<and> finite {i. x i \<noteq> a}}
                   \<subseteq> (\<Union>N. {x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)})"
     using infinite_nat_iff_unbounded_le by fastforce
   have "countable {x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)}" for N::nat
   proof (induction N)
     case 0
     have "{x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>(0::nat). x i = a)} = {(\<lambda>i. a)}"
       using \<open>a \<in> F\<close> by auto
     then show ?case by auto
   next
     case (Suc N)
     define f::"((nat \<Rightarrow> 'a) \<times> 'a) \<Rightarrow> (nat \<Rightarrow> 'a)"
       where "f = (\<lambda>(x, b). (\<lambda>i. if i = N then b else x i))"
     have "{x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>Suc N. x i = a)} \<subseteq> f`({x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)} \<times> F)"
     proof (auto)
       fix x assume H: "\<forall>i::nat. x i \<in> F" "\<forall>i\<ge>Suc N. x i = a"
       define y where "y = (\<lambda>i. if i = N then a else x i)"
       have "f (y, x N) = x"
         unfolding f_def y_def by auto
       moreover have "(y, x N) \<in> {x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)} \<times> F"
         unfolding y_def using H \<open>a \<in> F\<close> by auto
       ultimately show "x \<in> f`({x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)} \<times> F)"
         by (metis (no_types, lifting) image_eqI)
     qed
     moreover have "countable ({x. (\<forall>i. x i \<in> F) \<and> (\<forall>i\<ge>N. x i = a)} \<times> F)"
       using Suc.IH assms(2) by auto
     ultimately show ?case
       by (meson countable_image countable_subset)
   qed
   then show ?thesis using countable_subset[OF *] by auto
 qed
 
 lemma countable_product_event_const:
   fixes F::"('a::countable) \<Rightarrow> 'b set" and b::'b
   assumes "\<And>i. countable (F i)"
   shows "countable {f::('a \<Rightarrow> 'b). (\<forall>i. f i \<in> F i) \<and> (finite {i. f i \<noteq> b})}"
 proof -
   define G where "G = (\<Union>i. F i) \<union> {b}"
   have "countable G" unfolding G_def using assms by auto
   have "b \<in> G" unfolding G_def by auto
   define pi where "pi = (\<lambda>(x::(nat \<Rightarrow> 'b)). (\<lambda> i::'a. x ((to_nat::('a \<Rightarrow> nat)) i)))"
   have "{f::('a \<Rightarrow> 'b). (\<forall>i. f i \<in> F i) \<and> (finite {i. f i \<noteq> b})}
         \<subseteq> pi`{g::(nat \<Rightarrow> 'b). (\<forall>j. g j \<in> G) \<and> (finite {j. g j \<noteq> b})}"
   proof (auto)
     fix f assume H: "\<forall>i. f i \<in> F i" "finite {i. f i \<noteq> b}"
     define I where "I = {i. f i \<noteq> b}"
     define g where "g = (\<lambda>j. if j \<in> to_nat`I then f (from_nat j) else b)"
     have "{j. g j \<noteq> b} \<subseteq> to_nat`I" unfolding g_def by auto
     then have "finite {j. g j \<noteq> b}"
       unfolding I_def using H(2) using finite_surj by blast
     moreover have "g j \<in> G" for j
       unfolding g_def G_def using H by auto
     ultimately have "g \<in> {g::(nat \<Rightarrow> 'b). (\<forall>j. g j \<in> G) \<and> (finite {j. g j \<noteq> b})}"
       by auto
     moreover have "f = pi g"
       unfolding pi_def g_def I_def using H by fastforce
     ultimately show "f \<in> pi`{g. (\<forall>j. g j \<in> G) \<and> finite {j. g j \<noteq> b}}"
       by auto
   qed
   then show ?thesis
     using countable_nat_product_event_const[OF \<open>b \<in> G\<close> \<open>countable G\<close>]
     by (meson countable_image countable_subset)
 qed
 
 instance "fun" :: (countable, first_countable_topology) first_countable_topology
 proof
   fix x::"'a \<Rightarrow> 'b"
   have "\<exists>A::('b \<Rightarrow> nat \<Rightarrow> 'b set). \<forall>x. (\<forall>i. x \<in> A x i \<and> open (A x i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A x i \<subseteq> S))"
     apply (rule choice) using first_countable_basis by auto
   then obtain A::"('b \<Rightarrow> nat \<Rightarrow> 'b set)" where A: "\<And>x i. x \<in> A x i"
                                                   "\<And>x i. open (A x i)"
                                                   "\<And>x S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> (\<exists>i. A x i \<subseteq> S)"
     by metis
   text \<open>\<open>B i\<close> is a countable basis of neighborhoods of \<open>x\<^sub>i\<close>.\<close>
   define B where "B = (\<lambda>i. (A (x i))`UNIV \<union> {UNIV})"
   have "countable (B i)" for i unfolding B_def by auto
   have open_B: "\<And>X i. X \<in> B i \<Longrightarrow> open X"
     by (auto simp: B_def A)
   define K where "K = {Pi\<^sub>E UNIV X | X. (\<forall>i. X i \<in> B i) \<and> finite {i. X i \<noteq> UNIV}}"
   have "Pi\<^sub>E UNIV (\<lambda>i. UNIV) \<in> K"
     unfolding K_def B_def by auto
   then have "K \<noteq> {}" by auto
   have "countable {X. (\<forall>i. X i \<in> B i) \<and> finite {i. X i \<noteq> UNIV}}"
     apply (rule countable_product_event_const) using \<open>\<And>i. countable (B i)\<close> by auto
   moreover have "K = (\<lambda>X. Pi\<^sub>E UNIV X)`{X. (\<forall>i. X i \<in> B i) \<and> finite {i. X i \<noteq> UNIV}}"
     unfolding K_def by auto
   ultimately have "countable K" by auto
   have "x \<in> k" if "k \<in> K" for k
     using that unfolding K_def B_def apply auto using A(1) by auto
   have "open k" if "k \<in> K" for k
     using that unfolding K_def  by (blast intro: open_B open_PiE elim: )
   have Inc: "\<exists>k\<in>K. k \<subseteq> U" if "open U \<and> x \<in> U" for U
   proof -
     have "openin (product_topology (\<lambda>i. euclidean) UNIV) U" "x \<in> U"
       using \<open>open U \<and> x \<in> U\<close> unfolding open_fun_def by auto
     with product_topology_open_contains_basis[OF this]
     have "\<exists>X. x \<in> (\<Pi>\<^sub>E i\<in>UNIV. X i) \<and> (\<forall>i. open (X i)) \<and> finite {i. X i \<noteq> UNIV} \<and> (\<Pi>\<^sub>E i\<in>UNIV. X i) \<subseteq> U"
       by simp
     then obtain X where H: "x \<in> (\<Pi>\<^sub>E i\<in>UNIV. X i)"
                            "\<And>i. open (X i)"
                            "finite {i. X i \<noteq> UNIV}"
                            "(\<Pi>\<^sub>E i\<in>UNIV. X i) \<subseteq> U"
       by auto
     define I where "I = {i. X i \<noteq> UNIV}"
     define Y where "Y = (\<lambda>i. if i \<in> I then (SOME y. y \<in> B i \<and> y \<subseteq> X i) else UNIV)"
     have *: "\<exists>y. y \<in> B i \<and> y \<subseteq> X i" for i
       unfolding B_def using A(3)[OF H(2)] H(1) by (metis PiE_E UNIV_I UnCI image_iff)
     have **: "Y i \<in> B i \<and> Y i \<subseteq> X i" for i
       apply (cases "i \<in> I")
       unfolding Y_def using * that apply (auto)
       apply (metis (no_types, lifting) someI, metis (no_types, lifting) someI_ex subset_iff)
       unfolding B_def apply simp
       unfolding I_def apply auto
       done
     have "{i. Y i \<noteq> UNIV} \<subseteq> I"
       unfolding Y_def by auto
     then have ***: "finite {i. Y i \<noteq> UNIV}"
       unfolding I_def using H(3) rev_finite_subset by blast
     have "(\<forall>i. Y i \<in> B i) \<and> finite {i. Y i \<noteq> UNIV}"
       using ** *** by auto
     then have "Pi\<^sub>E UNIV Y \<in> K"
       unfolding K_def by auto
 
     have "Y i \<subseteq> X i" for i
       apply (cases "i \<in> I") using ** apply simp unfolding Y_def I_def by auto
     then have "Pi\<^sub>E UNIV Y \<subseteq> Pi\<^sub>E UNIV X" by auto
     then have "Pi\<^sub>E UNIV Y \<subseteq> U" using H(4) by auto
     then show ?thesis using \<open>Pi\<^sub>E UNIV Y \<in> K\<close> by auto
   qed
 
   show "\<exists>L. (\<forall>(i::nat). x \<in> L i \<and> open (L i)) \<and> (\<forall>U. open U \<and> x \<in> U \<longrightarrow> (\<exists>i. L i \<subseteq> U))"
     apply (rule first_countableI[of K])
     using \<open>countable K\<close> \<open>\<And>k. k \<in> K \<Longrightarrow> x \<in> k\<close> \<open>\<And>k. k \<in> K \<Longrightarrow> open k\<close> Inc by auto
 qed
 
 proposition product_topology_countable_basis:
   shows "\<exists>K::(('a::countable \<Rightarrow> 'b::second_countable_topology) set set).
           topological_basis K \<and> countable K \<and>
           (\<forall>k\<in>K. \<exists>X. (k = Pi\<^sub>E UNIV X) \<and> (\<forall>i. open (X i)) \<and> finite {i. X i \<noteq> UNIV})"
 proof -
   obtain B::"'b set set" where B: "countable B \<and> topological_basis B"
     using ex_countable_basis by auto
   then have "B \<noteq> {}" by (meson UNIV_I empty_iff open_UNIV topological_basisE)
   define B2 where "B2 = B \<union> {UNIV}"
   have "countable B2"
     unfolding B2_def using B by auto
   have "open U" if "U \<in> B2" for U
     using that unfolding B2_def using B topological_basis_open by auto
 
   define K where "K = {Pi\<^sub>E UNIV X | X. (\<forall>i::'a. X i \<in> B2) \<and> finite {i. X i \<noteq> UNIV}}"
   have i: "\<forall>k\<in>K. \<exists>X. (k = Pi\<^sub>E UNIV X) \<and> (\<forall>i. open (X i)) \<and> finite {i. X i \<noteq> UNIV}"
     unfolding K_def using \<open>\<And>U. U \<in> B2 \<Longrightarrow> open U\<close> by auto
 
   have "countable {X. (\<forall>(i::'a). X i \<in> B2) \<and> finite {i. X i \<noteq> UNIV}}"
     apply (rule countable_product_event_const) using \<open>countable B2\<close> by auto
   moreover have "K = (\<lambda>X. Pi\<^sub>E UNIV X)`{X. (\<forall>i. X i \<in> B2) \<and> finite {i. X i \<noteq> UNIV}}"
     unfolding K_def by auto
   ultimately have ii: "countable K" by auto
 
   have iii: "topological_basis K"
   proof (rule topological_basisI)
     fix U and x::"'a\<Rightarrow>'b" assume "open U" "x \<in> U"
     then have "openin (product_topology (\<lambda>i. euclidean) UNIV) U"
       unfolding open_fun_def by auto
     with product_topology_open_contains_basis[OF this \<open>x \<in> U\<close>]
     have "\<exists>X. x \<in> (\<Pi>\<^sub>E i\<in>UNIV. X i) \<and> (\<forall>i. open (X i)) \<and> finite {i. X i \<noteq> UNIV} \<and> (\<Pi>\<^sub>E i\<in>UNIV. X i) \<subseteq> U"
       by simp
     then obtain X where H: "x \<in> (\<Pi>\<^sub>E i\<in>UNIV. X i)"
                            "\<And>i. open (X i)"
                            "finite {i. X i \<noteq> UNIV}"
                            "(\<Pi>\<^sub>E i\<in>UNIV. X i) \<subseteq> U"
       by auto
     then have "x i \<in> X i" for i by auto
     define I where "I = {i. X i \<noteq> UNIV}"
     define Y where "Y = (\<lambda>i. if i \<in> I then (SOME y. y \<in> B2 \<and> y \<subseteq> X i \<and> x i \<in> y) else UNIV)"
     have *: "\<exists>y. y \<in> B2 \<and> y \<subseteq> X i \<and> x i \<in> y" for i
       unfolding B2_def using B \<open>open (X i)\<close> \<open>x i \<in> X i\<close> by (meson UnCI topological_basisE)
     have **: "Y i \<in> B2 \<and> Y i \<subseteq> X i \<and> x i \<in> Y i" for i
       using someI_ex[OF *]
       apply (cases "i \<in> I")
       unfolding Y_def using * apply (auto)
       unfolding B2_def I_def by auto
     have "{i. Y i \<noteq> UNIV} \<subseteq> I"
       unfolding Y_def by auto
     then have ***: "finite {i. Y i \<noteq> UNIV}"
       unfolding I_def using H(3) rev_finite_subset by blast
     have "(\<forall>i. Y i \<in> B2) \<and> finite {i. Y i \<noteq> UNIV}"
       using ** *** by auto
     then have "Pi\<^sub>E UNIV Y \<in> K"
       unfolding K_def by auto
 
     have "Y i \<subseteq> X i" for i
       apply (cases "i \<in> I") using ** apply simp unfolding Y_def I_def by auto
     then have "Pi\<^sub>E UNIV Y \<subseteq> Pi\<^sub>E UNIV X" by auto
     then have "Pi\<^sub>E UNIV Y \<subseteq> U" using H(4) by auto
 
     have "x \<in> Pi\<^sub>E UNIV Y"
       using ** by auto
 
     show "\<exists>V\<in>K. x \<in> V \<and> V \<subseteq> U"
       using \<open>Pi\<^sub>E UNIV Y \<in> K\<close> \<open>Pi\<^sub>E UNIV Y \<subseteq> U\<close> \<open>x \<in> Pi\<^sub>E UNIV Y\<close> by auto
   next
     fix U assume "U \<in> K"
     show "open U"
       using \<open>U \<in> K\<close> unfolding open_fun_def K_def  by clarify (metis \<open>U \<in> K\<close> i open_PiE open_fun_def)
   qed
 
   show ?thesis using i ii iii by auto
 qed
 
 instance "fun" :: (countable, second_countable_topology) second_countable_topology
   apply standard
   using product_topology_countable_basis topological_basis_imp_subbasis by auto
 
 subsection \<open>Metrics on product spaces\<close>
 
 
 text \<open>In general, the product topology is not metrizable, unless the index set is countable.
 When the index set is countable, essentially any (convergent) combination of the metrics on the
 factors will do. We use below the simplest one, based on \<open>L\<^sup>1\<close>, but \<open>L\<^sup>2\<close> would also work,
 for instance.
 
 What is not completely trivial is that the distance thus defined induces the same topology
 as the product topology. This is what we have to prove to show that we have an instance
 of \<^class>\<open>metric_space\<close>.
 
 The proofs below would work verbatim for general countable products of metric spaces. However,
 since distances are only implemented in terms of type classes, we only develop the theory
 for countable products of the same space.\<close>
 
 instantiation "fun" :: (countable, metric_space) metric_space
 begin
 
 definition\<^marker>\<open>tag important\<close> dist_fun_def:
   "dist x y = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
 
 definition\<^marker>\<open>tag important\<close> uniformity_fun_def:
   "(uniformity::(('a \<Rightarrow> 'b) \<times> ('a \<Rightarrow> 'b)) filter) = (INF e\<in>{0<..}. principal {(x, y). dist (x::('a\<Rightarrow>'b)) y < e})"
 
 text \<open>Except for the first one, the auxiliary lemmas below are only useful when proving the
 instance: once it is proved, they become trivial consequences of the general theory of metric
 spaces. It would thus be desirable to hide them once the instance is proved, but I do not know how
 to do this.\<close>
 
 lemma dist_fun_le_dist_first_terms:
   "dist x y \<le> 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} + (1/2)^N"
 proof -
   have "(\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
           = (\<Sum>n. (1 / 2) ^ (Suc N) * ((1/2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1))"
     by (rule suminf_cong, simp add: power_add)
   also have "... = (1/2)^(Suc N) * (\<Sum>n. (1 / 2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)"
     apply (rule suminf_mult)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... \<le> (1/2)^(Suc N) * (\<Sum>n. (1 / 2) ^ n)"
     apply (simp, rule suminf_le, simp)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... = (1/2)^(Suc N) * 2"
     using suminf_geometric[of "1/2"] by auto
   also have "... = (1/2)^N"
     by auto
   finally have *: "(\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1) \<le> (1/2)^N"
     by simp
 
   define M where "M = Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N}"
   have "dist (x (from_nat 0)) (y (from_nat 0)) \<le> M"
     unfolding M_def by (rule Max_ge, auto)
   then have [simp]: "M \<ge> 0" by (meson dual_order.trans zero_le_dist)
   have "dist (x (from_nat n)) (y (from_nat n)) \<le> M" if "n\<le>N" for n
     unfolding M_def apply (rule Max_ge) using that by auto
   then have i: "min (dist (x (from_nat n)) (y (from_nat n))) 1 \<le> M" if "n\<le>N" for n
     using that by force
   have "(\<Sum>n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) \<le>
       (\<Sum>n< Suc N. M * (1 / 2) ^ n)"
     by (rule sum_mono, simp add: i)
   also have "... = M * (\<Sum>n<Suc N. (1 / 2) ^ n)"
     by (rule sum_distrib_left[symmetric])
   also have "... \<le> M * (\<Sum>n. (1 / 2) ^ n)"
     by (rule mult_left_mono, rule sum_le_suminf, auto simp add: summable_geometric_iff)
   also have "... = M * 2"
     using suminf_geometric[of "1/2"] by auto
   finally have **: "(\<Sum>n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) \<le> 2 * M"
     by simp
 
   have "dist x y = (\<Sum>n. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     unfolding dist_fun_def by simp
   also have "... = (\<Sum>n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
                   + (\<Sum>n<Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     apply (rule suminf_split_initial_segment)
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   also have "... \<le> 2 * M + (1/2)^N"
     using * ** by auto
   finally show ?thesis unfolding M_def by simp
 qed
 
 lemma open_fun_contains_ball_aux:
   assumes "open (U::(('a \<Rightarrow> 'b) set))"
           "x \<in> U"
   shows "\<exists>e>0. {y. dist x y < e} \<subseteq> U"
 proof -
   have *: "openin (product_topology (\<lambda>i. euclidean) UNIV) U"
     using open_fun_def assms by auto
   obtain X where H: "Pi\<^sub>E UNIV X \<subseteq> U"
                     "\<And>i. openin euclidean (X i)"
                     "finite {i. X i \<noteq> topspace euclidean}"
                     "x \<in> Pi\<^sub>E UNIV X"
     using product_topology_open_contains_basis[OF * \<open>x \<in> U\<close>] by auto
   define I where "I = {i. X i \<noteq> topspace euclidean}"
   have "finite I" unfolding I_def using H(3) by auto
   {
     fix i
     have "x i \<in> X i" using \<open>x \<in> U\<close> H by auto
     then have "\<exists>e. e>0 \<and> ball (x i) e \<subseteq> X i"
       using \<open>openin euclidean (X i)\<close> open_openin open_contains_ball by blast
     then obtain e where "e>0" "ball (x i) e \<subseteq> X i" by blast
     define f where "f = min e (1/2)"
     have "f>0" "f<1" unfolding f_def using \<open>e>0\<close> by auto
     moreover have "ball (x i) f \<subseteq> X i" unfolding f_def using \<open>ball (x i) e \<subseteq> X i\<close> by auto
     ultimately have "\<exists>f. f > 0 \<and> f < 1 \<and> ball (x i) f \<subseteq> X i" by auto
   } note * = this
   have "\<exists>e. \<forall>i. e i > 0 \<and> e i < 1 \<and> ball (x i) (e i) \<subseteq> X i"
     by (rule choice, auto simp add: *)
   then obtain e where "\<And>i. e i > 0" "\<And>i. e i < 1" "\<And>i. ball (x i) (e i) \<subseteq> X i"
     by blast
   define m where "m = Min {(1/2)^(to_nat i) * e i|i. i \<in> I}"
   have "m > 0" if "I\<noteq>{}"
     unfolding m_def Min_gr_iff using \<open>finite I\<close> \<open>I \<noteq> {}\<close> \<open>\<And>i. e i > 0\<close> by auto
   moreover have "{y. dist x y < m} \<subseteq> U"
   proof (auto)
     fix y assume "dist x y < m"
     have "y i \<in> X i" if "i \<in> I" for i
     proof -
       have *: "summable (\<lambda>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
         by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
       define n where "n = to_nat i"
       have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 < m"
         using \<open>dist x y < m\<close> unfolding dist_fun_def using sum_le_suminf[OF *, of "{n}"] by auto
       then have "(1/2)^(to_nat i) * min (dist (x i) (y i)) 1 < m"
         using \<open>n = to_nat i\<close> by auto
       also have "... \<le> (1/2)^(to_nat i) * e i"
         unfolding m_def apply (rule Min_le) using \<open>finite I\<close> \<open>i \<in> I\<close> by auto
       ultimately have "min (dist (x i) (y i)) 1 < e i"
         by (auto simp add: field_split_simps)
       then have "dist (x i) (y i) < e i"
         using \<open>e i < 1\<close> by auto
       then show "y i \<in> X i" using \<open>ball (x i) (e i) \<subseteq> X i\<close> by auto
     qed
     then have "y \<in> Pi\<^sub>E UNIV X" using H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
     then show "y \<in> U" using \<open>Pi\<^sub>E UNIV X \<subseteq> U\<close> by auto
   qed
   ultimately have *: "\<exists>m>0. {y. dist x y < m} \<subseteq> U" if "I \<noteq> {}" using that by auto
 
   have "U = UNIV" if "I = {}"
     using that H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
   then have "\<exists>m>0. {y. dist x y < m} \<subseteq> U" if "I = {}" using that zero_less_one by blast
   then show "\<exists>m>0. {y. dist x y < m} \<subseteq> U" using * by blast
 qed
 
 lemma ball_fun_contains_open_aux:
   fixes x::"('a \<Rightarrow> 'b)" and e::real
   assumes "e>0"
   shows "\<exists>U. open U \<and> x \<in> U \<and> U \<subseteq> {y. dist x y < e}"
 proof -
   have "\<exists>N::nat. 2^N > 8/e"
     by (simp add: real_arch_pow)
   then obtain N::nat where "2^N > 8/e" by auto
   define f where "f = e/4"
   have [simp]: "e>0" "f > 0" unfolding f_def using assms by auto
   define X::"('a \<Rightarrow> 'b set)" where "X = (\<lambda>i. if (\<exists>n\<le>N. i = from_nat n) then {z. dist (x i) z < f} else UNIV)"
   have "{i. X i \<noteq> UNIV} \<subseteq> from_nat`{0..N}"
     unfolding X_def by auto
   then have "finite {i. X i \<noteq> topspace euclidean}"
     unfolding topspace_euclidean using finite_surj by blast
   have "\<And>i. open (X i)"
     unfolding X_def using metric_space_class.open_ball open_UNIV by auto
   then have "\<And>i. openin euclidean (X i)"
     using open_openin by auto
   define U where "U = Pi\<^sub>E UNIV X"
   have "open U"
     unfolding open_fun_def product_topology_def apply (rule topology_generated_by_Basis)
     unfolding U_def using \<open>\<And>i. openin euclidean (X i)\<close> \<open>finite {i. X i \<noteq> topspace euclidean}\<close>
     by auto
   moreover have "x \<in> U"
     unfolding U_def X_def by (auto simp add: PiE_iff)
   moreover have "dist x y < e" if "y \<in> U" for y
   proof -
     have *: "dist (x (from_nat n)) (y (from_nat n)) \<le> f" if "n \<le> N" for n
       using \<open>y \<in> U\<close> unfolding U_def apply (auto simp add: PiE_iff)
       unfolding X_def using that by (metis less_imp_le mem_Collect_eq)
     have **: "Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} \<le> f"
       apply (rule Max.boundedI) using * by auto
 
     have "dist x y \<le> 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n \<le> N} + (1/2)^N"
       by (rule dist_fun_le_dist_first_terms)
     also have "... \<le> 2 * f + e / 8"
       apply (rule add_mono) using ** \<open>2^N > 8/e\<close> by(auto simp add: algebra_simps field_split_simps)
     also have "... \<le> e/2 + e/8"
       unfolding f_def by auto
     also have "... < e"
       by auto
     finally show "dist x y < e" by simp
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma fun_open_ball_aux:
   fixes U::"('a \<Rightarrow> 'b) set"
   shows "open U \<longleftrightarrow> (\<forall>x\<in>U. \<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U)"
 proof (auto)
   assume "open U"
   fix x assume "x \<in> U"
   then show "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U"
     using open_fun_contains_ball_aux[OF \<open>open U\<close> \<open>x \<in> U\<close>] by auto
 next
   assume H: "\<forall>x\<in>U. \<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U"
   define K where "K = {V. open V \<and> V \<subseteq> U}"
   {
     fix x assume "x \<in> U"
     then obtain e where e: "e>0" "{y. dist x y < e} \<subseteq> U" using H by blast
     then obtain V where V: "open V" "x \<in> V" "V \<subseteq> {y. dist x y < e}"
       using ball_fun_contains_open_aux[OF \<open>e>0\<close>, of x] by auto
     have "V \<in> K"
       unfolding K_def using e(2) V(1) V(3) by auto
     then have "x \<in> (\<Union>K)" using \<open>x \<in> V\<close> by auto
   }
   then have "(\<Union>K) = U"
     unfolding K_def by auto
   moreover have "open (\<Union>K)"
     unfolding K_def by auto
   ultimately show "open U" by simp
 qed
 
 instance proof
   fix x y::"'a \<Rightarrow> 'b" show "(dist x y = 0) = (x = y)"
   proof
     assume "x = y"
     then show "dist x y = 0" unfolding dist_fun_def using \<open>x = y\<close> by auto
   next
     assume "dist x y = 0"
     have *: "summable (\<lambda>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
       by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
     have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 = 0" for n
       using \<open>dist x y = 0\<close> unfolding dist_fun_def by (simp add: "*" suminf_eq_zero_iff)
     then have "dist (x (from_nat n)) (y (from_nat n)) = 0" for n
       by (metis div_0 min_def nonzero_mult_div_cancel_left power_eq_0_iff
                 zero_eq_1_divide_iff zero_neq_numeral)
     then have "x (from_nat n) = y (from_nat n)" for n
       by auto
     then have "x i = y i" for i
       by (metis from_nat_to_nat)
     then show "x = y"
       by auto
   qed
 next
   text\<open>The proof of the triangular inequality is trivial, modulo the fact that we are dealing
         with infinite series, hence we should justify the convergence at each step. In this
         respect, the following simplification rule is extremely handy.\<close>
   have [simp]: "summable (\<lambda>n. (1/2)^n * min (dist (u (from_nat n)) (v (from_nat n))) 1)" for u v::"'a \<Rightarrow> 'b"
     by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
   fix x y z::"'a \<Rightarrow> 'b"
   {
     fix n
     have *: "dist (x (from_nat n)) (y (from_nat n)) \<le>
             dist (x (from_nat n)) (z (from_nat n)) + dist (y (from_nat n)) (z (from_nat n))"
       by (simp add: dist_triangle2)
     have "0 \<le> dist (y (from_nat n)) (z (from_nat n))"
       using zero_le_dist by blast
     moreover
     {
       assume "min (dist (y (from_nat n)) (z (from_nat n))) 1 \<noteq> dist (y (from_nat n)) (z (from_nat n))"
       then have "1 \<le> min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
         by (metis (no_types) diff_le_eq diff_self min_def zero_le_dist zero_le_one)
     }
     ultimately have "min (dist (x (from_nat n)) (y (from_nat n))) 1 \<le>
             min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
       using * by linarith
   } note ineq = this
   have "dist x y = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
     unfolding dist_fun_def by simp
   also have "... \<le> (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1
                         + (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
     apply (rule suminf_le)
     using ineq apply (metis (no_types, hide_lams) add.right_neutral distrib_left
       le_divide_eq_numeral1(1) mult_2_right mult_left_mono zero_le_one zero_le_power)
     by (auto simp add: summable_add)
   also have "... = (\<Sum>n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1)
                   + (\<Sum>n. (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
     by (rule suminf_add[symmetric], auto)
   also have "... = dist x z + dist y z"
     unfolding dist_fun_def by simp
   finally show "dist x y \<le> dist x z + dist y z"
     by simp
 next
   text\<open>Finally, we show that the topology generated by the distance and the product
         topology coincide. This is essentially contained in Lemma \<open>fun_open_ball_aux\<close>,
         except that the condition to prove is expressed with filters. To deal with this,
         we copy some mumbo jumbo from Lemma \<open>eventually_uniformity_metric\<close> in
         \<^file>\<open>~~/src/HOL/Real_Vector_Spaces.thy\<close>\<close>
   fix U::"('a \<Rightarrow> 'b) set"
   have "eventually P uniformity \<longleftrightarrow> (\<exists>e>0. \<forall>x (y::('a \<Rightarrow> 'b)). dist x y < e \<longrightarrow> P (x, y))" for P
   unfolding uniformity_fun_def apply (subst eventually_INF_base)
     by (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
   then show "open U = (\<forall>x\<in>U. \<forall>\<^sub>F (x', y) in uniformity. x' = x \<longrightarrow> y \<in> U)"
     unfolding fun_open_ball_aux by simp
 qed (simp add: uniformity_fun_def)
 
 end
 
 text \<open>Nice properties of spaces are preserved under countable products. In addition
 to first countability, second countability and metrizability, as we have seen above,
 completeness is also preserved, and therefore being Polish.\<close>
 
 instance "fun" :: (countable, complete_space) complete_space
 proof
   fix u::"nat \<Rightarrow> ('a \<Rightarrow> 'b)" assume "Cauchy u"
   have "Cauchy (\<lambda>n. u n i)" for i
   unfolding cauchy_def proof (intro impI allI)
     fix e assume "e>(0::real)"
     obtain k where "i = from_nat k"
       using from_nat_to_nat[of i] by metis
     have "(1/2)^k * min e 1 > 0" using \<open>e>0\<close> by auto
     then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m) (u n) < (1/2)^k * min e 1"
       using \<open>Cauchy u\<close> unfolding cauchy_def by blast
     then obtain N::nat where C: "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m) (u n) < (1/2)^k * min e 1"
       by blast
     have "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m i) (u n i) < e"
     proof (auto)
       fix m n::nat assume "m \<ge> N" "n \<ge> N"
       have "(1/2)^k * min (dist (u m i) (u n i)) 1
               = sum (\<lambda>p. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1) {k}"
         using \<open>i = from_nat k\<close> by auto
       also have "... \<le> (\<Sum>p. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1)"
         apply (rule sum_le_suminf)
         by (rule summable_comparison_test'[of "\<lambda>n. (1/2)^n"], auto simp add: summable_geometric_iff)
       also have "... = dist (u m) (u n)"
         unfolding dist_fun_def by auto
       also have "... < (1/2)^k * min e 1"
         using C \<open>m \<ge> N\<close> \<open>n \<ge> N\<close> by auto
       finally have "min (dist (u m i) (u n i)) 1 < min e 1"
         by (auto simp add: algebra_simps field_split_simps)
       then show "dist (u m i) (u n i) < e" by auto
     qed
     then show "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (u m i) (u n i) < e"
       by blast
   qed
   then have "\<exists>x. (\<lambda>n. u n i) \<longlonglongrightarrow> x" for i
     using Cauchy_convergent convergent_def by auto
   then have "\<exists>x. \<forall>i. (\<lambda>n. u n i) \<longlonglongrightarrow> x i"
     using choice by force
   then obtain x where *: "\<And>i. (\<lambda>n. u n i) \<longlonglongrightarrow> x i" by blast
   have "u \<longlonglongrightarrow> x"
   proof (rule metric_LIMSEQ_I)
     fix e assume [simp]: "e>(0::real)"
     have i: "\<exists>K. \<forall>n\<ge>K. dist (u n i) (x i) < e/4" for i
       by (rule metric_LIMSEQ_D, auto simp add: *)
     have "\<exists>K. \<forall>i. \<forall>n\<ge>K i. dist (u n i) (x i) < e/4"
       apply (rule choice) using i by auto
     then obtain K where K: "\<And>i n. n \<ge> K i \<Longrightarrow> dist (u n i) (x i) < e/4"
       by blast
 
     have "\<exists>N::nat. 2^N > 4/e"
       by (simp add: real_arch_pow)
     then obtain N::nat where "2^N > 4/e" by auto
     define L where "L = Max {K (from_nat n)|n. n \<le> N}"
     have "dist (u k) x < e" if "k \<ge> L" for k
     proof -
       have *: "dist (u k (from_nat n)) (x (from_nat n)) \<le> e / 4" if "n \<le> N" for n
       proof -
         have "K (from_nat n) \<le> L"
           unfolding L_def apply (rule Max_ge) using \<open>n \<le> N\<close> by auto
         then have "k \<ge> K (from_nat n)" using \<open>k \<ge> L\<close> by auto
         then show ?thesis using K less_imp_le by auto
       qed
       have **: "Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n \<le> N} \<le> e/4"
         apply (rule Max.boundedI) using * by auto
       have "dist (u k) x \<le> 2 * Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n \<le> N} + (1/2)^N"
         using dist_fun_le_dist_first_terms by auto
       also have "... \<le> 2 * e/4 + e/4"
         apply (rule add_mono)
         using ** \<open>2^N > 4/e\<close> less_imp_le by (auto simp add: algebra_simps field_split_simps)
       also have "... < e" by auto
       finally show ?thesis by simp
     qed
     then show "\<exists>L. \<forall>k\<ge>L. dist (u k) x < e" by blast
   qed
   then show "convergent u" using convergent_def by blast
 qed
 
 instance "fun" :: (countable, polish_space) polish_space
   by standard
 
 
 subsection\<open>The Alexander subbase theorem\<close>
 
 theorem Alexander_subbase:
   assumes X: "topology (arbitrary union_of (finite intersection_of (\<lambda>x. x \<in> \<B>) relative_to \<Union>\<B>)) = X"
     and fin: "\<And>C. \<lbrakk>C \<subseteq> \<B>; \<Union>C = topspace X\<rbrakk> \<Longrightarrow> \<exists>C'. finite C' \<and> C' \<subseteq> C \<and> \<Union>C' = topspace X"
   shows "compact_space X"
 proof -
   have U\<B>: "\<Union>\<B> = topspace X"
     by (simp flip: X)
   have False if \<U>: "\<forall>U\<in>\<U>. openin X U" and sub: "topspace X \<subseteq> \<Union>\<U>"
     and neg: "\<And>\<F>. \<lbrakk>\<F> \<subseteq> \<U>; finite \<F>\<rbrakk> \<Longrightarrow> \<not> topspace X \<subseteq> \<Union>\<F>" for \<U>
   proof -
     define \<A> where "\<A> \<equiv> {\<C>. (\<forall>U \<in> \<C>. openin X U) \<and> topspace X \<subseteq> \<Union>\<C> \<and> (\<forall>\<F>. finite \<F> \<longrightarrow> \<F> \<subseteq> \<C> \<longrightarrow> ~(topspace X \<subseteq> \<Union>\<F>))}"
     have 1: "\<A> \<noteq> {}"
       unfolding \<A>_def using sub \<U> neg by force
     have 2: "\<Union>\<C> \<in> \<A>" if "\<C>\<noteq>{}" and \<C>: "subset.chain \<A> \<C>" for \<C>
       unfolding \<A>_def
     proof (intro CollectI conjI ballI allI impI notI)
       show "openin X U" if U: "U \<in> \<Union>\<C>" for U
         using U \<C> unfolding \<A>_def subset_chain_def by force
       have "\<C> \<subseteq> \<A>"
         using subset_chain_def \<C> by blast
       with that \<A>_def show UUC: "topspace X \<subseteq> \<Union>(\<Union>\<C>)"
         by blast
       show "False" if "finite \<F>" and "\<F> \<subseteq> \<Union>\<C>" and "topspace X \<subseteq> \<Union>\<F>" for \<F>
       proof -
         obtain \<B> where "\<B> \<in> \<C>" "\<F> \<subseteq> \<B>"
           by (metis Sup_empty \<C> \<open>\<F> \<subseteq> \<Union>\<C>\<close> \<open>finite \<F>\<close> UUC empty_subsetI finite.emptyI finite_subset_Union_chain neg)
         then show False
           using \<A>_def \<open>\<C> \<subseteq> \<A>\<close> \<open>finite \<F>\<close> \<open>topspace X \<subseteq> \<Union>\<F>\<close> by blast
       qed
     qed
     obtain \<K> where "\<K> \<in> \<A>" and "\<And>X. \<lbrakk>X\<in>\<A>; \<K> \<subseteq> X\<rbrakk> \<Longrightarrow> X = \<K>"
       using subset_Zorn_nonempty [OF 1 2] by metis
     then have *: "\<And>\<W>. \<lbrakk>\<And>W. W\<in>\<W> \<Longrightarrow> openin X W; topspace X \<subseteq> \<Union>\<W>; \<K> \<subseteq> \<W>;
                         \<And>\<F>. \<lbrakk>finite \<F>; \<F> \<subseteq> \<W>; topspace X \<subseteq> \<Union>\<F>\<rbrakk> \<Longrightarrow> False\<rbrakk>
            \<Longrightarrow> \<W> = \<K>"
       and ope: "\<forall>U\<in>\<K>. openin X U" and top: "topspace X \<subseteq> \<Union>\<K>"
       and non: "\<And>\<F>. \<lbrakk>finite \<F>; \<F> \<subseteq> \<K>; topspace X \<subseteq> \<Union>\<F>\<rbrakk> \<Longrightarrow> False"
       unfolding \<A>_def by simp_all metis+
     then obtain x where "x \<in> topspace X" "x \<notin> \<Union>(\<B> \<inter> \<K>)"
     proof -
       have "\<Union>(\<B> \<inter> \<K>) \<noteq> \<Union>\<B>"
         by (metis \<open>\<Union>\<B> = topspace X\<close> fin inf.bounded_iff non order_refl)
       then have "\<exists>a. a \<notin> \<Union>(\<B> \<inter> \<K>) \<and> a \<in> \<Union>\<B>"
         by blast
       then show ?thesis
         using that by (metis U\<B>)
     qed
     obtain C where C: "openin X C" "C \<in> \<K>" "x \<in> C"
       using \<open>x \<in> topspace X\<close> ope top by auto
     then have "C \<subseteq> topspace X"
       by (metis openin_subset)
     then have "(arbitrary union_of (finite intersection_of (\<lambda>x. x \<in> \<B>) relative_to \<Union>\<B>)) C"
       using openin_subbase C unfolding X [symmetric] by blast
     moreover have "C \<noteq> topspace X"
       using \<open>\<K> \<in> \<A>\<close> \<open>C \<in> \<K>\<close> unfolding \<A>_def by blast
     ultimately obtain \<V> W where W: "(finite intersection_of (\<lambda>x. x \<in> \<B>) relative_to topspace X) W"
       and "x \<in> W" "W \<in> \<V>" "\<Union>\<V> \<noteq> topspace X" "C = \<Union>\<V>"
       using C  by (auto simp: union_of_def U\<B>)
     then have "\<Union>\<V> \<subseteq> topspace X"
       by (metis \<open>C \<subseteq> topspace X\<close>)
     then have "topspace X \<notin> \<V>"
       using \<open>\<Union>\<V> \<noteq> topspace X\<close> by blast
     then obtain \<B>' where \<B>': "finite \<B>'" "\<B>' \<subseteq> \<B>" "x \<in> \<Inter>\<B>'" "W = topspace X \<inter> \<Inter>\<B>'"
       using W \<open>x \<in> W\<close> unfolding relative_to_def intersection_of_def by auto
     then have "\<Inter>\<B>' \<subseteq> \<Union>\<B>"
       using \<open>W \<in> \<V>\<close> \<open>\<Union>\<V> \<noteq> topspace X\<close> \<open>\<Union>\<V> \<subseteq> topspace X\<close> by blast
     then have "\<Inter>\<B>' \<subseteq> C"
       using U\<B> \<open>C = \<Union>\<V>\<close> \<open>W = topspace X \<inter> \<Inter>\<B>'\<close> \<open>W \<in> \<V>\<close> by auto
     have "\<forall>b \<in> \<B>'. \<exists>C'. finite C' \<and> C' \<subseteq> \<K> \<and> topspace X \<subseteq> \<Union>(insert b C')"
     proof
       fix b
       assume "b \<in> \<B>'"
       have "insert b \<K> = \<K>" if neg: "\<not> (\<exists>C'. finite C' \<and> C' \<subseteq> \<K> \<and> topspace X \<subseteq> \<Union>(insert b C'))"
       proof (rule *)
         show "openin X W" if "W \<in> insert b \<K>" for W
           using that
         proof
           have "b \<in> \<B>"
             using \<open>b \<in> \<B>'\<close> \<open>\<B>' \<subseteq> \<B>\<close> by blast
           then have "\<exists>\<U>. finite \<U> \<and> \<U> \<subseteq> \<B> \<and> \<Inter>\<U> = b"
             by (rule_tac x="{b}" in exI) auto
           moreover have "\<Union>\<B> \<inter> b = b"
             using \<B>'(2) \<open>b \<in> \<B>'\<close> by auto
           ultimately show "openin X W" if "W = b"
             using  that \<open>b \<in> \<B>'\<close>
             apply (simp add: openin_subbase flip: X)
             apply (auto simp: arbitrary_def intersection_of_def relative_to_def intro!: union_of_inc)
             done
           show "openin X W" if "W \<in> \<K>"
             by (simp add: \<open>W \<in> \<K>\<close> ope)
         qed
       next
         show "topspace X \<subseteq> \<Union> (insert b \<K>)"
           using top by auto
       next
         show False if "finite \<F>" and "\<F> \<subseteq> insert b \<K>" "topspace X \<subseteq> \<Union>\<F>" for \<F>
         proof -
           have "insert b (\<F> \<inter> \<K>) = \<F>"
             using non that by blast
           then show False
             by (metis Int_lower2 finite_insert neg that(1) that(3))
         qed
       qed auto
       then show "\<exists>C'. finite C' \<and> C' \<subseteq> \<K> \<and> topspace X \<subseteq> \<Union>(insert b C')"
         using \<open>b \<in> \<B>'\<close> \<open>x \<notin> \<Union>(\<B> \<inter> \<K>)\<close> \<B>'
         by (metis IntI InterE Union_iff subsetD insertI1)
     qed
     then obtain F where F: "\<forall>b \<in> \<B>'. finite (F b) \<and> F b \<subseteq> \<K> \<and> topspace X \<subseteq> \<Union>(insert b (F b))"
       by metis
     let ?\<D> = "insert C (\<Union>(F ` \<B>'))"
     show False
     proof (rule non)
       have "topspace X \<subseteq> (\<Inter>b \<in> \<B>'. \<Union>(insert b (F b)))"
         using F by (simp add: INT_greatest)
       also have "\<dots> \<subseteq> \<Union>?\<D>"
         using \<open>\<Inter>\<B>' \<subseteq> C\<close> by force
       finally show "topspace X \<subseteq> \<Union>?\<D>" .
       show "?\<D> \<subseteq> \<K>"
         using \<open>C \<in> \<K>\<close> F by auto
       show "finite ?\<D>"
         using \<open>finite \<B>'\<close> F by auto
     qed
   qed
   then show ?thesis
     by (force simp: compact_space_def compactin_def)
 qed
 
 
 corollary Alexander_subbase_alt:
   assumes "U \<subseteq> \<Union>\<B>"
   and fin: "\<And>C. \<lbrakk>C \<subseteq> \<B>; U \<subseteq> \<Union>C\<rbrakk> \<Longrightarrow> \<exists>C'. finite C' \<and> C' \<subseteq> C \<and> U \<subseteq> \<Union>C'"
    and X: "topology
               (arbitrary union_of
                    (finite intersection_of (\<lambda>x. x \<in> \<B>) relative_to U)) = X"
  shows "compact_space X"
 proof -
   have "topspace X = U"
     using X topspace_subbase by fastforce
   have eq: "\<Union> (Collect ((\<lambda>x. x \<in> \<B>) relative_to U)) = U"
     unfolding relative_to_def
     using \<open>U \<subseteq> \<Union>\<B>\<close> by blast
   have *: "\<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<C> \<and> \<Union>\<F> = topspace X"
     if  "\<C> \<subseteq> Collect ((\<lambda>x. x \<in> \<B>) relative_to topspace X)" and UC: "\<Union>\<C> = topspace X" for \<C>
   proof -
     have "\<C> \<subseteq> (\<lambda>U. topspace X \<inter> U) ` \<B>"
       using that by (auto simp: relative_to_def)
     then obtain \<B>' where "\<B>' \<subseteq> \<B>" and \<B>': "\<C> = (\<inter>) (topspace X) ` \<B>'"
       by (auto simp: subset_image_iff)
     moreover have "U \<subseteq> \<Union>\<B>'"
       using \<B>' \<open>topspace X = U\<close> UC by auto
     ultimately obtain \<C>' where "finite \<C>'" "\<C>' \<subseteq> \<B>'" "U \<subseteq> \<Union>\<C>'"
       using fin [of \<B>'] \<open>topspace X = U\<close> \<open>U \<subseteq> \<Union>\<B>\<close> by blast
     then show ?thesis
       unfolding \<B>' ex_finite_subset_image \<open>topspace X = U\<close> by auto
   qed
   show ?thesis
     apply (rule Alexander_subbase [where \<B> = "Collect ((\<lambda>x. x \<in> \<B>) relative_to (topspace X))"])
      apply (simp flip: X)
      apply (metis finite_intersection_of_relative_to eq)
     apply (blast intro: *)
     done
 qed
 
 proposition continuous_map_componentwise:
    "continuous_map X (product_topology Y I) f \<longleftrightarrow>
     f ` (topspace X) \<subseteq> extensional I \<and> (\<forall>k \<in> I. continuous_map X (Y k) (\<lambda>x. f x k))"
     (is "?lhs \<longleftrightarrow> _ \<and> ?rhs")
 proof (cases "\<forall>x \<in> topspace X. f x \<in> extensional I")
   case True
   then have "f ` (topspace X) \<subseteq> extensional I"
     by force
   moreover have ?rhs if L: ?lhs
   proof -
     have "openin X {x \<in> topspace X. f x k \<in> U}" if "k \<in> I" and "openin (Y k) U" for k U
     proof -
       have "openin (product_topology Y I) ({Y. Y k \<in> U} \<inter> (\<Pi>\<^sub>E i\<in>I. topspace (Y i)))"
         apply (simp add: openin_product_topology flip: arbitrary_union_of_relative_to)
         apply (simp add: relative_to_def)
         using that apply (blast intro: arbitrary_union_of_inc finite_intersection_of_inc)
         done
       with that have "openin X {x \<in> topspace X. f x \<in> ({Y. Y k \<in> U} \<inter> (\<Pi>\<^sub>E i\<in>I. topspace (Y i)))}"
         using L unfolding continuous_map_def by blast
       moreover have "{x \<in> topspace X. f x \<in> ({Y. Y k \<in> U} \<inter> (\<Pi>\<^sub>E i\<in>I. topspace (Y i)))} = {x \<in> topspace X. f x k \<in> U}"
         using L by (auto simp: continuous_map_def)
       ultimately show ?thesis
         by metis
     qed
     with that
     show ?thesis
       by (auto simp: continuous_map_def)
   qed
   moreover have ?lhs if ?rhs
   proof -
     have 1: "\<And>x. x \<in> topspace X \<Longrightarrow> f x \<in> (\<Pi>\<^sub>E i\<in>I. topspace (Y i))"
       using that True by (auto simp: continuous_map_def PiE_iff)
     have 2: "{x \<in> S. \<exists>T\<in>\<T>. f x \<in> T} = (\<Union>T\<in>\<T>. {x \<in> S. f x \<in> T})" for S \<T>
       by blast
     have 3: "{x \<in> S. \<forall>U\<in>\<U>. f x \<in> U} = (\<Inter> (insert S ((\<lambda>U. {x \<in> S. f x \<in> U}) ` \<U>)))" for S \<U>
       by blast
     show ?thesis
       unfolding continuous_map_def openin_product_topology arbitrary_def
     proof (clarsimp simp: all_union_of 1 2)
       fix \<T>
       assume \<T>: "\<T> \<subseteq> Collect (finite intersection_of (\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (Y i) U)
                   relative_to (\<Pi>\<^sub>E i\<in>I. topspace (Y i)))"
       show "openin X (\<Union>T\<in>\<T>. {x \<in> topspace X. f x \<in> T})"
       proof (rule openin_Union; clarify)
         fix S T
         assume "T \<in> \<T>"
         obtain \<U> where "T = (\<Pi>\<^sub>E i\<in>I. topspace (Y i)) \<inter> \<Inter>\<U>" and "finite \<U>"
           "\<U> \<subseteq> {{f. f i \<in> U} |i U. i \<in> I \<and> openin (Y i) U}"
           using subsetD [OF \<T> \<open>T \<in> \<T>\<close>] by (auto simp: intersection_of_def relative_to_def)
         with that show "openin X {x \<in> topspace X. f x \<in> T}"
           apply (simp add: continuous_map_def 1 cong: conj_cong)
           unfolding 3
           apply (rule openin_Inter; auto)
           done
       qed
     qed
   qed
   ultimately show ?thesis
     by metis
 next
   case False
   then show ?thesis
     by (auto simp: continuous_map_def PiE_def)
 qed
 
 
 lemma continuous_map_componentwise_UNIV:
    "continuous_map X (product_topology Y UNIV) f \<longleftrightarrow> (\<forall>k. continuous_map X (Y k) (\<lambda>x. f x k))"
   by (simp add: continuous_map_componentwise)
 
 lemma continuous_map_product_projection [continuous_intros]:
    "k \<in> I \<Longrightarrow> continuous_map (product_topology X I) (X k) (\<lambda>x. x k)"
   using continuous_map_componentwise [of "product_topology X I" X I id] by simp
 
 declare continuous_map_from_subtopology [OF continuous_map_product_projection, continuous_intros]
 
 proposition open_map_product_projection:
   assumes "i \<in> I"
   shows "open_map (product_topology Y I) (Y i) (\<lambda>f. f i)"
   unfolding openin_product_topology all_union_of arbitrary_def open_map_def image_Union
 proof clarify
   fix \<V>
   assume \<V>: "\<V> \<subseteq> Collect
                (finite intersection_of
                 (\<lambda>F. \<exists>i U. F = {f. f i \<in> U} \<and> i \<in> I \<and> openin (Y i) U) relative_to
                            topspace (product_topology Y I))"
   show "openin (Y i) (\<Union>x\<in>\<V>. (\<lambda>f. f i) ` x)"
   proof (rule openin_Union, clarify)
     fix S V
     assume "V \<in> \<V>"
     obtain \<F> where "finite \<F>"
       and V: "V = (\<Pi>\<^sub>E i\<in>I. topspace (Y i)) \<inter> \<Inter>\<F>"
       and \<F>: "\<F> \<subseteq> {{f. f i \<in> U} |i U. i \<in> I \<and> openin (Y i) U}"
       using subsetD [OF \<V> \<open>V \<in> \<V>\<close>]
       by (auto simp: intersection_of_def relative_to_def)
     show "openin (Y i) ((\<lambda>f. f i) ` V)"
     proof (subst openin_subopen; clarify)
       fix x f
       assume "f \<in> V"
       let ?T = "{a \<in> topspace(Y i).
                    (\<lambda>j. if j = i then a
                         else if j \<in> I then f j else undefined) \<in> (\<Pi>\<^sub>E i\<in>I. topspace (Y i)) \<inter> \<Inter>\<F>}"
       show "\<exists>T. openin (Y i) T \<and> f i \<in> T \<and> T \<subseteq> (\<lambda>f. f i) ` V"
       proof (intro exI conjI)
         show "openin (Y i) ?T"
         proof (rule openin_continuous_map_preimage)
           have "continuous_map (Y i) (Y k) (\<lambda>x. if k = i then x else f k)" if "k \<in> I" for k
           proof (cases "k=i")
             case True
             then show ?thesis
               by (metis (mono_tags) continuous_map_id eq_id_iff)
           next
             case False
             then show ?thesis
               by simp (metis IntD1 PiE_iff V \<open>f \<in> V\<close> that)
           qed
           then show "continuous_map (Y i) (product_topology Y I)
                   (\<lambda>x j. if j = i then x else if j \<in> I then f j else undefined)"
             by (auto simp: continuous_map_componentwise assms extensional_def)
         next
           have "openin (product_topology Y I) (\<Pi>\<^sub>E i\<in>I. topspace (Y i))"
             by (metis openin_topspace topspace_product_topology)
           moreover have "openin (product_topology Y I) (\<Inter>B\<in>\<F>. (\<Pi>\<^sub>E i\<in>I. topspace (Y i)) \<inter> B)"
                          if "\<F> \<noteq> {}"
           proof -
             show ?thesis
             proof (rule openin_Inter)
               show "\<And>X. X \<in> (\<inter>) (\<Pi>\<^sub>E i\<in>I. topspace (Y i)) ` \<F> \<Longrightarrow> openin (product_topology Y I) X"
                 unfolding openin_product_topology relative_to_def
                 apply (clarify intro!: arbitrary_union_of_inc)
                 apply (rename_tac F)
                 apply (rule_tac x=F in exI)
                 using subsetD [OF \<F>]
                 apply (force intro: finite_intersection_of_inc)
                 done
             qed (use \<open>finite \<F>\<close> \<open>\<F> \<noteq> {}\<close> in auto)
           qed
           ultimately show "openin (product_topology Y I) ((\<Pi>\<^sub>E i\<in>I. topspace (Y i)) \<inter> \<Inter>\<F>)"
             by (auto simp only: Int_Inter_eq split: if_split)
         qed
       next
         have eqf: "(\<lambda>j. if j = i then f i else if j \<in> I then f j else undefined) = f"
           using PiE_arb V \<open>f \<in> V\<close> by force
         show "f i \<in> ?T"
           using V assms \<open>f \<in> V\<close> by (auto simp: PiE_iff eqf)
       next
         show "?T \<subseteq> (\<lambda>f. f i) ` V"
           unfolding V by (auto simp: intro!: rev_image_eqI)
       qed
     qed
   qed
 qed
 
 lemma retraction_map_product_projection:
   assumes "i \<in> I"
   shows "(retraction_map (product_topology X I) (X i) (\<lambda>x. x i) \<longleftrightarrow>
          (topspace (product_topology X I) = {}) \<longrightarrow> topspace (X i) = {})"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     using retraction_imp_surjective_map by force
 next
   assume R: ?rhs
   show ?lhs
   proof (cases "topspace (product_topology X I) = {}")
     case True
     then show ?thesis
       using R by (auto simp: retraction_map_def retraction_maps_def continuous_map_on_empty)
   next
     case False
     have *: "\<exists>g. continuous_map (X i) (product_topology X I) g \<and> (\<forall>x\<in>topspace (X i). g x i = x)"
       if z: "z \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" for z
     proof -
       have cm: "continuous_map (X i) (X j) (\<lambda>x. if j = i then x else z j)" if "j \<in> I" for j
         using \<open>j \<in> I\<close> z  by (case_tac "j = i") auto
       show ?thesis
         using \<open>i \<in> I\<close> that
         by (rule_tac x="\<lambda>x j. if j = i then x else z j" in exI) (auto simp: continuous_map_componentwise PiE_iff extensional_def cm)
     qed
     show ?thesis
       using \<open>i \<in> I\<close> False
       by (auto simp: retraction_map_def retraction_maps_def assms continuous_map_product_projection *)
   qed
 qed
 
 subsection \<open>Open Pi-sets in the product topology\<close>
 
 proposition openin_PiE_gen:
   "openin (product_topology X I) (PiE I S) \<longleftrightarrow>
         PiE I S = {} \<or>
         finite {i \<in> I. ~(S i = topspace(X i))} \<and> (\<forall>i \<in> I. openin (X i) (S i))"
   (is "?lhs \<longleftrightarrow> _ \<or> ?rhs")
 proof (cases "PiE I S = {}")
   case False
   moreover have "?lhs = ?rhs"
   proof
     assume L: ?lhs
     moreover
     obtain z where z: "z \<in> PiE I S"
       using False by blast
     ultimately obtain U where fin: "finite {i \<in> I. U i \<noteq> topspace (X i)}"
       and "Pi\<^sub>E I U \<noteq> {}"
       and sub: "Pi\<^sub>E I U \<subseteq> Pi\<^sub>E I S"
       by (fastforce simp add: openin_product_topology_alt)
     then have *: "\<And>i. i \<in> I \<Longrightarrow> U i \<subseteq> S i"
       by (simp add: subset_PiE)
     show ?rhs
     proof (intro conjI ballI)
       show "finite {i \<in> I. S i \<noteq> topspace (X i)}"
         apply (rule finite_subset [OF _ fin], clarify)
         using *
         by (metis False L openin_subset topspace_product_topology subset_PiE subset_antisym)
     next
       fix i :: "'a"
       assume "i \<in> I"
       then show "openin (X i) (S i)"
         using open_map_product_projection [of i I X] L
         apply (simp add: open_map_def)
         apply (drule_tac x="PiE I S" in spec)
         apply (simp add: False image_projection_PiE split: if_split_asm)
         done
     qed
   next
     assume ?rhs
     then show ?lhs
       apply (simp only: openin_product_topology)
       apply (rule arbitrary_union_of_inc)
       apply (auto simp: product_topology_base_alt)
       done
   qed
   ultimately show ?thesis
     by simp
 qed simp
 
 
 corollary openin_PiE:
    "finite I \<Longrightarrow> openin (product_topology X I) (PiE I S) \<longleftrightarrow> PiE I S = {} \<or> (\<forall>i \<in> I. openin (X i) (S i))"
   by (simp add: openin_PiE_gen)
 
 proposition compact_space_product_topology:
    "compact_space(product_topology X I) \<longleftrightarrow>
     topspace(product_topology X I) = {} \<or> (\<forall>i \<in> I. compact_space(X i))"
     (is "?lhs = ?rhs")
 proof (cases "topspace(product_topology X I) = {}")
   case False
   then obtain z where z: "z \<in> (\<Pi>\<^sub>E i\<in>I. topspace(X i))"
     by auto
   show ?thesis
   proof
     assume L: ?lhs
     show ?rhs
     proof (clarsimp simp add: False compact_space_def)
       fix i
       assume "i \<in> I"
       with L have "continuous_map (product_topology X I) (X i) (\<lambda>f. f i)"
         by (simp add: continuous_map_product_projection)
       moreover
       have "\<And>x. x \<in> topspace (X i) \<Longrightarrow> x \<in> (\<lambda>f. f i) ` (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
         using \<open>i \<in> I\<close> z
         apply (rule_tac x="\<lambda>j. if j = i then x else if j \<in> I then z j else undefined" in image_eqI, auto)
         done
       then have "(\<lambda>f. f i) ` (\<Pi>\<^sub>E i\<in>I. topspace (X i)) = topspace (X i)"
         using \<open>i \<in> I\<close> z by auto
       ultimately show "compactin (X i) (topspace (X i))"
         by (metis L compact_space_def image_compactin topspace_product_topology)
     qed
   next
     assume R: ?rhs
     show ?lhs
     proof (cases "I = {}")
       case True
       with R show ?thesis
         by (simp add: compact_space_def)
     next
       case False
       then obtain i where "i \<in> I"
         by blast
       show ?thesis
         using R
       proof
         assume com [rule_format]: "\<forall>i\<in>I. compact_space (X i)"
         let ?\<C> = "{{f. f i \<in> U} |i U. i \<in> I \<and> openin (X i) U}"
         show "compact_space (product_topology X I)"
         proof (rule Alexander_subbase_alt)
           show "topspace (product_topology X I) \<subseteq> \<Union>?\<C>"
             unfolding topspace_product_topology using \<open>i \<in> I\<close> by blast
         next
           fix C
           assume Csub: "C \<subseteq> ?\<C>" and UC: "topspace (product_topology X I) \<subseteq> \<Union>C"
           define \<D> where "\<D> \<equiv> \<lambda>i. {U. openin (X i) U \<and> {f. f i \<in> U} \<in> C}"
           show "\<exists>C'. finite C' \<and> C' \<subseteq> C \<and> topspace (product_topology X I) \<subseteq> \<Union>C'"
           proof (cases "\<exists>i. i \<in> I \<and> topspace (X i) \<subseteq> \<Union>(\<D> i)")
             case True
             then obtain i where "i \<in> I"
                    and i: "topspace (X i) \<subseteq> \<Union>(\<D> i)"
               unfolding \<D>_def by blast
             then have *: "\<And>\<U>. \<lbrakk>Ball \<U> (openin (X i)); topspace (X i) \<subseteq> \<Union>\<U>\<rbrakk> \<Longrightarrow>
                             \<exists>\<F>. finite \<F> \<and> \<F> \<subseteq> \<U> \<and> topspace (X i) \<subseteq> \<Union>\<F>"
               using com [OF \<open>i \<in> I\<close>] by (auto simp: compact_space_def compactin_def)
             have "topspace (X i) \<subseteq> \<Union>(\<D> i)"
               using i by auto
             with * obtain \<F> where "finite \<F> \<and> \<F> \<subseteq> (\<D> i) \<and> topspace (X i) \<subseteq> \<Union>\<F>"
               unfolding \<D>_def by fastforce
             with \<open>i \<in> I\<close> show ?thesis
               unfolding \<D>_def
               by (rule_tac x="(\<lambda>U. {x. x i \<in> U}) ` \<F>" in exI) auto
           next
             case False
             then have "\<forall>i \<in> I. \<exists>y. y \<in> topspace (X i) \<and> y \<notin> \<Union>(\<D> i)"
               by force
             then obtain g where g: "\<And>i. i \<in> I \<Longrightarrow> g i \<in> topspace (X i) \<and> g i \<notin> \<Union>(\<D> i)"
               by metis
             then have "(\<lambda>i. if i \<in> I then g i else undefined) \<in> topspace (product_topology X I)"
               by (simp add: PiE_I)
             moreover have "(\<lambda>i. if i \<in> I then g i else undefined) \<notin> \<Union>C"
               using Csub g unfolding \<D>_def by force
             ultimately show ?thesis
               using UC by blast
           qed
         qed (simp add: product_topology)
       qed (simp add: compact_space_topspace_empty)
     qed
   qed
 qed (simp add: compact_space_topspace_empty)
 
 corollary compactin_PiE:
    "compactin (product_topology X I) (PiE I S) \<longleftrightarrow>
         PiE I S = {} \<or> (\<forall>i \<in> I. compactin (X i) (S i))"
   by (auto simp: compactin_subspace subtopology_PiE subset_PiE compact_space_product_topology
        PiE_eq_empty_iff)
 
 lemma in_product_topology_closure_of:
    "z \<in> (product_topology X I) closure_of S
         \<Longrightarrow> i \<in> I \<Longrightarrow> z i \<in> ((X i) closure_of ((\<lambda>x. x i) ` S))"
   using continuous_map_product_projection
   by (force simp: continuous_map_eq_image_closure_subset image_subset_iff)
 
 lemma homeomorphic_space_singleton_product:
    "product_topology X {k} homeomorphic_space (X k)"
   unfolding homeomorphic_space
   apply (rule_tac x="\<lambda>x. x k" in exI)
   apply (rule bijective_open_imp_homeomorphic_map)
      apply (simp_all add: continuous_map_product_projection open_map_product_projection)
   unfolding PiE_over_singleton_iff
    apply (auto simp: image_iff inj_on_def)
   done
 
 subsection\<open>Relationship with connected spaces, paths, etc.\<close>
 
 proposition connected_space_product_topology:
    "connected_space(product_topology X I) \<longleftrightarrow>
     (\<Pi>\<^sub>E i\<in>I. topspace (X i)) = {} \<or> (\<forall>i \<in> I. connected_space(X i))"
   (is "?lhs \<longleftrightarrow> ?eq \<or> ?rhs")
 proof (cases ?eq)
   case False
   moreover have "?lhs = ?rhs"
   proof
     assume ?lhs
     moreover
     have "connectedin(X i) (topspace(X i))"
       if "i \<in> I" and ci: "connectedin(product_topology X I) (topspace(product_topology X I))" for i
     proof -
       have cm: "continuous_map (product_topology X I) (X i) (\<lambda>f. f i)"
         by (simp add: \<open>i \<in> I\<close> continuous_map_product_projection)
       show ?thesis
         using connectedin_continuous_map_image [OF cm ci] \<open>i \<in> I\<close>
         by (simp add: False image_projection_PiE)
     qed
     ultimately show ?rhs
       by (meson connectedin_topspace)
   next
     assume cs [rule_format]: ?rhs
     have False
       if disj: "U \<inter> V = {}" and subUV: "(\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<subseteq> U \<union> V"
         and U: "openin (product_topology X I) U"
         and V: "openin (product_topology X I) V"
         and "U \<noteq> {}" "V \<noteq> {}"
       for U V
     proof -
       obtain f where "f \<in> U"
         using \<open>U \<noteq> {}\<close> by blast
       then have f: "f \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
         using U openin_subset by fastforce
       have "U \<subseteq> topspace(product_topology X I)" "V \<subseteq> topspace(product_topology X I)"
         using U V openin_subset by blast+
       moreover have "(\<Pi>\<^sub>E i\<in>I. topspace (X i)) \<subseteq> U"
       proof -
         obtain C where "(finite intersection_of (\<lambda>F. \<exists>i U. F = {x. x i \<in> U} \<and> i \<in> I \<and> openin (X i) U) relative_to
             (\<Pi>\<^sub>E i\<in>I. topspace (X i))) C" "C \<subseteq> U" "f \<in> C"
           using U \<open>f \<in> U\<close> unfolding openin_product_topology union_of_def by auto
         then obtain \<T> where "finite \<T>"
           and t: "\<And>C. C \<in> \<T> \<Longrightarrow> \<exists>i u. (i \<in> I \<and> openin (X i) u) \<and> C = {x. x i \<in> u}"
           and subU: "topspace (product_topology X I) \<inter> \<Inter>\<T> \<subseteq> U"
           and ftop: "f \<in> topspace (product_topology X I)"
           and fint: "f \<in> \<Inter> \<T>"
           by (fastforce simp: relative_to_def intersection_of_def subset_iff)
         let ?L = "\<Union>C\<in>\<T>. {i. (\<lambda>x. x i) ` C \<subset> topspace (X i)}"
         obtain L where "finite L"
           and L: "\<And>i U. \<lbrakk>i \<in> I; openin (X i) U; U \<subset> topspace(X i); {x. x i \<in> U} \<in> \<T>\<rbrakk> \<Longrightarrow> i \<in> L"
         proof
           show "finite ?L"
           proof (rule finite_Union)
             fix M
             assume "M \<in> (\<lambda>C. {i. (\<lambda>x. x i) ` C \<subset> topspace (X i)}) ` \<T>"
             then obtain C where "C \<in> \<T>" and C: "M = {i. (\<lambda>x. x i) ` C \<subset> topspace (X i)}"
               by blast
             then obtain j V where "j \<in> I" and ope: "openin (X j) V" and Ceq: "C = {x. x j \<in> V}"
               using t by meson
             then have "f j \<in> V"
               using \<open>C \<in> \<T>\<close> fint by force
             then have "(\<lambda>x. x k) ` {x. x j \<in> V} = UNIV" if "k \<noteq> j" for k
               using that
               apply (clarsimp simp add: set_eq_iff)
               apply (rule_tac x="\<lambda>m. if m = k then x else f m" in image_eqI, auto)
               done
             then have "{i. (\<lambda>x. x i) ` C \<subset> topspace (X i)} \<subseteq> {j}"
               using Ceq by auto
             then show "finite M"
               using C finite_subset by fastforce
           qed (use \<open>finite \<T>\<close> in blast)
         next
           fix i U
           assume  "i \<in> I" and ope: "openin (X i) U" and psub: "U \<subset> topspace (X i)" and int: "{x. x i \<in> U} \<in> \<T>"
           then show "i \<in> ?L"
             by (rule_tac a="{x. x i \<in> U}" in UN_I) (force+)
         qed
         show ?thesis
         proof
           fix h
           assume h: "h \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
           define g where "g \<equiv> \<lambda>i. if i \<in> L then f i else h i"
           have gin: "g \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
             unfolding g_def using f h by auto
           moreover have "g \<in> X" if "X \<in> \<T>" for X
             using fint openin_subset t [OF that] L g_def h that by fastforce
           ultimately have "g \<in> U"
             using subU by auto
           have "h \<in> U" if "finite M" "h \<in> PiE I (topspace \<circ> X)" "{i \<in> I. h i \<noteq> g i} \<subseteq> M" for M h
             using that
           proof (induction arbitrary: h)
             case empty
             then show ?case
               using PiE_ext \<open>g \<in> U\<close> gin by force
           next
             case (insert i M)
             define f where "f \<equiv> \<lambda>j. if j = i then g i else h j"
             have fin: "f \<in> PiE I (topspace \<circ> X)"
               unfolding f_def using gin insert.prems(1) by auto
             have subM: "{j \<in> I. f j \<noteq> g j} \<subseteq> M"
               unfolding f_def using insert.prems(2) by auto
             have "f \<in> U"
               using insert.IH [OF fin subM] .
             show ?case
             proof (cases "h \<in> V")
               case True
               show ?thesis
               proof (cases "i \<in> I")
                 case True
                 let ?U = "{x \<in> topspace(X i). (\<lambda>j. if j = i then x else h j) \<in> U}"
                 let ?V = "{x \<in> topspace(X i). (\<lambda>j. if j = i then x else h j) \<in> V}"
                 have False
                 proof (rule connected_spaceD [OF cs [OF \<open>i \<in> I\<close>]])
                   have "\<And>k. k \<in> I \<Longrightarrow> continuous_map (X i) (X k) (\<lambda>x. if k = i then x else h k)"
                     using continuous_map_eq_topcontinuous_at insert.prems(1) topcontinuous_at_def by fastforce
                   then have cm: "continuous_map (X i) (product_topology X I) (\<lambda>x j. if j = i then x else h j)"
                     using \<open>i \<in> I\<close> insert.prems(1)
                     by (auto simp: continuous_map_componentwise extensional_def)
                   show "openin (X i) ?U"
                     by (rule openin_continuous_map_preimage [OF cm U])
                   show "openin (X i) ?V"
                     by (rule openin_continuous_map_preimage [OF cm V])
                   show "topspace (X i) \<subseteq> ?U \<union> ?V"
                   proof clarsimp
                     fix x
                     assume "x \<in> topspace (X i)" and "(\<lambda>j. if j = i then x else h j) \<notin> V"
                     with True subUV \<open>h \<in> Pi\<^sub>E I (topspace \<circ> X)\<close>
                     show "(\<lambda>j. if j = i then x else h j) \<in> U"
                       by (drule_tac c="(\<lambda>j. if j = i then x else h j)" in subsetD) auto
                   qed
                   show "?U \<inter> ?V = {}"
                     using disj by blast
                   show "?U \<noteq> {}"
                     using \<open>U \<noteq> {}\<close> f_def
                   proof -
                     have "(\<lambda>j. if j = i then g i else h j) \<in> U"
                       using \<open>f \<in> U\<close> f_def by blast
                     moreover have "f i \<in> topspace (X i)"
                       by (metis PiE_iff True comp_apply fin)
                     ultimately have "\<exists>b. b \<in> topspace (X i) \<and> (\<lambda>a. if a = i then b else h a) \<in> U"
                       using f_def by auto
                     then show ?thesis
                       by blast
                   qed
                   have "(\<lambda>j. if j = i then h i else h j) = h"
                     by force
                   moreover have "h i \<in> topspace (X i)"
                     using True insert.prems(1) by auto
                   ultimately show "?V \<noteq> {}"
                     using \<open>h \<in> V\<close>  by force
                 qed
                 then show ?thesis ..
               next
                 case False
                 show ?thesis
                 proof (cases "h = f")
                   case True
                   show ?thesis
                     by (rule insert.IH [OF insert.prems(1)]) (simp add: True subM)
                 next
                   case False
                   then show ?thesis
                     using gin insert.prems(1) \<open>i \<notin> I\<close> unfolding f_def by fastforce
                 qed
               qed
             next
               case False
               then show ?thesis
                 using subUV insert.prems(1) by auto
             qed
           qed
           then show "h \<in> U"
             unfolding g_def using PiE_iff \<open>finite L\<close> h by fastforce
         qed
       qed
       ultimately show ?thesis
         using disj inf_absorb2 \<open>V \<noteq> {}\<close> by fastforce
     qed
     then show ?lhs
       unfolding connected_space_def
       by auto
   qed
   ultimately show ?thesis
     by simp
 qed (simp add: connected_space_topspace_empty)
 
 
 lemma connectedin_PiE:
    "connectedin (product_topology X I) (PiE I S) \<longleftrightarrow>
         PiE I S = {} \<or> (\<forall>i \<in> I. connectedin (X i) (S i))"
-  by (fastforce simp add: connectedin_def subtopology_PiE connected_space_product_topology subset_PiE PiE_eq_empty_iff
-      topspace_subtopology_subset)
+  by (fastforce simp add: connectedin_def subtopology_PiE connected_space_product_topology subset_PiE PiE_eq_empty_iff)
 
 lemma path_connected_space_product_topology:
    "path_connected_space(product_topology X I) \<longleftrightarrow>
     topspace(product_topology X I) = {} \<or> (\<forall>i \<in> I. path_connected_space(X i))"
  (is "?lhs \<longleftrightarrow> ?eq \<or> ?rhs")
 proof (cases ?eq)
   case False
   moreover have "?lhs = ?rhs"
   proof
     assume L: ?lhs
     show ?rhs
     proof (clarsimp simp flip: path_connectedin_topspace)
       fix i :: "'a"
       assume "i \<in> I"
       have cm: "continuous_map (product_topology X I) (X i) (\<lambda>f. f i)"
         by (simp add: \<open>i \<in> I\<close> continuous_map_product_projection)
       show "path_connectedin (X i) (topspace (X i))"
         using path_connectedin_continuous_map_image [OF cm L [unfolded path_connectedin_topspace [symmetric]]]
         by (metis \<open>i \<in> I\<close> False retraction_imp_surjective_map retraction_map_product_projection)
     qed
   next
     assume R [rule_format]: ?rhs
     show ?lhs
       unfolding path_connected_space_def topspace_product_topology
     proof clarify
       fix x y
       assume x: "x \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" and y: "y \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
       have "\<forall>i. \<exists>g. i \<in> I \<longrightarrow> pathin (X i) g \<and> g 0 = x i \<and> g 1 = y i"
         using PiE_mem R path_connected_space_def x y by force
       then obtain g where g: "\<And>i. i \<in> I \<Longrightarrow> pathin (X i) (g i) \<and> g i 0 = x i \<and> g i 1 = y i"
         by metis
       with x y show "\<exists>g. pathin (product_topology X I) g \<and> g 0 = x \<and> g 1 = y"
         apply (rule_tac x="\<lambda>a. \<lambda>i \<in> I. g i a" in exI)
         apply (force simp: pathin_def continuous_map_componentwise)
         done
     qed
   qed
   ultimately show ?thesis
     by simp
 qed (simp add: path_connected_space_topspace_empty)
 
 lemma path_connectedin_PiE:
    "path_connectedin (product_topology X I) (PiE I S) \<longleftrightarrow>
     PiE I S = {} \<or> (\<forall>i \<in> I. path_connectedin (X i) (S i))"
   by (fastforce simp add: path_connectedin_def subtopology_PiE path_connected_space_product_topology subset_PiE PiE_eq_empty_iff topspace_subtopology_subset)
 
 subsection \<open>Projections from a function topology to a component\<close>
 
 lemma quotient_map_product_projection:
   assumes "i \<in> I"
   shows "quotient_map(product_topology X I) (X i) (\<lambda>x. x i) \<longleftrightarrow>
            (topspace(product_topology X I) = {} \<longrightarrow> topspace(X i) = {})"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs with assms show ?rhs
     by (auto simp: continuous_open_quotient_map open_map_product_projection)
 next
   assume ?rhs with assms show ?lhs
     by (auto simp: Abstract_Topology.retraction_imp_quotient_map retraction_map_product_projection)
 qed
 
 lemma product_topology_homeomorphic_component:
   assumes "i \<in> I" "\<And>j. \<lbrakk>j \<in> I; j \<noteq> i\<rbrakk> \<Longrightarrow> \<exists>a. topspace(X j) = {a}"
   shows "product_topology X I homeomorphic_space (X i)"
 proof -
   have "quotient_map (product_topology X I) (X i) (\<lambda>x. x i)"
     using assms by (force simp add: quotient_map_product_projection PiE_eq_empty_iff)
   moreover
   have "inj_on (\<lambda>x. x i) (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
     using assms by (auto simp: inj_on_def PiE_iff) (metis extensionalityI singletonD)
   ultimately show ?thesis
     unfolding homeomorphic_space_def
     by (rule_tac x="\<lambda>x. x i" in exI) (simp add: homeomorphic_map_def flip: homeomorphic_map_maps)
 qed
 
 lemma topological_property_of_product_component:
   assumes major: "P (product_topology X I)"
     and minor: "\<And>z i. \<lbrakk>z \<in> (\<Pi>\<^sub>E i\<in>I. topspace(X i)); P(product_topology X I); i \<in> I\<rbrakk> 
                       \<Longrightarrow> P(subtopology (product_topology X I) (PiE I (\<lambda>j. if j = i then topspace(X i) else {z j})))"
                (is "\<And>z i. \<lbrakk>_; _; _\<rbrakk> \<Longrightarrow> P (?SX z i)")
     and PQ:  "\<And>X X'. X homeomorphic_space X' \<Longrightarrow> (P X \<longleftrightarrow> Q X')"
   shows "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) = {} \<or> (\<forall>i \<in> I. Q(X i))"
 proof -
   have "Q(X i)" if "(\<Pi>\<^sub>E i\<in>I. topspace(X i)) \<noteq> {}" "i \<in> I" for i
   proof -
     from that obtain f where f: "f \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))" 
       by force
     have "?SX f i homeomorphic_space X i"
       apply (simp add: subtopology_PiE )
       using product_topology_homeomorphic_component [OF \<open>i \<in> I\<close>, of "\<lambda>j. subtopology (X j) (if j = i then topspace (X i) else {f j})"]
       using f by fastforce
     then show ?thesis
       using minor [OF f major \<open>i \<in> I\<close>] PQ by auto
   qed
   then show ?thesis by metis
 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,5714 +1,5712 @@
 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 "g ` (S - {0}) \<subseteq> T"
       apply (auto simp: g_def subspace_mul [OF \<open>subspace T\<close>])
       apply (metis (mono_tags, lifting) DiffI subS01 subspace_mul [OF \<open>subspace T\<close>] fim image_subset_iff inf_le2 singletonD)
       done
     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 show ?thesis
         using * [THEN subsetD, of "x /\<^sub>R norm x"] that apply clarsimp
         apply (rule_tac x="norm x *\<^sub>R xa" in image_eqI, simp)
         apply (metis norm_eq_zero right_inverse scaleR_one scaleR_scaleR)
         using \<open>subspace S\<close> subspace_mul apply force
         done
     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 "(\<lambda>z. g (p1 z)) differentiable_on {x + y |x y. x \<in> S - {0} \<and> y \<in> T'}"
     apply (rule differentiable_on_compose [where f=g])
     apply (rule linear_imp_differentiable_on [OF \<open>linear p1\<close>])
     apply (rule differentiable_on_subset [OF gdiff])
     using p12_eq \<open>S \<subseteq> T\<close> apply auto
     done
   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'"
       apply (rule_tac x="p1 z" in exI)
       apply (rule_tac x="p2 z" in exI)
       apply (simp add: p1 eq p2 geq)
       by (metis \<open>z \<notin> T'\<close> add.left_neutral eq p2)
   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 apply auto
     done
   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
     apply (intro derivative_intros diffg differentiable_on_compose [OF diffg])
     using gnz apply auto
     done
   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"
         apply (rule g12)
         using that by force
       ultimately show ?thesis
         by (auto simp: norm_minus_commute dest: segment_bound)
     qed
     show "\<And>x. x \<in> sphere 0 1 \<inter> S \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> T - {0}"
       apply (simp add: subset_Diff_insert non0fg)
       apply (simp add: segment_convex_hull)
       apply (rule hull_minimal)
        using fim image_eqI gim apply force
       apply (rule subspace_imp_convex [OF \<open>subspace T\<close>])
       done
   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)"
     apply (rule homotopic_with_linear [OF conth continuous_on_const])
     apply (simp add: subset_Diff_insert non0hd)
     apply (simp add: segment_convex_hull)
     apply (rule hull_minimal)
      using h d apply (force simp: subspace_neg [OF \<open>subspace T\<close>])
     apply (rule subspace_imp_convex [OF \<open>subspace T\<close>])
     done
   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_compose_continuous_left [OF hom_hd conT0 sub0T])
     using d apply (auto simp: h_def)
     done
   show ?thesis
     apply (rule_tac x=c in exI)
     apply (rule homotopic_with_trans [OF _ homhc])
     apply (rule homotopic_with_eq)
        apply (rule homotopic_compose_continuous_left [OF homfg conT0 sub0T])
       apply (auto simp: h_def)
     done
 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)"
         apply (rule homeomorphic_rel_frontiers_convex_bounded_sets [OF \<open>convex S\<close> \<open>bounded S\<close>])
           apply (simp add: \<open>subspace T\<close> convex_Int subspace_imp_convex)
          apply (simp add: bounded_Int)
         apply (rule affS_eq)
         done
       also have "... = frontier (ball 0 1) \<inter> T"
         apply (rule convex_affine_rel_frontier_Int [OF convex_ball])
          apply (simp add: \<open>subspace T\<close> subspace_imp_affine)
         using \<open>subspace T\<close> subspace_0 by force
       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)
              apply (simp_all add: f aff_dim_cball)
       using that by blast
   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)
     apply (simp_all add: insert closed_Union contf contg)
     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> (S \<inter> T) face_of T"
       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
   then have "\<Union>\<F> \<subseteq> \<Union>\<G>"
     by (simp add: Union_mono)
   then show ?thesis
     apply (rule_tac g=f in that)
       using contf continuous_on_subset apply blast
      using fim apply blast
     by simp
 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 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 then show ?case
       apply (simp add: Union_empty_eq)
       apply (rule_tac x=f in exI)
       apply (intro conjI)
       using contf continuous_on_subset apply blast
       using fim apply blast
       by simp
   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
       then show ?thesis
         apply (rule_tac x=h in exI)
         apply (intro conjI)
         apply (blast intro: continuous_on_subset [OF conth])
         using him apply blast
         by simp
     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}"
           apply clarify
           apply (metis \<open>D face_of C\<close> affD eq_iff face_of_trans facet_of_def zle_diff1_eq)
           done
         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 \<open>C \<in> \<F>\<close> \<open>D face_of C\<close> face
             apply auto
             apply (meson face_of_Int_subface \<open>\<G> \<subseteq> \<F>\<close> face_of_refl_eq poly polytope_imp_convex subsetD)
             using face_of_Int_subface apply blast
             done
           show "D \<inter> E \<noteq> D"
             using that notDsub by auto
         qed
         then show ?thesis
           apply (rule_tac x=g in exI)
           apply (intro conjI ballI)
             using continuous_on_subset contg apply blast
            using gim apply blast
           using gh by 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
     then have fin: "finite (\<G> \<union> ?Faces)"
       apply simp
       apply (rule_tac B = "\<Union>{{D. D face_of C}| C. C \<in> \<F>}" in finite_subset)
        by (auto simp: \<open>finite \<F>\<close> finite_polytope_faces poly)
     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
         apply (rule face_of_Int_subface [OF _ _ XY])
         apply (auto simp: face DE)
         done
       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)"
       apply (rule exE [OF extending_maps_Union [OF fin extendh clo K]], blast+)
       done
     then show ?case
       apply (simp add: intle local.heq [symmetric], blast)
       done
   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>"
       apply (rule Union_subsetI)
       using \<open>\<G> \<subseteq> \<F>\<close> face_of_imp_subset  apply force
       done
     show "\<Union>\<F> \<subseteq> \<Union>(\<G> \<union> {D. \<exists>C\<in>\<F>. D face_of C \<and> aff_dim D < i})"
       apply (rule Union_mono)
       using face  apply (fastforce simp: aff i)
       done
   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 \<union> (\<Union>\<F> - insert a C)) (\<lambda>x. if x \<in> X then f x else g x)"
        apply (rule continuous_on_cases_local)
           apply (simp_all add: closedin_closed)
         using \<open>closed X\<close> apply blast
         using \<open>closed (\<Union>\<F>)\<close> apply blast
         using contf apply (force simp: elim: continuous_on_subset)
         using contg apply (force simp: elim: continuous_on_subset)
         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)"
     apply (rule exE [OF extend_map_lemma_cofinite0 [OF fin pw, of U T h]])
       apply (fastforce intro!:  clo \<F>)+
     done
   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> (X \<inter> Y) face_of Y"
       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
   moreover have "finite (\<Union>{{D. D face_of C} |C. C \<in> \<F>})"
     apply (rule finite_Union)
      apply (simp add: \<open>finite \<F>\<close>)
     using finite_polytope_faces poly by auto
   ultimately have "finite \<H>"
     apply (simp add: \<H>_def)
     apply (rule finite_subset [of _ "\<Union> {{D. D face_of C} | C. C \<in> \<F>}"], auto)
     done
   have *: "\<And>X Y. \<lbrakk>X \<in> \<H>; Y \<in> \<H>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
     unfolding \<H>_def
     apply (elim UnE bexE CollectE DiffE)
     using subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] apply (simp_all add: face)
       apply (meson subsetD [OF \<open>\<G> \<subseteq> \<F>\<close>] face face_of_Int_subface face_of_imp_subset face_of_refl 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"
     using \<open>finite \<H>\<close>
     unfolding \<H>_def
     apply (rule extend_map_lemma [OF _ Un_upper1 T _ _ _ contf fim])
     using \<open>\<G> \<subseteq> \<F>\<close> face_of_polytope_polytope poly apply fastforce
     using * apply (auto simp: \<H>_def)
     done
   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])
                 show "D \<inter> A face_of D"
                   apply (rule face_of_Int_subface [of D B _ A, THEN conjunct1])
                      apply (simp_all add: 2 \<open>D \<in> \<F>\<close> face)
                    apply (simp add: \<open>polyhedron D\<close> polyhedron_imp_convex face_of_refl)
                   done
                 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> (X \<inter> Y) face_of Y"
       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 \<and> X \<inter> Y face_of Y"
   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> (X \<inter> Y) face_of Y"
       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 \<and> X \<inter> Y face_of Y"
     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"
         apply (rule hg)
         using Ssub 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 \<and> X \<inter> Y face_of Y"
         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
         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 simp: continuous_on_const)
+      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 simp: continuous_on_const)
+    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 homotopic_with_refl contf fim contg gim)
+    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 simp: continuous_on_const)
+    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 continuous_on_const linepath_def)
+    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]
                         image_add_ball 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 simp: continuous_on_id)
+        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 (force simp: elim: homotopic_with_eq dest: homotopic_with_sphere_times [where h=g])
   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_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 simp: continuous_on_id)
+    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 Compl_eq_Diff_UNIV connected_UNIV assms top_greatest 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
-      using continuous_on_const by force
+    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/Henstock_Kurzweil_Integration.thy b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
--- a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
+++ b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
@@ -1,7627 +1,7627 @@
 (*  Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light)
                 Huge cleanup by LCP
 *)
 
 section \<open>Henstock-Kurzweil Gauge Integration in Many Dimensions\<close>
 
 theory Henstock_Kurzweil_Integration
 imports
   Lebesgue_Measure Tagged_Division
 begin
 
 lemma norm_diff2: "\<lbrakk>y = y1 + y2; x = x1 + x2; e = e1 + e2; norm(y1 - x1) \<le> e1; norm(y2 - x2) \<le> e2\<rbrakk>
   \<Longrightarrow> norm(y-x) \<le> e"
   using norm_triangle_mono [of "y1 - x1" "e1" "y2 - x2" "e2"]
   by (simp add: add_diff_add)
 
 lemma setcomp_dot1: "{z. P (z \<bullet> (i,0))} = {(x,y). P(x \<bullet> i)}"
   by auto
 
 lemma setcomp_dot2: "{z. P (z \<bullet> (0,i))} = {(x,y). P(y \<bullet> i)}"
   by auto
 
 lemma Sigma_Int_Paircomp1: "(Sigma A B) \<inter> {(x, y). P x} = Sigma (A \<inter> {x. P x}) B"
   by blast
 
 lemma Sigma_Int_Paircomp2: "(Sigma A B) \<inter> {(x, y). P y} = Sigma A (\<lambda>z. B z \<inter> {y. P y})"
   by blast
 (* END MOVE *)
 
 subsection \<open>Content (length, area, volume...) of an interval\<close>
 
 abbreviation content :: "'a::euclidean_space set \<Rightarrow> real"
   where "content s \<equiv> measure lborel s"
 
 lemma content_cbox_cases:
   "content (cbox a b) = (if \<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i then prod (\<lambda>i. b\<bullet>i - a\<bullet>i) Basis else 0)"
   by (simp add: measure_lborel_cbox_eq inner_diff)
 
 lemma content_cbox: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   unfolding content_cbox_cases by simp
 
 lemma content_cbox': "cbox a b \<noteq> {} \<Longrightarrow> content (cbox a b) = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   by (simp add: box_ne_empty inner_diff)
 
 lemma content_cbox_if: "content (cbox a b) = (if cbox a b = {} then 0 else \<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   by (simp add: content_cbox')
 
 lemma content_cbox_cart:
    "cbox a b \<noteq> {} \<Longrightarrow> content(cbox a b) = prod (\<lambda>i. b$i - a$i) UNIV"
   by (simp add: content_cbox_if Basis_vec_def cart_eq_inner_axis axis_eq_axis prod.UNION_disjoint)
 
 lemma content_cbox_if_cart:
    "content(cbox a b) = (if cbox a b = {} then 0 else prod (\<lambda>i. b$i - a$i) UNIV)"
   by (simp add: content_cbox_cart)
 
 lemma content_division_of:
   assumes "K \<in> \<D>" "\<D> division_of S"
   shows "content K = (\<Prod>i \<in> Basis. interval_upperbound K \<bullet> i - interval_lowerbound K \<bullet> i)"
 proof -
   obtain a b where "K = cbox a b"
     using cbox_division_memE assms by metis
   then show ?thesis
     using assms by (force simp: division_of_def content_cbox')
 qed
 
 lemma content_real: "a \<le> b \<Longrightarrow> content {a..b} = b - a"
   by simp
 
 lemma abs_eq_content: "\<bar>y - x\<bar> = (if x\<le>y then content {x..y} else content {y..x})"
   by (auto simp: content_real)
 
 lemma content_singleton: "content {a} = 0"
   by simp
 
 lemma content_unit[iff]: "content (cbox 0 (One::'a::euclidean_space)) = 1"
   by simp
 
 lemma content_pos_le [iff]: "0 \<le> content X"
   by simp
 
 corollary\<^marker>\<open>tag unimportant\<close> content_nonneg [simp]: "\<not> content (cbox a b) < 0"
   using not_le by blast
 
 lemma content_pos_lt: "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i \<Longrightarrow> 0 < content (cbox a b)"
   by (auto simp: less_imp_le inner_diff box_eq_empty intro!: prod_pos)
 
 lemma content_eq_0: "content (cbox a b) = 0 \<longleftrightarrow> (\<exists>i\<in>Basis. b\<bullet>i \<le> a\<bullet>i)"
   by (auto simp: content_cbox_cases not_le intro: less_imp_le antisym eq_refl)
 
 lemma content_eq_0_interior: "content (cbox a b) = 0 \<longleftrightarrow> interior(cbox a b) = {}"
   unfolding content_eq_0 interior_cbox box_eq_empty by auto
 
 lemma content_pos_lt_eq: "0 < content (cbox a (b::'a::euclidean_space)) \<longleftrightarrow> (\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i)"
   by (auto simp add: content_cbox_cases less_le prod_nonneg)
 
 lemma content_empty [simp]: "content {} = 0"
   by simp
 
 lemma content_real_if [simp]: "content {a..b} = (if a \<le> b then b - a else 0)"
   by (simp add: content_real)
 
 lemma content_subset: "cbox a b \<subseteq> cbox c d \<Longrightarrow> content (cbox a b) \<le> content (cbox c d)"
   unfolding measure_def
   by (intro enn2real_mono emeasure_mono) (auto simp: emeasure_lborel_cbox_eq)
 
 lemma content_lt_nz: "0 < content (cbox a b) \<longleftrightarrow> content (cbox a b) \<noteq> 0"
   unfolding content_pos_lt_eq content_eq_0 unfolding not_ex not_le by fastforce
 
 lemma content_Pair: "content (cbox (a,c) (b,d)) = content (cbox a b) * content (cbox c d)"
   unfolding measure_lborel_cbox_eq Basis_prod_def
   apply (subst prod.union_disjoint)
   apply (auto simp: bex_Un ball_Un)
   apply (subst (1 2) prod.reindex_nontrivial)
   apply auto
   done
 
 lemma content_cbox_pair_eq0_D:
    "content (cbox (a,c) (b,d)) = 0 \<Longrightarrow> content (cbox a b) = 0 \<or> content (cbox c d) = 0"
   by (simp add: content_Pair)
 
 lemma content_cbox_plus:
   fixes x :: "'a::euclidean_space"
   shows "content(cbox x (x + h *\<^sub>R One)) = (if h \<ge> 0 then h ^ DIM('a) else 0)"
   by (simp add: algebra_simps content_cbox_if box_eq_empty)
 
 lemma content_0_subset: "content(cbox a b) = 0 \<Longrightarrow> s \<subseteq> cbox a b \<Longrightarrow> content s = 0"
   using emeasure_mono[of s "cbox a b" lborel]
   by (auto simp: measure_def enn2real_eq_0_iff emeasure_lborel_cbox_eq)
 
 lemma content_split:
   fixes a :: "'a::euclidean_space"
   assumes "k \<in> Basis"
   shows "content (cbox a b) = content(cbox a b \<inter> {x. x\<bullet>k \<le> c}) + content(cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
   \<comment> \<open>Prove using measure theory\<close>
 proof (cases "\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i")
   case True
   have 1: "\<And>X Y Z. (\<Prod>i\<in>Basis. Z i (if i = k then X else Y i)) = Z k X * (\<Prod>i\<in>Basis-{k}. Z i (Y i))"
     by (simp add: if_distrib prod.delta_remove assms)
   note simps = interval_split[OF assms] content_cbox_cases
   have 2: "(\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i) = (\<Prod>i\<in>Basis-{k}. b\<bullet>i - a\<bullet>i) * (b\<bullet>k - a\<bullet>k)"
     by (metis (no_types, lifting) assms finite_Basis mult.commute prod.remove)
   have "\<And>x. min (b \<bullet> k) c = max (a \<bullet> k) c \<Longrightarrow>
     x * (b\<bullet>k - a\<bullet>k) = x * (max (a \<bullet> k) c - a \<bullet> k) + x * (b \<bullet> k - max (a \<bullet> k) c)"
     by  (auto simp add: field_simps)
   moreover
   have **: "(\<Prod>i\<in>Basis. ((\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) *\<^sub>R i) \<bullet> i - a \<bullet> i)) =
       (\<Prod>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) - a \<bullet> i)"
     "(\<Prod>i\<in>Basis. b \<bullet> i - ((\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i)) =
       (\<Prod>i\<in>Basis. b \<bullet> i - (if i = k then max (a \<bullet> k) c else a \<bullet> i))"
     by (auto intro!: prod.cong)
   have "\<not> a \<bullet> k \<le> c \<Longrightarrow> \<not> c \<le> b \<bullet> k \<Longrightarrow> False"
     unfolding not_le using True assms by auto
   ultimately show ?thesis
     using assms unfolding simps ** 1[of "\<lambda>i x. b\<bullet>i - x"] 1[of "\<lambda>i x. x - a\<bullet>i"] 2
     by auto
 next
   case False
   then have "cbox a b = {}"
     unfolding box_eq_empty by (auto simp: not_le)
   then show ?thesis
     by (auto simp: not_le)
 qed
 
 lemma division_of_content_0:
   assumes "content (cbox a b) = 0" "d division_of (cbox a b)" "K \<in> d"
   shows "content K = 0"
   unfolding forall_in_division[OF assms(2)]
   by (meson assms content_0_subset division_of_def)
 
 lemma sum_content_null:
   assumes "content (cbox a b) = 0"
     and "p tagged_division_of (cbox a b)"
   shows "(\<Sum>(x,K)\<in>p. content K *\<^sub>R f x) = (0::'a::real_normed_vector)"
 proof (rule sum.neutral, rule)
   fix y
   assume y: "y \<in> p"
   obtain x K where xk: "y = (x, K)"
     using surj_pair[of y] by blast
   then obtain c d where k: "K = cbox c d" "K \<subseteq> cbox a b"
     by (metis assms(2) tagged_division_ofD(3) tagged_division_ofD(4) y)
   have "(\<lambda>(x',K'). content K' *\<^sub>R f x') y = content K *\<^sub>R f x"
     unfolding xk by auto
   also have "\<dots> = 0"
     using assms(1) content_0_subset k(2) by auto
   finally show "(\<lambda>(x, k). content k *\<^sub>R f x) y = 0" .
 qed
 
 global_interpretation sum_content: operative plus 0 content
   rewrites "comm_monoid_set.F plus 0 = sum"
 proof -
   interpret operative plus 0 content
     by standard (auto simp add: content_split [symmetric] content_eq_0_interior)
   show "operative plus 0 content"
     by standard
   show "comm_monoid_set.F plus 0 = sum"
     by (simp add: sum_def)
 qed
 
 lemma additive_content_division: "d division_of (cbox a b) \<Longrightarrow> sum content d = content (cbox a b)"
   by (fact sum_content.division)
 
 lemma additive_content_tagged_division:
   "d tagged_division_of (cbox a b) \<Longrightarrow> sum (\<lambda>(x,l). content l) d = content (cbox a b)"
   by (fact sum_content.tagged_division)
 
 lemma subadditive_content_division:
   assumes "\<D> division_of S" "S \<subseteq> cbox a b"
   shows "sum content \<D> \<le> content(cbox a b)"
 proof -
   have "\<D> division_of \<Union>\<D>" "\<Union>\<D> \<subseteq> cbox a b"
     using assms by auto
   then obtain \<D>' where "\<D> \<subseteq> \<D>'" "\<D>' division_of cbox a b"
     using partial_division_extend_interval by metis
   then have "sum content \<D> \<le> sum content \<D>'"
     using sum_mono2 by blast
   also have "... \<le> content(cbox a b)"
     by (simp add: \<open>\<D>' division_of cbox a b\<close> additive_content_division less_eq_real_def)
   finally show ?thesis .
 qed
 
 lemma content_real_eq_0: "content {a..b::real} = 0 \<longleftrightarrow> a \<ge> b"
   by (metis atLeastatMost_empty_iff2 content_empty content_real diff_self eq_iff le_cases le_iff_diff_le_0)
 
 lemma property_empty_interval: "\<forall>a b. content (cbox a b) = 0 \<longrightarrow> P (cbox a b) \<Longrightarrow> P {}"
   using content_empty unfolding empty_as_interval by auto
 
 lemma interval_bounds_nz_content [simp]:
   assumes "content (cbox a b) \<noteq> 0"
   shows "interval_upperbound (cbox a b) = b"
     and "interval_lowerbound (cbox a b) = a"
   by (metis assms content_empty interval_bounds')+
 
 subsection \<open>Gauge integral\<close>
 
 text \<open>Case distinction to define it first on compact intervals first, then use a limit. This is only
 much later unified. In Fremlin: Measure Theory, Volume 4I this is generalized using residual sets.\<close>
 
 definition has_integral :: "('n::euclidean_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> 'n set \<Rightarrow> bool"
   (infixr "has'_integral" 46)
   where "(f has_integral I) s \<longleftrightarrow>
     (if \<exists>a b. s = cbox a b
       then ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter s)
       else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
         (\<exists>z. ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R (if x \<in> s then f x else 0)) \<longlongrightarrow> z) (division_filter (cbox a b)) \<and>
           norm (z - I) < e)))"
 
 lemma has_integral_cbox:
   "(f has_integral I) (cbox a b) \<longleftrightarrow> ((\<lambda>p. \<Sum>(x,k)\<in>p. content k *\<^sub>R f x) \<longlongrightarrow> I) (division_filter (cbox a b))"
   by (auto simp add: has_integral_def)
 
 lemma has_integral:
   "(f has_integral y) (cbox a b) \<longleftrightarrow>
     (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
       (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
         norm (sum (\<lambda>(x,k). content(k) *\<^sub>R f x) \<D> - y) < e))"
   by (auto simp: dist_norm eventually_division_filter has_integral_def tendsto_iff)
 
 lemma has_integral_real:
   "(f has_integral y) {a..b::real} \<longleftrightarrow>
     (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
       (\<forall>\<D>. \<D> tagged_division_of {a..b} \<and> \<gamma> fine \<D> \<longrightarrow>
         norm (sum (\<lambda>(x,k). content(k) *\<^sub>R f x) \<D> - y) < e))"
   unfolding box_real[symmetric] by (rule has_integral)
 
 lemma has_integralD[dest]:
   assumes "(f has_integral y) (cbox a b)"
     and "e > 0"
   obtains \<gamma>
     where "gauge \<gamma>"
       and "\<And>\<D>. \<D> tagged_division_of (cbox a b) \<Longrightarrow> \<gamma> fine \<D> \<Longrightarrow>
         norm ((\<Sum>(x,k)\<in>\<D>. content k *\<^sub>R f x) - y) < e"
   using assms unfolding has_integral by auto
 
 lemma has_integral_alt:
   "(f has_integral y) i \<longleftrightarrow>
     (if \<exists>a b. i = cbox a b
      then (f has_integral y) i
      else (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> i then f x else 0) has_integral z) (cbox a b) \<and> norm (z - y) < e)))"
   by (subst has_integral_def) (auto simp add: has_integral_cbox)
 
 lemma has_integral_altD:
   assumes "(f has_integral y) i"
     and "\<not> (\<exists>a b. i = cbox a b)"
     and "e>0"
   obtains B where "B > 0"
     and "\<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> i then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - y) < e)"
   using assms has_integral_alt[of f y i] by auto
 
 definition integrable_on (infixr "integrable'_on" 46)
   where "f integrable_on i \<longleftrightarrow> (\<exists>y. (f has_integral y) i)"
 
 definition "integral i f = (SOME y. (f has_integral y) i \<or> \<not> f integrable_on i \<and> y=0)"
 
 lemma integrable_integral[intro]: "f integrable_on i \<Longrightarrow> (f has_integral (integral i f)) i"
   unfolding integrable_on_def integral_def by (metis (mono_tags, lifting) someI_ex)
 
 lemma not_integrable_integral: "\<not> f integrable_on i \<Longrightarrow> integral i f = 0"
   unfolding integrable_on_def integral_def by blast
 
 lemma has_integral_integrable[dest]: "(f has_integral i) s \<Longrightarrow> f integrable_on s"
   unfolding integrable_on_def by auto
 
 lemma has_integral_integral: "f integrable_on s \<longleftrightarrow> (f has_integral (integral s f)) s"
   by auto
 
 subsection \<open>Basic theorems about integrals\<close>
 
 lemma has_integral_eq_rhs: "(f has_integral j) S \<Longrightarrow> i = j \<Longrightarrow> (f has_integral i) S"
   by (rule forw_subst)
 
 lemma has_integral_unique_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   shows "(f has_integral k1) (cbox a b) \<Longrightarrow> (f has_integral k2) (cbox a b) \<Longrightarrow> k1 = k2"
     by (auto simp: has_integral_cbox intro: tendsto_unique[OF division_filter_not_empty])    
 
 lemma has_integral_unique:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "(f has_integral k1) i" "(f has_integral k2) i"
   shows "k1 = k2"
 proof (rule ccontr)
   let ?e = "norm (k1 - k2)/2"
   let ?F = "(\<lambda>x. if x \<in> i then f x else 0)"
   assume "k1 \<noteq> k2"
   then have e: "?e > 0"
     by auto
   have nonbox: "\<not> (\<exists>a b. i = cbox a b)"
     using \<open>k1 \<noteq> k2\<close> assms has_integral_unique_cbox by blast
   obtain B1 where B1:
       "0 < B1"
       "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?F has_integral z) (cbox a b) \<and> norm (z - k1) < norm (k1 - k2)/2"
     by (rule has_integral_altD[OF assms(1) nonbox,OF e]) blast
   obtain B2 where B2:
       "0 < B2"
       "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?F has_integral z) (cbox a b) \<and> norm (z - k2) < norm (k1 - k2)/2"
     by (rule has_integral_altD[OF assms(2) nonbox,OF e]) blast
   obtain a b :: 'n where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
     by (metis Un_subset_iff bounded_Un bounded_ball bounded_subset_cbox_symmetric)
   obtain w where w: "(?F has_integral w) (cbox a b)" "norm (w - k1) < norm (k1 - k2)/2"
     using B1(2)[OF ab(1)] by blast
   obtain z where z: "(?F has_integral z) (cbox a b)" "norm (z - k2) < norm (k1 - k2)/2"
     using B2(2)[OF ab(2)] by blast
   have "z = w"
     using has_integral_unique_cbox[OF w(1) z(1)] by auto
   then have "norm (k1 - k2) \<le> norm (z - k2) + norm (w - k1)"
     using norm_triangle_ineq4 [of "k1 - w" "k2 - z"]
     by (auto simp add: norm_minus_commute)
   also have "\<dots> < norm (k1 - k2)/2 + norm (k1 - k2)/2"
     by (metis add_strict_mono z(2) w(2))
   finally show False by auto
 qed
 
 lemma integral_unique [intro]: "(f has_integral y) k \<Longrightarrow> integral k f = y"
   unfolding integral_def
   by (rule some_equality) (auto intro: has_integral_unique)
 
 lemma has_integral_iff: "(f has_integral i) S \<longleftrightarrow> (f integrable_on S \<and> integral S f = i)"
   by blast
 
 lemma eq_integralD: "integral k f = y \<Longrightarrow> (f has_integral y) k \<or> \<not> f integrable_on k \<and> y=0"
   unfolding integral_def integrable_on_def
   apply (erule subst)
   apply (rule someI_ex)
   by blast
 
 lemma has_integral_const [intro]:
   fixes a b :: "'a::euclidean_space"
   shows "((\<lambda>x. c) has_integral (content (cbox a b) *\<^sub>R c)) (cbox a b)"
   using eventually_division_filter_tagged_division[of "cbox a b"]
      additive_content_tagged_division[of _ a b]
   by (auto simp: has_integral_cbox split_beta' scaleR_sum_left[symmetric]
            elim!: eventually_mono intro!: tendsto_cong[THEN iffD1, OF _ tendsto_const])
 
 lemma has_integral_const_real [intro]:
   fixes a b :: real
   shows "((\<lambda>x. c) has_integral (content {a..b} *\<^sub>R c)) {a..b}"
   by (metis box_real(2) has_integral_const)
 
 lemma has_integral_integrable_integral: "(f has_integral i) s \<longleftrightarrow> f integrable_on s \<and> integral s f = i"
   by blast
 
 lemma integral_const [simp]:
   fixes a b :: "'a::euclidean_space"
   shows "integral (cbox a b) (\<lambda>x. c) = content (cbox a b) *\<^sub>R c"
   by (rule integral_unique) (rule has_integral_const)
 
 lemma integral_const_real [simp]:
   fixes a b :: real
   shows "integral {a..b} (\<lambda>x. c) = content {a..b} *\<^sub>R c"
   by (metis box_real(2) integral_const)
 
 lemma has_integral_is_0_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) (cbox a b)"
     unfolding has_integral_cbox
     using eventually_division_filter_tagged_division[of "cbox a b"] assms
     by (subst tendsto_cong[where g="\<lambda>_. 0"])
        (auto elim!: eventually_mono intro!: sum.neutral simp: tag_in_interval)
 
 lemma has_integral_is_0:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) S"
 proof (cases "(\<exists>a b. S = cbox a b)")
   case True with assms has_integral_is_0_cbox show ?thesis
     by blast
 next
   case False
   have *: "(\<lambda>x. if x \<in> S then f x else 0) = (\<lambda>x. 0)"
     by (auto simp add: assms)
   show ?thesis
     using has_integral_is_0_cbox False
     by (subst has_integral_alt) (force simp add: *)
 qed
 
 lemma has_integral_0[simp]: "((\<lambda>x::'n::euclidean_space. 0) has_integral 0) S"
   by (rule has_integral_is_0) auto
 
 lemma has_integral_0_eq[simp]: "((\<lambda>x. 0) has_integral i) S \<longleftrightarrow> i = 0"
   using has_integral_unique[OF has_integral_0] by auto
 
 lemma has_integral_linear_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral y) (cbox a b)"
     and h: "bounded_linear h"
   shows "((h \<circ> f) has_integral (h y)) (cbox a b)"
 proof -
   interpret bounded_linear h using h .
   show ?thesis
     unfolding has_integral_cbox using tendsto [OF f [unfolded has_integral_cbox]]
     by (simp add: sum scaleR split_beta')
 qed
 
 lemma has_integral_linear:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral y) S"
     and h: "bounded_linear h"
   shows "((h \<circ> f) has_integral (h y)) S"
 proof (cases "(\<exists>a b. S = cbox a b)")
   case True with f h has_integral_linear_cbox show ?thesis 
     by blast
 next
   case False
   interpret bounded_linear h using h .
   from pos_bounded obtain B where B: "0 < B" "\<And>x. norm (h x) \<le> norm x * B"
     by blast
   let ?S = "\<lambda>f x. if x \<in> S then f x else 0"
   show ?thesis
   proof (subst has_integral_alt, clarsimp simp: False)
     fix e :: real
     assume e: "e > 0"
     have *: "0 < e/B" using e B(1) by simp
     obtain M where M:
       "M > 0"
       "\<And>a b. ball 0 M \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?S f has_integral z) (cbox a b) \<and> norm (z - y) < e/B"
       using has_integral_altD[OF f False *] by blast
     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. (?S(h \<circ> f) has_integral z) (cbox a b) \<and> norm (z - h y) < e)"
     proof (rule exI, intro allI conjI impI)
       show "M > 0" using M by metis
     next
       fix a b::'n
       assume sb: "ball 0 M \<subseteq> cbox a b"
       obtain z where z: "(?S f has_integral z) (cbox a b)" "norm (z - y) < e/B"
         using M(2)[OF sb] by blast
       have *: "?S(h \<circ> f) = h \<circ> ?S f"
         using zero by auto
       show "\<exists>z. (?S(h \<circ> f) has_integral z) (cbox a b) \<and> norm (z - h y) < e"
         apply (rule_tac x="h z" in exI)
         apply (simp add: * has_integral_linear_cbox[OF z(1) h])
         apply (metis B diff le_less_trans pos_less_divide_eq z(2))
         done
     qed
   qed
 qed
 
 lemma has_integral_scaleR_left:
   "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x *\<^sub>R c) has_integral (y *\<^sub>R c)) S"
   using has_integral_linear[OF _ bounded_linear_scaleR_left] by (simp add: comp_def)
 
 lemma integrable_on_scaleR_left:
   assumes "f integrable_on A"
   shows "(\<lambda>x. f x *\<^sub>R y) integrable_on A"
   using assms has_integral_scaleR_left unfolding integrable_on_def by blast
 
 lemma has_integral_mult_left:
   fixes c :: "_ :: real_normed_algebra"
   shows "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x * c) has_integral (y * c)) S"
   using has_integral_linear[OF _ bounded_linear_mult_left] by (simp add: comp_def)
 
 lemma has_integral_divide:
   fixes c :: "_ :: real_normed_div_algebra"
   shows "(f has_integral y) S \<Longrightarrow> ((\<lambda>x. f x / c) has_integral (y / c)) S"
   unfolding divide_inverse by (simp add: has_integral_mult_left)
 
 text\<open>The case analysis eliminates the condition \<^term>\<open>f integrable_on S\<close> at the cost
      of the type class constraint \<open>division_ring\<close>\<close>
 corollary integral_mult_left [simp]:
   fixes c:: "'a::{real_normed_algebra,division_ring}"
   shows "integral S (\<lambda>x. f x * c) = integral S f * c"
 proof (cases "f integrable_on S \<or> c = 0")
   case True then show ?thesis
     by (force intro: has_integral_mult_left)
 next
   case False then have "\<not> (\<lambda>x. f x * c) integrable_on S"
     using has_integral_mult_left [of "(\<lambda>x. f x * c)" _ S "inverse c"]
     by (auto simp add: mult.assoc)
   with False show ?thesis by (simp add: not_integrable_integral)
 qed
 
 corollary integral_mult_right [simp]:
   fixes c:: "'a::{real_normed_field}"
   shows "integral S (\<lambda>x. c * f x) = c * integral S f"
 by (simp add: mult.commute [of c])
 
 corollary integral_divide [simp]:
   fixes z :: "'a::real_normed_field"
   shows "integral S (\<lambda>x. f x / z) = integral S (\<lambda>x. f x) / z"
 using integral_mult_left [of S f "inverse z"]
   by (simp add: divide_inverse_commute)
 
 lemma has_integral_mult_right:
   fixes c :: "'a :: real_normed_algebra"
   shows "(f has_integral y) i \<Longrightarrow> ((\<lambda>x. c * f x) has_integral (c * y)) i"
   using has_integral_linear[OF _ bounded_linear_mult_right] by (simp add: comp_def)
 
 lemma has_integral_cmul: "(f has_integral k) S \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) S"
   unfolding o_def[symmetric]
   by (metis has_integral_linear bounded_linear_scaleR_right)
 
 lemma has_integral_cmult_real:
   fixes c :: real
   assumes "c \<noteq> 0 \<Longrightarrow> (f has_integral x) A"
   shows "((\<lambda>x. c * f x) has_integral c * x) A"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   from has_integral_cmul[OF assms[OF this], of c] show ?thesis
     unfolding real_scaleR_def .
 qed
 
 lemma has_integral_neg: "(f has_integral k) S \<Longrightarrow> ((\<lambda>x. -(f x)) has_integral -k) S"
   by (drule_tac c="-1" in has_integral_cmul) auto
 
 lemma has_integral_neg_iff: "((\<lambda>x. - f x) has_integral k) S \<longleftrightarrow> (f has_integral - k) S"
   using has_integral_neg[of f "- k"] has_integral_neg[of "\<lambda>x. - f x" k] by auto
 
 lemma has_integral_add_cbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "(f has_integral k) (cbox a b)" "(g has_integral l) (cbox a b)"
   shows "((\<lambda>x. f x + g x) has_integral (k + l)) (cbox a b)"
   using assms
     unfolding has_integral_cbox
     by (simp add: split_beta' scaleR_add_right sum.distrib[abs_def] tendsto_add)
 
 lemma has_integral_add:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes f: "(f has_integral k) S" and g: "(g has_integral l) S"
   shows "((\<lambda>x. f x + g x) has_integral (k + l)) S"
 proof (cases "\<exists>a b. S = cbox a b")
   case True with has_integral_add_cbox assms show ?thesis
     by blast 
 next
   let ?S = "\<lambda>f x. if x \<in> S then f x else 0"
   case False
   then show ?thesis
   proof (subst has_integral_alt, clarsimp, goal_cases)
     case (1 e)
     then have e2: "e/2 > 0"
       by auto
     obtain Bf where "0 < Bf"
       and Bf: "\<And>a b. ball 0 Bf \<subseteq> cbox a b \<Longrightarrow>
                      \<exists>z. (?S f has_integral z) (cbox a b) \<and> norm (z - k) < e/2"
       using has_integral_altD[OF f False e2] by blast
     obtain Bg where "0 < Bg"
       and Bg: "\<And>a b. ball 0 Bg \<subseteq> (cbox a b) \<Longrightarrow>
                      \<exists>z. (?S g has_integral z) (cbox a b) \<and> norm (z - l) < e/2"
       using has_integral_altD[OF g False e2] by blast
     show ?case
     proof (rule_tac x="max Bf Bg" in exI, clarsimp simp add: max.strict_coboundedI1 \<open>0 < Bf\<close>)
       fix a b
       assume "ball 0 (max Bf Bg) \<subseteq> cbox a (b::'n)"
       then have fs: "ball 0 Bf \<subseteq> cbox a (b::'n)" and gs: "ball 0 Bg \<subseteq> cbox a (b::'n)"
         by auto
       obtain w where w: "(?S f has_integral w) (cbox a b)" "norm (w - k) < e/2"
         using Bf[OF fs] by blast
       obtain z where z: "(?S g has_integral z) (cbox a b)" "norm (z - l) < e/2"
         using Bg[OF gs] by blast
       have *: "\<And>x. (if x \<in> S then f x + g x else 0) = (?S f x) + (?S g x)"
         by auto
       show "\<exists>z. (?S(\<lambda>x. f x + g x) has_integral z) (cbox a b) \<and> norm (z - (k + l)) < e"
         apply (rule_tac x="w + z" in exI)
         apply (simp add: has_integral_add_cbox[OF w(1) z(1), unfolded *[symmetric]])
         using norm_triangle_ineq[of "w - k" "z - l"] w(2) z(2)
         apply (auto simp add: field_simps)
         done
     qed
   qed
 qed
 
 lemma has_integral_diff:
   "(f has_integral k) S \<Longrightarrow> (g has_integral l) S \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_integral (k - l)) S"
   using has_integral_add[OF _ has_integral_neg, of f k S g l]
   by (auto simp: algebra_simps)
 
 lemma integral_0 [simp]:
   "integral S (\<lambda>x::'n::euclidean_space. 0::'m::real_normed_vector) = 0"
   by (rule integral_unique has_integral_0)+
 
 lemma integral_add: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow>
     integral S (\<lambda>x. f x + g x) = integral S f + integral S g"
   by (rule integral_unique) (metis integrable_integral has_integral_add)
 
 lemma integral_cmul [simp]: "integral S (\<lambda>x. c *\<^sub>R f x) = c *\<^sub>R integral S f"
 proof (cases "f integrable_on S \<or> c = 0")
   case True with has_integral_cmul integrable_integral show ?thesis
     by fastforce
 next
   case False then have "\<not> (\<lambda>x. c *\<^sub>R f x) integrable_on S"
     using has_integral_cmul [of "(\<lambda>x. c *\<^sub>R f x)" _ S "inverse c"] by auto
   with False show ?thesis by (simp add: not_integrable_integral)
 qed
 
 lemma integral_mult:
   fixes K::real
   shows "f integrable_on X \<Longrightarrow> K * integral X f = integral X (\<lambda>x. K * f x)"
   unfolding real_scaleR_def[symmetric] integral_cmul ..
 
 lemma integral_neg [simp]: "integral S (\<lambda>x. - f x) = - integral S f"
 proof (cases "f integrable_on S")
   case True then show ?thesis
     by (simp add: has_integral_neg integrable_integral integral_unique)
 next
   case False then have "\<not> (\<lambda>x. - f x) integrable_on S"
     using has_integral_neg [of "(\<lambda>x. - f x)" _ S ] by auto
   with False show ?thesis by (simp add: not_integrable_integral)
 qed
 
 lemma integral_diff: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow>
     integral S (\<lambda>x. f x - g x) = integral S f - integral S g"
   by (rule integral_unique) (metis integrable_integral has_integral_diff)
 
 lemma integrable_0: "(\<lambda>x. 0) integrable_on S"
   unfolding integrable_on_def using has_integral_0 by auto
 
 lemma integrable_add: "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow> (\<lambda>x. f x + g x) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_add)
 
 lemma integrable_cmul: "f integrable_on S \<Longrightarrow> (\<lambda>x. c *\<^sub>R f(x)) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_cmul)
 
 lemma integrable_on_scaleR_iff [simp]:
   fixes c :: real
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. c *\<^sub>R f x) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_cmul[of "\<lambda>x. c *\<^sub>R f x" S "1 / c"] integrable_cmul[of f S c] \<open>c \<noteq> 0\<close>
   by auto
 
 lemma integrable_on_cmult_iff [simp]:
   fixes c :: real
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. c * f x) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_on_scaleR_iff [of c f] assms by simp
 
 lemma integrable_on_cmult_left:
   assumes "f integrable_on S"
   shows "(\<lambda>x. of_real c * f x) integrable_on S"
     using integrable_cmul[of f S "of_real c"] assms
     by (simp add: scaleR_conv_of_real)
 
 lemma integrable_neg: "f integrable_on S \<Longrightarrow> (\<lambda>x. -f(x)) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_neg)
 
 lemma integrable_neg_iff: "(\<lambda>x. -f(x)) integrable_on S \<longleftrightarrow> f integrable_on S"
   using integrable_neg by fastforce
 
 lemma integrable_diff:
   "f integrable_on S \<Longrightarrow> g integrable_on S \<Longrightarrow> (\<lambda>x. f x - g x) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_diff)
 
 lemma integrable_linear:
   "f integrable_on S \<Longrightarrow> bounded_linear h \<Longrightarrow> (h \<circ> f) integrable_on S"
   unfolding integrable_on_def by(auto intro: has_integral_linear)
 
 lemma integral_linear:
   "f integrable_on S \<Longrightarrow> bounded_linear h \<Longrightarrow> integral S (h \<circ> f) = h (integral S f)"
   apply (rule has_integral_unique [where i=S and f = "h \<circ> f"])
   apply (simp_all add: integrable_integral integrable_linear has_integral_linear )
   done
 
 lemma integrable_on_cnj_iff:
   "(\<lambda>x. cnj (f x)) integrable_on A \<longleftrightarrow> f integrable_on A"
   using integrable_linear[OF _ bounded_linear_cnj, of f A]
         integrable_linear[OF _ bounded_linear_cnj, of "cnj \<circ> f" A]
   by (auto simp: o_def)
 
 lemma integral_cnj: "cnj (integral A f) = integral A (\<lambda>x. cnj (f x))"
   by (cases "f integrable_on A")
      (simp_all add: integral_linear[OF _ bounded_linear_cnj, symmetric]
                     o_def integrable_on_cnj_iff not_integrable_integral)
 
 lemma integral_component_eq[simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "f integrable_on S"
   shows "integral S (\<lambda>x. f x \<bullet> k) = integral S f \<bullet> k"
   unfolding integral_linear[OF assms(1) bounded_linear_inner_left,unfolded o_def] ..
 
 lemma has_integral_sum:
   assumes "finite T"
     and "\<And>a. a \<in> T \<Longrightarrow> ((f a) has_integral (i a)) S"
   shows "((\<lambda>x. sum (\<lambda>a. f a x) T) has_integral (sum i T)) S"
   using assms(1) subset_refl[of T]
 proof (induct rule: finite_subset_induct)
   case empty
   then show ?case by auto
 next
   case (insert x F)
   with assms show ?case
     by (simp add: has_integral_add)
 qed
 
 lemma integral_sum:
   "\<lbrakk>finite I;  \<And>a. a \<in> I \<Longrightarrow> f a integrable_on S\<rbrakk> \<Longrightarrow>
    integral S (\<lambda>x. \<Sum>a\<in>I. f a x) = (\<Sum>a\<in>I. integral S (f a))"
   by (simp add: has_integral_sum integrable_integral integral_unique)
 
 lemma integrable_sum:
   "\<lbrakk>finite I;  \<And>a. a \<in> I \<Longrightarrow> f a integrable_on S\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Sum>a\<in>I. f a x) integrable_on S"
   unfolding integrable_on_def using has_integral_sum[of I] by metis
 
 lemma has_integral_eq:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
     and "(f has_integral k) s"
   shows "(g has_integral k) s"
   using has_integral_diff[OF assms(2), of "\<lambda>x. f x - g x" 0]
   using has_integral_is_0[of s "\<lambda>x. f x - g x"]
   using assms(1)
   by auto
 
 lemma integrable_eq: "\<lbrakk>f integrable_on s; \<And>x. x \<in> s \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g integrable_on s"
   unfolding integrable_on_def
   using has_integral_eq[of s f g] has_integral_eq by blast
 
 lemma has_integral_cong:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
   shows "(f has_integral i) s = (g has_integral i) s"
   using has_integral_eq[of s f g] has_integral_eq[of s g f] assms
   by auto
 
 lemma integral_cong:
   assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
   shows "integral s f = integral s g"
   unfolding integral_def
 by (metis (full_types, hide_lams) assms has_integral_cong integrable_eq)
 
 lemma integrable_on_cmult_left_iff [simp]:
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. of_real c * f x) integrable_on s \<longleftrightarrow> f integrable_on s"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "(\<lambda>x. of_real (1 / c) * (of_real c * f x)) integrable_on s"
     using integrable_cmul[of "\<lambda>x. of_real c * f x" s "1 / of_real c"]
     by (simp add: scaleR_conv_of_real)
   then have "(\<lambda>x. (of_real (1 / c) * of_real c * f x)) integrable_on s"
     by (simp add: algebra_simps)
   with \<open>c \<noteq> 0\<close> show ?rhs
     by (metis (no_types, lifting) integrable_eq mult.left_neutral nonzero_divide_eq_eq of_real_1 of_real_mult)
 qed (blast intro: integrable_on_cmult_left)
 
 lemma integrable_on_cmult_right:
   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
   assumes "f integrable_on s"
   shows "(\<lambda>x. f x * of_real c) integrable_on s"
 using integrable_on_cmult_left [OF assms] by (simp add: mult.commute)
 
 lemma integrable_on_cmult_right_iff [simp]:
   fixes f :: "_ \<Rightarrow> 'b :: {comm_ring,real_algebra_1,real_normed_vector}"
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. f x * of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
 using integrable_on_cmult_left_iff [OF assms] by (simp add: mult.commute)
 
 lemma integrable_on_cdivide:
   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
   assumes "f integrable_on s"
   shows "(\<lambda>x. f x / of_real c) integrable_on s"
 by (simp add: integrable_on_cmult_right divide_inverse assms flip: of_real_inverse)
 
 lemma integrable_on_cdivide_iff [simp]:
   fixes f :: "_ \<Rightarrow> 'b :: real_normed_field"
   assumes "c \<noteq> 0"
   shows "(\<lambda>x. f x / of_real c) integrable_on s \<longleftrightarrow> f integrable_on s"
 by (simp add: divide_inverse assms flip: of_real_inverse)
 
 lemma has_integral_null [intro]: "content(cbox a b) = 0 \<Longrightarrow> (f has_integral 0) (cbox a b)"
   unfolding has_integral_cbox
   using eventually_division_filter_tagged_division[of "cbox a b"]
   by (subst tendsto_cong[where g="\<lambda>_. 0"]) (auto elim: eventually_mono intro: sum_content_null)
 
 lemma has_integral_null_real [intro]: "content {a..b::real} = 0 \<Longrightarrow> (f has_integral 0) {a..b}"
   by (metis box_real(2) has_integral_null)
 
 lemma has_integral_null_eq[simp]: "content (cbox a b) = 0 \<Longrightarrow> (f has_integral i) (cbox a b) \<longleftrightarrow> i = 0"
   by (auto simp add: has_integral_null dest!: integral_unique)
 
 lemma integral_null [simp]: "content (cbox a b) = 0 \<Longrightarrow> integral (cbox a b) f = 0"
   by (metis has_integral_null integral_unique)
 
 lemma integrable_on_null [intro]: "content (cbox a b) = 0 \<Longrightarrow> f integrable_on (cbox a b)"
   by (simp add: has_integral_integrable)
 
 lemma has_integral_empty[intro]: "(f has_integral 0) {}"
   by (meson ex_in_conv has_integral_is_0)
 
 lemma has_integral_empty_eq[simp]: "(f has_integral i) {} \<longleftrightarrow> i = 0"
   by (auto simp add: has_integral_empty has_integral_unique)
 
 lemma integrable_on_empty[intro]: "f integrable_on {}"
   unfolding integrable_on_def by auto
 
 lemma integral_empty[simp]: "integral {} f = 0"
   by (rule integral_unique) (rule has_integral_empty)
 
 lemma has_integral_refl[intro]:
   fixes a :: "'a::euclidean_space"
   shows "(f has_integral 0) (cbox a a)"
     and "(f has_integral 0) {a}"
 proof -
   show "(f has_integral 0) (cbox a a)"
      by (rule has_integral_null) simp
   then show "(f has_integral 0) {a}"
     by simp
 qed
 
 lemma integrable_on_refl[intro]: "f integrable_on cbox a a"
   unfolding integrable_on_def by auto
 
 lemma integral_refl [simp]: "integral (cbox a a) f = 0"
   by (rule integral_unique) auto
 
 lemma integral_singleton [simp]: "integral {a} f = 0"
   by auto
 
 lemma integral_blinfun_apply:
   assumes "f integrable_on s"
   shows "integral s (\<lambda>x. blinfun_apply h (f x)) = blinfun_apply h (integral s f)"
   by (subst integral_linear[symmetric, OF assms blinfun.bounded_linear_right]) (simp add: o_def)
 
 lemma blinfun_apply_integral:
   assumes "f integrable_on s"
   shows "blinfun_apply (integral s f) x = integral s (\<lambda>y. blinfun_apply (f y) x)"
   by (metis (no_types, lifting) assms blinfun.prod_left.rep_eq integral_blinfun_apply integral_cong)
 
 lemma has_integral_componentwise_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(f has_integral y) A \<longleftrightarrow> (\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
 proof safe
   fix b :: 'b assume "(f has_integral y) A"
   from has_integral_linear[OF this(1) bounded_linear_inner_left, of b]
     show "((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A" by (simp add: o_def)
 next
   assume "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral ((y \<bullet> b) *\<^sub>R b)) A"
     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. (y \<bullet> b) *\<^sub>R b)) A"
     by (intro has_integral_sum) (simp_all add: o_def)
   thus "(f has_integral y) A" by (simp add: euclidean_representation)
 qed
 
 lemma has_integral_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(\<And>b. b \<in> Basis \<Longrightarrow> ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A) \<Longrightarrow> (f has_integral y) A"
   by (subst has_integral_componentwise_iff) blast
 
 lemma integrable_componentwise_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "f integrable_on A \<longleftrightarrow> (\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
 proof
   assume "f integrable_on A"
   then obtain y where "(f has_integral y) A" by (auto simp: integrable_on_def)
   hence "(\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral (y \<bullet> b)) A)"
     by (subst (asm) has_integral_componentwise_iff)
   thus "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)" by (auto simp: integrable_on_def)
 next
   assume "(\<forall>b\<in>Basis. (\<lambda>x. f x \<bullet> b) integrable_on A)"
   then obtain y where "\<forall>b\<in>Basis. ((\<lambda>x. f x \<bullet> b) has_integral y b) A"
     unfolding integrable_on_def by (subst (asm) bchoice_iff) blast
   hence "\<forall>b\<in>Basis. (((\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. f x \<bullet> b)) has_integral (y b *\<^sub>R b)) A"
     by (intro ballI has_integral_linear) (simp_all add: bounded_linear_scaleR_left)
   hence "((\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b) has_integral (\<Sum>b\<in>Basis. y b *\<^sub>R b)) A"
     by (intro has_integral_sum) (simp_all add: o_def)
   thus "f integrable_on A" by (auto simp: integrable_on_def o_def euclidean_representation)
 qed
 
 lemma integrable_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   shows "(\<And>b. b \<in> Basis \<Longrightarrow> (\<lambda>x. f x \<bullet> b) integrable_on A) \<Longrightarrow> f integrable_on A"
   by (subst integrable_componentwise_iff) blast
 
 lemma integral_componentwise:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   assumes "f integrable_on A"
   shows "integral A f = (\<Sum>b\<in>Basis. integral A (\<lambda>x. (f x \<bullet> b) *\<^sub>R b))"
 proof -
   from assms have integrable: "\<forall>b\<in>Basis. (\<lambda>x. x *\<^sub>R b) \<circ> (\<lambda>x. (f x \<bullet> b)) integrable_on A"
     by (subst (asm) integrable_componentwise_iff, intro integrable_linear ballI)
        (simp_all add: bounded_linear_scaleR_left)
   have "integral A f = integral A (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b)"
     by (simp add: euclidean_representation)
   also from integrable have "\<dots> = (\<Sum>a\<in>Basis. integral A (\<lambda>x. (f x \<bullet> a) *\<^sub>R a))"
     by (subst integral_sum) (simp_all add: o_def)
   finally show ?thesis .
 qed
 
 lemma integrable_component:
   "f integrable_on A \<Longrightarrow> (\<lambda>x. f x \<bullet> (y :: 'b :: euclidean_space)) integrable_on A"
   by (drule integrable_linear[OF _ bounded_linear_inner_left[of y]]) (simp add: o_def)
 
 
 
 subsection \<open>Cauchy-type criterion for integrability\<close>
 
 proposition integrable_Cauchy:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::{real_normed_vector,complete_space}"
   shows "f integrable_on cbox a b \<longleftrightarrow>
         (\<forall>e>0. \<exists>\<gamma>. gauge \<gamma> \<and>
           (\<forall>\<D>1 \<D>2. \<D>1 tagged_division_of (cbox a b) \<and> \<gamma> fine \<D>1 \<and>
             \<D>2 tagged_division_of (cbox a b) \<and> \<gamma> fine \<D>2 \<longrightarrow>
             norm ((\<Sum>(x,K)\<in>\<D>1. content K *\<^sub>R f x) - (\<Sum>(x,K)\<in>\<D>2. content K *\<^sub>R f x)) < e))"
   (is "?l = (\<forall>e>0. \<exists>\<gamma>. ?P e \<gamma>)")
 proof (intro iffI allI impI)
   assume ?l
   then obtain y
     where y: "\<And>e. e > 0 \<Longrightarrow>
         \<exists>\<gamma>. gauge \<gamma> \<and>
             (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                  norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - y) < e)"
     by (auto simp: integrable_on_def has_integral)
   show "\<exists>\<gamma>. ?P e \<gamma>" if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
     with y obtain \<gamma> where "gauge \<gamma>"
       and \<gamma>: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<Longrightarrow>
                   norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f x) - y) < e/2"
       by meson
     show ?thesis
     apply (rule_tac x=\<gamma> in exI, clarsimp simp: \<open>gauge \<gamma>\<close>)
         by (blast intro!: \<gamma> dist_triangle_half_l[where y=y,unfolded dist_norm])
     qed
 next
   assume "\<forall>e>0. \<exists>\<gamma>. ?P e \<gamma>"
   then have "\<forall>n::nat. \<exists>\<gamma>. ?P (1 / (n + 1)) \<gamma>"
     by auto
   then obtain \<gamma> :: "nat \<Rightarrow> 'n \<Rightarrow> 'n set" where \<gamma>:
     "\<And>m. gauge (\<gamma> m)"
     "\<And>m \<D>1 \<D>2. \<lbrakk>\<D>1 tagged_division_of cbox a b;
               \<gamma> m fine \<D>1; \<D>2 tagged_division_of cbox a b; \<gamma> m fine \<D>2\<rbrakk>
               \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> \<D>2. content K *\<^sub>R f x))
                   < 1 / (m + 1)"
     by metis
   have "\<And>n. gauge (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..n}})"
     apply (rule gauge_Inter)
     using \<gamma> by auto
   then have "\<forall>n. \<exists>p. p tagged_division_of (cbox a b) \<and> (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..n}}) fine p"
     by (meson fine_division_exists)
   then obtain p where p: "\<And>z. p z tagged_division_of cbox a b"
                          "\<And>z. (\<lambda>x. \<Inter>{\<gamma> i x |i. i \<in> {0..z}}) fine p z"
     by meson
   have dp: "\<And>i n. i\<le>n \<Longrightarrow> \<gamma> i fine p n"
     using p unfolding fine_Inter
     using atLeastAtMost_iff by blast
   have "Cauchy (\<lambda>n. sum (\<lambda>(x,K). content K *\<^sub>R (f x)) (p n))"
   proof (rule CauchyI)
     fix e::real
     assume "0 < e"
     then obtain N where "N \<noteq> 0" and N: "inverse (real N) < e"
       using real_arch_inverse[of e] by blast
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm ((\<Sum>(x,K) \<in> p m. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x)) < e"
     proof (intro exI allI impI)
       fix m n
       assume mn: "N \<le> m" "N \<le> n"
       have "norm ((\<Sum>(x,K) \<in> p m. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x)) < 1 / (real N + 1)"
         by (simp add: p(1) dp mn \<gamma>)
       also have "... < e"
         using  N \<open>N \<noteq> 0\<close> \<open>0 < e\<close> by (auto simp: field_simps)
       finally show "norm ((\<Sum>(x,K) \<in> p m. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x)) < e" .
     qed
   qed
   then obtain y where y: "\<exists>no. \<forall>n\<ge>no. norm ((\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x) - y) < r" if "r > 0" for r
     by (auto simp: convergent_eq_Cauchy[symmetric] dest: LIMSEQ_D)
   show ?l
     unfolding integrable_on_def has_integral
   proof (rule_tac x=y in exI, clarify)
     fix e :: real
     assume "e>0"
     then have e2: "e/2 > 0" by auto
     then obtain N1::nat where N1: "N1 \<noteq> 0" "inverse (real N1) < e/2"
       using real_arch_inverse by blast
     obtain N2::nat where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> norm ((\<Sum>(x,K) \<in> p n. content K *\<^sub>R f x) - y) < e/2"
       using y[OF e2] by metis
     show "\<exists>\<gamma>. gauge \<gamma> \<and>
               (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
                 norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - y) < e)"
     proof (intro exI conjI allI impI)
       show "gauge (\<gamma> (N1+N2))"
         using \<gamma> by auto
       show "norm ((\<Sum>(x,K) \<in> q. content K *\<^sub>R f x) - y) < e"
            if "q tagged_division_of cbox a b \<and> \<gamma> (N1+N2) fine q" for q
       proof (rule norm_triangle_half_r)
         have "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> q. content K *\<^sub>R f x))
                < 1 / (real (N1+N2) + 1)"
           by (rule \<gamma>; simp add: dp p that)
         also have "... < e/2"
           using N1 \<open>0 < e\<close> by (auto simp: field_simps intro: less_le_trans)
         finally show "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> q. content K *\<^sub>R f x)) < e/2" .
         show "norm ((\<Sum>(x,K) \<in> p (N1+N2). content K *\<^sub>R f x) - y) < e/2"
           using N2 le_add_same_cancel2 by blast
       qed
     qed
   qed
 qed
 
 
 subsection \<open>Additivity of integral on abutting intervals\<close>
 
 lemma tagged_division_split_left_inj_content:
   assumes \<D>: "\<D> tagged_division_of S"
     and "(x1, K1) \<in> \<D>" "(x2, K2) \<in> \<D>" "K1 \<noteq> K2" "K1 \<inter> {x. x\<bullet>k \<le> c} = K2 \<inter> {x. x\<bullet>k \<le> c}" "k \<in> Basis"
   shows "content (K1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
 proof -
   from tagged_division_ofD(4)[OF \<D> \<open>(x1, K1) \<in> \<D>\<close>] obtain a b where K1: "K1 = cbox a b"
     by auto
   then have "interior (K1 \<inter> {x. x \<bullet> k \<le> c}) = {}"
     by (metis tagged_division_split_left_inj assms)
   then show ?thesis
     unfolding K1 interval_split[OF \<open>k \<in> Basis\<close>] by (auto simp: content_eq_0_interior)
 qed
 
 lemma tagged_division_split_right_inj_content:
   assumes \<D>: "\<D> tagged_division_of S"
     and "(x1, K1) \<in> \<D>" "(x2, K2) \<in> \<D>" "K1 \<noteq> K2" "K1 \<inter> {x. x\<bullet>k \<ge> c} = K2 \<inter> {x. x\<bullet>k \<ge> c}" "k \<in> Basis"
   shows "content (K1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
 proof -
   from tagged_division_ofD(4)[OF \<D> \<open>(x1, K1) \<in> \<D>\<close>] obtain a b where K1: "K1 = cbox a b"
     by auto
   then have "interior (K1 \<inter> {x. c \<le> x \<bullet> k}) = {}"
     by (metis tagged_division_split_right_inj assms)
   then show ?thesis
     unfolding K1 interval_split[OF \<open>k \<in> Basis\<close>]
     by (auto simp: content_eq_0_interior)
 qed
 
 
 proposition has_integral_split:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes fi: "(f has_integral i) (cbox a b \<inter> {x. x\<bullet>k \<le> c})"
       and fj: "(f has_integral j) (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"
       and k: "k \<in> Basis"
 shows "(f has_integral (i + j)) (cbox a b)"
   unfolding has_integral
 proof clarify
   fix e::real
   assume "0 < e"
   then have e: "e/2 > 0"
     by auto
     obtain \<gamma>1 where \<gamma>1: "gauge \<gamma>1"
       and \<gamma>1norm:
         "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; \<gamma>1 fine \<D>\<rbrakk>
              \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - i) < e/2"
        apply (rule has_integralD[OF fi[unfolded interval_split[OF k]] e])
        apply (simp add: interval_split[symmetric] k)
       done
     obtain \<gamma>2 where \<gamma>2: "gauge \<gamma>2"
       and \<gamma>2norm:
         "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; \<gamma>2 fine \<D>\<rbrakk>
              \<Longrightarrow> norm ((\<Sum>(x, k) \<in> \<D>. content k *\<^sub>R f x) - j) < e/2"
        apply (rule has_integralD[OF fj[unfolded interval_split[OF k]] e])
        apply (simp add: interval_split[symmetric] k)
        done
   let ?\<gamma> = "\<lambda>x. if x\<bullet>k = c then (\<gamma>1 x \<inter> \<gamma>2 x) else ball x \<bar>x\<bullet>k - c\<bar> \<inter> \<gamma>1 x \<inter> \<gamma>2 x"
   have "gauge ?\<gamma>"
     using \<gamma>1 \<gamma>2 unfolding gauge_def by auto
   then show "\<exists>\<gamma>. gauge \<gamma> \<and>
                  (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                       norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - (i + j)) < e)"
   proof (rule_tac x="?\<gamma>" in exI, safe)
     fix p
     assume p: "p tagged_division_of (cbox a b)" and "?\<gamma> fine p"
     have ab_eqp: "cbox a b = \<Union>{K. \<exists>x. (x, K) \<in> p}"
       using p by blast
     have xk_le_c: "x\<bullet>k \<le> c" if as: "(x,K) \<in> p" and K: "K \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}" for x K
     proof (rule ccontr)
       assume **: "\<not> x \<bullet> k \<le> c"
       then have "K \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
         using \<open>?\<gamma> fine p\<close> as by (fastforce simp: not_le algebra_simps)
       with K obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<le> c"
         by blast
       then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
         using Basis_le_norm[OF k, of "x - y"]
         by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
       with y show False
         using ** by (auto simp add: field_simps)
     qed
     have xk_ge_c: "x\<bullet>k \<ge> c" if as: "(x,K) \<in> p" and K: "K \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}" for x K
     proof (rule ccontr)
       assume **: "\<not> x \<bullet> k \<ge> c"
       then have "K \<subseteq> ball x \<bar>x \<bullet> k - c\<bar>"
         using \<open>?\<gamma> fine p\<close> as by (fastforce simp: not_le algebra_simps)
       with K obtain y where y: "y \<in> ball x \<bar>x \<bullet> k - c\<bar>" "y\<bullet>k \<ge> c"
         by blast
       then have "\<bar>x \<bullet> k - y \<bullet> k\<bar> < \<bar>x \<bullet> k - c\<bar>"
         using Basis_le_norm[OF k, of "x - y"]
         by (auto simp add: dist_norm inner_diff_left intro: le_less_trans)
       with y show False
         using ** by (auto simp add: field_simps)
     qed
     have fin_finite: "finite {(x,f K) | x K. (x,K) \<in> s \<and> P x K}"
       if "finite s" for s and f :: "'a set \<Rightarrow> 'a set" and P :: "'a \<Rightarrow> 'a set \<Rightarrow> bool"
     proof -
       from that have "finite ((\<lambda>(x,K). (x, f K)) ` s)"
         by auto
       then show ?thesis
         by (rule rev_finite_subset) auto
     qed
     { fix \<G> :: "'a set \<Rightarrow> 'a set"
       fix i :: "'a \<times> 'a set"
       assume "i \<in> (\<lambda>(x, k). (x, \<G> k)) ` p - {(x, \<G> k) |x k. (x, k) \<in> p \<and> \<G> k \<noteq> {}}"
       then obtain x K where xk: "i = (x, \<G> K)"  "(x,K) \<in> p"
                                  "(x, \<G> K) \<notin> {(x, \<G> K) |x K. (x,K) \<in> p \<and> \<G> K \<noteq> {}}"
         by auto
       have "content (\<G> K) = 0"
         using xk using content_empty by auto
       then have "(\<lambda>(x,K). content K *\<^sub>R f x) i = 0"
         unfolding xk split_conv by auto
     } note [simp] = this
     have "finite p"
       using p by blast
     let ?M1 = "{(x, K \<inter> {x. x\<bullet>k \<le> c}) |x K. (x,K) \<in> p \<and> K \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
     have \<gamma>1_fine: "\<gamma>1 fine ?M1"
       using \<open>?\<gamma> fine p\<close> by (fastforce simp: fine_def split: if_split_asm)
     have "norm ((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) < e/2"
     proof (rule \<gamma>1norm [OF tagged_division_ofI \<gamma>1_fine])
       show "finite ?M1"
         by (rule fin_finite) (use p in blast)
       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M1} = cbox a b \<inter> {x. x\<bullet>k \<le> c}"
         by (auto simp: ab_eqp)
 
       fix x L
       assume xL: "(x, L) \<in> ?M1"
       then obtain x' L' where xL': "x = x'" "L = L' \<inter> {x. x \<bullet> k \<le> c}"
                                    "(x', L') \<in> p" "L' \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
         by blast
       then obtain a' b' where ab': "L' = cbox a' b'"
         using p by blast
       show "x \<in> L" "L \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<le> c}"
         using p xk_le_c xL' by auto
       show "\<exists>a b. L = cbox a b"
         using p xL' ab' by (auto simp add: interval_split[OF k,where c=c])
 
       fix y R
       assume yR: "(y, R) \<in> ?M1"
       then obtain y' R' where yR': "y = y'" "R = R' \<inter> {x. x \<bullet> k \<le> c}"
                                    "(y', R') \<in> p" "R' \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
         by blast
       assume as: "(x, L) \<noteq> (y, R)"
       show "interior L \<inter> interior R = {}"
       proof (cases "L' = R' \<longrightarrow> x' = y'")
         case False
         have "interior R' = {}"
           by (metis (no_types) False Pair_inject inf.idem tagged_division_ofD(5) [OF p] xL'(3) yR'(3))
         then show ?thesis
           using yR' by simp
       next
         case True
         then have "L' \<noteq> R'"
           using as unfolding xL' yR' by auto
         have "interior L' \<inter> interior R' = {}"
           by (metis (no_types) Pair_inject \<open>L' \<noteq> R'\<close> p tagged_division_ofD(5) xL'(3) yR'(3))
         then show ?thesis
           using xL'(2) yR'(2) by auto
       qed
     qed
     moreover
     let ?M2 = "{(x,K \<inter> {x. x\<bullet>k \<ge> c}) |x K. (x,K) \<in> p \<and> K \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
     have \<gamma>2_fine: "\<gamma>2 fine ?M2"
       using \<open>?\<gamma> fine p\<close> by (fastforce simp: fine_def split: if_split_asm)
     have "norm ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) < e/2"
     proof (rule \<gamma>2norm [OF tagged_division_ofI \<gamma>2_fine])
       show "finite ?M2"
         by (rule fin_finite) (use p in blast)
       show "\<Union>{k. \<exists>x. (x, k) \<in> ?M2} = cbox a b \<inter> {x. x\<bullet>k \<ge> c}"
         by (auto simp: ab_eqp)
 
       fix x L
       assume xL: "(x, L) \<in> ?M2"
       then obtain x' L' where xL': "x = x'" "L = L' \<inter> {x. x \<bullet> k \<ge> c}"
                                    "(x', L') \<in> p" "L' \<inter> {x. x \<bullet> k \<ge> c} \<noteq> {}"
         by blast
       then obtain a' b' where ab': "L' = cbox a' b'"
         using p by blast
       show "x \<in> L" "L \<subseteq> cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
         using p xk_ge_c xL' by auto
       show "\<exists>a b. L = cbox a b"
         using p xL' ab' by (auto simp add: interval_split[OF k,where c=c])
 
       fix y R
       assume yR: "(y, R) \<in> ?M2"
       then obtain y' R' where yR': "y = y'" "R = R' \<inter> {x. x \<bullet> k \<ge> c}"
                                    "(y', R') \<in> p" "R' \<inter> {x. x \<bullet> k \<ge> c} \<noteq> {}"
         by blast
       assume as: "(x, L) \<noteq> (y, R)"
       show "interior L \<inter> interior R = {}"
       proof (cases "L' = R' \<longrightarrow> x' = y'")
         case False
         have "interior R' = {}"
           by (metis (no_types) False Pair_inject inf.idem tagged_division_ofD(5) [OF p] xL'(3) yR'(3))
         then show ?thesis
           using yR' by simp
       next
         case True
         then have "L' \<noteq> R'"
           using as unfolding xL' yR' by auto
         have "interior L' \<inter> interior R' = {}"
           by (metis (no_types) Pair_inject \<open>L' \<noteq> R'\<close> p tagged_division_ofD(5) xL'(3) yR'(3))
         then show ?thesis
           using xL'(2) yR'(2) by auto
       qed
     qed
     ultimately
     have "norm (((\<Sum>(x,K) \<in> ?M1. content K *\<^sub>R f x) - i) + ((\<Sum>(x,K) \<in> ?M2. content K *\<^sub>R f x) - j)) < e/2 + e/2"
       using norm_add_less by blast
     moreover have "((\<Sum>(x,K) \<in> ?M1. content K *\<^sub>R f x) - i) +
                    ((\<Sum>(x,K) \<in> ?M2. content K *\<^sub>R f x) - j) =
                    (\<Sum>(x, ka)\<in>p. content ka *\<^sub>R f x) - (i + j)"
     proof -
       have eq0: "\<And>x y. x = (0::real) \<Longrightarrow> x *\<^sub>R (y::'b) = 0"
          by auto
       have cont_eq: "\<And>g. (\<lambda>(x,l). content l *\<^sub>R f x) \<circ> (\<lambda>(x,l). (x,g l)) = (\<lambda>(x,l). content (g l) *\<^sub>R f x)"
         by auto
       have *: "\<And>\<G> :: 'a set \<Rightarrow> 'a set.
                   (\<Sum>(x,K)\<in>{(x, \<G> K) |x K. (x,K) \<in> p \<and> \<G> K \<noteq> {}}. content K *\<^sub>R f x) =
                   (\<Sum>(x,K)\<in>(\<lambda>(x,K). (x, \<G> K)) ` p. content K *\<^sub>R f x)"
         by (rule sum.mono_neutral_left) (auto simp: \<open>finite p\<close>)
       have "((\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) - i) + ((\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - j) =
         (\<Sum>(x, k)\<in>?M1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>?M2. content k *\<^sub>R f x) - (i + j)"
         by auto
       moreover have "\<dots> = (\<Sum>(x,K) \<in> p. content (K \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) +
         (\<Sum>(x,K) \<in> p. content (K \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) - (i + j)"
         unfolding *
         apply (subst (1 2) sum.reindex_nontrivial)
            apply (auto intro!: k p eq0 tagged_division_split_left_inj_content tagged_division_split_right_inj_content
                        simp: cont_eq \<open>finite p\<close>)
         done
       moreover have "\<And>x. x \<in> p \<Longrightarrow> (\<lambda>(a,B). content (B \<inter> {a. a \<bullet> k \<le> c}) *\<^sub>R f a) x +
                                 (\<lambda>(a,B). content (B \<inter> {a. c \<le> a \<bullet> k}) *\<^sub>R f a) x =
                                 (\<lambda>(a,B). content B *\<^sub>R f a) x"
       proof clarify
         fix a B
         assume "(a, B) \<in> p"
         with p obtain u v where uv: "B = cbox u v" by blast
         then show "content (B \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f a + content (B \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f a = content B *\<^sub>R f a"
           by (auto simp: scaleR_left_distrib uv content_split[OF k,of u v c])
       qed
       ultimately show ?thesis
         by (auto simp: sum.distrib[symmetric])
       qed
     ultimately show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - (i + j)) < e"
       by auto
   qed
 qed
 
 
 subsection \<open>A sort of converse, integrability on subintervals\<close>
 
 lemma has_integral_separate_sides:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes f: "(f has_integral i) (cbox a b)"
     and "e > 0"
     and k: "k \<in> Basis"
   obtains d where "gauge d"
     "\<forall>p1 p2. p1 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
         p2 tagged_division_of (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2 \<longrightarrow>
         norm ((sum (\<lambda>(x,k). content k *\<^sub>R f x) p1 + sum (\<lambda>(x,k). content k *\<^sub>R f x) p2) - i) < e"
 proof -
   obtain \<gamma> where d: "gauge \<gamma>"
       "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma> fine p\<rbrakk>
             \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < e"
     using has_integralD[OF f \<open>e > 0\<close>] by metis
   { fix p1 p2
     assume tdiv1: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" and "\<gamma> fine p1"
     note p1=tagged_division_ofD[OF this(1)] 
     assume tdiv2: "p2 tagged_division_of (cbox a b) \<inter> {x. c \<le> x \<bullet> k}" and "\<gamma> fine p2"
     note p2=tagged_division_ofD[OF this(1)] 
     note tagged_division_Un_interval[OF tdiv1 tdiv2] 
     note p12 = tagged_division_ofD[OF this] this
     { fix a b
       assume ab: "(a, b) \<in> p1 \<inter> p2"
       have "(a, b) \<in> p1"
         using ab by auto
       obtain u v where uv: "b = cbox u v"
         using \<open>(a, b) \<in> p1\<close> p1(4) by moura
       have "b \<subseteq> {x. x\<bullet>k = c}"
         using ab p1(3)[of a b] p2(3)[of a b] by fastforce
       moreover
       have "interior {x::'a. x \<bullet> k = c} = {}"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         then obtain x where x: "x \<in> interior {x::'a. x\<bullet>k = c}"
           by auto
         then obtain \<epsilon> where "0 < \<epsilon>" and \<epsilon>: "ball x \<epsilon> \<subseteq> {x. x \<bullet> k = c}"
           using mem_interior by metis
         have x: "x\<bullet>k = c"
           using x interior_subset by fastforce
         have *: "\<And>i. i \<in> Basis \<Longrightarrow> \<bar>(x - (x + (\<epsilon>/2) *\<^sub>R k)) \<bullet> i\<bar> = (if i = k then \<epsilon>/2 else 0)"
           using \<open>0 < \<epsilon>\<close> k by (auto simp: inner_simps inner_not_same_Basis)
         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (\<epsilon>/2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
               (\<Sum>i\<in>Basis. (if i = k then \<epsilon>/2 else 0))"
           using "*" by (blast intro: sum.cong)
         also have "\<dots> < \<epsilon>"
           by (subst sum.delta) (use \<open>0 < \<epsilon>\<close> in auto)
         finally have "x + (\<epsilon>/2) *\<^sub>R k \<in> ball x \<epsilon>"
           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
         then have "x + (\<epsilon>/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}"
           using \<epsilon> by auto
         then show False
           using \<open>0 < \<epsilon>\<close> x k by (auto simp: inner_simps)
       qed
       ultimately have "content b = 0"
         unfolding uv content_eq_0_interior
         using interior_mono by blast
       then have "content b *\<^sub>R f a = 0"
         by auto
     }
     then have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) =
                norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
       by (subst sum.union_inter_neutral) (auto simp: p1 p2)
     also have "\<dots> < e"
       using d(2) p12 by (simp add: fine_Un k \<open>\<gamma> fine p1\<close> \<open>\<gamma> fine p2\<close>)
     finally have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) < e" .
    }
   then show ?thesis
     using d(1) that by auto
 qed
 
 lemma integrable_split [intro]:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
   assumes f: "f integrable_on cbox a b"
       and k: "k \<in> Basis"
     shows "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<le> c})"   (is ?thesis1)
     and   "f integrable_on (cbox a b \<inter> {x. x\<bullet>k \<ge> c})"   (is ?thesis2)
 proof -
   obtain y where y: "(f has_integral y) (cbox a b)"
     using f by blast
   define a' where "a' = (\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i)"
   define b' where "b' = (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i)"
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p2 \<longrightarrow>
                      norm ((\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)) < e)"
     if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
   with has_integral_separate_sides[OF y this k, of c]
   obtain d
     where "gauge d"
          and d: "\<And>p1 p2. \<lbrakk>p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; d fine p1;
                           p2 tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; d fine p2\<rbrakk>
                   \<Longrightarrow> norm ((\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) + (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x) - y) < e/2"
     by metis
   show ?thesis
     proof (rule_tac x=d in exI, clarsimp simp add: \<open>gauge d\<close>)
       fix p1 p2
       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<le> c}" "d fine p2"
       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
       proof (rule fine_division_exists[OF \<open>gauge d\<close>, of a' b])
         fix p
         assume "p tagged_division_of cbox a' b" "d fine p"
         then show ?thesis
           using as norm_triangle_half_l[OF d[of p1 p] d[of p2 p]]
           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   with f show ?thesis1
     by (simp add: interval_split[OF k] integrable_Cauchy)
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p2 \<longrightarrow>
                      norm ((\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)) < e)"
     if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
   with has_integral_separate_sides[OF y this k, of c]
   obtain d
     where "gauge d"
          and d: "\<And>p1 p2. \<lbrakk>p1 tagged_division_of cbox a b \<inter> {x. x \<bullet> k \<le> c}; d fine p1;
                           p2 tagged_division_of cbox a b \<inter> {x. c \<le> x \<bullet> k}; d fine p2\<rbrakk>
                   \<Longrightarrow> norm ((\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) + (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x) - y) < e/2"
     by metis
   show ?thesis
     proof (rule_tac x=d in exI, clarsimp simp add: \<open>gauge d\<close>)
       fix p1 p2
       assume as: "p1 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p1"
                  "p2 tagged_division_of (cbox a b) \<inter> {x. x \<bullet> k \<ge> c}" "d fine p2"
       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
       proof (rule fine_division_exists[OF \<open>gauge d\<close>, of a b'])
         fix p
         assume "p tagged_division_of cbox a b'" "d fine p"
         then show ?thesis
           using as norm_triangle_half_l[OF d[of p p1] d[of p p2]]
           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   with f show ?thesis2
     by (simp add: interval_split[OF k] integrable_Cauchy)
 qed
 
 lemma operative_integralI:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   shows "operative (lift_option (+)) (Some 0)
     (\<lambda>i. if f integrable_on i then Some (integral i f) else None)"
 proof -
   interpret comm_monoid "lift_option plus" "Some (0::'b)"
     by (rule comm_monoid_lift_option)
       (rule add.comm_monoid_axioms)
   show ?thesis
   proof
     fix a b c
     fix k :: 'a
     assume k: "k \<in> Basis"
     show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) =
           lift_option (+) (if f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c} then Some (integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f) else None)
           (if f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k} then Some (integral (cbox a b \<inter> {x. c \<le> x \<bullet> k}) f) else None)"
     proof (cases "f integrable_on cbox a b")
       case True
       with k show ?thesis
         apply (simp add: integrable_split)
         apply (rule integral_unique [OF has_integral_split[OF _ _ k]])
         apply (auto intro: integrable_integral)
         done
     next
     case False
       have "\<not> (f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}) \<or> \<not> ( f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k})"
       proof (rule ccontr)
         assume "\<not> ?thesis"
         then have "f integrable_on cbox a b"
           unfolding integrable_on_def
           apply (rule_tac x="integral (cbox a b \<inter> {x. x \<bullet> k \<le> c}) f + integral (cbox a b \<inter> {x. x \<bullet> k \<ge> c}) f" in exI)
           apply (rule has_integral_split[OF _ _ k])
           apply (auto intro: integrable_integral)
           done
         then show False
           using False by auto
       qed
       then show ?thesis
         using False by auto
     qed
   next
     fix a b :: 'a
     assume "box a b = {}"
     then show "(if f integrable_on cbox a b then Some (integral (cbox a b) f) else None) = Some 0"
       using has_integral_null_eq
       by (auto simp: integrable_on_null content_eq_0_interior)
   qed
 qed
 
 subsection \<open>Bounds on the norm of Riemann sums and the integral itself\<close>
 
 lemma dsum_bound:
   assumes "p division_of (cbox a b)"
     and "norm c \<le> e"
   shows "norm (sum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content(cbox a b)"
 proof -
   have sumeq: "(\<Sum>i\<in>p. \<bar>content i\<bar>) = sum content p"
     apply (rule sum.cong)
     using assms
     apply simp
     apply (metis abs_of_nonneg assms(1) content_pos_le division_ofD(4))
     done
   have e: "0 \<le> e"
     using assms(2) norm_ge_zero order_trans by blast
   have "norm (sum (\<lambda>l. content l *\<^sub>R c) p) \<le> (\<Sum>i\<in>p. norm (content i *\<^sub>R c))"
     using norm_sum by blast
   also have "...  \<le> e * (\<Sum>i\<in>p. \<bar>content i\<bar>)"
     by (simp add: sum_distrib_left[symmetric] mult.commute assms(2) mult_right_mono sum_nonneg)
   also have "... \<le> e * content (cbox a b)"
     apply (rule mult_left_mono [OF _ e])
     apply (simp add: sumeq)
     using additive_content_division assms(1) eq_iff apply blast
     done
   finally show ?thesis .
 qed
 
 lemma rsum_bound:
   assumes p: "p tagged_division_of (cbox a b)"
       and "\<forall>x\<in>cbox a b. norm (f x) \<le> e"
     shows "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content (cbox a b)"
 proof (cases "cbox a b = {}")
   case True show ?thesis
     using p unfolding True tagged_division_of_trivial by auto
 next
   case False
   then have e: "e \<ge> 0"
     by (meson ex_in_conv assms(2) norm_ge_zero order_trans)
   have sum_le: "sum (content \<circ> snd) p \<le> content (cbox a b)"
     unfolding additive_content_tagged_division[OF p, symmetric] split_def
     by (auto intro: eq_refl)
   have con: "\<And>xk. xk \<in> p \<Longrightarrow> 0 \<le> content (snd xk)"
     using tagged_division_ofD(4) [OF p] content_pos_le
     by force
   have norm: "\<And>xk. xk \<in> p \<Longrightarrow> norm (f (fst xk)) \<le> e"
     unfolding fst_conv using tagged_division_ofD(2,3)[OF p] assms
     by (metis prod.collapse subset_eq)
   have "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> (\<Sum>i\<in>p. norm (case i of (x, k) \<Rightarrow> content k *\<^sub>R f x))"
     by (rule norm_sum)
   also have "...  \<le> e * content (cbox a b)"
     unfolding split_def norm_scaleR
     apply (rule order_trans[OF sum_mono])
     apply (rule mult_left_mono[OF _ abs_ge_zero, of _ e])
     apply (metis norm)
     unfolding sum_distrib_right[symmetric]
     using con sum_le
     apply (auto simp: mult.commute intro: mult_left_mono [OF _ e])
     done
   finally show ?thesis .
 qed
 
 lemma rsum_diff_bound:
   assumes "p tagged_division_of (cbox a b)"
     and "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e"
   shows "norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - sum (\<lambda>(x,k). content k *\<^sub>R g x) p) \<le>
          e * content (cbox a b)"
   apply (rule order_trans[OF _ rsum_bound[OF assms]])
   apply (simp add: split_def scaleR_diff_right sum_subtractf eq_refl)
   done
 
 lemma has_integral_bound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B"
       and f: "(f has_integral i) (cbox a b)"
       and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content (cbox a b)"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have "norm i - B * content (cbox a b) > 0"
     by auto
   with f[unfolded has_integral]
   obtain \<gamma> where "gauge \<gamma>" and \<gamma>:
     "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma> fine p\<rbrakk>
           \<Longrightarrow> norm ((\<Sum>(x, K)\<in>p. content K *\<^sub>R f x) - i) < norm i - B * content (cbox a b)"
     by metis
   then obtain p where p: "p tagged_division_of cbox a b" and "\<gamma> fine p"
     using fine_division_exists by blast
   have "\<And>s B. norm s \<le> B \<Longrightarrow> \<not> norm (s - i) < norm i - B"
     unfolding not_less
     by (metis diff_left_mono dist_commute dist_norm norm_triangle_ineq2 order_trans)
   then show False
     using \<gamma> [OF p \<open>\<gamma> fine p\<close>] rsum_bound[OF p] assms by metis
 qed
 
 corollary integrable_bound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B"
       and "f integrable_on (cbox a b)"
       and "\<And>x. x\<in>cbox a b \<Longrightarrow> norm (f x) \<le> B"
     shows "norm (integral (cbox a b) f) \<le> B * content (cbox a b)"
 by (metis integrable_integral has_integral_bound assms)
 
 
 subsection \<open>Similar theorems about relationship among components\<close>
 
 lemma rsum_component_le:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes p: "p tagged_division_of (cbox a b)"
       and "\<And>x. x \<in> cbox a b \<Longrightarrow> (f x)\<bullet>i \<le> (g x)\<bullet>i"
     shows "(\<Sum>(x, K)\<in>p. content K *\<^sub>R f x) \<bullet> i \<le> (\<Sum>(x, K)\<in>p. content K *\<^sub>R g x) \<bullet> i"
 unfolding inner_sum_left
 proof (rule sum_mono, clarify)
   fix x K
   assume ab: "(x, K) \<in> p"
   with p obtain u v where K: "K = cbox u v"
     by blast
   then show "(content K *\<^sub>R f x) \<bullet> i \<le> (content K *\<^sub>R g x) \<bullet> i"
     by (metis ab assms inner_scaleR_left measure_nonneg mult_left_mono tag_in_interval)
 qed
 
 lemma has_integral_component_le:
   fixes f g :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes k: "k \<in> Basis"
   assumes "(f has_integral i) S" "(g has_integral j) S"
     and f_le_g: "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> (g x)\<bullet>k"
   shows "i\<bullet>k \<le> j\<bullet>k"
 proof -
   have ik_le_jk: "i\<bullet>k \<le> j\<bullet>k"
     if f_i: "(f has_integral i) (cbox a b)"
     and g_j: "(g has_integral j) (cbox a b)"
     and le: "\<forall>x\<in>cbox a b. (f x)\<bullet>k \<le> (g x)\<bullet>k"
     for a b i and j :: 'b and f g :: "'a \<Rightarrow> 'b"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
       by auto
     obtain \<gamma>1 where "gauge \<gamma>1" 
       and \<gamma>1: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma>1 fine p\<rbrakk>
                 \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < (i \<bullet> k - j \<bullet> k) / 3"
       using f_i[unfolded has_integral,rule_format,OF *] by fastforce 
     obtain \<gamma>2 where "gauge \<gamma>2" 
       and \<gamma>2: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; \<gamma>2 fine p\<rbrakk>
                 \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) < (i \<bullet> k - j \<bullet> k) / 3"
       using g_j[unfolded has_integral,rule_format,OF *] by fastforce 
     obtain p where p: "p tagged_division_of cbox a b" and "\<gamma>1 fine p" "\<gamma>2 fine p"
        using fine_division_exists[OF gauge_Int[OF \<open>gauge \<gamma>1\<close> \<open>gauge \<gamma>2\<close>], of a b] unfolding fine_Int
        by metis
     then have "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
          "\<bar>((\<Sum>(x, k)\<in>p. content k *\<^sub>R g x) - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
       using le_less_trans[OF Basis_le_norm[OF k]] k \<gamma>1 \<gamma>2 by metis+ 
     then show False
       unfolding inner_simps
       using rsum_component_le[OF p] le
       by (fastforce simp add: abs_real_def split: if_split_asm)
   qed
   show ?thesis
   proof (cases "\<exists>a b. S = cbox a b")
     case True
     with ik_le_jk assms show ?thesis
       by auto
   next
     case False
     show ?thesis
     proof (rule ccontr)
       assume "\<not> i\<bullet>k \<le> j\<bullet>k"
       then have ij: "(i\<bullet>k - j\<bullet>k) / 3 > 0"
         by auto
       obtain B1 where "0 < B1" 
            and B1: "\<And>a b. ball 0 B1 \<subseteq> cbox a b \<Longrightarrow>
                     \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b) \<and>
                         norm (z - i) < (i \<bullet> k - j \<bullet> k) / 3"
         using has_integral_altD[OF _ False ij] assms by blast
       obtain B2 where "0 < B2" 
            and B2: "\<And>a b. ball 0 B2 \<subseteq> cbox a b \<Longrightarrow>
                     \<exists>z. ((\<lambda>x. if x \<in> S then g x else 0) has_integral z) (cbox a b) \<and>
                         norm (z - j) < (i \<bullet> k - j \<bullet> k) / 3"
         using has_integral_altD[OF _ False ij] assms by blast
       have "bounded (ball 0 B1 \<union> ball (0::'a) B2)"
         unfolding bounded_Un by(rule conjI bounded_ball)+
       from bounded_subset_cbox_symmetric[OF this] 
       obtain a b::'a where ab: "ball 0 B1 \<subseteq> cbox a b" "ball 0 B2 \<subseteq> cbox a b"
         by (meson Un_subset_iff)
       then obtain w1 w2 where int_w1: "((\<lambda>x. if x \<in> S then f x else 0) has_integral w1) (cbox a b)"
                         and norm_w1:  "norm (w1 - i) < (i \<bullet> k - j \<bullet> k) / 3"
                         and int_w2: "((\<lambda>x. if x \<in> S then g x else 0) has_integral w2) (cbox a b)"
                         and norm_w2: "norm (w2 - j) < (i \<bullet> k - j \<bullet> k) / 3"
         using B1 B2 by blast
       have *: "\<And>w1 w2 j i::real .\<bar>w1 - i\<bar> < (i - j) / 3 \<Longrightarrow> \<bar>w2 - j\<bar> < (i - j) / 3 \<Longrightarrow> w1 \<le> w2 \<Longrightarrow> False"
         by (simp add: abs_real_def split: if_split_asm)
       have "\<bar>(w1 - i) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
            "\<bar>(w2 - j) \<bullet> k\<bar> < (i \<bullet> k - j \<bullet> k) / 3"
         using Basis_le_norm k le_less_trans norm_w1 norm_w2 by blast+
       moreover
       have "w1\<bullet>k \<le> w2\<bullet>k"
         using ik_le_jk int_w1 int_w2 f_le_g by auto
       ultimately show False
         unfolding inner_simps by(rule *)
     qed
   qed
 qed
 
 lemma integral_component_le:
   fixes g f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "f integrable_on S" "g integrable_on S"
     and "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> (g x)\<bullet>k"
   shows "(integral S f)\<bullet>k \<le> (integral S g)\<bullet>k"
   apply (rule has_integral_component_le)
   using integrable_integral assms
   apply auto
   done
 
 lemma has_integral_component_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "(f has_integral i) S"
     and "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> (f x)\<bullet>k"
   shows "0 \<le> i\<bullet>k"
   using has_integral_component_le[OF assms(1) has_integral_0 assms(2)]
   using assms(3-)
   by auto
 
 lemma integral_component_nonneg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and  "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> (f x)\<bullet>k"
   shows "0 \<le> (integral S f)\<bullet>k"
 proof (cases "f integrable_on S")
   case True show ?thesis
     apply (rule has_integral_component_nonneg)
     using assms True
     apply auto
     done
 next
   case False then show ?thesis by (simp add: not_integrable_integral)
 qed
 
 lemma has_integral_component_neg:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "k \<in> Basis"
     and "(f has_integral i) S"
     and "\<And>x. x \<in> S \<Longrightarrow> (f x)\<bullet>k \<le> 0"
   shows "i\<bullet>k \<le> 0"
   using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-)
   by auto
 
 lemma has_integral_component_lbound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content (cbox a b) \<le> i\<bullet>k"
   using has_integral_component_le[OF assms(3) has_integral_const assms(1),of "(\<Sum>i\<in>Basis. B *\<^sub>R i)::'b"] assms(2-)
   by (auto simp add: field_simps)
 
 lemma has_integral_component_ubound:
   fixes f::"'a::euclidean_space => 'b::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "i\<bullet>k \<le> B * content (cbox a b)"
   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"] assms(2-)
   by (auto simp add: field_simps)
 
 lemma integral_component_lbound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "f integrable_on cbox a b"
     and "\<forall>x\<in>cbox a b. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content (cbox a b) \<le> (integral(cbox a b) f)\<bullet>k"
   apply (rule has_integral_component_lbound)
   using assms
   unfolding has_integral_integral
   apply auto
   done
 
 lemma integral_component_lbound_real:
   assumes "f integrable_on {a ::real..b}"
     and "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k"
     and "k \<in> Basis"
   shows "B * content {a..b} \<le> (integral {a..b} f)\<bullet>k"
   using assms
   by (metis box_real(2) integral_component_lbound)
 
 lemma integral_component_ubound:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "f integrable_on cbox a b"
     and "\<forall>x\<in>cbox a b. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "(integral (cbox a b) f)\<bullet>k \<le> B * content (cbox a b)"
   apply (rule has_integral_component_ubound)
   using assms
   unfolding has_integral_integral
   apply auto
   done
 
 lemma integral_component_ubound_real:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "f integrable_on {a..b}"
     and "\<forall>x\<in>{a..b}. f x\<bullet>k \<le> B"
     and "k \<in> Basis"
   shows "(integral {a..b} f)\<bullet>k \<le> B * content {a..b}"
   using assms
   by (metis box_real(2) integral_component_ubound)
 
 subsection \<open>Uniform limit of integrable functions is integrable\<close>
 
 lemma real_arch_invD:
   "0 < (e::real) \<Longrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
   by (subst(asm) real_arch_inverse)
 
 
 lemma integrable_uniform_limit:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "\<And>e. e > 0 \<Longrightarrow> \<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
   shows "f integrable_on cbox a b"
 proof (cases "content (cbox a b) > 0")
   case False then show ?thesis
     using has_integral_null by (simp add: content_lt_nz integrable_on_def)
 next
   case True
   have "1 / (real n + 1) > 0" for n
     by auto
   then have "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> 1 / (real n + 1)) \<and> g integrable_on cbox a b" for n
     using assms by blast
   then obtain g where g_near_f: "\<And>n x. x \<in> cbox a b \<Longrightarrow> norm (f x - g n x) \<le> 1 / (real n + 1)"
                   and int_g: "\<And>n. g n integrable_on cbox a b"
     by metis
   then obtain h where h: "\<And>n. (g n has_integral h n) (cbox a b)"
     unfolding integrable_on_def by metis
   have "Cauchy h"
     unfolding Cauchy_def
   proof clarify
     fix e :: real
     assume "e>0"
     then have "e/4 / content (cbox a b) > 0"
       using True by (auto simp: field_simps)
     then obtain M where "M \<noteq> 0" and M: "1 / (real M) < e/4 / content (cbox a b)"
       by (metis inverse_eq_divide real_arch_inverse)
     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (h m) (h n) < e"
     proof (rule exI [where x=M], clarify)
       fix m n
       assume m: "M \<le> m" and n: "M \<le> n"
       have "e/4>0" using \<open>e>0\<close> by auto
       then obtain gm gn where "gauge gm" "gauge gn"
               and gm: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> gm fine \<D> 
                             \<Longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x) - h m) < e/4"
               and gn: "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> gn fine \<D> \<Longrightarrow>
                       norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - h n) < e/4"
         using h[unfolded has_integral] by meson
       then obtain \<D> where \<D>: "\<D> tagged_division_of cbox a b" "(\<lambda>x. gm x \<inter> gn x) fine \<D>"
         by (metis (full_types) fine_division_exists gauge_Int)
       have triangle3: "norm (i1 - i2) < e"
         if no: "norm(s2 - s1) \<le> e/2" "norm (s1 - i1) < e/4" "norm (s2 - i2) < e/4" for s1 s2 i1 and i2::'b
       proof -
         have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"]
           by (auto simp: algebra_simps)
         also have "\<dots> < e"
           using no by (auto simp: algebra_simps norm_minus_commute)
         finally show ?thesis .
       qed
       have finep: "gm fine \<D>" "gn fine \<D>"
         using fine_Int \<D>  by auto
       have norm_le: "norm (g n x - g m x) \<le> 2 / real M" if x: "x \<in> cbox a b" for x
       proof -
         have "norm (f x - g n x) + norm (f x - g m x) \<le> 1 / (real n + 1) + 1 / (real m + 1)"          
           using g_near_f[OF x, of n] g_near_f[OF x, of m] by simp
         also have "\<dots> \<le> 1 / (real M) + 1 / (real M)"
           apply (rule add_mono)
           using \<open>M \<noteq> 0\<close> m n by (auto simp: field_split_simps)
         also have "\<dots> = 2 / real M"
           by auto
         finally show "norm (g n x - g m x) \<le> 2 / real M"
           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
           by (auto simp: algebra_simps simp add: norm_minus_commute)
       qed
       have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x)) \<le> 2 / real M * content (cbox a b)"
         by (blast intro: norm_le rsum_diff_bound[OF \<D>(1), where e="2 / real M"])
       also have "... \<le> e/2"
         using M True
         by (auto simp: field_simps)
       finally have le_e2: "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g n x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g m x)) \<le> e/2" .
       then show "dist (h m) (h n) < e"
         unfolding dist_norm using gm gn \<D> finep by (auto intro!: triangle3)
     qed
   qed
   then obtain s where s: "h \<longlonglongrightarrow> s"
     using convergent_eq_Cauchy[symmetric] by blast
   show ?thesis
     unfolding integrable_on_def has_integral
   proof (rule_tac x=s in exI, clarify)
     fix e::real
     assume e: "0 < e"
     then have "e/3 > 0" by auto
     then obtain N1 where N1: "\<forall>n\<ge>N1. norm (h n - s) < e/3"
       using LIMSEQ_D [OF s] by metis
     from e True have "e/3 / content (cbox a b) > 0"
       by (auto simp: field_simps)
     then obtain N2 :: nat
          where "N2 \<noteq> 0" and N2: "1 / (real N2) < e/3 / content (cbox a b)"
       by (metis inverse_eq_divide real_arch_inverse)
     obtain g' where "gauge g'"
             and g': "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> g' fine \<D> \<Longrightarrow>
                     norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x) - h (N1 + N2)) < e/3"
       by (metis h has_integral \<open>e/3 > 0\<close>)
     have *: "norm (sf - s) < e" 
         if no: "norm (sf - sg) \<le> e/3" "norm(h - s) < e/3" "norm (sg - h) < e/3" for sf sg h
     proof -
       have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - h) + norm (h - s)"
         using norm_triangle_ineq[of "sf - sg" "sg - s"]
         using norm_triangle_ineq[of "sg -  h" " h - s"]
         by (auto simp: algebra_simps)
       also have "\<dots> < e"
         using no by (auto simp: algebra_simps norm_minus_commute)
       finally show ?thesis .
     qed
     { fix \<D>
       assume ptag: "\<D> tagged_division_of (cbox a b)" and "g' fine \<D>"
       then have norm_less: "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x) - h (N1 + N2)) < e/3"
         using g' by blast
       have "content (cbox a b) < e/3 * (of_nat N2)"
         using \<open>N2 \<noteq> 0\<close> N2 using True by (auto simp: field_split_simps)
       moreover have "e/3 * of_nat N2 \<le> e/3 * (of_nat (N1 + N2) + 1)"
         using \<open>e>0\<close> by auto
       ultimately have "content (cbox a b) < e/3 * (of_nat (N1 + N2) + 1)"
         by linarith
       then have le_e3: "1 / (real (N1 + N2) + 1) * content (cbox a b) \<le> e/3"
         unfolding inverse_eq_divide
         by (auto simp: field_simps)
       have ne3: "norm (h (N1 + N2) - s) < e/3"
         using N1 by auto
       have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R g (N1 + N2) x))
             \<le> 1 / (real (N1 + N2) + 1) * content (cbox a b)"
         by (blast intro: g_near_f rsum_diff_bound[OF ptag])
       then have "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - s) < e"
         by (rule *[OF order_trans [OF _ le_e3] ne3 norm_less])
     }
     then show "\<exists>d. gauge d \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> d fine \<D> \<longrightarrow> norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - s) < e)"
       by (blast intro: g' \<open>gauge g'\<close>)
   qed
 qed
 
 lemmas integrable_uniform_limit_real = integrable_uniform_limit [where 'a=real, simplified]
 
 
 subsection \<open>Negligible sets\<close>
 
 definition "negligible (s:: 'a::euclidean_space set) \<longleftrightarrow>
   (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) (cbox a b))"
 
 
 subsubsection \<open>Negligibility of hyperplane\<close>
 
 lemma content_doublesplit:
   fixes a :: "'a::euclidean_space"
   assumes "0 < e"
     and k: "k \<in> Basis"
   obtains d where "0 < d" and "content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) < e"
 proof cases
   assume *: "a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j)"
   define a' where "a' d = (\<Sum>j\<in>Basis. (if j = k then max (a\<bullet>j) (c - d) else a\<bullet>j) *\<^sub>R j)" for d
   define b' where "b' d = (\<Sum>j\<in>Basis. (if j = k then min (b\<bullet>j) (c + d) else b\<bullet>j) *\<^sub>R j)" for d
 
   have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> (\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j)) (at_right 0)"
     by (auto simp: b'_def a'_def intro!: tendsto_min tendsto_max tendsto_eq_intros)
   also have "(\<Prod>j\<in>Basis. (b' 0 - a' 0) \<bullet> j) = 0"
     using k *
     by (intro prod_zero bexI[OF _ k])
        (auto simp: b'_def a'_def inner_diff inner_sum_left inner_not_same_Basis intro!: sum.cong)
   also have "((\<lambda>d. \<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) \<longlongrightarrow> 0) (at_right 0) =
     ((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)"
   proof (intro tendsto_cong eventually_at_rightI)
     fix d :: real assume d: "d \<in> {0<..<1}"
     have "cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d} = cbox (a' d) (b' d)" for d
       using * d k by (auto simp add: cbox_def set_eq_iff Int_def ball_conj_distrib abs_diff_le_iff a'_def b'_def)
     moreover have "j \<in> Basis \<Longrightarrow> a' d \<bullet> j \<le> b' d \<bullet> j" for j
       using * d k by (auto simp: a'_def b'_def)
     ultimately show "(\<Prod>j\<in>Basis. (b' d - a' d) \<bullet> j) = content (cbox a b \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d})"
       by simp
   qed simp
   finally have "((\<lambda>d. content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<longlongrightarrow> 0) (at_right 0)" .
   from order_tendstoD(2)[OF this \<open>0<e\<close>]
   obtain d' where "0 < d'" and d': "\<And>y. y > 0 \<Longrightarrow> y < d' \<Longrightarrow> content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> y}) < e"
     by (subst (asm) eventually_at_right[of _ 1]) auto
   show ?thesis
     by (rule that[of "d'/2"], insert \<open>0<d'\<close> d'[of "d'/2"], auto)
 next
   assume *: "\<not> (a \<bullet> k \<le> c \<and> c \<le> b \<bullet> k \<and> (\<forall>j\<in>Basis. a \<bullet> j \<le> b \<bullet> j))"
   then have "(\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j) \<or> (c < a \<bullet> k \<or> b \<bullet> k < c)"
     by (auto simp: not_le)
   show thesis
   proof cases
     assume "\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j"
     then have [simp]: "cbox a b = {}"
       using box_ne_empty(1)[of a b] by auto
     show ?thesis
       by (rule that[of 1]) (simp_all add: \<open>0<e\<close>)
   next
     assume "\<not> (\<exists>j\<in>Basis. b \<bullet> j < a \<bullet> j)"
     with * have "c < a \<bullet> k \<or> b \<bullet> k < c"
       by auto
     then show thesis
     proof
       assume c: "c < a \<bullet> k"
       moreover have "x \<in> cbox a b \<Longrightarrow> c \<le> x \<bullet> k" for x
         using k c by (auto simp: cbox_def)
       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (a \<bullet> k - c)/2} = {}"
         using k by (auto simp: cbox_def)
       with \<open>0<e\<close> c that[of "(a \<bullet> k - c)/2"] show ?thesis
         by auto
     next
       assume c: "b \<bullet> k < c"
       moreover have "x \<in> cbox a b \<Longrightarrow> x \<bullet> k \<le> c" for x
         using k c by (auto simp: cbox_def)
       ultimately have "cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> (c - b \<bullet> k)/2} = {}"
         using k by (auto simp: cbox_def)
       with \<open>0<e\<close> c that[of "(c - b \<bullet> k)/2"] show ?thesis
         by auto
     qed
   qed
 qed
 
 
 proposition negligible_standard_hyperplane[intro]:
   fixes k :: "'a::euclidean_space"
   assumes k: "k \<in> Basis"
   shows "negligible {x. x\<bullet>k = c}"
   unfolding negligible_def has_integral
 proof clarsimp
   fix a b and e::real assume "e > 0"
   with k obtain d where "0 < d" and d: "content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) < e"
     by (metis content_doublesplit)
   let ?i = "indicator {x::'a. x\<bullet>k = c} :: 'a\<Rightarrow>real"
   show "\<exists>\<gamma>. gauge \<gamma> \<and>
            (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                  \<bar>\<Sum>(x,K) \<in> \<D>. content K * ?i x\<bar> < e)"
   proof (intro exI, safe)
     show "gauge (\<lambda>x. ball x d)"
       using \<open>0 < d\<close> by blast
   next
     fix \<D>
     assume p: "\<D> tagged_division_of (cbox a b)" "(\<lambda>x. ball x d) fine \<D>"
     have "content L = content (L \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})" 
       if "(x, L) \<in> \<D>" "?i x \<noteq> 0" for x L
     proof -
       have xk: "x\<bullet>k = c"
         using that by (simp add: indicator_def split: if_split_asm)
       have "L \<subseteq> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
       proof 
         fix y
         assume y: "y \<in> L"
         have "L \<subseteq> ball x d"
           using p(2) that(1) by auto
         then have "norm (x - y) < d"
           by (simp add: dist_norm subset_iff y)
         then have "\<bar>(x - y) \<bullet> k\<bar> < d"
           using k norm_bound_Basis_lt by blast
         then show "y \<in> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
           unfolding inner_simps xk by auto
       qed 
       then show "content L = content (L \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
         by (metis inf.orderE)
     qed
     then have *: "(\<Sum>(x,K)\<in>\<D>. content K * ?i x) = (\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x\<bullet>k - c\<bar> \<le> d}) *\<^sub>R ?i x)"
       by (force simp add: split_paired_all intro!: sum.cong [OF refl])
     note p'= tagged_division_ofD[OF p(1)] and p''=division_of_tagged_division[OF p(1)]
     have "(\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * indicator {x. x \<bullet> k = c} x) < e"
     proof -
       have "(\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) \<le> (\<Sum>(x,K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}))"
         by (force simp add: indicator_def intro!: sum_mono)
       also have "\<dots> < e"
       proof (subst sum.over_tagged_division_lemma[OF p(1)])
         fix u v::'a
         assume "box u v = {}"
         then have *: "content (cbox u v) = 0"
           unfolding content_eq_0_interior by simp
         have "cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<subseteq> cbox u v"
           by auto
         then have "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<le> content (cbox u v)"
           unfolding interval_doublesplit[OF k] by (rule content_subset)
         then show "content (cbox u v \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
           unfolding * interval_doublesplit[OF k]
           by (blast intro: antisym)
       next
         have "(\<Sum>l\<in>snd ` \<D>. content (l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) =
           sum content ((\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}})"
         proof (subst (2) sum.reindex_nontrivial)
           fix x y assume "x \<in> {l \<in> snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}" "y \<in> {l \<in> snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}"
             "x \<noteq> y" and eq: "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} = y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}"
           then obtain x' y' where "(x', x) \<in> \<D>" "x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}" "(y', y) \<in> \<D>" "y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}"
             by (auto)
           from p'(5)[OF \<open>(x', x) \<in> \<D>\<close> \<open>(y', y) \<in> \<D>\<close>] \<open>x \<noteq> y\<close> have "interior (x \<inter> y) = {}"
             by auto
           moreover have "interior ((x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) \<inter> (y \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) \<subseteq> interior (x \<inter> y)"
             by (auto intro: interior_mono)
           ultimately have "interior (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = {}"
             by (auto simp: eq)
           then show "content (x \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) = 0"
             using p'(4)[OF \<open>(x', x) \<in> \<D>\<close>] by (auto simp: interval_doublesplit[OF k] content_eq_0_interior simp del: interior_Int)
         qed (insert p'(1), auto intro!: sum.mono_neutral_right)
         also have "\<dots> \<le> norm (\<Sum>l\<in>(\<lambda>l. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})`{l\<in>snd ` \<D>. l \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d} \<noteq> {}}. content l *\<^sub>R 1::real)"
           by simp
         also have "\<dots> \<le> 1 * content (cbox a b \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})"
           using division_doublesplit[OF p'' k, unfolded interval_doublesplit[OF k]]
           unfolding interval_doublesplit[OF k] by (intro dsum_bound) auto
         also have "\<dots> < e"
           using d by simp
         finally show "(\<Sum>K\<in>snd ` \<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d})) < e" .
       qed
       finally show "(\<Sum>(x, K)\<in>\<D>. content (K \<inter> {x. \<bar>x \<bullet> k - c\<bar> \<le> d}) * ?i x) < e" .
     qed
     then show "\<bar>\<Sum>(x, K)\<in>\<D>. content K * ?i x\<bar> < e"
       unfolding * 
       apply (subst abs_of_nonneg)
       using measure_nonneg       
       by (force simp add: indicator_def intro: sum_nonneg)+
   qed
 qed
 
 corollary negligible_standard_hyperplane_cart:
   fixes k :: "'a::finite"
   shows "negligible {x. x$k = (0::real)}"
   by (simp add: cart_eq_inner_axis negligible_standard_hyperplane)
 
 
 subsubsection \<open>Hence the main theorem about negligible sets\<close>
 
 
 lemma has_integral_negligible_cbox:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes negs: "negligible S"
     and 0: "\<And>x. x \<notin> S \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) (cbox a b)"
   unfolding has_integral
 proof clarify
   fix e::real
   assume "e > 0"
   then have nn_gt0: "e/2 / ((real n+1) * (2 ^ n)) > 0" for n
     by simp
   then have "\<exists>\<gamma>. gauge \<gamma> \<and>
                    (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                         \<bar>\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R indicator S x\<bar>
                         < e/2 / ((real n + 1) * 2 ^ n))" for n
     using negs [unfolded negligible_def has_integral] by auto
   then obtain \<gamma> where 
     gd: "\<And>n. gauge (\<gamma> n)"
     and \<gamma>: "\<And>n \<D>. \<lbrakk>\<D> tagged_division_of cbox a b; \<gamma> n fine \<D>\<rbrakk>
                   \<Longrightarrow> \<bar>\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R indicator S x\<bar> < e/2 / ((real n + 1) * 2 ^ n)"
     by metis
   show "\<exists>\<gamma>. gauge \<gamma> \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> \<longrightarrow>
                   norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - 0) < e)"
   proof (intro exI, safe)
     show "gauge (\<lambda>x. \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x)"
       using gd by (auto simp: gauge_def)
 
     show "norm ((\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) - 0) < e"
       if "\<D> tagged_division_of (cbox a b)" "(\<lambda>x. \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x) fine \<D>" for \<D>
     proof (cases "\<D> = {}")
       case True with \<open>0 < e\<close> show ?thesis by simp
     next
       case False
       obtain N where "Max ((\<lambda>(x, K). norm (f x)) ` \<D>) \<le> real N"
         using real_arch_simple by blast
       then have N: "\<And>x. x \<in> (\<lambda>(x, K). norm (f x)) ` \<D> \<Longrightarrow> x \<le> real N"
         by (meson Max_ge that(1) dual_order.trans finite_imageI tagged_division_of_finite)
       have "\<forall>i. \<exists>q. q tagged_division_of (cbox a b) \<and> (\<gamma> i) fine q \<and> (\<forall>(x,K) \<in> \<D>. K \<subseteq> (\<gamma> i) x \<longrightarrow> (x, K) \<in> q)"
         by (auto intro: tagged_division_finer[OF that(1) gd])
       from choice[OF this] 
       obtain q where q: "\<And>n. q n tagged_division_of cbox a b"
                         "\<And>n. \<gamma> n fine q n"
                         "\<And>n x K. \<lbrakk>(x, K) \<in> \<D>; K \<subseteq> \<gamma> n x\<rbrakk> \<Longrightarrow> (x, K) \<in> q n"
         by fastforce
       have "finite \<D>"
         using that(1) by blast
       then have sum_le_inc: "\<lbrakk>finite T; \<And>x y. (x,y) \<in> T \<Longrightarrow> (0::real) \<le> g(x,y);
                       \<And>y. y\<in>\<D> \<Longrightarrow> \<exists>x. (x,y) \<in> T \<and> f(y) \<le> g(x,y)\<rbrakk> \<Longrightarrow> sum f \<D> \<le> sum g T" for f g T
         by (rule sum_le_included[of \<D> T g snd f]; force)
       have "norm (\<Sum>(x,K) \<in> \<D>. content K *\<^sub>R f x) \<le> (\<Sum>(x,K) \<in> \<D>. norm (content K *\<^sub>R f x))"
         unfolding split_def by (rule norm_sum)
       also have "... \<le> (\<Sum>(i, j) \<in> Sigma {..N + 1} q.
                           (real i + 1) * (case j of (x, K) \<Rightarrow> content K *\<^sub>R indicator S x))"
       proof (rule sum_le_inc, safe)
         show "finite (Sigma {..N+1} q)"
           by (meson finite_SigmaI finite_atMost tagged_division_of_finite q(1)) 
       next
         fix x K
         assume xk: "(x, K) \<in> \<D>"
         define n where "n = nat \<lfloor>norm (f x)\<rfloor>"
         have *: "norm (f x) \<in> (\<lambda>(x, K). norm (f x)) ` \<D>"
           using xk by auto
         have nfx: "real n \<le> norm (f x)" "norm (f x) \<le> real n + 1"
           unfolding n_def by auto
         then have "n \<in> {0..N + 1}"
           using N[OF *] by auto
         moreover have "K \<subseteq> \<gamma> (nat \<lfloor>norm (f x)\<rfloor>) x"
           using that(2) xk by auto
         moreover then have "(x, K) \<in> q (nat \<lfloor>norm (f x)\<rfloor>)"
           by (simp add: q(3) xk)
         moreover then have "(x, K) \<in> q n"
           using n_def by blast
         moreover
         have "norm (content K *\<^sub>R f x) \<le> (real n + 1) * (content K * indicator S x)"
         proof (cases "x \<in> S")
           case False
           then show ?thesis by (simp add: 0)
         next
           case True
           have *: "content K \<ge> 0"
             using tagged_division_ofD(4)[OF that(1) xk] by auto
           moreover have "content K * norm (f x) \<le> content K * (real n + 1)"
             by (simp add: mult_left_mono nfx(2))
           ultimately show ?thesis
             using nfx True by (auto simp: field_simps)
         qed
         ultimately show "\<exists>y. (y, x, K) \<in> (Sigma {..N + 1} q) \<and> norm (content K *\<^sub>R f x) \<le>
           (real y + 1) * (content K *\<^sub>R indicator S x)"
           by force
       qed auto
       also have "... = (\<Sum>i\<le>N + 1. \<Sum>j\<in>q i. (real i + 1) * (case j of (x, K) \<Rightarrow> content K *\<^sub>R indicator S x))"
         apply (rule sum_Sigma_product [symmetric])
         using q(1) apply auto
         done
       also have "... \<le> (\<Sum>i\<le>N + 1. (real i + 1) * \<bar>\<Sum>(x,K) \<in> q i. content K *\<^sub>R indicator S x\<bar>)"
         by (rule sum_mono) (simp add: sum_distrib_left [symmetric])
       also have "... \<le> (\<Sum>i\<le>N + 1. e/2/2 ^ i)"
       proof (rule sum_mono)
         show "(real i + 1) * \<bar>\<Sum>(x,K) \<in> q i. content K *\<^sub>R indicator S x\<bar> \<le> e/2/2 ^ i"
           if "i \<in> {..N + 1}" for i
           using \<gamma>[of "q i" i] q by (simp add: divide_simps mult.left_commute)
       qed
       also have "... = e/2 * (\<Sum>i\<le>N + 1. (1/2) ^ i)"
         unfolding sum_distrib_left by (metis divide_inverse inverse_eq_divide power_one_over)
       also have "\<dots> < e/2 * 2"
       proof (rule mult_strict_left_mono)
         have "sum (power (1/2)) {..N + 1} = sum (power (1/2::real)) {..<N + 2}"
           using lessThan_Suc_atMost by auto
         also have "... < 2"
           by (auto simp: geometric_sum)
         finally show "sum (power (1/2::real)) {..N + 1} < 2" .
       qed (use \<open>0 < e\<close> in auto)
       finally  show ?thesis by auto
     qed
   qed
 qed
 
 
 proposition has_integral_negligible:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes negs: "negligible S"
     and "\<And>x. x \<in> (T - S) \<Longrightarrow> f x = 0"
   shows "(f has_integral 0) T"
 proof (cases "\<exists>a b. T = cbox a b")
   case True
   then have "((\<lambda>x. if x \<in> T then f x else 0) has_integral 0) T"
     using assms by (auto intro!: has_integral_negligible_cbox)
   then show ?thesis
     by (rule has_integral_eq [rotated]) auto
 next
   case False
   let ?f = "(\<lambda>x. if x \<in> T then f x else 0)"
   have "((\<lambda>x. if x \<in> T then f x else 0) has_integral 0) T"
     apply (auto simp: False has_integral_alt [of ?f])
     apply (rule_tac x=1 in exI, auto)
     apply (rule_tac x=0 in exI, simp add: has_integral_negligible_cbox [OF negs] assms)
     done
   then show ?thesis
     by (rule_tac f="?f" in has_integral_eq) auto
 qed
 
 lemma
   assumes "negligible S"
   shows integrable_negligible: "f integrable_on S" and integral_negligible: "integral S f = 0"
   using has_integral_negligible [OF assms]
   by (auto simp: has_integral_iff)
 
 lemma has_integral_spike:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   assumes "negligible S"
     and gf: "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and fint: "(f has_integral y) T"
   shows "(g has_integral y) T"
 proof -
   have *: "(g has_integral y) (cbox a b)"
        if "(f has_integral y) (cbox a b)" "\<forall>x \<in> cbox a b - S. g x = f x" for a b f and g:: "'b \<Rightarrow> 'a" and y
   proof -
     have "((\<lambda>x. f x + (g x - f x)) has_integral (y + 0)) (cbox a b)"
       using that by (intro has_integral_add has_integral_negligible) (auto intro!: \<open>negligible S\<close>)
     then show ?thesis
       by auto
   qed
   show ?thesis
     using fint gf
     apply (subst has_integral_alt)
     apply (subst (asm) has_integral_alt)
     apply (simp split: if_split_asm)
      apply (blast dest: *)
       apply (erule_tac V = "\<forall>a b. T \<noteq> cbox a b" in thin_rl)
     apply (elim all_forward imp_forward ex_forward all_forward conj_forward asm_rl)
      apply (auto dest!: *[where f="\<lambda>x. if x\<in>T then f x else 0" and g="\<lambda>x. if x \<in> T then g x else 0"])
     done
 qed
 
 lemma has_integral_spike_eq:
   assumes "negligible S"
     and gf: "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "(f has_integral y) T \<longleftrightarrow> (g has_integral y) T"
     using has_integral_spike [OF \<open>negligible S\<close>] gf
     by metis
 
 lemma integrable_spike:
   assumes "f integrable_on T" "negligible S" "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     shows "g integrable_on T"
   using assms unfolding integrable_on_def by (blast intro: has_integral_spike)
 
 lemma integral_spike:
   assumes "negligible S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "integral T f = integral T g"
   using has_integral_spike_eq[OF assms]
     by (auto simp: integral_def integrable_on_def)
 
 
 subsection \<open>Some other trivialities about negligible sets\<close>
 
 lemma negligible_subset:
   assumes "negligible s" "t \<subseteq> s"
   shows "negligible t"
   unfolding negligible_def
     by (metis (no_types) Diff_iff assms contra_subsetD has_integral_negligible indicator_simps(2))
 
 lemma negligible_diff[intro?]:
   assumes "negligible s"
   shows "negligible (s - t)"
   using assms by (meson Diff_subset negligible_subset)
 
 lemma negligible_Int:
   assumes "negligible s \<or> negligible t"
   shows "negligible (s \<inter> t)"
   using assms negligible_subset by force
 
 lemma negligible_Un:
   assumes "negligible S" and T: "negligible T"
   shows "negligible (S \<union> T)"
 proof -
   have "(indicat_real (S \<union> T) has_integral 0) (cbox a b)"
     if S0: "(indicat_real S has_integral 0) (cbox a b)" 
       and  "(indicat_real T has_integral 0) (cbox a b)" for a b
   proof (subst has_integral_spike_eq[OF T])
     show "indicat_real S x = indicat_real (S \<union> T) x" if "x \<in> cbox a b - T" for x
       by (metis Diff_iff Un_iff indicator_def that)
     show "(indicat_real S has_integral 0) (cbox a b)"
       by (simp add: S0)
   qed
   with assms show ?thesis
     unfolding negligible_def by blast
 qed
 
 lemma negligible_Un_eq[simp]: "negligible (s \<union> t) \<longleftrightarrow> negligible s \<and> negligible t"
   using negligible_Un negligible_subset by blast
 
 lemma negligible_sing[intro]: "negligible {a::'a::euclidean_space}"
   using negligible_standard_hyperplane[OF SOME_Basis, of "a \<bullet> (SOME i. i \<in> Basis)"] negligible_subset by blast
 
 lemma negligible_insert[simp]: "negligible (insert a s) \<longleftrightarrow> negligible s"
   apply (subst insert_is_Un)
   unfolding negligible_Un_eq
   apply auto
   done
 
 lemma negligible_empty[iff]: "negligible {}"
   using negligible_insert by blast
 
 text\<open>Useful in this form for backchaining\<close>
 lemma empty_imp_negligible: "S = {} \<Longrightarrow> negligible S"
   by simp
 
 lemma negligible_finite[intro]:
   assumes "finite s"
   shows "negligible s"
   using assms by (induct s) auto
 
 lemma negligible_Union[intro]:
   assumes "finite \<T>"
     and "\<And>t. t \<in> \<T> \<Longrightarrow> negligible t"
   shows "negligible(\<Union>\<T>)"
   using assms by induct auto
 
 lemma negligible: "negligible S \<longleftrightarrow> (\<forall>T. (indicat_real S has_integral 0) T)"
 proof (intro iffI allI)
   fix T
   assume "negligible S"
   then show "(indicator S has_integral 0) T"
     by (meson Diff_iff has_integral_negligible indicator_simps(2))
 qed (simp add: negligible_def)
 
 subsection \<open>Finite case of the spike theorem is quite commonly needed\<close>
 
 lemma has_integral_spike_finite:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and "(f has_integral y) T"
   shows "(g has_integral y) T"
   using assms has_integral_spike negligible_finite by blast
 
 lemma has_integral_spike_finite_eq:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
   shows "((f has_integral y) T \<longleftrightarrow> (g has_integral y) T)"
   by (metis assms has_integral_spike_finite)
 
 lemma integrable_spike_finite:
   assumes "finite S"
     and "\<And>x. x \<in> T - S \<Longrightarrow> g x = f x"
     and "f integrable_on T"
   shows "g integrable_on T"
   using assms has_integral_spike_finite by blast
 
 lemma has_integral_bound_spike_finite:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B" "finite S"
       and f: "(f has_integral i) (cbox a b)"
       and leB: "\<And>x. x \<in> cbox a b - S \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content (cbox a b)"
 proof -
   define g where "g \<equiv> (\<lambda>x. if x \<in> S then 0 else f x)"
   then have "\<And>x. x \<in> cbox a b - S \<Longrightarrow> norm (g x) \<le> B"
     using leB by simp
   moreover have "(g has_integral i) (cbox a b)"
     using has_integral_spike_finite [OF \<open>finite S\<close> _ f]
     by (simp add: g_def)
   ultimately show ?thesis
     by (simp add: \<open>0 \<le> B\<close> g_def has_integral_bound)
 qed
 
 corollary has_integral_bound_real:
   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
   assumes "0 \<le> B" "finite S"
       and "(f has_integral i) {a..b}"
       and "\<And>x. x \<in> {a..b} - S \<Longrightarrow> norm (f x) \<le> B"
     shows "norm i \<le> B * content {a..b}"
   by (metis assms box_real(2) has_integral_bound_spike_finite)
 
 
 subsection \<open>In particular, the boundary of an interval is negligible\<close>
 
 lemma negligible_frontier_interval: "negligible(cbox (a::'a::euclidean_space) b - box a b)"
 proof -
   let ?A = "\<Union>((\<lambda>k. {x. x\<bullet>k = a\<bullet>k} \<union> {x::'a. x\<bullet>k = b\<bullet>k}) ` Basis)"
   have "negligible ?A"
     by (force simp add: negligible_Union[OF finite_imageI])
   moreover have "cbox a b - box a b \<subseteq> ?A"
     by (force simp add: mem_box)
   ultimately show ?thesis
     by (rule negligible_subset)
 qed
 
 lemma has_integral_spike_interior:
   assumes f: "(f has_integral y) (cbox a b)" and gf: "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
   shows "(g has_integral y) (cbox a b)"
   apply (rule has_integral_spike[OF negligible_frontier_interval _ f])
   using gf by auto
 
 lemma has_integral_spike_interior_eq:
   assumes "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
   shows "(f has_integral y) (cbox a b) \<longleftrightarrow> (g has_integral y) (cbox a b)"
   by (metis assms has_integral_spike_interior)
 
 lemma integrable_spike_interior:
   assumes "\<And>x. x \<in> box a b \<Longrightarrow> g x = f x"
     and "f integrable_on cbox a b"
   shows "g integrable_on cbox a b"
   using assms has_integral_spike_interior_eq by blast
 
 
 subsection \<open>Integrability of continuous functions\<close>
 
 lemma operative_approximableI:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
   shows "operative conj True (\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i)"
 proof -
   interpret comm_monoid conj True
     by standard auto
   show ?thesis
   proof (standard, safe)
     fix a b :: 'b
     show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       if "box a b = {}" for a b
       apply (rule_tac x=f in exI)
       using assms that by (auto simp: content_eq_0_interior)
     {
       fix c g and k :: 'b
       assume fg: "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" and g: "g integrable_on cbox a b"
       assume k: "k \<in> Basis"
       show "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
            "\<exists>g. (\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}"
          apply (rule_tac[!] x=g in exI)
         using fg integrable_split[OF g k] by auto
     }
     show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       if fg1: "\<forall>x\<in>cbox a b \<inter> {x. x \<bullet> k \<le> c}. norm (f x - g1 x) \<le> e" 
         and g1: "g1 integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}"
         and fg2: "\<forall>x\<in>cbox a b \<inter> {x. c \<le> x \<bullet> k}. norm (f x - g2 x) \<le> e" 
         and g2: "g2 integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}" 
         and k: "k \<in> Basis"
       for c k g1 g2
     proof -
       let ?g = "\<lambda>x. if x\<bullet>k = c then f x else if x\<bullet>k \<le> c then g1 x else g2 x"
       show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
       proof (intro exI conjI ballI)
         show "norm (f x - ?g x) \<le> e" if "x \<in> cbox a b" for x
           by (auto simp: that assms fg1 fg2)
         show "?g integrable_on cbox a b"
         proof -
           have "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c}" "?g integrable_on cbox a b \<inter> {x. x \<bullet> k \<ge> c}"
             by(rule integrable_spike[OF _ negligible_standard_hyperplane[of k c]], use k g1 g2 in auto)+
           with has_integral_split[OF _ _ k] show ?thesis
             unfolding integrable_on_def by blast
         qed
       qed
     qed
   qed
 qed
 
 lemma comm_monoid_set_F_and: "comm_monoid_set.F (\<and>) True f s \<longleftrightarrow> (finite s \<longrightarrow> (\<forall>x\<in>s. f x))"
 proof -
   interpret bool: comm_monoid_set "(\<and>)" True
     proof qed auto
   show ?thesis
     by (induction s rule: infinite_finite_induct) auto
 qed
 
 lemma approximable_on_division:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
     and d: "d division_of (cbox a b)"
     and f: "\<forall>i\<in>d. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
   obtains g where "\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e" "g integrable_on cbox a b"
 proof -
   interpret operative conj True "\<lambda>i. \<exists>g. (\<forall>x\<in>i. norm (f x - g (x::'b)) \<le> e) \<and> g integrable_on i"
     using \<open>0 \<le> e\<close> by (rule operative_approximableI)
   from f local.division [OF d] that show thesis
     by auto
 qed
 
 lemma integrable_continuous:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "continuous_on (cbox a b) f"
   shows "f integrable_on cbox a b"
 proof (rule integrable_uniform_limit)
   fix e :: real
   assume e: "e > 0"
   then obtain d where "0 < d" and d: "\<And>x x'. \<lbrakk>x \<in> cbox a b; x' \<in> cbox a b; dist x' x < d\<rbrakk> \<Longrightarrow> dist (f x') (f x) < e"
     using compact_uniformly_continuous[OF assms compact_cbox] unfolding uniformly_continuous_on_def by metis
   obtain p where ptag: "p tagged_division_of cbox a b" and finep: "(\<lambda>x. ball x d) fine p"
     using fine_division_exists[OF gauge_ball[OF \<open>0 < d\<close>], of a b] .
   have *: "\<forall>i\<in>snd ` p. \<exists>g. (\<forall>x\<in>i. norm (f x - g x) \<le> e) \<and> g integrable_on i"
   proof (safe, unfold snd_conv)
     fix x l
     assume as: "(x, l) \<in> p"
     obtain a b where l: "l = cbox a b"
       using as ptag by blast
     then have x: "x \<in> cbox a b"
       using as ptag by auto
     show "\<exists>g. (\<forall>x\<in>l. norm (f x - g x) \<le> e) \<and> g integrable_on l"
       apply (rule_tac x="\<lambda>y. f x" in exI)
     proof safe
       show "(\<lambda>y. f x) integrable_on l"
         unfolding integrable_on_def l by blast
     next
       fix y
       assume y: "y \<in> l"
       then have "y \<in> ball x d"
         using as finep by fastforce
       then show "norm (f y - f x) \<le> e"
         using d x y as l
         by (metis dist_commute dist_norm less_imp_le mem_ball ptag subsetCE tagged_division_ofD(3))
     qed
   qed
   from e have "e \<ge> 0"
     by auto
   from approximable_on_division[OF this division_of_tagged_division[OF ptag] *]
   show "\<exists>g. (\<forall>x\<in>cbox a b. norm (f x - g x) \<le> e) \<and> g integrable_on cbox a b"
     by metis
 qed
 
 lemma integrable_continuous_interval:
   fixes f :: "'b::ordered_euclidean_space \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
   shows "f integrable_on {a..b}"
   by (metis assms integrable_continuous interval_cbox)
 
 lemmas integrable_continuous_real = integrable_continuous_interval[where 'b=real]
 
 lemma integrable_continuous_closed_segment:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on (closed_segment a b) f"
   shows "f integrable_on (closed_segment a b)"
   using assms
   by (auto intro!: integrable_continuous_interval simp: closed_segment_eq_real_ivl)
 
 
 subsection \<open>Specialization of additivity to one dimension\<close>
 
 
 subsection \<open>A useful lemma allowing us to factor out the content size\<close>
 
 lemma has_integral_factor_content:
   "(f has_integral i) (cbox a b) \<longleftrightarrow>
     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
       norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content (cbox a b)))"
 proof (cases "content (cbox a b) = 0")
   case True
   have "\<And>e p. p tagged_division_of cbox a b \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x)) \<le> e * content (cbox a b)"
     unfolding sum_content_null[OF True] True by force
   moreover have "i = 0" 
     if "\<And>e. e > 0 \<Longrightarrow> \<exists>d. gauge d \<and>
               (\<forall>p. p tagged_division_of cbox a b \<and>
                    d fine p \<longrightarrow>
                    norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) \<le> e * content (cbox a b))"
     using that [of 1]
     by (force simp add: True sum_content_null[OF True] intro: fine_division_exists[of _ a b])
   ultimately show ?thesis
     unfolding has_integral_null_eq[OF True]
     by (force simp add: )
 next
   case False
   then have F: "0 < content (cbox a b)"
     using zero_less_measure_iff by blast
   let ?P = "\<lambda>e opp. \<exists>d. gauge d \<and>
     (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow> opp (norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i)) e)"
   show ?thesis
     apply (subst has_integral)
   proof safe
     fix e :: real
     assume e: "e > 0"
     { assume "\<forall>e>0. ?P e (<)"
       then show "?P (e * content (cbox a b)) (\<le>)"
         apply (rule allE [where x="e * content (cbox a b)"])
         apply (elim impE ex_forward conj_forward)
         using F e apply (auto simp add: algebra_simps)
         done }
     { assume "\<forall>e>0. ?P (e * content (cbox a b)) (\<le>)"
       then show "?P e (<)"
         apply (rule allE [where x="e/2 / content (cbox a b)"])
         apply (elim impE ex_forward conj_forward)
         using F e apply (auto simp add: algebra_simps)
         done }
   qed
 qed
 
 lemma has_integral_factor_content_real:
   "(f has_integral i) {a..b::real} \<longleftrightarrow>
     (\<forall>e>0. \<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b}  \<and> d fine p \<longrightarrow>
       norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) p - i) \<le> e * content {a..b} ))"
   unfolding box_real[symmetric]
   by (rule has_integral_factor_content)
 
 
 subsection \<open>Fundamental theorem of calculus\<close>
 
 lemma interval_bounds_real:
   fixes q b :: real
   assumes "a \<le> b"
   shows "Sup {a..b} = b"
     and "Inf {a..b} = a"
   using assms by auto
 
 theorem fundamental_theorem_of_calculus:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> b" 
       and vecd: "\<And>x. x \<in> {a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x within {a..b})"
   shows "(f' has_integral (f b - f a)) {a..b}"
   unfolding has_integral_factor_content box_real[symmetric]
 proof safe
   fix e :: real
   assume "e > 0"
   then have "\<forall>x. \<exists>d>0. x \<in> {a..b} \<longrightarrow>
          (\<forall>y\<in>{a..b}. norm (y-x) < d \<longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e * norm (y-x))"
     using vecd[unfolded has_vector_derivative_def has_derivative_within_alt] by blast
   then obtain d where d: "\<And>x. 0 < d x"
                  "\<And>x y. \<lbrakk>x \<in> {a..b}; y \<in> {a..b}; norm (y-x) < d x\<rbrakk>
                         \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e * norm (y-x)"
     by metis  
   show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of (cbox a b) \<and> d fine p \<longrightarrow>
     norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b))"
   proof (rule exI, safe)
     show "gauge (\<lambda>x. ball x (d x))"
       using d(1) gauge_ball_dependent by blast
   next
     fix p
     assume ptag: "p tagged_division_of cbox a b" and finep: "(\<lambda>x. ball x (d x)) fine p"
     have ba: "b - a = (\<Sum>(x,K)\<in>p. Sup K - Inf K)" "f b - f a = (\<Sum>(x,K)\<in>p. f(Sup K) - f(Inf K))"
       using additive_tagged_division_1[where f= "\<lambda>x. x"] additive_tagged_division_1[where f= f]
             \<open>a \<le> b\<close> ptag by auto
     have "norm (\<Sum>(x, K) \<in> p. (content K *\<^sub>R f' x) - (f (Sup K) - f (Inf K)))
           \<le> (\<Sum>n\<in>p. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))"
     proof (rule sum_norm_le,safe)
       fix x K
       assume "(x, K) \<in> p"
       then have "x \<in> K" and kab: "K \<subseteq> cbox a b"
         using ptag by blast+
       then obtain u v where k: "K = cbox u v" and "x \<in> K" and kab: "K \<subseteq> cbox a b"
         using ptag \<open>(x, K) \<in> p\<close> by auto 
       have "u \<le> v"
         using \<open>x \<in> K\<close> unfolding k by auto
       have ball: "\<forall>y\<in>K. y \<in> ball x (d x)"
         using finep \<open>(x, K) \<in> p\<close> by blast
       have "u \<in> K" "v \<in> K"
         by (simp_all add: \<open>u \<le> v\<close> k)
       have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) = norm (f u - f x - (u - x) *\<^sub>R f' x - (f v - f x - (v - x) *\<^sub>R f' x))"
         by (auto simp add: algebra_simps)
       also have "... \<le> norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)"
         by (rule norm_triangle_ineq4)
       finally have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) \<le>
         norm (f u - f x - (u - x) *\<^sub>R f' x) + norm (f v - f x - (v - x) *\<^sub>R f' x)" .
       also have "\<dots> \<le> e * norm (u - x) + e * norm (v - x)"
       proof (rule add_mono)
         show "norm (f u - f x - (u - x) *\<^sub>R f' x) \<le> e * norm (u - x)"
           apply (rule d(2)[of x u])
           using \<open>x \<in> K\<close> kab \<open>u \<in> K\<close> ball dist_real_def by (auto simp add:dist_real_def)
         show "norm (f v - f x - (v - x) *\<^sub>R f' x) \<le> e * norm (v - x)"
           apply (rule d(2)[of x v])
           using \<open>x \<in> K\<close> kab \<open>v \<in> K\<close> ball dist_real_def by (auto simp add:dist_real_def)
       qed
       also have "\<dots> \<le> e * (Sup K - Inf K)"
         using \<open>x \<in> K\<close> by (auto simp: k interval_bounds_real[OF \<open>u \<le> v\<close>] field_simps)
       finally show "norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (Sup K - Inf K)"
         using \<open>u \<le> v\<close> by (simp add: k)
     qed
     with \<open>a \<le> b\<close> show "norm ((\<Sum>(x, K)\<in>p. content K *\<^sub>R f' x) - (f b - f a)) \<le> e * content (cbox a b)"
       by (auto simp: ba split_def sum_subtractf [symmetric] sum_distrib_left)
   qed
 qed
 
 lemma ident_has_integral:
   fixes a::real
   assumes "a \<le> b"
   shows "((\<lambda>x. x) has_integral (b\<^sup>2 - a\<^sup>2)/2) {a..b}"
 proof -
   have "((\<lambda>x. x) has_integral inverse 2 * b\<^sup>2 - inverse 2 * a\<^sup>2) {a..b}"
     apply (rule fundamental_theorem_of_calculus [OF assms])
     unfolding power2_eq_square
     by (rule derivative_eq_intros | simp)+
   then show ?thesis
     by (simp add: field_simps)
 qed
 
 lemma integral_ident [simp]:
   fixes a::real
   assumes "a \<le> b"
   shows "integral {a..b} (\<lambda>x. x) = (if a \<le> b then (b\<^sup>2 - a\<^sup>2)/2 else 0)"
   by (metis assms ident_has_integral integral_unique)
 
 lemma ident_integrable_on:
   fixes a::real
   shows "(\<lambda>x. x) integrable_on {a..b}"
 by (metis atLeastatMost_empty_iff integrable_on_def has_integral_empty ident_has_integral)
 
 lemma integral_sin [simp]:
   fixes a::real
   assumes "a \<le> b" shows "integral {a..b} sin = cos a - cos b"
 proof -
   have "(sin has_integral (- cos b - - cos a)) {a..b}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>a. - cos a) has_vector_derivative sin x) (at x within {a..b})" for x
       unfolding has_field_derivative_iff_has_vector_derivative [symmetric]
       by (rule derivative_eq_intros | force)+
   qed (use assms in auto)
   then show ?thesis
     by (simp add: integral_unique)
 qed
 
 lemma integral_cos [simp]:
   fixes a::real
   assumes "a \<le> b" shows "integral {a..b} cos = sin b - sin a"
 proof -
   have "(cos has_integral (sin b - sin a)) {a..b}"
   proof (rule fundamental_theorem_of_calculus)
     show "(sin has_vector_derivative cos x) (at x within {a..b})" for x
       unfolding has_field_derivative_iff_has_vector_derivative [symmetric]
       by (rule derivative_eq_intros | force)+
   qed (use assms in auto)
   then show ?thesis
     by (simp add: integral_unique)
 qed
 
 lemma has_integral_sin_nx: "((\<lambda>x. sin(real_of_int n * x)) has_integral 0) {-pi..pi}"
 proof (cases "n = 0")
   case False
   have "((\<lambda>x. sin (n * x)) has_integral (- cos (n * pi)/n - - cos (n * - pi)/n)) {-pi..pi}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>x. - cos (n * x) / n) has_vector_derivative sin (n * a)) (at a within {-pi..pi})"
       if "a \<in> {-pi..pi}" for a :: real
       using that False
       apply (simp only: has_vector_derivative_def)
       apply (rule derivative_eq_intros | force)+
       done
   qed auto
   then show ?thesis
     by simp
 qed auto
 
 lemma integral_sin_nx:
    "integral {-pi..pi} (\<lambda>x. sin(x * real_of_int n)) = 0"
   using has_integral_sin_nx [of n] by (force simp: mult.commute)
 
 lemma has_integral_cos_nx:
   "((\<lambda>x. cos(real_of_int n * x)) has_integral (if n = 0 then 2 * pi else 0)) {-pi..pi}"
 proof (cases "n = 0")
   case True
   then show ?thesis
     using has_integral_const_real [of "1::real" "-pi" pi] by auto
 next
   case False
   have "((\<lambda>x. cos (n * x)) has_integral (sin (n * pi)/n - sin (n * - pi)/n)) {-pi..pi}"
   proof (rule fundamental_theorem_of_calculus)
     show "((\<lambda>x. sin (n * x) / n) has_vector_derivative cos (n * x)) (at x within {-pi..pi})"
       if "x \<in> {-pi..pi}"
       for x :: real
       using that False
       apply (simp only: has_vector_derivative_def)
       apply (rule derivative_eq_intros | force)+
       done
   qed auto
   with False show ?thesis
     by (simp add: mult.commute)
 qed
 
 lemma integral_cos_nx:
    "integral {-pi..pi} (\<lambda>x. cos(x * real_of_int n)) = (if n = 0 then 2 * pi else 0)"
   using has_integral_cos_nx [of n] by (force simp: mult.commute)
 
 
 subsection \<open>Taylor series expansion\<close>
 
 lemma mvt_integral:
   fixes f::"'a::real_normed_vector\<Rightarrow>'b::banach"
   assumes f'[derivative_intros]:
     "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   assumes line_in: "\<And>t. t \<in> {0..1} \<Longrightarrow> x + t *\<^sub>R y \<in> S"
   shows "f (x + y) - f x = integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) y)" (is ?th1)
 proof -
   from assms have subset: "(\<lambda>xa. x + xa *\<^sub>R y) ` {0..1} \<subseteq> S" by auto
   note [derivative_intros] =
     has_derivative_subset[OF _ subset]
     has_derivative_in_compose[where f="(\<lambda>xa. x + xa *\<^sub>R y)" and g = f]
   note [continuous_intros] =
     continuous_on_compose2[where f="(\<lambda>xa. x + xa *\<^sub>R y)"]
     continuous_on_subset[OF _ subset]
   have "\<And>t. t \<in> {0..1} \<Longrightarrow>
     ((\<lambda>t. f (x + t *\<^sub>R y)) has_vector_derivative f' (x + t *\<^sub>R y) y)
     (at t within {0..1})"
     using assms
     by (auto simp: has_vector_derivative_def
         linear_cmul[OF has_derivative_linear[OF f'], symmetric]
       intro!: derivative_eq_intros)
   from fundamental_theorem_of_calculus[rule_format, OF _ this]
   show ?th1
     by (auto intro!: integral_unique[symmetric])
 qed
 
 lemma (in bounded_bilinear) sum_prod_derivatives_has_vector_derivative:
   assumes "p>0"
   and f0: "Df 0 = f"
   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Df m has_vector_derivative Df (Suc m) t) (at t within {a..b})"
   and g0: "Dg 0 = g"
   and Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a..b})"
   and ivl: "a \<le> t" "t \<le> b"
   shows "((\<lambda>t. \<Sum>i<p. (-1)^i *\<^sub>R prod (Df i t) (Dg (p - Suc i) t))
     has_vector_derivative
       prod (f t) (Dg p t) - (-1)^p *\<^sub>R prod (Df p t) (g t))
     (at t within {a..b})"
   using assms
 proof cases
   assume p: "p \<noteq> 1"
   define p' where "p' = p - 2"
   from assms p have p': "{..<p} = {..Suc p'}" "p = Suc (Suc p')"
     by (auto simp: p'_def)
   have *: "\<And>i. i \<le> p' \<Longrightarrow> Suc (Suc p' - i) = (Suc (Suc p') - i)"
     by auto
   let ?f = "\<lambda>i. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg ((p - i)) t))"
   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
     prod (Df (Suc i) t) (Dg (p - Suc i) t))) =
     (\<Sum>i\<le>(Suc p'). ?f i - ?f (Suc i))"
     by (auto simp: algebra_simps p'(2) numeral_2_eq_2 * lessThan_Suc_atMost)
   also note sum_telescope
   finally
   have "(\<Sum>i<p. (-1) ^ i *\<^sub>R (prod (Df i t) (Dg (Suc (p - Suc i)) t) +
     prod (Df (Suc i) t) (Dg (p - Suc i) t)))
     = prod (f t) (Dg p t) - (- 1) ^ p *\<^sub>R prod (Df p t) (g t)"
     unfolding p'[symmetric]
     by (simp add: assms)
   thus ?thesis
     using assms
     by (auto intro!: derivative_eq_intros has_vector_derivative)
 qed (auto intro!: derivative_eq_intros has_vector_derivative)
 
 lemma
   fixes f::"real\<Rightarrow>'a::banach"
   assumes "p>0"
   and f0: "Df 0 = f"
   and Df: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Df m has_vector_derivative Df (Suc m) t) (at t within {a..b})"
   and ivl: "a \<le> b"
   defines "i \<equiv> \<lambda>x. ((b - x) ^ (p - 1) / fact (p - 1)) *\<^sub>R Df p x"
   shows Taylor_has_integral:
     "(i has_integral f b - (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a)) {a..b}"
   and Taylor_integral:
     "f b = (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a) + integral {a..b} i"
   and Taylor_integrable:
     "i integrable_on {a..b}"
 proof goal_cases
   case 1
   interpret bounded_bilinear "scaleR::real\<Rightarrow>'a\<Rightarrow>'a"
     by (rule bounded_bilinear_scaleR)
   define g where "g s = (b - s)^(p - 1)/fact (p - 1)" for s
   define Dg where [abs_def]:
     "Dg n s = (if n < p then (-1)^n * (b - s)^(p - 1 - n) / fact (p - 1 - n) else 0)" for n s
   have g0: "Dg 0 = g"
     using \<open>p > 0\<close>
     by (auto simp add: Dg_def field_split_simps g_def split: if_split_asm)
   {
     fix m
     assume "p > Suc m"
     hence "p - Suc m = Suc (p - Suc (Suc m))"
       by auto
     hence "real (p - Suc m) * fact (p - Suc (Suc m)) = fact (p - Suc m)"
       by auto
   } note fact_eq = this
   have Dg: "\<And>m t. m < p \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (Dg m has_vector_derivative Dg (Suc m) t) (at t within {a..b})"
     unfolding Dg_def
     by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def fact_eq field_split_simps)
   let ?sum = "\<lambda>t. \<Sum>i<p. (- 1) ^ i *\<^sub>R Dg i t *\<^sub>R Df (p - Suc i) t"
   from sum_prod_derivatives_has_vector_derivative[of _ Dg _ _ _ Df,
       OF \<open>p > 0\<close> g0 Dg f0 Df]
   have deriv: "\<And>t. a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
     (?sum has_vector_derivative
       g t *\<^sub>R Df p t - (- 1) ^ p *\<^sub>R Dg p t *\<^sub>R f t) (at t within {a..b})"
     by auto
   from fundamental_theorem_of_calculus[rule_format, OF \<open>a \<le> b\<close> deriv]
   have "(i has_integral ?sum b - ?sum a) {a..b}"
     using atLeastatMost_empty'[simp del]
     by (simp add: i_def g_def Dg_def)
   also
   have one: "(- 1) ^ p' * (- 1) ^ p' = (1::real)"
     and "{..<p} \<inter> {i. p = Suc i} = {p - 1}"
     for p'
     using \<open>p > 0\<close>
     by (auto simp: power_mult_distrib[symmetric])
   then have "?sum b = f b"
     using Suc_pred'[OF \<open>p > 0\<close>]
     by (simp add: diff_eq_eq Dg_def power_0_left le_Suc_eq if_distrib
         if_distribR sum.If_cases f0)
   also
   have "{..<p} = (\<lambda>x. p - x - 1) ` {..<p}"
   proof safe
     fix x
     assume "x < p"
     thus "x \<in> (\<lambda>x. p - x - 1) ` {..<p}"
       by (auto intro!: image_eqI[where x = "p - x - 1"])
   qed simp
   from _ this
   have "?sum a = (\<Sum>i<p. ((b-a) ^ i / fact i) *\<^sub>R Df i a)"
     by (rule sum.reindex_cong) (auto simp add: inj_on_def Dg_def one)
   finally show c: ?case .
   case 2 show ?case using c integral_unique
     by (metis (lifting) add.commute diff_eq_eq integral_unique)
   case 3 show ?case using c by force
 qed
 
 
 subsection \<open>Only need trivial subintervals if the interval itself is trivial\<close>
 
 proposition division_of_nontrivial:
   fixes \<D> :: "'a::euclidean_space set set"
   assumes sdiv: "\<D> division_of (cbox a b)"
      and cont0: "content (cbox a b) \<noteq> 0"
   shows "{k. k \<in> \<D> \<and> content k \<noteq> 0} division_of (cbox a b)"
   using sdiv
 proof (induction "card \<D>" arbitrary: \<D> rule: less_induct)
   case less
   note \<D> = division_ofD[OF less.prems]
   {
     presume *: "{k \<in> \<D>. content k \<noteq> 0} \<noteq> \<D> \<Longrightarrow> ?case"
     then show ?case
       using less.prems by fastforce
   }
   assume noteq: "{k \<in> \<D>. content k \<noteq> 0} \<noteq> \<D>"
   then obtain K c d where "K \<in> \<D>" and contk: "content K = 0" and keq: "K = cbox c d"
     using \<D>(4) by blast 
   then have "card \<D> > 0"
     unfolding card_gt_0_iff using less by auto
   then have card: "card (\<D> - {K}) < card \<D>"
     using less \<open>K \<in> \<D>\<close> by (simp add: \<D>(1))
   have closed: "closed (\<Union>(\<D> - {K}))"
     using less.prems by auto
   have "x islimpt \<Union>(\<D> - {K})" if "x \<in> K" for x 
     unfolding islimpt_approachable
   proof (intro allI impI)
     fix e::real
     assume "e > 0"
     obtain i where i: "c\<bullet>i = d\<bullet>i" "i\<in>Basis"
       using contk \<D>(3) [OF \<open>K \<in> \<D>\<close>] unfolding box_ne_empty keq
       by (meson content_eq_0 dual_order.antisym)
     then have xi: "x\<bullet>i = d\<bullet>i"
       using \<open>x \<in> K\<close> unfolding keq mem_box by (metis antisym)
     define y where "y = (\<Sum>j\<in>Basis. (if j = i then if c\<bullet>i \<le> (a\<bullet>i + b\<bullet>i)/2 then c\<bullet>i +
       min e (b\<bullet>i - c\<bullet>i)/2 else c\<bullet>i - min e (c\<bullet>i - a\<bullet>i)/2 else x\<bullet>j) *\<^sub>R j)"
     show "\<exists>x'\<in>\<Union>(\<D> - {K}). x' \<noteq> x \<and> dist x' x < e"
     proof (intro bexI conjI)
       have "d \<in> cbox c d"
         using \<D>(3)[OF \<open>K \<in> \<D>\<close>] by (simp add: box_ne_empty(1) keq mem_box(2))
       then have "d \<in> cbox a b"
         using \<D>(2)[OF \<open>K \<in> \<D>\<close>] by (auto simp: keq)
       then have di: "a \<bullet> i \<le> d \<bullet> i \<and> d \<bullet> i \<le> b \<bullet> i"
         using \<open>i \<in> Basis\<close> mem_box(2) by blast
       then have xyi: "y\<bullet>i \<noteq> x\<bullet>i"
         unfolding y_def i xi using \<open>e > 0\<close> cont0 \<open>i \<in> Basis\<close>
         by (auto simp: content_eq_0 elim!: ballE[of _ _ i])
       then show "y \<noteq> x"
         unfolding euclidean_eq_iff[where 'a='a] using i by auto
       have "norm (y-x) \<le> (\<Sum>b\<in>Basis. \<bar>(y - x) \<bullet> b\<bar>)"
         by (rule norm_le_l1)
       also have "... = \<bar>(y - x) \<bullet> i\<bar> + (\<Sum>b \<in> Basis - {i}. \<bar>(y - x) \<bullet> b\<bar>)"
         by (meson finite_Basis i(2) sum.remove)
       also have "... <  e + sum (\<lambda>i. 0) Basis"
       proof (rule add_less_le_mono)
         show "\<bar>(y-x) \<bullet> i\<bar> < e"
           using di \<open>e > 0\<close> y_def i xi by (auto simp: inner_simps)
         show "(\<Sum>i\<in>Basis - {i}. \<bar>(y-x) \<bullet> i\<bar>) \<le> (\<Sum>i\<in>Basis. 0)"
           unfolding y_def by (auto simp: inner_simps)
       qed 
       finally have "norm (y-x) < e + sum (\<lambda>i. 0) Basis" .
       then show "dist y x < e"
         unfolding dist_norm by auto
       have "y \<notin> K"
         unfolding keq mem_box using i(1) i(2) xi xyi by fastforce
       moreover have "y \<in> \<Union>\<D>"
         using subsetD[OF \<D>(2)[OF \<open>K \<in> \<D>\<close>] \<open>x \<in> K\<close>] \<open>e > 0\<close> di i
         by (auto simp: \<D> mem_box y_def field_simps elim!: ballE[of _ _ i])
       ultimately show "y \<in> \<Union>(\<D> - {K})" by auto
     qed
   qed
   then have "K \<subseteq> \<Union>(\<D> - {K})"
     using closed closed_limpt by blast
   then have "\<Union>(\<D> - {K}) = cbox a b"
     unfolding \<D>(6)[symmetric] by auto
   then have "\<D> - {K} division_of cbox a b"
     by (metis Diff_subset less.prems division_of_subset \<D>(6))
   then have "{ka \<in> \<D> - {K}. content ka \<noteq> 0} division_of (cbox a b)"
     using card less.hyps by blast
   moreover have "{ka \<in> \<D> - {K}. content ka \<noteq> 0} = {K \<in> \<D>. content K \<noteq> 0}"
     using contk by auto
   ultimately show ?case by auto
 qed
 
 
 subsection \<open>Integrability on subintervals\<close>
 
 lemma operative_integrableI:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "0 \<le> e"
   shows "operative conj True (\<lambda>i. f integrable_on i)"
 proof -
   interpret comm_monoid conj True
     by standard auto
   have 1: "\<And>a b. box a b = {} \<Longrightarrow> f integrable_on cbox a b"
     by (simp add: content_eq_0_interior integrable_on_null)
   have 2: "\<And>a b c k.
        \<lbrakk>k \<in> Basis;
         f integrable_on cbox a b \<inter> {x. x \<bullet> k \<le> c};
         f integrable_on cbox a b \<inter> {x. c \<le> x \<bullet> k}\<rbrakk>
        \<Longrightarrow> f integrable_on cbox a b"
     unfolding integrable_on_def by (auto intro!: has_integral_split)
   show ?thesis
     apply standard
     using 1 2 by blast+
 qed
 
 lemma integrable_subinterval:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on cbox a b"
     and cd: "cbox c d \<subseteq> cbox a b"
   shows "f integrable_on cbox c d"
 proof -
   interpret operative conj True "\<lambda>i. f integrable_on i"
     using order_refl by (rule operative_integrableI)
   show ?thesis
   proof (cases "cbox c d = {}")
     case True
     then show ?thesis
       using division [symmetric] f by (auto simp: comm_monoid_set_F_and)
   next
     case False
     then show ?thesis
       by (metis cd comm_monoid_set_F_and division division_of_finite f partial_division_extend_1)
   qed
 qed
 
 lemma integrable_subinterval_real:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
     and "{c..d} \<subseteq> {a..b}"
   shows "f integrable_on {c..d}"
   by (metis assms box_real(2) integrable_subinterval)
 
 subsection \<open>Combining adjacent intervals in 1 dimension\<close>
 
 lemma has_integral_combine:
   fixes a b c :: real and j :: "'a::banach"
   assumes "a \<le> c"
       and "c \<le> b"
       and ac: "(f has_integral i) {a..c}"
       and cb: "(f has_integral j) {c..b}"
   shows "(f has_integral (i + j)) {a..b}"
 proof -
   interpret operative_real "lift_option plus" "Some 0"
     "\<lambda>i. if f integrable_on i then Some (integral i f) else None"
     using operative_integralI by (rule operative_realI)
   from \<open>a \<le> c\<close> \<open>c \<le> b\<close> ac cb coalesce_less_eq
   have *: "lift_option (+)
              (if f integrable_on {a..c} then Some (integral {a..c} f) else None)
              (if f integrable_on {c..b} then Some (integral {c..b} f) else None) =
             (if f integrable_on {a..b} then Some (integral {a..b} f) else None)"
     by (auto simp: split: if_split_asm)
   then have "f integrable_on cbox a b"
     using ac cb by (auto split: if_split_asm)
   with *
   show ?thesis
     using ac cb by (auto simp add: integrable_on_def integral_unique split: if_split_asm)
 qed
 
 lemma integral_combine:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> c"
     and "c \<le> b"
     and ab: "f integrable_on {a..b}"
   shows "integral {a..c} f + integral {c..b} f = integral {a..b} f"
 proof -
   have "(f has_integral integral {a..c} f) {a..c}"
     using ab \<open>c \<le> b\<close> integrable_subinterval_real by fastforce
   moreover
   have "(f has_integral integral {c..b} f) {c..b}"
     using ab \<open>a \<le> c\<close> integrable_subinterval_real by fastforce
   ultimately have "(f has_integral integral {a..c} f + integral {c..b} f) {a..b}"
     using \<open>a \<le> c\<close> \<open>c \<le> b\<close> has_integral_combine by blast
   then show ?thesis
     by (simp add: has_integral_integrable_integral)
 qed
 
 lemma integrable_combine:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "a \<le> c"
     and "c \<le> b"
     and "f integrable_on {a..c}"
     and "f integrable_on {c..b}"
   shows "f integrable_on {a..b}"
   using assms
   unfolding integrable_on_def
   by (auto intro!: has_integral_combine)
 
 lemma integral_minus_sets:
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "c \<le> a \<Longrightarrow> c \<le> b \<Longrightarrow> f integrable_on {c .. max a b} \<Longrightarrow>
     integral {c .. a} f - integral {c .. b} f =
     (if a \<le> b then - integral {a .. b} f else integral {b .. a} f)"
   using integral_combine[of c a b f]  integral_combine[of c b a f]
   by (auto simp: algebra_simps max_def)
 
 lemma integral_minus_sets':
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "c \<ge> a \<Longrightarrow> c \<ge> b \<Longrightarrow> f integrable_on {min a b .. c} \<Longrightarrow>
     integral {a .. c} f - integral {b .. c} f =
     (if a \<le> b then integral {a .. b} f else - integral {b .. a} f)"
   using integral_combine[of b a c f] integral_combine[of a b c f]
   by (auto simp: algebra_simps min_def)
 
 subsection \<open>Reduce integrability to "local" integrability\<close>
 
 lemma integrable_on_little_subintervals:
   fixes f :: "'b::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<forall>x\<in>cbox a b. \<exists>d>0. \<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
     f integrable_on cbox u v"
   shows "f integrable_on cbox a b"
 proof -
   interpret operative conj True "\<lambda>i. f integrable_on i"
     using order_refl by (rule operative_integrableI)
   have "\<forall>x. \<exists>d>0. x\<in>cbox a b \<longrightarrow> (\<forall>u v. x \<in> cbox u v \<and> cbox u v \<subseteq> ball x d \<and> cbox u v \<subseteq> cbox a b \<longrightarrow>
     f integrable_on cbox u v)"
     using assms by (metis zero_less_one)
   then obtain d where d: "\<And>x. 0 < d x"
      "\<And>x u v. \<lbrakk>x \<in> cbox a b; x \<in> cbox u v; cbox u v \<subseteq> ball x (d x); cbox u v \<subseteq> cbox a b\<rbrakk> 
                \<Longrightarrow> f integrable_on cbox u v"
     by metis
   obtain p where p: "p tagged_division_of cbox a b" "(\<lambda>x. ball x (d x)) fine p"
     using fine_division_exists[OF gauge_ball_dependent,of d a b] d(1) by blast 
   then have sndp: "snd ` p division_of cbox a b"
     by (metis division_of_tagged_division)
   have "f integrable_on k" if "(x, k) \<in> p" for x k
     using tagged_division_ofD(2-4)[OF p(1) that] fineD[OF p(2) that] d[of x] by auto
   then show ?thesis
     unfolding division [symmetric, OF sndp] comm_monoid_set_F_and
     by auto
 qed
 
 
 subsection \<open>Second FTC or existence of antiderivative\<close>
 
 lemma integrable_const[intro]: "(\<lambda>x. c) integrable_on cbox a b"
   unfolding integrable_on_def by blast
 
 lemma integral_has_vector_derivative_continuous_at:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on {a..b}"
      and x: "x \<in> {a..b} - S"
      and "finite S"
      and fx: "continuous (at x within ({a..b} - S)) f"
  shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f x) (at x within ({a..b} - S))"
 proof -
   let ?I = "\<lambda>a b. integral {a..b} f"
   { fix e::real
     assume "e > 0"
     obtain d where "d>0" and d: "\<And>x'. \<lbrakk>x' \<in> {a..b} - S; \<bar>x' - x\<bar> < d\<rbrakk> \<Longrightarrow> norm(f x' - f x) \<le> e"
       using \<open>e>0\<close> fx by (auto simp: continuous_within_eps_delta dist_norm less_imp_le)
     have "norm (integral {a..y} f - integral {a..x} f - (y-x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
            if y: "y \<in> {a..b} - S" and yx: "\<bar>y - x\<bar> < d" for y
     proof (cases "y < x")
       case False
       have "f integrable_on {a..y}"
         using f y by (simp add: integrable_subinterval_real)
       then have Idiff: "?I a y - ?I a x = ?I x y"
         using False x by (simp add: algebra_simps integral_combine)
       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {x..y} f - (y-x) *\<^sub>R f x) {x..y}"
         apply (rule has_integral_diff)
         using x y apply (auto intro: integrable_integral [OF integrable_subinterval_real [OF f]])
         using has_integral_const_real [of "f x" x y] False
         apply simp
         done
       have "\<And>xa. y - x < d \<Longrightarrow> (\<And>x'. a \<le> x' \<and> x' \<le> b \<and> x' \<notin> S \<Longrightarrow> \<bar>x' - x\<bar> < d \<Longrightarrow> norm (f x' - f x) \<le> e) \<Longrightarrow> 0 < e \<Longrightarrow> xa \<notin> S \<Longrightarrow> a \<le> x \<Longrightarrow> x \<notin> S \<Longrightarrow> y \<le> b \<Longrightarrow> y \<notin> S \<Longrightarrow> x \<le> xa \<Longrightarrow> xa \<le> y \<Longrightarrow> norm (f xa - f x) \<le> e"
         using assms by auto
       show ?thesis
         using False
         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
         using yx False d x y \<open>e>0\<close> assms by (auto simp: Idiff fux_int)
     next
       case True
       have "f integrable_on {a..x}"
         using f x by (simp add: integrable_subinterval_real)
       then have Idiff: "?I a x - ?I a y = ?I y x"
         using True x y by (simp add: algebra_simps integral_combine)
       have fux_int: "((\<lambda>u. f u - f x) has_integral integral {y..x} f - (x - y) *\<^sub>R f x) {y..x}"
         apply (rule has_integral_diff)
         using x y apply (auto intro: integrable_integral [OF integrable_subinterval_real [OF f]])
         using has_integral_const_real [of "f x" y x] True
         apply simp
         done
       have "norm (integral {a..x} f - integral {a..y} f - (x - y) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
         using True
         apply (simp add: abs_eq_content del: content_real_if measure_lborel_Icc)
         apply (rule has_integral_bound_real[where f="(\<lambda>u. f u - f x)"])
         using yx True d x y \<open>e>0\<close> assms by (auto simp: Idiff fux_int)
       then show ?thesis
         by (simp add: algebra_simps norm_minus_commute)
     qed
     then have "\<exists>d>0. \<forall>y\<in>{a..b} - S. \<bar>y - x\<bar> < d \<longrightarrow> norm (integral {a..y} f - integral {a..x} f - (y-x) *\<^sub>R f x) \<le> e * \<bar>y - x\<bar>"
       using \<open>d>0\<close> by blast
   }
   then show ?thesis
     by (simp add: has_vector_derivative_def has_derivative_within_alt bounded_linear_scaleR_left)
 qed
 
 
 lemma integral_has_vector_derivative:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
     and "x \<in> {a..b}"
   shows "((\<lambda>u. integral {a..u} f) has_vector_derivative f(x)) (at x within {a..b})"
 using assms integral_has_vector_derivative_continuous_at [OF integrable_continuous_real]
   by (fastforce simp: continuous_on_eq_continuous_within)
 
 lemma integral_has_real_derivative:
   assumes "continuous_on {a..b} g"
   assumes "t \<in> {a..b}"
   shows "((\<lambda>x. integral {a..x} g) has_real_derivative g t) (at t within {a..b})"
   using integral_has_vector_derivative[of a b g t] assms
   by (auto simp: has_field_derivative_iff_has_vector_derivative)
 
 lemma antiderivative_continuous:
   fixes q b :: real
   assumes "continuous_on {a..b} f"
   obtains g where "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_vector_derivative (f x::_::banach)) (at x within {a..b})"
   using integral_has_vector_derivative[OF assms] by auto
 
 subsection \<open>Combined fundamental theorem of calculus\<close>
 
 lemma antiderivative_integral_continuous:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "continuous_on {a..b} f"
   obtains g where "\<forall>u\<in>{a..b}. \<forall>v \<in> {a..b}. u \<le> v \<longrightarrow> (f has_integral (g v - g u)) {u..v}"
 proof -
   obtain g 
     where g: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_vector_derivative f x) (at x within {a..b})" 
     using  antiderivative_continuous[OF assms] by metis
   have "(f has_integral g v - g u) {u..v}" if "u \<in> {a..b}" "v \<in> {a..b}" "u \<le> v" for u v
   proof -
     have "\<And>x. x \<in> cbox u v \<Longrightarrow> (g has_vector_derivative f x) (at x within cbox u v)"
       by (metis atLeastAtMost_iff atLeastatMost_subset_iff box_real(2) g
           has_vector_derivative_within_subset subsetCE that(1,2))
     then show ?thesis
       by (metis box_real(2) that(3) fundamental_theorem_of_calculus)
   qed
   then show ?thesis
     using that by blast
 qed
 
 
 subsection \<open>General "twiddling" for interval-to-interval function image\<close>
 
 lemma has_integral_twiddle:
   assumes "0 < r"
     and hg: "\<And>x. h(g x) = x"
     and gh: "\<And>x. g(h x) = x"
     and contg: "\<And>x. continuous (at x) g"
     and g: "\<And>u v. \<exists>w z. g ` cbox u v = cbox w z"
     and h: "\<And>u v. \<exists>w z. h ` cbox u v = cbox w z"
     and r: "\<And>u v. content(g ` cbox u v) = r * content (cbox u v)"
     and intfi: "(f has_integral i) (cbox a b)"
   shows "((\<lambda>x. f(g x)) has_integral (1 / r) *\<^sub>R i) (h ` cbox a b)"
 proof (cases "cbox a b = {}")
   case True
   then show ?thesis 
     using intfi by auto
 next
   case False
   obtain w z where wz: "h ` cbox a b = cbox w z"
     using h by blast
   have inj: "inj g" "inj h"
     using hg gh injI by metis+
   from h obtain ha hb where h_eq: "h ` cbox a b = cbox ha hb" by blast
   have "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of h ` cbox a b \<and> d fine p 
               \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e)"
     if "e > 0" for e
   proof -
     have "e * r > 0" using that \<open>0 < r\<close> by simp
     with intfi[unfolded has_integral]
     obtain d where "gauge d"
                and d: "\<And>p. p tagged_division_of cbox a b \<and> d fine p 
                         \<Longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - i) < e * r" 
       by metis
     define d' where "d' x = g -` d (g x)" for x
     show ?thesis
     proof (rule_tac x=d' in exI, safe)
       show "gauge d'"
         using \<open>gauge d\<close> continuous_open_vimage[OF _ contg] by (auto simp: gauge_def d'_def)
     next
       fix p
       assume ptag: "p tagged_division_of h ` cbox a b" and finep: "d' fine p"
       note p = tagged_division_ofD[OF ptag]
       have gab: "g y \<in> cbox a b" if "y \<in> K" "(x, K) \<in> p" for x y K
         by (metis hg inj(2) inj_image_mem_iff p(3) subsetCE that that)
       have gimp: "(\<lambda>(x,K). (g x, g ` K)) ` p tagged_division_of (cbox a b) \<and> 
                   d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
         unfolding tagged_division_of
       proof safe
         show "finite ((\<lambda>(x, k). (g x, g ` k)) ` p)"
           using ptag by auto
         show "d fine (\<lambda>(x, k). (g x, g ` k)) ` p"
           using finep unfolding fine_def d'_def by auto
       next
         fix x k
         assume xk: "(x, k) \<in> p"
         show "g x \<in> g ` k"
           using p(2)[OF xk] by auto
         show "\<exists>u v. g ` k = cbox u v"
           using p(4)[OF xk] using assms(5-6) by auto
         fix x' K' u
         assume xk': "(x', K') \<in> p" and u: "u \<in> interior (g ` k)" "u \<in> interior (g ` K')"
         have "interior k \<inter> interior K' \<noteq> {}"
         proof 
           assume "interior k \<inter> interior K' = {}"
           moreover have "u \<in> g ` (interior k \<inter> interior K')"
             using interior_image_subset[OF \<open>inj g\<close> contg] u
             unfolding image_Int[OF inj(1)] by blast
           ultimately show False by blast
         qed
         then have same: "(x, k) = (x', K')"
           using ptag xk' xk by blast
         then show "g x = g x'"
           by auto
         show "g u \<in> g ` K'"if "u \<in> k" for u
           using that same by auto
         show "g u \<in> g ` k"if "u \<in> K'" for u
           using that same by auto
       next
         fix x
         assume "x \<in> cbox a b"
         then have "h x \<in>  \<Union>{k. \<exists>x. (x, k) \<in> p}"
           using p(6) by auto
         then obtain X y where "h x \<in> X" "(y, X) \<in> p" by blast
         then show "x \<in> \<Union>{k. \<exists>x. (x, k) \<in> (\<lambda>(x, k). (g x, g ` k)) ` p}"
           apply clarsimp
           by (metis (no_types, lifting) assms(3) image_eqI pair_imageI)
       qed (use gab in auto)
       have *: "inj_on (\<lambda>(x, k). (g x, g ` k)) p"
         using inj(1) unfolding inj_on_def by fastforce
       have "(\<Sum>(x, k)\<in>(\<lambda>(x, k). (g x, g ` k)) ` p. content k *\<^sub>R f x) - i = r *\<^sub>R (\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - i" (is "?l = _")
         using r
         apply (simp only: algebra_simps add_left_cancel scaleR_right.sum)
         apply (subst sum.reindex_bij_betw[symmetric, where h="\<lambda>(x, k). (g x, g ` k)" and S=p])
          apply (auto intro!: * sum.cong simp: bij_betw_def dest!: p(4))
         done
       also have "\<dots> = r *\<^sub>R ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i)" (is "_ = ?r")
         using \<open>0 < r\<close> by (auto simp: scaleR_diff_right)
       finally have eq: "?l = ?r" .
       show "norm ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e"
         using d[OF gimp] \<open>0 < r\<close> by (auto simp add: eq)
     qed
   qed
   then show ?thesis
     by (auto simp: h_eq has_integral)
 qed
 
 
 subsection \<open>Special case of a basic affine transformation\<close>
 
 lemma AE_lborel_inner_neq:
   assumes k: "k \<in> Basis"
   shows "AE x in lborel. x \<bullet> k \<noteq> c"
 proof -
   interpret finite_product_sigma_finite "\<lambda>_. lborel" Basis
     proof qed simp
 
   have "emeasure lborel {x\<in>space lborel. x \<bullet> k = c} = emeasure (\<Pi>\<^sub>M j::'a\<in>Basis. lborel) (\<Pi>\<^sub>E j\<in>Basis. if j = k then {c} else UNIV)"
     using k
     by (auto simp add: lborel_eq[where 'a='a] emeasure_distr intro!: arg_cong2[where f=emeasure])
        (auto simp: space_PiM PiE_iff extensional_def split: if_split_asm)
   also have "\<dots> = (\<Prod>j\<in>Basis. emeasure lborel (if j = k then {c} else UNIV))"
     by (intro measure_times) auto
   also have "\<dots> = 0"
     by (intro prod_zero bexI[OF _ k]) auto
   finally show ?thesis
     by (subst AE_iff_measurable[OF _ refl]) auto
 qed
 
 lemma content_image_stretch_interval:
   fixes m :: "'a::euclidean_space \<Rightarrow> real"
   defines "s f x \<equiv> (\<Sum>k::'a\<in>Basis. (f k * (x\<bullet>k)) *\<^sub>R k)"
   shows "content (s m ` cbox a b) = \<bar>\<Prod>k\<in>Basis. m k\<bar> * content (cbox a b)"
 proof cases
   have s[measurable]: "s f \<in> borel \<rightarrow>\<^sub>M borel" for f
     by (auto simp: s_def[abs_def])
   assume m: "\<forall>k\<in>Basis. m k \<noteq> 0"
   then have s_comp_s: "s (\<lambda>k. 1 / m k) \<circ> s m = id" "s m \<circ> s (\<lambda>k. 1 / m k) = id"
     by (auto simp: s_def[abs_def] fun_eq_iff euclidean_representation)
   then have "inv (s (\<lambda>k. 1 / m k)) = s m" "bij (s (\<lambda>k. 1 / m k))"
     by (auto intro: inv_unique_comp o_bij)
   then have eq: "s m ` cbox a b = s (\<lambda>k. 1 / m k) -` cbox a b"
     using bij_vimage_eq_inv_image[OF \<open>bij (s (\<lambda>k. 1 / m k))\<close>, of "cbox a b"] by auto
   show ?thesis
     using m unfolding eq measure_def
     by (subst lborel_affine_euclidean[where c=m and t=0])
        (simp_all add: emeasure_density measurable_sets_borel[OF s] abs_prod nn_integral_cmult
                       s_def[symmetric] emeasure_distr vimage_comp s_comp_s enn2real_mult prod_nonneg)
 next
   assume "\<not> (\<forall>k\<in>Basis. m k \<noteq> 0)"
   then obtain k where k: "k \<in> Basis" "m k = 0" by auto
   then have [simp]: "(\<Prod>k\<in>Basis. m k) = 0"
     by (intro prod_zero) auto
   have "emeasure lborel {x\<in>space lborel. x \<in> s m ` cbox a b} = 0"
   proof (rule emeasure_eq_0_AE)
     show "AE x in lborel. x \<notin> s m ` cbox a b"
       using AE_lborel_inner_neq[OF \<open>k\<in>Basis\<close>]
     proof eventually_elim
       show "x \<bullet> k \<noteq> 0 \<Longrightarrow> x \<notin> s m ` cbox a b " for x
         using k by (auto simp: s_def[abs_def] cbox_def)
     qed
   qed
   then show ?thesis
     by (simp add: measure_def)
 qed
 
 lemma interval_image_affinity_interval:
   "\<exists>u v. (\<lambda>x. m *\<^sub>R (x::'a::euclidean_space) + c) ` cbox a b = cbox u v"
   unfolding image_affinity_cbox
   by auto
 
 lemma content_image_affinity_cbox:
   "content((\<lambda>x::'a::euclidean_space. m *\<^sub>R x + c) ` cbox a b) =
     \<bar>m\<bar> ^ DIM('a) * content (cbox a b)" (is "?l = ?r")
 proof (cases "cbox a b = {}")
   case True then show ?thesis by simp
 next
   case False
   show ?thesis
   proof (cases "m \<ge> 0")
     case True
     with \<open>cbox a b \<noteq> {}\<close> have "cbox (m *\<^sub>R a + c) (m *\<^sub>R b + c) \<noteq> {}"
       unfolding box_ne_empty
       apply (intro ballI)
       apply (erule_tac x=i in ballE)
       apply (auto simp: inner_simps mult_left_mono)
       done
     moreover from True have *: "\<And>i. (m *\<^sub>R b + c) \<bullet> i - (m *\<^sub>R a + c) \<bullet> i = m *\<^sub>R (b-a) \<bullet> i"
       by (simp add: inner_simps field_simps)
     ultimately show ?thesis
       by (simp add: image_affinity_cbox True content_cbox'
         prod.distrib prod_constant inner_diff_left)
   next
     case False
     with \<open>cbox a b \<noteq> {}\<close> have "cbox (m *\<^sub>R b + c) (m *\<^sub>R a + c) \<noteq> {}"
       unfolding box_ne_empty
       apply (intro ballI)
       apply (erule_tac x=i in ballE)
       apply (auto simp: inner_simps mult_left_mono)
       done
     moreover from False have *: "\<And>i. (m *\<^sub>R a + c) \<bullet> i - (m *\<^sub>R b + c) \<bullet> i = (-m) *\<^sub>R (b-a) \<bullet> i"
       by (simp add: inner_simps field_simps)
     ultimately show ?thesis using False
       by (simp add: image_affinity_cbox content_cbox'
         prod.distrib[symmetric] inner_diff_left flip: prod_constant)
   qed
 qed
 
 lemma has_integral_affinity:
   fixes a :: "'a::euclidean_space"
   assumes "(f has_integral i) (cbox a b)"
       and "m \<noteq> 0"
   shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral ((1 / (\<bar>m\<bar> ^ DIM('a))) *\<^sub>R i)) ((\<lambda>x. (1 / m) *\<^sub>R x + -((1 / m) *\<^sub>R c)) ` cbox a b)"
   apply (rule has_integral_twiddle)
   using assms
   apply (safe intro!: interval_image_affinity_interval content_image_affinity_cbox)
   apply (rule zero_less_power)
   unfolding scaleR_right_distrib
   apply auto
   done
 
 lemma integrable_affinity:
   assumes "f integrable_on cbox a b"
     and "m \<noteq> 0"
   shows "(\<lambda>x. f(m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x + -((1/m) *\<^sub>R c)) ` cbox a b)"
   using assms
   unfolding integrable_on_def
   apply safe
   apply (drule has_integral_affinity)
   apply auto
   done
 
 lemmas has_integral_affinity01 = has_integral_affinity [of _ _ 0 "1::real", simplified]
 
 lemma integrable_on_affinity:
   assumes "m \<noteq> 0" "f integrable_on (cbox a b)"
   shows   "(\<lambda>x. f (m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x - ((1 / m) *\<^sub>R c)) ` cbox a b)"
 proof -
   from assms obtain I where "(f has_integral I) (cbox a b)"
     by (auto simp: integrable_on_def)
   from has_integral_affinity[OF this assms(1), of c] show ?thesis
     by (auto simp: integrable_on_def)
 qed
 
 lemma has_integral_cmul_iff:
   assumes "c \<noteq> 0"
   shows   "((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R I)) A \<longleftrightarrow> (f has_integral I) A"
   using assms has_integral_cmul[of f I A c]
         has_integral_cmul[of "\<lambda>x. c *\<^sub>R f x" "c *\<^sub>R I" A "inverse c"] by (auto simp: field_simps)
 
 lemma has_integral_affinity':
   fixes a :: "'a::euclidean_space"
   assumes "(f has_integral i) (cbox a b)" and "m > 0"
   shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral (i /\<^sub>R m ^ DIM('a)))
            (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m))"
 proof (cases "cbox a b = {}")
   case True
   hence "(cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) = {}"
     using \<open>m > 0\<close> unfolding box_eq_empty by (auto simp: algebra_simps)
   with True and assms show ?thesis by simp
 next
   case False
   have "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (1 / \<bar>m\<bar> ^ DIM('a)) *\<^sub>R i)
           ((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b)"
     using assms by (intro has_integral_affinity) auto
   also have "((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b) =
                ((\<lambda>x.  - ((1 / m) *\<^sub>R c) + x) ` (\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b)"
     by (simp add: image_image algebra_simps)
   also have "(\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b = cbox ((1 / m) *\<^sub>R a) ((1 / m) *\<^sub>R b)" using \<open>m > 0\<close> False
     by (subst image_smult_cbox) simp_all
   also have "(\<lambda>x. - ((1 / m) *\<^sub>R c) + x) ` \<dots> = cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)"
     by (subst cbox_translation [symmetric]) (simp add: field_simps vector_add_divide_simps)
   finally show ?thesis using \<open>m > 0\<close> by (simp add: field_simps)
 qed
 
 lemma has_integral_affinity_iff:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: real_normed_vector"
   assumes "m > 0"
   shows   "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (I /\<^sub>R m ^ DIM('a)))
                (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) \<longleftrightarrow>
            (f has_integral I) (cbox a b)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   from has_integral_affinity'[OF this, of "1 / m" "-c /\<^sub>R m"] and \<open>m > 0\<close>
     show ?rhs by (simp add: vector_add_divide_simps) (simp add: field_simps)
 next
   assume ?rhs
   from has_integral_affinity'[OF this, of m c] and \<open>m > 0\<close>
   show ?lhs by simp
 qed
 
 
 subsection \<open>Special case of stretching coordinate axes separately\<close>
 
 lemma has_integral_stretch:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_integral i) (cbox a b)"
     and "\<forall>k\<in>Basis. m k \<noteq> 0"
   shows "((\<lambda>x. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) has_integral
          ((1/ \<bar>prod m Basis\<bar>) *\<^sub>R i)) ((\<lambda>x. (\<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k)) ` cbox a b)"
   apply (rule has_integral_twiddle[where f=f])
   unfolding zero_less_abs_iff content_image_stretch_interval
   unfolding image_stretch_interval empty_as_interval euclidean_eq_iff[where 'a='a]
   using assms
   by auto
 
 lemma has_integral_stretch_real:
   fixes f :: "real \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_integral i) {a..b}" and "m \<noteq> 0"
   shows "((\<lambda>x. f (m * x)) has_integral (1 / \<bar>m\<bar>) *\<^sub>R i) ((\<lambda>x. x / m) ` {a..b})"
   using has_integral_stretch [of f i a b "\<lambda>b. m"] assms by simp
 
 lemma integrable_stretch:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "f integrable_on cbox a b"
     and "\<forall>k\<in>Basis. m k \<noteq> 0"
   shows "(\<lambda>x::'a. f (\<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k)) integrable_on
     ((\<lambda>x. \<Sum>k\<in>Basis. (1 / m k * (x\<bullet>k))*\<^sub>R k) ` cbox a b)"
   using assms unfolding integrable_on_def
   by (force dest: has_integral_stretch)
 
 lemma vec_lambda_eq_sum:
   shows "(\<chi> k. f k (x $ k)) = (\<Sum>k\<in>Basis. (f (axis_index k) (x \<bullet> k)) *\<^sub>R k)"
     apply (simp add: Basis_vec_def cart_eq_inner_axis UNION_singleton_eq_range sum.reindex axis_eq_axis inj_on_def)
     apply (simp add: vec_eq_iff axis_def if_distrib cong: if_cong)
     done
 
 lemma has_integral_stretch_cart:
   fixes m :: "'n::finite \<Rightarrow> real"
   assumes f: "(f has_integral i) (cbox a b)" and m: "\<And>k. m k \<noteq> 0"
   shows "((\<lambda>x. f(\<chi> k. m k * x$k)) has_integral i /\<^sub>R \<bar>prod m UNIV\<bar>)
             ((\<lambda>x. \<chi> k. x$k / m k) ` (cbox a b))"
 proof -
   have *: "\<forall>k:: real^'n \<in> Basis. m (axis_index k) \<noteq> 0"
     using axis_index by (simp add: m)
   have eqp: "(\<Prod>k:: real^'n \<in> Basis. m (axis_index k)) = prod m UNIV"
     by (simp add: Basis_vec_def UNION_singleton_eq_range prod.reindex axis_eq_axis inj_on_def)
   show ?thesis
     using has_integral_stretch [OF f *] vec_lambda_eq_sum [where f="\<lambda>i x. m i * x"] vec_lambda_eq_sum [where f="\<lambda>i x. x / m i"]
     by (simp add: field_simps eqp)
 qed
 
 lemma image_stretch_interval_cart:
   fixes m :: "'n::finite \<Rightarrow> real"
   shows "(\<lambda>x. \<chi> k. m k * x$k) ` cbox a b =
             (if cbox a b = {} then {}
             else cbox (\<chi> k. min (m k * a$k) (m k * b$k)) (\<chi> k. max (m k * a$k) (m k * b$k)))"
 proof -
   have *: "(\<Sum>k\<in>Basis. min (m (axis_index k) * (a \<bullet> k)) (m (axis_index k) * (b \<bullet> k)) *\<^sub>R k)
            = (\<chi> k. min (m k * a $ k) (m k * b $ k))"
           "(\<Sum>k\<in>Basis. max (m (axis_index k) * (a \<bullet> k)) (m (axis_index k) * (b \<bullet> k)) *\<^sub>R k)
            = (\<chi> k. max (m k * a $ k) (m k * b $ k))"
     apply (simp_all add: Basis_vec_def cart_eq_inner_axis UNION_singleton_eq_range sum.reindex axis_eq_axis inj_on_def)
     apply (simp_all add: vec_eq_iff axis_def if_distrib cong: if_cong)
     done
   show ?thesis
     by (simp add: vec_lambda_eq_sum [where f="\<lambda>i x. m i * x"] image_stretch_interval eq_cbox *)
 qed
 
 
 subsection \<open>even more special cases\<close>
 
 lemma uminus_interval_vector[simp]:
   fixes a b :: "'a::euclidean_space"
   shows "uminus ` cbox a b = cbox (-b) (-a)"
   apply safe
    apply (simp add: mem_box(2))
   apply (rule_tac x="-x" in image_eqI)
    apply (auto simp add: mem_box)
   done
 
 lemma has_integral_reflect_lemma[intro]:
   assumes "(f has_integral i) (cbox a b)"
   shows "((\<lambda>x. f(-x)) has_integral i) (cbox (-b) (-a))"
   using has_integral_affinity[OF assms, of "-1" 0]
   by auto
 
 lemma has_integral_reflect_lemma_real[intro]:
   assumes "(f has_integral i) {a..b::real}"
   shows "((\<lambda>x. f(-x)) has_integral i) {-b .. -a}"
   using assms
   unfolding box_real[symmetric]
   by (rule has_integral_reflect_lemma)
 
 lemma has_integral_reflect[simp]:
   "((\<lambda>x. f (-x)) has_integral i) (cbox (-b) (-a)) \<longleftrightarrow> (f has_integral i) (cbox a b)"
   by (auto dest: has_integral_reflect_lemma)
 
 lemma has_integral_reflect_real[simp]:
   fixes a b::real
   shows "((\<lambda>x. f (-x)) has_integral i) {-b..-a} \<longleftrightarrow> (f has_integral i) {a..b}"
   by (metis has_integral_reflect interval_cbox)
 
 lemma integrable_reflect[simp]: "(\<lambda>x. f(-x)) integrable_on cbox (-b) (-a) \<longleftrightarrow> f integrable_on cbox a b"
   unfolding integrable_on_def by auto
 
 lemma integrable_reflect_real[simp]: "(\<lambda>x. f(-x)) integrable_on {-b .. -a} \<longleftrightarrow> f integrable_on {a..b::real}"
   unfolding box_real[symmetric]
   by (rule integrable_reflect)
 
 lemma integral_reflect[simp]: "integral (cbox (-b) (-a)) (\<lambda>x. f (-x)) = integral (cbox a b) f"
   unfolding integral_def by auto
 
 lemma integral_reflect_real[simp]: "integral {-b .. -a} (\<lambda>x. f (-x)) = integral {a..b::real} f"
   unfolding box_real[symmetric]
   by (rule integral_reflect)
 
 subsection \<open>Stronger form of FCT; quite a tedious proof\<close>
 
 lemma split_minus[simp]: "(\<lambda>(x, k). f x k) x - (\<lambda>(x, k). g x k) x = (\<lambda>(x, k). f x k - g x k) x"
   by (simp add: split_def)
 
 theorem fundamental_theorem_of_calculus_interior:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "a \<le> b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
   shows "(f' has_integral (f b - f a)) {a..b}"
 proof (cases "a = b")
   case True
   then have *: "cbox a b = {b}" "f b - f a = 0"
     by (auto simp add:  order_antisym)
   with True show ?thesis by auto
 next
   case False
   with \<open>a \<le> b\<close> have ab: "a < b" by arith
   show ?thesis
     unfolding has_integral_factor_content_real
   proof (intro allI impI)
     fix e :: real
     assume e: "e > 0"
     then have eba8: "(e * (b-a)) / 8 > 0"
       using ab by (auto simp add: field_simps)
     note derf_exp = derf[unfolded has_vector_derivative_def has_derivative_at_alt]
     have bounded: "\<And>x. x \<in> {a<..<b} \<Longrightarrow> bounded_linear (\<lambda>u. u *\<^sub>R f' x)"
       using derf_exp by simp
     have "\<forall>x \<in> box a b. \<exists>d>0. \<forall>y. norm (y-x) < d \<longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
       (is "\<forall>x \<in> box a b. ?Q x")
     proof
       fix x assume x: "x \<in> box a b"
       show "?Q x"
         apply (rule allE [where x="e/2", OF derf_exp [THEN conjunct2, of x]])
         using x e by auto
     qed
     from this [unfolded bgauge_existence_lemma]
     obtain d where d: "\<And>x. 0 < d x"
       "\<And>x y. \<lbrakk>x \<in> box a b; norm (y-x) < d x\<rbrakk>
                \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
       by metis
     have "bounded (f ` cbox a b)"
       using compact_cbox assms by (auto simp: compact_imp_bounded compact_continuous_image)
     then obtain B 
       where "0 < B" and B: "\<And>x. x \<in> f ` cbox a b \<Longrightarrow> norm x \<le> B"
       unfolding bounded_pos by metis
     obtain da where "0 < da"
       and da: "\<And>c. \<lbrakk>a \<le> c; {a..c} \<subseteq> {a..b}; {a..c} \<subseteq> ball a da\<rbrakk>
                           \<Longrightarrow> norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> (e * (b-a)) / 4"
     proof -
       have "continuous (at a within {a..b}) f"
         using contf continuous_on_eq_continuous_within by force
       with eba8 obtain k where "0 < k"
         and k: "\<And>x. \<lbrakk>x \<in> {a..b}; 0 < norm (x-a); norm (x-a) < k\<rbrakk> \<Longrightarrow> norm (f x - f a) < e * (b-a) / 8"
         unfolding continuous_within Lim_within dist_norm by metis
       obtain l where l: "0 < l" "norm (l *\<^sub>R f' a) \<le> e * (b-a) / 8" 
       proof (cases "f' a = 0")
         case True with ab e that show ?thesis by auto
       next
         case False
         then show ?thesis
           apply (rule_tac l="(e * (b-a)) / 8 / norm (f' a)" in that)
           using ab e apply (auto simp add: field_simps)
           done
       qed
       have "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b-a) / 4"
         if "a \<le> c" "{a..c} \<subseteq> {a..b}" and bmin: "{a..c} \<subseteq> ball a (min k l)" for c
       proof -
         have minkl: "\<bar>a - x\<bar> < min k l" if "x \<in> {a..c}" for x
           using bmin dist_real_def that by auto
         then have lel: "\<bar>c - a\<bar> \<le> \<bar>l\<bar>"
           using that by force
         have "norm ((c - a) *\<^sub>R f' a - (f c - f a)) \<le> norm ((c - a) *\<^sub>R f' a) + norm (f c - f a)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> e * (b-a) / 8 + e * (b-a) / 8"
         proof (rule add_mono)
           have "norm ((c - a) *\<^sub>R f' a) \<le> norm (l *\<^sub>R f' a)"
             by (auto intro: mult_right_mono [OF lel])
           also have "... \<le> e * (b-a) / 8"
             by (rule l)
           finally show "norm ((c - a) *\<^sub>R f' a) \<le> e * (b-a) / 8" .
         next
           have "norm (f c - f a) < e * (b-a) / 8"
           proof (cases "a = c")
             case True then show ?thesis
               using eba8 by auto
           next
             case False show ?thesis
               by (rule k) (use minkl \<open>a \<le> c\<close> that False in auto)
           qed
           then show "norm (f c - f a) \<le> e * (b-a) / 8" by simp
         qed
         finally show "norm (content {a..c} *\<^sub>R f' a - (f c - f a)) \<le> e * (b-a) / 4"
           unfolding content_real[OF \<open>a \<le> c\<close>] by auto
       qed
       then show ?thesis
         by (rule_tac da="min k l" in that) (auto simp: l \<open>0 < k\<close>)
     qed
     obtain db where "0 < db"
       and db: "\<And>c. \<lbrakk>c \<le> b; {c..b} \<subseteq> {a..b}; {c..b} \<subseteq> ball b db\<rbrakk>
                           \<Longrightarrow> norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> (e * (b-a)) / 4"
     proof -
       have "continuous (at b within {a..b}) f"
         using contf continuous_on_eq_continuous_within by force
       with eba8 obtain k
         where "0 < k"
           and k: "\<And>x. \<lbrakk>x \<in> {a..b}; 0 < norm(x-b); norm(x-b) < k\<rbrakk>
                      \<Longrightarrow> norm (f b - f x) < e * (b-a) / 8"
         unfolding continuous_within Lim_within dist_norm norm_minus_commute by metis
       obtain l where l: "0 < l" "norm (l *\<^sub>R f' b) \<le> (e * (b-a)) / 8"
       proof (cases "f' b = 0")
         case True thus ?thesis 
           using ab e that by auto
       next
         case False then show ?thesis
           apply (rule_tac l="(e * (b-a)) / 8 / norm (f' b)" in that)
           using ab e by (auto simp add: field_simps)
       qed
       have "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b-a) / 4" 
         if "c \<le> b" "{c..b} \<subseteq> {a..b}" and bmin: "{c..b} \<subseteq> ball b (min k l)" for c
       proof -
         have minkl: "\<bar>b - x\<bar> < min k l" if "x \<in> {c..b}" for x
           using bmin dist_real_def that by auto
         then have lel: "\<bar>b - c\<bar> \<le> \<bar>l\<bar>"
           using that by force
         have "norm ((b - c) *\<^sub>R f' b - (f b - f c)) \<le> norm ((b - c) *\<^sub>R f' b) + norm (f b - f c)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> e * (b-a) / 8 + e * (b-a) / 8"
         proof (rule add_mono)
           have "norm ((b - c) *\<^sub>R f' b) \<le> norm (l *\<^sub>R f' b)"
             by (auto intro: mult_right_mono [OF lel])
           also have "... \<le> e * (b-a) / 8"
             by (rule l)
           finally show "norm ((b - c) *\<^sub>R f' b) \<le> e * (b-a) / 8" .
         next
           have "norm (f b - f c) < e * (b-a) / 8"
           proof (cases "b = c")
             case True with eba8 show ?thesis
               by auto
           next
             case False show ?thesis
               by (rule k) (use minkl \<open>c \<le> b\<close> that False in auto)
           qed
           then show "norm (f b - f c) \<le> e * (b-a) / 8" by simp
         qed
         finally show "norm (content {c..b} *\<^sub>R f' b - (f b - f c)) \<le> e * (b-a) / 4"
           unfolding content_real[OF \<open>c \<le> b\<close>] by auto
       qed
       then show ?thesis
         by (rule_tac db="min k l" in that) (auto simp: l \<open>0 < k\<close>)
     qed
     let ?d = "(\<lambda>x. ball x (if x=a then da else if x=b then db else d x))"
     show "\<exists>d. gauge d \<and> (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow>
               norm ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b})"
     proof (rule exI, safe)
       show "gauge ?d"
         using ab \<open>db > 0\<close> \<open>da > 0\<close> d(1) by (auto intro: gauge_ball_dependent)
     next
       fix p
       assume ptag: "p tagged_division_of {a..b}" and fine: "?d fine p"
       let ?A = "{t. fst t \<in> {a, b}}"
       note p = tagged_division_ofD[OF ptag]
       have pA: "p = (p \<inter> ?A) \<union> (p - ?A)" "finite (p \<inter> ?A)" "finite (p - ?A)" "(p \<inter> ?A) \<inter> (p - ?A) = {}"
         using ptag fine by auto
       have le_xz: "\<And>w x y z::real. y \<le> z/2 \<Longrightarrow> w - x \<le> z/2 \<Longrightarrow> w + y \<le> x + z"
         by arith
       have non: False if xk: "(x,K) \<in> p" and "x \<noteq> a" "x \<noteq> b"
         and less: "e * (Sup K - Inf K)/2 < norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))"
       for x K
       proof -
         obtain u v where k: "K = cbox u v"
           using p(4) xk by blast
         then have "u \<le> v" and uv: "{u, v} \<subseteq> cbox u v"
           using p(2)[OF xk] by auto
         then have result: "e * (v - u)/2 < norm ((v - u) *\<^sub>R f' x - (f v - f u))"
           using less[unfolded k box_real interval_bounds_real content_real] by auto
         then have "x \<in> box a b"
           using p(2) p(3) \<open>x \<noteq> a\<close> \<open>x \<noteq> b\<close> xk by fastforce
         with d have *: "\<And>y. norm (y-x) < d x 
                 \<Longrightarrow> norm (f y - f x - (y-x) *\<^sub>R f' x) \<le> e/2 * norm (y-x)"
           by metis
         have xd: "norm (u - x) < d x" "norm (v - x) < d x"
           using fineD[OF fine xk] \<open>x \<noteq> a\<close> \<open>x \<noteq> b\<close> uv 
           by (auto simp add: k subset_eq dist_commute dist_real_def)
         have "norm ((v - u) *\<^sub>R f' x - (f v - f u)) =
               norm ((f u - f x - (u - x) *\<^sub>R f' x) - (f v - f x - (v - x) *\<^sub>R f' x))"
           by (rule arg_cong[where f=norm]) (auto simp: scaleR_left.diff)
         also have "\<dots> \<le> e/2 * norm (u - x) + e/2 * norm (v - x)"
           by (metis norm_triangle_le_diff add_mono * xd)
         also have "\<dots> \<le> e/2 * norm (v - u)"
           using p(2)[OF xk] by (auto simp add: field_simps k)
         also have "\<dots> < norm ((v - u) *\<^sub>R f' x - (f v - f u))"
           using result by (simp add: \<open>u \<le> v\<close>)
         finally have "e * (v - u)/2 < e * (v - u)/2"
           using uv by auto
         then show False by auto
       qed
       have "norm (\<Sum>(x, K)\<in>p - ?A. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
           \<le> (\<Sum>(x, K)\<in>p - ?A. norm (content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))))"
         by (auto intro: sum_norm_le)
       also have "... \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k)/2)"
         using non by (fastforce intro: sum_mono)
       finally have I: "norm (\<Sum>(x, k)\<in>p - ?A.
                   content k *\<^sub>R f' x - (f (Sup k) - f (Inf k)))
              \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
         by (simp add: sum_divide_distrib)
       have II: "norm (\<Sum>(x, k)\<in>p \<inter> ?A. content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) -
              (\<Sum>n\<in>p \<inter> ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))
              \<le> (\<Sum>n\<in>p - ?A. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
       proof -
         have ge0: "0 \<le> e * (Sup k - Inf k)" if xkp: "(x, k) \<in> p \<inter> ?A" for x k
         proof -
           obtain u v where uv: "k = cbox u v"
             by (meson Int_iff xkp p(4))
           with p(2) that uv have "cbox u v \<noteq> {}"
             by blast
           then show "0 \<le> e * ((Sup k) - (Inf k))"
             unfolding uv using e by (auto simp add: field_simps)
         qed
         let ?B = "\<lambda>x. {t \<in> p. fst t = x \<and> content (snd t) \<noteq> 0}"
         let ?C = "{t \<in> p. fst t \<in> {a, b} \<and> content (snd t) \<noteq> 0}"
         have "norm (\<Sum>(x, k)\<in>p \<inter> {t. fst t \<in> {a, b}}. content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le> e * (b-a)/2"
         proof -
           have *: "\<And>S f e. sum f S = sum f (p \<inter> ?C) \<Longrightarrow> norm (sum f (p \<inter> ?C)) \<le> e \<Longrightarrow> norm (sum f S) \<le> e"
             by auto
           have 1: "content K *\<^sub>R (f' x) - (f ((Sup K)) - f ((Inf K))) = 0"
             if "(x,K) \<in> p \<inter> {t. fst t \<in> {a, b}} - p \<inter> ?C" for x K
           proof -
             have xk: "(x,K) \<in> p" and k0: "content K = 0"
               using that by auto
             then obtain u v where uv: "K = cbox u v"
               using p(4) by blast
             then have "u = v"
               using xk k0 p(2) by force
             then show "content K *\<^sub>R (f' x) - (f ((Sup K)) - f ((Inf K))) = 0"
               using xk unfolding uv by auto
           qed
           have 2: "norm(\<Sum>(x,K)\<in>p \<inter> ?C. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))  \<le> e * (b-a)/2"
           proof -
             have norm_le: "norm (sum f S) \<le> e"
               if "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x = y" "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> e" "e > 0"
               for S f and e :: real
             proof (cases "S = {}")
               case True
               with that show ?thesis by auto
             next
               case False then obtain x where "x \<in> S"
                 by auto
               then have "S = {x}"
                 using that(1) by auto
               then show ?thesis
                 using \<open>x \<in> S\<close> that(2) by auto
             qed
             have *: "p \<inter> ?C = ?B a \<union> ?B b"
               by blast
             then have "norm (\<Sum>(x,K)\<in>p \<inter> ?C. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) =
                        norm (\<Sum>(x,K) \<in> ?B a \<union> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))"
               by simp
             also have "... = norm ((\<Sum>(x,K) \<in> ?B a. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) + 
                                    (\<Sum>(x,K) \<in> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))))"
               apply (subst sum.union_disjoint)
               using p(1) ab e by auto
             also have "... \<le> e * (b - a) / 4 + e * (b - a) / 4"
             proof (rule norm_triangle_le [OF add_mono])
               have pa: "\<exists>v. k = cbox a v \<and> a \<le> v" if "(a, k) \<in> p" for k
                 using p(2) p(3) p(4) that by fastforce
               show "norm (\<Sum>(x,K) \<in> ?B a. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (b - a) / 4"
               proof (intro norm_le; clarsimp)
                 fix K K'
                 assume K: "(a, K) \<in> p" "(a, K') \<in> p" and ne0: "content K \<noteq> 0" "content K' \<noteq> 0"
                 with pa obtain v v' where v: "K = cbox a v" "a \<le> v" and v': "K' = cbox a v'" "a \<le> v'"
                   by blast
                 let ?v = "min v v'"
                 have "box a ?v \<subseteq> K \<inter> K'"
                   unfolding v v' by (auto simp add: mem_box)
                 then have "interior (box a (min v v')) \<subseteq> interior K \<inter> interior K'"
                   using interior_Int interior_mono by blast
                 moreover have "(a + ?v)/2 \<in> box a ?v"
                   using ne0  unfolding v v' content_eq_0 not_le
                   by (auto simp add: mem_box)
                 ultimately have "(a + ?v)/2 \<in> interior K \<inter> interior K'"
                   unfolding interior_open[OF open_box] by auto
                 then show "K = K'"
                   using p(5)[OF K] by auto
               next
                 fix K 
                 assume K: "(a, K) \<in> p" and ne0: "content K \<noteq> 0"
                 show "norm (content c *\<^sub>R f' a - (f (Sup c) - f (Inf c))) * 4 \<le> e * (b-a)"
                   if "(a, c) \<in> p" and ne0: "content c \<noteq> 0" for c
                 proof -
                   obtain v where v: "c = cbox a v" and "a \<le> v"
                     using pa[OF \<open>(a, c) \<in> p\<close>] by metis 
                   then have "a \<in> {a..v}" "v \<le> b"
                     using p(3)[OF \<open>(a, c) \<in> p\<close>] by auto
                   moreover have "{a..v} \<subseteq> ball a da"
                     using fineD[OF \<open>?d fine p\<close> \<open>(a, c) \<in> p\<close>] by (simp add: v split: if_split_asm)
                   ultimately show ?thesis
                     unfolding v interval_bounds_real[OF \<open>a \<le> v\<close>] box_real
                     using da \<open>a \<le> v\<close> by auto
                 qed
               qed (use ab e in auto)
             next
               have pb: "\<exists>v. k = cbox v b \<and> b \<ge> v" if "(b, k) \<in> p" for k
                 using p(2) p(3) p(4) that by fastforce
               show "norm (\<Sum>(x,K) \<in> ?B b. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K))) \<le> e * (b - a) / 4"
               proof (intro norm_le; clarsimp)
                 fix K K'
                 assume K: "(b, K) \<in> p" "(b, K') \<in> p" and ne0: "content K \<noteq> 0" "content K' \<noteq> 0"
                 with pb obtain v v' where v: "K = cbox v b" "v \<le> b" and v': "K' = cbox v' b" "v' \<le> b"
                   by blast
                 let ?v = "max v v'"
                 have "box ?v b \<subseteq> K \<inter> K'"
                   unfolding v v' by (auto simp: mem_box)
                 then have "interior (box (max v v') b) \<subseteq> interior K \<inter> interior K'"
                   using interior_Int interior_mono by blast
                 moreover have " ((b + ?v)/2) \<in> box ?v b"
                   using ne0 unfolding v v' content_eq_0 not_le by (auto simp: mem_box)
                 ultimately have "((b + ?v)/2) \<in> interior K \<inter> interior K'"
                   unfolding interior_open[OF open_box] by auto
                 then show "K = K'"
                   using p(5)[OF K] by auto
               next
                 fix K 
                 assume K: "(b, K) \<in> p" and ne0: "content K \<noteq> 0"
                 show "norm (content c *\<^sub>R f' b - (f (Sup c) - f (Inf c))) * 4 \<le> e * (b-a)"
                   if "(b, c) \<in> p" and ne0: "content c \<noteq> 0" for c
                 proof -
                 obtain v where v: "c = cbox v b" and "v \<le> b"
                   using \<open>(b, c) \<in> p\<close> pb by blast
                 then have "v \<ge> a""b \<in> {v.. b}"  
                   using p(3)[OF \<open>(b, c) \<in> p\<close>] by auto
                 moreover have "{v..b} \<subseteq> ball b db"
                   using fineD[OF \<open>?d fine p\<close> \<open>(b, c) \<in> p\<close>] box_real(2) v False by force
                 ultimately show ?thesis
                   using db v by auto
                 qed
               qed (use ab e in auto)
             qed
             also have "... = e * (b-a)/2"
               by simp
             finally show "norm (\<Sum>(x,k)\<in>p \<inter> ?C.
                         content k *\<^sub>R f' x - (f (Sup k) - f (Inf k))) \<le> e * (b-a)/2" .
           qed
           show "norm (\<Sum>(x, k)\<in>p \<inter> ?A. content k *\<^sub>R f' x - (f ((Sup k)) - f ((Inf k)))) \<le> e * (b-a)/2"
             apply (rule * [OF sum.mono_neutral_right[OF pA(2)]])
             using 1 2 by (auto simp: split_paired_all)
         qed
         also have "... = (\<Sum>n\<in>p. e * (case n of (x, k) \<Rightarrow> Sup k - Inf k))/2"
           unfolding sum_distrib_left[symmetric]
           apply (subst additive_tagged_division_1[OF \<open>a \<le> b\<close> ptag])
           by auto
         finally have norm_le: "norm (\<Sum>(x,K)\<in>p \<inter> {t. fst t \<in> {a, b}}. content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
                 \<le> (\<Sum>n\<in>p. e * (case n of (x, K) \<Rightarrow> Sup K - Inf K))/2" .
         have le2: "\<And>x s1 s2::real. 0 \<le> s1 \<Longrightarrow> x \<le> (s1 + s2)/2 \<Longrightarrow> x - s1 \<le> s2/2"
           by auto
         show ?thesis
           apply (rule le2 [OF sum_nonneg])
           using ge0 apply force
           unfolding sum.union_disjoint[OF pA(2-), symmetric] pA(1)[symmetric]
           by (metis norm_le)
       qed
       note * = additive_tagged_division_1[OF assms(1) ptag, symmetric]
       have "norm (\<Sum>(x,K)\<in>p \<inter> ?A \<union> (p - ?A). content K *\<^sub>R f' x - (f (Sup K) - f (Inf K)))
                \<le> e * (\<Sum>(x,K)\<in>p \<inter> ?A \<union> (p - ?A). Sup K - Inf K)"
         unfolding sum_distrib_left
         unfolding sum.union_disjoint[OF pA(2-)]
         using le_xz norm_triangle_le I II by blast
       then
       show "norm ((\<Sum>(x,K)\<in>p. content K *\<^sub>R f' x) - (f b - f a)) \<le> e * content {a..b}"
         by (simp only: content_real[OF \<open>a \<le> b\<close>] *[of "\<lambda>x. x"] *[of f] sum_subtractf[symmetric] split_minus pA(1) [symmetric])
     qed
   qed
 qed
 
 
 subsection \<open>Stronger form with finite number of exceptional points\<close>
 
 lemma fundamental_theorem_of_calculus_interior_strong:
  fixes f :: "real \<Rightarrow> 'a::banach"
  assumes "finite S"
    and "a \<le> b" "\<And>x. x \<in> {a <..< b} - S \<Longrightarrow> (f has_vector_derivative f'(x)) (at x)"
    and "continuous_on {a .. b} f"
  shows "(f' has_integral (f b - f a)) {a .. b}"
   using assms
 proof (induction arbitrary: a b)
 case empty
   then show ?case
     using fundamental_theorem_of_calculus_interior by force
 next
 case (insert x S)
   show ?case
   proof (cases "x \<in> {a<..<b}")
     case False then show ?thesis
       using insert by blast
   next
     case True then have "a < x" "x < b"
       by auto
     have "(f' has_integral f x - f a) {a..x}" "(f' has_integral f b - f x) {x..b}"
       using \<open>continuous_on {a..b} f\<close> \<open>a < x\<close> \<open>x < b\<close> continuous_on_subset by (force simp: intro!: insert)+
     then have "(f' has_integral f x - f a + (f b - f x)) {a..b}"
       using \<open>a < x\<close> \<open>x < b\<close> has_integral_combine less_imp_le by blast
     then show ?thesis
       by simp
   qed
 qed
 
 corollary fundamental_theorem_of_calculus_strong:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "finite S"
     and "a \<le> b"
     and vec: "\<And>x. x \<in> {a..b} - S \<Longrightarrow> (f has_vector_derivative f'(x)) (at x)"
     and "continuous_on {a..b} f"
   shows "(f' has_integral (f b - f a)) {a..b}"
   by (rule fundamental_theorem_of_calculus_interior_strong [OF \<open>finite S\<close>]) (force simp: assms)+
 
 proposition indefinite_integral_continuous_left:
   fixes f:: "real \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on {a..b}" and "a < c" "c \<le> b" "e > 0"
   obtains d where "d > 0"
     and "\<forall>t. c - d < t \<and> t \<le> c \<longrightarrow> norm (integral {a..c} f - integral {a..t} f) < e"
 proof -
   obtain w where "w > 0" and w: "\<And>t. \<lbrakk>c - w < t; t < c\<rbrakk> \<Longrightarrow> norm (f c) * norm(c - t) < e/3"
   proof (cases "f c = 0")
     case False
     hence e3: "0 < e/3 / norm (f c)" using \<open>e>0\<close> by simp
     moreover have "norm (f c) * norm (c - t) < e/3" 
       if "t < c" and "c - e/3 / norm (f c) < t" for t
     proof -
       have "norm (c - t) < e/3 / norm (f c)"
         using that by auto
       then show "norm (f c) * norm (c - t) < e/3"
         by (metis e3 mult.commute norm_not_less_zero pos_less_divide_eq zero_less_divide_iff)
     qed
     ultimately show ?thesis
       using that by auto
   next
     case True then show ?thesis
       using \<open>e > 0\<close> that by auto
   qed
 
   let ?SUM = "\<lambda>p. (\<Sum>(x,K) \<in> p. content K *\<^sub>R f x)"
   have e3: "e/3 > 0"
     using \<open>e > 0\<close> by auto
   have "f integrable_on {a..c}"
     apply (rule integrable_subinterval_real[OF intf])
     using \<open>a < c\<close> \<open>c \<le> b\<close> by auto
   then obtain d1 where "gauge d1" and d1:
     "\<And>p. \<lbrakk>p tagged_division_of {a..c}; d1 fine p\<rbrakk> \<Longrightarrow> norm (?SUM p - integral {a..c} f) < e/3"
     using integrable_integral has_integral_real e3 by metis
   define d where [abs_def]: "d x = ball x w \<inter> d1 x" for x
   have "gauge d"
     unfolding d_def using \<open>w > 0\<close> \<open>gauge d1\<close> by auto
   then obtain k where "0 < k" and k: "ball c k \<subseteq> d c"
     by (meson gauge_def open_contains_ball)
 
   let ?d = "min k (c - a)/2"
   show thesis
   proof (intro that[of ?d] allI impI, safe)
     show "?d > 0"
       using \<open>0 < k\<close> \<open>a < c\<close> by auto
   next
     fix t
     assume t: "c - ?d < t" "t \<le> c"
     show "norm (integral ({a..c}) f - integral ({a..t}) f) < e"
     proof (cases "t < c")
       case False with \<open>t \<le> c\<close> show ?thesis
         by (simp add: \<open>e > 0\<close>)
     next
       case True
       have "f integrable_on {a..t}"
         apply (rule integrable_subinterval_real[OF intf])
         using \<open>t < c\<close> \<open>c \<le> b\<close> by auto
       then obtain d2 where d2: "gauge d2"
         "\<And>p. p tagged_division_of {a..t} \<and> d2 fine p \<Longrightarrow> norm (?SUM p - integral {a..t} f) < e/3"
         using integrable_integral has_integral_real e3 by metis
       define d3 where "d3 x = (if x \<le> t then d1 x \<inter> d2 x else d1 x)" for x
       have "gauge d3"
         using \<open>gauge d1\<close> \<open>gauge d2\<close> unfolding d3_def gauge_def by auto
       then obtain p where ptag: "p tagged_division_of {a..t}" and pfine: "d3 fine p"
         by (metis box_real(2) fine_division_exists)
       note p' = tagged_division_ofD[OF ptag]
       have pt: "(x,K)\<in>p \<Longrightarrow> x \<le> t" for x K
         by (meson atLeastAtMost_iff p'(2) p'(3) subsetCE)
       with pfine have "d2 fine p"
         unfolding fine_def d3_def by fastforce
       then have d2_fin: "norm (?SUM p - integral {a..t} f) < e/3"
         using d2(2) ptag by auto
       have eqs: "{a..c} \<inter> {x. x \<le> t} = {a..t}" "{a..c} \<inter> {x. x \<ge> t} = {t..c}"
         using t by (auto simp add: field_simps)
       have "p \<union> {(c, {t..c})} tagged_division_of {a..c}"
         apply (rule tagged_division_Un_interval_real[of _ _ _ 1 "t"])
         using  \<open>t \<le> c\<close> by (auto simp: eqs ptag tagged_division_of_self_real)
       moreover
       have "d1 fine p \<union> {(c, {t..c})}"
         unfolding fine_def
       proof safe
         fix x K y
         assume "(x,K) \<in> p" and "y \<in> K" then show "y \<in> d1 x"
           by (metis Int_iff d3_def subsetD fineD pfine)
       next
         fix x assume "x \<in> {t..c}"
         then have "dist c x < k"
           using t(1) by (auto simp add: field_simps dist_real_def)
         with k show "x \<in> d1 c"
           unfolding d_def by auto
       qed  
       ultimately have d1_fin: "norm (?SUM(p \<union> {(c, {t..c})}) - integral {a..c} f) < e/3"
         using d1 by metis
       have SUMEQ: "?SUM(p \<union> {(c, {t..c})}) = (c - t) *\<^sub>R f c + ?SUM p"
       proof -
         have "?SUM(p \<union> {(c, {t..c})}) = (content{t..c} *\<^sub>R f c) + ?SUM p"
         proof (subst sum.union_disjoint)
           show "p \<inter> {(c, {t..c})} = {}"
             using \<open>t < c\<close> pt by force
         qed (use p'(1) in auto)
         also have "... = (c - t) *\<^sub>R f c + ?SUM p"
           using \<open>t \<le> c\<close> by auto
         finally show ?thesis .
       qed
       have "c - k < t"
         using \<open>k>0\<close> t(1) by (auto simp add: field_simps)
       moreover have "k \<le> w"
       proof (rule ccontr)
         assume "\<not> k \<le> w"
         then have "c + (k + w) / 2 \<notin> d c"
           by (auto simp add: field_simps not_le not_less dist_real_def d_def)
         then have "c + (k + w) / 2 \<notin> ball c k"
           using k by blast
         then show False
           using \<open>0 < w\<close> \<open>\<not> k \<le> w\<close> dist_real_def by auto
       qed
       ultimately have cwt: "c - w < t"
         by (auto simp add: field_simps)
       have eq: "integral {a..c} f - integral {a..t} f = -(((c - t) *\<^sub>R f c + ?SUM p) -
              integral {a..c} f) + (?SUM p - integral {a..t} f) + (c - t) *\<^sub>R f c"
         by auto
       have "norm (integral {a..c} f - integral {a..t} f) < e/3 + e/3 + e/3"
         unfolding eq
       proof (intro norm_triangle_lt add_strict_mono)
         show "norm (- ((c - t) *\<^sub>R f c + ?SUM p - integral {a..c} f)) < e/3"
           by (metis SUMEQ d1_fin norm_minus_cancel)
         show "norm (?SUM p - integral {a..t} f) < e/3"
           using d2_fin by blast
         show "norm ((c - t) *\<^sub>R f c) < e/3"
           using w cwt \<open>t < c\<close> by simp (simp add: field_simps)
       qed
       then show ?thesis by simp
     qed
   qed
 qed
 
 lemma indefinite_integral_continuous_right:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
     and "a \<le> c"
     and "c < b"
     and "e > 0"
   obtains d where "0 < d"
     and "\<forall>t. c \<le> t \<and> t < c + d \<longrightarrow> norm (integral {a..c} f - integral {a..t} f) < e"
 proof -
   have intm: "(\<lambda>x. f (- x)) integrable_on {-b .. -a}" "- b < - c" "- c \<le> - a"
     using assms by auto
   from indefinite_integral_continuous_left[OF intm \<open>e>0\<close>]
   obtain d where "0 < d"
     and d: "\<And>t. \<lbrakk>- c - d < t; t \<le> -c\<rbrakk> 
              \<Longrightarrow> norm (integral {- b..- c} (\<lambda>x. f (-x)) - integral {- b..t} (\<lambda>x. f (-x))) < e"
     by metis
   let ?d = "min d (b - c)" 
   show ?thesis
   proof (intro that[of "?d"] allI impI)
     show "0 < ?d"
       using \<open>0 < d\<close> \<open>c < b\<close> by auto
     fix t :: real
     assume t: "c \<le> t \<and> t < c + ?d"
     have *: "integral {a..c} f = integral {a..b} f - integral {c..b} f"
             "integral {a..t} f = integral {a..b} f - integral {t..b} f"
       apply (simp_all only: algebra_simps)
       using assms t by (auto simp: integral_combine)
     have "(- c) - d < (- t)" "- t \<le> - c"
       using t by auto 
     from d[OF this] show "norm (integral {a..c} f - integral {a..t} f) < e"
       by (auto simp add: algebra_simps norm_minus_commute *)
   qed
 qed
 
 lemma indefinite_integral_continuous_1:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
   shows "continuous_on {a..b} (\<lambda>x. integral {a..x} f)"
 proof -
   have "\<exists>d>0. \<forall>x'\<in>{a..b}. dist x' x < d \<longrightarrow> dist (integral {a..x'} f) (integral {a..x} f) < e" 
        if x: "x \<in> {a..b}" and "e > 0" for x e :: real
   proof (cases "a = b")
     case True
     with that show ?thesis by force
   next
     case False
     with x have "a < b" by force
     with x consider "x = a" | "x = b" | "a < x" "x < b"
       by force
     then show ?thesis 
     proof cases
       case 1 show ?thesis
         apply (rule indefinite_integral_continuous_right [OF assms _ \<open>a < b\<close> \<open>e > 0\<close>], force)
         using \<open>x = a\<close> apply (force simp: dist_norm algebra_simps)
         done
     next
       case 2 show ?thesis 
         apply (rule indefinite_integral_continuous_left [OF assms \<open>a < b\<close> _ \<open>e > 0\<close>], force)
         using \<open>x = b\<close> apply (force simp: dist_norm norm_minus_commute algebra_simps)
         done
     next
       case 3
       obtain d1 where "0 < d1" 
         and d1: "\<And>t. \<lbrakk>x - d1 < t; t \<le> x\<rbrakk> \<Longrightarrow> norm (integral {a..x} f - integral {a..t} f) < e"
         using 3 by (auto intro: indefinite_integral_continuous_left [OF assms \<open>a < x\<close> _ \<open>e > 0\<close>])
       obtain d2 where "0 < d2" 
         and d2: "\<And>t. \<lbrakk>x \<le> t; t < x + d2\<rbrakk> \<Longrightarrow> norm (integral {a..x} f - integral {a..t} f) < e"
         using 3 by (auto intro: indefinite_integral_continuous_right [OF assms _ \<open>x < b\<close> \<open>e > 0\<close>])
       show ?thesis
       proof (intro exI ballI conjI impI)
         show "0 < min d1 d2"
           using \<open>0 < d1\<close> \<open>0 < d2\<close> by simp
         show "dist (integral {a..y} f) (integral {a..x} f) < e"
              if "y \<in> {a..b}" "dist y x < min d1 d2" for y
         proof (cases "y < x")
           case True
           with that d1 show ?thesis by (auto simp: dist_commute dist_norm)
         next
           case False
           with that d2 show ?thesis
             by (auto simp: dist_commute dist_norm)
         qed
       qed
     qed
   qed
   then show ?thesis
     by (auto simp: continuous_on_iff)
 qed
 
 lemma indefinite_integral_continuous_1':
   fixes f::"real \<Rightarrow> 'a::banach"
   assumes "f integrable_on {a..b}"
   shows "continuous_on {a..b} (\<lambda>x. integral {x..b} f)"
 proof -
   have "integral {a..b} f - integral {a..x} f = integral {x..b} f" if "x \<in> {a..b}" for x
     using integral_combine[OF _ _ assms, of x] that
     by (auto simp: algebra_simps)
   with _ show ?thesis
     by (rule continuous_on_eq) (auto intro!: continuous_intros indefinite_integral_continuous_1 assms)
 qed
 
 theorem integral_has_vector_derivative':
   fixes f :: "real \<Rightarrow> 'b::banach"
   assumes "continuous_on {a..b} f"
     and "x \<in> {a..b}"
   shows "((\<lambda>u. integral {u..b} f) has_vector_derivative - f x) (at x within {a..b})"
 proof -
   have *: "integral {x..b} f = integral {a .. b} f - integral {a .. x} f" if "a \<le> x" "x \<le> b" for x
     using integral_combine[of a x b for x, OF that integrable_continuous_real[OF assms(1)]]
     by (simp add: algebra_simps)
   show ?thesis
     using \<open>x \<in> _\<close> *
     by (rule has_vector_derivative_transform)
       (auto intro!: derivative_eq_intros assms integral_has_vector_derivative)
 qed
 
 lemma integral_has_real_derivative':
   assumes "continuous_on {a..b} g"
   assumes "t \<in> {a..b}"
   shows "((\<lambda>x. integral {x..b} g) has_real_derivative -g t) (at t within {a..b})"
   using integral_has_vector_derivative'[OF assms]
   by (auto simp: has_field_derivative_iff_has_vector_derivative)
 
 
 subsection \<open>This doesn't directly involve integration, but that gives an easy proof\<close>
 
 lemma has_derivative_zero_unique_strong_interval:
   fixes f :: "real \<Rightarrow> 'a::banach"
   assumes "finite k"
     and contf: "continuous_on {a..b} f"
     and "f a = y"
     and fder: "\<And>x. x \<in> {a..b} - k \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within {a..b})"
     and x: "x \<in> {a..b}"
   shows "f x = y"
 proof -
   have "a \<le> b" "a \<le> x"
     using assms by auto
   have "((\<lambda>x. 0::'a) has_integral f x - f a) {a..x}"
   proof (rule fundamental_theorem_of_calculus_interior_strong[OF \<open>finite k\<close> \<open>a \<le> x\<close>]; clarify?)
     have "{a..x} \<subseteq> {a..b}"
       using x by auto
     then show "continuous_on {a..x} f"
       by (rule continuous_on_subset[OF contf])
     show "(f has_vector_derivative 0) (at z)" if z: "z \<in> {a<..<x}" and notin: "z \<notin> k" for z
       unfolding has_vector_derivative_def
     proof (simp add: at_within_open[OF z, symmetric])
       show "(f has_derivative (\<lambda>x. 0)) (at z within {a<..<x})"
         by (rule has_derivative_within_subset [OF fder]) (use x z notin in auto)
     qed
   qed
   from has_integral_unique[OF has_integral_0 this]
   show ?thesis
     unfolding assms by auto
 qed
 
 
 subsection \<open>Generalize a bit to any convex set\<close>
 
 lemma has_derivative_zero_unique_strong_convex:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "convex S" "finite K"
     and contf: "continuous_on S f"
     and "c \<in> S" "f c = y"
     and derf: "\<And>x. x \<in> S - K \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within S)"
     and "x \<in> S"
   shows "f x = y"
 proof (cases "x = c")
   case True with \<open>f c = y\<close> show ?thesis
     by blast
 next
   case False
   let ?\<phi> = "\<lambda>u. (1 - u) *\<^sub>R c + u *\<^sub>R x"
   have contf': "continuous_on {0 ..1} (f \<circ> ?\<phi>)"
   proof (rule continuous_intros continuous_on_subset[OF contf])+
     show "(\<lambda>u. (1 - u) *\<^sub>R c + u *\<^sub>R x) ` {0..1} \<subseteq> S"
       using \<open>convex S\<close> \<open>x \<in> S\<close> \<open>c \<in> S\<close> by (auto simp add: convex_alt algebra_simps)
   qed
   have "t = u" if "?\<phi> t = ?\<phi> u" for t u
   proof -
     from that have "(t - u) *\<^sub>R x = (t - u) *\<^sub>R c"
       by (auto simp add: algebra_simps)
     then show ?thesis
       using \<open>x \<noteq> c\<close> by auto
   qed
   then have eq: "(SOME t. ?\<phi> t = ?\<phi> u) = u" for u
     by blast
   then have "(?\<phi> -` K) \<subseteq> (\<lambda>z. SOME t. ?\<phi> t = z) ` K"
     by (clarsimp simp: image_iff) (metis (no_types) eq)
   then have fin: "finite (?\<phi> -` K)"
     by (rule finite_surj[OF \<open>finite K\<close>])
 
   have derf': "((\<lambda>u. f (?\<phi> u)) has_derivative (\<lambda>h. 0)) (at t within {0..1})"
                if "t \<in> {0..1} - {t. ?\<phi> t \<in> K}" for t
   proof -
     have df: "(f has_derivative (\<lambda>h. 0)) (at (?\<phi> t) within ?\<phi> ` {0..1})"
       apply (rule has_derivative_within_subset [OF derf])
       using \<open>convex S\<close> \<open>x \<in> S\<close> \<open>c \<in> S\<close> that by (auto simp add: convex_alt algebra_simps)
     have "(f \<circ> ?\<phi> has_derivative (\<lambda>x. 0) \<circ> (\<lambda>z. (0 - z *\<^sub>R c) + z *\<^sub>R x)) (at t within {0..1})"
       by (rule derivative_eq_intros df | simp)+
     then show ?thesis
       unfolding o_def .
   qed
   have "(f \<circ> ?\<phi>) 1 = y"
     apply (rule has_derivative_zero_unique_strong_interval[OF fin contf'])
     unfolding o_def using \<open>f c = y\<close> derf' by auto
   then show ?thesis
     by auto
 qed
 
 
 text \<open>Also to any open connected set with finite set of exceptions. Could
  generalize to locally convex set with limpt-free set of exceptions.\<close>
 
 lemma has_derivative_zero_unique_strong_connected:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "connected S"
     and "open S"
     and "finite K"
     and contf: "continuous_on S f"
     and "c \<in> S"
     and "f c = y"
     and derf: "\<And>x. x \<in> S - K \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within S)"
     and "x \<in> S"
   shows "f x = y"
 proof -
   have "\<exists>e>0. ball x e \<subseteq> (S \<inter> f -` {f x})" if "x \<in> S" for x
   proof -
     obtain e where "0 < e" and e: "ball x e \<subseteq> S"
       using \<open>x \<in> S\<close> \<open>open S\<close> open_contains_ball by blast
     have "ball x e \<subseteq> {u \<in> S. f u \<in> {f x}}"
     proof safe
       fix y
       assume y: "y \<in> ball x e"
       then show "y \<in> S"
         using e by auto
       show "f y = f x"
       proof (rule has_derivative_zero_unique_strong_convex[OF convex_ball \<open>finite K\<close>])
         show "continuous_on (ball x e) f"
           using contf continuous_on_subset e by blast
         show "(f has_derivative (\<lambda>h. 0)) (at u within ball x e)"
              if "u \<in> ball x e - K" for u
           by (metis Diff_iff contra_subsetD derf e has_derivative_within_subset that)
       qed (use y e \<open>0 < e\<close> in auto)
     qed
     then show "\<exists>e>0. ball x e \<subseteq> (S \<inter> f -` {f x})"
       using \<open>0 < e\<close> by blast
   qed
   then have "openin (top_of_set S) (S \<inter> f -` {y})"
     by (auto intro!: open_openin_trans[OF \<open>open S\<close>] simp: open_contains_ball)
   moreover have "closedin (top_of_set S) (S \<inter> f -` {y})"
     by (force intro!: continuous_closedin_preimage [OF contf])
   ultimately have "(S \<inter> f -` {y}) = {} \<or> (S \<inter> f -` {y}) = S"
     using \<open>connected S\<close> by (simp add: connected_clopen)
   then show ?thesis
     using \<open>x \<in> S\<close> \<open>f c = y\<close> \<open>c \<in> S\<close> by auto
 qed
 
 lemma has_derivative_zero_connected_constant:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "connected S"
       and "open S"
       and "finite k"
       and "continuous_on S f"
       and "\<forall>x\<in>(S - k). (f has_derivative (\<lambda>h. 0)) (at x within S)"
     obtains c where "\<And>x. x \<in> S \<Longrightarrow> f(x) = c"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (metis empty_iff that)
 next
   case False
   then obtain c where "c \<in> S"
     by (metis equals0I)
   then show ?thesis
     by (metis has_derivative_zero_unique_strong_connected assms that)
 qed
 
 lemma DERIV_zero_connected_constant:
   fixes f :: "'a::{real_normed_field,euclidean_space} \<Rightarrow> 'a"
   assumes "connected S"
       and "open S"
       and "finite K"
       and "continuous_on S f"
       and "\<forall>x\<in>(S - K). DERIV f x :> 0"
     obtains c where "\<And>x. x \<in> S \<Longrightarrow> f(x) = c"
   using has_derivative_zero_connected_constant [OF assms(1-4)] assms
   by (metis DERIV_const has_derivative_const Diff_iff at_within_open frechet_derivative_at has_field_derivative_def)
 
 
 subsection \<open>Integrating characteristic function of an interval\<close>
 
 lemma has_integral_restrict_open_subinterval:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes intf: "(f has_integral i) (cbox c d)"
     and cb: "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> box c d then f x else 0) has_integral i) (cbox a b)"
 proof (cases "cbox c d = {}")
   case True
   then have "box c d = {}"
     by (metis bot.extremum_uniqueI box_subset_cbox)
   then show ?thesis
     using True intf by auto
 next
   case False
   then obtain p where pdiv: "p division_of cbox a b" and inp: "cbox c d \<in> p"
     using cb partial_division_extend_1 by blast
   define g where [abs_def]: "g x = (if x \<in>box c d then f x else 0)" for x
   interpret operative "lift_option plus" "Some (0 :: 'b)"
     "\<lambda>i. if g integrable_on i then Some (integral i g) else None"
     by (fact operative_integralI)
   note operat = division [OF pdiv, symmetric]
   show ?thesis
   proof (cases "(g has_integral i) (cbox a b)")
     case True then show ?thesis
       by (simp add: g_def)
   next
     case False
     have iterate:"F (\<lambda>i. if g integrable_on i then Some (integral i g) else None) (p - {cbox c d}) = Some 0"
     proof (intro neutral ballI)
       fix x
       assume x: "x \<in> p - {cbox c d}"
       then have "x \<in> p"
         by auto
       then obtain u v where uv: "x = cbox u v"
         using pdiv by blast
       have "interior x \<inter> interior (cbox c d) = {}"
         using pdiv inp x by blast 
       then have "(g has_integral 0) x"
         unfolding uv using has_integral_spike_interior[where f="\<lambda>x. 0"]
         by (metis (no_types, lifting) disjoint_iff_not_equal g_def has_integral_0_eq interior_cbox)
       then show "(if g integrable_on x then Some (integral x g) else None) = Some 0"
         by auto
     qed
     interpret comm_monoid_set "lift_option plus" "Some (0 :: 'b)"
       by (intro comm_monoid_set.intro comm_monoid_lift_option add.comm_monoid_axioms)
     have intg: "g integrable_on cbox c d"
       using integrable_spike_interior[where f=f]
       by (meson g_def has_integral_integrable intf)
     moreover have "integral (cbox c d) g = i"
     proof (rule has_integral_unique[OF has_integral_spike_interior intf])
       show "\<And>x. x \<in> box c d \<Longrightarrow> f x = g x"
         by (auto simp: g_def)
       show "(g has_integral integral (cbox c d) g) (cbox c d)"
         by (rule integrable_integral[OF intg])
     qed
     ultimately have "F (\<lambda>A. if g integrable_on A then Some (integral A g) else None) p = Some i"
       by (metis (full_types, lifting) division_of_finite inp iterate pdiv remove right_neutral)
     then
     have "(g has_integral i) (cbox a b)"
       by (metis integrable_on_def integral_unique operat option.inject option.simps(3))
     with False show ?thesis
       by blast
   qed
 qed
 
 
 lemma has_integral_restrict_closed_subinterval:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "(f has_integral i) (cbox c d)"
     and "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b)"
 proof -
   note has_integral_restrict_open_subinterval[OF assms]
   note * = has_integral_spike[OF negligible_frontier_interval _ this]
   show ?thesis
     by (rule *[of c d]) (use box_subset_cbox[of c d] in auto)
 qed
 
 lemma has_integral_restrict_closed_subintervals_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "cbox c d \<subseteq> cbox a b"
   shows "((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b) \<longleftrightarrow> (f has_integral i) (cbox c d)"
   (is "?l = ?r")
 proof (cases "cbox c d = {}")
   case False
   let ?g = "\<lambda>x. if x \<in> cbox c d then f x else 0"
   show ?thesis
   proof 
     assume ?l
     then have "?g integrable_on cbox c d"
       using assms has_integral_integrable integrable_subinterval by blast
     then have "f integrable_on cbox c d"
       by (rule integrable_eq) auto
     moreover then have "i = integral (cbox c d) f"
       by (meson \<open>((\<lambda>x. if x \<in> cbox c d then f x else 0) has_integral i) (cbox a b)\<close> assms has_integral_restrict_closed_subinterval has_integral_unique integrable_integral)
     ultimately show ?r by auto
   next
     assume ?r then show ?l
       by (rule has_integral_restrict_closed_subinterval[OF _ assms])
   qed
 qed auto
 
 
 text \<open>Hence we can apply the limit process uniformly to all integrals.\<close>
 
 lemma has_integral':
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(f has_integral i) S \<longleftrightarrow>
     (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       (\<exists>z. ((\<lambda>x. if x \<in> S then f(x) else 0) has_integral z) (cbox a b) \<and> norm(z - i) < e))"
   (is "?l \<longleftrightarrow> (\<forall>e>0. ?r e)")
 proof (cases "\<exists>a b. S = cbox a b")
   case False then show ?thesis 
     by (simp add: has_integral_alt)
 next
   case True
   then obtain a b where S: "S = cbox a b"
     by blast 
   obtain B where " 0 < B" and B: "\<And>x. x \<in> cbox a b \<Longrightarrow> norm x \<le> B"
     using bounded_cbox[unfolded bounded_pos] by blast
   show ?thesis
   proof safe
     fix e :: real
     assume ?l and "e > 0"
     have "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) (cbox c d)"
       if "ball 0 (B+1) \<subseteq> cbox c d" for c d
         unfolding S using B that
         by (force intro: \<open>?l\<close>[unfolded S] has_integral_restrict_closed_subinterval)
     then show "?r e"
       apply (rule_tac x="B+1" in exI)
       using \<open>B>0\<close> \<open>e>0\<close> by force
   next
     assume as: "\<forall>e>0. ?r e"
     then obtain C 
       where C: "\<And>a b. ball 0 C \<subseteq> cbox a b \<Longrightarrow>
                 \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b)"
       by (meson zero_less_one)
     define c :: 'n where "c = (\<Sum>i\<in>Basis. (- max B C) *\<^sub>R i)"
     define d :: 'n where "d = (\<Sum>i\<in>Basis. max B C *\<^sub>R i)"
     have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" if "norm x \<le> B" "i \<in> Basis" for x i
       using that and Basis_le_norm[OF \<open>i\<in>Basis\<close>, of x]
       by (auto simp add: field_simps sum_negf c_def d_def)
     then have c_d: "cbox a b \<subseteq> cbox c d"
       by (meson B mem_box(2) subsetI)
     have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
       if x: "norm (0 - x) < C" and i: "i \<in> Basis" for x i
         using Basis_le_norm[OF i, of x] x i by (auto simp: sum_negf c_def d_def)
       then have "ball 0 C \<subseteq> cbox c d"
         by (auto simp: mem_box dist_norm)
     with C obtain y where y: "(f has_integral y) (cbox a b)"
       using c_d has_integral_restrict_closed_subintervals_eq S by blast
     have "y = i"
     proof (rule ccontr)
       assume "y \<noteq> i"
       then have "0 < norm (y - i)"
         by auto
       from as[rule_format,OF this]
       obtain C where C: "\<And>a b. ball 0 C \<subseteq> cbox a b \<Longrightarrow> 
            \<exists>z. ((\<lambda>x. if x \<in> S then f x else 0) has_integral z) (cbox a b) \<and> norm (z-i) < norm (y-i)"
         by auto
       define c :: 'n where "c = (\<Sum>i\<in>Basis. (- max B C) *\<^sub>R i)"
       define d :: 'n where "d = (\<Sum>i\<in>Basis. max B C *\<^sub>R i)"
       have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i"
         if "norm x \<le> B" and "i \<in> Basis" for x i
           using that Basis_le_norm[of i x] by (auto simp add: field_simps sum_negf c_def d_def)
         then have c_d: "cbox a b \<subseteq> cbox c d"
         by (simp add: B mem_box(2) subset_eq)
       have "c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" if "norm (0 - x) < C" and "i \<in> Basis" for x i
         using Basis_le_norm[of i x] that by (auto simp: sum_negf c_def d_def)
       then have "ball 0 C \<subseteq> cbox c d"
         by (auto simp: mem_box dist_norm)
       with C obtain z where z: "(f has_integral z) (cbox a b)" "norm (z-i) < norm (y-i)"
         using has_integral_restrict_closed_subintervals_eq[OF c_d] S by blast
       moreover then have "z = y" 
         by (blast intro: has_integral_unique[OF _ y])
       ultimately show False
         by auto
     qed
     then show ?l
       using y by (auto simp: S)
   qed
 qed
 
 lemma has_integral_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes fg: "(f has_integral i) S" "(g has_integral j) S"
     and le: "\<And>x. x \<in> S \<Longrightarrow> f x \<le> g x"
   shows "i \<le> j"
   using has_integral_component_le[OF _ fg, of 1] le  by auto
 
 lemma integral_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "f integrable_on S"
     and "g integrable_on S"
     and "\<And>x. x \<in> S \<Longrightarrow> f x \<le> g x"
   shows "integral S f \<le> integral S g"
   by (rule has_integral_le[OF assms(1,2)[unfolded has_integral_integral] assms(3)])
 
 lemma has_integral_nonneg:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "(f has_integral i) S"
     and "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f x"
   shows "0 \<le> i"
   using has_integral_component_nonneg[of 1 f i S]
   unfolding o_def
   using assms
   by auto
 
 lemma integral_nonneg:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes f: "f integrable_on S" and 0: "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> f x"
   shows "0 \<le> integral S f"
   by (rule has_integral_nonneg[OF f[unfolded has_integral_integral] 0])
 
 
 text \<open>Hence a general restriction property.\<close>
 
 lemma has_integral_restrict [simp]:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   assumes "S \<subseteq> T"
   shows "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) T \<longleftrightarrow> (f has_integral i) S"
 proof -
   have *: "\<And>x. (if x \<in> T then if x \<in> S then f x else 0 else 0) =  (if x\<in>S then f x else 0)"
     using assms by auto
   show ?thesis
     apply (subst(2) has_integral')
     apply (subst has_integral')
       apply (simp add: *)
     done
 qed
 
 corollary has_integral_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "((\<lambda>x. if x \<in> s then f x else 0) has_integral i) UNIV \<longleftrightarrow> (f has_integral i) s"
   by auto
 
 lemma has_integral_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) T \<longleftrightarrow> (f has_integral i) (S \<inter> T)"
 proof -
   have "((\<lambda>x. if x \<in> T then if x \<in> S then f x else 0 else 0) has_integral i) UNIV =
         ((\<lambda>x. if x \<in> S \<inter> T then f x else 0) has_integral i) UNIV"
     by (rule has_integral_cong) auto
   then show ?thesis
     using has_integral_restrict_UNIV by fastforce
 qed
 
 lemma integral_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "integral T (\<lambda>x. if x \<in> S then f x else 0) = integral (S \<inter> T) f"
   by (metis (no_types, lifting) has_integral_cong has_integral_restrict_Int integrable_integral integral_unique not_integrable_integral)
 
 lemma integrable_restrict_Int:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "(\<lambda>x. if x \<in> S then f x else 0) integrable_on T \<longleftrightarrow> f integrable_on (S \<inter> T)"
   using has_integral_restrict_Int by fastforce
 
 lemma has_integral_on_superset:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "(f has_integral i) S"
       and "\<And>x. x \<notin> S \<Longrightarrow> f x = 0"
       and "S \<subseteq> T"
     shows "(f has_integral i) T"
 proof -
   have "(\<lambda>x. if x \<in> S then f x else 0) = (\<lambda>x. if x \<in> T then f x else 0)"
     using assms by fastforce
   with f show ?thesis
     by (simp only: has_integral_restrict_UNIV [symmetric, of f])
 qed
 
 lemma integrable_on_superset:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S"
     and "\<And>x. x \<notin> S \<Longrightarrow> f x = 0"
     and "S \<subseteq> t"
   shows "f integrable_on t"
   using assms
   unfolding integrable_on_def
   by (auto intro:has_integral_on_superset)
 
 lemma integral_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "integral UNIV (\<lambda>x. if x \<in> S then f x else 0) = integral S f"
   by (simp add: integral_restrict_Int)
 
 lemma integrable_restrict_UNIV:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(\<lambda>x. if x \<in> s then f x else 0) integrable_on UNIV \<longleftrightarrow> f integrable_on s"
   unfolding integrable_on_def
   by auto
 
 lemma has_integral_subset_component_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes k: "k \<in> Basis"
     and as: "S \<subseteq> T" "(f has_integral i) S" "(f has_integral j) T" "\<And>x. x\<in>T \<Longrightarrow> 0 \<le> f(x)\<bullet>k"
   shows "i\<bullet>k \<le> j\<bullet>k"
 proof -
   have "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) UNIV"
         "((\<lambda>x. if x \<in> T then f x else 0) has_integral j) UNIV"
     by (simp_all add: assms)
   then show ?thesis
     apply (rule has_integral_component_le[OF k])
     using as by auto
 qed
 
 subsection\<open>Integrals on set differences\<close>
 
 lemma has_integral_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes S: "(f has_integral i) S" and T: "(f has_integral j) T"
     and neg: "negligible (T - S)"
   shows "(f has_integral (i - j)) (S - T)"
 proof -
   show ?thesis
     unfolding has_integral_restrict_UNIV [symmetric, of f]
   proof (rule has_integral_spike [OF neg])
     have eq: "(\<lambda>x. (if x \<in> S then f x else 0) - (if x \<in> T then f x else 0)) =
             (\<lambda>x. if x \<in> T - S then - f x else if x \<in> S - T then f x else 0)"
       by (force simp add: )
     have "((\<lambda>x. if x \<in> S then f x else 0) has_integral i) UNIV"
       "((\<lambda>x. if x \<in> T then f x else 0) has_integral j) UNIV"
       using S T has_integral_restrict_UNIV by auto
     from has_integral_diff [OF this]
     show "((\<lambda>x. if x \<in> T - S then - f x else if x \<in> S - T then f x else 0)
                    has_integral i-j) UNIV"
       by (simp add: eq)
   qed force
 qed
 
 lemma integral_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "f integrable_on S" "f integrable_on T" "negligible(T - S)"
  shows "integral (S - T) f = integral S f - integral T f"
   by (rule integral_unique) (simp add: assms has_integral_setdiff integrable_integral)
 
 lemma integrable_setdiff:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   assumes "(f has_integral i) S" "(f has_integral j) T" "negligible (T - S)"
   shows "f integrable_on (S - T)"
   using has_integral_setdiff [OF assms]
   by (simp add: has_integral_iff)
 
 lemma negligible_setdiff [simp]: "T \<subseteq> S \<Longrightarrow> negligible (T - S)"
   by (metis Diff_eq_empty_iff negligible_empty)
 
 lemma negligible_on_intervals: "negligible s \<longleftrightarrow> (\<forall>a b. negligible(s \<inter> cbox a b))" (is "?l \<longleftrightarrow> ?r")
 proof
   assume ?r
   show ?l
     unfolding negligible_def
   proof safe
     fix a b
     show "(indicator s has_integral 0) (cbox a b)"
       apply (rule has_integral_negligible[OF \<open>?r\<close>[rule_format,of a b]])
       unfolding indicator_def
       apply auto
       done
   qed
 qed (simp add: negligible_Int)
 
 lemma negligible_translation:
   assumes "negligible S"
     shows "negligible ((+) c ` S)"
 proof -
   have inj: "inj ((+) c)"
     by simp
   show ?thesis
   using assms
   proof (clarsimp simp: negligible_def)
     fix a b
     assume "\<forall>x y. (indicator S has_integral 0) (cbox x y)"
     then have *: "(indicator S has_integral 0) (cbox (a-c) (b-c))"
       by (meson Diff_iff assms has_integral_negligible indicator_simps(2))
     have eq: "indicator ((+) c ` S) = (\<lambda>x. indicator S (x - c))"
       by (force simp add: indicator_def)
     show "(indicator ((+) c ` S) has_integral 0) (cbox a b)"
       using has_integral_affinity [OF *, of 1 "-c"]
             cbox_translation [of "c" "-c+a" "-c+b"]
       by (simp add: eq) (simp add: ac_simps)
   qed
 qed
 
 lemma negligible_translation_rev:
   assumes "negligible ((+) c ` S)"
     shows "negligible S"
 by (metis negligible_translation [OF assms, of "-c"] translation_galois)
 
 lemma has_integral_spike_set_eq:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "(f has_integral y) S \<longleftrightarrow> (f has_integral y) T"
 proof -
   have "((\<lambda>x. if x \<in> S then f x else 0) has_integral y) UNIV =
         ((\<lambda>x. if x \<in> T then f x else 0) has_integral y) UNIV"
   proof (rule has_integral_spike_eq)
     show "negligible ({x \<in> S - T. f x \<noteq> 0} \<union> {x \<in> T - S. f x \<noteq> 0})"
       by (rule negligible_Un [OF assms])
   qed auto
   then show ?thesis
     by (simp add: has_integral_restrict_UNIV)
 qed
 
 corollary integral_spike_set:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "integral S f = integral T f"
   using has_integral_spike_set_eq [OF assms]
   by (metis eq_integralD integral_unique)
 
 lemma integrable_spike_set:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on S" and neg: "negligible {x \<in> S - T. f x \<noteq> 0}" "negligible {x \<in> T - S. f x \<noteq> 0}"
   shows "f integrable_on T"
   using has_integral_spike_set_eq [OF neg] f by blast
 
 lemma integrable_spike_set_eq:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "negligible ((S - T) \<union> (T - S))"
   shows "f integrable_on S \<longleftrightarrow> f integrable_on T"
   by (blast intro: integrable_spike_set assms negligible_subset)
 
 lemma integrable_on_insert_iff: "f integrable_on (insert x X) \<longleftrightarrow> f integrable_on X"
   for f::"_ \<Rightarrow> 'a::banach"
   by (rule integrable_spike_set_eq) (auto simp: insert_Diff_if)
 
 lemma has_integral_interior:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "negligible(frontier S) \<Longrightarrow> (f has_integral y) (interior S) \<longleftrightarrow> (f has_integral y) S"
   by (rule has_integral_spike_set_eq [OF empty_imp_negligible negligible_subset])
      (use interior_subset in \<open>auto simp: frontier_def closure_def\<close>)
 
 lemma has_integral_closure:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "negligible(frontier S) \<Longrightarrow> (f has_integral y) (closure S) \<longleftrightarrow> (f has_integral y) S"
   by (rule has_integral_spike_set_eq [OF negligible_subset empty_imp_negligible]) (auto simp: closure_Un_frontier )
 
 lemma has_integral_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "(f has_integral y) (box a b) \<longleftrightarrow> (f has_integral y) (cbox a b)"
   unfolding interior_cbox [symmetric]
   by (metis frontier_cbox has_integral_interior negligible_frontier_interval)
 
 lemma integrable_on_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "f integrable_on box a b \<longleftrightarrow> f integrable_on cbox a b"
   by (simp add: has_integral_open_interval integrable_on_def)
 
 lemma integral_open_interval:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: banach"
   shows "integral(box a b) f = integral(cbox a b) f"
   by (metis has_integral_integrable_integral has_integral_open_interval not_integrable_integral)
 
 
 subsection \<open>More lemmas that are useful later\<close>
 
 lemma has_integral_subset_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "s \<subseteq> t"
     and "(f has_integral i) s"
     and "(f has_integral j) t"
     and "\<forall>x\<in>t. 0 \<le> f x"
   shows "i \<le> j"
   using has_integral_subset_component_le[OF _ assms(1), of 1 f i j]
   using assms
   by auto
 
 lemma integral_subset_component_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "k \<in> Basis"
     and "s \<subseteq> t"
     and "f integrable_on s"
     and "f integrable_on t"
     and "\<forall>x \<in> t. 0 \<le> f x \<bullet> k"
   shows "(integral s f)\<bullet>k \<le> (integral t f)\<bullet>k"
   apply (rule has_integral_subset_component_le)
   using assms
   apply auto
   done
 
 lemma integral_subset_le:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "s \<subseteq> t"
     and "f integrable_on s"
     and "f integrable_on t"
     and "\<forall>x \<in> t. 0 \<le> f x"
   shows "integral s f \<le> integral t f"
   apply (rule has_integral_subset_le)
   using assms
   apply auto
   done
 
 lemma has_integral_alt':
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "(f has_integral i) s \<longleftrightarrow> 
           (\<forall>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b) \<and>
           (\<forall>e>0. \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
             norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - i) < e)"
   (is "?l = ?r")
 proof
   assume rhs: ?r
   show ?l
   proof (subst has_integral', intro allI impI)
     fix e::real
     assume "e > 0"
     from rhs[THEN conjunct2,rule_format,OF this] 
     show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
                    (\<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z)
                          (cbox a b) \<and> norm (z - i) < e)"
       apply (rule ex_forward)
       using rhs by blast
   qed
 next
   let ?\<Phi> = "\<lambda>e a b. \<exists>z. ((\<lambda>x. if x \<in> s then f x else 0) has_integral z) (cbox a b) \<and> norm (z - i) < e"
   assume ?l 
   then have lhs: "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> ?\<Phi> e a b" if "e > 0" for e
     using that has_integral'[of f] by auto
   let ?f = "\<lambda>x. if x \<in> s then f x else 0"
   show ?r
   proof (intro conjI allI impI)
     fix a b :: 'n
     from lhs[OF zero_less_one]
     obtain B where "0 < B" and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> ?\<Phi> 1 a b"
       by blast
     let ?a = "\<Sum>i\<in>Basis. min (a\<bullet>i) (-B) *\<^sub>R i::'n"
     let ?b = "\<Sum>i\<in>Basis. max (b\<bullet>i) B *\<^sub>R i::'n"
     show "?f integrable_on cbox a b"
     proof (rule integrable_subinterval[of _ ?a ?b])
       have "?a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> ?b \<bullet> i" if "norm (0 - x) < B" "i \<in> Basis" for x i
         using Basis_le_norm[of i x] that by (auto simp add:field_simps)
       then have "ball 0 B \<subseteq> cbox ?a ?b"
         by (auto simp: mem_box dist_norm)
       then show "?f integrable_on cbox ?a ?b"
         unfolding integrable_on_def using B by blast
       show "cbox a b \<subseteq> cbox ?a ?b"
         by (force simp: mem_box)
     qed
   
     fix e :: real
     assume "e > 0"
     with lhs show "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow>
       norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - i) < e"
       by (metis (no_types, lifting) has_integral_integrable_integral)
   qed
 qed
 
 
 subsection \<open>Continuity of the integral (for a 1-dimensional interval)\<close>
 
 lemma integrable_alt:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   shows "f integrable_on s \<longleftrightarrow>
     (\<forall>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b) \<and>
     (\<forall>e>0. \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
     norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) -
       integral (cbox c d)  (\<lambda>x. if x \<in> s then f x else 0)) < e)"
   (is "?l = ?r")
 proof
   let ?F = "\<lambda>x. if x \<in> s then f x else 0"
   assume ?l
   then obtain y where intF: "\<And>a b. ?F integrable_on cbox a b"
           and y: "\<And>e. 0 < e \<Longrightarrow>
               \<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?F - y) < e"
     unfolding integrable_on_def has_integral_alt'[of f] by auto
   show ?r
   proof (intro conjI allI impI intF)
     fix e::real
     assume "e > 0"
     then have "e/2 > 0"
       by auto
     obtain B where "0 < B" 
        and B: "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> norm (integral (cbox a b) ?F - y) < e/2"
       using \<open>0 < e/2\<close> y by blast
     show "\<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                   norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
     proof (intro conjI exI impI allI, rule \<open>0 < B\<close>)
       fix a b c d::'n
       assume sub: "ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d"
       show "norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
         using sub by (auto intro: norm_triangle_half_l dest: B)
     qed
   qed
 next
   let ?F = "\<lambda>x. if x \<in> s then f x else 0"
   assume rhs: ?r
   let ?cube = "\<lambda>n. cbox (\<Sum>i\<in>Basis. - real n *\<^sub>R i::'n) (\<Sum>i\<in>Basis. real n *\<^sub>R i)"
   have "Cauchy (\<lambda>n. integral (?cube n) ?F)"
     unfolding Cauchy_def
   proof (intro allI impI)
     fix e::real
     assume "e > 0"
     with rhs obtain B where "0 < B" 
       and B: "\<And>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d 
                         \<Longrightarrow> norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e"
       by blast
     obtain N where N: "B \<le> real N"
       using real_arch_simple by blast
     have "ball 0 B \<subseteq> ?cube n" if n: "n \<ge> N" for n
     proof -
       have "sum ((*\<^sub>R) (- real n)) Basis \<bullet> i \<le> x \<bullet> i \<and>
             x \<bullet> i \<le> sum ((*\<^sub>R) (real n)) Basis \<bullet> i"
         if "norm x < B" "i \<in> Basis" for x i::'n
           using Basis_le_norm[of i x] n N that by (auto simp add: field_simps sum_negf)
       then show ?thesis
         by (auto simp: mem_box dist_norm)
     qed
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (integral (?cube m) ?F) (integral (?cube n) ?F) < e"
       by (fastforce simp add: dist_norm intro!: B)
   qed
   then obtain i where i: "(\<lambda>n. integral (?cube n) ?F) \<longlonglongrightarrow> i"
     using convergent_eq_Cauchy by blast
   have "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?F - i) < e"
     if "e > 0" for e
   proof -
     have *: "e/2 > 0" using that by auto
     then obtain N where N: "\<And>n. N \<le> n \<Longrightarrow> norm (i - integral (?cube n) ?F) < e/2"
       using i[THEN LIMSEQ_D, simplified norm_minus_commute] by meson
     obtain B where "0 < B" 
       and B: "\<And>a b c d. \<lbrakk>ball 0 B \<subseteq> cbox a b; ball 0 B \<subseteq> cbox c d\<rbrakk> \<Longrightarrow>
                   norm (integral (cbox a b) ?F - integral (cbox c d) ?F) < e/2"
       using rhs * by meson
     let ?B = "max (real N) B"
     show ?thesis
     proof (intro exI conjI allI impI)
       show "0 < ?B"
         using \<open>B > 0\<close> by auto
       fix a b :: 'n
       assume "ball 0 ?B \<subseteq> cbox a b"
       moreover obtain n where n: "max (real N) B \<le> real n"
         using real_arch_simple by blast
       moreover have "ball 0 B \<subseteq> ?cube n"
       proof 
         fix x :: 'n
         assume x: "x \<in> ball 0 B"
         have "\<lbrakk>norm (0 - x) < B; i \<in> Basis\<rbrakk>
               \<Longrightarrow> sum ((*\<^sub>R) (-n)) Basis \<bullet> i\<le> x \<bullet> i \<and> x \<bullet> i \<le> sum ((*\<^sub>R) n) Basis \<bullet> i" for i
           using Basis_le_norm[of i x] n by (auto simp add: field_simps sum_negf)
         then show "x \<in> ?cube n"
           using x by (auto simp: mem_box dist_norm)
       qed 
       ultimately show "norm (integral (cbox a b) ?F - i) < e"
         using norm_triangle_half_l [OF B N] by force
     qed
   qed
   then show ?l unfolding integrable_on_def has_integral_alt'[of f]
     using rhs by blast
 qed
 
 lemma integrable_altD:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on s"
   shows "\<And>a b. (\<lambda>x. if x \<in> s then f x else 0) integrable_on cbox a b"
     and "\<And>e. e > 0 \<Longrightarrow> \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
       norm (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - integral (cbox c d)  (\<lambda>x. if x \<in> s then f x else 0)) < e"
   using assms[unfolded integrable_alt[of f]] by auto
 
 lemma integrable_alt_subset:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::banach"
   shows
      "f integrable_on S \<longleftrightarrow>
       (\<forall>a b. (\<lambda>x. if x \<in> S then f x else 0) integrable_on cbox a b) \<and>
       (\<forall>e>0. \<exists>B>0. \<forall>a b c d.
                       ball 0 B \<subseteq> cbox a b \<and> cbox a b \<subseteq> cbox c d
                       \<longrightarrow> norm(integral (cbox a b) (\<lambda>x. if x \<in> S then f x else 0) -
                                integral (cbox c d) (\<lambda>x. if x \<in> S then f x else 0)) < e)"
       (is "_ = ?rhs")
 proof -
   let ?g = "\<lambda>x. if x \<in> S then f x else 0"
   have "f integrable_on S \<longleftrightarrow>
         (\<forall>a b. ?g integrable_on cbox a b) \<and>
         (\<forall>e>0. \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
            norm (integral (cbox a b) ?g - integral (cbox c d)  ?g) < e)"
     by (rule integrable_alt)
   also have "\<dots> = ?rhs"
   proof -
     { fix e :: "real"
       assume e: "\<And>e. e>0 \<Longrightarrow> \<exists>B>0. \<forall>a b c d. ball 0 B \<subseteq> cbox a b \<and> cbox a b \<subseteq> cbox c d \<longrightarrow>
                                    norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
         and "e > 0"
       obtain B where "B > 0"
         and B: "\<And>a b c d. \<lbrakk>ball 0 B \<subseteq> cbox a b; cbox a b \<subseteq> cbox c d\<rbrakk> \<Longrightarrow>
                            norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e/2"
         using \<open>e > 0\<close> e [of "e/2"] by force
       have "\<exists>B>0. \<forall>a b c d.
                ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
       proof (intro exI allI conjI impI)
         fix a b c d :: "'a"
         let ?\<alpha> = "\<Sum>i\<in>Basis. max (a \<bullet> i) (c \<bullet> i) *\<^sub>R i"
         let ?\<beta> = "\<Sum>i\<in>Basis. min (b \<bullet> i) (d \<bullet> i) *\<^sub>R i"
         show "norm (integral (cbox a b) ?g - integral (cbox c d) ?g) < e"
           if ball: "ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d"
         proof -
           have B': "norm (integral (cbox a b \<inter> cbox c d) ?g - integral (cbox x y) ?g) < e/2"
             if "cbox a b \<inter> cbox c d \<subseteq> cbox x y" for x y
             using B [of ?\<alpha> ?\<beta> x y] ball that by (simp add: Int_interval [symmetric])
           show ?thesis
             using B' [of a b] B' [of c d] norm_triangle_half_r by blast
         qed
       qed (use \<open>B > 0\<close> in auto)}
     then show ?thesis
       by force
   qed
   finally show ?thesis .
 qed
 
 lemma integrable_on_subcbox:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on S"
     and sub: "cbox a b \<subseteq> S"
   shows "f integrable_on cbox a b"
 proof -
   have "(\<lambda>x. if x \<in> S then f x else 0) integrable_on cbox a b"
     by (simp add: intf integrable_altD(1))
 then show ?thesis
   by (metis (mono_tags) sub integrable_restrict_Int le_inf_iff order_refl subset_antisym)
 qed
 
 
 subsection \<open>A straddling criterion for integrability\<close>
 
 lemma integrable_straddle_interval:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>g h i j. (g has_integral i) (cbox a b) \<and> (h has_integral j) (cbox a b) \<and>
                             \<bar>i - j\<bar> < e \<and> (\<forall>x\<in>cbox a b. (g x) \<le> f x \<and> f x \<le> h x)"
   shows "f integrable_on cbox a b"
 proof -
   have "\<exists>d. gauge d \<and>
             (\<forall>p1 p2. p1 tagged_division_of cbox a b \<and> d fine p1 \<and>
                      p2 tagged_division_of cbox a b \<and> d fine p2 \<longrightarrow>
                      \<bar>(\<Sum>(x,K)\<in>p1. content K *\<^sub>R f x) - (\<Sum>(x,K)\<in>p2. content K *\<^sub>R f x)\<bar> < e)"
     if "e > 0" for e
   proof -
     have e: "e/3 > 0"
       using that by auto
     then obtain g h i j where ij: "\<bar>i - j\<bar> < e/3"
             and "(g has_integral i) (cbox a b)"
             and "(h has_integral j) (cbox a b)"
             and fgh: "\<And>x. x \<in> cbox a b \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       using assms real_norm_def by metis
     then obtain d1 d2 where "gauge d1" "gauge d2"
             and d1: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; d1 fine p\<rbrakk> \<Longrightarrow>
                           \<bar>(\<Sum>(x,K)\<in>p. content K *\<^sub>R g x) - i\<bar> < e/3"
             and d2: "\<And>p. \<lbrakk>p tagged_division_of cbox a b; d2 fine p\<rbrakk> \<Longrightarrow>
                           \<bar>(\<Sum>(x,K) \<in> p. content K *\<^sub>R h x) - j\<bar> < e/3"
       by (metis e has_integral real_norm_def)
     have "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R f x) - (\<Sum>(x,K) \<in> p2. content K *\<^sub>R f x)\<bar> < e"
       if p1: "p1 tagged_division_of cbox a b" and 11: "d1 fine p1" and 21: "d2 fine p1"
        and p2: "p2 tagged_division_of cbox a b" and 12: "d1 fine p2" and 22: "d2 fine p2" for p1 p2
     proof -
       have *: "\<And>g1 g2 h1 h2 f1 f2.
                   \<lbrakk>\<bar>g2 - i\<bar> < e/3; \<bar>g1 - i\<bar> < e/3; \<bar>h2 - j\<bar> < e/3; \<bar>h1 - j\<bar> < e/3;
                    g1 - h2 \<le> f1 - f2; f1 - f2 \<le> h1 - g2\<rbrakk>
                   \<Longrightarrow> \<bar>f1 - f2\<bar> < e"
         using \<open>e > 0\<close> ij by arith
       have 0: "(\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p1. content k *\<^sub>R g x) \<ge> 0"
               "0 \<le> (\<Sum>(x, k)\<in>p2. content k *\<^sub>R h x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)"
               "(\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R g x) \<ge> 0"
               "0 \<le> (\<Sum>(x, k)\<in>p1. content k *\<^sub>R h x) - (\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x)"
         unfolding sum_subtractf[symmetric]
            apply (auto intro!: sum_nonneg)
            apply (meson fgh measure_nonneg mult_left_mono tag_in_interval that sum_nonneg)+
         done
       show ?thesis
       proof (rule *)
         show "\<bar>(\<Sum>(x,K) \<in> p2. content K *\<^sub>R g x) - i\<bar> < e/3"
           by (rule d1[OF p2 12])
         show "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R g x) - i\<bar> < e/3"
           by (rule d1[OF p1 11])
         show "\<bar>(\<Sum>(x,K) \<in> p2. content K *\<^sub>R h x) - j\<bar> < e/3"
           by (rule d2[OF p2 22])
         show "\<bar>(\<Sum>(x,K) \<in> p1. content K *\<^sub>R h x) - j\<bar> < e/3"
           by (rule d2[OF p1 21])
       qed (use 0 in auto)
     qed
     then show ?thesis
       by (rule_tac x="\<lambda>x. d1 x \<inter> d2 x" in exI)
         (auto simp: fine_Int intro: \<open>gauge d1\<close> \<open>gauge d2\<close> d1 d2)
   qed
   then show ?thesis
     by (simp add: integrable_Cauchy)
 qed
 
 lemma integrable_straddle:
   fixes f :: "'n::euclidean_space \<Rightarrow> real"
   assumes "\<And>e. e>0 \<Longrightarrow> \<exists>g h i j. (g has_integral i) s \<and> (h has_integral j) s \<and>
                      \<bar>i - j\<bar> < e \<and> (\<forall>x\<in>s. g x \<le> f x \<and> f x \<le> h x)"
   shows "f integrable_on s"
 proof -
   let ?fs = "(\<lambda>x. if x \<in> s then f x else 0)"
   have "?fs integrable_on cbox a b" for a b
   proof (rule integrable_straddle_interval)
     fix e::real
     assume "e > 0"
     then have *: "e/4 > 0"
       by auto
     with assms obtain g h i j where g: "(g has_integral i) s" and h: "(h has_integral j) s"
                  and ij: "\<bar>i - j\<bar> < e/4"
                  and fgh: "\<And>x. x \<in> s \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       by metis
     let ?gs = "(\<lambda>x. if x \<in> s then g x else 0)"
     let ?hs = "(\<lambda>x. if x \<in> s then h x else 0)"
     obtain Bg where Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?gs - i\<bar> < e/4"
               and int_g: "\<And>a b. ?gs integrable_on cbox a b"
       using g * unfolding has_integral_alt' real_norm_def by meson
     obtain Bh where
           Bh: "\<And>a b. ball 0 Bh \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?hs - j\<bar> < e/4"
          and int_h: "\<And>a b. ?hs integrable_on cbox a b"
       using h * unfolding has_integral_alt' real_norm_def by meson
     define c where "c = (\<Sum>i\<in>Basis. min (a\<bullet>i) (- (max Bg Bh)) *\<^sub>R i)"
     define d where "d = (\<Sum>i\<in>Basis. max (b\<bullet>i) (max Bg Bh) *\<^sub>R i)"
     have "\<lbrakk>norm (0 - x) < Bg; i \<in> Basis\<rbrakk> \<Longrightarrow> c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" for x i
       using Basis_le_norm[of i x] unfolding c_def d_def by auto
     then have ballBg: "ball 0 Bg \<subseteq> cbox c d"
       by (auto simp: mem_box dist_norm)
     have "\<lbrakk>norm (0 - x) < Bh; i \<in> Basis\<rbrakk> \<Longrightarrow> c \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> d \<bullet> i" for x i
       using Basis_le_norm[of i x] unfolding c_def d_def by auto
     then have ballBh: "ball 0 Bh \<subseteq> cbox c d"
       by (auto simp: mem_box dist_norm)
     have ab_cd: "cbox a b \<subseteq> cbox c d"
       by (auto simp: c_def d_def subset_box_imp)
     have **: "\<And>ch cg ag ah::real. \<lbrakk>\<bar>ah - ag\<bar> \<le> \<bar>ch - cg\<bar>; \<bar>cg - i\<bar> < e/4; \<bar>ch - j\<bar> < e/4\<rbrakk>
        \<Longrightarrow> \<bar>ag - ah\<bar> < e"
       using ij by arith
     show "\<exists>g h i j. (g has_integral i) (cbox a b) \<and> (h has_integral j) (cbox a b) \<and> \<bar>i - j\<bar> < e \<and>
           (\<forall>x\<in>cbox a b. g x \<le> (if x \<in> s then f x else 0) \<and>
                         (if x \<in> s then f x else 0) \<le> h x)"
     proof (intro exI ballI conjI)
       have eq: "\<And>x f g. (if x \<in> s then f x else 0) - (if x \<in> s then g x else 0) =
                        (if x \<in> s then f x - g x else (0::real))"
         by auto
       have int_hg: "(\<lambda>x. if x \<in> s then h x - g x else 0) integrable_on cbox a b"
                    "(\<lambda>x. if x \<in> s then h x - g x else 0) integrable_on cbox c d"
         by (metis (no_types) integrable_diff g h has_integral_integrable integrable_altD(1))+
       show "(?gs has_integral integral (cbox a b) ?gs) (cbox a b)"
            "(?hs has_integral integral (cbox a b) ?hs) (cbox a b)"
         by (intro integrable_integral int_g int_h)+
       then have "integral (cbox a b) ?gs \<le> integral (cbox a b) ?hs"
         apply (rule has_integral_le)
         using fgh by force
       then have "0 \<le> integral (cbox a b) ?hs - integral (cbox a b) ?gs"
         by simp
       then have "\<bar>integral (cbox a b) ?hs - integral (cbox a b) ?gs\<bar>
               \<le> \<bar>integral (cbox c d) ?hs - integral (cbox c d) ?gs\<bar>"
         apply (simp add: integral_diff [symmetric] int_g int_h)
         apply (subst abs_of_nonneg[OF integral_nonneg[OF integrable_diff, OF int_h int_g]])
         using fgh apply (force simp: eq intro!: integral_subset_le [OF ab_cd int_hg])+
         done
       then show "\<bar>integral (cbox a b) ?gs - integral (cbox a b) ?hs\<bar> < e"
         apply (rule **)
          apply (rule Bg ballBg Bh ballBh)+
         done
       show "\<And>x. x \<in> cbox a b \<Longrightarrow> ?gs x \<le> ?fs x" "\<And>x. x \<in> cbox a b \<Longrightarrow> ?fs x \<le> ?hs x"
         using fgh by auto
     qed
   qed
   then have int_f: "?fs integrable_on cbox a b" for a b
     by simp
   have "\<exists>B>0. \<forall>a b c d.
                   ball 0 B \<subseteq> cbox a b \<and> ball 0 B \<subseteq> cbox c d \<longrightarrow>
                   abs (integral (cbox a b) ?fs - integral (cbox c d) ?fs) < e"
       if "0 < e" for e
   proof -
     have *: "e/3 > 0"
       using that by auto
     with assms obtain g h i j where g: "(g has_integral i) s" and h: "(h has_integral j) s"
                  and ij: "\<bar>i - j\<bar> < e/3"
                  and fgh: "\<And>x. x \<in> s \<Longrightarrow> g x \<le> f x \<and> f x \<le> h x"
       by metis
     let ?gs = "(\<lambda>x. if x \<in> s then g x else 0)"
     let ?hs = "(\<lambda>x. if x \<in> s then h x else 0)"
     obtain Bg where "Bg > 0"
               and Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?gs - i\<bar> < e/3"
               and int_g: "\<And>a b. ?gs integrable_on cbox a b"
       using g * unfolding has_integral_alt' real_norm_def by meson
     obtain Bh where "Bh > 0"
               and Bh: "\<And>a b. ball 0 Bh \<subseteq> cbox a b \<Longrightarrow> \<bar>integral (cbox a b) ?hs - j\<bar> < e/3"
               and int_h: "\<And>a b. ?hs integrable_on cbox a b"
       using h * unfolding has_integral_alt' real_norm_def by meson
     { fix a b c d :: 'n
       assume as: "ball 0 (max Bg Bh) \<subseteq> cbox a b" "ball 0 (max Bg Bh) \<subseteq> cbox c d"
       have **: "ball 0 Bg \<subseteq> ball (0::'n) (max Bg Bh)" "ball 0 Bh \<subseteq> ball (0::'n) (max Bg Bh)"
         by auto
       have *: "\<And>ga gc ha hc fa fc. \<lbrakk>\<bar>ga - i\<bar> < e/3; \<bar>gc - i\<bar> < e/3; \<bar>ha - j\<bar> < e/3;
                      \<bar>hc - j\<bar> < e/3; ga \<le> fa; fa \<le> ha; gc \<le> fc; fc \<le> hc\<rbrakk> \<Longrightarrow>
         \<bar>fa - fc\<bar> < e"
         using ij by arith
       have "abs (integral (cbox a b) (\<lambda>x. if x \<in> s then f x else 0) - integral (cbox c d)
         (\<lambda>x. if x \<in> s then f x else 0)) < e"
       proof (rule *)
         show "\<bar>integral (cbox a b) ?gs - i\<bar> < e/3"
           using "**" Bg as by blast
         show "\<bar>integral (cbox c d) ?gs - i\<bar> < e/3"
           using "**" Bg as by blast
         show "\<bar>integral (cbox a b) ?hs - j\<bar> < e/3"
           using "**" Bh as by blast
         show "\<bar>integral (cbox c d) ?hs - j\<bar> < e/3"
           using "**" Bh as by blast
       qed (use int_f int_g int_h fgh in \<open>simp_all add: integral_le\<close>)
     }
     then show ?thesis
       apply (rule_tac x="max Bg Bh" in exI)
         using \<open>Bg > 0\<close> by auto
   qed
   then show ?thesis
     unfolding integrable_alt[of f] real_norm_def by (blast intro: int_f)
 qed
 
 
 subsection \<open>Adding integrals over several sets\<close>
 
 lemma has_integral_Un:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "(f has_integral i) S" "(f has_integral j) T"
     and neg: "negligible (S \<inter> T)"
   shows "(f has_integral (i + j)) (S \<union> T)"
   unfolding has_integral_restrict_UNIV[symmetric, of f]
 proof (rule has_integral_spike[OF neg])
   let ?f = "\<lambda>x. (if x \<in> S then f x else 0) + (if x \<in> T then f x else 0)"
   show "(?f has_integral i + j) UNIV"
     by (simp add: f has_integral_add)
 qed auto
 
 lemma integral_Un [simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S" "f integrable_on T" "negligible (S \<inter> T)"
   shows "integral (S \<union> T) f = integral S f + integral T f"
   by (simp add: has_integral_Un assms integrable_integral integral_unique)
 
 lemma integrable_Un:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: banach"
   assumes "negligible (A \<inter> B)" "f integrable_on A" "f integrable_on B"
   shows   "f integrable_on (A \<union> B)"
 proof -
   from assms obtain y z where "(f has_integral y) A" "(f has_integral z) B"
      by (auto simp: integrable_on_def)
   from has_integral_Un[OF this assms(1)] show ?thesis by (auto simp: integrable_on_def)
 qed
 
 lemma integrable_Un':
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: banach"
   assumes "f integrable_on A" "f integrable_on B" "negligible (A \<inter> B)" "C = A \<union> B"
   shows   "f integrable_on C"
   using integrable_Un[of A B f] assms by simp
 
 lemma has_integral_Union:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes \<T>: "finite \<T>"
     and int: "\<And>S. S \<in> \<T> \<Longrightarrow> (f has_integral (i S)) S"
     and neg: "pairwise (\<lambda>S S'. negligible (S \<inter> S')) \<T>"
   shows "(f has_integral (sum i \<T>)) (\<Union>\<T>)"
 proof -
   let ?\<U> = "((\<lambda>(a,b). a \<inter> b) ` {(a,b). a \<in> \<T> \<and> b \<in> {y. y \<in> \<T> \<and> a \<noteq> y}})"
   have "((\<lambda>x. if x \<in> \<Union>\<T> then f x else 0) has_integral sum i \<T>) UNIV"
   proof (rule has_integral_spike)
     show "negligible (\<Union>?\<U>)"
     proof (rule negligible_Union)
       have "finite (\<T> \<times> \<T>)"
         by (simp add: \<T>)
       moreover have "{(a, b). a \<in> \<T> \<and> b \<in> {y \<in> \<T>. a \<noteq> y}} \<subseteq> \<T> \<times> \<T>"
         by auto
       ultimately show "finite ?\<U>"
         by (blast intro: finite_subset[of _ "\<T> \<times> \<T>"])
       show "\<And>t. t \<in> ?\<U> \<Longrightarrow> negligible t"
         using neg unfolding pairwise_def by auto
     qed
   next
     show "(if x \<in> \<Union>\<T> then f x else 0) = (\<Sum>A\<in>\<T>. if x \<in> A then f x else 0)"
       if "x \<in> UNIV - (\<Union>?\<U>)" for x
     proof clarsimp
       fix S assume "S \<in> \<T>" "x \<in> S"
       moreover then have "\<forall>b\<in>\<T>. x \<in> b \<longleftrightarrow> b = S"
         using that by blast
       ultimately show "f x = (\<Sum>A\<in>\<T>. if x \<in> A then f x else 0)"
         by (simp add: sum.delta[OF \<T>])
     qed
   next
     show "((\<lambda>x. \<Sum>A\<in>\<T>. if x \<in> A then f x else 0) has_integral (\<Sum>A\<in>\<T>. i A)) UNIV"
       apply (rule has_integral_sum [OF \<T>])
       using int by (simp add: has_integral_restrict_UNIV)
   qed
   then show ?thesis
     using has_integral_restrict_UNIV by blast
 qed
 
 
 text \<open>In particular adding integrals over a division, maybe not of an interval.\<close>
 
 lemma has_integral_combine_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<D> division_of S"
     and "\<And>k. k \<in> \<D> \<Longrightarrow> (f has_integral (i k)) k"
   shows "(f has_integral (sum i \<D>)) S"
 proof -
   note \<D> = division_ofD[OF assms(1)]
   have neg: "negligible (S \<inter> s')" if "S \<in> \<D>" "s' \<in> \<D>" "S \<noteq> s'" for S s'
   proof -
     obtain a c b \<D> where obt: "S = cbox a b" "s' = cbox c \<D>"
       by (meson \<open>S \<in> \<D>\<close> \<open>s' \<in> \<D>\<close> \<D>(4))
     from \<D>(5)[OF that] show ?thesis
       unfolding obt interior_cbox
       by (metis (no_types, lifting) Diff_empty Int_interval box_Int_box negligible_frontier_interval)
   qed
   show ?thesis
     unfolding \<D>(6)[symmetric]
     by (auto intro: \<D> neg assms has_integral_Union pairwiseI)
 qed
 
 lemma integral_combine_division_bottomup:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "\<D> division_of S" "\<And>k. k \<in> \<D> \<Longrightarrow> f integrable_on k"
   shows "integral S f = sum (\<lambda>i. integral i f) \<D>"
   apply (rule integral_unique)
   by (meson assms has_integral_combine_division has_integral_integrable_integral)
 
 lemma has_integral_combine_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on S"
     and \<D>: "\<D> division_of K"
     and "K \<subseteq> S"
   shows "(f has_integral (sum (\<lambda>i. integral i f) \<D>)) K"
 proof -
   have "f integrable_on L" if "L \<in> \<D>" for L
   proof -
     have "L \<subseteq> S"
       using \<open>K \<subseteq> S\<close> \<D> that by blast
     then show "f integrable_on L"
       using that by (metis (no_types) f \<D> division_ofD(4) integrable_on_subcbox)
   qed
   then show ?thesis
     by (meson \<D> has_integral_combine_division has_integral_integrable_integral)
 qed
 
 lemma integral_combine_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S"
     and "\<D> division_of S"
   shows "integral S f = sum (\<lambda>i. integral i f) \<D>"
   apply (rule integral_unique)
   apply (rule has_integral_combine_division_topdown)
   using assms
   apply auto
   done
 
 lemma integrable_combine_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes \<D>: "\<D> division_of S"
     and f: "\<And>i. i \<in> \<D> \<Longrightarrow> f integrable_on i"
   shows "f integrable_on S"
   using f unfolding integrable_on_def by (metis has_integral_combine_division[OF \<D>])
 
 lemma integrable_on_subdivision:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes \<D>: "\<D> division_of i"
     and f: "f integrable_on S"
     and "i \<subseteq> S"
   shows "f integrable_on i"
 proof -
   have "f integrable_on i" if "i \<in> \<D>" for i
 proof -
   have "i \<subseteq> S"
     using assms that by auto
   then show "f integrable_on i"
     using that by (metis (no_types) \<D> f division_ofD(4) integrable_on_subcbox)
 qed
   then show ?thesis
     using \<D> integrable_combine_division by blast
 qed
 
 
 subsection \<open>Also tagged divisions\<close>
 
 lemma has_integral_combine_tagged_division:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "p tagged_division_of S"
     and "\<forall>(x,k) \<in> p. (f has_integral (i k)) k"
   shows "(f has_integral (\<Sum>(x,k)\<in>p. i k)) S"
 proof -
   have *: "(f has_integral (\<Sum>k\<in>snd`p. integral k f)) S"
     using assms(2)
     apply (intro has_integral_combine_division)
     apply (auto simp: has_integral_integral[symmetric] intro: division_of_tagged_division[OF assms(1)])
     apply auto
     done
   also have "(\<Sum>k\<in>snd`p. integral k f) = (\<Sum>(x, k)\<in>p. integral k f)"
     by (intro sum.over_tagged_division_lemma[OF assms(1), symmetric] integral_null)
        (simp add: content_eq_0_interior)
   finally show ?thesis
     using assms by (auto simp add: has_integral_iff intro!: sum.cong)
 qed
 
 lemma integral_combine_tagged_division_bottomup:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "p tagged_division_of (cbox a b)"
     and "\<forall>(x,k)\<in>p. f integrable_on k"
   shows "integral (cbox a b) f = sum (\<lambda>(x,k). integral k f) p"
   apply (rule integral_unique)
   apply (rule has_integral_combine_tagged_division[OF assms(1)])
   using assms(2)
   apply auto
   done
 
 lemma has_integral_combine_tagged_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes f: "f integrable_on cbox a b"
     and p: "p tagged_division_of (cbox a b)"
   shows "(f has_integral (sum (\<lambda>(x,K). integral K f) p)) (cbox a b)"
 proof -
   have "(f has_integral integral K f) K" if "(x,K) \<in> p" for x K
     by (metis assms integrable_integral integrable_on_subcbox tagged_division_ofD(3,4) that)
   then show ?thesis
     by (metis assms case_prodI2 has_integral_integrable_integral integral_combine_tagged_division_bottomup)
 qed
 
 lemma integral_combine_tagged_division_topdown:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on cbox a b"
     and "p tagged_division_of (cbox a b)"
   shows "integral (cbox a b) f = sum (\<lambda>(x,k). integral k f) p"
   apply (rule integral_unique [OF has_integral_combine_tagged_division_topdown])
   using assms apply auto
   done
 
 
 subsection \<open>Henstock's lemma\<close>
 
 lemma Henstock_lemma_part1:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes intf: "f integrable_on cbox a b"
     and "e > 0"
     and "gauge d"
     and less_e: "\<And>p. \<lbrakk>p tagged_division_of (cbox a b); d fine p\<rbrakk> \<Longrightarrow>
                      norm (sum (\<lambda>(x,K). content K *\<^sub>R f x) p - integral(cbox a b) f) < e"
     and p: "p tagged_partial_division_of (cbox a b)" "d fine p"
   shows "norm (sum (\<lambda>(x,K). content K *\<^sub>R f x - integral K f) p) \<le> e" (is "?lhs \<le> e")
 proof (rule field_le_epsilon)
   fix k :: real
   assume "k > 0"
   let ?SUM = "\<lambda>p. (\<Sum>(x,K) \<in> p. content K *\<^sub>R f x)"
   note p' = tagged_partial_division_ofD[OF p(1)]
   have "\<Union>(snd ` p) \<subseteq> cbox a b"
     using p'(3) by fastforce
   then obtain q where q: "snd ` p \<subseteq> q" and qdiv: "q division_of cbox a b"
     by (meson p(1) partial_division_extend_interval partial_division_of_tagged_division)
   note q' = division_ofD[OF qdiv]
   define r where "r = q - snd ` p"
   have "snd ` p \<inter> r = {}"
     unfolding r_def by auto
   have "finite r"
     using q' unfolding r_def by auto
   have "\<exists>p. p tagged_division_of i \<and> d fine p \<and>
         norm (?SUM p - integral i f) < k / (real (card r) + 1)"
     if "i\<in>r" for i
   proof -
     have gt0: "k / (real (card r) + 1) > 0" using \<open>k > 0\<close> by simp
     have i: "i \<in> q"
       using that unfolding r_def by auto
     then obtain u v where uv: "i = cbox u v"
       using q'(4) by blast
     then have "cbox u v \<subseteq> cbox a b"
       using i q'(2) by auto  
     then have "f integrable_on cbox u v"
       by (rule integrable_subinterval[OF intf])
     with integrable_integral[OF this, unfolded has_integral[of f]]
     obtain dd where "gauge dd" and dd:
       "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox u v; dd fine \<D>\<rbrakk> \<Longrightarrow>
     norm (?SUM \<D> - integral (cbox u v) f) < k / (real (card r) + 1)"
       using gt0 by auto
     with gauge_Int[OF \<open>gauge d\<close> \<open>gauge dd\<close>]
     obtain qq where qq: "qq tagged_division_of cbox u v" "(\<lambda>x. d x \<inter> dd x) fine qq"
       using fine_division_exists by blast
     with dd[of qq]  show ?thesis
       by (auto simp: fine_Int uv)
   qed
   then obtain qq where qq: "\<And>i. i \<in> r \<Longrightarrow> qq i tagged_division_of i \<and>
       d fine qq i \<and> norm (?SUM (qq i) - integral i f) < k / (real (card r) + 1)"
     by metis
 
   let ?p = "p \<union> \<Union>(qq ` r)"
   have "norm (?SUM ?p - integral (cbox a b) f) < e"
   proof (rule less_e)
     show "d fine ?p"
       by (metis (mono_tags, hide_lams) qq fine_Un fine_Union imageE p(2))
     note ptag = tagged_partial_division_of_Union_self[OF p(1)]
     have "p \<union> \<Union>(qq ` r) tagged_division_of \<Union>(snd ` p) \<union> \<Union>r"
     proof (rule tagged_division_Un[OF ptag tagged_division_Union [OF \<open>finite r\<close>]])
       show "\<And>i. i \<in> r \<Longrightarrow> qq i tagged_division_of i"
         using qq by auto
       show "\<And>i1 i2. \<lbrakk>i1 \<in> r; i2 \<in> r; i1 \<noteq> i2\<rbrakk> \<Longrightarrow> interior i1 \<inter> interior i2 = {}"
         by (simp add: q'(5) r_def)
       show "interior (\<Union>(snd ` p)) \<inter> interior (\<Union>r) = {}"
       proof (rule Int_interior_Union_intervals [OF \<open>finite r\<close>])
         show "open (interior (\<Union>(snd ` p)))"
           by blast
         show "\<And>T. T \<in> r \<Longrightarrow> \<exists>a b. T = cbox a b"
           by (simp add: q'(4) r_def)
         have "finite (snd ` p)"
           by (simp add: p'(1))
         then show "\<And>T. T \<in> r \<Longrightarrow> interior (\<Union>(snd ` p)) \<inter> interior T = {}"
           apply (subst Int_commute)
           apply (rule Int_interior_Union_intervals)
           using r_def q'(5) q(1) apply auto
           by (simp add: p'(4))
       qed
     qed
     moreover have "\<Union>(snd ` p) \<union> \<Union>r = cbox a b" and "{qq i |i. i \<in> r} = qq ` r"
       using qdiv q unfolding Union_Un_distrib[symmetric] r_def by auto
     ultimately show "?p tagged_division_of (cbox a b)"
       by fastforce
   qed
   then have "norm (?SUM p + (?SUM (\<Union>(qq ` r))) - integral (cbox a b) f) < e"
   proof (subst sum.union_inter_neutral[symmetric, OF \<open>finite p\<close>], safe)
     show "content L *\<^sub>R f x = 0" if "(x, L) \<in> p" "(x, L) \<in> qq K" "K \<in> r" for x K L 
     proof -
       obtain u v where uv: "L = cbox u v"
         using \<open>(x,L) \<in> p\<close> p'(4) by blast
       have "L \<subseteq> K"
         using  qq[OF that(3)] tagged_division_ofD(3) \<open>(x,L) \<in> qq K\<close> by metis
       have "L \<in> snd ` p" 
         using \<open>(x,L) \<in> p\<close> image_iff by fastforce 
       then have "L \<in> q" "K \<in> q" "L \<noteq> K"
         using that(1,3) q(1) unfolding r_def by auto
       with q'(5) have "interior L = {}"
         using interior_mono[OF \<open>L \<subseteq> K\<close>] by blast
       then show "content L *\<^sub>R f x = 0"
         unfolding uv content_eq_0_interior[symmetric] by auto
     qed
     show "finite (\<Union>(qq ` r))"
       by (meson finite_UN qq \<open>finite r\<close> tagged_division_of_finite)
   qed
   moreover have "content M *\<^sub>R f x = 0" 
       if x: "(x,M) \<in> qq K" "(x,M) \<in> qq L" and KL: "qq K \<noteq> qq L" and r: "K \<in> r" "L \<in> r"
     for x M K L
   proof -
     note kl = tagged_division_ofD(3,4)[OF qq[THEN conjunct1]]
     obtain u v where uv: "M = cbox u v"
       using \<open>(x, M) \<in> qq L\<close> \<open>L \<in> r\<close> kl(2) by blast
     have empty: "interior (K \<inter> L) = {}"
       by (metis DiffD1 interior_Int q'(5) r_def KL r)
     have "interior M = {}"
       by (metis (no_types, lifting) Int_assoc empty inf.absorb_iff2 interior_Int kl(1) subset_empty x r)
     then show "content M *\<^sub>R f x = 0"
       unfolding uv content_eq_0_interior[symmetric]
       by auto
   qed 
   ultimately have "norm (?SUM p + sum ?SUM (qq ` r) - integral (cbox a b) f) < e"
     apply (subst (asm) sum.Union_comp)
     using qq by (force simp: split_paired_all)+
   moreover have "content M *\<^sub>R f x = 0" 
        if "K \<in> r" "L \<in> r" "K \<noteq> L" "qq K = qq L" "(x, M) \<in> qq K" for K L x M
     using tagged_division_ofD(6) qq that by (metis (no_types, lifting)) 
   ultimately have less_e: "norm (?SUM p + sum (?SUM \<circ> qq) r - integral (cbox a b) f) < e"
     apply (subst (asm) sum.reindex_nontrivial [OF \<open>finite r\<close>])
      apply (auto simp: split_paired_all sum.neutral)
     done
   have norm_le: "norm (cp - ip) \<le> e + k"
                   if "norm ((cp + cr) - i) < e" "norm (cr - ir) < k" "ip + ir = i"
                   for ir ip i cr cp::'a
   proof -
     from that show ?thesis
       using norm_triangle_le[of "cp + cr - i" "- (cr - ir)"]
       unfolding that(3)[symmetric] norm_minus_cancel
       by (auto simp add: algebra_simps)
   qed
 
   have "?lhs =  norm (?SUM p - (\<Sum>(x, k)\<in>p. integral k f))"
     unfolding split_def sum_subtractf ..
   also have "\<dots> \<le> e + k"
   proof (rule norm_le[OF less_e])
     have lessk: "k * real (card r) / (1 + real (card r)) < k"
       using \<open>k>0\<close> by (auto simp add: field_simps)
     have "norm (sum (?SUM \<circ> qq) r - (\<Sum>k\<in>r. integral k f)) \<le> (\<Sum>x\<in>r. k / (real (card r) + 1))"
       unfolding sum_subtractf[symmetric] by (force dest: qq intro!: sum_norm_le)
     also have "... < k"
       by (simp add: lessk add.commute mult.commute)
     finally show "norm (sum (?SUM \<circ> qq) r - (\<Sum>k\<in>r. integral k f)) < k" .
   next
     from q(1) have [simp]: "snd ` p \<union> q = q" by auto
     have "integral l f = 0"
       if inp: "(x, l) \<in> p" "(y, m) \<in> p" and ne: "(x, l) \<noteq> (y, m)" and "l = m" for x l y m
     proof -
       obtain u v where uv: "l = cbox u v"
         using inp p'(4) by blast
       have "content (cbox u v) = 0"
         unfolding content_eq_0_interior using that p(1) uv by auto
       then show ?thesis
         using uv by blast
     qed
     then have "(\<Sum>(x, k)\<in>p. integral k f) = (\<Sum>k\<in>snd ` p. integral k f)"
       apply (subst sum.reindex_nontrivial [OF \<open>finite p\<close>])
       unfolding split_paired_all split_def by auto
     then show "(\<Sum>(x, k)\<in>p. integral k f) + (\<Sum>k\<in>r. integral k f) = integral (cbox a b) f"
       unfolding integral_combine_division_topdown[OF intf qdiv] r_def
       using q'(1) p'(1) sum.union_disjoint [of "snd ` p" "q - snd ` p", symmetric]
         by simp
   qed
   finally show "?lhs \<le> e + k" .
 qed
 
 lemma Henstock_lemma_part2:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes fed: "f integrable_on cbox a b" "e > 0" "gauge d"
     and less_e: "\<And>\<D>. \<lbrakk>\<D> tagged_division_of (cbox a b); d fine \<D>\<rbrakk> \<Longrightarrow>
                      norm (sum (\<lambda>(x,k). content k *\<^sub>R f x) \<D> - integral (cbox a b) f) < e"
     and tag: "p tagged_partial_division_of (cbox a b)"
     and "d fine p"
   shows "sum (\<lambda>(x,k). norm (content k *\<^sub>R f x - integral k f)) p \<le> 2 * real (DIM('n)) * e"
 proof -
   have "finite p"
     using tag by blast
   then show ?thesis
     unfolding split_def
   proof (rule sum_norm_allsubsets_bound)
     fix Q
     assume Q: "Q \<subseteq> p"
     then have fine: "d fine Q"
       by (simp add: \<open>d fine p\<close> fine_subset)
     show "norm (\<Sum>x\<in>Q. content (snd x) *\<^sub>R f (fst x) - integral (snd x) f) \<le> e"
       apply (rule Henstock_lemma_part1[OF fed less_e, unfolded split_def])
       using Q tag tagged_partial_division_subset apply (force simp add: fine)+
       done
   qed
 qed
 
 lemma Henstock_lemma:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes intf: "f integrable_on cbox a b"
     and "e > 0"
   obtains \<gamma> where "gauge \<gamma>"
     and "\<And>p. \<lbrakk>p tagged_partial_division_of (cbox a b); \<gamma> fine p\<rbrakk> \<Longrightarrow>
              sum (\<lambda>(x,k). norm(content k *\<^sub>R f x - integral k f)) p < e"
 proof -
   have *: "e/(2 * (real DIM('n) + 1)) > 0" using \<open>e > 0\<close> by simp
   with integrable_integral[OF intf, unfolded has_integral]
   obtain \<gamma> where "gauge \<gamma>"
     and \<gamma>: "\<And>\<D>. \<lbrakk>\<D> tagged_division_of cbox a b; \<gamma> fine \<D>\<rbrakk> \<Longrightarrow>
          norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f x) - integral (cbox a b) f)
          < e/(2 * (real DIM('n) + 1))"
     by metis
   show thesis
   proof (rule that [OF \<open>gauge \<gamma>\<close>])
     fix p
     assume p: "p tagged_partial_division_of cbox a b" "\<gamma> fine p"
     have "(\<Sum>(x,K)\<in>p. norm (content K *\<^sub>R f x - integral K f)) 
           \<le> 2 * real DIM('n) * (e/(2 * (real DIM('n) + 1)))"
       using Henstock_lemma_part2[OF intf * \<open>gauge \<gamma>\<close> \<gamma> p] by metis
     also have "... < e"
       using \<open>e > 0\<close> by (auto simp add: field_simps)
     finally
     show "(\<Sum>(x,K)\<in>p. norm (content K *\<^sub>R f x - integral K f)) < e" .
   qed
 qed
 
 
 subsection \<open>Monotone convergence (bounded interval first)\<close>
 
 lemma bounded_increasing_convergent:
   fixes f :: "nat \<Rightarrow> real"
   shows "\<lbrakk>bounded (range f); \<And>n. f n \<le> f (Suc n)\<rbrakk> \<Longrightarrow> \<exists>l. f \<longlonglongrightarrow> l"
   using Bseq_mono_convergent[of f] incseq_Suc_iff[of f]
   by (auto simp: image_def Bseq_eq_bounded convergent_def incseq_def)
 
 lemma monotone_convergence_interval:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes intf: "\<And>k. (f k) integrable_on cbox a b"
     and le: "\<And>k x. x \<in> cbox a b \<Longrightarrow> (f k x) \<le> f (Suc k) x"
     and fg: "\<And>x. x \<in> cbox a b \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range (\<lambda>k. integral (cbox a b) (f k)))"
   shows "g integrable_on cbox a b \<and> ((\<lambda>k. integral (cbox a b) (f k)) \<longlongrightarrow> integral (cbox a b) g) sequentially"
 proof (cases "content (cbox a b) = 0")
   case True then show ?thesis
     by auto
 next
   case False
   have fg1: "(f k x) \<le> (g x)" if x: "x \<in> cbox a b" for x k
   proof -
     have "\<forall>\<^sub>F j in sequentially. f k x \<le> f j x"
       apply (rule eventually_sequentiallyI [of k])
       using le x apply (force intro: transitive_stepwise_le)
       done
     then show "f k x \<le> g x"
       using tendsto_lowerbound [OF fg] x trivial_limit_sequentially by blast
   qed
   have int_inc: "\<And>n. integral (cbox a b) (f n) \<le> integral (cbox a b) (f (Suc n))"
     by (metis integral_le intf le)
   then obtain i where i: "(\<lambda>k. integral (cbox a b) (f k)) \<longlonglongrightarrow> i"
     using bounded_increasing_convergent bou by blast
   have "\<And>k. \<forall>\<^sub>F x in sequentially. integral (cbox a b) (f k) \<le> integral (cbox a b) (f x)"
     unfolding eventually_sequentially
     by (force intro: transitive_stepwise_le int_inc)
   then have i': "\<And>k. (integral(cbox a b) (f k)) \<le> i"
     using tendsto_le [OF trivial_limit_sequentially i] by blast
   have "(g has_integral i) (cbox a b)"
     unfolding has_integral real_norm_def
   proof clarify
     fix e::real
     assume e: "e > 0"
     have "\<And>k. (\<exists>\<gamma>. gauge \<gamma> \<and> (\<forall>\<D>. \<D> tagged_division_of (cbox a b) \<and> \<gamma> fine \<D> \<longrightarrow>
       abs ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f k x) - integral (cbox a b) (f k)) < e/2 ^ (k + 2)))"
       using intf e by (auto simp: has_integral_integral has_integral)
     then obtain c where c: "\<And>x. gauge (c x)"
           "\<And>x \<D>. \<lbrakk>\<D> tagged_division_of cbox a b; c x fine \<D>\<rbrakk> \<Longrightarrow>
               abs ((\<Sum>(u,K)\<in>\<D>. content K *\<^sub>R f x u) - integral (cbox a b) (f x))
               < e/2 ^ (x + 2)"
       by metis
 
     have "\<exists>r. \<forall>k\<ge>r. 0 \<le> i - (integral (cbox a b) (f k)) \<and> i - (integral (cbox a b) (f k)) < e/4"
     proof -
       have "e/4 > 0"
         using e by auto
       show ?thesis
         using LIMSEQ_D [OF i \<open>e/4 > 0\<close>] i' by auto
     qed
     then obtain r where r: "\<And>k. r \<le> k \<Longrightarrow> 0 \<le> i - integral (cbox a b) (f k)"
                        "\<And>k. r \<le> k \<Longrightarrow> i - integral (cbox a b) (f k) < e/4" 
       by metis
     have "\<exists>n\<ge>r. \<forall>k\<ge>n. 0 \<le> (g x) - (f k x) \<and> (g x) - (f k x) < e/(4 * content(cbox a b))"
       if "x \<in> cbox a b" for x
     proof -
       have "e/(4 * content (cbox a b)) > 0"
         by (simp add: False content_lt_nz e)
       with fg that LIMSEQ_D
       obtain N where "\<forall>n\<ge>N. norm (f n x - g x) < e/(4 * content (cbox a b))"
         by metis
       then show "\<exists>n\<ge>r.
             \<forall>k\<ge>n.
                0 \<le> g x - f k x \<and>
                g x - f k x
                < e/(4 * content (cbox a b))"
         apply (rule_tac x="N + r" in exI)
         using fg1[OF that] apply (auto simp add: field_simps)
         done
     qed
     then obtain m where r_le_m: "\<And>x. x \<in> cbox a b \<Longrightarrow> r \<le> m x"
        and m: "\<And>x k. \<lbrakk>x \<in> cbox a b; m x \<le> k\<rbrakk>
                      \<Longrightarrow> 0 \<le> g x - f k x \<and> g x - f k x < e/(4 * content (cbox a b))"
       by metis
     define d where "d x = c (m x) x" for x
     show "\<exists>\<gamma>. gauge \<gamma> \<and>
              (\<forall>\<D>. \<D> tagged_division_of cbox a b \<and>
                   \<gamma> fine \<D> \<longrightarrow> abs ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - i) < e)"
     proof (rule exI, safe)
       show "gauge d"
         using c(1) unfolding gauge_def d_def by auto
     next
       fix \<D>
       assume ptag: "\<D> tagged_division_of (cbox a b)" and "d fine \<D>"
       note p'=tagged_division_ofD[OF ptag]
       obtain s where s: "\<And>x. x \<in> \<D> \<Longrightarrow> m (fst x) \<le> s"
         by (metis finite_imageI finite_nat_set_iff_bounded_le p'(1) rev_image_eqI)
       have *: "\<bar>a - d\<bar> < e" if "\<bar>a - b\<bar> \<le> e/4" "\<bar>b - c\<bar> < e/2" "\<bar>c - d\<bar> < e/4" for a b c d
         using that norm_triangle_lt[of "a - b" "b - c" "3* e/4"]
           norm_triangle_lt[of "a - b + (b - c)" "c - d" e]
         by (auto simp add: algebra_simps)
       show "\<bar>(\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - i\<bar> < e"
       proof (rule *)
         have "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - (\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x)\<bar> 
               \<le> (\<Sum>i\<in>\<D>. \<bar>(case i of (x, K) \<Rightarrow> content K *\<^sub>R g x) - (case i of (x, K) \<Rightarrow> content K *\<^sub>R f (m x) x)\<bar>)"
           by (metis (mono_tags) sum_subtractf sum_abs) 
         also have "... \<le> (\<Sum>(x, k)\<in>\<D>. content k * (e/(4 * content (cbox a b))))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xk: "(x,K) \<in> \<D>"
           with ptag have x: "x \<in> cbox a b"
             by blast
           then have "abs (content K * (g x - f (m x) x)) \<le> content K * (e/(4 * content (cbox a b)))"
             by (metis m[OF x] mult_nonneg_nonneg abs_of_nonneg less_eq_real_def measure_nonneg mult_left_mono order_refl)
           then show "\<bar>content K * g x - content K * f (m x) x\<bar> \<le> content K * e/(4 * content (cbox a b))"
             by (simp add: algebra_simps)
         qed
         also have "... = (e/(4 * content (cbox a b))) * (\<Sum>(x, k)\<in>\<D>. content k)"
           by (simp add: sum_distrib_left sum_divide_distrib split_def mult.commute)
         also have "... \<le> e/4"
           by (metis False additive_content_tagged_division [OF ptag] nonzero_mult_divide_mult_cancel_right order_refl times_divide_eq_left)
         finally show "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R g x) - (\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x)\<bar> \<le> e/4" .
 
       next
         have "norm ((\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x) - (\<Sum>(x,K)\<in>\<D>. integral K (f (m x))))
               \<le> norm (\<Sum>j = 0..s. \<Sum>(x,K)\<in>{xk \<in> \<D>. m (fst xk) = j}. content K *\<^sub>R f (m x) x - integral K (f (m x)))"
           apply (subst sum.group)
           using s by (auto simp: sum_subtractf split_def p'(1))
         also have "\<dots> < e/2"
         proof -
           have "norm (\<Sum>j = 0..s. \<Sum>(x, k)\<in>{xk \<in> \<D>. m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x)))
                 \<le> (\<Sum>i = 0..s. e/2 ^ (i + 2))"
           proof (rule sum_norm_le)
             fix t
             assume "t \<in> {0..s}"
             have "norm (\<Sum>(x,k)\<in>{xk \<in> \<D>. m (fst xk) = t}. content k *\<^sub>R f (m x) x - integral k (f (m x))) =
                   norm (\<Sum>(x,k)\<in>{xk \<in> \<D>. m (fst xk) = t}. content k *\<^sub>R f t x - integral k (f t))"
               by (force intro!: sum.cong arg_cong[where f=norm])
             also have "... \<le> e/2 ^ (t + 2)"
             proof (rule Henstock_lemma_part1 [OF intf])
               show "{xk \<in> \<D>. m (fst xk) = t} tagged_partial_division_of cbox a b"
                 apply (rule tagged_partial_division_subset[of \<D>])
                 using ptag by (auto simp: tagged_division_of_def)
               show "c t fine {xk \<in> \<D>. m (fst xk) = t}"
                 using \<open>d fine \<D>\<close> by (auto simp: fine_def d_def)
             qed (use c e in auto)
             finally show "norm (\<Sum>(x,K)\<in>{xk \<in> \<D>. m (fst xk) = t}. content K *\<^sub>R f (m x) x -
                                 integral K (f (m x))) \<le> e/2 ^ (t + 2)" .
           qed
           also have "... = (e/2/2) * (\<Sum>i = 0..s. (1/2) ^ i)"
             by (simp add: sum_distrib_left field_simps)
           also have "\<dots> < e/2"
             by (simp add: sum_gp mult_strict_left_mono[OF _ e])
           finally show "norm (\<Sum>j = 0..s. \<Sum>(x, k)\<in>{xk \<in> \<D>.
             m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x))) < e/2" .
         qed 
         finally show "\<bar>(\<Sum>(x,K)\<in>\<D>. content K *\<^sub>R f (m x) x) - (\<Sum>(x,K)\<in>\<D>. integral K (f (m x)))\<bar> < e/2"
           by simp
       next
         have comb: "integral (cbox a b) (f y) = (\<Sum>(x, k)\<in>\<D>. integral k (f y))" for y
           using integral_combine_tagged_division_topdown[OF intf ptag] by metis
         have f_le: "\<And>y m n. \<lbrakk>y \<in> cbox a b; n\<ge>m\<rbrakk> \<Longrightarrow> f m y \<le> f n y"
           using le by (auto intro: transitive_stepwise_le)        
         have "(\<Sum>(x, k)\<in>\<D>. integral k (f r)) \<le> (\<Sum>(x, K)\<in>\<D>. integral K (f (m x)))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xK: "(x, K) \<in> \<D>"
           show "integral K (f r) \<le> integral K (f (m x))"
           proof (rule integral_le)
             show "f r integrable_on K"
               by (metis integrable_on_subcbox intf p'(3) p'(4) xK)
             show "f (m x) integrable_on K"
               by (metis elementary_interval integrable_on_subdivision intf p'(3) p'(4) xK)
             show "f r y \<le> f (m x) y" if "y \<in> K" for y
               using that r_le_m[of x] p'(2-3)[OF xK] f_le by auto
           qed
         qed
         moreover have "(\<Sum>(x, K)\<in>\<D>. integral K (f (m x))) \<le> (\<Sum>(x, k)\<in>\<D>. integral k (f s))"
         proof (rule sum_mono, simp add: split_paired_all)
           fix x K
           assume xK: "(x, K) \<in> \<D>"
           show "integral K (f (m x)) \<le> integral K (f s)"
           proof (rule integral_le)
             show "f (m x) integrable_on K"
               by (metis elementary_interval integrable_on_subdivision intf p'(3) p'(4) xK)
             show "f s integrable_on K"
               by (metis integrable_on_subcbox intf p'(3) p'(4) xK)
             show "f (m x) y \<le> f s y" if "y \<in> K" for y
               using that s xK f_le p'(3) by fastforce
           qed
         qed
         moreover have "0 \<le> i - integral (cbox a b) (f r)" "i - integral (cbox a b) (f r) < e/4"
           using r by auto
         ultimately show "\<bar>(\<Sum>(x,K)\<in>\<D>. integral K (f (m x))) - i\<bar> < e/4"
           using comb i'[of s] by auto
       qed
     qed
   qed 
   with i integral_unique show ?thesis
     by blast
 qed
 
 lemma monotone_convergence_increasing:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes int_f: "\<And>k. (f k) integrable_on S"
     and "\<And>k x. x \<in> S \<Longrightarrow> (f k x) \<le> (f (Suc k) x)"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range (\<lambda>k. integral S (f k)))"
   shows "g integrable_on S \<and> ((\<lambda>k. integral S (f k)) \<longlongrightarrow> integral S g) sequentially"
 proof -
   have lem: "g integrable_on S \<and> ((\<lambda>k. integral S (f k)) \<longlongrightarrow> integral S g) sequentially"
     if f0: "\<And>k x. x \<in> S \<Longrightarrow> 0 \<le> f k x"
     and int_f: "\<And>k. (f k) integrable_on S"
     and le: "\<And>k x. x \<in> S \<Longrightarrow> f k x \<le> f (Suc k) x"
     and lim: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range(\<lambda>k. integral S (f k)))"
     for f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real" and g S
   proof -
     have fg: "(f k x) \<le> (g x)" if "x \<in> S" for x k
       apply (rule tendsto_lowerbound [OF lim [OF that]])
       apply (rule eventually_sequentiallyI [of k])
       using le  by (force intro: transitive_stepwise_le that)+
     obtain i where i: "(\<lambda>k. integral S (f k)) \<longlonglongrightarrow> i"
       using bounded_increasing_convergent [OF bou] le int_f integral_le by blast
     have i': "(integral S (f k)) \<le> i" for k
     proof -
       have "\<And>k. \<And>x. x \<in> S \<Longrightarrow> \<forall>n\<ge>k. f k x \<le> f n x"
         using le  by (force intro: transitive_stepwise_le)
       then show ?thesis
         using tendsto_lowerbound [OF i eventually_sequentiallyI trivial_limit_sequentially]
         by (meson int_f integral_le)
     qed
 
     let ?f = "(\<lambda>k x. if x \<in> S then f k x else 0)"
     let ?g = "(\<lambda>x. if x \<in> S then g x else 0)"
     have int: "?f k integrable_on cbox a b" for a b k
       by (simp add: int_f integrable_altD(1))
     have int': "\<And>k a b. f k integrable_on cbox a b \<inter> S"
       using int by (simp add: Int_commute integrable_restrict_Int) 
     have g: "?g integrable_on cbox a b \<and>
              (\<lambda>k. integral (cbox a b) (?f k)) \<longlonglongrightarrow> integral (cbox a b) ?g" for a b
     proof (rule monotone_convergence_interval)
       have "norm (integral (cbox a b) (?f k)) \<le> norm (integral S (f k))" for k
       proof -
         have "0 \<le> integral (cbox a b) (?f k)"
           by (metis (no_types) integral_nonneg Int_iff f0 inf_commute integral_restrict_Int int')
         moreover have "0 \<le> integral S (f k)"
           by (simp add: integral_nonneg f0 int_f)
         moreover have "integral (S \<inter> cbox a b) (f k) \<le> integral S (f k)"
           by (metis f0 inf_commute int' int_f integral_subset_le le_inf_iff order_refl)
         ultimately show ?thesis
           by (simp add: integral_restrict_Int)
       qed
       moreover obtain B where "\<And>x. x \<in> range (\<lambda>k. integral S (f k)) \<Longrightarrow> norm x \<le> B"
         using bou unfolding bounded_iff by blast
       ultimately show "bounded (range (\<lambda>k. integral (cbox a b) (?f k)))"
         unfolding bounded_iff by (blast intro: order_trans)
     qed (use int le lim in auto)
     moreover have "\<exists>B>0. \<forall>a b. ball 0 B \<subseteq> cbox a b \<longrightarrow> norm (integral (cbox a b) ?g - i) < e"
       if "0 < e" for e
     proof -
       have "e/4>0"
         using that by auto
       with LIMSEQ_D [OF i] obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> norm (integral S (f n) - i) < e/4"
         by metis
       with int_f[of N, unfolded has_integral_integral has_integral_alt'[of "f N"]] 
       obtain B where "0 < B" and B: 
         "\<And>a b. ball 0 B \<subseteq> cbox a b \<Longrightarrow> norm (integral (cbox a b) (?f N) - integral S (f N)) < e/4"
         by (meson \<open>0 < e/4\<close>)
       have "norm (integral (cbox a b) ?g - i) < e" if  ab: "ball 0 B \<subseteq> cbox a b" for a b
       proof -
         obtain M where M: "\<And>n. n \<ge> M \<Longrightarrow> abs (integral (cbox a b) (?f n) - integral (cbox a b) ?g) < e/2"
           using \<open>e > 0\<close> g by (fastforce simp add: dest!: LIMSEQ_D [where r = "e/2"])
         have *: "\<And>\<alpha> \<beta> g. \<lbrakk>\<bar>\<alpha> - i\<bar> < e/2; \<bar>\<beta> - g\<bar> < e/2; \<alpha> \<le> \<beta>; \<beta> \<le> i\<rbrakk> \<Longrightarrow> \<bar>g - i\<bar> < e"
           unfolding real_inner_1_right by arith
         show "norm (integral (cbox a b) ?g - i) < e"
           unfolding real_norm_def
         proof (rule *)
           show "\<bar>integral (cbox a b) (?f N) - i\<bar> < e/2"
           proof (rule abs_triangle_half_l)
             show "\<bar>integral (cbox a b) (?f N) - integral S (f N)\<bar> < e/2/2"
               using B[OF ab] by simp
             show "abs (i - integral S (f N)) < e/2/2"
               using N by (simp add: abs_minus_commute)
           qed
           show "\<bar>integral (cbox a b) (?f (M + N)) - integral (cbox a b) ?g\<bar> < e/2"
             by (metis le_add1 M[of "M + N"])
           show "integral (cbox a b) (?f N) \<le> integral (cbox a b) (?f (M + N))"
           proof (intro ballI integral_le[OF int int])
             fix x assume "x \<in> cbox a b"
             have "(f m x) \<le> (f n x)" if "x \<in> S" "n \<ge> m" for m n
               apply (rule transitive_stepwise_le [OF \<open>n \<ge> m\<close> order_refl])
               using dual_order.trans apply blast
               by (simp add: le \<open>x \<in> S\<close>)
             then show "(?f N)x \<le> (?f (M+N))x"
               by auto
           qed
           have "integral (cbox a b \<inter> S) (f (M + N)) \<le> integral S (f (M + N))"
             by (metis Int_lower1 f0 inf_commute int' int_f integral_subset_le)
           then have "integral (cbox a b) (?f (M + N)) \<le> integral S (f (M + N))"
             by (metis (no_types) inf_commute integral_restrict_Int)
           also have "... \<le> i"
             using i'[of "M + N"] by auto
           finally show "integral (cbox a b) (?f (M + N)) \<le> i" .
         qed
       qed
       then show ?thesis
         using \<open>0 < B\<close> by blast
     qed
     ultimately have "(g has_integral i) S"
       unfolding has_integral_alt' by auto
     then show ?thesis
       using has_integral_integrable_integral i integral_unique by metis
   qed
 
   have sub: "\<And>k. integral S (\<lambda>x. f k x - f 0 x) = integral S (f k) - integral S (f 0)"
     by (simp add: integral_diff int_f)
   have *: "\<And>x m n. x \<in> S \<Longrightarrow> n\<ge>m \<Longrightarrow> f m x \<le> f n x"
     using assms(2) by (force intro: transitive_stepwise_le)
   have gf: "(\<lambda>x. g x - f 0 x) integrable_on S \<and> ((\<lambda>k. integral S (\<lambda>x. f (Suc k) x - f 0 x)) \<longlongrightarrow>
     integral S (\<lambda>x. g x - f 0 x)) sequentially"
   proof (rule lem)
     show "\<And>k. (\<lambda>x. f (Suc k) x - f 0 x) integrable_on S"
       by (simp add: integrable_diff int_f)
     show "(\<lambda>k. f (Suc k) x - f 0 x) \<longlonglongrightarrow> g x - f 0 x" if "x \<in> S" for x
     proof -
       have "(\<lambda>n. f (Suc n) x) \<longlonglongrightarrow> g x"
         using LIMSEQ_ignore_initial_segment[OF fg[OF \<open>x \<in> S\<close>], of 1] by simp
       then show ?thesis
         by (simp add: tendsto_diff)
     qed
     show "bounded (range (\<lambda>k. integral S (\<lambda>x. f (Suc k) x - f 0 x)))"
     proof -
       obtain B where B: "\<And>k. norm (integral S (f k)) \<le> B"
         using  bou by (auto simp: bounded_iff)
       then have "norm (integral S (\<lambda>x. f (Suc k) x - f 0 x))
               \<le> B + norm (integral S (f 0))" for k
         unfolding sub by (meson add_le_cancel_right norm_triangle_le_diff)
       then show ?thesis
         unfolding bounded_iff by blast
     qed
   qed (use * in auto)
   then have "(\<lambda>x. integral S (\<lambda>xa. f (Suc x) xa - f 0 xa) + integral S (f 0))
              \<longlonglongrightarrow> integral S (\<lambda>x. g x - f 0 x) + integral S (f 0)"
     by (auto simp add: tendsto_add)
   moreover have "(\<lambda>x. g x - f 0 x + f 0 x) integrable_on S"
     using gf integrable_add int_f [of 0] by metis
   ultimately show ?thesis
     by (simp add: integral_diff int_f LIMSEQ_imp_Suc sub)
 qed
 
 lemma has_integral_monotone_convergence_increasing:
   fixes f :: "nat \<Rightarrow> 'a::euclidean_space \<Rightarrow> real"
   assumes f: "\<And>k. (f k has_integral x k) s"
   assumes "\<And>k x. x \<in> s \<Longrightarrow> f k x \<le> f (Suc k) x"
   assumes "\<And>x. x \<in> s \<Longrightarrow> (\<lambda>k. f k x) \<longlonglongrightarrow> g x"
   assumes "x \<longlonglongrightarrow> x'"
   shows "(g has_integral x') s"
 proof -
   have x_eq: "x = (\<lambda>i. integral s (f i))"
     by (simp add: integral_unique[OF f])
   then have x: "range(\<lambda>k. integral s (f k)) = range x"
     by auto
   have *: "g integrable_on s \<and> (\<lambda>k. integral s (f k)) \<longlonglongrightarrow> integral s g"
   proof (intro monotone_convergence_increasing allI ballI assms)
     show "bounded (range(\<lambda>k. integral s (f k)))"
       using x convergent_imp_bounded assms by metis
   qed (use f in auto)
   then have "integral s g = x'"
     by (intro LIMSEQ_unique[OF _ \<open>x \<longlonglongrightarrow> x'\<close>]) (simp add: x_eq)
   with * show ?thesis
     by (simp add: has_integral_integral)
 qed
 
 lemma monotone_convergence_decreasing:
   fixes f :: "nat \<Rightarrow> 'n::euclidean_space \<Rightarrow> real"
   assumes intf: "\<And>k. (f k) integrable_on S"
     and le: "\<And>k x. x \<in> S \<Longrightarrow> f (Suc k) x \<le> f k x"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> ((\<lambda>k. f k x) \<longlongrightarrow> g x) sequentially"
     and bou: "bounded (range(\<lambda>k. integral S (f k)))"
   shows "g integrable_on S \<and> (\<lambda>k. integral S (f k)) \<longlonglongrightarrow> integral S g"
 proof -
   have *: "range(\<lambda>k. integral S (\<lambda>x. - f k x)) = (*\<^sub>R) (- 1) ` (range(\<lambda>k. integral S (f k)))"
     by force
   have "(\<lambda>x. - g x) integrable_on S \<and> (\<lambda>k. integral S (\<lambda>x. - f k x)) \<longlonglongrightarrow> integral S (\<lambda>x. - g x)"
   proof (rule monotone_convergence_increasing)
     show "\<And>k. (\<lambda>x. - f k x) integrable_on S"
       by (blast intro: integrable_neg intf)
     show "\<And>k x. x \<in> S \<Longrightarrow> - f k x \<le> - f (Suc k) x"
       by (simp add: le)
     show "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>k. - f k x) \<longlonglongrightarrow> - g x"
       by (simp add: fg tendsto_minus)
     show "bounded (range(\<lambda>k. integral S (\<lambda>x. - f k x)))"
       using "*" bou bounded_scaling by auto
   qed
   then show ?thesis
     by (force dest: integrable_neg tendsto_minus)
 qed
 
 lemma integral_norm_bound_integral:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   assumes int_f: "f integrable_on S"
     and int_g: "g integrable_on S"
     and le_g: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
   shows "norm (integral S f) \<le> integral S g"
 proof -
   have norm: "norm \<eta> \<le> y + e"
     if "norm \<zeta> \<le> x" and "\<bar>x - y\<bar> < e/2" and "norm (\<zeta> - \<eta>) < e/2"
     for e x y and \<zeta> \<eta> :: 'a
   proof -
     have "norm (\<eta> - \<zeta>) < e/2"
       by (metis norm_minus_commute that(3))
     moreover have "x \<le> y + e/2"
       using that(2) by linarith
     ultimately show ?thesis
       using that(1) le_less_trans[OF norm_triangle_sub[of \<eta> \<zeta>]] by (auto simp: less_imp_le)
   qed
   have lem: "norm (integral(cbox a b) f) \<le> integral (cbox a b) g"
     if f: "f integrable_on cbox a b"
     and g: "g integrable_on cbox a b"
     and nle: "\<And>x. x \<in> cbox a b \<Longrightarrow> norm (f x) \<le> g x"
     for f :: "'n \<Rightarrow> 'a" and g a b
   proof (rule field_le_epsilon)
     fix e :: real
     assume "e > 0"
     then have e: "e/2 > 0"
       by auto
     with integrable_integral[OF f,unfolded has_integral[of f]]
     obtain \<gamma> where \<gamma>: "gauge \<gamma>"
               "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<gamma> fine \<D> 
            \<Longrightarrow> norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - integral (cbox a b) f) < e/2"
       by meson 
     moreover
     from integrable_integral[OF g,unfolded has_integral[of g]] e
     obtain \<delta> where \<delta>: "gauge \<delta>"
               "\<And>\<D>. \<D> tagged_division_of cbox a b \<and> \<delta> fine \<D> 
            \<Longrightarrow> norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - integral (cbox a b) g) < e/2"
       by meson
     ultimately have "gauge (\<lambda>x. \<gamma> x \<inter> \<delta> x)"
       using gauge_Int by blast
     with fine_division_exists obtain \<D> 
       where p: "\<D> tagged_division_of cbox a b" "(\<lambda>x. \<gamma> x \<inter> \<delta> x) fine \<D>" 
       by metis
     have "\<gamma> fine \<D>" "\<delta> fine \<D>"
       using fine_Int p(2) by blast+
     show "norm (integral (cbox a b) f) \<le> integral (cbox a b) g + e"
     proof (rule norm)
       have "norm (content K *\<^sub>R f x) \<le> content K *\<^sub>R g x" if  "(x, K) \<in> \<D>" for x K
       proof-
         have K: "x \<in> K" "K \<subseteq> cbox a b"
           using \<open>(x, K) \<in> \<D>\<close> p(1) by blast+
         obtain u v where  "K = cbox u v"
           using \<open>(x, K) \<in> \<D>\<close> p(1) by blast
         moreover have "content K * norm (f x) \<le> content K * g x"
           by (metis K subsetD dual_order.antisym measure_nonneg mult_zero_left nle not_le real_mult_le_cancel_iff2)
         then show ?thesis
           by simp
       qed
       then show "norm (\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) \<le> (\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x)"
         by (simp add: sum_norm_le split_def)
       show "norm ((\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R f x) - integral (cbox a b) f) < e/2"
         using \<open>\<gamma> fine \<D>\<close> \<gamma> p(1) by simp
       show "\<bar>(\<Sum>(x, k)\<in>\<D>. content k *\<^sub>R g x) - integral (cbox a b) g\<bar> < e/2"
         using \<open>\<delta> fine \<D>\<close> \<delta> p(1) by simp
     qed
   qed
   show ?thesis
   proof (rule field_le_epsilon)
     fix e :: real
     assume "e > 0"
     then have e: "e/2 > 0"
       by auto
     let ?f = "(\<lambda>x. if x \<in> S then f x else 0)"
     let ?g = "(\<lambda>x. if x \<in> S then g x else 0)"
     have f: "?f integrable_on cbox a b" and g: "?g integrable_on cbox a b" for a b
       using int_f int_g integrable_altD by auto
     obtain Bf where "0 < Bf"
       and Bf: "\<And>a b. ball 0 Bf \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?f has_integral z) (cbox a b) \<and> norm (z - integral S f) < e/2"
       using integrable_integral [OF int_f,unfolded has_integral'[of f]] e that by blast
     obtain Bg where "0 < Bg"
       and Bg: "\<And>a b. ball 0 Bg \<subseteq> cbox a b \<Longrightarrow>
         \<exists>z. (?g has_integral z) (cbox a b) \<and> norm (z - integral S g) < e/2"
       using integrable_integral [OF int_g,unfolded has_integral'[of g]] e that by blast
     obtain a b::'n where ab: "ball 0 Bf \<union> ball 0 Bg \<subseteq> cbox a b"
       using ball_max_Un  by (metis bounded_ball bounded_subset_cbox_symmetric)
     have "ball 0 Bf \<subseteq> cbox a b"
       using ab by auto
     with Bf obtain z where int_fz: "(?f has_integral z) (cbox a b)" and z: "norm (z - integral S f) < e/2"
       by meson
     have "ball 0 Bg \<subseteq> cbox a b"
       using ab by auto
     with Bg obtain w where int_gw: "(?g has_integral w) (cbox a b)" and w: "norm (w - integral S g) < e/2"
       by meson
     show "norm (integral S f) \<le> integral S g + e"
     proof (rule norm)
       show "norm (integral (cbox a b) ?f) \<le> integral (cbox a b) ?g"
         by (simp add: le_g lem[OF f g, of a b])
       show "\<bar>integral (cbox a b) ?g - integral S g\<bar> < e/2"
         using int_gw integral_unique w by auto
       show "norm (integral (cbox a b) ?f - integral S f) < e/2"
         using int_fz integral_unique z by blast
     qed
   qed
 qed
 
 lemma continuous_on_imp_absolutely_integrable_on:
   fixes f::"real \<Rightarrow> 'a::banach"
   shows "continuous_on {a..b} f \<Longrightarrow>
     norm (integral {a..b} f) \<le> integral {a..b} (\<lambda>x. norm (f x))"
   by (intro integral_norm_bound_integral integrable_continuous_real continuous_on_norm) auto
 
 lemma integral_bound:
   fixes f::"real \<Rightarrow> 'a::banach"
   assumes "a \<le> b"
   assumes "continuous_on {a .. b} f"
   assumes "\<And>t. t \<in> {a .. b} \<Longrightarrow> norm (f t) \<le> B"
   shows "norm (integral {a .. b} f) \<le> B * (b - a)"
 proof -
   note continuous_on_imp_absolutely_integrable_on[OF assms(2)]
   also have "integral {a..b} (\<lambda>x. norm (f x)) \<le> integral {a..b} (\<lambda>_. B)"
     by (rule integral_le)
       (auto intro!: integrable_continuous_real continuous_intros assms)
   also have "\<dots> = B * (b - a)" using assms by simp
   finally show ?thesis .
 qed
 
 lemma integral_norm_bound_integral_component:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   fixes g :: "'n \<Rightarrow> 'b::euclidean_space"
   assumes f: "f integrable_on S" and g: "g integrable_on S"
     and fg: "\<And>x. x \<in> S \<Longrightarrow> norm(f x) \<le> (g x)\<bullet>k"
   shows "norm (integral S f) \<le> (integral S g)\<bullet>k"
 proof -
   have "norm (integral S f) \<le> integral S ((\<lambda>x. x \<bullet> k) \<circ> g)"
     apply (rule integral_norm_bound_integral[OF f integrable_linear[OF g]])
     apply (simp add: bounded_linear_inner_left)
     apply (metis fg o_def)
     done
   then show ?thesis
     unfolding o_def integral_component_eq[OF g] .
 qed
 
 lemma has_integral_norm_bound_integral_component:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'a::banach"
   fixes g :: "'n \<Rightarrow> 'b::euclidean_space"
   assumes f: "(f has_integral i) S"
     and g: "(g has_integral j) S"
     and "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> (g x)\<bullet>k"
   shows "norm i \<le> j\<bullet>k"
   using integral_norm_bound_integral_component[of f S g k] 
   unfolding integral_unique[OF f] integral_unique[OF g]
   using assms
   by auto
 
 
 lemma uniformly_convergent_improper_integral:
   fixes f :: "'b \<Rightarrow> real \<Rightarrow> 'a :: {banach}"
   assumes deriv: "\<And>x. x \<ge> a \<Longrightarrow> (G has_field_derivative g x) (at x within {a..})"
   assumes integrable: "\<And>a' b x. x \<in> A \<Longrightarrow> a' \<ge> a \<Longrightarrow> b \<ge> a' \<Longrightarrow> f x integrable_on {a'..b}"
   assumes G: "convergent G"
   assumes le: "\<And>y x. y \<in> A \<Longrightarrow> x \<ge> a \<Longrightarrow> norm (f y x) \<le> g x"
   shows   "uniformly_convergent_on A (\<lambda>b x. integral {a..b} (f x))"
 proof (intro Cauchy_uniformly_convergent uniformly_Cauchy_onI', goal_cases)
   case (1 \<epsilon>)
   from G have "Cauchy G"
     by (auto intro!: convergent_Cauchy)
   with 1 obtain M where M: "dist (G (real m)) (G (real n)) < \<epsilon>" if "m \<ge> M" "n \<ge> M" for m n
     by (force simp: Cauchy_def)
   define M' where "M' = max (nat \<lceil>a\<rceil>) M"
 
   show ?case
   proof (rule exI[of _ M'], safe, goal_cases)
     case (1 x m n)
     have M': "M' \<ge> a" "M' \<ge> M" unfolding M'_def by linarith+
     have int_g: "(g has_integral (G (real n) - G (real m))) {real m..real n}"
       using 1 M' by (intro fundamental_theorem_of_calculus) 
                     (auto simp: has_field_derivative_iff_has_vector_derivative [symmetric] 
                           intro!: DERIV_subset[OF deriv])
     have int_f: "f x integrable_on {a'..real n}" if "a' \<ge> a" for a'
       using that 1 by (cases "a' \<le> real n") (auto intro: integrable)
 
     have "dist (integral {a..real m} (f x)) (integral {a..real n} (f x)) =
             norm (integral {a..real n} (f x) - integral {a..real m} (f x))"
       by (simp add: dist_norm norm_minus_commute)
     also have "integral {a..real m} (f x) + integral {real m..real n} (f x) = 
                  integral {a..real n} (f x)"
       using M' and 1 by (intro integral_combine int_f) auto
     hence "integral {a..real n} (f x) - integral {a..real m} (f x) = 
              integral {real m..real n} (f x)"
       by (simp add: algebra_simps)
     also have "norm \<dots> \<le> integral {real m..real n} g"
       using le 1 M' int_f int_g by (intro integral_norm_bound_integral) auto 
     also from int_g have "integral {real m..real n} g = G (real n) - G (real m)"
       by (simp add: has_integral_iff)
     also have "\<dots> \<le> dist (G m) (G n)" 
       by (simp add: dist_norm)
     also from 1 and M' have "\<dots> < \<epsilon>"
       by (intro M) auto
     finally show ?case .
   qed
 qed
 
 lemma uniformly_convergent_improper_integral':
   fixes f :: "'b \<Rightarrow> real \<Rightarrow> 'a :: {banach, real_normed_algebra}"
   assumes deriv: "\<And>x. x \<ge> a \<Longrightarrow> (G has_field_derivative g x) (at x within {a..})"
   assumes integrable: "\<And>a' b x. x \<in> A \<Longrightarrow> a' \<ge> a \<Longrightarrow> b \<ge> a' \<Longrightarrow> f x integrable_on {a'..b}"
   assumes G: "convergent G"
   assumes le: "eventually (\<lambda>x. \<forall>y\<in>A. norm (f y x) \<le> g x) at_top"
   shows   "uniformly_convergent_on A (\<lambda>b x. integral {a..b} (f x))"
 proof -
   from le obtain a'' where le: "\<And>y x. y \<in> A \<Longrightarrow> x \<ge> a'' \<Longrightarrow> norm (f y x) \<le> g x"
     by (auto simp: eventually_at_top_linorder)
   define a' where "a' = max a a''"
 
   have "uniformly_convergent_on A (\<lambda>b x. integral {a'..real b} (f x))"
   proof (rule uniformly_convergent_improper_integral)
     fix t assume t: "t \<ge> a'"
     hence "(G has_field_derivative g t) (at t within {a..})"
       by (intro deriv) (auto simp: a'_def)
     moreover have "{a'..} \<subseteq> {a..}" unfolding a'_def by auto
     ultimately show "(G has_field_derivative g t) (at t within {a'..})"
       by (rule DERIV_subset)
   qed (insert le, auto simp: a'_def intro: integrable G)
   hence "uniformly_convergent_on A (\<lambda>b x. integral {a..a'} (f x) + integral {a'..real b} (f x))" 
     (is ?P) by (intro uniformly_convergent_add) auto
   also have "eventually (\<lambda>x. \<forall>y\<in>A. integral {a..a'} (f y) + integral {a'..x} (f y) =
                    integral {a..x} (f y)) sequentially"
     by (intro eventually_mono [OF eventually_ge_at_top[of "nat \<lceil>a'\<rceil>"]] ballI integral_combine)
        (auto simp: a'_def intro: integrable)
   hence "?P \<longleftrightarrow> ?thesis"
     by (intro uniformly_convergent_cong) simp_all
   finally show ?thesis .
 qed
 
 subsection \<open>differentiation under the integral sign\<close>
 
 lemma integral_continuous_on_param:
   fixes f::"'a::topological_space \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes cont_fx: "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). f x t)"
   shows "continuous_on U (\<lambda>x. integral (cbox a b) (f x))"
 proof cases
   assume "content (cbox a b) \<noteq> 0"
   then have ne: "cbox a b \<noteq> {}" by auto
 
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
 
   show ?thesis
     unfolding continuous_on_def
   proof (safe intro!: tendstoI)
     fix e'::real and x
     assume "e' > 0"
     define e where "e = e' / (content (cbox a b) + 1)"
     have "e > 0" using \<open>e' > 0\<close> by (auto simp: e_def intro!: divide_pos_pos add_nonneg_pos)
     assume "x \<in> U"
     from continuous_on_prod_compactE[OF cont_fx compact_cbox \<open>x \<in> U\<close> \<open>0 < e\<close>]
     obtain X0 where X0: "x \<in> X0" "open X0"
       and fx_bound: "\<And>y t. y \<in> X0 \<inter> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> norm (f y t - f x t) \<le> e"
       unfolding split_beta fst_conv snd_conv dist_norm
       by metis
     have "\<forall>\<^sub>F y in at x within U. y \<in> X0 \<inter> U"
       using X0(1) X0(2) eventually_at_topological by auto
     then show "\<forall>\<^sub>F y in at x within U. dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) < e'"
     proof eventually_elim
       case (elim y)
       have "dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) =
         norm (integral (cbox a b) (\<lambda>t. f y t - f x t))"
         using elim \<open>x \<in> U\<close>
         unfolding dist_norm
         by (subst integral_diff)
            (auto intro!: integrable_continuous continuous_intros)
       also have "\<dots> \<le> e * content (cbox a b)"
         using elim \<open>x \<in> U\<close>
         by (intro integrable_bound)
            (auto intro!: fx_bound \<open>x \<in> U \<close> less_imp_le[OF \<open>0 < e\<close>]
               integrable_continuous continuous_intros)
       also have "\<dots> < e'"
         using \<open>0 < e'\<close> \<open>e > 0\<close>
         by (auto simp: e_def field_split_simps)
       finally show "dist (integral (cbox a b) (f y)) (integral (cbox a b) (f x)) < e'" .
     qed
   qed
 qed (auto intro!: continuous_on_const)
 
 lemma leibniz_rule:
   fixes f::"'a::banach \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow>
     ((\<lambda>x. f x t) has_derivative blinfun_apply (fx x t)) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> f x integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes [intro]: "x0 \<in> U"
   assumes "convex U"
   shows
     "((\<lambda>x. integral (cbox a b) (f x)) has_derivative integral (cbox a b) (fx x0)) (at x0 within U)"
     (is "(?F has_derivative ?dF) _")
 proof cases
   assume "content (cbox a b) \<noteq> 0"
   then have ne: "cbox a b \<noteq> {}" by auto
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   show ?thesis
   proof (intro has_derivativeI bounded_linear_scaleR_left tendstoI, fold norm_conv_dist)
     have cont_f1: "\<And>t. t \<in> cbox a b \<Longrightarrow> continuous_on U (\<lambda>x. f x t)"
       by (auto simp: continuous_on_eq_continuous_within intro!: has_derivative_continuous fx)
     note [continuous_intros] = continuous_on_compose2[OF cont_f1]
     fix e'::real
     assume "e' > 0"
     define e where "e = e' / (content (cbox a b) + 1)"
     have "e > 0" using \<open>e' > 0\<close> by (auto simp: e_def intro!: divide_pos_pos add_nonneg_pos)
     from continuous_on_prod_compactE[OF cont_fx compact_cbox \<open>x0 \<in> U\<close> \<open>e > 0\<close>]
     obtain X0 where X0: "x0 \<in> X0" "open X0"
       and fx_bound: "\<And>x t. x \<in> X0 \<inter> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> norm (fx x t - fx x0 t) \<le> e"
       unfolding split_beta fst_conv snd_conv
       by (metis dist_norm)
 
     note eventually_closed_segment[OF \<open>open X0\<close> \<open>x0 \<in> X0\<close>, of U]
     moreover
     have "\<forall>\<^sub>F x in at x0 within U. x \<in> X0"
       using \<open>open X0\<close> \<open>x0 \<in> X0\<close> eventually_at_topological by blast
     moreover have "\<forall>\<^sub>F x in at x0 within U. x \<noteq> x0"
       by (auto simp: eventually_at_filter)
     moreover have "\<forall>\<^sub>F x in at x0 within U. x \<in> U"
       by (auto simp: eventually_at_filter)
     ultimately
     show "\<forall>\<^sub>F x in at x0 within U. norm ((?F x - ?F x0 - ?dF (x - x0)) /\<^sub>R norm (x - x0)) < e'"
     proof eventually_elim
       case (elim x)
       from elim have "0 < norm (x - x0)" by simp
       have "closed_segment x0 x \<subseteq> U"
         by (rule \<open>convex U\<close>[unfolded convex_contains_segment, rule_format, OF \<open>x0 \<in> U\<close> \<open>x \<in> U\<close>])
       from elim have [intro]: "x \<in> U" by auto
       have "?F x - ?F x0 - ?dF (x - x0) =
         integral (cbox a b) (\<lambda>y. f x y - f x0 y - fx x0 y (x - x0))"
         (is "_ = ?id")
         using \<open>x \<noteq> x0\<close>
         by (subst blinfun_apply_integral integral_diff,
             auto intro!: integrable_diff integrable_f2 continuous_intros
               intro: integrable_continuous)+
       also
       {
         fix t assume t: "t \<in> (cbox a b)"
         have seg: "\<And>t. t \<in> {0..1} \<Longrightarrow> x0 + t *\<^sub>R (x - x0) \<in> X0 \<inter> U"
           using \<open>closed_segment x0 x \<subseteq> U\<close>
             \<open>closed_segment x0 x \<subseteq> X0\<close>
           by (force simp: closed_segment_def algebra_simps)
         from t have deriv:
           "((\<lambda>x. f x t) has_derivative (fx y t)) (at y within X0 \<inter> U)"
           if "y \<in> X0 \<inter> U" for y
           unfolding has_vector_derivative_def[symmetric]
           using that \<open>x \<in> X0\<close>
           by (intro has_derivative_within_subset[OF fx]) auto
         have "\<And>x. x \<in> X0 \<inter> U \<Longrightarrow> onorm (blinfun_apply (fx x t) - (fx x0 t)) \<le> e"
           using fx_bound t
           by (auto simp add: norm_blinfun_def fun_diff_def blinfun.bilinear_simps[symmetric])
         from differentiable_bound_linearization[OF seg deriv this] X0
         have "norm (f x t - f x0 t - fx x0 t (x - x0)) \<le> e * norm (x - x0)"
           by (auto simp add: ac_simps)
       }
       then have "norm ?id \<le> integral (cbox a b) (\<lambda>_. e * norm (x - x0))"
         by (intro integral_norm_bound_integral)
           (auto intro!: continuous_intros integrable_diff integrable_f2
             intro: integrable_continuous)
       also have "\<dots> = content (cbox a b) * e * norm (x - x0)"
         by simp
       also have "\<dots> < e' * norm (x - x0)"
         using \<open>e' > 0\<close>
         apply (intro mult_strict_right_mono[OF _ \<open>0 < norm (x - x0)\<close>])
         apply (simp add: divide_simps e_def not_less)
         done
       finally have "norm (?F x - ?F x0 - ?dF (x - x0)) < e' * norm (x - x0)" .
       then show ?case
         by (auto simp: divide_simps)
     qed
   qed (rule blinfun.bounded_linear_right)
 qed (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps)
 
 lemma has_vector_derivative_eq_has_derivative_blinfun:
   "(f has_vector_derivative f') (at x within U) \<longleftrightarrow>
     (f has_derivative blinfun_scaleR_left f') (at x within U)"
   by (simp add: has_vector_derivative_def)
 
 lemma leibniz_rule_vector_derivative:
   fixes f::"real \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow>
       ((\<lambda>x. f x t) has_vector_derivative (fx x t)) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> cbox a b) (\<lambda>(x, t). fx x t)"
   assumes U: "x0 \<in> U" "convex U"
   shows "((\<lambda>x. integral (cbox a b) (f x)) has_vector_derivative integral (cbox a b) (fx x0))
       (at x0 within U)"
 proof -
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   have *: "blinfun_scaleR_left (integral (cbox a b) (fx x0)) =
     integral (cbox a b) (\<lambda>t. blinfun_scaleR_left (fx x0 t))"
     by (subst integral_linear[symmetric])
        (auto simp: has_vector_derivative_def o_def
          intro!: integrable_continuous U continuous_intros bounded_linear_intros)
   show ?thesis
     unfolding has_vector_derivative_eq_has_derivative_blinfun
     apply (rule has_derivative_eq_rhs)
     apply (rule leibniz_rule[OF _ integrable_f2 _ U, where fx="\<lambda>x t. blinfun_scaleR_left (fx x t)"])
     using fx cont_fx
     apply (auto simp: has_vector_derivative_def * split_beta intro!: continuous_intros)
     done
 qed
 
 lemma has_field_derivative_eq_has_derivative_blinfun:
   "(f has_field_derivative f') (at x within U) \<longleftrightarrow> (f has_derivative blinfun_mult_right f') (at x within U)"
   by (simp add: has_field_derivative_def)
 
 lemma leibniz_rule_field_derivative:
   fixes f::"'a::{real_normed_field, banach} \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'a"
   assumes fx: "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> ((\<lambda>x. f x t) has_field_derivative fx x t) (at x within U)"
   assumes integrable_f2: "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes cont_fx: "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes U: "x0 \<in> U" "convex U"
   shows "((\<lambda>x. integral (cbox a b) (f x)) has_field_derivative integral (cbox a b) (fx x0)) (at x0 within U)"
 proof -
   note [continuous_intros] =
     continuous_on_compose2[OF cont_fx, where f="\<lambda>y. Pair x y" for x,
       unfolded split_beta fst_conv snd_conv]
   have *: "blinfun_mult_right (integral (cbox a b) (fx x0)) =
     integral (cbox a b) (\<lambda>t. blinfun_mult_right (fx x0 t))"
     by (subst integral_linear[symmetric])
       (auto simp: has_vector_derivative_def o_def
         intro!: integrable_continuous U continuous_intros bounded_linear_intros)
   show ?thesis
     unfolding has_field_derivative_eq_has_derivative_blinfun
     apply (rule has_derivative_eq_rhs)
     apply (rule leibniz_rule[OF _ integrable_f2 _ U, where fx="\<lambda>x t. blinfun_mult_right (fx x t)"])
     using fx cont_fx
     apply (auto simp: has_field_derivative_def * split_beta intro!: continuous_intros)
     done
 qed
 
 lemma leibniz_rule_field_differentiable:
   fixes f::"'a::{real_normed_field, banach} \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'a"
   assumes "\<And>x t. x \<in> U \<Longrightarrow> t \<in> cbox a b \<Longrightarrow> ((\<lambda>x. f x t) has_field_derivative fx x t) (at x within U)"
   assumes "\<And>x. x \<in> U \<Longrightarrow> (f x) integrable_on cbox a b"
   assumes "continuous_on (U \<times> (cbox a b)) (\<lambda>(x, t). fx x t)"
   assumes "x0 \<in> U" "convex U"
   shows "(\<lambda>x. integral (cbox a b) (f x)) field_differentiable at x0 within U"
   using leibniz_rule_field_derivative[OF assms] by (auto simp: field_differentiable_def)
 
 
 subsection \<open>Exchange uniform limit and integral\<close>
 
 lemma uniform_limit_integral_cbox:
   fixes f::"'a \<Rightarrow> 'b::euclidean_space \<Rightarrow> 'c::banach"
   assumes u: "uniform_limit (cbox a b) f g F"
   assumes c: "\<And>n. continuous_on (cbox a b) (f n)"
   assumes [simp]: "F \<noteq> bot"
   obtains I J where
     "\<And>n. (f n has_integral I n) (cbox a b)"
     "(g has_integral J) (cbox a b)"
     "(I \<longlongrightarrow> J) F"
 proof -
   have fi[simp]: "f n integrable_on (cbox a b)" for n
     by (auto intro!: integrable_continuous assms)
   then obtain I where I: "\<And>n. (f n has_integral I n) (cbox a b)"
     by atomize_elim (auto simp: integrable_on_def intro!: choice)
 
   moreover
   have gi[simp]: "g integrable_on (cbox a b)"
     by (auto intro!: integrable_continuous uniform_limit_theorem[OF _ u] eventuallyI c)
   then obtain J where J: "(g has_integral J) (cbox a b)"
     by blast
 
   moreover
   have "(I \<longlongrightarrow> J) F"
   proof cases
     assume "content (cbox a b) = 0"
     hence "I = (\<lambda>_. 0)" "J = 0"
       by (auto intro!: has_integral_unique I J)
     thus ?thesis by simp
   next
     assume content_nonzero: "content (cbox a b) \<noteq> 0"
     show ?thesis
     proof (rule tendstoI)
       fix e::real
       assume "e > 0"
       define e' where "e' = e/2"
       with \<open>e > 0\<close> have "e' > 0" by simp
       then have "\<forall>\<^sub>F n in F. \<forall>x\<in>cbox a b. norm (f n x - g x) < e' / content (cbox a b)"
         using u content_nonzero by (auto simp: uniform_limit_iff dist_norm zero_less_measure_iff)
       then show "\<forall>\<^sub>F n in F. dist (I n) J < e"
       proof eventually_elim
         case (elim n)
         have "I n = integral (cbox a b) (f n)"
             "J = integral (cbox a b) g"
           using I[of n] J by (simp_all add: integral_unique)
         then have "dist (I n) J = norm (integral (cbox a b) (\<lambda>x. f n x - g x))"
           by (simp add: integral_diff dist_norm)
         also have "\<dots> \<le> integral (cbox a b) (\<lambda>x. (e' / content (cbox a b)))"
           using elim
           by (intro integral_norm_bound_integral) (auto intro!: integrable_diff)
         also have "\<dots> < e"
           using \<open>0 < e\<close>
           by (simp add: e'_def)
         finally show ?case .
       qed
     qed
   qed
   ultimately show ?thesis ..
 qed
 
 lemma uniform_limit_integral:
   fixes f::"'a \<Rightarrow> 'b::ordered_euclidean_space \<Rightarrow> 'c::banach"
   assumes u: "uniform_limit {a..b} f g F"
   assumes c: "\<And>n. continuous_on {a..b} (f n)"
   assumes [simp]: "F \<noteq> bot"
   obtains I J where
     "\<And>n. (f n has_integral I n) {a..b}"
     "(g has_integral J) {a..b}"
     "(I \<longlongrightarrow> J) F"
   by (metis interval_cbox assms uniform_limit_integral_cbox)
 
 
 subsection \<open>Integration by parts\<close>
 
 lemma integration_by_parts_interior_strong:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes bilinear: "bounded_bilinear (prod)"
   assumes s: "finite s" and le: "a \<le> b"
   assumes cont [continuous_intros]: "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes deriv: "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
                  "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes int: "((\<lambda>x. prod (f x) (g' x)) has_integral
                   (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
 proof -
   interpret bounded_bilinear prod by fact
   have "((\<lambda>x. prod (f x) (g' x) + prod (f' x) (g x)) has_integral
           (prod (f b) (g b) - prod (f a) (g a))) {a..b}"
     using deriv by (intro fundamental_theorem_of_calculus_interior_strong[OF s le])
                    (auto intro!: continuous_intros continuous_on has_vector_derivative)
   from has_integral_diff[OF this int] show ?thesis by (simp add: algebra_simps)
 qed
 
 lemma integration_by_parts_interior:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
   by (rule integration_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (insert assms, simp_all)
 
 lemma integration_by_parts:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a..b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) - y)) {a..b}"
   shows   "((\<lambda>x. prod (f' x) (g x)) has_integral y) {a..b}"
   by (rule integration_by_parts_interior[of _ _ _ f g f' g']) (insert assms, simp_all)
 
 lemma integrable_by_parts_interior_strong:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes bilinear: "bounded_bilinear (prod)"
   assumes s: "finite s" and le: "a \<le> b"
   assumes cont [continuous_intros]: "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes deriv: "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
                  "\<And>x. x\<in>{a<..<b} - s \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes int: "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
 proof -
   from int obtain I where "((\<lambda>x. prod (f x) (g' x)) has_integral I) {a..b}"
     unfolding integrable_on_def by blast
   hence "((\<lambda>x. prod (f x) (g' x)) has_integral (prod (f b) (g b) - prod (f a) (g a) -
            (prod (f b) (g b) - prod (f a) (g a) - I))) {a..b}" by simp
   from integration_by_parts_interior_strong[OF assms(1-7) this]
     show ?thesis unfolding integrable_on_def by blast
 qed
 
 lemma integrable_by_parts_interior:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a<..<b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
   by (rule integrable_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (insert assms, simp_all)
 
 lemma integrable_by_parts:
   fixes prod :: "_ \<Rightarrow> _ \<Rightarrow> 'b :: banach"
   assumes "bounded_bilinear (prod)" "a \<le> b"
           "continuous_on {a..b} f" "continuous_on {a..b} g"
   assumes "\<And>x. x\<in>{a..b} \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
           "\<And>x. x\<in>{a..b} \<Longrightarrow> (g has_vector_derivative g' x) (at x)"
   assumes "(\<lambda>x. prod (f x) (g' x)) integrable_on {a..b}"
   shows   "(\<lambda>x. prod (f' x) (g x)) integrable_on {a..b}"
   by (rule integrable_by_parts_interior_strong[of _ "{}" _ _ f g f' g']) (insert assms, simp_all)
 
 
 subsection \<open>Integration by substitution\<close>
 
 lemma has_integral_substitution_general:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes s: "finite s" and le: "a \<le> b"
       and subset: "g ` {a..b} \<subseteq> {c..d}"
       and f [continuous_intros]: "continuous_on {c..d} f"
       and g [continuous_intros]: "continuous_on {a..b} g"
       and deriv [derivative_intros]:
               "\<And>x. x \<in> {a..b} - s \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
     shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f - integral {g b..g a} f)) {a..b}"
 proof -
   let ?F = "\<lambda>x. integral {c..g x} f"
   have cont_int: "continuous_on {a..b} ?F"
     by (rule continuous_on_compose2[OF _ g subset] indefinite_integral_continuous_1
           f integrable_continuous_real)+
   have deriv: "(((\<lambda>x. integral {c..x} f) \<circ> g) has_vector_derivative g' x *\<^sub>R f (g x))
                  (at x within {a..b})" if "x \<in> {a..b} - s" for x
   proof (rule has_vector_derivative_eq_rhs [OF vector_diff_chain_within refl])
     show "(g has_vector_derivative g' x) (at x within {a..b})"
       using deriv has_field_derivative_iff_has_vector_derivative that by blast
     show "((\<lambda>x. integral {c..x} f) has_vector_derivative f (g x)) 
           (at (g x) within g ` {a..b})"
       using that le subset
       by (blast intro: has_vector_derivative_within_subset integral_has_vector_derivative f)
   qed
   have deriv: "(?F has_vector_derivative g' x *\<^sub>R f (g x))
                   (at x)" if "x \<in> {a..b} - (s \<union> {a,b})" for x
     using deriv[of x] that by (simp add: at_within_Icc_at o_def)
   have "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (?F b - ?F a)) {a..b}"
     using le cont_int s deriv cont_int
     by (intro fundamental_theorem_of_calculus_interior_strong[of "s \<union> {a,b}"]) simp_all
   also
   from subset have "g x \<in> {c..d}" if "x \<in> {a..b}" for x using that by blast
   from this[of a] this[of b] le have cd: "c \<le> g a" "g b \<le> d" "c \<le> g b" "g a \<le> d" by auto
   have "integral {c..g b} f - integral {c..g a} f = integral {g a..g b} f - integral {g b..g a} f"
   proof cases
     assume "g a \<le> g b"
     note le = le this
     from cd have "integral {c..g a} f + integral {g a..g b} f = integral {c..g b} f"
       by (intro integral_combine integrable_continuous_real continuous_on_subset[OF f] le) simp_all
     with le show ?thesis
       by (cases "g a = g b") (simp_all add: algebra_simps)
   next
     assume less: "\<not>g a \<le> g b"
     then have "g a \<ge> g b" by simp
     note le = le this
     from cd have "integral {c..g b} f + integral {g b..g a} f = integral {c..g a} f"
       by (intro integral_combine integrable_continuous_real continuous_on_subset[OF f] le) simp_all
     with less show ?thesis
       by (simp_all add: algebra_simps)
   qed
   finally show ?thesis .
 qed
 
 lemma has_integral_substitution_strong:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes s: "finite s" and le: "a \<le> b" "g a \<le> g b"
     and subset: "g ` {a..b} \<subseteq> {c..d}"
     and f [continuous_intros]: "continuous_on {c..d} f"
     and g [continuous_intros]: "continuous_on {a..b} g"
     and deriv [derivative_intros]:
     "\<And>x. x \<in> {a..b} - s \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
   shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f)) {a..b}"
   using has_integral_substitution_general[OF s le(1) subset f g deriv] le(2)
   by (cases "g a = g b") auto
 
 lemma has_integral_substitution:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space" and g :: "real \<Rightarrow> real"
   assumes "a \<le> b" "g a \<le> g b" "g ` {a..b} \<subseteq> {c..d}"
       and "continuous_on {c..d} f"
       and "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_field_derivative g' x) (at x within {a..b})"
     shows "((\<lambda>x. g' x *\<^sub>R f (g x)) has_integral (integral {g a..g b} f)) {a..b}"
   by (intro has_integral_substitution_strong[of "{}" a b g c d] assms)
      (auto intro: DERIV_continuous_on assms)
 
 lemma integral_shift:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes cont: "continuous_on {a + c..b + c} f"
   shows "integral {a..b} (f \<circ> (\<lambda>x. x + c)) = integral {a + c..b + c} f"
 proof (cases "a \<le> b")
   case True
   have "((\<lambda>x. 1 *\<^sub>R f (x + c)) has_integral integral {a+c..b+c} f) {a..b}"
     using True cont
     by (intro has_integral_substitution[where c = "a + c" and d = "b + c"])
        (auto intro!: derivative_eq_intros)
   thus ?thesis by (simp add: has_integral_iff o_def)
 qed auto
 
 
 subsection \<open>Compute a double integral using iterated integrals and switching the order of integration\<close>
 
 lemma continuous_on_imp_integrable_on_Pair1:
   fixes f :: "_ \<Rightarrow> 'b::banach"
   assumes con: "continuous_on (cbox (a,c) (b,d)) f" and x: "x \<in> cbox a b"
   shows "(\<lambda>y. f (x, y)) integrable_on (cbox c d)"
 proof -
   have "f \<circ> (\<lambda>y. (x, y)) integrable_on (cbox c d)"
     apply (rule integrable_continuous)
     apply (rule continuous_on_compose [OF _ continuous_on_subset [OF con]])
     using x
     apply (auto intro: continuous_on_Pair continuous_on_const continuous_on_id continuous_on_subset con)
     done
   then show ?thesis
     by (simp add: o_def)
 qed
 
 lemma integral_integrable_2dim:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) f"
     shows "(\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y))) integrable_on cbox a b"
 proof (cases "content(cbox c d) = 0")
 case True
   then show ?thesis
     by (simp add: True integrable_const)
 next
   case False
   have uc: "uniformly_continuous_on (cbox (a,c) (b,d)) f"
     by (simp add: assms compact_cbox compact_uniformly_continuous)
   { fix x::'a and e::real
     assume x: "x \<in> cbox a b" and e: "0 < e"
     then have e2_gt: "0 < e/2 / content (cbox c d)" and e2_less: "e/2 / content (cbox c d) * content (cbox c d) < e"
       by (auto simp: False content_lt_nz e)
     then obtain dd
     where dd: "\<And>x x'. \<lbrakk>x\<in>cbox (a, c) (b, d); x'\<in>cbox (a, c) (b, d); norm (x' - x) < dd\<rbrakk>
                        \<Longrightarrow> norm (f x' - f x) \<le> e/(2 * content (cbox c d))"  "dd>0"
       using uc [unfolded uniformly_continuous_on_def, THEN spec, of "e/(2 * content (cbox c d))"]
       by (auto simp: dist_norm intro: less_imp_le)
     have "\<exists>delta>0. \<forall>x'\<in>cbox a b. norm (x' - x) < delta \<longrightarrow> norm (integral (cbox c d) (\<lambda>u. f (x', u) - f (x, u))) < e"
       apply (rule_tac x=dd in exI)
       using dd e2_gt assms x
       apply clarify
       apply (rule le_less_trans [OF _ e2_less])
       apply (rule integrable_bound)
       apply (auto intro: integrable_diff continuous_on_imp_integrable_on_Pair1)
       done
   } note * = this
   show ?thesis
     apply (rule integrable_continuous)
     apply (simp add: * continuous_on_iff dist_norm integral_diff [symmetric] continuous_on_imp_integrable_on_Pair1 [OF assms])
     done
 qed
 
 lemma integral_split:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
   assumes f: "f integrable_on (cbox a b)"
       and k: "k \<in> Basis"
   shows "integral (cbox a b) f =
            integral (cbox a b \<inter> {x. x\<bullet>k \<le> c}) f +
            integral (cbox a b \<inter> {x. x\<bullet>k \<ge> c}) f"
   apply (rule integral_unique [OF has_integral_split [where c=c]])
   using k f
   apply (auto simp: has_integral_integral [symmetric])
   done
 
 lemma integral_swap_operativeI:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes f: "continuous_on s f" and e: "0 < e"
     shows "operative conj True
            (\<lambda>k. \<forall>a b c d.
                 cbox (a,c) (b,d) \<subseteq> k \<and> cbox (a,c) (b,d) \<subseteq> s
                 \<longrightarrow> norm(integral (cbox (a,c) (b,d)) f -
                          integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f((x,y)))))
                     \<le> e * content (cbox (a,c) (b,d)))"
 proof (standard, auto)
   fix a::'a and c::'b and b::'a and d::'b and u::'a and v::'a and w::'b and z::'b
   assume *: "box (a, c) (b, d) = {}"
      and cb1: "cbox (u, w) (v, z) \<subseteq> cbox (a, c) (b, d)"
      and cb2: "cbox (u, w) (v, z) \<subseteq> s"
   then have c0: "content (cbox (a, c) (b, d)) = 0"
     using * unfolding content_eq_0_interior by simp
   have c0': "content (cbox (u, w) (v, z)) = 0"
     by (fact content_0_subset [OF c0 cb1])
   show "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
           \<le> e * content (cbox (u,w) (v,z))"
     using content_cbox_pair_eq0_D [OF c0']
     by (force simp add: c0')
 next
   fix a::'a and c::'b and b::'a and d::'b
   and M::real and i::'a and j::'b
   and u::'a and v::'a and w::'b and z::'b
   assume ij: "(i,j) \<in> Basis"
      and n1: "\<forall>a' b' c' d'.
                 cbox (a',c') (b',d') \<subseteq> cbox (a,c) (b,d) \<and>
                 cbox (a',c') (b',d') \<subseteq> {x. x \<bullet> (i,j) \<le> M} \<and> cbox (a',c') (b',d') \<subseteq> s \<longrightarrow>
                 norm (integral (cbox (a',c') (b',d')) f - integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f (x,y))))
                 \<le> e * content (cbox (a',c') (b',d'))"
      and n2: "\<forall>a' b' c' d'.
                 cbox (a',c') (b',d') \<subseteq> cbox (a,c) (b,d) \<and>
                 cbox (a',c') (b',d') \<subseteq> {x. M \<le> x \<bullet> (i,j)} \<and> cbox (a',c') (b',d') \<subseteq> s \<longrightarrow>
                 norm (integral (cbox (a',c') (b',d')) f - integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f (x,y))))
                 \<le> e * content (cbox (a',c') (b',d'))"
      and subs: "cbox (u,w) (v,z) \<subseteq> cbox (a,c) (b,d)"  "cbox (u,w) (v,z) \<subseteq> s"
   have fcont: "continuous_on (cbox (u, w) (v, z)) f"
     using assms(1) continuous_on_subset  subs(2) by blast
   then have fint: "f integrable_on cbox (u, w) (v, z)"
     by (metis integrable_continuous)
   consider "i \<in> Basis" "j=0" | "j \<in> Basis" "i=0"  using ij
     by (auto simp: Euclidean_Space.Basis_prod_def)
   then show "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))))
              \<le> e * content (cbox (u,w) (v,z))" (is ?normle)
   proof cases
     case 1
     then have e: "e * content (cbox (u, w) (v, z)) =
                   e * (content (cbox u v \<inter> {x. x \<bullet> i \<le> M}) * content (cbox w z)) +
                   e * (content (cbox u v \<inter> {x. M \<le> x \<bullet> i}) * content (cbox w z))"
       by (simp add: content_split [where c=M] content_Pair algebra_simps)
     have *: "integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) =
                 integral (cbox u v \<inter> {x. x \<bullet> i \<le> M}) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) +
                 integral (cbox u v \<inter> {x. M \<le> x \<bullet> i}) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y)))"
       using 1 f subs integral_integrable_2dim continuous_on_subset
       by (blast intro: integral_split)
     show ?normle
       apply (rule norm_diff2 [OF integral_split [where c=M, OF fint ij] * e])
       using 1 subs
       apply (simp_all add: cbox_Pair_eq setcomp_dot1 [of "\<lambda>u. M\<le>u"] setcomp_dot1 [of "\<lambda>u. u\<le>M"] Sigma_Int_Paircomp1)
       apply (simp_all add: interval_split ij)
       apply (simp_all add: cbox_Pair_eq [symmetric] content_Pair [symmetric])
       apply (force simp add: interval_split [symmetric] intro!: n1 [rule_format])
       apply (force simp add: interval_split [symmetric] intro!: n2 [rule_format])
       done
   next
     case 2
     then have e: "e * content (cbox (u, w) (v, z)) =
                   e * (content (cbox u v) * content (cbox w z \<inter> {x. x \<bullet> j \<le> M})) +
                   e * (content (cbox u v) * content (cbox w z \<inter> {x. M \<le> x \<bullet> j}))"
       by (simp add: content_split [where c=M] content_Pair algebra_simps)
     have "(\<lambda>x. integral (cbox w z \<inter> {x. x \<bullet> j \<le> M}) (\<lambda>y. f (x, y))) integrable_on cbox u v"
                 "(\<lambda>x. integral (cbox w z \<inter> {x. M \<le> x \<bullet> j}) (\<lambda>y. f (x, y))) integrable_on cbox u v"
       using 2 subs
       apply (simp_all add: interval_split)
       apply (rule_tac [!] integral_integrable_2dim [OF continuous_on_subset [OF f]])
       apply (auto simp: cbox_Pair_eq interval_split [symmetric])
       done
     with 2 have *: "integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) =
                    integral (cbox u v) (\<lambda>x. integral (cbox w z \<inter> {x. x \<bullet> j \<le> M}) (\<lambda>y. f (x, y))) +
                    integral (cbox u v) (\<lambda>x. integral (cbox w z \<inter> {x. M \<le> x \<bullet> j}) (\<lambda>y. f (x, y)))"
       by (simp add: integral_add [symmetric] integral_split [symmetric]
                     continuous_on_imp_integrable_on_Pair1 [OF fcont] cong: integral_cong)
     show ?normle
       apply (rule norm_diff2 [OF integral_split [where c=M, OF fint ij] * e])
       using 2 subs
       apply (simp_all add: cbox_Pair_eq setcomp_dot2 [of "\<lambda>u. M\<le>u"] setcomp_dot2 [of "\<lambda>u. u\<le>M"] Sigma_Int_Paircomp2)
       apply (simp_all add: interval_split ij)
       apply (simp_all add: cbox_Pair_eq [symmetric] content_Pair [symmetric])
       apply (force simp add: interval_split [symmetric] intro!: n1 [rule_format])
       apply (force simp add: interval_split [symmetric] intro!: n2 [rule_format])
       done
   qed
 qed
 
 lemma integral_Pair_const:
     "integral (cbox (a,c) (b,d)) (\<lambda>x. k) =
      integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. k))"
   by (simp add: content_Pair)
 
 lemma integral_prod_continuous:
   fixes f :: "('a::euclidean_space * 'b::euclidean_space) \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a, c) (b, d)) f" (is "continuous_on ?CBOX f")
     shows "integral (cbox (a, c) (b, d)) f = integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y)))"
 proof (cases "content ?CBOX = 0")
   case True
   then show ?thesis
     by (auto simp: content_Pair)
 next
   case False
   then have cbp: "content ?CBOX > 0"
     using content_lt_nz by blast
   have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) = 0"
   proof (rule dense_eq0_I, simp)
     fix e :: real 
     assume "0 < e"
     with \<open>content ?CBOX > 0\<close> have "0 < e/content ?CBOX"
       by simp
     have f_int_acbd: "f integrable_on ?CBOX"
       by (rule integrable_continuous [OF assms])
     { fix p
       assume p: "p division_of ?CBOX"
       then have "finite p"
         by blast
       define e' where "e' = e/content ?CBOX"
       with \<open>0 < e\<close> \<open>0 < e/content ?CBOX\<close>
       have "0 < e'"
         by simp
       interpret operative conj True
            "\<lambda>k. \<forall>a' b' c' d'.
                 cbox (a', c') (b', d') \<subseteq> k \<and> cbox (a', c') (b', d') \<subseteq> ?CBOX
                 \<longrightarrow> norm (integral (cbox (a', c') (b', d')) f -
                          integral (cbox a' b') (\<lambda>x. integral (cbox c' d') (\<lambda>y. f ((x, y)))))
                     \<le> e' * content (cbox (a', c') (b', d'))"
         using assms \<open>0 < e'\<close> by (rule integral_swap_operativeI)
       have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y))))
           \<le> e' * content ?CBOX"
         if "\<And>t u v w z. t \<in> p \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> t \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> ?CBOX
           \<Longrightarrow> norm (integral (cbox (u, w) (v, z)) f -
               integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
               \<le> e' * content (cbox (u, w) (v, z))"
         using that division [of p "(a, c)" "(b, d)"] p \<open>finite p\<close> by (auto simp add: comm_monoid_set_F_and)
       with False have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x, y))))
           \<le> e"
         if "\<And>t u v w z. t \<in> p \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> t \<Longrightarrow> cbox (u, w) (v, z) \<subseteq> ?CBOX
           \<Longrightarrow> norm (integral (cbox (u, w) (v, z)) f -
               integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))))
               \<le> e * content (cbox (u, w) (v, z)) / content ?CBOX"
         using that by (simp add: e'_def)
     } note op_acbd = this
     { fix k::real and \<D> and u::'a and v w and z::'b and t1 t2 l
       assume k: "0 < k"
          and nf: "\<And>x y u v.
                   \<lbrakk>x \<in> cbox a b; y \<in> cbox c d; u \<in> cbox a b; v\<in>cbox c d; norm (u-x, v-y) < k\<rbrakk>
                   \<Longrightarrow> norm (f(u,v) - f(x,y)) < e/(2 * (content ?CBOX))"
          and p_acbd: "\<D> tagged_division_of cbox (a,c) (b,d)"
          and fine: "(\<lambda>x. ball x k) fine \<D>"  "((t1,t2), l) \<in> \<D>"
          and uwvz_sub: "cbox (u,w) (v,z) \<subseteq> l" "cbox (u,w) (v,z) \<subseteq> cbox (a,c) (b,d)"
       have t: "t1 \<in> cbox a b" "t2 \<in> cbox c d"
         by (meson fine p_acbd cbox_Pair_iff tag_in_interval)+
       have ls: "l \<subseteq> ball (t1,t2) k"
         using fine by (simp add: fine_def Ball_def)
       { fix x1 x2
         assume xuvwz: "x1 \<in> cbox u v" "x2 \<in> cbox w z"
         then have x: "x1 \<in> cbox a b" "x2 \<in> cbox c d"
           using uwvz_sub by auto
         have "norm (x1 - t1, x2 - t2) = norm (t1 - x1, t2 - x2)"
           by (simp add: norm_Pair norm_minus_commute)
         also have "norm (t1 - x1, t2 - x2) < k"
           using xuvwz ls uwvz_sub unfolding ball_def
           by (force simp add: cbox_Pair_eq dist_norm )
         finally have "norm (f (x1,x2) - f (t1,t2)) \<le> e/content ?CBOX/2"
           using nf [OF t x]  by simp
       } note nf' = this
       have f_int_uwvz: "f integrable_on cbox (u,w) (v,z)"
         using f_int_acbd uwvz_sub integrable_on_subcbox by blast
       have f_int_uv: "\<And>x. x \<in> cbox u v \<Longrightarrow> (\<lambda>y. f (x,y)) integrable_on cbox w z"
         using assms continuous_on_subset uwvz_sub
         by (blast intro: continuous_on_imp_integrable_on_Pair1)
       have 1: "norm (integral (cbox (u,w) (v,z)) f - integral (cbox (u,w) (v,z)) (\<lambda>x. f (t1,t2)))
          \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         apply (simp only: integral_diff [symmetric] f_int_uwvz integrable_const)
         apply (rule order_trans [OF integrable_bound [of "e/content ?CBOX/2"]])
         using cbp \<open>0 < e/content ?CBOX\<close> nf'
         apply (auto simp: integrable_diff f_int_uwvz integrable_const)
         done
       have int_integrable: "(\<lambda>x. integral (cbox w z) (\<lambda>y. f (x, y))) integrable_on cbox u v"
         using assms integral_integrable_2dim continuous_on_subset uwvz_sub(2) by blast
       have normint_wz:
          "\<And>x. x \<in> cbox u v \<Longrightarrow>
                norm (integral (cbox w z) (\<lambda>y. f (x, y)) - integral (cbox w z) (\<lambda>y. f (t1, t2)))
                \<le> e * content (cbox w z) / content (cbox (a, c) (b, d))/2"
         apply (simp only: integral_diff [symmetric] f_int_uv integrable_const)
         apply (rule order_trans [OF integrable_bound [of "e/content ?CBOX/2"]])
         using cbp \<open>0 < e/content ?CBOX\<close> nf'
         apply (auto simp: integrable_diff f_int_uv integrable_const)
         done
       have "norm (integral (cbox u v)
                (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y)) - integral (cbox w z) (\<lambda>y. f (t1,t2))))
             \<le> e * content (cbox w z) / content ?CBOX/2 * content (cbox u v)"
         apply (rule integrable_bound [OF _ _ normint_wz])
         using cbp \<open>0 < e/content ?CBOX\<close>
-        apply (auto simp: field_split_simps content_pos_le integrable_diff int_integrable integrable_const)
+        apply (auto simp: field_split_simps integrable_diff int_integrable integrable_const)
         done
       also have "... \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         by (simp add: content_Pair field_split_simps)
       finally have 2: "norm (integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))) -
                       integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (t1,t2))))
                 \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX/2"
         by (simp only: integral_diff [symmetric] int_integrable integrable_const)
       have norm_xx: "\<lbrakk>x' = y'; norm(x - x') \<le> e/2; norm(y - y') \<le> e/2\<rbrakk> \<Longrightarrow> norm(x - y) \<le> e" for x::'c and y x' y' e
         using norm_triangle_mono [of "x-y'" "e/2" "y'-y" "e/2"] field_sum_of_halves
         by (simp add: norm_minus_commute)
       have "norm (integral (cbox (u,w) (v,z)) f - integral (cbox u v) (\<lambda>x. integral (cbox w z) (\<lambda>y. f (x,y))))
             \<le> e * content (cbox (u,w) (v,z)) / content ?CBOX"
         by (rule norm_xx [OF integral_Pair_const 1 2])
     } note * = this
     have "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) \<le> e" 
       if "\<forall>x\<in>?CBOX. \<forall>x'\<in>?CBOX. norm (x' - x) < k \<longrightarrow> norm (f x' - f x) < e /(2 * content (?CBOX))" "0 < k" for k
     proof -
       obtain p where ptag: "p tagged_division_of cbox (a, c) (b, d)" 
                  and fine: "(\<lambda>x. ball x k) fine p"
         using fine_division_exists \<open>0 < k\<close> by blast
       show ?thesis
         apply (rule op_acbd [OF division_of_tagged_division [OF ptag]])
         using that fine ptag \<open>0 < k\<close> by (auto simp: *)
     qed
     then show "norm (integral ?CBOX f - integral (cbox a b) (\<lambda>x. integral (cbox c d) (\<lambda>y. f (x,y)))) \<le> e"
       using compact_uniformly_continuous [OF assms compact_cbox]
       apply (simp add: uniformly_continuous_on_def dist_norm)
       apply (drule_tac x="e/2 / content?CBOX" in spec)
       using cbp \<open>0 < e\<close> by (auto simp: zero_less_mult_iff)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma integral_swap_2dim:
   fixes f :: "['a::euclidean_space, 'b::euclidean_space] \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     shows "integral (cbox (a, c) (b, d)) (\<lambda>(x, y). f x y) = integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)"
 proof -
   have "((\<lambda>(x, y). f x y) has_integral integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)) (prod.swap ` (cbox (c, a) (d, b)))"
     apply (rule has_integral_twiddle [of 1 prod.swap prod.swap "\<lambda>(x,y). f y x" "integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)", simplified])
     apply (force simp: isCont_swap content_Pair has_integral_integral [symmetric] integrable_continuous swap_continuous assms)+
     done
  then show ?thesis
    by force
 qed
 
 theorem integral_swap_continuous:
   fixes f :: "['a::euclidean_space, 'b::euclidean_space] \<Rightarrow> 'c::banach"
   assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     shows "integral (cbox a b) (\<lambda>x. integral (cbox c d) (f x)) =
            integral (cbox c d) (\<lambda>y. integral (cbox a b) (\<lambda>x. f x y))"
 proof -
   have "integral (cbox a b) (\<lambda>x. integral (cbox c d) (f x)) = integral (cbox (a, c) (b, d)) (\<lambda>(x, y). f x y)"
     using integral_prod_continuous [OF assms] by auto
   also have "... = integral (cbox (c, a) (d, b)) (\<lambda>(x, y). f y x)"
     by (rule integral_swap_2dim [OF assms])
   also have "... = integral (cbox c d) (\<lambda>y. integral (cbox a b) (\<lambda>x. f x y))"
     using integral_prod_continuous [OF swap_continuous] assms
     by auto
   finally show ?thesis .
 qed
 
 
 subsection \<open>Definite integrals for exponential and power function\<close>
 
 lemma has_integral_exp_minus_to_infinity:
   assumes a: "a > 0"
   shows   "((\<lambda>x::real. exp (-a*x)) has_integral exp (-a*c)/a) {c..}"
 proof -
   define f where "f = (\<lambda>k x. if x \<in> {c..real k} then exp (-a*x) else 0)"
   {
     fix k :: nat assume k: "of_nat k \<ge> c"
     from k a
       have "((\<lambda>x. exp (-a*x)) has_integral (-exp (-a*real k)/a - (-exp (-a*c)/a))) {c..real k}"
       by (intro fundamental_theorem_of_calculus)
          (auto intro!: derivative_eq_intros
                simp: has_field_derivative_iff_has_vector_derivative [symmetric])
     hence "(f k has_integral (exp (-a*c)/a - exp (-a*real k)/a)) {c..}" unfolding f_def
       by (subst has_integral_restrict) simp_all
   } note has_integral_f = this
 
   have [simp]: "f k = (\<lambda>_. 0)" if "of_nat k < c" for k using that by (auto simp: fun_eq_iff f_def)
   have integral_f: "integral {c..} (f k) =
                       (if real k \<ge> c then exp (-a*c)/a - exp (-a*real k)/a else 0)"
     for k using integral_unique[OF has_integral_f[of k]] by simp
 
   have A: "(\<lambda>x. exp (-a*x)) integrable_on {c..} \<and>
              (\<lambda>k. integral {c..} (f k)) \<longlonglongrightarrow> integral {c..} (\<lambda>x. exp (-a*x))"
   proof (intro monotone_convergence_increasing allI ballI)
     fix k ::nat
     have "(\<lambda>x. exp (-a*x)) integrable_on {c..of_real k}" (is ?P)
       unfolding f_def by (auto intro!: continuous_intros integrable_continuous_real)
     hence  "(f k) integrable_on {c..of_real k}"
       by (rule integrable_eq) (simp add: f_def)
     then show "f k integrable_on {c..}"
       by (rule integrable_on_superset) (auto simp: f_def)
   next
     fix x assume x: "x \<in> {c..}"
     have "sequentially \<le> principal {nat \<lceil>x\<rceil>..}" unfolding at_top_def by (simp add: Inf_lower)
     also have "{nat \<lceil>x\<rceil>..} \<subseteq> {k. x \<le> real k}" by auto
     also have "inf (principal \<dots>) (principal {k. \<not>x \<le> real k}) =
                  principal ({k. x \<le> real k} \<inter> {k. \<not>x \<le> real k})" by simp
     also have "{k. x \<le> real k} \<inter> {k. \<not>x \<le> real k} = {}" by blast
     finally have "inf sequentially (principal {k. \<not>x \<le> real k}) = bot"
       by (simp add: inf.coboundedI1 bot_unique)
     with x show "(\<lambda>k. f k x) \<longlonglongrightarrow> exp (-a*x)" unfolding f_def
       by (intro filterlim_If) auto
   next
     have "\<bar>integral {c..} (f k)\<bar> \<le> exp (-a*c)/a" for k
     proof (cases "c > of_nat k")
       case False
       hence "abs (integral {c..} (f k)) = abs (exp (- (a * c)) / a - exp (- (a * real k)) / a)"
         by (simp add: integral_f)
       also have "abs (exp (- (a * c)) / a - exp (- (a * real k)) / a) =
                    exp (- (a * c)) / a - exp (- (a * real k)) / a"
         using False a by (intro abs_of_nonneg) (simp_all add: field_simps)
       also have "\<dots> \<le> exp (- a * c) / a" using a by simp
       finally show ?thesis .
     qed (insert a, simp_all add: integral_f)
     thus "bounded (range(\<lambda>k. integral {c..} (f k)))"
       by (intro boundedI[of _ "exp (-a*c)/a"]) auto
   qed (auto simp: f_def)
   have "(\<lambda>k. exp (-a*c)/a - exp (-a * of_nat k)/a) \<longlonglongrightarrow> exp (-a*c)/a - 0/a"
     by (intro tendsto_intros filterlim_compose[OF exp_at_bot]
         filterlim_tendsto_neg_mult_at_bot[OF tendsto_const] filterlim_real_sequentially)+
       (insert a, simp_all)
   moreover
   from eventually_gt_at_top[of "nat \<lceil>c\<rceil>"] have "eventually (\<lambda>k. of_nat k > c) sequentially"
     by eventually_elim linarith
   hence "eventually (\<lambda>k. exp (-a*c)/a - exp (-a * of_nat k)/a = integral {c..} (f k)) sequentially"
     by eventually_elim (simp add: integral_f) 
   ultimately have "(\<lambda>k. integral {c..} (f k)) \<longlonglongrightarrow> exp (-a*c)/a - 0/a"
     by (rule Lim_transform_eventually)
   from LIMSEQ_unique[OF conjunct2[OF A] this]
   have "integral {c..} (\<lambda>x. exp (-a*x)) = exp (-a*c)/a" by simp
   with conjunct1[OF A] show ?thesis
     by (simp add: has_integral_integral)
 qed
 
 lemma integrable_on_exp_minus_to_infinity: "a > 0 \<Longrightarrow> (\<lambda>x. exp (-a*x) :: real) integrable_on {c..}"
   using has_integral_exp_minus_to_infinity[of a c] unfolding integrable_on_def by blast
 
 lemma has_integral_powr_from_0:
   assumes a: "a > (-1::real)" and c: "c \<ge> 0"
   shows   "((\<lambda>x. x powr a) has_integral (c powr (a+1) / (a+1))) {0..c}"
 proof (cases "c = 0")
   case False
   define f where "f = (\<lambda>k x. if x \<in> {inverse (of_nat (Suc k))..c} then x powr a else 0)"
   define F where "F = (\<lambda>k. if inverse (of_nat (Suc k)) \<le> c then
                              c powr (a+1)/(a+1) - inverse (real (Suc k)) powr (a+1)/(a+1) else 0)"
   {
     fix k :: nat
     have "(f k has_integral F k) {0..c}"
     proof (cases "inverse (of_nat (Suc k)) \<le> c")
       case True
       {
         fix x assume x: "x \<ge> inverse (1 + real k)"
         have "0 < inverse (1 + real k)" by simp
         also note x
         finally have "x > 0" .
       } note x = this
       hence "((\<lambda>x. x powr a) has_integral c powr (a + 1) / (a + 1) -
                inverse (real (Suc k)) powr (a + 1) / (a + 1)) {inverse (real (Suc k))..c}"
         using True a by (intro fundamental_theorem_of_calculus)
            (auto intro!: derivative_eq_intros continuous_on_powr' continuous_on_const
-             continuous_on_id simp: has_field_derivative_iff_has_vector_derivative [symmetric])
+              simp: has_field_derivative_iff_has_vector_derivative [symmetric])
       with True show ?thesis unfolding f_def F_def by (subst has_integral_restrict) simp_all
     next
       case False
       thus ?thesis unfolding f_def F_def by (subst has_integral_restrict) auto
     qed
   } note has_integral_f = this
   have integral_f: "integral {0..c} (f k) = F k" for k
     using has_integral_f[of k] by (rule integral_unique)
 
   have A: "(\<lambda>x. x powr a) integrable_on {0..c} \<and>
            (\<lambda>k. integral {0..c} (f k)) \<longlonglongrightarrow> integral {0..c} (\<lambda>x. x powr a)"
   proof (intro monotone_convergence_increasing ballI allI)
     fix k from has_integral_f[of k] show "f k integrable_on {0..c}"
       by (auto simp: integrable_on_def)
   next
     fix k :: nat and x :: real
     {
       assume x: "inverse (real (Suc k)) \<le> x"
       have "inverse (real (Suc (Suc k))) \<le> inverse (real (Suc k))" by (simp add: field_simps)
       also note x
       finally have "inverse (real (Suc (Suc k))) \<le> x" .
     }
     thus "f k x \<le> f (Suc k) x" by (auto simp: f_def simp del: of_nat_Suc)
   next
     fix x assume x: "x \<in> {0..c}"
     show "(\<lambda>k. f k x) \<longlonglongrightarrow> x powr a"
     proof (cases "x = 0")
       case False
       with x have "x > 0" by simp
       from order_tendstoD(2)[OF LIMSEQ_inverse_real_of_nat this]
         have "eventually (\<lambda>k. x powr a = f k x) sequentially"
         by eventually_elim (insert x, simp add: f_def)
       moreover have "(\<lambda>_. x powr a) \<longlonglongrightarrow> x powr a" by simp
       ultimately show ?thesis by (blast intro: Lim_transform_eventually)
     qed (simp_all add: f_def)
   next
     {
       fix k
       from a have "F k \<le> c powr (a + 1) / (a + 1)"
         by (auto simp add: F_def divide_simps)
       also from a have "F k \<ge> 0"
         by (auto simp: F_def divide_simps simp del: of_nat_Suc intro!: powr_mono2)
       hence "F k = abs (F k)" by simp
       finally have "abs (F k) \<le>  c powr (a + 1) / (a + 1)" .
     }
     thus "bounded (range(\<lambda>k. integral {0..c} (f k)))"
       by (intro boundedI[of _ "c powr (a+1) / (a+1)"]) (auto simp: integral_f)
   qed
 
   from False c have "c > 0" by simp
   from order_tendstoD(2)[OF LIMSEQ_inverse_real_of_nat this]
     have "eventually (\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a+1) / (a+1) =
             integral {0..c} (f k)) sequentially"
     by eventually_elim (simp add: integral_f F_def)
   moreover have "(\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a + 1) / (a + 1))
                    \<longlonglongrightarrow> c powr (a + 1) / (a + 1) - 0 powr (a + 1) / (a + 1)"
     using a by (intro tendsto_intros LIMSEQ_inverse_real_of_nat) auto
   hence "(\<lambda>k. c powr (a + 1) / (a + 1) - inverse (real (Suc k)) powr (a + 1) / (a + 1))
           \<longlonglongrightarrow> c powr (a + 1) / (a + 1)" by simp
   ultimately have "(\<lambda>k. integral {0..c} (f k)) \<longlonglongrightarrow> c powr (a+1) / (a+1)"
     by (blast intro: Lim_transform_eventually)
   with A have "integral {0..c} (\<lambda>x. x powr a) = c powr (a+1) / (a+1)"
     by (blast intro: LIMSEQ_unique)
   with A show ?thesis by (simp add: has_integral_integral)
 qed (simp_all add: has_integral_refl)
 
 lemma integrable_on_powr_from_0:
   assumes a: "a > (-1::real)" and c: "c \<ge> 0"
   shows   "(\<lambda>x. x powr a) integrable_on {0..c}"
   using has_integral_powr_from_0[OF assms] unfolding integrable_on_def by blast
 
 lemma has_integral_powr_to_inf:
   fixes a e :: real
   assumes "e < -1" "a > 0"
   shows   "((\<lambda>x. x powr e) has_integral -(a powr (e + 1)) / (e + 1)) {a..}"
 proof -
   define f :: "nat \<Rightarrow> real \<Rightarrow> real" where "f = (\<lambda>n x. if x \<in> {a..n} then x powr e else 0)"
   define F where "F = (\<lambda>x. x powr (e + 1) / (e + 1))"
 
   have has_integral_f: "(f n has_integral (F n - F a)) {a..}"
     if n: "n \<ge> a" for n :: nat
   proof -
     from n assms have "((\<lambda>x. x powr e) has_integral (F n - F a)) {a..n}"
       by (intro fundamental_theorem_of_calculus) (auto intro!: derivative_eq_intros
             simp: has_field_derivative_iff_has_vector_derivative [symmetric] F_def)
     hence "(f n has_integral (F n - F a)) {a..n}"
       by (rule has_integral_eq [rotated]) (simp add: f_def)
     thus "(f n has_integral (F n - F a)) {a..}"
       by (rule has_integral_on_superset) (auto simp: f_def)
   qed
   have integral_f: "integral {a..} (f n) = (if n \<ge> a then F n - F a else 0)" for n :: nat
   proof (cases "n \<ge> a")
     case True
     with has_integral_f[OF this] show ?thesis by (simp add: integral_unique)
   next
     case False
     have "(f n has_integral 0) {a}" by (rule has_integral_refl)
     hence "(f n has_integral 0) {a..}"
       by (rule has_integral_on_superset) (insert False, simp_all add: f_def)
     with False show ?thesis by (simp add: integral_unique)
   qed
 
   have *: "(\<lambda>x. x powr e) integrable_on {a..} \<and>
            (\<lambda>n. integral {a..} (f n)) \<longlonglongrightarrow> integral {a..} (\<lambda>x. x powr e)"
   proof (intro monotone_convergence_increasing allI ballI)
     fix n :: nat
     from assms have "(\<lambda>x. x powr e) integrable_on {a..n}"
       by (auto intro!: integrable_continuous_real continuous_intros)
     hence "f n integrable_on {a..n}"
       by (rule integrable_eq) (auto simp: f_def)
     thus "f n integrable_on {a..}"
       by (rule integrable_on_superset) (auto simp: f_def)
   next
     fix n :: nat and x :: real
     show "f n x \<le> f (Suc n) x" by (auto simp: f_def)
   next
     fix x :: real assume x: "x \<in> {a..}"
     from filterlim_real_sequentially
       have "eventually (\<lambda>n. real n \<ge> x) at_top"
       by (simp add: filterlim_at_top)
     with x have "eventually (\<lambda>n. f n x = x powr e) at_top"
       by (auto elim!: eventually_mono simp: f_def)
     thus "(\<lambda>n. f n x) \<longlonglongrightarrow> x powr e" by (simp add: tendsto_eventually)
   next
     have "norm (integral {a..} (f n)) \<le> -F a" for n :: nat
     proof (cases "n \<ge> a")
       case True
       with assms have "a powr (e + 1) \<ge> n powr (e + 1)"
         by (intro powr_mono2') simp_all
       with assms show ?thesis by (auto simp: divide_simps F_def integral_f)
     qed (insert assms, simp add: integral_f F_def field_split_simps)
     thus "bounded (range(\<lambda>k. integral {a..} (f k)))"
       unfolding bounded_iff by (intro exI[of _ "-F a"]) auto
   qed
 
   from filterlim_real_sequentially
     have "eventually (\<lambda>n. real n \<ge> a) at_top"
     by (simp add: filterlim_at_top)
   hence "eventually (\<lambda>n. F n - F a = integral {a..} (f n)) at_top"
     by eventually_elim (simp add: integral_f)
   moreover have "(\<lambda>n. F n - F a) \<longlonglongrightarrow> 0 / (e + 1) - F a" unfolding F_def
     by (insert assms, (rule tendsto_intros filterlim_compose[OF tendsto_neg_powr]
           filterlim_ident filterlim_real_sequentially | simp)+)
   hence "(\<lambda>n. F n - F a) \<longlonglongrightarrow> -F a" by simp
   ultimately have "(\<lambda>n. integral {a..} (f n)) \<longlonglongrightarrow> -F a" by (blast intro: Lim_transform_eventually)
   from conjunct2[OF *] and this
     have "integral {a..} (\<lambda>x. x powr e) = -F a" by (rule LIMSEQ_unique)
   with conjunct1[OF *] show ?thesis
     by (simp add: has_integral_integral F_def)
 qed
 
 lemma has_integral_inverse_power_to_inf:
   fixes a :: real and n :: nat
   assumes "n > 1" "a > 0"
   shows   "((\<lambda>x. 1 / x ^ n) has_integral 1 / (real (n - 1) * a ^ (n - 1))) {a..}"
 proof -
   from assms have "real_of_int (-int n) < -1" by simp
   note has_integral_powr_to_inf[OF this \<open>a > 0\<close>]
   also have "- (a powr (real_of_int (- int n) + 1)) / (real_of_int (- int n) + 1) =
                  1 / (real (n - 1) * a powr (real (n - 1)))" using assms
     by (simp add: field_split_simps powr_add [symmetric] of_nat_diff)
   also from assms have "a powr (real (n - 1)) = a ^ (n - 1)"
     by (intro powr_realpow)
   finally show ?thesis
     by (rule has_integral_eq [rotated])
        (insert assms, simp_all add: powr_minus powr_realpow field_split_simps)
 qed
 
 subsubsection \<open>Adaption to ordered Euclidean spaces and the Cartesian Euclidean space\<close>
 
 lemma integral_component_eq_cart[simp]:
   fixes f :: "'n::euclidean_space \<Rightarrow> real^'m"
   assumes "f integrable_on s"
   shows "integral s (\<lambda>x. f x $ k) = integral s f $ k"
   using integral_linear[OF assms(1) bounded_linear_vec_nth,unfolded o_def] .
 
 lemma content_closed_interval:
   fixes a :: "'a::ordered_euclidean_space"
   assumes "a \<le> b"
   shows "content {a..b} = (\<Prod>i\<in>Basis. b\<bullet>i - a\<bullet>i)"
   using content_cbox[of a b] assms by (simp add: cbox_interval eucl_le[where 'a='a])
 
 lemma integrable_const_ivl[intro]:
   fixes a::"'a::ordered_euclidean_space"
   shows "(\<lambda>x. c) integrable_on {a..b}"
   unfolding cbox_interval[symmetric] by (rule integrable_const)
 
 lemma integrable_on_subinterval:
   fixes f :: "'n::ordered_euclidean_space \<Rightarrow> 'a::banach"
   assumes "f integrable_on S" "{a..b} \<subseteq> S"
   shows "f integrable_on {a..b}"
   using integrable_on_subcbox[of f S a b] assms by (simp add: cbox_interval)
 
 end
diff --git a/src/HOL/Analysis/Homeomorphism.thy b/src/HOL/Analysis/Homeomorphism.thy
--- a/src/HOL/Analysis/Homeomorphism.thy
+++ b/src/HOL/Analysis/Homeomorphism.thy
@@ -1,2255 +1,2255 @@
 (*  Title:      HOL/Analysis/Homeomorphism.thy
     Author: LC Paulson (ported from HOL Light)
 *)
 
 section \<open>Homeomorphism Theorems\<close>
 
 theory Homeomorphism
 imports Homotopy
 begin
 
 lemma homeomorphic_spheres':
   fixes a ::"'a::euclidean_space" and b ::"'b::euclidean_space"
   assumes "0 < \<delta>" and dimeq: "DIM('a) = DIM('b)"
   shows "(sphere a \<delta>) homeomorphic (sphere b \<delta>)"
 proof -
   obtain f :: "'a\<Rightarrow>'b" and g where "linear f" "linear g"
      and fg: "\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y" "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
     by (blast intro: isomorphisms_UNIV_UNIV [OF dimeq])
   then have "continuous_on UNIV f" "continuous_on UNIV g"
     using linear_continuous_on linear_linear by blast+
   then show ?thesis
     unfolding homeomorphic_minimal
     apply(rule_tac x="\<lambda>x. b + f(x - a)" in exI)
     apply(rule_tac x="\<lambda>x. a + g(x - b)" in exI)
     using assms
     apply (force intro: continuous_intros
                   continuous_on_compose2 [of _ f] continuous_on_compose2 [of _ g] simp: dist_commute dist_norm fg)
     done
 qed
 
 lemma homeomorphic_spheres_gen:
     fixes a :: "'a::euclidean_space" and b :: "'b::euclidean_space"
   assumes "0 < r" "0 < s" "DIM('a::euclidean_space) = DIM('b::euclidean_space)"
   shows "(sphere a r homeomorphic sphere b s)"
   apply (rule homeomorphic_trans [OF homeomorphic_spheres homeomorphic_spheres'])
   using assms  apply auto
   done
 
 subsection \<open>Homeomorphism of all convex compact sets with nonempty interior\<close>
 
 proposition
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and 0: "0 \<in> rel_interior S"
       and star: "\<And>x. x \<in> S \<Longrightarrow> open_segment 0 x \<subseteq> rel_interior S"
     shows starlike_compact_projective1_0:
             "S - rel_interior S homeomorphic sphere 0 1 \<inter> affine hull S"
             (is "?SMINUS homeomorphic ?SPHER")
       and starlike_compact_projective2_0:
             "S homeomorphic cball 0 1 \<inter> affine hull S"
             (is "S homeomorphic ?CBALL")
 proof -
   have starI: "(u *\<^sub>R x) \<in> rel_interior S" if "x \<in> S" "0 \<le> u" "u < 1" for x u
   proof (cases "x=0 \<or> u=0")
     case True with 0 show ?thesis by force
   next
     case False with that show ?thesis
       by (auto simp: in_segment intro: star [THEN subsetD])
   qed
   have "0 \<in> S"  using assms rel_interior_subset by auto
   define proj where "proj \<equiv> \<lambda>x::'a. x /\<^sub>R norm x"
   have eqI: "x = y" if "proj x = proj y" "norm x = norm y" for x y
     using that  by (force simp: proj_def)
   then have iff_eq: "\<And>x y. (proj x = proj y \<and> norm x = norm y) \<longleftrightarrow> x = y"
     by blast
   have projI: "x \<in> affine hull S \<Longrightarrow> proj x \<in> affine hull S" for x
     by (metis \<open>0 \<in> S\<close> affine_hull_span_0 hull_inc span_mul proj_def)
   have nproj1 [simp]: "x \<noteq> 0 \<Longrightarrow> norm(proj x) = 1" for x
     by (simp add: proj_def)
   have proj0_iff [simp]: "proj x = 0 \<longleftrightarrow> x = 0" for x
     by (simp add: proj_def)
   have cont_proj: "continuous_on (UNIV - {0}) proj"
     unfolding proj_def by (rule continuous_intros | force)+
   have proj_spherI: "\<And>x. \<lbrakk>x \<in> affine hull S; x \<noteq> 0\<rbrakk> \<Longrightarrow> proj x \<in> ?SPHER"
     by (simp add: projI)
   have "bounded S" "closed S"
     using \<open>compact S\<close> compact_eq_bounded_closed by blast+
   have inj_on_proj: "inj_on proj (S - rel_interior S)"
   proof
     fix x y
     assume x: "x \<in> S - rel_interior S"
        and y: "y \<in> S - rel_interior S" and eq: "proj x = proj y"
     then have xynot: "x \<noteq> 0" "y \<noteq> 0" "x \<in> S" "y \<in> S" "x \<notin> rel_interior S" "y \<notin> rel_interior S"
       using 0 by auto
     consider "norm x = norm y" | "norm x < norm y" | "norm x > norm y" by linarith
     then show "x = y"
     proof cases
       assume "norm x = norm y"
         with iff_eq eq show "x = y" by blast
     next
       assume *: "norm x < norm y"
       have "x /\<^sub>R norm x = norm x *\<^sub>R (x /\<^sub>R norm x) /\<^sub>R norm (norm x *\<^sub>R (x /\<^sub>R norm x))"
         by force
       then have "proj ((norm x / norm y) *\<^sub>R y) = proj x"
         by (metis (no_types) divide_inverse local.proj_def eq scaleR_scaleR)
       then have [simp]: "(norm x / norm y) *\<^sub>R y = x"
         by (rule eqI) (simp add: \<open>y \<noteq> 0\<close>)
       have no: "0 \<le> norm x / norm y" "norm x / norm y < 1"
         using * by (auto simp: field_split_simps)
       then show "x = y"
         using starI [OF \<open>y \<in> S\<close> no] xynot by auto
     next
       assume *: "norm x > norm y"
       have "y /\<^sub>R norm y = norm y *\<^sub>R (y /\<^sub>R norm y) /\<^sub>R norm (norm y *\<^sub>R (y /\<^sub>R norm y))"
         by force
       then have "proj ((norm y / norm x) *\<^sub>R x) = proj y"
         by (metis (no_types) divide_inverse local.proj_def eq scaleR_scaleR)
       then have [simp]: "(norm y / norm x) *\<^sub>R x = y"
         by (rule eqI) (simp add: \<open>x \<noteq> 0\<close>)
       have no: "0 \<le> norm y / norm x" "norm y / norm x < 1"
         using * by (auto simp: field_split_simps)
       then show "x = y"
         using starI [OF \<open>x \<in> S\<close> no] xynot by auto
     qed
   qed
   have "\<exists>surf. homeomorphism (S - rel_interior S) ?SPHER proj surf"
   proof (rule homeomorphism_compact)
     show "compact (S - rel_interior S)"
        using \<open>compact S\<close> compact_rel_boundary by blast
     show "continuous_on (S - rel_interior S) proj"
       using 0 by (blast intro: continuous_on_subset [OF cont_proj])
     show "proj ` (S - rel_interior S) = ?SPHER"
     proof
       show "proj ` (S - rel_interior S) \<subseteq> ?SPHER"
         using 0 by (force simp: hull_inc projI intro: nproj1)
       show "?SPHER \<subseteq> proj ` (S - rel_interior S)"
       proof (clarsimp simp: proj_def)
         fix x
         assume "x \<in> affine hull S" and nox: "norm x = 1"
         then have "x \<noteq> 0" by auto
         obtain d where "0 < d" and dx: "(d *\<^sub>R x) \<in> rel_frontier S"
                    and ri: "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (e *\<^sub>R x) \<in> rel_interior S"
           using ray_to_rel_frontier [OF \<open>bounded S\<close> 0] \<open>x \<in> affine hull S\<close> \<open>x \<noteq> 0\<close> by auto
         show "x \<in> (\<lambda>x. x /\<^sub>R norm x) ` (S - rel_interior S)"
           apply (rule_tac x="d *\<^sub>R x" in image_eqI)
           using \<open>0 < d\<close>
           using dx \<open>closed S\<close> apply (auto simp: rel_frontier_def field_split_simps nox)
           done
       qed
     qed
   qed (rule inj_on_proj)
   then obtain surf where surf: "homeomorphism (S - rel_interior S) ?SPHER proj surf"
     by blast
   then have cont_surf: "continuous_on (proj ` (S - rel_interior S)) surf"
     by (auto simp: homeomorphism_def)
   have surf_nz: "\<And>x. x \<in> ?SPHER \<Longrightarrow> surf x \<noteq> 0"
     by (metis "0" DiffE homeomorphism_def imageI surf)
   have cont_nosp: "continuous_on (?SPHER) (\<lambda>x. norm x *\<^sub>R ((surf o proj) x))"
     apply (rule continuous_intros)+
     apply (rule continuous_on_subset [OF cont_proj], force)
     apply (rule continuous_on_subset [OF cont_surf])
     apply (force simp: homeomorphism_image1 [OF surf] dest: proj_spherI)
     done
   have surfpS: "\<And>x. \<lbrakk>norm x = 1; x \<in> affine hull S\<rbrakk> \<Longrightarrow> surf (proj x) \<in> S"
     by (metis (full_types) DiffE \<open>0 \<in> S\<close> homeomorphism_def image_eqI norm_zero proj_spherI real_vector.scale_zero_left scaleR_one surf)
   have *: "\<exists>y. norm y = 1 \<and> y \<in> affine hull S \<and> x = surf (proj y)"
           if "x \<in> S" "x \<notin> rel_interior S" for x
   proof -
     have "proj x \<in> ?SPHER"
       by (metis (full_types) "0" hull_inc proj_spherI that)
     moreover have "surf (proj x) = x"
       by (metis Diff_iff homeomorphism_def surf that)
     ultimately show ?thesis
       by (metis \<open>\<And>x. x \<in> ?SPHER \<Longrightarrow> surf x \<noteq> 0\<close> hull_inc inverse_1 local.proj_def norm_sgn projI scaleR_one sgn_div_norm that(1))
   qed
   have surfp_notin: "\<And>x. \<lbrakk>norm x = 1; x \<in> affine hull S\<rbrakk> \<Longrightarrow> surf (proj x) \<notin> rel_interior S"
     by (metis (full_types) DiffE one_neq_zero homeomorphism_def image_eqI norm_zero proj_spherI surf)
   have no_sp_im: "(\<lambda>x. norm x *\<^sub>R surf (proj x)) ` (?SPHER) = S - rel_interior S"
     by (auto simp: surfpS image_def Bex_def surfp_notin *)
   have inj_spher: "inj_on (\<lambda>x. norm x *\<^sub>R surf (proj x)) ?SPHER"
   proof
     fix x y
     assume xy: "x \<in> ?SPHER" "y \<in> ?SPHER"
        and eq: " norm x *\<^sub>R surf (proj x) = norm y *\<^sub>R surf (proj y)"
     then have "norm x = 1" "norm y = 1" "x \<in> affine hull S" "y \<in> affine hull S"
       using 0 by auto
     with eq show "x = y"
       by (simp add: proj_def) (metis surf xy homeomorphism_def)
   qed
   have co01: "compact ?SPHER"
-    by (simp add: closed_affine_hull compact_Int_closed)
+    by (simp add: compact_Int_closed)
   show "?SMINUS homeomorphic ?SPHER"
     apply (subst homeomorphic_sym)
     apply (rule homeomorphic_compact [OF co01 cont_nosp [unfolded o_def] no_sp_im inj_spher])
     done
   have proj_scaleR: "\<And>a x. 0 < a \<Longrightarrow> proj (a *\<^sub>R x) = proj x"
     by (simp add: proj_def)
   have cont_sp0: "continuous_on (affine hull S - {0}) (surf o proj)"
     apply (rule continuous_on_compose [OF continuous_on_subset [OF cont_proj]], force)
     apply (rule continuous_on_subset [OF cont_surf])
     using homeomorphism_image1 proj_spherI surf by fastforce
   obtain B where "B>0" and B: "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> B"
     by (metis compact_imp_bounded \<open>compact S\<close> bounded_pos_less less_eq_real_def)
   have cont_nosp: "continuous (at x within ?CBALL) (\<lambda>x. norm x *\<^sub>R surf (proj x))"
          if "norm x \<le> 1" "x \<in> affine hull S" for x
   proof (cases "x=0")
     case True
     show ?thesis using True
       apply (simp add: continuous_within)
       apply (rule lim_null_scaleR_bounded [where B=B])
       apply (simp_all add: tendsto_norm_zero eventually_at)
       apply (rule_tac x=B in exI)
       using B surfpS proj_def projI apply (auto simp: \<open>B > 0\<close>)
       done
   next
     case False
     then have "\<forall>\<^sub>F x in at x. (x \<in> affine hull S - {0}) = (x \<in> affine hull S)"
       apply (simp add: eventually_at)
       apply (rule_tac x="norm x" in exI)
       apply (auto simp: False)
       done
     with cont_sp0 have *: "continuous (at x within affine hull S) (\<lambda>x. surf (proj x))"
       apply (simp add: continuous_on_eq_continuous_within)
       apply (drule_tac x=x in bspec, force simp: False that)
       apply (simp add: continuous_within Lim_transform_within_set)
       done
     show ?thesis
       apply (rule continuous_within_subset [where s = "affine hull S", OF _ Int_lower2])
       apply (rule continuous_intros *)+
       done
   qed
   have cont_nosp2: "continuous_on ?CBALL (\<lambda>x. norm x *\<^sub>R ((surf o proj) x))"
     by (simp add: continuous_on_eq_continuous_within cont_nosp)
   have "norm y *\<^sub>R surf (proj y) \<in> S"  if "y \<in> cball 0 1" and yaff: "y \<in> affine hull S" for y
   proof (cases "y=0")
     case True then show ?thesis
       by (simp add: \<open>0 \<in> S\<close>)
   next
     case False
     then have "norm y *\<^sub>R surf (proj y) = norm y *\<^sub>R surf (proj (y /\<^sub>R norm y))"
       by (simp add: proj_def)
     have "norm y \<le> 1" using that by simp
     have "surf (proj (y /\<^sub>R norm y)) \<in> S"
       apply (rule surfpS)
       using proj_def projI yaff
       by (auto simp: False)
     then have "surf (proj y) \<in> S"
       by (simp add: False proj_def)
     then show "norm y *\<^sub>R surf (proj y) \<in> S"
       by (metis dual_order.antisym le_less_linear norm_ge_zero rel_interior_subset scaleR_one
                 starI subset_eq \<open>norm y \<le> 1\<close>)
   qed
   moreover have "x \<in> (\<lambda>x. norm x *\<^sub>R surf (proj x)) ` (?CBALL)" if "x \<in> S" for x
   proof (cases "x=0")
     case True with that hull_inc  show ?thesis by fastforce
   next
     case False
     then have psp: "proj (surf (proj x)) = proj x"
       by (metis homeomorphism_def hull_inc proj_spherI surf that)
     have nxx: "norm x *\<^sub>R proj x = x"
       by (simp add: False local.proj_def)
     have affineI: "(1 / norm (surf (proj x))) *\<^sub>R x \<in> affine hull S"
       by (metis \<open>0 \<in> S\<close> affine_hull_span_0 hull_inc span_clauses(4) that)
     have sproj_nz: "surf (proj x) \<noteq> 0"
       by (metis False proj0_iff psp)
     then have "proj x = proj (proj x)"
       by (metis False nxx proj_scaleR zero_less_norm_iff)
     moreover have scaleproj: "\<And>a r. r *\<^sub>R proj a = (r / norm a) *\<^sub>R a"
       by (simp add: divide_inverse local.proj_def)
     ultimately have "(norm (surf (proj x)) / norm x) *\<^sub>R x \<notin> rel_interior S"
       by (metis (no_types) sproj_nz divide_self_if hull_inc norm_eq_zero nproj1 projI psp scaleR_one surfp_notin that)
     then have "(norm (surf (proj x)) / norm x) \<ge> 1"
       using starI [OF that] by (meson starI [OF that] le_less_linear norm_ge_zero zero_le_divide_iff)
     then have nole: "norm x \<le> norm (surf (proj x))"
       by (simp add: le_divide_eq_1)
     show ?thesis
       apply (rule_tac x="inverse(norm(surf (proj x))) *\<^sub>R x" in image_eqI)
       apply (metis (no_types, hide_lams) mult.commute scaleproj abs_inverse abs_norm_cancel divide_inverse norm_scaleR nxx positive_imp_inverse_positive proj_scaleR psp sproj_nz zero_less_norm_iff)
       apply (auto simp: field_split_simps nole affineI)
       done
   qed
   ultimately have im_cball: "(\<lambda>x. norm x *\<^sub>R surf (proj x)) ` ?CBALL = S"
     by blast
   have inj_cball: "inj_on (\<lambda>x. norm x *\<^sub>R surf (proj x)) ?CBALL"
   proof
     fix x y
     assume "x \<in> ?CBALL" "y \<in> ?CBALL"
        and eq: "norm x *\<^sub>R surf (proj x) = norm y *\<^sub>R surf (proj y)"
     then have x: "x \<in> affine hull S" and y: "y \<in> affine hull S"
       using 0 by auto
     show "x = y"
     proof (cases "x=0 \<or> y=0")
       case True then show "x = y" using eq proj_spherI surf_nz x y by force
     next
       case False
       with x y have speq: "surf (proj x) = surf (proj y)"
         by (metis eq homeomorphism_apply2 proj_scaleR proj_spherI surf zero_less_norm_iff)
       then have "norm x = norm y"
         by (metis \<open>x \<in> affine hull S\<close> \<open>y \<in> affine hull S\<close> eq proj_spherI real_vector.scale_cancel_right surf_nz)
       moreover have "proj x = proj y"
         by (metis (no_types) False speq homeomorphism_apply2 proj_spherI surf x y)
       ultimately show "x = y"
         using eq eqI by blast
     qed
   qed
   have co01: "compact ?CBALL"
-    by (simp add: closed_affine_hull compact_Int_closed)
+    by (simp add: compact_Int_closed)
   show "S homeomorphic ?CBALL"
     apply (subst homeomorphic_sym)
     apply (rule homeomorphic_compact [OF co01 cont_nosp2 [unfolded o_def] im_cball inj_cball])
     done
 qed
 
 corollary
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and a: "a \<in> rel_interior S"
       and star: "\<And>x. x \<in> S \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     shows starlike_compact_projective1:
             "S - rel_interior S homeomorphic sphere a 1 \<inter> affine hull S"
       and starlike_compact_projective2:
             "S homeomorphic cball a 1 \<inter> affine hull S"
 proof -
   have 1: "compact ((+) (-a) ` S)" by (meson assms compact_translation)
   have 2: "0 \<in> rel_interior ((+) (-a) ` S)"
     using a rel_interior_translation [of "- a" S] by (simp cong: image_cong_simp)
   have 3: "open_segment 0 x \<subseteq> rel_interior ((+) (-a) ` S)" if "x \<in> ((+) (-a) ` S)" for x
   proof -
     have "x+a \<in> S" using that by auto
     then have "open_segment a (x+a) \<subseteq> rel_interior S" by (metis star)
     then show ?thesis using open_segment_translation [of a 0 x]
       using rel_interior_translation [of "- a" S] by (fastforce simp add: ac_simps image_iff cong: image_cong_simp)
   qed
   have "S - rel_interior S homeomorphic ((+) (-a) ` S) - rel_interior ((+) (-a) ` S)"
     by (metis rel_interior_translation translation_diff homeomorphic_translation)
   also have "... homeomorphic sphere 0 1 \<inter> affine hull ((+) (-a) ` S)"
     by (rule starlike_compact_projective1_0 [OF 1 2 3])
   also have "... = (+) (-a) ` (sphere a 1 \<inter> affine hull S)"
     by (metis affine_hull_translation left_minus sphere_translation translation_Int)
   also have "... homeomorphic sphere a 1 \<inter> affine hull S"
     using homeomorphic_translation homeomorphic_sym by blast
   finally show "S - rel_interior S homeomorphic sphere a 1 \<inter> affine hull S" .
 
   have "S homeomorphic ((+) (-a) ` S)"
     by (metis homeomorphic_translation)
   also have "... homeomorphic cball 0 1 \<inter> affine hull ((+) (-a) ` S)"
     by (rule starlike_compact_projective2_0 [OF 1 2 3])
   also have "... = (+) (-a) ` (cball a 1 \<inter> affine hull S)"
     by (metis affine_hull_translation left_minus cball_translation translation_Int)
   also have "... homeomorphic cball a 1 \<inter> affine hull S"
     using homeomorphic_translation homeomorphic_sym by blast
   finally show "S homeomorphic cball a 1 \<inter> affine hull S" .
 qed
 
 corollary starlike_compact_projective_special:
   assumes "compact S"
     and cb01: "cball (0::'a::euclidean_space) 1 \<subseteq> S"
     and scale: "\<And>x u. \<lbrakk>x \<in> S; 0 \<le> u; u < 1\<rbrakk> \<Longrightarrow> u *\<^sub>R x \<in> S - frontier S"
   shows "S homeomorphic (cball (0::'a::euclidean_space) 1)"
 proof -
   have "ball 0 1 \<subseteq> interior S"
     using cb01 interior_cball interior_mono by blast
   then have 0: "0 \<in> rel_interior S"
     by (meson centre_in_ball subsetD interior_subset_rel_interior le_numeral_extra(2) not_le)
   have [simp]: "affine hull S = UNIV"
     using \<open>ball 0 1 \<subseteq> interior S\<close> by (auto intro!: affine_hull_nonempty_interior)
   have star: "open_segment 0 x \<subseteq> rel_interior S" if "x \<in> S" for x
   proof
     fix p assume "p \<in> open_segment 0 x"
     then obtain u where "x \<noteq> 0" and u: "0 \<le> u" "u < 1" and p: "u *\<^sub>R x = p"
       by (auto simp: in_segment)
     then show "p \<in> rel_interior S"
       using scale [OF that u] closure_subset frontier_def interior_subset_rel_interior by fastforce
   qed
   show ?thesis
     using starlike_compact_projective2_0 [OF \<open>compact S\<close> 0 star] by simp
 qed
 
 lemma homeomorphic_convex_lemma:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "convex S" "compact S" "convex T" "compact T"
       and affeq: "aff_dim S = aff_dim T"
     shows "(S - rel_interior S) homeomorphic (T - rel_interior T) \<and>
            S homeomorphic T"
 proof (cases "rel_interior S = {} \<or> rel_interior T = {}")
   case True
     then show ?thesis
       by (metis Diff_empty affeq \<open>convex S\<close> \<open>convex T\<close> aff_dim_empty homeomorphic_empty rel_interior_eq_empty aff_dim_empty)
 next
   case False
   then obtain a b where a: "a \<in> rel_interior S" and b: "b \<in> rel_interior T" by auto
   have starS: "\<And>x. x \<in> S \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     using rel_interior_closure_convex_segment
           a \<open>convex S\<close> closure_subset subsetCE by blast
   have starT: "\<And>x. x \<in> T \<Longrightarrow> open_segment b x \<subseteq> rel_interior T"
     using rel_interior_closure_convex_segment
           b \<open>convex T\<close> closure_subset subsetCE by blast
   let ?aS = "(+) (-a) ` S" and ?bT = "(+) (-b) ` T"
   have 0: "0 \<in> affine hull ?aS" "0 \<in> affine hull ?bT"
     by (metis a b subsetD hull_inc image_eqI left_minus rel_interior_subset)+
   have subs: "subspace (span ?aS)" "subspace (span ?bT)"
     by (rule subspace_span)+
   moreover
   have "dim (span ((+) (- a) ` S)) = dim (span ((+) (- b) ` T))"
     by (metis 0 aff_dim_translation_eq aff_dim_zero affeq dim_span nat_int)
   ultimately obtain f g where "linear f" "linear g"
                 and fim: "f ` span ?aS = span ?bT"
                 and gim: "g ` span ?bT = span ?aS"
                 and fno: "\<And>x. x \<in> span ?aS \<Longrightarrow> norm(f x) = norm x"
                 and gno: "\<And>x. x \<in> span ?bT \<Longrightarrow> norm(g x) = norm x"
                 and gf: "\<And>x. x \<in> span ?aS \<Longrightarrow> g(f x) = x"
                 and fg: "\<And>x. x \<in> span ?bT \<Longrightarrow> f(g x) = x"
     by (rule isometries_subspaces) blast
   have [simp]: "continuous_on A f" for A
     using \<open>linear f\<close> linear_conv_bounded_linear linear_continuous_on by blast
   have [simp]: "continuous_on B g" for B
     using \<open>linear g\<close> linear_conv_bounded_linear linear_continuous_on by blast
   have eqspanS: "affine hull ?aS = span ?aS"
     by (metis a affine_hull_span_0 subsetD hull_inc image_eqI left_minus rel_interior_subset)
   have eqspanT: "affine hull ?bT = span ?bT"
     by (metis b affine_hull_span_0 subsetD hull_inc image_eqI left_minus rel_interior_subset)
   have "S homeomorphic cball a 1 \<inter> affine hull S"
     by (rule starlike_compact_projective2 [OF \<open>compact S\<close> a starS])
   also have "... homeomorphic (+) (-a) ` (cball a 1 \<inter> affine hull S)"
     by (metis homeomorphic_translation)
   also have "... = cball 0 1 \<inter> (+) (-a) ` (affine hull S)"
     by (auto simp: dist_norm)
   also have "... = cball 0 1 \<inter> span ?aS"
     using eqspanS affine_hull_translation by blast
   also have "... homeomorphic cball 0 1 \<inter> span ?bT"
     proof (rule homeomorphicI [where f=f and g=g])
       show fim1: "f ` (cball 0 1 \<inter> span ?aS) = cball 0 1 \<inter> span ?bT"
         apply (rule subset_antisym)
          using fim fno apply (force simp:, clarify)
         by (metis IntI fg gim gno image_eqI mem_cball_0)
       show "g ` (cball 0 1 \<inter> span ?bT) = cball 0 1 \<inter> span ?aS"
         apply (rule subset_antisym)
          using gim gno apply (force simp:, clarify)
         by (metis IntI fim1 gf image_eqI)
     qed (auto simp: fg gf)
   also have "... = cball 0 1 \<inter> (+) (-b) ` (affine hull T)"
     using eqspanT affine_hull_translation by blast
   also have "... = (+) (-b) ` (cball b 1 \<inter> affine hull T)"
     by (auto simp: dist_norm)
   also have "... homeomorphic (cball b 1 \<inter> affine hull T)"
     by (metis homeomorphic_translation homeomorphic_sym)
   also have "... homeomorphic T"
     by (metis starlike_compact_projective2 [OF \<open>compact T\<close> b starT] homeomorphic_sym)
   finally have 1: "S homeomorphic T" .
 
   have "S - rel_interior S homeomorphic sphere a 1 \<inter> affine hull S"
     by (rule starlike_compact_projective1 [OF \<open>compact S\<close> a starS])
   also have "... homeomorphic (+) (-a) ` (sphere a 1 \<inter> affine hull S)"
     by (metis homeomorphic_translation)
   also have "... = sphere 0 1 \<inter> (+) (-a) ` (affine hull S)"
     by (auto simp: dist_norm)
   also have "... = sphere 0 1 \<inter> span ?aS"
     using eqspanS affine_hull_translation by blast
   also have "... homeomorphic sphere 0 1 \<inter> span ?bT"
     proof (rule homeomorphicI [where f=f and g=g])
       show fim1: "f ` (sphere 0 1 \<inter> span ?aS) = sphere 0 1 \<inter> span ?bT"
         apply (rule subset_antisym)
         using fim fno apply (force simp:, clarify)
         by (metis IntI fg gim gno image_eqI mem_sphere_0)
       show "g ` (sphere 0 1 \<inter> span ?bT) = sphere 0 1 \<inter> span ?aS"
         apply (rule subset_antisym)
         using gim gno apply (force simp:, clarify)
         by (metis IntI fim1 gf image_eqI)
     qed (auto simp: fg gf)
   also have "... = sphere 0 1 \<inter> (+) (-b) ` (affine hull T)"
     using eqspanT affine_hull_translation by blast
   also have "... = (+) (-b) ` (sphere b 1 \<inter> affine hull T)"
     by (auto simp: dist_norm)
   also have "... homeomorphic (sphere b 1 \<inter> affine hull T)"
     by (metis homeomorphic_translation homeomorphic_sym)
   also have "... homeomorphic T - rel_interior T"
     by (metis starlike_compact_projective1 [OF \<open>compact T\<close> b starT] homeomorphic_sym)
   finally have 2: "S - rel_interior S homeomorphic T - rel_interior T" .
   show ?thesis
     using 1 2 by blast
 qed
 
 lemma homeomorphic_convex_compact_sets:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "convex S" "compact S" "convex T" "compact T"
       and affeq: "aff_dim S = aff_dim T"
     shows "S homeomorphic T"
 using homeomorphic_convex_lemma [OF assms] assms
 by (auto simp: rel_frontier_def)
 
 lemma homeomorphic_rel_frontiers_convex_bounded_sets:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "convex S" "bounded S" "convex T" "bounded T"
       and affeq: "aff_dim S = aff_dim T"
     shows  "rel_frontier S homeomorphic rel_frontier T"
 using assms homeomorphic_convex_lemma [of "closure S" "closure T"]
 by (simp add: rel_frontier_def convex_rel_interior_closure)
 
 
 subsection\<open>Homeomorphisms between punctured spheres and affine sets\<close>
 text\<open>Including the famous stereoscopic projection of the 3-D sphere to the complex plane\<close>
 
 text\<open>The special case with centre 0 and radius 1\<close>
 lemma homeomorphic_punctured_affine_sphere_affine_01:
   assumes "b \<in> sphere 0 1" "affine T" "0 \<in> T" "b \<in> T" "affine p"
       and affT: "aff_dim T = aff_dim p + 1"
     shows "(sphere 0 1 \<inter> T) - {b} homeomorphic p"
 proof -
   have [simp]: "norm b = 1" "b\<bullet>b = 1"
     using assms by (auto simp: norm_eq_1)
   have [simp]: "T \<inter> {v. b\<bullet>v = 0} \<noteq> {}"
     using \<open>0 \<in> T\<close> by auto
   have [simp]: "\<not> T \<subseteq> {v. b\<bullet>v = 0}"
     using \<open>norm b = 1\<close> \<open>b \<in> T\<close> by auto
   define f where "f \<equiv> \<lambda>x. 2 *\<^sub>R b + (2 / (1 - b\<bullet>x)) *\<^sub>R (x - b)"
   define g where "g \<equiv> \<lambda>y. b + (4 / (norm y ^ 2 + 4)) *\<^sub>R (y - 2 *\<^sub>R b)"
   have [simp]: "\<And>x. \<lbrakk>x \<in> T; b\<bullet>x = 0\<rbrakk> \<Longrightarrow> f (g x) = x"
     unfolding f_def g_def by (simp add: algebra_simps field_split_simps add_nonneg_eq_0_iff)
   have no: "(norm (f x))\<^sup>2 = 4 * (1 + b \<bullet> x) / (1 - b \<bullet> x)"
     if "norm x = 1" and "b \<bullet> x \<noteq> 1" for x
     using that
     apply (simp flip: dot_square_norm add: norm_eq_1 nonzero_eq_divide_eq)
     apply (simp add: f_def vector_add_divide_simps inner_simps)
     apply (use sum_sqs_eq [of 1 "b \<bullet> x"]
      in \<open>auto simp add: field_split_simps inner_commute\<close>)
     done
   have [simp]: "\<And>u::real. 8 + u * (u * 8) = u * 16 \<longleftrightarrow> u=1"
     by algebra
   have [simp]: "\<And>x. \<lbrakk>norm x = 1; b \<bullet> x \<noteq> 1\<rbrakk> \<Longrightarrow> g (f x) = x"
     unfolding g_def no by (auto simp: f_def field_split_simps)
   have [simp]: "norm (g x) = 1" if "x \<in> T" and "b \<bullet> x = 0" for x
     using that
     apply (simp only: g_def)
     apply (rule power2_eq_imp_eq)
     apply (simp_all add: dot_square_norm [symmetric] divide_simps vector_add_divide_simps)
     apply (simp add: algebra_simps inner_commute)
     done
   have [simp]: "b \<bullet> g x \<noteq> 1" if "x \<in> T" and "b \<bullet> x = 0" for x
     using that unfolding g_def
     apply (simp_all add: dot_square_norm [symmetric] divide_simps vector_add_divide_simps add_nonneg_eq_0_iff)
     apply (auto simp: algebra_simps)
     done
   have "subspace T"
     by (simp add: assms subspace_affine)
   have [simp]: "\<And>x. \<lbrakk>x \<in> T; b \<bullet> x = 0\<rbrakk> \<Longrightarrow> g x \<in> T"
     unfolding g_def
     by (blast intro: \<open>subspace T\<close> \<open>b \<in> T\<close> subspace_add subspace_mul subspace_diff)
   have "f ` {x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<subseteq> {x. b\<bullet>x = 0}"
     unfolding f_def using \<open>norm b = 1\<close> norm_eq_1
     by (force simp: field_simps inner_add_right inner_diff_right)
   moreover have "f ` T \<subseteq> T"
     unfolding f_def using assms \<open>subspace T\<close>
     by (auto simp add: inner_add_right inner_diff_right mem_affine_3_minus subspace_mul)
   moreover have "{x. b\<bullet>x = 0} \<inter> T \<subseteq> f ` ({x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<inter> T)"
     apply clarify
     apply (rule_tac x = "g x" in image_eqI, auto)
     done
   ultimately have imf: "f ` ({x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<inter> T) = {x. b\<bullet>x = 0} \<inter> T"
     by blast
   have no4: "\<And>y. b\<bullet>y = 0 \<Longrightarrow> norm ((y\<bullet>y + 4) *\<^sub>R b + 4 *\<^sub>R (y - 2 *\<^sub>R b)) = y\<bullet>y + 4"
     apply (rule power2_eq_imp_eq)
     apply (simp_all add: dot_square_norm [symmetric])
     apply (auto simp: power2_eq_square algebra_simps inner_commute)
     done
   have [simp]: "\<And>x. \<lbrakk>norm x = 1; b \<bullet> x \<noteq> 1\<rbrakk> \<Longrightarrow> b \<bullet> f x = 0"
     by (simp add: f_def algebra_simps field_split_simps)
   have [simp]: "\<And>x. \<lbrakk>x \<in> T; norm x = 1; b \<bullet> x \<noteq> 1\<rbrakk> \<Longrightarrow> f x \<in> T"
     unfolding f_def
     by (blast intro: \<open>subspace T\<close> \<open>b \<in> T\<close> subspace_add subspace_mul subspace_diff)
   have "g ` {x. b\<bullet>x = 0} \<subseteq> {x. norm x = 1 \<and> b\<bullet>x \<noteq> 1}"
     unfolding g_def
     apply (clarsimp simp: no4 vector_add_divide_simps divide_simps add_nonneg_eq_0_iff dot_square_norm [symmetric])
     apply (auto simp: algebra_simps)
     done
   moreover have "g ` T \<subseteq> T"
     unfolding g_def
     by (blast intro: \<open>subspace T\<close> \<open>b \<in> T\<close> subspace_add subspace_mul subspace_diff)
   moreover have "{x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<inter> T \<subseteq> g ` ({x. b\<bullet>x = 0} \<inter> T)"
     apply clarify
     apply (rule_tac x = "f x" in image_eqI, auto)
     done
   ultimately have img: "g ` ({x. b\<bullet>x = 0} \<inter> T) = {x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<inter> T"
     by blast
   have aff: "affine ({x. b\<bullet>x = 0} \<inter> T)"
     by (blast intro: affine_hyperplane assms)
   have contf: "continuous_on ({x. norm x = 1 \<and> b\<bullet>x \<noteq> 1} \<inter> T) f"
     unfolding f_def by (rule continuous_intros | force)+
   have contg: "continuous_on ({x. b\<bullet>x = 0} \<inter> T) g"
     unfolding g_def by (rule continuous_intros | force simp: add_nonneg_eq_0_iff)+
   have "(sphere 0 1 \<inter> T) - {b} = {x. norm x = 1 \<and> (b\<bullet>x \<noteq> 1)} \<inter> T"
     using  \<open>norm b = 1\<close> by (auto simp: norm_eq_1) (metis vector_eq  \<open>b\<bullet>b = 1\<close>)
   also have "... homeomorphic {x. b\<bullet>x = 0} \<inter> T"
     by (rule homeomorphicI [OF imf img contf contg]) auto
   also have "... homeomorphic p"
     apply (rule homeomorphic_affine_sets [OF aff \<open>affine p\<close>])
     apply (simp add: Int_commute aff_dim_affine_Int_hyperplane [OF \<open>affine T\<close>] affT)
     done
   finally show ?thesis .
 qed
 
 theorem homeomorphic_punctured_affine_sphere_affine:
   fixes a :: "'a :: euclidean_space"
   assumes "0 < r" "b \<in> sphere a r" "affine T" "a \<in> T" "b \<in> T" "affine p"
       and aff: "aff_dim T = aff_dim p + 1"
     shows "(sphere a r \<inter> T) - {b} homeomorphic p"
 proof -
   have "a \<noteq> b" using assms by auto
   then have inj: "inj (\<lambda>x::'a. x /\<^sub>R norm (a - b))"
     by (simp add: inj_on_def)
   have "((sphere a r \<inter> T) - {b}) homeomorphic
         (+) (-a) ` ((sphere a r \<inter> T) - {b})"
     by (rule homeomorphic_translation)
   also have "... homeomorphic (*\<^sub>R) (inverse r) ` (+) (- a) ` (sphere a r \<inter> T - {b})"
     by (metis \<open>0 < r\<close> homeomorphic_scaling inverse_inverse_eq inverse_zero less_irrefl)
   also have "... = sphere 0 1 \<inter> ((*\<^sub>R) (inverse r) ` (+) (- a) ` T) - {(b - a) /\<^sub>R r}"
     using assms by (auto simp: dist_norm norm_minus_commute divide_simps)
   also have "... homeomorphic p"
     apply (rule homeomorphic_punctured_affine_sphere_affine_01)
     using assms affine_translation [symmetric, of "- a"] aff_dim_translation_eq [of "- a"]
          apply (auto simp: dist_norm norm_minus_commute affine_scaling inj)
     done
   finally show ?thesis .
 qed
 
 corollary homeomorphic_punctured_sphere_affine:
   fixes a :: "'a :: euclidean_space"
   assumes "0 < r" and b: "b \<in> sphere a r"
       and "affine T" and affS: "aff_dim T + 1 = DIM('a)"
     shows "(sphere a r - {b}) homeomorphic T"
   using homeomorphic_punctured_affine_sphere_affine [of r b a UNIV T] assms by auto
 
 corollary homeomorphic_punctured_sphere_hyperplane:
   fixes a :: "'a :: euclidean_space"
   assumes "0 < r" and b: "b \<in> sphere a r"
       and "c \<noteq> 0"
     shows "(sphere a r - {b}) homeomorphic {x::'a. c \<bullet> x = d}"
 apply (rule homeomorphic_punctured_sphere_affine)
 using assms
 apply (auto simp: affine_hyperplane of_nat_diff)
 done
 
 proposition homeomorphic_punctured_sphere_affine_gen:
   fixes a :: "'a :: euclidean_space"
   assumes "convex S" "bounded S" and a: "a \<in> rel_frontier S"
       and "affine T" and affS: "aff_dim S = aff_dim T + 1"
     shows "rel_frontier S - {a} homeomorphic T"
 proof -
   obtain U :: "'a set" where "affine U" "convex U" and affdS: "aff_dim U = aff_dim S"
     using choose_affine_subset [OF affine_UNIV aff_dim_geq]
     by (meson aff_dim_affine_hull affine_affine_hull affine_imp_convex)
   have "S \<noteq> {}" using assms by auto
   then obtain z where "z \<in> U"
     by (metis aff_dim_negative_iff equals0I affdS)
   then have bne: "ball z 1 \<inter> U \<noteq> {}" by force
   then have [simp]: "aff_dim(ball z 1 \<inter> U) = aff_dim U"
     using aff_dim_convex_Int_open [OF \<open>convex U\<close> open_ball]
     by (fastforce simp add: Int_commute)
   have "rel_frontier S homeomorphic rel_frontier (ball z 1 \<inter> U)"
     by (rule homeomorphic_rel_frontiers_convex_bounded_sets)
        (auto simp: \<open>affine U\<close> affine_imp_convex convex_Int affdS assms)
   also have "... = sphere z 1 \<inter> U"
     using convex_affine_rel_frontier_Int [of "ball z 1" U]
     by (simp add: \<open>affine U\<close> bne)
   finally have "rel_frontier S homeomorphic sphere z 1 \<inter> U" . 
   then obtain h k where him: "h ` rel_frontier S = sphere z 1 \<inter> U"
                     and kim: "k ` (sphere z 1 \<inter> U) = rel_frontier S"
                     and hcon: "continuous_on (rel_frontier S) h"
                     and kcon: "continuous_on (sphere z 1 \<inter> U) k"
                     and kh:  "\<And>x. x \<in> rel_frontier S \<Longrightarrow> k(h(x)) = x"
                     and hk:  "\<And>y. y \<in> sphere z 1 \<inter> U \<Longrightarrow> h(k(y)) = y"
     unfolding homeomorphic_def homeomorphism_def by auto
   have "rel_frontier S - {a} homeomorphic (sphere z 1 \<inter> U) - {h a}"
   proof (rule homeomorphicI)
     show h: "h ` (rel_frontier S - {a}) = sphere z 1 \<inter> U - {h a}"
       using him a kh by auto metis
     show "k ` (sphere z 1 \<inter> U - {h a}) = rel_frontier S - {a}"
       by (force simp: h [symmetric] image_comp o_def kh)
   qed (auto intro: continuous_on_subset hcon kcon simp: kh hk)
   also have "... homeomorphic T"
     by (rule homeomorphic_punctured_affine_sphere_affine)
        (use a him in \<open>auto simp: affS affdS \<open>affine T\<close> \<open>affine U\<close> \<open>z \<in> U\<close>\<close>)
   finally show ?thesis .
 qed
 
 
 text\<open> When dealing with AR, ANR and ANR later, it's useful to know that every set
   is homeomorphic to a closed subset of a convex set, and
   if the set is locally compact we can take the convex set to be the universe.\<close>
 
 proposition homeomorphic_closedin_convex:
   fixes S :: "'m::euclidean_space set"
   assumes "aff_dim S < DIM('n)"
   obtains U and T :: "'n::euclidean_space set"
      where "convex U" "U \<noteq> {}" "closedin (top_of_set U) T"
            "S homeomorphic T"
 proof (cases "S = {}")
   case True then show ?thesis
     by (rule_tac U=UNIV and T="{}" in that) auto
 next
   case False
   then obtain a where "a \<in> S" by auto
   obtain i::'n where i: "i \<in> Basis" "i \<noteq> 0"
     using SOME_Basis Basis_zero by force
   have "0 \<in> affine hull ((+) (- a) ` S)"
     by (simp add: \<open>a \<in> S\<close> hull_inc)
   then have "dim ((+) (- a) ` S) = aff_dim ((+) (- a) ` S)"
     by (simp add: aff_dim_zero)
   also have "... < DIM('n)"
     by (simp add: aff_dim_translation_eq_subtract assms cong: image_cong_simp)
   finally have dd: "dim ((+) (- a) ` S) < DIM('n)"
     by linarith
   have span: "span {x. i \<bullet> x = 0} = {x. i \<bullet> x = 0}"
     using span_eq_iff [symmetric, of "{x. i \<bullet> x = 0}"] subspace_hyperplane [of i] by simp
   have "dim ((+) (- a) ` S) \<le> dim {x. i \<bullet> x = 0}"
     using dd by (simp add: dim_hyperplane [OF \<open>i \<noteq> 0\<close>])
   then obtain T where "subspace T" and Tsub: "T \<subseteq> {x. i \<bullet> x = 0}"
     and dimT: "dim T = dim ((+) (- a) ` S)"
     by (rule choose_subspace_of_subspace) (simp add: span)
   have "subspace (span ((+) (- a) ` S))"
     using subspace_span by blast
   then obtain h k where "linear h" "linear k"
                and heq: "h ` span ((+) (- a) ` S) = T"
                and keq:"k ` T = span ((+) (- a) ` S)"
                and hinv [simp]:  "\<And>x. x \<in> span ((+) (- a) ` S) \<Longrightarrow> k(h x) = x"
                and kinv [simp]:  "\<And>x. x \<in> T \<Longrightarrow> h(k x) = x"
     apply (rule isometries_subspaces [OF _ \<open>subspace T\<close>])
     apply (auto simp: dimT)
     done
   have hcont: "continuous_on A h" and kcont: "continuous_on B k" for A B
     using \<open>linear h\<close> \<open>linear k\<close> linear_continuous_on linear_conv_bounded_linear by blast+
   have ihhhh[simp]: "\<And>x. x \<in> S \<Longrightarrow> i \<bullet> h (x - a) = 0"
     using Tsub [THEN subsetD] heq span_superset by fastforce
   have "sphere 0 1 - {i} homeomorphic {x. i \<bullet> x = 0}"
     apply (rule homeomorphic_punctured_sphere_affine)
     using i
     apply (auto simp: affine_hyperplane)
     by (metis DIM_positive Suc_eq_plus1 add.left_neutral diff_add_cancel not_le not_less_eq_eq of_nat_1 of_nat_diff)
   then obtain f g where fg: "homeomorphism (sphere 0 1 - {i}) {x. i \<bullet> x = 0} f g"
     by (force simp: homeomorphic_def)
   have "h ` (+) (- a) ` S \<subseteq> T"
     using heq span_superset span_linear_image by blast
   then have "g ` h ` (+) (- a) ` S \<subseteq> g ` {x. i \<bullet> x = 0}"
     using Tsub by (simp add: image_mono)
   also have "... \<subseteq> sphere 0 1 - {i}"
     by (simp add: fg [unfolded homeomorphism_def])
   finally have gh_sub_sph: "(g \<circ> h) ` (+) (- a) ` S \<subseteq> sphere 0 1 - {i}"
     by (metis image_comp)
   then have gh_sub_cb: "(g \<circ> h) ` (+) (- a) ` S \<subseteq> cball 0 1"
     by (metis Diff_subset order_trans sphere_cball)
   have [simp]: "\<And>u. u \<in> S \<Longrightarrow> norm (g (h (u - a))) = 1"
     using gh_sub_sph [THEN subsetD] by (auto simp: o_def)
   have ghcont: "continuous_on ((\<lambda>x. x - a) ` S) (\<lambda>x. g (h x))"
     apply (rule continuous_on_compose2 [OF homeomorphism_cont2 [OF fg] hcont], force)
     done
   have kfcont: "continuous_on ((\<lambda>x. g (h (x - a))) ` S) (\<lambda>x. k (f x))"
     apply (rule continuous_on_compose2 [OF kcont])
     using homeomorphism_cont1 [OF fg] gh_sub_sph apply (force intro: continuous_on_subset, blast)
     done
   have "S homeomorphic (+) (- a) ` S"
     by (fact homeomorphic_translation)
   also have "\<dots> homeomorphic (g \<circ> h) ` (+) (- a) ` S"
     apply (simp add: homeomorphic_def homeomorphism_def cong: image_cong_simp)
     apply (rule_tac x="g \<circ> h" in exI)
     apply (rule_tac x="k \<circ> f" in exI)
     apply (auto simp: ghcont kfcont span_base homeomorphism_apply2 [OF fg] image_comp cong: image_cong_simp)
     done
   finally have Shom: "S homeomorphic (\<lambda>x. g (h x)) ` (\<lambda>x. x - a) ` S"
     by (simp cong: image_cong_simp)
   show ?thesis
     apply (rule_tac U = "ball 0 1 \<union> image (g o h) ((+) (- a) ` S)"
                 and T = "image (g o h) ((+) (- a) ` S)"
                     in that)
     apply (rule convex_intermediate_ball [of 0 1], force)
     using gh_sub_cb apply force
     apply force
     apply (simp add: closedin_closed)
     apply (rule_tac x="sphere 0 1" in exI)
      apply (auto simp: Shom cong: image_cong_simp)
     done
 qed
 
 subsection\<open>Locally compact sets in an open set\<close>
 
 text\<open> Locally compact sets are closed in an open set and are homeomorphic
   to an absolutely closed set if we have one more dimension to play with.\<close>
 
 lemma locally_compact_open_Int_closure:
   fixes S :: "'a :: metric_space set"
   assumes "locally compact S"
   obtains T where "open T" "S = T \<inter> closure S"
 proof -
   have "\<forall>x\<in>S. \<exists>T v u. u = S \<inter> T \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> S \<and> open T \<and> compact v"
     by (metis assms locally_compact openin_open)
   then obtain t v where
         tv: "\<And>x. x \<in> S
              \<Longrightarrow> v x \<subseteq> S \<and> open (t x) \<and> compact (v x) \<and> (\<exists>u. x \<in> u \<and> u \<subseteq> v x \<and> u = S \<inter> t x)"
     by metis
   then have o: "open (\<Union>(t ` S))"
     by blast
   have "S = \<Union> (v ` S)"
     using tv by blast
   also have "... = \<Union>(t ` S) \<inter> closure S"
   proof
     show "\<Union>(v ` S) \<subseteq> \<Union>(t ` S) \<inter> closure S"
       apply safe
        apply (metis Int_iff subsetD UN_iff tv)
       apply (simp add: closure_def rev_subsetD tv)
       done
     have "t x \<inter> closure S \<subseteq> v x" if "x \<in> S" for x
     proof -
       have "t x \<inter> closure S \<subseteq> closure (t x \<inter> S)"
         by (simp add: open_Int_closure_subset that tv)
       also have "... \<subseteq> v x"
         by (metis Int_commute closure_minimal compact_imp_closed that tv)
       finally show ?thesis .
     qed
     then show "\<Union>(t ` S) \<inter> closure S \<subseteq> \<Union>(v ` S)"
       by blast
   qed
   finally have e: "S = \<Union>(t ` S) \<inter> closure S" .
   show ?thesis
     by (rule that [OF o e])
 qed
 
 
 lemma locally_compact_closedin_open:
     fixes S :: "'a :: metric_space set"
     assumes "locally compact S"
     obtains T where "open T" "closedin (top_of_set T) S"
   by (metis locally_compact_open_Int_closure [OF assms] closed_closure closedin_closed_Int)
 
 
 lemma locally_compact_homeomorphism_projection_closed:
   assumes "locally compact S"
   obtains T and f :: "'a \<Rightarrow> 'a :: euclidean_space \<times> 'b :: euclidean_space"
     where "closed T" "homeomorphism S T f fst"
 proof (cases "closed S")
   case True
     then show ?thesis
       apply (rule_tac T = "S \<times> {0}" and f = "\<lambda>x. (x, 0)" in that)
       apply (auto simp: closed_Times homeomorphism_def continuous_intros)
       done
 next
   case False
     obtain U where "open U" and US: "U \<inter> closure S = S"
       by (metis locally_compact_open_Int_closure [OF assms])
     with False have Ucomp: "-U \<noteq> {}"
       using closure_eq by auto
     have [simp]: "closure (- U) = -U"
       by (simp add: \<open>open U\<close> closed_Compl)
     define f :: "'a \<Rightarrow> 'a \<times> 'b" where "f \<equiv> \<lambda>x. (x, One /\<^sub>R setdist {x} (- U))"
     have "continuous_on U (\<lambda>x. (x, One /\<^sub>R setdist {x} (- U)))"
       apply (intro continuous_intros continuous_on_setdist)
       by (simp add: Ucomp setdist_eq_0_sing_1)
     then have homU: "homeomorphism U (f`U) f fst"
       by (auto simp: f_def homeomorphism_def image_iff continuous_intros)
     have cloS: "closedin (top_of_set U) S"
       by (metis US closed_closure closedin_closed_Int)
     have cont: "isCont ((\<lambda>x. setdist {x} (- U)) o fst) z" for z :: "'a \<times> 'b"
       by (rule continuous_at_compose continuous_intros continuous_at_setdist)+
     have setdist1D: "setdist {a} (- U) *\<^sub>R b = One \<Longrightarrow> setdist {a} (- U) \<noteq> 0" for a::'a and b::'b
       by force
     have *: "r *\<^sub>R b = One \<Longrightarrow> b = (1 / r) *\<^sub>R One" for r and b::'b
       by (metis One_non_0 nonzero_divide_eq_eq real_vector.scale_eq_0_iff real_vector.scale_scale scaleR_one)
     have "f ` U = (\<lambda>z. (setdist {fst z} (- U) *\<^sub>R snd z)) -` {One}"
       apply (auto simp: f_def setdist_eq_0_sing_1 field_simps Ucomp)
       apply (rule_tac x=a in image_eqI)
       apply (auto simp: * setdist_eq_0_sing_1 dest: setdist1D)
       done
     then have clfU: "closed (f ` U)"
       apply (rule ssubst)
       apply (rule continuous_closed_vimage)
       apply (auto intro: continuous_intros cont [unfolded o_def])
       done
     have "closed (f ` S)"
        apply (rule closedin_closed_trans [OF _ clfU])
        apply (rule homeomorphism_imp_closed_map [OF homU cloS])
        done
     then show ?thesis
       apply (rule that)
       apply (rule homeomorphism_of_subsets [OF homU])
       using US apply auto
       done
 qed
 
 lemma locally_compact_closed_Int_open:
   fixes S :: "'a :: euclidean_space set"
   shows
     "locally compact S \<longleftrightarrow> (\<exists>U u. closed U \<and> open u \<and> S = U \<inter> u)"
 by (metis closed_closure closed_imp_locally_compact inf_commute locally_compact_Int locally_compact_open_Int_closure open_imp_locally_compact)
 
 
 lemma lowerdim_embeddings:
   assumes  "DIM('a) < DIM('b)"
   obtains f :: "'a::euclidean_space*real \<Rightarrow> 'b::euclidean_space" 
       and g :: "'b \<Rightarrow> 'a*real"
       and j :: 'b
   where "linear f" "linear g" "\<And>z. g (f z) = z" "j \<in> Basis" "\<And>x. f(x,0) \<bullet> j = 0"
 proof -
   let ?B = "Basis :: ('a*real) set"
   have b01: "(0,1) \<in> ?B"
     by (simp add: Basis_prod_def)
   have "DIM('a * real) \<le> DIM('b)"
     by (simp add: Suc_leI assms)
   then obtain basf :: "'a*real \<Rightarrow> 'b" where sbf: "basf ` ?B \<subseteq> Basis" and injbf: "inj_on basf Basis"
     by (metis finite_Basis card_le_inj)
   define basg:: "'b \<Rightarrow> 'a * real" where
     "basg \<equiv> \<lambda>i. if i \<in> basf ` Basis then inv_into Basis basf i else (0,1)"
   have bgf[simp]: "basg (basf i) = i" if "i \<in> Basis" for i
     using inv_into_f_f injbf that by (force simp: basg_def)
   have sbg: "basg ` Basis \<subseteq> ?B" 
     by (force simp: basg_def injbf b01)
   define f :: "'a*real \<Rightarrow> 'b" where "f \<equiv> \<lambda>u. \<Sum>j\<in>Basis. (u \<bullet> basg j) *\<^sub>R j"
   define g :: "'b \<Rightarrow> 'a*real" where "g \<equiv> \<lambda>z. (\<Sum>i\<in>Basis. (z \<bullet> basf i) *\<^sub>R i)" 
   show ?thesis
   proof
     show "linear f"
       unfolding f_def
       by (intro linear_compose_sum linearI ballI) (auto simp: algebra_simps)
     show "linear g"
       unfolding g_def
       by (intro linear_compose_sum linearI ballI) (auto simp: algebra_simps)
     have *: "(\<Sum>a \<in> Basis. a \<bullet> basf b * (x \<bullet> basg a)) = x \<bullet> b" if "b \<in> Basis" for x b
       using sbf that by auto
     show gf: "g (f x) = x" for x
       apply (rule euclidean_eqI)
       apply (simp add: f_def g_def inner_sum_left scaleR_sum_left algebra_simps)
       apply (simp add: Groups_Big.sum_distrib_left [symmetric] *)
       done
     show "basf(0,1) \<in> Basis"
       using b01 sbf by auto
     then show "f(x,0) \<bullet> basf(0,1) = 0" for x
       apply (simp add: f_def inner_sum_left)
       apply (rule comm_monoid_add_class.sum.neutral)
       using b01 inner_not_same_Basis by fastforce
   qed
 qed
 
 proposition locally_compact_homeomorphic_closed:
   fixes S :: "'a::euclidean_space set"
   assumes "locally compact S" and dimlt: "DIM('a) < DIM('b)"
   obtains T :: "'b::euclidean_space set" where "closed T" "S homeomorphic T"
 proof -
   obtain U:: "('a*real)set" and h
     where "closed U" and homU: "homeomorphism S U h fst"
     using locally_compact_homeomorphism_projection_closed assms by metis
   obtain f :: "'a*real \<Rightarrow> 'b" and g :: "'b \<Rightarrow> 'a*real"
     where "linear f" "linear g" and gf [simp]: "\<And>z. g (f z) = z"
     using lowerdim_embeddings [OF dimlt] by metis 
   then have "inj f"
     by (metis injI)
   have gfU: "g ` f ` U = U"
     by (simp add: image_comp o_def)
   have "S homeomorphic U"
     using homU homeomorphic_def by blast
   also have "... homeomorphic f ` U"
     apply (rule homeomorphicI [OF refl gfU])
        apply (meson \<open>inj f\<close> \<open>linear f\<close> homeomorphism_cont2 linear_homeomorphism_image)
     using \<open>linear g\<close> linear_continuous_on linear_conv_bounded_linear apply blast
     apply (auto simp: o_def)
     done
   finally show ?thesis
     apply (rule_tac T = "f ` U" in that)
     apply (rule closed_injective_linear_image [OF \<open>closed U\<close> \<open>linear f\<close> \<open>inj f\<close>], assumption)
     done
 qed
 
 
 lemma homeomorphic_convex_compact_lemma:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "compact S"
     and "cball 0 1 \<subseteq> S"
   shows "S homeomorphic (cball (0::'a) 1)"
 proof (rule starlike_compact_projective_special[OF assms(2-3)])
   fix x u
   assume "x \<in> S" and "0 \<le> u" and "u < (1::real)"
   have "open (ball (u *\<^sub>R x) (1 - u))"
     by (rule open_ball)
   moreover have "u *\<^sub>R x \<in> ball (u *\<^sub>R x) (1 - u)"
     unfolding centre_in_ball using \<open>u < 1\<close> by simp
   moreover have "ball (u *\<^sub>R x) (1 - u) \<subseteq> S"
   proof
     fix y
     assume "y \<in> ball (u *\<^sub>R x) (1 - u)"
     then have "dist (u *\<^sub>R x) y < 1 - u"
       unfolding mem_ball .
     with \<open>u < 1\<close> have "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> cball 0 1"
       by (simp add: dist_norm inverse_eq_divide norm_minus_commute)
     with assms(3) have "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> S" ..
     with assms(1) have "(1 - u) *\<^sub>R ((y - u *\<^sub>R x) /\<^sub>R (1 - u)) + u *\<^sub>R x \<in> S"
       using \<open>x \<in> S\<close> \<open>0 \<le> u\<close> \<open>u < 1\<close> [THEN less_imp_le] by (rule convexD_alt)
     then show "y \<in> S" using \<open>u < 1\<close>
       by simp
   qed
   ultimately have "u *\<^sub>R x \<in> interior S" ..
   then show "u *\<^sub>R x \<in> S - frontier S"
     using frontier_def and interior_subset by auto
 qed
 
 proposition homeomorphic_convex_compact_cball:
   fixes e :: real
     and S :: "'a::euclidean_space set"
   assumes "convex S"
     and "compact S"
     and "interior S \<noteq> {}"
     and "e > 0"
   shows "S homeomorphic (cball (b::'a) e)"
 proof -
   obtain a where "a \<in> interior S"
     using assms(3) by auto
   then obtain d where "d > 0" and d: "cball a d \<subseteq> S"
     unfolding mem_interior_cball by auto
   let ?d = "inverse d" and ?n = "0::'a"
   have "cball ?n 1 \<subseteq> (\<lambda>x. inverse d *\<^sub>R (x - a)) ` S"
     apply rule
     apply (rule_tac x="d *\<^sub>R x + a" in image_eqI)
     defer
     apply (rule d[unfolded subset_eq, rule_format])
     using \<open>d > 0\<close>
     unfolding mem_cball dist_norm
     apply (auto simp add: mult_right_le_one_le)
     done
   then have "(\<lambda>x. inverse d *\<^sub>R (x - a)) ` S homeomorphic cball ?n 1"
     using homeomorphic_convex_compact_lemma[of "(\<lambda>x. ?d *\<^sub>R -a + ?d *\<^sub>R x) ` S",
       OF convex_affinity compact_affinity]
     using assms(1,2)
     by (auto simp add: scaleR_right_diff_distrib)
   then show ?thesis
     apply (rule_tac homeomorphic_trans[OF _ homeomorphic_balls(2)[of 1 _ ?n]])
     apply (rule homeomorphic_trans[OF homeomorphic_affinity[of "?d" S "?d *\<^sub>R -a"]])
     using \<open>d>0\<close> \<open>e>0\<close>
     apply (auto simp add: scaleR_right_diff_distrib)
     done
 qed
 
 corollary homeomorphic_convex_compact:
   fixes S :: "'a::euclidean_space set"
     and T :: "'a set"
   assumes "convex S" "compact S" "interior S \<noteq> {}"
     and "convex T" "compact T" "interior T \<noteq> {}"
   shows "S homeomorphic T"
   using assms
   by (meson zero_less_one homeomorphic_trans homeomorphic_convex_compact_cball homeomorphic_sym)
 
 lemma homeomorphic_closed_intervals:
   fixes a :: "'a::euclidean_space" and b and c :: "'a::euclidean_space" and d
   assumes "box a b \<noteq> {}" and "box c d \<noteq> {}"
     shows "(cbox a b) homeomorphic (cbox c d)"
 apply (rule homeomorphic_convex_compact)
 using assms apply auto
 done
 
 lemma homeomorphic_closed_intervals_real:
   fixes a::real and b and c::real and d
   assumes "a<b" and "c<d"
   shows "{a..b} homeomorphic {c..d}"
   using assms by (auto intro: homeomorphic_convex_compact)
 
 subsection\<open>Covering spaces and lifting results for them\<close>
 
 definition\<^marker>\<open>tag important\<close> covering_space
            :: "'a::topological_space set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
   where
   "covering_space c p S \<equiv>
        continuous_on c p \<and> p ` c = S \<and>
        (\<forall>x \<in> S. \<exists>T. x \<in> T \<and> openin (top_of_set S) T \<and>
                     (\<exists>v. \<Union>v = c \<inter> p -` T \<and>
                         (\<forall>u \<in> v. openin (top_of_set c) u) \<and>
                         pairwise disjnt v \<and>
                         (\<forall>u \<in> v. \<exists>q. homeomorphism u T p q)))"
 
 lemma covering_space_imp_continuous: "covering_space c p S \<Longrightarrow> continuous_on c p"
   by (simp add: covering_space_def)
 
 lemma covering_space_imp_surjective: "covering_space c p S \<Longrightarrow> p ` c = S"
   by (simp add: covering_space_def)
 
 lemma homeomorphism_imp_covering_space: "homeomorphism S T f g \<Longrightarrow> covering_space S f T"
   apply (simp add: homeomorphism_def covering_space_def, clarify)
   apply (rule_tac x=T in exI, simp)
   apply (rule_tac x="{S}" in exI, auto)
   done
 
 lemma covering_space_local_homeomorphism:
   assumes "covering_space c p S" "x \<in> c"
   obtains T u q where "x \<in> T" "openin (top_of_set c) T"
                       "p x \<in> u" "openin (top_of_set S) u"
                       "homeomorphism T u p q"
 using assms
 apply (simp add: covering_space_def, clarify)
   apply (drule_tac x="p x" in bspec, force)
   by (metis IntI UnionE vimage_eq) 
 
 
 lemma covering_space_local_homeomorphism_alt:
   assumes p: "covering_space c p S" and "y \<in> S"
   obtains x T U q where "p x = y"
                         "x \<in> T" "openin (top_of_set c) T"
                         "y \<in> U" "openin (top_of_set S) U"
                           "homeomorphism T U p q"
 proof -
   obtain x where "p x = y" "x \<in> c"
     using assms covering_space_imp_surjective by blast
   show ?thesis
     apply (rule covering_space_local_homeomorphism [OF p \<open>x \<in> c\<close>])
     using that \<open>p x = y\<close> by blast
 qed
 
 proposition covering_space_open_map:
   fixes S :: "'a :: metric_space set" and T :: "'b :: metric_space set"
   assumes p: "covering_space c p S" and T: "openin (top_of_set c) T"
     shows "openin (top_of_set S) (p ` T)"
 proof -
   have pce: "p ` c = S"
    and covs:
        "\<And>x. x \<in> S \<Longrightarrow>
             \<exists>X VS. x \<in> X \<and> openin (top_of_set S) X \<and>
                   \<Union>VS = c \<inter> p -` X \<and>
                   (\<forall>u \<in> VS. openin (top_of_set c) u) \<and>
                   pairwise disjnt VS \<and>
                   (\<forall>u \<in> VS. \<exists>q. homeomorphism u X p q)"
     using p by (auto simp: covering_space_def)
   have "T \<subseteq> c"  by (metis openin_euclidean_subtopology_iff T)
   have "\<exists>X. openin (top_of_set S) X \<and> y \<in> X \<and> X \<subseteq> p ` T"
           if "y \<in> p ` T" for y
   proof -
     have "y \<in> S" using \<open>T \<subseteq> c\<close> pce that by blast
     obtain U VS where "y \<in> U" and U: "openin (top_of_set S) U"
                   and VS: "\<Union>VS = c \<inter> p -` U"
                   and openVS: "\<forall>V \<in> VS. openin (top_of_set c) V"
                   and homVS: "\<And>V. V \<in> VS \<Longrightarrow> \<exists>q. homeomorphism V U p q"
       using covs [OF \<open>y \<in> S\<close>] by auto
     obtain x where "x \<in> c" "p x \<in> U" "x \<in> T" "p x = y"
       apply simp
       using T [unfolded openin_euclidean_subtopology_iff] \<open>y \<in> U\<close> \<open>y \<in> p ` T\<close> by blast
     with VS obtain V where "x \<in> V" "V \<in> VS" by auto
     then obtain q where q: "homeomorphism V U p q" using homVS by blast
     then have ptV: "p ` (T \<inter> V) = U \<inter> q -` (T \<inter> V)"
       using VS \<open>V \<in> VS\<close> by (auto simp: homeomorphism_def)
     have ocv: "openin (top_of_set c) V"
       by (simp add: \<open>V \<in> VS\<close> openVS)
     have "openin (top_of_set U) (U \<inter> q -` (T \<inter> V))"
       apply (rule continuous_on_open [THEN iffD1, rule_format])
        using homeomorphism_def q apply blast
       using openin_subtopology_Int_subset [of c] q T unfolding homeomorphism_def
       by (metis inf.absorb_iff2 Int_commute ocv openin_euclidean_subtopology_iff)
     then have os: "openin (top_of_set S) (U \<inter> q -` (T \<inter> V))"
       using openin_trans [of U] by (simp add: Collect_conj_eq U)
     show ?thesis
       apply (rule_tac x = "p ` (T \<inter> V)" in exI)
       apply (rule conjI)
       apply (simp only: ptV os)
       using \<open>p x = y\<close> \<open>x \<in> V\<close> \<open>x \<in> T\<close> apply blast
       done
   qed
   with openin_subopen show ?thesis by blast
 qed
 
 lemma covering_space_lift_unique_gen:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   fixes g1 :: "'a \<Rightarrow> 'c::real_normed_vector"
   assumes cov: "covering_space c p S"
       and eq: "g1 a = g2 a"
       and f: "continuous_on T f"  "f ` T \<subseteq> S"
       and g1: "continuous_on T g1"  "g1 ` T \<subseteq> c"
       and fg1: "\<And>x. x \<in> T \<Longrightarrow> f x = p(g1 x)"
       and g2: "continuous_on T g2"  "g2 ` T \<subseteq> c"
       and fg2: "\<And>x. x \<in> T \<Longrightarrow> f x = p(g2 x)"
       and u_compt: "U \<in> components T" and "a \<in> U" "x \<in> U"
     shows "g1 x = g2 x"
 proof -
   have "U \<subseteq> T" by (rule in_components_subset [OF u_compt])
   define G12 where "G12 \<equiv> {x \<in> U. g1 x - g2 x = 0}"
   have "connected U" by (rule in_components_connected [OF u_compt])
   have contu: "continuous_on U g1" "continuous_on U g2"
        using \<open>U \<subseteq> T\<close> continuous_on_subset g1 g2 by blast+
   have o12: "openin (top_of_set U) G12"
   unfolding G12_def
   proof (subst openin_subopen, clarify)
     fix z
     assume z: "z \<in> U" "g1 z - g2 z = 0"
     obtain v w q where "g1 z \<in> v" and ocv: "openin (top_of_set c) v"
                    and "p (g1 z) \<in> w" and osw: "openin (top_of_set S) w"
                    and hom: "homeomorphism v w p q"
       apply (rule_tac x = "g1 z" in covering_space_local_homeomorphism [OF cov])
        using \<open>U \<subseteq> T\<close> \<open>z \<in> U\<close> g1(2) apply blast+
       done
     have "g2 z \<in> v" using \<open>g1 z \<in> v\<close> z by auto
     have gg: "U \<inter> g -` v = U \<inter> g -` (v \<inter> g ` U)" for g
       by auto
     have "openin (top_of_set (g1 ` U)) (v \<inter> g1 ` U)"
       using ocv \<open>U \<subseteq> T\<close> g1 by (fastforce simp add: openin_open)
     then have 1: "openin (top_of_set U) (U \<inter> g1 -` v)"
       unfolding gg by (blast intro: contu continuous_on_open [THEN iffD1, rule_format])
     have "openin (top_of_set (g2 ` U)) (v \<inter> g2 ` U)"
       using ocv \<open>U \<subseteq> T\<close> g2 by (fastforce simp add: openin_open)
     then have 2: "openin (top_of_set U) (U \<inter> g2 -` v)"
       unfolding gg by (blast intro: contu continuous_on_open [THEN iffD1, rule_format])
     show "\<exists>T. openin (top_of_set U) T \<and> z \<in> T \<and> T \<subseteq> {z \<in> U. g1 z - g2 z = 0}"
       using z
       apply (rule_tac x = "(U \<inter> g1 -` v) \<inter> (U \<inter> g2 -` v)" in exI)
       apply (intro conjI)
       apply (rule openin_Int [OF 1 2])
       using \<open>g1 z \<in> v\<close>  \<open>g2 z \<in> v\<close>  apply (force simp:, clarify)
       apply (metis \<open>U \<subseteq> T\<close> subsetD eq_iff_diff_eq_0 fg1 fg2 hom homeomorphism_def)
       done
   qed
   have c12: "closedin (top_of_set U) G12"
     unfolding G12_def
     by (intro continuous_intros continuous_closedin_preimage_constant contu)
   have "G12 = {} \<or> G12 = U"
     by (intro connected_clopen [THEN iffD1, rule_format] \<open>connected U\<close> conjI o12 c12)
   with eq \<open>a \<in> U\<close> have "\<And>x. x \<in> U \<Longrightarrow> g1 x - g2 x = 0" by (auto simp: G12_def)
   then show ?thesis
     using \<open>x \<in> U\<close> by force
 qed
 
 proposition covering_space_lift_unique:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   fixes g1 :: "'a \<Rightarrow> 'c::real_normed_vector"
   assumes "covering_space c p S"
           "g1 a = g2 a"
           "continuous_on T f"  "f ` T \<subseteq> S"
           "continuous_on T g1"  "g1 ` T \<subseteq> c"  "\<And>x. x \<in> T \<Longrightarrow> f x = p(g1 x)"
           "continuous_on T g2"  "g2 ` T \<subseteq> c"  "\<And>x. x \<in> T \<Longrightarrow> f x = p(g2 x)"
           "connected T"  "a \<in> T"   "x \<in> T"
    shows "g1 x = g2 x"
   using covering_space_lift_unique_gen [of c p S] in_components_self assms ex_in_conv
   by blast
 
 lemma covering_space_locally:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes loc: "locally \<phi> C" and cov: "covering_space C p S"
       and pim: "\<And>T. \<lbrakk>T \<subseteq> C; \<phi> T\<rbrakk> \<Longrightarrow> \<psi>(p ` T)"
     shows "locally \<psi> S"
 proof -
   have "locally \<psi> (p ` C)"
     apply (rule locally_open_map_image [OF loc])
     using cov covering_space_imp_continuous apply blast
     using cov covering_space_imp_surjective covering_space_open_map apply blast
     by (simp add: pim)
   then show ?thesis
     using covering_space_imp_surjective [OF cov] by metis
 qed
 
 
 proposition covering_space_locally_eq:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes cov: "covering_space C p S"
       and pim: "\<And>T. \<lbrakk>T \<subseteq> C; \<phi> T\<rbrakk> \<Longrightarrow> \<psi>(p ` T)"
       and qim: "\<And>q U. \<lbrakk>U \<subseteq> S; continuous_on U q; \<psi> U\<rbrakk> \<Longrightarrow> \<phi>(q ` U)"
     shows "locally \<psi> S \<longleftrightarrow> locally \<phi> C"
          (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (rule locallyI)
     fix V x
     assume V: "openin (top_of_set C) V" and "x \<in> V"
     have "p x \<in> p ` C"
       by (metis IntE V \<open>x \<in> V\<close> imageI openin_open)
     then obtain T \<V> where "p x \<in> T"
                       and opeT: "openin (top_of_set S) T"
                       and veq: "\<Union>\<V> = C \<inter> p -` T"
                       and ope: "\<forall>U\<in>\<V>. openin (top_of_set C) U"
                       and hom: "\<forall>U\<in>\<V>. \<exists>q. homeomorphism U T p q"
       using cov unfolding covering_space_def by (blast intro: that)
     have "x \<in> \<Union>\<V>"
       using V veq \<open>p x \<in> T\<close> \<open>x \<in> V\<close> openin_imp_subset by fastforce
     then obtain U where "x \<in> U" "U \<in> \<V>"
       by blast
     then obtain q where opeU: "openin (top_of_set C) U" and q: "homeomorphism U T p q"
       using ope hom by blast
     with V have "openin (top_of_set C) (U \<inter> V)"
       by blast
     then have UV: "openin (top_of_set S) (p ` (U \<inter> V))"
       using cov covering_space_open_map by blast
     obtain W W' where opeW: "openin (top_of_set S) W" and "\<psi> W'" "p x \<in> W" "W \<subseteq> W'" and W'sub: "W' \<subseteq> p ` (U \<inter> V)"
       using locallyE [OF L UV] \<open>x \<in> U\<close> \<open>x \<in> V\<close> by blast
     then have "W \<subseteq> T"
       by (metis Int_lower1 q homeomorphism_image1 image_Int_subset order_trans)
     show "\<exists>U Z. openin (top_of_set C) U \<and>
                  \<phi> Z \<and> x \<in> U \<and> U \<subseteq> Z \<and> Z \<subseteq> V"
     proof (intro exI conjI)
       have "openin (top_of_set T) W"
         by (meson opeW opeT openin_imp_subset openin_subset_trans \<open>W \<subseteq> T\<close>)
       then have "openin (top_of_set U) (q ` W)"
         by (meson homeomorphism_imp_open_map homeomorphism_symD q)
       then show "openin (top_of_set C) (q ` W)"
         using opeU openin_trans by blast
       show "\<phi> (q ` W')"
         by (metis (mono_tags, lifting) Int_subset_iff UV W'sub \<open>\<psi> W'\<close> continuous_on_subset dual_order.trans homeomorphism_def image_Int_subset openin_imp_subset q qim)
       show "x \<in> q ` W"
         by (metis \<open>p x \<in> W\<close> \<open>x \<in> U\<close> homeomorphism_def imageI q)
       show "q ` W \<subseteq> q ` W'"
         using \<open>W \<subseteq> W'\<close> by blast
       have "W' \<subseteq> p ` V"
         using W'sub by blast
       then show "q ` W' \<subseteq> V"
         using W'sub homeomorphism_apply1 [OF q] by auto
       qed
   qed
 next
   assume ?rhs
   then show ?lhs
     using cov covering_space_locally pim by blast
 qed
 
 lemma covering_space_locally_compact_eq:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "covering_space C p S"
   shows "locally compact S \<longleftrightarrow> locally compact C"
   apply (rule covering_space_locally_eq [OF assms])
    apply (meson assms compact_continuous_image continuous_on_subset covering_space_imp_continuous)
   using compact_continuous_image by blast
 
 lemma covering_space_locally_connected_eq:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "covering_space C p S"
     shows "locally connected S \<longleftrightarrow> locally connected C"
   apply (rule covering_space_locally_eq [OF assms])
    apply (meson connected_continuous_image assms continuous_on_subset covering_space_imp_continuous)
   using connected_continuous_image by blast
 
 lemma covering_space_locally_path_connected_eq:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "covering_space C p S"
     shows "locally path_connected S \<longleftrightarrow> locally path_connected C"
   apply (rule covering_space_locally_eq [OF assms])
    apply (meson path_connected_continuous_image assms continuous_on_subset covering_space_imp_continuous)
   using path_connected_continuous_image by blast
 
 
 lemma covering_space_locally_compact:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "locally compact C" "covering_space C p S"
   shows "locally compact S"
   using assms covering_space_locally_compact_eq by blast
 
 
 lemma covering_space_locally_connected:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "locally connected C" "covering_space C p S"
   shows "locally connected S"
   using assms covering_space_locally_connected_eq by blast
 
 lemma covering_space_locally_path_connected:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "locally path_connected C" "covering_space C p S"
   shows "locally path_connected S"
   using assms covering_space_locally_path_connected_eq by blast
 
 proposition covering_space_lift_homotopy:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and h :: "real \<times> 'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S"
       and conth: "continuous_on ({0..1} \<times> U) h"
       and him: "h ` ({0..1} \<times> U) \<subseteq> S"
       and heq: "\<And>y. y \<in> U \<Longrightarrow> h (0,y) = p(f y)"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> C"
     obtains k where "continuous_on ({0..1} \<times> U) k"
                     "k ` ({0..1} \<times> U) \<subseteq> C"
                     "\<And>y. y \<in> U \<Longrightarrow> k(0, y) = f y"
                     "\<And>z. z \<in> {0..1} \<times> U \<Longrightarrow> h z = p(k z)"
 proof -
   have "\<exists>V k. openin (top_of_set U) V \<and> y \<in> V \<and>
               continuous_on ({0..1} \<times> V) k \<and> k ` ({0..1} \<times> V) \<subseteq> C \<and>
               (\<forall>z \<in> V. k(0, z) = f z) \<and> (\<forall>z \<in> {0..1} \<times> V. h z = p(k z))"
         if "y \<in> U" for y
   proof -
     obtain UU where UU: "\<And>s. s \<in> S \<Longrightarrow> s \<in> (UU s) \<and> openin (top_of_set S) (UU s) \<and>
                                         (\<exists>\<V>. \<Union>\<V> = C \<inter> p -` UU s \<and>
                                             (\<forall>U \<in> \<V>. openin (top_of_set C) U) \<and>
                                             pairwise disjnt \<V> \<and>
                                             (\<forall>U \<in> \<V>. \<exists>q. homeomorphism U (UU s) p q))"
       using cov unfolding covering_space_def by (metis (mono_tags))
     then have ope: "\<And>s. s \<in> S \<Longrightarrow> s \<in> (UU s) \<and> openin (top_of_set S) (UU s)"
       by blast
     have "\<exists>k n i. open k \<and> open n \<and>
                   t \<in> k \<and> y \<in> n \<and> i \<in> S \<and> h ` (({0..1} \<inter> k) \<times> (U \<inter> n)) \<subseteq> UU i" if "t \<in> {0..1}" for t
     proof -
       have hinS: "h (t, y) \<in> S"
         using \<open>y \<in> U\<close> him that by blast
       then have "(t,y) \<in> ({0..1} \<times> U) \<inter> h -` UU(h(t, y))"
         using \<open>y \<in> U\<close> \<open>t \<in> {0..1}\<close>  by (auto simp: ope)
       moreover have ope_01U: "openin (top_of_set ({0..1} \<times> U)) (({0..1} \<times> U) \<inter> h -` UU(h(t, y)))"
         using hinS ope continuous_on_open_gen [OF him] conth by blast
       ultimately obtain V W where opeV: "open V" and "t \<in> {0..1} \<inter> V" "t \<in> {0..1} \<inter> V"
                               and opeW: "open W" and "y \<in> U" "y \<in> W"
                               and VW: "({0..1} \<inter> V) \<times> (U \<inter> W)  \<subseteq> (({0..1} \<times> U) \<inter> h -` UU(h(t, y)))"
         by (rule Times_in_interior_subtopology) (auto simp: openin_open)
       then show ?thesis
         using hinS by blast
     qed
     then obtain K NN X where
               K: "\<And>t. t \<in> {0..1} \<Longrightarrow> open (K t)"
           and NN: "\<And>t. t \<in> {0..1} \<Longrightarrow> open (NN t)"
           and inUS: "\<And>t. t \<in> {0..1} \<Longrightarrow> t \<in> K t \<and> y \<in> NN t \<and> X t \<in> S"
           and him: "\<And>t. t \<in> {0..1} \<Longrightarrow> h ` (({0..1} \<inter> K t) \<times> (U \<inter> NN t)) \<subseteq> UU (X t)"
     by (metis (mono_tags))
     obtain \<T> where "\<T> \<subseteq> ((\<lambda>i. K i \<times> NN i)) ` {0..1}" "finite \<T>" "{0::real..1} \<times> {y} \<subseteq> \<Union>\<T>"
     proof (rule compactE)
       show "compact ({0::real..1} \<times> {y})"
         by (simp add: compact_Times)
       show "{0..1} \<times> {y} \<subseteq> (\<Union>i\<in>{0..1}. K i \<times> NN i)"
         using K inUS by auto
       show "\<And>B. B \<in> (\<lambda>i. K i \<times> NN i) ` {0..1} \<Longrightarrow> open B"
         using K NN by (auto simp: open_Times)
     qed blast
     then obtain tk where "tk \<subseteq> {0..1}" "finite tk"
                      and tk: "{0::real..1} \<times> {y} \<subseteq> (\<Union>i \<in> tk. K i \<times> NN i)"
       by (metis (no_types, lifting) finite_subset_image)
     then have "tk \<noteq> {}"
       by auto
     define n where "n = \<Inter>(NN ` tk)"
     have "y \<in> n" "open n"
       using inUS NN \<open>tk \<subseteq> {0..1}\<close> \<open>finite tk\<close>
       by (auto simp: n_def open_INT subset_iff)
     obtain \<delta> where "0 < \<delta>" and \<delta>: "\<And>T. \<lbrakk>T \<subseteq> {0..1}; diameter T < \<delta>\<rbrakk> \<Longrightarrow> \<exists>B\<in>K ` tk. T \<subseteq> B"
     proof (rule Lebesgue_number_lemma [of "{0..1}" "K ` tk"])
       show "K ` tk \<noteq> {}"
         using \<open>tk \<noteq> {}\<close> by auto
       show "{0..1} \<subseteq> \<Union>(K ` tk)"
         using tk by auto
       show "\<And>B. B \<in> K ` tk \<Longrightarrow> open B"
         using \<open>tk \<subseteq> {0..1}\<close> K by auto
     qed auto
     obtain N::nat where N: "N > 1 / \<delta>"
       using reals_Archimedean2 by blast
     then have "N > 0"
       using \<open>0 < \<delta>\<close> order.asym by force
     have *: "\<exists>V k. openin (top_of_set U) V \<and> y \<in> V \<and>
                    continuous_on ({0..of_nat n / N} \<times> V) k \<and>
                    k ` ({0..of_nat n / N} \<times> V) \<subseteq> C \<and>
                    (\<forall>z\<in>V. k (0, z) = f z) \<and>
                    (\<forall>z\<in>{0..of_nat n / N} \<times> V. h z = p (k z))" if "n \<le> N" for n
       using that
     proof (induction n)
       case 0
       show ?case
         apply (rule_tac x=U in exI)
         apply (rule_tac x="f \<circ> snd" in exI)
         apply (intro conjI \<open>y \<in> U\<close> continuous_intros continuous_on_subset [OF contf])
         using fim  apply (auto simp: heq)
         done
     next
       case (Suc n)
       then obtain V k where opeUV: "openin (top_of_set U) V"
                         and "y \<in> V"
                         and contk: "continuous_on ({0..real n / real N} \<times> V) k"
                         and kim: "k ` ({0..real n / real N} \<times> V) \<subseteq> C"
                         and keq: "\<And>z. z \<in> V \<Longrightarrow> k (0, z) = f z"
                         and heq: "\<And>z. z \<in> {0..real n / real N} \<times> V \<Longrightarrow> h z = p (k z)"
         using Suc_leD by auto
       have "n \<le> N"
         using Suc.prems by auto
       obtain t where "t \<in> tk" and t: "{real n / real N .. (1 + real n) / real N} \<subseteq> K t"
       proof (rule bexE [OF \<delta>])
         show "{real n / real N .. (1 + real n) / real N} \<subseteq> {0..1}"
-          using Suc.prems by (auto simp: field_split_simps algebra_simps)
+          using Suc.prems by (auto simp: field_split_simps)
         show diameter_less: "diameter {real n / real N .. (1 + real n) / real N} < \<delta>"
-          using \<open>0 < \<delta>\<close> N by (auto simp: field_split_simps algebra_simps)
+          using \<open>0 < \<delta>\<close> N by (auto simp: field_split_simps)
       qed blast
       have t01: "t \<in> {0..1}"
         using \<open>t \<in> tk\<close> \<open>tk \<subseteq> {0..1}\<close> by blast
       obtain \<V> where \<V>: "\<Union>\<V> = C \<inter> p -` UU (X t)"
                  and opeC: "\<And>U. U \<in> \<V> \<Longrightarrow> openin (top_of_set C) U"
                  and "pairwise disjnt \<V>"
                  and homuu: "\<And>U. U \<in> \<V> \<Longrightarrow> \<exists>q. homeomorphism U (UU (X t)) p q"
         using inUS [OF t01] UU by meson
       have n_div_N_in: "real n / real N \<in> {real n / real N .. (1 + real n) / real N}"
-        using N by (auto simp: field_split_simps algebra_simps)
+        using N by (auto simp: field_split_simps)
       with t have nN_in_kkt: "real n / real N \<in> K t"
         by blast
       have "k (real n / real N, y) \<in> C \<inter> p -` UU (X t)"
       proof (simp, rule conjI)
         show "k (real n / real N, y) \<in> C"
           using \<open>y \<in> V\<close> kim keq by force
         have "p (k (real n / real N, y)) = h (real n / real N, y)"
           by (simp add: \<open>y \<in> V\<close> heq)
         also have "... \<in> h ` (({0..1} \<inter> K t) \<times> (U \<inter> NN t))"
           apply (rule imageI)
            using \<open>y \<in> V\<close> t01 \<open>n \<le> N\<close>
           apply (simp add: nN_in_kkt \<open>y \<in> U\<close> inUS field_split_simps)
           done
         also have "... \<subseteq> UU (X t)"
           using him t01 by blast
         finally show "p (k (real n / real N, y)) \<in> UU (X t)" .
       qed
       with \<V> have "k (real n / real N, y) \<in> \<Union>\<V>"
         by blast
       then obtain W where W: "k (real n / real N, y) \<in> W" and "W \<in> \<V>"
         by blast
       then obtain p' where opeC': "openin (top_of_set C) W"
                        and hom': "homeomorphism W (UU (X t)) p p'"
         using homuu opeC by blast
       then have "W \<subseteq> C"
         using openin_imp_subset by blast
       define W' where "W' = UU(X t)"
       have opeVW: "openin (top_of_set V) (V \<inter> (k \<circ> Pair (n / N)) -` W)"
         apply (rule continuous_openin_preimage [OF _ _ opeC'])
          apply (intro continuous_intros continuous_on_subset [OF contk])
         using kim apply (auto simp: \<open>y \<in> V\<close> W)
         done
       obtain N' where opeUN': "openin (top_of_set U) N'"
                   and "y \<in> N'" and kimw: "k ` ({(real n / real N)} \<times> N') \<subseteq> W"
         apply (rule_tac N' = "(V \<inter> (k \<circ> Pair (n / N)) -` W)" in that)
         apply (fastforce simp:  \<open>y \<in> V\<close> W intro!: openin_trans [OF opeVW opeUV])+
         done
       obtain Q Q' where opeUQ: "openin (top_of_set U) Q"
                     and cloUQ': "closedin (top_of_set U) Q'"
                     and "y \<in> Q" "Q \<subseteq> Q'"
                     and Q': "Q' \<subseteq> (U \<inter> NN(t)) \<inter> N' \<inter> V"
       proof -
         obtain VO VX where "open VO" "open VX" and VO: "V = U \<inter> VO" and VX: "N' = U \<inter> VX"
           using opeUV opeUN' by (auto simp: openin_open)
         then have "open (NN(t) \<inter> VO \<inter> VX)"
           using NN t01 by blast
         then obtain e where "e > 0" and e: "cball y e \<subseteq> NN(t) \<inter> VO \<inter> VX"
           by (metis Int_iff \<open>N' = U \<inter> VX\<close> \<open>V = U \<inter> VO\<close> \<open>y \<in> N'\<close> \<open>y \<in> V\<close> inUS open_contains_cball t01)
         show ?thesis
         proof
           show "openin (top_of_set U) (U \<inter> ball y e)"
             by blast
           show "closedin (top_of_set U) (U \<inter> cball y e)"
             using e by (auto simp: closedin_closed)
         qed (use \<open>y \<in> U\<close> \<open>e > 0\<close> VO VX e in auto)
       qed
       then have "y \<in> Q'" "Q \<subseteq> (U \<inter> NN(t)) \<inter> N' \<inter> V"
         by blast+
       have neq: "{0..real n / real N} \<union> {real n / real N..(1 + real n) / real N} = {0..(1 + real n) / real N}"
         apply (auto simp: field_split_simps)
         by (metis mult_zero_left of_nat_0_le_iff of_nat_0_less_iff order_trans real_mult_le_cancel_iff1)
       then have neqQ': "{0..real n / real N} \<times> Q' \<union> {real n / real N..(1 + real n) / real N} \<times> Q' = {0..(1 + real n) / real N} \<times> Q'"
         by blast
       have cont: "continuous_on ({0..(1 + real n) / real N} \<times> Q')
         (\<lambda>x. if x \<in> {0..real n / real N} \<times> Q' then k x else (p' \<circ> h) x)"
         unfolding neqQ' [symmetric]
       proof (rule continuous_on_cases_local, simp_all add: neqQ' del: comp_apply)
         show "closedin (top_of_set ({0..(1 + real n) / real N} \<times> Q'))
                        ({0..real n / real N} \<times> Q')"
           apply (simp add: closedin_closed)
           apply (rule_tac x="{0 .. real n / real N} \<times> UNIV" in exI)
           using n_div_N_in apply (auto simp: closed_Times)
           done
         show "closedin (top_of_set ({0..(1 + real n) / real N} \<times> Q'))
                        ({real n / real N..(1 + real n) / real N} \<times> Q')"
           apply (simp add: closedin_closed)
           apply (rule_tac x="{real n / real N .. (1 + real n) / real N} \<times> UNIV" in exI)
           apply (auto simp: closed_Times)
           by (meson divide_nonneg_nonneg of_nat_0_le_iff order_trans)
         show "continuous_on ({0..real n / real N} \<times> Q') k"
           apply (rule continuous_on_subset [OF contk])
           using Q' by auto
         have "continuous_on ({real n / real N..(1 + real n) / real N} \<times> Q') h"
         proof (rule continuous_on_subset [OF conth])
           show "{real n / real N..(1 + real n) / real N} \<times> Q' \<subseteq> {0..1} \<times> U"
             using \<open>N > 0\<close>
             apply auto
               apply (meson divide_nonneg_nonneg of_nat_0_le_iff order_trans)
             using Suc.prems order_trans apply fastforce
             apply (metis IntE  cloUQ' closedin_closed)
             done
         qed
         moreover have "continuous_on (h ` ({real n / real N..(1 + real n) / real N} \<times> Q')) p'"
         proof (rule continuous_on_subset [OF homeomorphism_cont2 [OF hom']])
           have "h ` ({real n / real N..(1 + real n) / real N} \<times> Q') \<subseteq> h ` (({0..1} \<inter> K t) \<times> (U \<inter> NN t))"
             apply (rule image_mono)
             using \<open>0 < \<delta>\<close> \<open>N > 0\<close> Suc.prems apply auto
               apply (meson divide_nonneg_nonneg of_nat_0_le_iff order_trans)
             using Suc.prems order_trans apply fastforce
             using t Q' apply auto
             done
           with him show "h ` ({real n / real N..(1 + real n) / real N} \<times> Q') \<subseteq> UU (X t)"
             using t01 by blast
         qed
         ultimately show "continuous_on ({real n / real N..(1 + real n) / real N} \<times> Q') (p' \<circ> h)"
           by (rule continuous_on_compose)
         have "k (real n / real N, b) = p' (h (real n / real N, b))" if "b \<in> Q'" for b
         proof -
           have "k (real n / real N, b) \<in> W"
             using that Q' kimw  by force
           then have "k (real n / real N, b) = p' (p (k (real n / real N, b)))"
             by (simp add:  homeomorphism_apply1 [OF hom'])
           then show ?thesis
             using Q' that by (force simp: heq)
         qed
         then show "\<And>x. x \<in> {real n / real N..(1 + real n) / real N} \<times> Q' \<and>
                   x \<in> {0..real n / real N} \<times> Q' \<Longrightarrow> k x = (p' \<circ> h) x"
           by auto
       qed
       have h_in_UU: "h (x, y) \<in> UU (X t)" if "y \<in> Q" "\<not> x \<le> real n / real N" "0 \<le> x" "x \<le> (1 + real n) / real N" for x y
       proof -
         have "x \<le> 1"
           using Suc.prems that order_trans by force
         moreover have "x \<in> K t"
           by (meson atLeastAtMost_iff le_less not_le subset_eq t that)
         moreover have "y \<in> U"
           using \<open>y \<in> Q\<close> opeUQ openin_imp_subset by blast
         moreover have "y \<in> NN t"
           using Q' \<open>Q \<subseteq> Q'\<close> \<open>y \<in> Q\<close> by auto
         ultimately have "(x, y) \<in> (({0..1} \<inter> K t) \<times> (U \<inter> NN t))"
           using that by auto
         then have "h (x, y) \<in> h ` (({0..1} \<inter> K t) \<times> (U \<inter> NN t))"
           by blast
         also have "... \<subseteq> UU (X t)"
           by (metis him t01)
         finally show ?thesis .
       qed
       let ?k = "(\<lambda>x. if x \<in> {0..real n / real N} \<times> Q' then k x else (p' \<circ> h) x)"
       show ?case
       proof (intro exI conjI)
         show "continuous_on ({0..real (Suc n) / real N} \<times> Q) ?k"
           apply (rule continuous_on_subset [OF cont])
           using \<open>Q \<subseteq> Q'\<close> by auto
         have "\<And>a b. \<lbrakk>a \<le> real n / real N; b \<in> Q'; 0 \<le> a\<rbrakk> \<Longrightarrow> k (a, b) \<in> C"
           using kim Q' by force
         moreover have "\<And>a b. \<lbrakk>b \<in> Q; 0 \<le> a; a \<le> (1 + real n) / real N; \<not> a \<le> real n / real N\<rbrakk> \<Longrightarrow> p' (h (a, b)) \<in> C"
           apply (rule \<open>W \<subseteq> C\<close> [THEN subsetD])
           using homeomorphism_image2 [OF hom', symmetric]  h_in_UU  Q' \<open>Q \<subseteq> Q'\<close> \<open>W \<subseteq> C\<close>
           apply auto
           done
         ultimately show "?k ` ({0..real (Suc n) / real N} \<times> Q) \<subseteq> C"
           using Q' \<open>Q \<subseteq> Q'\<close> by force
         show "\<forall>z\<in>Q. ?k (0, z) = f z"
           using Q' keq  \<open>Q \<subseteq> Q'\<close> by auto
         show "\<forall>z \<in> {0..real (Suc n) / real N} \<times> Q. h z = p(?k z)"
           using \<open>Q \<subseteq> U \<inter> NN t \<inter> N' \<inter> V\<close> heq apply clarsimp
           using h_in_UU Q' \<open>Q \<subseteq> Q'\<close> apply (auto simp: homeomorphism_apply2 [OF hom', symmetric])
           done
         qed (auto simp: \<open>y \<in> Q\<close> opeUQ)
     qed
     show ?thesis
       using*[OF order_refl] N \<open>0 < \<delta>\<close> by (simp add: split: if_split_asm)
   qed
   then obtain V fs where opeV: "\<And>y. y \<in> U \<Longrightarrow> openin (top_of_set U) (V y)"
           and V: "\<And>y. y \<in> U \<Longrightarrow> y \<in> V y"
           and contfs: "\<And>y. y \<in> U \<Longrightarrow> continuous_on ({0..1} \<times> V y) (fs y)"
           and *: "\<And>y. y \<in> U \<Longrightarrow> (fs y) ` ({0..1} \<times> V y) \<subseteq> C \<and>
                             (\<forall>z \<in> V y. fs y (0, z) = f z) \<and>
                             (\<forall>z \<in> {0..1} \<times> V y. h z = p(fs y z))"
     by (metis (mono_tags))
   then have VU: "\<And>y. y \<in> U \<Longrightarrow> V y \<subseteq> U"
     by (meson openin_imp_subset)
   obtain k where contk: "continuous_on ({0..1} \<times> U) k"
              and k: "\<And>x i. \<lbrakk>i \<in> U; x \<in> {0..1} \<times> U \<inter> {0..1} \<times> V i\<rbrakk> \<Longrightarrow> k x = fs i x"
   proof (rule pasting_lemma_exists)
     let ?X = "top_of_set ({0..1::real} \<times> U)"
     show "topspace ?X \<subseteq> (\<Union>i\<in>U. {0..1} \<times> V i)"
       using V by force
     show "\<And>i. i \<in> U \<Longrightarrow> openin (top_of_set ({0..1} \<times> U)) ({0..1} \<times> V i)"
       by (simp add: Abstract_Topology.openin_Times opeV)
     show "\<And>i. i \<in> U \<Longrightarrow> continuous_map
               (subtopology (top_of_set ({0..1} \<times> U)) ({0..1} \<times> V i)) euclidean (fs i)"
       using contfs
       apply simp
       by (metis continuous_map_iff_continuous continuous_on_subset openin_imp_subset openin_subtopology_self subtopology_subtopology)
     show "fs i x = fs j x"  if "i \<in> U" "j \<in> U" and x: "x \<in> topspace ?X \<inter> {0..1} \<times> V i \<inter> {0..1} \<times> V j"
          for i j x
     proof -
       obtain u y where "x = (u, y)" "y \<in> V i" "y \<in> V j" "0 \<le> u" "u \<le> 1"
         using x by auto
       show ?thesis
       proof (rule covering_space_lift_unique [OF cov, of _ "(0,y)" _ "{0..1} \<times> {y}" h])
         show "fs i (0, y) = fs j (0, y)"
           using*V by (simp add: \<open>y \<in> V i\<close> \<open>y \<in> V j\<close> that)
         show conth_y: "continuous_on ({0..1} \<times> {y}) h"
           apply (rule continuous_on_subset [OF conth])
           using VU \<open>y \<in> V j\<close> that by auto
         show "h ` ({0..1} \<times> {y}) \<subseteq> S"
           using \<open>y \<in> V i\<close> assms(3) VU that by fastforce
         show "continuous_on ({0..1} \<times> {y}) (fs i)"
           using continuous_on_subset [OF contfs] \<open>i \<in> U\<close>
           by (simp add: \<open>y \<in> V i\<close> subset_iff)
         show "fs i ` ({0..1} \<times> {y}) \<subseteq> C"
           using "*" \<open>y \<in> V i\<close> \<open>i \<in> U\<close> by fastforce
         show "\<And>x. x \<in> {0..1} \<times> {y} \<Longrightarrow> h x = p (fs i x)"
           using "*" \<open>y \<in> V i\<close> \<open>i \<in> U\<close> by blast
         show "continuous_on ({0..1} \<times> {y}) (fs j)"
           using continuous_on_subset [OF contfs] \<open>j \<in> U\<close>
           by (simp add: \<open>y \<in> V j\<close> subset_iff)
         show "fs j ` ({0..1} \<times> {y}) \<subseteq> C"
           using "*" \<open>y \<in> V j\<close> \<open>j \<in> U\<close> by fastforce
         show "\<And>x. x \<in> {0..1} \<times> {y} \<Longrightarrow> h x = p (fs j x)"
           using "*" \<open>y \<in> V j\<close> \<open>j \<in> U\<close> by blast
         show "connected ({0..1::real} \<times> {y})"
           using connected_Icc connected_Times connected_sing by blast
         show "(0, y) \<in> {0..1::real} \<times> {y}"
           by force
         show "x \<in> {0..1} \<times> {y}"
           using \<open>x = (u, y)\<close> x by blast
       qed
     qed
   qed force
   show ?thesis
   proof
     show "k ` ({0..1} \<times> U) \<subseteq> C"
       using V*k VU by fastforce
     show "\<And>y. y \<in> U \<Longrightarrow> k (0, y) = f y"
       by (simp add: V*k)
     show "\<And>z. z \<in> {0..1} \<times> U \<Longrightarrow> h z = p (k z)"
       using V*k by auto
   qed (auto simp: contk)
 qed
 
 corollary covering_space_lift_homotopy_alt:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and h :: "'c::real_normed_vector \<times> real \<Rightarrow> 'b"
   assumes cov: "covering_space C p S"
       and conth: "continuous_on (U \<times> {0..1}) h"
       and him: "h ` (U \<times> {0..1}) \<subseteq> S"
       and heq: "\<And>y. y \<in> U \<Longrightarrow> h (y,0) = p(f y)"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> C"
   obtains k where "continuous_on (U \<times> {0..1}) k"
                   "k ` (U \<times> {0..1}) \<subseteq> C"
                   "\<And>y. y \<in> U \<Longrightarrow> k(y, 0) = f y"
                   "\<And>z. z \<in> U \<times> {0..1} \<Longrightarrow> h z = p(k z)"
 proof -
   have "continuous_on ({0..1} \<times> U) (h \<circ> (\<lambda>z. (snd z, fst z)))"
     by (intro continuous_intros continuous_on_subset [OF conth]) auto
   then obtain k where contk: "continuous_on ({0..1} \<times> U) k"
                   and kim:  "k ` ({0..1} \<times> U) \<subseteq> C"
                   and k0: "\<And>y. y \<in> U \<Longrightarrow> k(0, y) = f y"
                   and heqp: "\<And>z. z \<in> {0..1} \<times> U \<Longrightarrow> (h \<circ> (\<lambda>z. Pair (snd z) (fst z))) z = p(k z)"
     apply (rule covering_space_lift_homotopy [OF cov _ _ _ contf fim])
     using him  by (auto simp: contf heq)
   show ?thesis
     apply (rule_tac k="k \<circ> (\<lambda>z. Pair (snd z) (fst z))" in that)
        apply (intro continuous_intros continuous_on_subset [OF contk])
     using kim heqp apply (auto simp: k0)
     done
 qed
 
 corollary covering_space_lift_homotopic_function:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" and g:: "'c::real_normed_vector \<Rightarrow> 'a"
   assumes cov: "covering_space C p S"
       and contg: "continuous_on U g"
       and gim: "g ` U \<subseteq> C"
       and pgeq: "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
       and hom: "homotopic_with_canon (\<lambda>x. True) U S f f'"
     obtains g' where "continuous_on U g'" "image g' U \<subseteq> C" "\<And>y. y \<in> U \<Longrightarrow> p(g' y) = f' y"
 proof -
   obtain h where conth: "continuous_on ({0..1::real} \<times> U) h"
              and him: "h ` ({0..1} \<times> U) \<subseteq> S"
              and h0:  "\<And>x. h(0, x) = f x"
              and h1: "\<And>x. h(1, x) = f' x"
     using hom by (auto simp: homotopic_with_def)
   have "\<And>y. y \<in> U \<Longrightarrow> h (0, y) = p (g y)"
     by (simp add: h0 pgeq)
   then obtain k where contk: "continuous_on ({0..1} \<times> U) k"
                   and kim: "k ` ({0..1} \<times> U) \<subseteq> C"
                   and k0: "\<And>y. y \<in> U \<Longrightarrow> k(0, y) = g y"
                   and heq: "\<And>z. z \<in> {0..1} \<times> U \<Longrightarrow> h z = p(k z)"
     using covering_space_lift_homotopy [OF cov conth him _ contg gim] by metis
   show ?thesis
   proof
     show "continuous_on U (k \<circ> Pair 1)"
       by (meson contk atLeastAtMost_iff continuous_on_o_Pair order_refl zero_le_one)
     show "(k \<circ> Pair 1) ` U \<subseteq> C"
       using kim by auto
     show "\<And>y. y \<in> U \<Longrightarrow> p ((k \<circ> Pair 1) y) = f' y"
       by (auto simp: h1 heq [symmetric])
   qed
 qed
 
 corollary covering_space_lift_inessential_function:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" and U :: "'c::real_normed_vector set"
   assumes cov: "covering_space C p S"
       and hom: "homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. a)"
   obtains g where "continuous_on U g" "g ` U \<subseteq> C" "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
 proof (cases "U = {}")
   case True
   then show ?thesis
     using that continuous_on_empty by blast
 next
   case False
   then obtain b where b: "b \<in> C" "p b = a"
     using covering_space_imp_surjective [OF cov] homotopic_with_imp_subset2 [OF hom]
     by auto
   then have gim: "(\<lambda>y. b) ` U \<subseteq> C"
     by blast
   show ?thesis
     apply (rule covering_space_lift_homotopic_function
                   [OF cov continuous_on_const gim _ homotopic_with_symD [OF hom]])
     using b that apply auto
     done
 qed
 
 subsection\<open> Lifting of general functions to covering space\<close>
 
 proposition covering_space_lift_path_strong:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and f :: "'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S" and "a \<in> C"
       and "path g" and pag: "path_image g \<subseteq> S" and pas: "pathstart g = p a"
     obtains h where "path h" "path_image h \<subseteq> C" "pathstart h = a"
                 and "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h t) = g t"
 proof -
   obtain k:: "real \<times> 'c \<Rightarrow> 'a"
     where contk: "continuous_on ({0..1} \<times> {undefined}) k"
       and kim: "k ` ({0..1} \<times> {undefined}) \<subseteq> C"
       and k0:  "k (0, undefined) = a"
       and pk: "\<And>z. z \<in> {0..1} \<times> {undefined} \<Longrightarrow> p(k z) = (g \<circ> fst) z"
   proof (rule covering_space_lift_homotopy [OF cov, of "{undefined}" "g \<circ> fst"])
     show "continuous_on ({0..1::real} \<times> {undefined::'c}) (g \<circ> fst)"
       apply (intro continuous_intros)
       using \<open>path g\<close> by (simp add: path_def)
     show "(g \<circ> fst) ` ({0..1} \<times> {undefined}) \<subseteq> S"
       using pag by (auto simp: path_image_def)
     show "(g \<circ> fst) (0, y) = p a" if "y \<in> {undefined}" for y::'c
       by (metis comp_def fst_conv pas pathstart_def)
   qed (use assms in auto)
   show ?thesis
   proof
     show "path (k \<circ> (\<lambda>t. Pair t undefined))"
       unfolding path_def
       by (intro continuous_on_compose continuous_intros continuous_on_subset [OF contk]) auto
     show "path_image (k \<circ> (\<lambda>t. (t, undefined))) \<subseteq> C"
       using kim by (auto simp: path_image_def)
     show "pathstart (k \<circ> (\<lambda>t. (t, undefined))) = a"
       by (auto simp: pathstart_def k0)
     show "\<And>t. t \<in> {0..1} \<Longrightarrow> p ((k \<circ> (\<lambda>t. (t, undefined))) t) = g t"
       by (auto simp: pk)
   qed
 qed
 
 corollary covering_space_lift_path:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes cov: "covering_space C p S" and "path g" and pig: "path_image g \<subseteq> S"
   obtains h where "path h" "path_image h \<subseteq> C" "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h t) = g t"
 proof -
   obtain a where "a \<in> C" "pathstart g = p a"
     by (metis pig cov covering_space_imp_surjective imageE pathstart_in_path_image subsetCE)
   show ?thesis
     using covering_space_lift_path_strong [OF cov \<open>a \<in> C\<close> \<open>path g\<close> pig]
     by (metis \<open>pathstart g = p a\<close> that)
 qed
 
   
 proposition covering_space_lift_homotopic_paths:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes cov: "covering_space C p S"
       and "path g1" and pig1: "path_image g1 \<subseteq> S"
       and "path g2" and pig2: "path_image g2 \<subseteq> S"
       and hom: "homotopic_paths S g1 g2"
       and "path h1" and pih1: "path_image h1 \<subseteq> C" and ph1: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h1 t) = g1 t"
       and "path h2" and pih2: "path_image h2 \<subseteq> C" and ph2: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h2 t) = g2 t"
       and h1h2: "pathstart h1 = pathstart h2"
     shows "homotopic_paths C h1 h2"
 proof -
   obtain h :: "real \<times> real \<Rightarrow> 'b"
      where conth: "continuous_on ({0..1} \<times> {0..1}) h"
        and him: "h ` ({0..1} \<times> {0..1}) \<subseteq> S"
        and h0: "\<And>x. h (0, x) = g1 x" and h1: "\<And>x. h (1, x) = g2 x"
        and heq0: "\<And>t. t \<in> {0..1} \<Longrightarrow> h (t, 0) = g1 0"
        and heq1: "\<And>t. t \<in> {0..1} \<Longrightarrow> h (t, 1) = g1 1"
     using hom by (auto simp: homotopic_paths_def homotopic_with_def pathstart_def pathfinish_def)
   obtain k where contk: "continuous_on ({0..1} \<times> {0..1}) k"
              and kim: "k ` ({0..1} \<times> {0..1}) \<subseteq> C"
              and kh2: "\<And>y. y \<in> {0..1} \<Longrightarrow> k (y, 0) = h2 0"
              and hpk: "\<And>z. z \<in> {0..1} \<times> {0..1} \<Longrightarrow> h z = p (k z)"
     apply (rule covering_space_lift_homotopy_alt [OF cov conth him, of "\<lambda>x. h2 0"])
     using h1h2 ph1 ph2 apply (force simp: heq0 pathstart_def pathfinish_def)
-    using path_image_def pih2 continuous_on_const by fastforce+
+    using path_image_def pih2 by fastforce+
   have contg1: "continuous_on {0..1} g1" and contg2: "continuous_on {0..1} g2"
     using \<open>path g1\<close> \<open>path g2\<close> path_def by blast+
   have g1im: "g1 ` {0..1} \<subseteq> S" and g2im: "g2 ` {0..1} \<subseteq> S"
     using path_image_def pig1 pig2 by auto
   have conth1: "continuous_on {0..1} h1" and conth2: "continuous_on {0..1} h2"
     using \<open>path h1\<close> \<open>path h2\<close> path_def by blast+
   have h1im: "h1 ` {0..1} \<subseteq> C" and h2im: "h2 ` {0..1} \<subseteq> C"
     using path_image_def pih1 pih2 by auto
   show ?thesis
     unfolding homotopic_paths pathstart_def pathfinish_def
   proof (intro exI conjI ballI)
     show keqh1: "k(0, x) = h1 x" if "x \<in> {0..1}" for x
     proof (rule covering_space_lift_unique [OF cov _ contg1 g1im])
       show "k (0,0) = h1 0"
         by (metis atLeastAtMost_iff h1h2 kh2 order_refl pathstart_def zero_le_one)
       show "continuous_on {0..1} (\<lambda>a. k (0, a))"
         by (intro continuous_intros continuous_on_compose2 [OF contk]) auto
       show "\<And>x. x \<in> {0..1} \<Longrightarrow> g1 x = p (k (0, x))"
         by (metis atLeastAtMost_iff h0 hpk zero_le_one mem_Sigma_iff order_refl)
     qed (use conth1 h1im kim that in \<open>auto simp: ph1\<close>)
     show "k(1, x) = h2 x" if "x \<in> {0..1}" for x
     proof (rule covering_space_lift_unique [OF cov _ contg2 g2im])
       show "k (1,0) = h2 0"
         by (metis atLeastAtMost_iff kh2 order_refl zero_le_one)
       show "continuous_on {0..1} (\<lambda>a. k (1, a))"
         by (intro continuous_intros continuous_on_compose2 [OF contk]) auto
       show "\<And>x. x \<in> {0..1} \<Longrightarrow> g2 x = p (k (1, x))"
         by (metis atLeastAtMost_iff h1 hpk mem_Sigma_iff order_refl zero_le_one)
     qed (use conth2 h2im kim that in \<open>auto simp: ph2\<close>)
     show "\<And>t. t \<in> {0..1} \<Longrightarrow> (k \<circ> Pair t) 0 = h1 0"
       by (metis comp_apply h1h2 kh2 pathstart_def)
     show "(k \<circ> Pair t) 1 = h1 1" if "t \<in> {0..1}" for t
     proof (rule covering_space_lift_unique
            [OF cov, of "\<lambda>a. (k \<circ> Pair a) 1" 0 "\<lambda>a. h1 1" "{0..1}"  "\<lambda>x. g1 1"])
       show "(k \<circ> Pair 0) 1 = h1 1"
         using keqh1 by auto
       show "continuous_on {0..1} (\<lambda>a. (k \<circ> Pair a) 1)"
         apply simp
         by (intro continuous_intros continuous_on_compose2 [OF contk]) auto
       show "\<And>x. x \<in> {0..1} \<Longrightarrow> g1 1 = p ((k \<circ> Pair x) 1)"
         using heq1 hpk by auto
-    qed (use contk kim g1im h1im that in \<open>auto simp: ph1 continuous_on_const\<close>)
+    qed (use contk kim g1im h1im that in \<open>auto simp: ph1\<close>)
   qed (use contk kim in auto)
 qed
 
 
 corollary covering_space_monodromy:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes cov: "covering_space C p S"
       and "path g1" and pig1: "path_image g1 \<subseteq> S"
       and "path g2" and pig2: "path_image g2 \<subseteq> S"
       and hom: "homotopic_paths S g1 g2"
       and "path h1" and pih1: "path_image h1 \<subseteq> C" and ph1: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h1 t) = g1 t"
       and "path h2" and pih2: "path_image h2 \<subseteq> C" and ph2: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h2 t) = g2 t"
       and h1h2: "pathstart h1 = pathstart h2"
     shows "pathfinish h1 = pathfinish h2"
   using covering_space_lift_homotopic_paths [OF assms] homotopic_paths_imp_pathfinish
   by blast
 
 
 corollary covering_space_lift_homotopic_path:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes cov: "covering_space C p S"
       and hom: "homotopic_paths S f f'"
       and "path g" and pig: "path_image g \<subseteq> C"
       and a: "pathstart g = a" and b: "pathfinish g = b"
       and pgeq: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(g t) = f t"
   obtains g' where "path g'" "path_image g' \<subseteq> C"
                    "pathstart g' = a" "pathfinish g' = b" "\<And>t. t \<in> {0..1} \<Longrightarrow> p(g' t) = f' t"
 proof (rule covering_space_lift_path_strong [OF cov, of a f'])
   show "a \<in> C"
     using a pig by auto
   show "path f'" "path_image f' \<subseteq> S"
     using hom homotopic_paths_imp_path homotopic_paths_imp_subset by blast+
   show "pathstart f' = p a"
     by (metis a atLeastAtMost_iff hom homotopic_paths_imp_pathstart order_refl pathstart_def pgeq zero_le_one)
 qed (metis (mono_tags, lifting) assms cov covering_space_monodromy hom homotopic_paths_imp_path homotopic_paths_imp_subset pgeq pig)
 
 
 proposition covering_space_lift_general:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and f :: "'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S" and "a \<in> C" "z \<in> U"
       and U: "path_connected U" "locally path_connected U"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> S"
       and feq: "f z = p a"
       and hom: "\<And>r. \<lbrakk>path r; path_image r \<subseteq> U; pathstart r = z; pathfinish r = z\<rbrakk>
                      \<Longrightarrow> \<exists>q. path q \<and> path_image q \<subseteq> C \<and>
                              pathstart q = a \<and> pathfinish q = a \<and>
                              homotopic_paths S (f \<circ> r) (p \<circ> q)"
   obtains g where "continuous_on U g" "g ` U \<subseteq> C" "g z = a" "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
 proof -
   have *: "\<exists>g h. path g \<and> path_image g \<subseteq> U \<and>
                  pathstart g = z \<and> pathfinish g = y \<and>
                  path h \<and> path_image h \<subseteq> C \<and> pathstart h = a \<and>
                  (\<forall>t \<in> {0..1}. p(h t) = f(g t))"
           if "y \<in> U" for y
   proof -
     obtain g where "path g" "path_image g \<subseteq> U" and pastg: "pathstart g = z"
                and pafig: "pathfinish g = y"
       using U \<open>z \<in> U\<close> \<open>y \<in> U\<close> by (force simp: path_connected_def)
     obtain h where "path h" "path_image h \<subseteq> C" "pathstart h = a"
                and "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h t) = (f \<circ> g) t"
     proof (rule covering_space_lift_path_strong [OF cov \<open>a \<in> C\<close>])
       show "path (f \<circ> g)"
         using \<open>path g\<close> \<open>path_image g \<subseteq> U\<close> contf continuous_on_subset path_continuous_image by blast
       show "path_image (f \<circ> g) \<subseteq> S"
         by (metis \<open>path_image g \<subseteq> U\<close> fim image_mono path_image_compose subset_trans)
       show "pathstart (f \<circ> g) = p a"
         by (simp add: feq pastg pathstart_compose)
     qed auto
     then show ?thesis
       by (metis \<open>path g\<close> \<open>path_image g \<subseteq> U\<close> comp_apply pafig pastg)
   qed
   have "\<exists>l. \<forall>g h. path g \<and> path_image g \<subseteq> U \<and> pathstart g = z \<and> pathfinish g = y \<and>
                   path h \<and> path_image h \<subseteq> C \<and> pathstart h = a \<and>
                   (\<forall>t \<in> {0..1}. p(h t) = f(g t))  \<longrightarrow> pathfinish h = l" for y
   proof -
     have "pathfinish h = pathfinish h'"
          if g: "path g" "path_image g \<subseteq> U" "pathstart g = z" "pathfinish g = y"
             and h: "path h" "path_image h \<subseteq> C" "pathstart h = a"
             and phg: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h t) = f(g t)"
             and g': "path g'" "path_image g' \<subseteq> U" "pathstart g' = z" "pathfinish g' = y"
             and h': "path h'" "path_image h' \<subseteq> C" "pathstart h' = a"
             and phg': "\<And>t. t \<in> {0..1} \<Longrightarrow> p(h' t) = f(g' t)"
          for g h g' h'
     proof -
       obtain q where "path q" and piq: "path_image q \<subseteq> C" and pastq: "pathstart q = a" and pafiq: "pathfinish q = a"
                  and homS: "homotopic_paths S (f \<circ> g +++ reversepath g') (p \<circ> q)"
         using g g' hom [of "g +++ reversepath g'"] by (auto simp:  subset_path_image_join)
               have papq: "path (p \<circ> q)"
                 using homS homotopic_paths_imp_path by blast
               have pipq: "path_image (p \<circ> q) \<subseteq> S"
                 using homS homotopic_paths_imp_subset by blast
       obtain q' where "path q'" "path_image q' \<subseteq> C"
                 and "pathstart q' = pathstart q" "pathfinish q' = pathfinish q"
                 and pq'_eq: "\<And>t. t \<in> {0..1} \<Longrightarrow> p (q' t) = (f \<circ> g +++ reversepath g') t"
         using covering_space_lift_homotopic_path [OF cov homotopic_paths_sym [OF homS] \<open>path q\<close> piq refl refl]
         by auto
       have "q' t = (h \<circ> (*\<^sub>R) 2) t" if "0 \<le> t" "t \<le> 1/2" for t
       proof (rule covering_space_lift_unique [OF cov, of q' 0 "h \<circ> (*\<^sub>R) 2" "{0..1/2}" "f \<circ> g \<circ> (*\<^sub>R) 2" t])
         show "q' 0 = (h \<circ> (*\<^sub>R) 2) 0"
-          by (metis \<open>pathstart q' = pathstart q\<close> comp_def g h pastq pathstart_def pth_4(2))
+          by (metis \<open>pathstart q' = pathstart q\<close> comp_def h pastq pathstart_def pth_4(2))
         show "continuous_on {0..1/2} (f \<circ> g \<circ> (*\<^sub>R) 2)"
           apply (intro continuous_intros continuous_on_compose continuous_on_path [OF \<open>path g\<close>] continuous_on_subset [OF contf])
           using g(2) path_image_def by fastforce+
         show "(f \<circ> g \<circ> (*\<^sub>R) 2) ` {0..1/2} \<subseteq> S"
           using g(2) path_image_def fim by fastforce
         show "(h \<circ> (*\<^sub>R) 2) ` {0..1/2} \<subseteq> C"
           using h path_image_def by fastforce
         show "q' ` {0..1/2} \<subseteq> C"
           using \<open>path_image q' \<subseteq> C\<close> path_image_def by fastforce
         show "\<And>x. x \<in> {0..1/2} \<Longrightarrow> (f \<circ> g \<circ> (*\<^sub>R) 2) x = p (q' x)"
           by (auto simp: joinpaths_def pq'_eq)
         show "\<And>x. x \<in> {0..1/2} \<Longrightarrow> (f \<circ> g \<circ> (*\<^sub>R) 2) x = p ((h \<circ> (*\<^sub>R) 2) x)"
           by (simp add: phg)
         show "continuous_on {0..1/2} q'"
           by (simp add: continuous_on_path \<open>path q'\<close>)
         show "continuous_on {0..1/2} (h \<circ> (*\<^sub>R) 2)"
           apply (intro continuous_intros continuous_on_compose continuous_on_path [OF \<open>path h\<close>], force)
           done
       qed (use that in auto)
       moreover have "q' t = (reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) t" if "1/2 < t" "t \<le> 1" for t
       proof (rule covering_space_lift_unique [OF cov, of q' 1 "reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)" "{1/2<..1}" "f \<circ> reversepath g' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)" t])
         show "q' 1 = (reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) 1"
           using h' \<open>pathfinish q' = pathfinish q\<close> pafiq
           by (simp add: pathstart_def pathfinish_def reversepath_def)
         show "continuous_on {1/2<..1} (f \<circ> reversepath g' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1))"
           apply (intro continuous_intros continuous_on_compose continuous_on_path \<open>path g'\<close> continuous_on_subset [OF contf])
           using g' apply simp_all
           by (auto simp: path_image_def reversepath_def)
         show "(f \<circ> reversepath g' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) ` {1/2<..1} \<subseteq> S"
           using g'(2) path_image_def fim by (auto simp: image_subset_iff path_image_def reversepath_def)
         show "q' ` {1/2<..1} \<subseteq> C"
           using \<open>path_image q' \<subseteq> C\<close> path_image_def by fastforce
         show "(reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) ` {1/2<..1} \<subseteq> C"
           using h' by (simp add: path_image_def reversepath_def subset_eq)
         show "\<And>x. x \<in> {1/2<..1} \<Longrightarrow> (f \<circ> reversepath g' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) x = p (q' x)"
           by (auto simp: joinpaths_def pq'_eq)
         show "\<And>x. x \<in> {1/2<..1} \<Longrightarrow>
                   (f \<circ> reversepath g' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) x = p ((reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1)) x)"
           by (simp add: phg' reversepath_def)
         show "continuous_on {1/2<..1} q'"
           by (auto intro: continuous_on_path [OF \<open>path q'\<close>])
         show "continuous_on {1/2<..1} (reversepath h' \<circ> (\<lambda>t. 2 *\<^sub>R t - 1))"
           apply (intro continuous_intros continuous_on_compose continuous_on_path \<open>path h'\<close>)
           using h' apply auto
           done
       qed (use that in auto)
       ultimately have "q' t = (h +++ reversepath h') t" if "0 \<le> t" "t \<le> 1" for t
         using that by (simp add: joinpaths_def)
       then have "path(h +++ reversepath h')"
         by (auto intro: path_eq [OF \<open>path q'\<close>])
       then show ?thesis
         by (auto simp: \<open>path h\<close> \<open>path h'\<close>)
     qed
     then show ?thesis by metis
   qed
   then obtain l :: "'c \<Rightarrow> 'a"
           where l: "\<And>y g h. \<lbrakk>path g; path_image g \<subseteq> U; pathstart g = z; pathfinish g = y;
                              path h; path_image h \<subseteq> C; pathstart h = a;
                              \<And>t. t \<in> {0..1} \<Longrightarrow> p(h t) = f(g t)\<rbrakk> \<Longrightarrow> pathfinish h = l y"
     by metis
   show ?thesis
   proof
     show pleq: "p (l y) = f y" if "y \<in> U" for y
       using*[OF \<open>y \<in> U\<close>]  by (metis l atLeastAtMost_iff order_refl pathfinish_def zero_le_one)
     show "l z = a"
       using l [of "linepath z z" z "linepath a a"] by (auto simp: assms)
     show LC: "l ` U \<subseteq> C"
       by (clarify dest!: *) (metis (full_types) l pathfinish_in_path_image subsetCE)
     have "\<exists>T. openin (top_of_set U) T \<and> y \<in> T \<and> T \<subseteq> U \<inter> l -` X"
          if X: "openin (top_of_set C) X" and "y \<in> U" "l y \<in> X" for X y
     proof -
       have "X \<subseteq> C"
         using X openin_euclidean_subtopology_iff by blast
       have "f y \<in> S"
         using fim \<open>y \<in> U\<close> by blast
       then obtain W \<V>
               where WV: "f y \<in> W \<and> openin (top_of_set S) W \<and>
                          (\<Union>\<V> = C \<inter> p -` W \<and>
                           (\<forall>U \<in> \<V>. openin (top_of_set C) U) \<and>
                           pairwise disjnt \<V> \<and>
                           (\<forall>U \<in> \<V>. \<exists>q. homeomorphism U W p q))"
         using cov by (force simp: covering_space_def)
       then have "l y \<in> \<Union>\<V>"
         using \<open>X \<subseteq> C\<close> pleq that by auto
       then obtain W' where "l y \<in> W'" and "W' \<in> \<V>"
         by blast
       with WV obtain p' where opeCW': "openin (top_of_set C) W'"
                           and homUW': "homeomorphism W' W p p'"
         by blast
       then have contp': "continuous_on W p'" and p'im: "p' ` W \<subseteq> W'"
         using homUW' homeomorphism_image2 homeomorphism_cont2 by fastforce+
       obtain V where "y \<in> V" "y \<in> U" and fimW: "f ` V \<subseteq> W" "V \<subseteq> U"
                  and "path_connected V" and opeUV: "openin (top_of_set U) V"
       proof -
         have "openin (top_of_set U) (U \<inter> f -` W)"
           using WV contf continuous_on_open_gen fim by auto
         then show ?thesis
           using U WV
           apply (auto simp: locally_path_connected)
           apply (drule_tac x="U \<inter> f -` W" in spec)
           apply (drule_tac x=y in spec)
           apply (auto simp: \<open>y \<in> U\<close> intro: that)
           done
       qed
       have "W' \<subseteq> C" "W \<subseteq> S"
         using opeCW' WV openin_imp_subset by auto
       have p'im: "p' ` W \<subseteq> W'"
         using homUW' homeomorphism_image2 by fastforce
       show ?thesis
       proof (intro exI conjI)
         have "openin (top_of_set S) (W \<inter> p' -` (W' \<inter> X))"
         proof (rule openin_trans)
           show "openin (top_of_set W) (W \<inter> p' -` (W' \<inter> X))"
             apply (rule continuous_openin_preimage [OF contp' p'im])
             using X \<open>W' \<subseteq> C\<close> apply (auto simp: openin_open)
             done
           show "openin (top_of_set S) W"
             using WV by blast
         qed
         then show "openin (top_of_set U) (V \<inter> (U \<inter> (f -` (W \<inter> (p' -` (W' \<inter> X))))))"
           by (blast intro: opeUV openin_subtopology_self continuous_openin_preimage [OF contf fim])
          have "p' (f y) \<in> X"
           using \<open>l y \<in> W'\<close> homeomorphism_apply1 [OF homUW'] pleq \<open>y \<in> U\<close> \<open>l y \<in> X\<close> by fastforce
         then show "y \<in> V \<inter> (U \<inter> f -` (W \<inter> p' -` (W' \<inter> X)))"
           using \<open>y \<in> U\<close> \<open>y \<in> V\<close> WV p'im by auto
         show "V \<inter> (U \<inter> f -` (W \<inter> p' -` (W' \<inter> X))) \<subseteq> U \<inter> l -` X"
         proof (intro subsetI IntI; clarify)
           fix y'
           assume y': "y' \<in> V" "y' \<in> U" "f y' \<in> W" "p' (f y') \<in> W'" "p' (f y') \<in> X"
           then obtain \<gamma> where "path \<gamma>" "path_image \<gamma> \<subseteq> V" "pathstart \<gamma> = y" "pathfinish \<gamma> = y'"
             by (meson \<open>path_connected V\<close> \<open>y \<in> V\<close> path_connected_def)
           obtain pp qq where "path pp" "path_image pp \<subseteq> U"
                              "pathstart pp = z" "pathfinish pp = y"
                              "path qq" "path_image qq \<subseteq> C" "pathstart qq = a"
                          and pqqeq: "\<And>t. t \<in> {0..1} \<Longrightarrow> p(qq t) = f(pp t)"
             using*[OF \<open>y \<in> U\<close>] by blast
           have finW: "\<And>x. \<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> f (\<gamma> x) \<in> W"
             using \<open>path_image \<gamma> \<subseteq> V\<close> by (auto simp: image_subset_iff path_image_def fimW [THEN subsetD])
           have "pathfinish (qq +++ (p' \<circ> f \<circ> \<gamma>)) = l y'"
           proof (rule l [of "pp +++ \<gamma>" y' "qq +++ (p' \<circ> f \<circ> \<gamma>)"])
             show "path (pp +++ \<gamma>)"
               by (simp add: \<open>path \<gamma>\<close> \<open>path pp\<close> \<open>pathfinish pp = y\<close> \<open>pathstart \<gamma> = y\<close>)
             show "path_image (pp +++ \<gamma>) \<subseteq> U"
               using \<open>V \<subseteq> U\<close> \<open>path_image \<gamma> \<subseteq> V\<close> \<open>path_image pp \<subseteq> U\<close> not_in_path_image_join by blast
             show "pathstart (pp +++ \<gamma>) = z"
               by (simp add: \<open>pathstart pp = z\<close>)
             show "pathfinish (pp +++ \<gamma>) = y'"
               by (simp add: \<open>pathfinish \<gamma> = y'\<close>)
             have paqq: "pathfinish qq = pathstart (p' \<circ> f \<circ> \<gamma>)"
               apply (simp add: \<open>pathstart \<gamma> = y\<close> pathstart_compose)
               apply (metis (mono_tags, lifting) \<open>l y \<in> W'\<close> \<open>path pp\<close> \<open>path qq\<close> \<open>path_image pp \<subseteq> U\<close> \<open>path_image qq \<subseteq> C\<close>
                            \<open>pathfinish pp = y\<close> \<open>pathstart pp = z\<close> \<open>pathstart qq = a\<close>
                            homeomorphism_apply1 [OF homUW'] l pleq pqqeq \<open>y \<in> U\<close>)
               done
             have "continuous_on (path_image \<gamma>) (p' \<circ> f)"
             proof (rule continuous_on_compose)
               show "continuous_on (path_image \<gamma>) f"
                 using \<open>path_image \<gamma> \<subseteq> V\<close> \<open>V \<subseteq> U\<close> contf continuous_on_subset by blast
               show "continuous_on (f ` path_image \<gamma>) p'"
                 apply (rule continuous_on_subset [OF contp'])
                 apply (auto simp: path_image_def pathfinish_def pathstart_def finW)
                 done
             qed
             then show "path (qq +++ (p' \<circ> f \<circ> \<gamma>))"
               using \<open>path \<gamma>\<close> \<open>path qq\<close> paqq path_continuous_image path_join_imp by blast
             show "path_image (qq +++ (p' \<circ> f \<circ> \<gamma>)) \<subseteq> C"
               apply (rule subset_path_image_join)
                apply (simp add: \<open>path_image qq \<subseteq> C\<close>)
               by (metis \<open>W' \<subseteq> C\<close> \<open>path_image \<gamma> \<subseteq> V\<close> dual_order.trans fimW(1) image_comp image_mono p'im path_image_compose)
             show "pathstart (qq +++ (p' \<circ> f \<circ> \<gamma>)) = a"
               by (simp add: \<open>pathstart qq = a\<close>)
             show "p ((qq +++ (p' \<circ> f \<circ> \<gamma>)) \<xi>) = f ((pp +++ \<gamma>) \<xi>)" if \<xi>: "\<xi> \<in> {0..1}" for \<xi>
             proof (simp add: joinpaths_def, safe)
               show "p (qq (2*\<xi>)) = f (pp (2*\<xi>))" if "\<xi>*2 \<le> 1"
                 using \<open>\<xi> \<in> {0..1}\<close> pqqeq that by auto
               show "p (p' (f (\<gamma> (2*\<xi> - 1)))) = f (\<gamma> (2*\<xi> - 1))" if "\<not> \<xi>*2 \<le> 1"
                 apply (rule homeomorphism_apply2 [OF homUW' finW])
                 using that \<xi> by auto
             qed
           qed
           with \<open>pathfinish \<gamma> = y'\<close>  \<open>p' (f y') \<in> X\<close> show "y' \<in> l -` X"
             unfolding pathfinish_join by (simp add: pathfinish_def)
         qed
       qed
     qed
     then show "continuous_on U l"
       by (metis IntD1 IntD2 vimage_eq openin_subopen continuous_on_open_gen [OF LC])
   qed
 qed
 
 
 corollary covering_space_lift_stronger:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and f :: "'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S" "a \<in> C" "z \<in> U"
       and U: "path_connected U" "locally path_connected U"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> S"
       and feq: "f z = p a"
       and hom: "\<And>r. \<lbrakk>path r; path_image r \<subseteq> U; pathstart r = z; pathfinish r = z\<rbrakk>
                      \<Longrightarrow> \<exists>b. homotopic_paths S (f \<circ> r) (linepath b b)"
   obtains g where "continuous_on U g" "g ` U \<subseteq> C" "g z = a" "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
 proof (rule covering_space_lift_general [OF cov U contf fim feq])
   fix r
   assume "path r" "path_image r \<subseteq> U" "pathstart r = z" "pathfinish r = z"
   then obtain b where b: "homotopic_paths S (f \<circ> r) (linepath b b)"
     using hom by blast
   then have "f (pathstart r) = b"
     by (metis homotopic_paths_imp_pathstart pathstart_compose pathstart_linepath)
   then have "homotopic_paths S (f \<circ> r) (linepath (f z) (f z))"
     by (simp add: b \<open>pathstart r = z\<close>)
   then have "homotopic_paths S (f \<circ> r) (p \<circ> linepath a a)"
     by (simp add: o_def feq linepath_def)
   then show "\<exists>q. path q \<and>
                   path_image q \<subseteq> C \<and>
                   pathstart q = a \<and> pathfinish q = a \<and> homotopic_paths S (f \<circ> r) (p \<circ> q)"
     by (force simp: \<open>a \<in> C\<close>)
 qed auto
 
 corollary covering_space_lift_strong:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and f :: "'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S" "a \<in> C" "z \<in> U"
       and scU: "simply_connected U" and lpcU: "locally path_connected U"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> S"
       and feq: "f z = p a"
   obtains g where "continuous_on U g" "g ` U \<subseteq> C" "g z = a" "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
 proof (rule covering_space_lift_stronger [OF cov _ lpcU contf fim feq])
   show "path_connected U"
     using scU simply_connected_eq_contractible_loop_some by blast
   fix r
   assume r: "path r" "path_image r \<subseteq> U" "pathstart r = z" "pathfinish r = z"
   have "linepath (f z) (f z) = f \<circ> linepath z z"
     by (simp add: o_def linepath_def)
   then have "homotopic_paths S (f \<circ> r) (linepath (f z) (f z))"
     by (metis r contf fim homotopic_paths_continuous_image scU simply_connected_eq_contractible_path)
   then show "\<exists>b. homotopic_paths S (f \<circ> r) (linepath b b)"
     by blast
 qed blast
 
 corollary covering_space_lift:
   fixes p :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and f :: "'c::real_normed_vector \<Rightarrow> 'b"
   assumes cov: "covering_space C p S"
       and U: "simply_connected U"  "locally path_connected U"
       and contf: "continuous_on U f" and fim: "f ` U \<subseteq> S"
     obtains g where "continuous_on U g" "g ` U \<subseteq> C" "\<And>y. y \<in> U \<Longrightarrow> p(g y) = f y"
 proof (cases "U = {}")
   case True
   with that show ?thesis by auto
 next
   case False
   then obtain z where "z \<in> U" by blast
   then obtain a where "a \<in> C" "f z = p a"
     by (metis cov covering_space_imp_surjective fim image_iff image_subset_iff)
   then show ?thesis
     by (metis that covering_space_lift_strong [OF cov _ \<open>z \<in> U\<close> U contf fim])
 qed
 
 end
diff --git a/src/HOL/Analysis/Homotopy.thy b/src/HOL/Analysis/Homotopy.thy
--- a/src/HOL/Analysis/Homotopy.thy
+++ b/src/HOL/Analysis/Homotopy.thy
@@ -1,5679 +1,5677 @@
 (*  Title:      HOL/Analysis/Path_Connected.thy
     Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
 *)
 
 section \<open>Homotopy of Maps\<close>
 
 theory Homotopy
   imports Path_Connected Continuum_Not_Denumerable Product_Topology
 begin
 
 definition\<^marker>\<open>tag important\<close> homotopic_with
 where
  "homotopic_with P X Y f g \<equiv>
    (\<exists>h. continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y h \<and>
        (\<forall>x. h(0, x) = f x) \<and>
        (\<forall>x. h(1, x) = g x) \<and>
        (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t,x))))"
 
 text\<open>\<open>p\<close>, \<open>q\<close> are functions \<open>X \<rightarrow> Y\<close>, and the property \<open>P\<close> restricts all intermediate maps.
 We often just want to require that \<open>P\<close> fixes some subset, but to include the case of a loop homotopy,
 it is convenient to have a general property \<open>P\<close>.\<close>
 
 abbreviation homotopic_with_canon ::
   "[('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool, 'a set, 'b set, 'a \<Rightarrow> 'b, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
 where
  "homotopic_with_canon P S T p q \<equiv> homotopic_with P (top_of_set S) (top_of_set T) p q"
 
 lemma split_01: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
   by force
 
 lemma split_01_prod: "{0..1::real} \<times> X = ({0..1/2} \<times> X) \<union> ({1/2..1} \<times> X)"
   by force
 
 lemma image_Pair_const: "(\<lambda>x. (x, c)) ` A = A \<times> {c}"
   by auto
 
 lemma fst_o_paired [simp]: "fst \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). f x y)"
   by auto
 
 lemma snd_o_paired [simp]: "snd \<circ> (\<lambda>(x,y). (f x y, g x y)) = (\<lambda>(x,y). g x y)"
   by auto
 
 lemma continuous_on_o_Pair: "\<lbrakk>continuous_on (T \<times> X) h; t \<in> T\<rbrakk> \<Longrightarrow> continuous_on X (h \<circ> Pair t)"
   by (fast intro: continuous_intros elim!: continuous_on_subset)
 
 lemma continuous_map_o_Pair: 
   assumes h: "continuous_map (prod_topology X Y) Z h" and t: "t \<in> topspace X"
   shows "continuous_map Y Z (h \<circ> Pair t)"
   apply (intro continuous_map_compose [OF _ h] continuous_map_id [unfolded id_def] continuous_intros)
   apply (simp add: t)
   done
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial properties\<close>
 
 text \<open>We often want to just localize the ending function equality or whatever.\<close>
 text\<^marker>\<open>tag important\<close> \<open>%whitespace\<close>
 proposition homotopic_with:
   assumes "\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> (P h \<longleftrightarrow> P k)"
   shows "homotopic_with P X Y p q \<longleftrightarrow>
            (\<exists>h. continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y h \<and>
               (\<forall>x \<in> topspace X. h(0,x) = p x) \<and>
               (\<forall>x \<in> topspace X. h(1,x) = q x) \<and>
               (\<forall>t \<in> {0..1}. P(\<lambda>x. h(t, x))))"
   unfolding homotopic_with_def
   apply (rule iffI, blast, clarify)
   apply (rule_tac x="\<lambda>(u,v). if v \<in> topspace X then h(u,v) else if u = 0 then p v else q v" in exI)
   apply auto
   using continuous_map_eq apply fastforce
   apply (drule_tac x=t in bspec, force)
   apply (subst assms; simp)
   done
 
 lemma homotopic_with_mono:
   assumes hom: "homotopic_with P X Y f g"
     and Q: "\<And>h. \<lbrakk>continuous_map X Y h; P h\<rbrakk> \<Longrightarrow> Q h"
   shows "homotopic_with Q X Y f g"
   using hom
   apply (simp add: homotopic_with_def)
   apply (erule ex_forward)
   apply (force simp: o_def dest: continuous_map_o_Pair intro: Q)
   done
 
 lemma homotopic_with_imp_continuous_maps:
     assumes "homotopic_with P X Y f g"
     shows "continuous_map X Y f \<and> continuous_map X Y g"
 proof -
   obtain h
     where conth: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y h"
       and h: "\<forall>x. h (0, x) = f x" "\<forall>x. h (1, x) = g x"
     using assms by (auto simp: homotopic_with_def)
   have *: "t \<in> {0..1} \<Longrightarrow> continuous_map X Y (h \<circ> (\<lambda>x. (t,x)))" for t
     by (rule continuous_map_compose [OF _ conth]) (simp add: o_def continuous_map_pairwise)
   show ?thesis
     using h *[of 0] *[of 1] by (simp add: continuous_map_eq)
 qed
 
 lemma homotopic_with_imp_continuous:
     assumes "homotopic_with_canon P X Y f g"
     shows "continuous_on X f \<and> continuous_on X g"
   by (meson assms continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 lemma homotopic_with_imp_property:
   assumes "homotopic_with P X Y f g"
   shows "P f \<and> P g"
 proof
   obtain h where h: "\<And>x. h(0, x) = f x" "\<And>x. h(1, x) = g x" and P: "\<And>t. t \<in> {0..1::real} \<Longrightarrow> P(\<lambda>x. h(t,x))"
     using assms by (force simp: homotopic_with_def)
   show "P f" "P g"
     using P [of 0] P [of 1] by (force simp: h)+
 qed
 
 lemma homotopic_with_equal:
   assumes "P f" "P g" and contf: "continuous_map X Y f" and fg: "\<And>x. x \<in> topspace X \<Longrightarrow> f x = g x"
   shows "homotopic_with P X Y f g"
   unfolding homotopic_with_def
 proof (intro exI conjI allI ballI)
   let ?h = "\<lambda>(t::real,x). if t = 1 then g x else f x"
   show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y ?h"
   proof (rule continuous_map_eq)
     show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X) Y (f \<circ> snd)"
       by (simp add: contf continuous_map_of_snd)
   qed (auto simp: fg)
   show "P (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
     by (cases "t = 1") (simp_all add: assms)
 qed auto
 
 lemma homotopic_with_imp_subset1:
      "homotopic_with_canon P X Y f g \<Longrightarrow> f ` X \<subseteq> Y"
   by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
 
 lemma homotopic_with_imp_subset2:
      "homotopic_with_canon P X Y f g \<Longrightarrow> g ` X \<subseteq> Y"
   by (simp add: homotopic_with_def image_subset_iff) (metis atLeastAtMost_iff order_refl zero_le_one)
 
 lemma homotopic_with_subset_left:
      "\<lbrakk>homotopic_with_canon P X Y f g; Z \<subseteq> X\<rbrakk> \<Longrightarrow> homotopic_with_canon P Z Y f g"
   apply (simp add: homotopic_with_def)
   apply (fast elim!: continuous_on_subset ex_forward)
   done
 
 lemma homotopic_with_subset_right:
      "\<lbrakk>homotopic_with_canon P X Y f g; Y \<subseteq> Z\<rbrakk> \<Longrightarrow> homotopic_with_canon P X Z f g"
   apply (simp add: homotopic_with_def)
   apply (fast elim!: continuous_on_subset ex_forward)
   done
 
 subsection\<open>Homotopy with P is an equivalence relation\<close>
 
 text \<open>(on continuous functions mapping X into Y that satisfy P, though this only affects reflexivity)\<close>
 
 lemma homotopic_with_refl [simp]: "homotopic_with P X Y f f \<longleftrightarrow> continuous_map X Y f \<and> P f"
   by (auto simp: homotopic_with_imp_continuous_maps intro: homotopic_with_equal dest: homotopic_with_imp_property)
 
 lemma homotopic_with_symD:
     assumes "homotopic_with P X Y f g"
       shows "homotopic_with P X Y g f"
 proof -
   let ?I01 = "subtopology euclideanreal {0..1}"
   let ?j = "\<lambda>y. (1 - fst y, snd y)"
   have 1: "continuous_map (prod_topology ?I01 X) (prod_topology euclideanreal X) ?j"
     apply (intro continuous_intros)
     apply (simp_all add: prod_topology_subtopology continuous_map_from_subtopology [OF continuous_map_fst])
     done
   have *: "continuous_map (prod_topology ?I01 X) (prod_topology ?I01 X) ?j"
   proof -
     have "continuous_map (prod_topology ?I01 X) (subtopology (prod_topology euclideanreal X) ({0..1} \<times> topspace X)) ?j"
       by (simp add: continuous_map_into_subtopology [OF 1] image_subset_iff)
     then show ?thesis
       by (simp add: prod_topology_subtopology(1))
   qed
   show ?thesis
     using assms
     apply (clarsimp simp add: homotopic_with_def)
     apply (rename_tac h)
     apply (rule_tac x="h \<circ> (\<lambda>y. (1 - fst y, snd y))" in exI)
     apply (simp add: continuous_map_compose [OF *])
     done
 qed
 
 lemma homotopic_with_sym:
    "homotopic_with P X Y f g \<longleftrightarrow> homotopic_with P X Y g f"
   by (metis homotopic_with_symD)
 
 proposition homotopic_with_trans:
     assumes "homotopic_with P X Y f g"  "homotopic_with P X Y g h"
     shows "homotopic_with P X Y f h"
 proof -
   let ?X01 = "prod_topology (subtopology euclideanreal {0..1}) X"
   obtain k1 k2
     where contk1: "continuous_map ?X01 Y k1" and contk2: "continuous_map ?X01 Y k2"
       and k12: "\<forall>x. k1 (1, x) = g x" "\<forall>x. k2 (0, x) = g x"
       "\<forall>x. k1 (0, x) = f x" "\<forall>x. k2 (1, x) = h x"
       and P:   "\<forall>t\<in>{0..1}. P (\<lambda>x. k1 (t, x))" "\<forall>t\<in>{0..1}. P (\<lambda>x. k2 (t, x))"
     using assms by (auto simp: homotopic_with_def)
   define k where "k \<equiv> \<lambda>y. if fst y \<le> 1/2
                              then (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y
                              else (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
   have keq: "k1 (2 * u, v) = k2 (2 * u -1, v)" if "u = 1/2"  for u v
     by (simp add: k12 that)
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI)
     show "continuous_map ?X01 Y k"
       unfolding k_def
     proof (rule continuous_map_cases_le)
       show fst: "continuous_map ?X01 euclideanreal fst"
         using continuous_map_fst continuous_map_in_subtopology by blast
       show "continuous_map ?X01 euclideanreal (\<lambda>x. 1/2)"
         by simp
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. fst y \<le> 1/2}) Y
                (k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x)))"
         apply (rule fst continuous_map_compose [OF _ contk1] continuous_intros continuous_map_into_subtopology | simp)+
           apply (intro continuous_intros fst continuous_map_from_subtopology)
          apply (force simp: prod_topology_subtopology)
         using continuous_map_snd continuous_map_from_subtopology by blast
       show "continuous_map (subtopology ?X01 {y \<in> topspace ?X01. 1/2 \<le> fst y}) Y
                (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x)))"
         apply (rule fst continuous_map_compose [OF _ contk2] continuous_intros continuous_map_into_subtopology | simp)+
           apply (rule continuous_intros fst continuous_map_from_subtopology | simp)+
-         apply (force simp: topspace_subtopology prod_topology_subtopology)
+         apply (force simp: prod_topology_subtopology)
         using continuous_map_snd  continuous_map_from_subtopology by blast
       show "(k1 \<circ> (\<lambda>x. (2 *\<^sub>R fst x, snd x))) y = (k2 \<circ> (\<lambda>x. (2 *\<^sub>R fst x -1, snd x))) y"
         if "y \<in> topspace ?X01" and "fst y = 1/2" for y
         using that by (simp add: keq)
     qed
     show "\<forall>x. k (0, x) = f x"
       by (simp add: k12 k_def)
     show "\<forall>x. k (1, x) = h x"
       by (simp add: k12 k_def)
     show "\<forall>t\<in>{0..1}. P (\<lambda>x. k (t, x))"
       using P
       apply (clarsimp simp add: k_def)
       apply (case_tac "t \<le> 1/2", auto)
       done
   qed
 qed
 
 lemma homotopic_with_id2: 
   "(\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x) \<Longrightarrow> homotopic_with (\<lambda>x. True) X X (g \<circ> f) id"
   by (metis comp_apply continuous_map_id eq_id_iff homotopic_with_equal homotopic_with_symD)
 
 subsection\<open>Continuity lemmas\<close>
 
 lemma homotopic_with_compose_continuous_map_left:
   "\<lbrakk>homotopic_with p X1 X2 f g; continuous_map X2 X3 h; \<And>j. p j \<Longrightarrow> q(h \<circ> j)\<rbrakk>
    \<Longrightarrow> homotopic_with q X1 X3 (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_with_def
   apply clarify
   apply (rename_tac k)
   apply (rule_tac x="h \<circ> k" in exI)
   apply (rule conjI continuous_map_compose | simp add: o_def)+
   done
 
 lemma homotopic_compose_continuous_map_left:
    "\<lbrakk>homotopic_with (\<lambda>k. True) X1 X2 f g; continuous_map X2 X3 h\<rbrakk>
         \<Longrightarrow> homotopic_with (\<lambda>k. True) X1 X3 (h \<circ> f) (h \<circ> g)"
   by (simp add: homotopic_with_compose_continuous_map_left)
 
 lemma homotopic_with_compose_continuous_map_right:
   assumes hom: "homotopic_with p X2 X3 f g" and conth: "continuous_map X1 X2 h"
     and q: "\<And>j. p j \<Longrightarrow> q(j \<circ> h)"
   shows "homotopic_with q X1 X3 (f \<circ> h) (g \<circ> h)"
 proof -
   obtain k
     where contk: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) X3 k"
       and k: "\<forall>x. k (0, x) = f x" "\<forall>x. k (1, x) = g x" and p: "\<And>t. t\<in>{0..1} \<Longrightarrow> p (\<lambda>x. k (t, x))"
     using hom unfolding homotopic_with_def by blast
   have hsnd: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X2 (h \<circ> snd)"
     by (rule continuous_map_compose [OF continuous_map_snd conth])
   let ?h = "k \<circ> (\<lambda>(t,x). (t,h x))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro exI conjI allI ballI)
     have "continuous_map (prod_topology (top_of_set {0..1}) X1)
      (prod_topology (top_of_set {0..1::real}) X2) (\<lambda>(t, x). (t, h x))"
       by (metis (mono_tags, lifting) case_prod_beta' comp_def continuous_map_eq continuous_map_fst continuous_map_pairedI hsnd)
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) X3 ?h"
       by (intro conjI continuous_map_compose [OF _ contk])
     show "q (\<lambda>x. ?h (t, x))" if "t \<in> {0..1}" for t
       using q [OF p [OF that]] by (simp add: o_def)
   qed (auto simp: k)
 qed
 
 lemma homotopic_compose_continuous_map_right:
    "\<lbrakk>homotopic_with (\<lambda>k. True) X2 X3 f g; continuous_map X1 X2 h\<rbrakk>
         \<Longrightarrow> homotopic_with (\<lambda>k. True) X1 X3 (f \<circ> h) (g \<circ> h)"
   by (meson homotopic_with_compose_continuous_map_right)
 
 corollary homotopic_compose:
       shows "\<lbrakk>homotopic_with (\<lambda>x. True) X Y f f'; homotopic_with (\<lambda>x. True) Y Z g g'\<rbrakk>
              \<Longrightarrow> homotopic_with (\<lambda>x. True) X Z (g \<circ> f) (g' \<circ> f')"
   apply (rule homotopic_with_trans [where g = "g \<circ> f'"])
   apply (simp add: homotopic_compose_continuous_map_left homotopic_with_imp_continuous_maps)
   by (simp add: homotopic_compose_continuous_map_right homotopic_with_imp_continuous_maps)
 
 
 
 proposition homotopic_with_compose_continuous_right:
     "\<lbrakk>homotopic_with_canon (\<lambda>f. p (f \<circ> h)) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
      \<Longrightarrow> homotopic_with_canon p W Y (f \<circ> h) (g \<circ> h)"
   apply (clarsimp simp add: homotopic_with_def)
   apply (rename_tac k)
   apply (rule_tac x="k \<circ> (\<lambda>y. (fst y, h (snd y)))" in exI)
   apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   apply (erule continuous_on_subset)
   apply (fastforce simp: o_def)+
   done
 
 proposition homotopic_compose_continuous_right:
      "\<lbrakk>homotopic_with_canon (\<lambda>f. True) X Y f g; continuous_on W h; h ` W \<subseteq> X\<rbrakk>
       \<Longrightarrow> homotopic_with_canon (\<lambda>f. True) W Y (f \<circ> h) (g \<circ> h)"
   using homotopic_with_compose_continuous_right by fastforce
 
 proposition homotopic_with_compose_continuous_left:
      "\<lbrakk>homotopic_with_canon (\<lambda>f. p (h \<circ> f)) X Y f g; continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
       \<Longrightarrow> homotopic_with_canon p X Z (h \<circ> f) (h \<circ> g)"
   apply (clarsimp simp add: homotopic_with_def)
   apply (rename_tac k)
   apply (rule_tac x="h \<circ> k" in exI)
   apply (rule conjI continuous_intros continuous_on_compose [where f=snd and g=h, unfolded o_def] | simp)+
   apply (erule continuous_on_subset)
   apply (fastforce simp: o_def)+
   done
 
 proposition homotopic_compose_continuous_left:
    "\<lbrakk>homotopic_with_canon (\<lambda>_. True) X Y f g;
      continuous_on Y h; h ` Y \<subseteq> Z\<rbrakk>
     \<Longrightarrow> homotopic_with_canon (\<lambda>f. True) X Z (h \<circ> f) (h \<circ> g)"
   using homotopic_with_compose_continuous_left by fastforce
 
 lemma homotopic_from_subtopology:
    "homotopic_with P X X' f g \<Longrightarrow> homotopic_with P (subtopology X s) X' f g"
   unfolding homotopic_with_def
   apply (erule ex_forward)
   by (simp add: continuous_map_from_subtopology prod_topology_subtopology(2))
 
 lemma homotopic_on_emptyI:
     assumes "topspace X = {}" "P f" "P g"
     shows "homotopic_with P X X' f g"
   unfolding homotopic_with_def
 proof (intro exI conjI ballI)
   show "P (\<lambda>x. (\<lambda>(t,x). if t = 0 then f x else g x) (t, x))" if "t \<in> {0..1}" for t::real
     by (cases "t = 0", auto simp: assms)
 qed (auto simp: continuous_map_atin assms)
 
 lemma homotopic_on_empty:
    "topspace X = {} \<Longrightarrow> (homotopic_with P X X' f g \<longleftrightarrow> P f \<and> P g)"
   using homotopic_on_emptyI homotopic_with_imp_property by metis
 
 lemma homotopic_with_canon_on_empty [simp]: "homotopic_with_canon (\<lambda>x. True) {} t f g"
   by (auto intro: homotopic_with_equal)
 
 lemma homotopic_constant_maps:
    "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b) \<longleftrightarrow>
     topspace X = {} \<or> path_component_of X' a b" (is "?lhs = ?rhs")
 proof (cases "topspace X = {}")
   case False
   then obtain c where c: "c \<in> topspace X"
     by blast
   have "\<exists>g. continuous_map (top_of_set {0..1::real}) X' g \<and> g 0 = a \<and> g 1 = b"
     if "x \<in> topspace X" and hom: "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. a) (\<lambda>x. b)" for x
   proof -
     obtain h :: "real \<times> 'a \<Rightarrow> 'b"
       where conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X' h"
         and h: "\<And>x. h (0, x) = a" "\<And>x. h (1, x) = b"
       using hom by (auto simp: homotopic_with_def)
     have cont: "continuous_map (top_of_set {0..1}) X' (h \<circ> (\<lambda>t. (t, c)))"
       apply (rule continuous_map_compose [OF _ conth])
       apply (rule continuous_intros c | simp)+
       done
     then show ?thesis
       by (force simp: h)
   qed
   moreover have "homotopic_with (\<lambda>x. True) X X' (\<lambda>x. g 0) (\<lambda>x. g 1)"
     if "x \<in> topspace X" "a = g 0" "b = g 1" "continuous_map (top_of_set {0..1}) X' g"
     for x and g :: "real \<Rightarrow> 'b"
     unfolding homotopic_with_def
     by (force intro!: continuous_map_compose continuous_intros c that)
   ultimately show ?thesis
     using False by (auto simp: path_component_of_def pathin_def)
 qed (simp add: homotopic_on_empty)
 
 proposition homotopic_with_eq:
    assumes h: "homotopic_with P X Y f g"
        and f': "\<And>x. x \<in> topspace X \<Longrightarrow> f' x = f x"
        and g': "\<And>x. x \<in> topspace X \<Longrightarrow> g' x = g x"
        and P:  "(\<And>h k. (\<And>x. x \<in> topspace X \<Longrightarrow> h x = k x) \<Longrightarrow> P h \<longleftrightarrow> P k)"
    shows "homotopic_with P X Y f' g'"
   using h unfolding homotopic_with_def
   apply safe
   apply (rule_tac x="\<lambda>(u,v). if v \<in> topspace X then h(u,v) else if u = 0 then f' v else g' v" in exI)
   apply (simp add: f' g', safe)
   apply (fastforce intro: continuous_map_eq)
   apply (subst P; fastforce)
   done
 
 lemma homotopic_with_prod_topology:
   assumes "homotopic_with p X1 Y1 f f'" and "homotopic_with q X2 Y2 g g'"
     and r: "\<And>i j. \<lbrakk>p i; q j\<rbrakk> \<Longrightarrow> r(\<lambda>(x,y). (i x, j y))"
   shows "homotopic_with r (prod_topology X1 X2) (prod_topology Y1 Y2)
                           (\<lambda>z. (f(fst z),g(snd z))) (\<lambda>z. (f'(fst z), g'(snd z)))"
 proof -
   obtain h
     where h: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X1) Y1 h"
       and h0: "\<And>x. h (0, x) = f x"
       and h1: "\<And>x. h (1, x) = f' x"
       and p: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> p (\<lambda>x. h (t,x))"
     using assms unfolding homotopic_with_def by auto
   obtain k
     where k: "continuous_map (prod_topology (subtopology euclideanreal {0..1}) X2) Y2 k"
       and k0: "\<And>x. k (0, x) = g x"
       and k1: "\<And>x. k (1, x) = g' x"
       and q: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1\<rbrakk> \<Longrightarrow> q (\<lambda>x. k (t,x))"
     using assms unfolding homotopic_with_def by auto
   let ?hk = "\<lambda>(t,x,y). (h(t,x), k(t,y))"
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (prod_topology X1 X2))
                          (prod_topology Y1 Y2) ?hk"
       unfolding continuous_map_pairwise case_prod_unfold
       by (rule conjI continuous_map_pairedI continuous_intros continuous_map_id [unfolded id_def]
           continuous_map_fst_of [unfolded o_def] continuous_map_snd_of [unfolded o_def]
           continuous_map_compose [OF _ h, unfolded o_def]
           continuous_map_compose [OF _ k, unfolded o_def])+
   next
     fix x
     show "?hk (0, x) = (f (fst x), g (snd x))" "?hk (1, x) = (f' (fst x), g' (snd x))"
       by (auto simp: case_prod_beta h0 k0 h1 k1)
   qed (auto simp: p q r)
 qed
 
 
 lemma homotopic_with_product_topology:
   assumes ht: "\<And>i. i \<in> I \<Longrightarrow> homotopic_with (p i) (X i) (Y i) (f i) (g i)"
     and pq: "\<And>h. (\<And>i. i \<in> I \<Longrightarrow> p i (h i)) \<Longrightarrow> q(\<lambda>x. (\<lambda>i\<in>I. h i (x i)))"
   shows "homotopic_with q (product_topology X I) (product_topology Y I)
                           (\<lambda>z. (\<lambda>i\<in>I. (f i) (z i))) (\<lambda>z. (\<lambda>i\<in>I. (g i) (z i)))"
 proof -
   obtain h
     where h: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (prod_topology (subtopology euclideanreal {0..1}) (X i)) (Y i) (h i)"
       and h0: "\<And>i x. i \<in> I \<Longrightarrow> h i (0, x) = f i x"
       and h1: "\<And>i x. i \<in> I \<Longrightarrow> h i (1, x) = g i x"
       and p: "\<And>i t. \<lbrakk>i \<in> I; t \<in> {0..1}\<rbrakk> \<Longrightarrow> p i (\<lambda>x. h i (t,x))"
     using ht unfolding homotopic_with_def by metis
   show ?thesis
     unfolding homotopic_with_def
   proof (intro conjI allI exI)
     let ?h = "\<lambda>(t,z). \<lambda>i\<in>I. h i (t,z i)"
     have "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
                          (Y i) (\<lambda>x. h i (fst x, snd x i))" if "i \<in> I" for i
       unfolding continuous_map_pairwise case_prod_unfold
       apply (intro conjI that  continuous_intros continuous_map_compose [OF _ h, unfolded o_def])
       using continuous_map_componentwise continuous_map_snd that apply fastforce
       done
     then show "continuous_map (prod_topology (subtopology euclideanreal {0..1}) (product_topology X I))
          (product_topology Y I) ?h"
       by (auto simp: continuous_map_componentwise case_prod_beta)
     show "?h (0, x) = (\<lambda>i\<in>I. f i (x i))" "?h (1, x) = (\<lambda>i\<in>I. g i (x i))" for x
       by (auto simp: case_prod_beta h0 h1)
     show "\<forall>t\<in>{0..1}. q (\<lambda>x. ?h (t, x))"
       by (force intro: p pq)
   qed
 qed
 
 text\<open>Homotopic triviality implicitly incorporates path-connectedness.\<close>
 lemma homotopic_triviality:
   shows  "(\<forall>f g. continuous_on S f \<and> f ` S \<subseteq> T \<and>
                  continuous_on S g \<and> g ` S \<subseteq> T
                  \<longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g) \<longleftrightarrow>
           (S = {} \<or> path_connected T) \<and>
           (\<forall>f. continuous_on S f \<and> f ` S \<subseteq> T \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)))"
           (is "?lhs = ?rhs")
 proof (cases "S = {} \<or> T = {}")
   case True then show ?thesis
     by (auto simp: homotopic_on_emptyI)
 next
   case False show ?thesis
   proof
     assume LHS [rule_format]: ?lhs
     have pab: "path_component T a b" if "a \<in> T" "b \<in> T" for a b
     proof -
       have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. a) (\<lambda>x. b)"
-        by (simp add: LHS continuous_on_const image_subset_iff that)
+        by (simp add: LHS image_subset_iff that)
       then show ?thesis
         using False homotopic_constant_maps [of "top_of_set S" "top_of_set T" a b] by auto
     qed
     moreover
     have "\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" if "continuous_on S f" "f ` S \<subseteq> T" for f
       using False LHS continuous_on_const that by blast
     ultimately show ?rhs
       by (simp add: path_connected_component)
   next
     assume RHS: ?rhs
     with False have T: "path_connected T"
       by blast
     show ?lhs
     proof clarify
       fix f g
       assume "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T"
       obtain c d where c: "homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)" and d: "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. d)"
         using False \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> T\<close>  RHS \<open>continuous_on S g\<close> \<open>g ` S \<subseteq> T\<close> by blast
       then have "c \<in> T" "d \<in> T"
         using False homotopic_with_imp_continuous_maps by fastforce+
       with T have "path_component T c d"
         using path_connected_component by blast
       then have "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) (\<lambda>x. d)"
         by (simp add: homotopic_constant_maps)
       with c d show "homotopic_with_canon (\<lambda>x. True) S T f g"
         by (meson homotopic_with_symD homotopic_with_trans)
     qed
   qed
 qed
 
 
 subsection\<open>Homotopy of paths, maintaining the same endpoints\<close>
 
 
 definition\<^marker>\<open>tag important\<close> homotopic_paths :: "['a set, real \<Rightarrow> 'a, real \<Rightarrow> 'a::topological_space] \<Rightarrow> bool"
   where
      "homotopic_paths s p q \<equiv>
        homotopic_with_canon (\<lambda>r. pathstart r = pathstart p \<and> pathfinish r = pathfinish p) {0..1} s p q"
 
 lemma homotopic_paths:
    "homotopic_paths s p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1} \<times> {0..1}) h \<and>
           h ` ({0..1} \<times> {0..1}) \<subseteq> s \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1::real}. pathstart(h \<circ> Pair t) = pathstart p \<and>
                         pathfinish(h \<circ> Pair t) = pathfinish p))"
   by (auto simp: homotopic_paths_def homotopic_with pathstart_def pathfinish_def)
 
 proposition homotopic_paths_imp_pathstart:
      "homotopic_paths s p q \<Longrightarrow> pathstart p = pathstart q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 proposition homotopic_paths_imp_pathfinish:
      "homotopic_paths s p q \<Longrightarrow> pathfinish p = pathfinish q"
   by (metis (mono_tags, lifting) homotopic_paths_def homotopic_with_imp_property)
 
 lemma homotopic_paths_imp_path:
      "homotopic_paths s p q \<Longrightarrow> path p \<and> path q"
   using homotopic_paths_def homotopic_with_imp_continuous_maps path_def continuous_map_subtopology_eu by blast
 
 lemma homotopic_paths_imp_subset:
      "homotopic_paths s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   by (metis (mono_tags) continuous_map_subtopology_eu homotopic_paths_def homotopic_with_imp_continuous_maps path_image_def)
 
 proposition homotopic_paths_refl [simp]: "homotopic_paths s p p \<longleftrightarrow> path p \<and> path_image p \<subseteq> s"
   by (simp add: homotopic_paths_def path_def path_image_def)
 
 proposition homotopic_paths_sym: "homotopic_paths s p q \<Longrightarrow> homotopic_paths s q p"
   by (metis (mono_tags) homotopic_paths_def homotopic_paths_imp_pathfinish homotopic_paths_imp_pathstart homotopic_with_symD)
 
 proposition homotopic_paths_sym_eq: "homotopic_paths s p q \<longleftrightarrow> homotopic_paths s q p"
   by (metis homotopic_paths_sym)
 
 proposition homotopic_paths_trans [trans]:
   assumes "homotopic_paths s p q" "homotopic_paths s q r"
   shows "homotopic_paths s p r"
 proof -
   have "pathstart q = pathstart p" "pathfinish q = pathfinish p"
     using assms by (simp_all add: homotopic_paths_imp_pathstart homotopic_paths_imp_pathfinish)
   then have "homotopic_with_canon (\<lambda>f. pathstart f = pathstart p \<and> pathfinish f = pathfinish p) {0..1} s q r"
     using \<open>homotopic_paths s q r\<close> homotopic_paths_def by force
   then show ?thesis
     using assms homotopic_paths_def homotopic_with_trans by blast
 qed
 
 proposition homotopic_paths_eq:
      "\<lbrakk>path p; path_image p \<subseteq> s; \<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t\<rbrakk> \<Longrightarrow> homotopic_paths s p q"
   apply (simp add: homotopic_paths_def)
   apply (rule homotopic_with_eq)
-  apply (auto simp: path_def homotopic_with_refl pathstart_def pathfinish_def path_image_def elim: continuous_on_eq)
+  apply (auto simp: path_def pathstart_def pathfinish_def path_image_def elim: continuous_on_eq)
   done
 
 proposition homotopic_paths_reparametrize:
   assumes "path p"
       and pips: "path_image p \<subseteq> s"
       and contf: "continuous_on {0..1} f"
       and f01:"f ` {0..1} \<subseteq> {0..1}"
       and [simp]: "f(0) = 0" "f(1) = 1"
       and q: "\<And>t. t \<in> {0..1} \<Longrightarrow> q(t) = p(f t)"
     shows "homotopic_paths s p q"
 proof -
   have contp: "continuous_on {0..1} p"
     by (metis \<open>path p\<close> path_def)
   then have "continuous_on {0..1} (p \<circ> f)"
     using contf continuous_on_compose continuous_on_subset f01 by blast
   then have "path q"
     by (simp add: path_def) (metis q continuous_on_cong)
   have piqs: "path_image q \<subseteq> s"
     by (metis (no_types, hide_lams) pips f01 image_subset_iff path_image_def q)
   have fb0: "\<And>a b. \<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> (1 - a) * f b + a * b"
     using f01 by force
   have fb1: "\<lbrakk>0 \<le> a; a \<le> 1; 0 \<le> b; b \<le> 1\<rbrakk> \<Longrightarrow> (1 - a) * f b + a * b \<le> 1" for a b
     using f01 [THEN subsetD, of "f b"] by (simp add: convex_bound_le)
   have "homotopic_paths s q p"
   proof (rule homotopic_paths_trans)
     show "homotopic_paths s q (p \<circ> f)"
       using q by (force intro: homotopic_paths_eq [OF  \<open>path q\<close> piqs])
   next
     show "homotopic_paths s (p \<circ> f) p"
       apply (simp add: homotopic_paths_def homotopic_with_def)
       apply (rule_tac x="p \<circ> (\<lambda>y. (1 - (fst y)) *\<^sub>R ((f \<circ> snd) y) + (fst y) *\<^sub>R snd y)"  in exI)
       apply (rule conjI contf continuous_intros continuous_on_subset [OF contp] | simp)+
       using pips [unfolded path_image_def]
       apply (auto simp: fb0 fb1 pathstart_def pathfinish_def)
       done
   qed
   then show ?thesis
     by (simp add: homotopic_paths_sym)
 qed
 
 lemma homotopic_paths_subset: "\<lbrakk>homotopic_paths s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t p q"
   unfolding homotopic_paths by fast
 
 
 text\<open> A slightly ad-hoc but useful lemma in constructing homotopies.\<close>
 lemma homotopic_join_lemma:
   fixes q :: "[real,real] \<Rightarrow> 'a::topological_space"
   assumes p: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. p (fst y) (snd y))"
       and q: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. q (fst y) (snd y))"
       and pf: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish(p t) = pathstart(q t)"
     shows "continuous_on ({0..1} \<times> {0..1}) (\<lambda>y. (p(fst y) +++ q(fst y)) (snd y))"
 proof -
   have 1: "(\<lambda>y. p (fst y) (2 * snd y)) = (\<lambda>y. p (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y))"
     by (rule ext) (simp)
   have 2: "(\<lambda>y. q (fst y) (2 * snd y - 1)) = (\<lambda>y. q (fst y) (snd y)) \<circ> (\<lambda>y. (fst y, 2 * snd y - 1))"
     by (rule ext) (simp)
   show ?thesis
     apply (simp add: joinpaths_def)
     apply (rule continuous_on_cases_le)
     apply (simp_all only: 1 2)
     apply (rule continuous_intros continuous_on_subset [OF p] continuous_on_subset [OF q] | force)+
     using pf
     apply (auto simp: mult.commute pathstart_def pathfinish_def)
     done
 qed
 
 text\<open> Congruence properties of homotopy w.r.t. path-combining operations.\<close>
 
 lemma homotopic_paths_reversepath_D:
       assumes "homotopic_paths s p q"
       shows   "homotopic_paths s (reversepath p) (reversepath q)"
   using assms
   apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   apply (rule_tac x="h \<circ> (\<lambda>x. (fst x, 1 - snd x))" in exI)
   apply (rule conjI continuous_intros)+
   apply (auto simp: reversepath_def pathstart_def pathfinish_def elim!: continuous_on_subset)
   done
 
 proposition homotopic_paths_reversepath:
      "homotopic_paths s (reversepath p) (reversepath q) \<longleftrightarrow> homotopic_paths s p q"
   using homotopic_paths_reversepath_D by force
 
 
 proposition homotopic_paths_join:
     "\<lbrakk>homotopic_paths s p p'; homotopic_paths s q q'; pathfinish p = pathstart q\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ q) (p' +++ q')"
   apply (simp add: homotopic_paths_def homotopic_with_def, clarify)
   apply (rename_tac k1 k2)
   apply (rule_tac x="(\<lambda>y. ((k1 \<circ> Pair (fst y)) +++ (k2 \<circ> Pair (fst y))) (snd y))" in exI)
   apply (rule conjI continuous_intros homotopic_join_lemma)+
   apply (auto simp: joinpaths_def pathstart_def pathfinish_def path_image_def)
   done
 
 proposition homotopic_paths_continuous_image:
     "\<lbrakk>homotopic_paths s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_paths t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_paths_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_compose pathstart_compose)
 
 
 subsection\<open>Group properties for homotopy of paths\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>So taking equivalence classes under homotopy would give the fundamental group\<close>
 
 proposition homotopic_paths_rid:
     "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p)) p"
   apply (subst homotopic_paths_sym)
   apply (rule homotopic_paths_reparametrize [where f = "\<lambda>t. if  t \<le> 1 / 2 then 2 *\<^sub>R t else 1"])
   apply (simp_all del: le_divide_eq_numeral1)
   apply (subst split_01)
   apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
   done
 
 proposition homotopic_paths_lid:
    "\<lbrakk>path p; path_image p \<subseteq> s\<rbrakk> \<Longrightarrow> homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p) p"
   using homotopic_paths_rid [of "reversepath p" s]
   by (metis homotopic_paths_reversepath path_image_reversepath path_reversepath pathfinish_linepath
         pathfinish_reversepath reversepath_joinpaths reversepath_linepath)
 
 proposition homotopic_paths_assoc:
    "\<lbrakk>path p; path_image p \<subseteq> s; path q; path_image q \<subseteq> s; path r; path_image r \<subseteq> s; pathfinish p = pathstart q;
      pathfinish q = pathstart r\<rbrakk>
     \<Longrightarrow> homotopic_paths s (p +++ (q +++ r)) ((p +++ q) +++ r)"
   apply (subst homotopic_paths_sym)
   apply (rule homotopic_paths_reparametrize
            [where f = "\<lambda>t. if  t \<le> 1 / 2 then inverse 2 *\<^sub>R t
                            else if  t \<le> 3 / 4 then t - (1 / 4)
                            else 2 *\<^sub>R t - 1"])
   apply (simp_all del: le_divide_eq_numeral1)
   apply (simp add: subset_path_image_join)
   apply (rule continuous_on_cases_1 continuous_intros)+
   apply (auto simp: joinpaths_def)
   done
 
 proposition homotopic_paths_rinv:
   assumes "path p" "path_image p \<subseteq> s"
     shows "homotopic_paths s (p +++ reversepath p) (linepath (pathstart p) (pathstart p))"
 proof -
   have "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. (subpath 0 (fst x) p +++ reversepath (subpath 0 (fst x) p)) (snd x))"
     using assms
     apply (simp add: joinpaths_def subpath_def reversepath_def path_def del: le_divide_eq_numeral1)
     apply (rule continuous_on_cases_le)
     apply (rule_tac [2] continuous_on_compose [of _ _ p, unfolded o_def])
     apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
     apply (auto intro!: continuous_intros simp del: eq_divide_eq_numeral1)
     apply (force elim!: continuous_on_subset simp add: mult_le_one)+
     done
   then show ?thesis
     using assms
     apply (subst homotopic_paths_sym_eq)
     unfolding homotopic_paths_def homotopic_with_def
     apply (rule_tac x="(\<lambda>y. (subpath 0 (fst y) p +++ reversepath(subpath 0 (fst y) p)) (snd y))" in exI)
     apply (simp add: path_defs joinpaths_def subpath_def reversepath_def)
     apply (force simp: mult_le_one)
     done
 qed
 
 proposition homotopic_paths_linv:
   assumes "path p" "path_image p \<subseteq> s"
     shows "homotopic_paths s (reversepath p +++ p) (linepath (pathfinish p) (pathfinish p))"
   using homotopic_paths_rinv [of "reversepath p" s] assms by simp
 
 
 subsection\<open>Homotopy of loops without requiring preservation of endpoints\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopic_loops :: "'a::topological_space set \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool"  where
  "homotopic_loops s p q \<equiv>
      homotopic_with_canon (\<lambda>r. pathfinish r = pathstart r) {0..1} s p q"
 
 lemma homotopic_loops:
    "homotopic_loops s p q \<longleftrightarrow>
       (\<exists>h. continuous_on ({0..1::real} \<times> {0..1}) h \<and>
           image h ({0..1} \<times> {0..1}) \<subseteq> s \<and>
           (\<forall>x \<in> {0..1}. h(0,x) = p x) \<and>
           (\<forall>x \<in> {0..1}. h(1,x) = q x) \<and>
           (\<forall>t \<in> {0..1}. pathfinish(h \<circ> Pair t) = pathstart(h \<circ> Pair t)))"
   by (simp add: homotopic_loops_def pathstart_def pathfinish_def homotopic_with)
 
 proposition homotopic_loops_imp_loop:
      "homotopic_loops s p q \<Longrightarrow> pathfinish p = pathstart p \<and> pathfinish q = pathstart q"
 using homotopic_with_imp_property homotopic_loops_def by blast
 
 proposition homotopic_loops_imp_path:
      "homotopic_loops s p q \<Longrightarrow> path p \<and> path q"
   unfolding homotopic_loops_def path_def
   using homotopic_with_imp_continuous_maps continuous_map_subtopology_eu by blast
 
 proposition homotopic_loops_imp_subset:
      "homotopic_loops s p q \<Longrightarrow> path_image p \<subseteq> s \<and> path_image q \<subseteq> s"
   unfolding homotopic_loops_def path_image_def
   by (meson continuous_map_subtopology_eu homotopic_with_imp_continuous_maps)
 
 proposition homotopic_loops_refl:
      "homotopic_loops s p p \<longleftrightarrow>
       path p \<and> path_image p \<subseteq> s \<and> pathfinish p = pathstart p"
   by (simp add: homotopic_loops_def path_image_def path_def)
 
 proposition homotopic_loops_sym: "homotopic_loops s p q \<Longrightarrow> homotopic_loops s q p"
   by (simp add: homotopic_loops_def homotopic_with_sym)
 
 proposition homotopic_loops_sym_eq: "homotopic_loops s p q \<longleftrightarrow> homotopic_loops s q p"
   by (metis homotopic_loops_sym)
 
 proposition homotopic_loops_trans:
    "\<lbrakk>homotopic_loops s p q; homotopic_loops s q r\<rbrakk> \<Longrightarrow> homotopic_loops s p r"
   unfolding homotopic_loops_def by (blast intro: homotopic_with_trans)
 
 proposition homotopic_loops_subset:
    "\<lbrakk>homotopic_loops s p q; s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t p q"
   by (fastforce simp add: homotopic_loops)
 
 proposition homotopic_loops_eq:
    "\<lbrakk>path p; path_image p \<subseteq> s; pathfinish p = pathstart p; \<And>t. t \<in> {0..1} \<Longrightarrow> p(t) = q(t)\<rbrakk>
           \<Longrightarrow> homotopic_loops s p q"
   unfolding homotopic_loops_def
   apply (rule homotopic_with_eq)
   apply (rule homotopic_with_refl [where f = p, THEN iffD2])
   apply (simp_all add: path_image_def path_def pathstart_def pathfinish_def)
   done
 
 proposition homotopic_loops_continuous_image:
    "\<lbrakk>homotopic_loops s f g; continuous_on s h; h ` s \<subseteq> t\<rbrakk> \<Longrightarrow> homotopic_loops t (h \<circ> f) (h \<circ> g)"
   unfolding homotopic_loops_def
   by (simp add: homotopic_with_compose_continuous_map_left pathfinish_def pathstart_def)
 
 
 subsection\<open>Relations between the two variants of homotopy\<close>
 
 proposition homotopic_paths_imp_homotopic_loops:
     "\<lbrakk>homotopic_paths s p q; pathfinish p = pathstart p; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> homotopic_loops s p q"
   by (auto simp: homotopic_with_def homotopic_paths_def homotopic_loops_def)
 
 proposition homotopic_loops_imp_homotopic_paths_null:
   assumes "homotopic_loops s p (linepath a a)"
     shows "homotopic_paths s p (linepath (pathstart p) (pathstart p))"
 proof -
   have "path p" by (metis assms homotopic_loops_imp_path)
   have ploop: "pathfinish p = pathstart p" by (metis assms homotopic_loops_imp_loop)
   have pip: "path_image p \<subseteq> s" by (metis assms homotopic_loops_imp_subset)
   obtain h where conth: "continuous_on ({0..1::real} \<times> {0..1}) h"
              and hs: "h ` ({0..1} \<times> {0..1}) \<subseteq> s"
              and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(0,x) = p x"
              and [simp]: "\<And>x. x \<in> {0..1} \<Longrightarrow> h(1,x) = a"
              and ends: "\<And>t. t \<in> {0..1} \<Longrightarrow> pathfinish (h \<circ> Pair t) = pathstart (h \<circ> Pair t)"
     using assms by (auto simp: homotopic_loops homotopic_with)
   have conth0: "path (\<lambda>u. h (u, 0))"
     unfolding path_def
     apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
     apply (force intro: continuous_intros continuous_on_subset [OF conth])+
     done
   have pih0: "path_image (\<lambda>u. h (u, 0)) \<subseteq> s"
     using hs by (force simp: path_image_def)
   have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x * snd x, 0))"
     apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
     apply (force simp: mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
     done
   have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. h (fst x - fst x * snd x, 0))"
     apply (rule continuous_on_compose [of _ _ h, unfolded o_def])
     apply (force simp: mult_left_le mult_le_one intro: continuous_intros continuous_on_subset [OF conth])+
     apply (rule continuous_on_subset [OF conth])
     apply (auto simp: algebra_simps add_increasing2 mult_left_le)
     done
   have [simp]: "\<And>t. \<lbrakk>0 \<le> t \<and> t \<le> 1\<rbrakk> \<Longrightarrow> h (t, 1) = h (t, 0)"
     using ends by (simp add: pathfinish_def pathstart_def)
   have adhoc_le: "c * 4 \<le> 1 + c * (d * 4)" if "\<not> d * 4 \<le> 3" "0 \<le> c" "c \<le> 1" for c d::real
   proof -
     have "c * 3 \<le> c * (d * 4)" using that less_eq_real_def by auto
     with \<open>c \<le> 1\<close> show ?thesis by fastforce
   qed
   have *: "\<And>p x. (path p \<and> path(reversepath p)) \<and>
                   (path_image p \<subseteq> s \<and> path_image(reversepath p) \<subseteq> s) \<and>
                   (pathfinish p = pathstart(linepath a a +++ reversepath p) \<and>
                    pathstart(reversepath p) = a) \<and> pathstart p = x
                   \<Longrightarrow> homotopic_paths s (p +++ linepath a a +++ reversepath p) (linepath x x)"
     by (metis homotopic_paths_lid homotopic_paths_join
               homotopic_paths_trans homotopic_paths_sym homotopic_paths_rinv)
   have 1: "homotopic_paths s p (p +++ linepath (pathfinish p) (pathfinish p))"
     using \<open>path p\<close> homotopic_paths_rid homotopic_paths_sym pip by blast
   moreover have "homotopic_paths s (p +++ linepath (pathfinish p) (pathfinish p))
                                    (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))"
     apply (rule homotopic_paths_sym)
     using homotopic_paths_lid [of "p +++ linepath (pathfinish p) (pathfinish p)" s]
     by (metis 1 homotopic_paths_imp_path homotopic_paths_imp_pathstart homotopic_paths_imp_subset)
   moreover have "homotopic_paths s (linepath (pathstart p) (pathstart p) +++ p +++ linepath (pathfinish p) (pathfinish p))
                                    ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))"
     apply (simp add: homotopic_paths_def homotopic_with_def)
     apply (rule_tac x="\<lambda>y. (subpath 0 (fst y) (\<lambda>u. h (u, 0)) +++ (\<lambda>u. h (Pair (fst y) u)) +++ subpath (fst y) 0 (\<lambda>u. h (u, 0))) (snd y)" in exI)
     apply (simp add: subpath_reversepath)
     apply (intro conjI homotopic_join_lemma)
     using ploop
     apply (simp_all add: path_defs joinpaths_def o_def subpath_def conth c1 c2)
     apply (force simp: algebra_simps mult_le_one mult_left_le intro: hs [THEN subsetD] adhoc_le)
     done
   moreover have "homotopic_paths s ((\<lambda>u. h (u, 0)) +++ linepath a a +++ reversepath (\<lambda>u. h (u, 0)))
                                    (linepath (pathstart p) (pathstart p))"
     apply (rule *)
     apply (simp add: pih0 pathstart_def pathfinish_def conth0)
     apply (simp add: reversepath_def joinpaths_def)
     done
   ultimately show ?thesis
     by (blast intro: homotopic_paths_trans)
 qed
 
 proposition homotopic_loops_conjugate:
   fixes s :: "'a::real_normed_vector set"
   assumes "path p" "path q" and pip: "path_image p \<subseteq> s" and piq: "path_image q \<subseteq> s"
       and papp: "pathfinish p = pathstart q" and qloop: "pathfinish q = pathstart q"
     shows "homotopic_loops s (p +++ q +++ reversepath p) q"
 proof -
   have contp: "continuous_on {0..1} p"  using \<open>path p\<close> [unfolded path_def] by blast
   have contq: "continuous_on {0..1} q"  using \<open>path q\<close> [unfolded path_def] by blast
   have c1: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((1 - fst x) * snd x + fst x))"
     apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
     apply (force simp: mult_le_one intro!: continuous_intros)
     apply (rule continuous_on_subset [OF contp])
     apply (auto simp: algebra_simps add_increasing2 mult_right_le_one_le sum_le_prod1)
     done
   have c2: "continuous_on ({0..1} \<times> {0..1}) (\<lambda>x. p ((fst x - 1) * snd x + 1))"
     apply (rule continuous_on_compose [of _ _ p, unfolded o_def])
     apply (force simp: mult_le_one intro!: continuous_intros)
     apply (rule continuous_on_subset [OF contp])
     apply (auto simp: algebra_simps add_increasing2 mult_left_le_one_le)
     done
   have ps1: "\<And>a b. \<lbrakk>b * 2 \<le> 1; 0 \<le> b; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((1 - a) * (2 * b) + a) \<in> s"
     using sum_le_prod1
     by (force simp: algebra_simps add_increasing2 mult_left_le intro: pip [unfolded path_image_def, THEN subsetD])
   have ps2: "\<And>a b. \<lbrakk>\<not> 4 * b \<le> 3; b \<le> 1; 0 \<le> a; a \<le> 1\<rbrakk> \<Longrightarrow> p ((a - 1) * (4 * b - 3) + 1) \<in> s"
     apply (rule pip [unfolded path_image_def, THEN subsetD])
     apply (rule image_eqI, blast)
     apply (simp add: algebra_simps)
     by (metis add_mono_thms_linordered_semiring(1) affine_ineq linear mult.commute mult.left_neutral mult_right_mono not_le
               add.commute zero_le_numeral)
   have qs: "\<And>a b. \<lbrakk>4 * b \<le> 3; \<not> b * 2 \<le> 1\<rbrakk> \<Longrightarrow> q (4 * b - 2) \<in> s"
     using path_image_def piq by fastforce
   have "homotopic_loops s (p +++ q +++ reversepath p)
                           (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q))"
     apply (simp add: homotopic_loops_def homotopic_with_def)
     apply (rule_tac x="(\<lambda>y. (subpath (fst y) 1 p +++ q +++ subpath 1 (fst y) p) (snd y))" in exI)
     apply (simp add: subpath_refl subpath_reversepath)
     apply (intro conjI homotopic_join_lemma)
     using papp qloop
     apply (simp_all add: path_defs joinpaths_def o_def subpath_def c1 c2)
     apply (force simp: contq intro: continuous_on_compose [of _ _ q, unfolded o_def] continuous_on_id continuous_on_snd)
     apply (auto simp: ps1 ps2 qs)
     done
   moreover have "homotopic_loops s (linepath (pathstart q) (pathstart q) +++ q +++ linepath (pathstart q) (pathstart q)) q"
   proof -
     have "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q) q"
       using \<open>path q\<close> homotopic_paths_lid qloop piq by auto
     hence 1: "\<And>f. homotopic_paths s f q \<or> \<not> homotopic_paths s f (linepath (pathfinish q) (pathfinish q) +++ q)"
       using homotopic_paths_trans by blast
     hence "homotopic_paths s (linepath (pathfinish q) (pathfinish q) +++ q +++ linepath (pathfinish q) (pathfinish q)) q"
     proof -
       have "homotopic_paths s (q +++ linepath (pathfinish q) (pathfinish q)) q"
         by (simp add: \<open>path q\<close> homotopic_paths_rid piq)
       thus ?thesis
         by (metis (no_types) 1 \<open>path q\<close> homotopic_paths_join homotopic_paths_rinv homotopic_paths_sym
                   homotopic_paths_trans qloop pathfinish_linepath piq)
     qed
     thus ?thesis
       by (metis (no_types) qloop homotopic_loops_sym homotopic_paths_imp_homotopic_loops homotopic_paths_imp_pathfinish homotopic_paths_sym)
   qed
   ultimately show ?thesis
     by (blast intro: homotopic_loops_trans)
 qed
 
 lemma homotopic_paths_loop_parts:
   assumes loops: "homotopic_loops S (p +++ reversepath q) (linepath a a)" and "path q"
   shows "homotopic_paths S p q"
 proof -
   have paths: "homotopic_paths S (p +++ reversepath q) (linepath (pathstart p) (pathstart p))"
     using homotopic_loops_imp_homotopic_paths_null [OF loops] by simp
   then have "path p"
     using \<open>path q\<close> homotopic_loops_imp_path loops path_join path_join_path_ends path_reversepath by blast
   show ?thesis
   proof (cases "pathfinish p = pathfinish q")
     case True
     have pipq: "path_image p \<subseteq> S" "path_image q \<subseteq> S"
       by (metis Un_subset_iff paths \<open>path p\<close> \<open>path q\<close> homotopic_loops_imp_subset homotopic_paths_imp_path loops
            path_image_join path_image_reversepath path_imp_reversepath path_join_eq)+
     have "homotopic_paths S p (p +++ (linepath (pathfinish p) (pathfinish p)))"
       using \<open>path p\<close> \<open>path_image p \<subseteq> S\<close> homotopic_paths_rid homotopic_paths_sym by blast
     moreover have "homotopic_paths S (p +++ (linepath (pathfinish p) (pathfinish p))) (p +++ (reversepath q +++ q))"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> pipq homotopic_paths_join homotopic_paths_linv homotopic_paths_sym)
     moreover have "homotopic_paths S (p +++ (reversepath q +++ q)) ((p +++ reversepath q) +++ q)"
       by (simp add: True \<open>path p\<close> \<open>path q\<close> homotopic_paths_assoc pipq)
     moreover have "homotopic_paths S ((p +++ reversepath q) +++ q) (linepath (pathstart p) (pathstart p) +++ q)"
       by (simp add: \<open>path q\<close> homotopic_paths_join paths pipq)
     moreover then have "homotopic_paths S (linepath (pathstart p) (pathstart p) +++ q) q"
       by (metis \<open>path q\<close> homotopic_paths_imp_path homotopic_paths_lid linepath_trivial path_join_path_ends pathfinish_def pipq(2))
     ultimately show ?thesis
       using homotopic_paths_trans by metis
   next
     case False
     then show ?thesis
       using \<open>path q\<close> homotopic_loops_imp_path loops path_join_path_ends by fastforce
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Homotopy of "nearby" function, paths and loops\<close>
 
 lemma homotopic_with_linear:
   fixes f g :: "_ \<Rightarrow> 'b::real_normed_vector"
   assumes contf: "continuous_on s f"
       and contg:"continuous_on s g"
       and sub: "\<And>x. x \<in> s \<Longrightarrow> closed_segment (f x) (g x) \<subseteq> t"
     shows "homotopic_with_canon (\<lambda>z. True) s t f g"
   apply (simp add: homotopic_with_def)
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R f(snd y) + (fst y) *\<^sub>R g(snd y))" in exI)
   apply (intro conjI)
   apply (rule subset_refl continuous_intros continuous_on_subset [OF contf] continuous_on_compose2 [where g=f]
                                             continuous_on_subset [OF contg] continuous_on_compose2 [where g=g]| simp)+
   using sub closed_segment_def apply fastforce+
   done
 
 lemma homotopic_paths_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
           "\<And>t. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
     shows "homotopic_paths s g h"
   using assms
   unfolding path_def
   apply (simp add: closed_segment_def pathstart_def pathfinish_def homotopic_paths_def homotopic_with_def)
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R (g \<circ> snd) y + (fst y) *\<^sub>R (h \<circ> snd) y)" in exI)
   apply (intro conjI subsetI continuous_intros; force)
   done
 
 lemma homotopic_loops_linear:
   fixes g h :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
           "\<And>t x. t \<in> {0..1} \<Longrightarrow> closed_segment (g t) (h t) \<subseteq> s"
     shows "homotopic_loops s g h"
   using assms
   unfolding path_def
   apply (simp add: pathstart_def pathfinish_def homotopic_loops_def homotopic_with_def)
   apply (rule_tac x="\<lambda>y. ((1 - (fst y)) *\<^sub>R g(snd y) + (fst y) *\<^sub>R h(snd y))" in exI)
   apply (auto intro!: continuous_intros intro: continuous_on_compose2 [where g=g] continuous_on_compose2 [where g=h])
   apply (force simp: closed_segment_def)
   done
 
 lemma homotopic_paths_nearby_explicit:
   assumes "path g" "path h" "pathstart h = pathstart g" "pathfinish h = pathfinish g"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_paths s g h"
   apply (rule homotopic_paths_linear [OF assms(1-4)])
   by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
 
 lemma homotopic_loops_nearby_explicit:
   assumes "path g" "path h" "pathfinish g = pathstart g" "pathfinish h = pathstart h"
       and no: "\<And>t x. \<lbrakk>t \<in> {0..1}; x \<notin> s\<rbrakk> \<Longrightarrow> norm(h t - g t) < norm(g t - x)"
     shows "homotopic_loops s g h"
   apply (rule homotopic_loops_linear [OF assms(1-4)])
   by (metis no segment_bound(1) subsetI norm_minus_commute not_le)
 
 lemma homotopic_nearby_paths:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open s" "path_image g \<subseteq> s"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and>
                     pathstart h = pathstart g \<and> pathfinish h = pathfinish g \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_paths s g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-s"] assms by force
   show ?thesis
     apply (intro exI conjI)
     using e [unfolded dist_norm]
     apply (auto simp: intro!: homotopic_paths_nearby_explicit assms  \<open>e > 0\<close>)
     by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
 qed
 
 lemma homotopic_nearby_loops:
   fixes g h :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "path g" "open s" "path_image g \<subseteq> s" "pathfinish g = pathstart g"
     shows "\<exists>e. 0 < e \<and>
                (\<forall>h. path h \<and> pathfinish h = pathstart h \<and>
                     (\<forall>t \<in> {0..1}. norm(h t - g t) < e) \<longrightarrow> homotopic_loops s g h)"
 proof -
   obtain e where "e > 0" and e: "\<And>x y. x \<in> path_image g \<Longrightarrow> y \<in> - s \<Longrightarrow> e \<le> dist x y"
     using separate_compact_closed [of "path_image g" "-s"] assms by force
   show ?thesis
     apply (intro exI conjI)
     using e [unfolded dist_norm]
     apply (auto simp: intro!: homotopic_loops_nearby_explicit assms  \<open>e > 0\<close>)
     by (metis atLeastAtMost_iff imageI le_less_trans not_le path_image_def)
 qed
 
 
 subsection\<open> Homotopy and subpaths\<close>
 
 lemma homotopic_join_subpaths1:
   assumes "path g" and pag: "path_image g \<subseteq> s"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}" "u \<le> v" "v \<le> w"
     shows "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
 proof -
   have 1: "t * 2 \<le> 1 \<Longrightarrow> u + t * (v * 2) \<le> v + t * (u * 2)" for t
     using affine_ineq \<open>u \<le> v\<close> by fastforce
   have 2: "t * 2 > 1 \<Longrightarrow> u + (2*t - 1) * v \<le> v + (2*t - 1) * w" for t
     by (metis add_mono_thms_linordered_semiring(1) diff_gt_0_iff_gt less_eq_real_def mult.commute mult_right_mono \<open>u \<le> v\<close> \<open>v \<le> w\<close>)
   have t2: "\<And>t::real. t*2 = 1 \<Longrightarrow> t = 1/2" by auto
   show ?thesis
     apply (rule homotopic_paths_subset [OF _ pag])
     using assms
     apply (cases "w = u")
     using homotopic_paths_rinv [of "subpath u v g" "path_image g"]
     apply (force simp: closed_segment_eq_real_ivl image_mono path_image_def subpath_refl)
       apply (rule homotopic_paths_sym)
       apply (rule homotopic_paths_reparametrize
              [where f = "\<lambda>t. if  t \<le> 1 / 2
                              then inverse((w - u)) *\<^sub>R (2 * (v - u)) *\<^sub>R t
                              else inverse((w - u)) *\<^sub>R ((v - u) + (w - v) *\<^sub>R (2 *\<^sub>R t - 1))"])
       using \<open>path g\<close> path_subpath u w apply blast
       using \<open>path g\<close> path_image_subpath_subset u w(1) apply blast
       apply simp_all
       apply (subst split_01)
       apply (rule continuous_on_cases continuous_intros | force simp: pathfinish_def joinpaths_def)+
       apply (simp_all add: field_simps not_le)
       apply (force dest!: t2)
       apply (force simp: algebra_simps mult_left_mono affine_ineq dest!: 1 2)
       apply (simp add: joinpaths_def subpath_def)
       apply (force simp: algebra_simps)
       done
 qed
 
 lemma homotopic_join_subpaths2:
   assumes "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
     shows "homotopic_paths s (subpath w v g +++ subpath v u g) (subpath w u g)"
 by (metis assms homotopic_paths_reversepath_D pathfinish_subpath pathstart_subpath reversepath_joinpaths reversepath_subpath)
 
 lemma homotopic_join_subpaths3:
   assumes hom: "homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
       and "path g" and pag: "path_image g \<subseteq> s"
       and u: "u \<in> {0..1}" and v: "v \<in> {0..1}" and w: "w \<in> {0..1}"
     shows "homotopic_paths s (subpath v w g +++ subpath w u g) (subpath v u g)"
 proof -
   have "homotopic_paths s (subpath u w g +++ subpath w v g) ((subpath u v g +++ subpath v w g) +++ subpath w v g)"
     apply (rule homotopic_paths_join)
     using hom homotopic_paths_sym_eq apply blast
     apply (metis \<open>path g\<close> homotopic_paths_eq pag path_image_subpath_subset path_subpath subset_trans v w, simp)
     done
   also have "homotopic_paths s ((subpath u v g +++ subpath v w g) +++ subpath w v g) (subpath u v g +++ subpath v w g +++ subpath w v g)"
     apply (rule homotopic_paths_sym [OF homotopic_paths_assoc])
     using assms by (simp_all add: path_image_subpath_subset [THEN order_trans])
   also have "homotopic_paths s (subpath u v g +++ subpath v w g +++ subpath w v g)
                                (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))"
     apply (rule homotopic_paths_join)
     apply (metis \<open>path g\<close> homotopic_paths_eq order.trans pag path_image_subpath_subset path_subpath u v)
     apply (metis (no_types, lifting) \<open>path g\<close> homotopic_paths_linv order_trans pag path_image_subpath_subset path_subpath pathfinish_subpath reversepath_subpath v w)
     apply simp
     done
   also have "homotopic_paths s (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)"
     apply (rule homotopic_paths_rid)
     using \<open>path g\<close> path_subpath u v apply blast
     apply (meson \<open>path g\<close> order.trans pag path_image_subpath_subset u v)
     done
   finally have "homotopic_paths s (subpath u w g +++ subpath w v g) (subpath u v g)" .
   then show ?thesis
     using homotopic_join_subpaths2 by blast
 qed
 
 proposition homotopic_join_subpaths:
    "\<lbrakk>path g; path_image g \<subseteq> s; u \<in> {0..1}; v \<in> {0..1}; w \<in> {0..1}\<rbrakk>
     \<Longrightarrow> homotopic_paths s (subpath u v g +++ subpath v w g) (subpath u w g)"
   apply (rule le_cases3 [of u v w])
 using homotopic_join_subpaths1 homotopic_join_subpaths2 homotopic_join_subpaths3 by metis+
 
 text\<open>Relating homotopy of trivial loops to path-connectedness.\<close>
 
 lemma path_component_imp_homotopic_points:
     "path_component S a b \<Longrightarrow> homotopic_loops S (linepath a a) (linepath b b)"
 apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
                  pathstart_def pathfinish_def path_image_def path_def, clarify)
 apply (rule_tac x="g \<circ> fst" in exI)
 apply (intro conjI continuous_intros continuous_on_compose)+
 apply (auto elim!: continuous_on_subset)
 done
 
 lemma homotopic_loops_imp_path_component_value:
    "\<lbrakk>homotopic_loops S p q; 0 \<le> t; t \<le> 1\<rbrakk>
         \<Longrightarrow> path_component S (p t) (q t)"
 apply (simp add: path_component_def homotopic_loops_def homotopic_with_def
                  pathstart_def pathfinish_def path_image_def path_def, clarify)
 apply (rule_tac x="h \<circ> (\<lambda>u. (u, t))" in exI)
 apply (intro conjI continuous_intros continuous_on_compose)+
 apply (auto elim!: continuous_on_subset)
 done
 
 lemma homotopic_points_eq_path_component:
    "homotopic_loops S (linepath a a) (linepath b b) \<longleftrightarrow>
         path_component S a b"
 by (auto simp: path_component_imp_homotopic_points
          dest: homotopic_loops_imp_path_component_value [where t=1])
 
 lemma path_connected_eq_homotopic_points:
     "path_connected S \<longleftrightarrow>
       (\<forall>a b. a \<in> S \<and> b \<in> S \<longrightarrow> homotopic_loops S (linepath a a) (linepath b b))"
 by (auto simp: path_connected_def path_component_def homotopic_points_eq_path_component)
 
 
 subsection\<open>Simply connected sets\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>defined as "all loops are homotopic (as loops)\<close>
 
 definition\<^marker>\<open>tag important\<close> simply_connected where
   "simply_connected S \<equiv>
         \<forall>p q. path p \<and> pathfinish p = pathstart p \<and> path_image p \<subseteq> S \<and>
               path q \<and> pathfinish q = pathstart q \<and> path_image q \<subseteq> S
               \<longrightarrow> homotopic_loops S p q"
 
 lemma simply_connected_empty [iff]: "simply_connected {}"
   by (simp add: simply_connected_def)
 
 lemma simply_connected_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> path_connected S"
 by (simp add: simply_connected_def path_connected_eq_homotopic_points)
 
 lemma simply_connected_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<Longrightarrow> connected S"
 by (simp add: path_connected_imp_connected simply_connected_imp_path_connected)
 
 lemma simply_connected_eq_contractible_loop_any:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
             (\<forall>p a. path p \<and> path_image p \<subseteq> S \<and>
                   pathfinish p = pathstart p \<and> a \<in> S
                   \<longrightarrow> homotopic_loops S p (linepath a a))"
 apply (simp add: simply_connected_def)
 apply (rule iffI, force, clarify)
 apply (rule_tac q = "linepath (pathstart p) (pathstart p)" in homotopic_loops_trans)
 apply (fastforce simp add:)
 using homotopic_loops_sym apply blast
 done
 
 lemma simply_connected_eq_contractible_loop_some:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
                 path_connected S \<and>
                 (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                     \<longrightarrow> (\<exists>a. a \<in> S \<and> homotopic_loops S p (linepath a a)))"
 apply (rule iffI)
  apply (fastforce simp: simply_connected_imp_path_connected simply_connected_eq_contractible_loop_any)
 apply (clarsimp simp add: simply_connected_eq_contractible_loop_any)
 apply (drule_tac x=p in spec)
 using homotopic_loops_trans path_connected_eq_homotopic_points
   apply blast
 done
 
 lemma simply_connected_eq_contractible_loop_all:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
          S = {} \<or>
          (\<exists>a \<in> S. \<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
                 \<longrightarrow> homotopic_loops S p (linepath a a))"
         (is "?lhs = ?rhs")
 proof (cases "S = {}")
   case True then show ?thesis by force
 next
   case False
   then obtain a where "a \<in> S" by blast
   show ?thesis
   proof
     assume "simply_connected S"
     then show ?rhs
       using \<open>a \<in> S\<close> \<open>simply_connected S\<close> simply_connected_eq_contractible_loop_any
       by blast
   next
     assume ?rhs
     then show "simply_connected S"
       apply (simp add: simply_connected_eq_contractible_loop_any False)
       by (meson homotopic_loops_refl homotopic_loops_sym homotopic_loops_trans
              path_component_imp_homotopic_points path_component_refl)
   qed
 qed
 
 lemma simply_connected_eq_contractible_path:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
            path_connected S \<and>
            (\<forall>p. path p \<and> path_image p \<subseteq> S \<and> pathfinish p = pathstart p
             \<longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p)))"
 apply (rule iffI)
  apply (simp add: simply_connected_imp_path_connected)
  apply (metis simply_connected_eq_contractible_loop_some homotopic_loops_imp_homotopic_paths_null)
 by (meson homotopic_paths_imp_homotopic_loops pathfinish_linepath pathstart_in_path_image
          simply_connected_eq_contractible_loop_some subset_iff)
 
 lemma simply_connected_eq_homotopic_paths:
   fixes S :: "_::real_normed_vector set"
   shows "simply_connected S \<longleftrightarrow>
           path_connected S \<and>
           (\<forall>p q. path p \<and> path_image p \<subseteq> S \<and>
                 path q \<and> path_image q \<subseteq> S \<and>
                 pathstart q = pathstart p \<and> pathfinish q = pathfinish p
                 \<longrightarrow> homotopic_paths S p q)"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have pc: "path_connected S"
         and *:  "\<And>p. \<lbrakk>path p; path_image p \<subseteq> S;
                        pathfinish p = pathstart p\<rbrakk>
                       \<Longrightarrow> homotopic_paths S p (linepath (pathstart p) (pathstart p))"
     by (auto simp: simply_connected_eq_contractible_path)
   have "homotopic_paths S p q"
         if "path p" "path_image p \<subseteq> S" "path q"
            "path_image q \<subseteq> S" "pathstart q = pathstart p"
            "pathfinish q = pathfinish p" for p q
   proof -
     have "homotopic_paths S p (p +++ linepath (pathfinish p) (pathfinish p))"
       by (simp add: homotopic_paths_rid homotopic_paths_sym that)
     also have "homotopic_paths S (p +++ linepath (pathfinish p) (pathfinish p))
                                  (p +++ reversepath q +++ q)"
       using that
       by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl homotopic_paths_sym_eq pathstart_linepath)
     also have "homotopic_paths S (p +++ reversepath q +++ q)
                                  ((p +++ reversepath q) +++ q)"
       by (simp add: that homotopic_paths_assoc)
     also have "homotopic_paths S ((p +++ reversepath q) +++ q)
                                  (linepath (pathstart q) (pathstart q) +++ q)"
       using * [of "p +++ reversepath q"] that
       by (simp add: homotopic_paths_join path_image_join)
     also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q"
       using that homotopic_paths_lid by blast
     finally show ?thesis .
   qed
   then show ?rhs
     by (blast intro: pc *)
 next
   assume ?rhs
   then show ?lhs
     by (force simp: simply_connected_eq_contractible_path)
 qed
 
 proposition simply_connected_Times:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   assumes S: "simply_connected S" and T: "simply_connected T"
     shows "simply_connected(S \<times> T)"
 proof -
   have "homotopic_loops (S \<times> T) p (linepath (a, b) (a, b))"
        if "path p" "path_image p \<subseteq> S \<times> T" "p 1 = p 0" "a \<in> S" "b \<in> T"
        for p a b
   proof -
     have "path (fst \<circ> p)"
       apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
       apply (rule continuous_intros)+
       done
     moreover have "path_image (fst \<circ> p) \<subseteq> S"
       using that apply (simp add: path_image_def) by force
     ultimately have p1: "homotopic_loops S (fst \<circ> p) (linepath a a)"
       using S that
       apply (simp add: simply_connected_eq_contractible_loop_any)
       apply (drule_tac x="fst \<circ> p" in spec)
       apply (drule_tac x=a in spec)
       apply (auto simp: pathstart_def pathfinish_def)
       done
     have "path (snd \<circ> p)"
       apply (rule Path_Connected.path_continuous_image [OF \<open>path p\<close>])
       apply (rule continuous_intros)+
       done
     moreover have "path_image (snd \<circ> p) \<subseteq> T"
       using that apply (simp add: path_image_def) by force
     ultimately have p2: "homotopic_loops T (snd \<circ> p) (linepath b b)"
       using T that
       apply (simp add: simply_connected_eq_contractible_loop_any)
       apply (drule_tac x="snd \<circ> p" in spec)
       apply (drule_tac x=b in spec)
       apply (auto simp: pathstart_def pathfinish_def)
       done
     show ?thesis
       using p1 p2
       apply (simp add: homotopic_loops, clarify)
       apply (rename_tac h k)
       apply (rule_tac x="\<lambda>z. Pair (h z) (k z)" in exI)
       apply (intro conjI continuous_intros | assumption)+
       apply (auto simp: pathstart_def pathfinish_def)
       done
   qed
   with assms show ?thesis
     by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def)
 qed
 
 
 subsection\<open>Contractible sets\<close>
 
 definition\<^marker>\<open>tag important\<close> contractible where
  "contractible S \<equiv> \<exists>a. homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
 
 proposition contractible_imp_simply_connected:
   fixes S :: "_::real_normed_vector set"
   assumes "contractible S" shows "simply_connected S"
 proof (cases "S = {}")
   case True then show ?thesis by force
 next
   case False
   obtain a where a: "homotopic_with_canon (\<lambda>x. True) S S id (\<lambda>x. a)"
     using assms by (force simp: contractible_def)
   then have "a \<in> S"
     by (metis False homotopic_constant_maps homotopic_with_symD homotopic_with_trans path_component_in_topspace topspace_euclidean_subtopology)
   show ?thesis
     apply (simp add: simply_connected_eq_contractible_loop_all False)
     apply (rule bexI [OF _ \<open>a \<in> S\<close>])
     using a apply (simp add: homotopic_loops_def homotopic_with_def path_def path_image_def pathfinish_def pathstart_def, clarify)
     apply (rule_tac x="(h \<circ> (\<lambda>y. (fst y, (p \<circ> snd) y)))" in exI)
     apply (intro conjI continuous_on_compose continuous_intros)
     apply (erule continuous_on_subset | force)+
     done
 qed
 
 corollary contractible_imp_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> connected S"
 by (simp add: contractible_imp_simply_connected simply_connected_imp_connected)
 
 lemma contractible_imp_path_connected:
   fixes S :: "_::real_normed_vector set"
   shows "contractible S \<Longrightarrow> path_connected S"
 by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected)
 
 lemma nullhomotopic_through_contractible:
   fixes S :: "_::topological_space set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and g: "continuous_on T g" "g ` T \<subseteq> U"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S U (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with_canon (\<lambda>x. True) T T id (\<lambda>x. b)"
     using assms by (force simp: contractible_def)
   have "homotopic_with_canon (\<lambda>f. True) T U (g \<circ> id) (g \<circ> (\<lambda>x. b))"
     by (metis Abstract_Topology.continuous_map_subtopology_eu b g homotopic_compose_continuous_map_left)
   then have "homotopic_with_canon (\<lambda>f. True) S U (g \<circ> id \<circ> f) (g \<circ> (\<lambda>x. b) \<circ> f)"
     by (simp add: f homotopic_with_compose_continuous_map_right)
   then show ?thesis
     by (simp add: comp_def that)
 qed
 
 lemma nullhomotopic_into_contractible:
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and T: "contractible T"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
 apply (rule nullhomotopic_through_contractible [OF f, of id T])
 using assms
-apply (auto simp: continuous_on_id)
+apply (auto)
 done
 
 lemma nullhomotopic_from_contractible:
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and S: "contractible S"
     obtains c where "homotopic_with_canon (\<lambda>h. True) S T f (\<lambda>x. c)"
 apply (rule nullhomotopic_through_contractible [OF continuous_on_id _ f S, of S])
 using assms
 apply (auto simp: comp_def)
 done
 
 lemma homotopic_through_contractible:
   fixes S :: "_::real_normed_vector set"
   assumes "continuous_on S f1" "f1 ` S \<subseteq> T"
           "continuous_on T g1" "g1 ` T \<subseteq> U"
           "continuous_on S f2" "f2 ` S \<subseteq> T"
           "continuous_on T g2" "g2 ` T \<subseteq> U"
           "contractible T" "path_connected U"
    shows "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (g2 \<circ> f2)"
 proof -
   obtain c1 where c1: "homotopic_with_canon (\<lambda>h. True) S U (g1 \<circ> f1) (\<lambda>x. c1)"
     apply (rule nullhomotopic_through_contractible [of S f1 T g1 U])
     using assms apply auto
     done
   obtain c2 where c2: "homotopic_with_canon (\<lambda>h. True) S U (g2 \<circ> f2) (\<lambda>x. c2)"
     apply (rule nullhomotopic_through_contractible [of S f2 T g2 U])
     using assms apply auto
     done
   have *: "S = {} \<or> (\<exists>t. path_connected t \<and> t \<subseteq> U \<and> c2 \<in> t \<and> c1 \<in> t)"
   proof (cases "S = {}")
     case True then show ?thesis by force
   next
     case False
     with c1 c2 have "c1 \<in> U" "c2 \<in> U"
       using homotopic_with_imp_continuous_maps by fastforce+
     with \<open>path_connected U\<close> show ?thesis by blast
   qed
   show ?thesis
     apply (rule homotopic_with_trans [OF c1])
     apply (rule homotopic_with_symD)
     apply (rule homotopic_with_trans [OF c2])
     apply (simp add: path_component homotopic_constant_maps *)
     done
 qed
 
 lemma homotopic_into_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and g: "continuous_on S g" "g ` S \<subseteq> T"
       and T: "contractible T"
     shows "homotopic_with_canon (\<lambda>h. True) S T f g"
 using homotopic_through_contractible [of S f T id T g id]
 by (simp add: assms contractible_imp_path_connected)
 
 lemma homotopic_from_contractible:
   fixes S :: "'a::real_normed_vector set" and T:: "'b::real_normed_vector set"
   assumes f: "continuous_on S f" "f ` S \<subseteq> T"
       and g: "continuous_on S g" "g ` S \<subseteq> T"
       and "contractible S" "path_connected T"
     shows "homotopic_with_canon (\<lambda>h. True) S T f g"
 using homotopic_through_contractible [of S id S f T id g]
 by (simp add: assms contractible_imp_path_connected)
 
 lemma starlike_imp_contractible_gen:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "starlike S"
       and P: "\<And>a T. \<lbrakk>a \<in> S; 0 \<le> T; T \<le> 1\<rbrakk> \<Longrightarrow> P(\<lambda>x. (1 - T) *\<^sub>R x + T *\<^sub>R a)"
     obtains a where "homotopic_with_canon P S S (\<lambda>x. x) (\<lambda>x. a)"
 proof -
   obtain a where "a \<in> S" and a: "\<And>x. x \<in> S \<Longrightarrow> closed_segment a x \<subseteq> S"
     using S by (auto simp: starlike_def)
   have "(\<lambda>y. (1 - fst y) *\<^sub>R snd y + fst y *\<^sub>R a) ` ({0..1} \<times> S) \<subseteq> S"
     apply clarify
     apply (erule a [unfolded closed_segment_def, THEN subsetD], simp)
     apply (metis add_diff_cancel_right' diff_ge_0_iff_ge le_add_diff_inverse pth_c(1))
     done
   then show ?thesis
     apply (rule_tac a=a in that)
     using \<open>a \<in> S\<close>
     apply (simp add: homotopic_with_def)
     apply (rule_tac x="\<lambda>y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI)
     apply (intro conjI ballI continuous_on_compose continuous_intros)
     apply (simp_all add: P)
     done
 qed
 
 lemma starlike_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> contractible S"
 using starlike_imp_contractible_gen contractible_def by (fastforce simp: id_def)
 
 lemma contractible_UNIV [simp]: "contractible (UNIV :: 'a::real_normed_vector set)"
   by (simp add: starlike_imp_contractible)
 
 lemma starlike_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> simply_connected S"
 by (simp add: contractible_imp_simply_connected starlike_imp_contractible)
 
 lemma convex_imp_simply_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> simply_connected S"
 using convex_imp_starlike starlike_imp_simply_connected by blast
 
 lemma starlike_imp_path_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> path_connected S"
 by (simp add: simply_connected_imp_path_connected starlike_imp_simply_connected)
 
 lemma starlike_imp_connected:
   fixes S :: "'a::real_normed_vector set"
   shows "starlike S \<Longrightarrow> connected S"
 by (simp add: path_connected_imp_connected starlike_imp_path_connected)
 
 lemma is_interval_simply_connected_1:
   fixes S :: "real set"
   shows "is_interval S \<longleftrightarrow> simply_connected S"
 using convex_imp_simply_connected is_interval_convex_1 is_interval_path_connected_1 simply_connected_imp_path_connected by auto
 
 lemma contractible_empty [simp]: "contractible {}"
   by (simp add: contractible_def homotopic_on_emptyI)
 
 lemma contractible_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and TS: "rel_interior S \<subseteq> T" "T \<subseteq> closure S"
   shows "contractible T"
 proof (cases "S = {}")
   case True
   with assms show ?thesis
     by (simp add: subsetCE)
 next
   case False
   show ?thesis
     apply (rule starlike_imp_contractible)
     apply (rule starlike_convex_tweak_boundary_points [OF \<open>convex S\<close> False TS])
     done
 qed
 
 lemma convex_imp_contractible:
   fixes S :: "'a::real_normed_vector set"
   shows "convex S \<Longrightarrow> contractible S"
   using contractible_empty convex_imp_starlike starlike_imp_contractible by blast
 
 lemma contractible_sing [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "contractible {a}"
 by (rule convex_imp_contractible [OF convex_singleton])
 
 lemma is_interval_contractible_1:
   fixes S :: "real set"
   shows  "is_interval S \<longleftrightarrow> contractible S"
 using contractible_imp_simply_connected convex_imp_contractible is_interval_convex_1
       is_interval_simply_connected_1 by auto
 
 lemma contractible_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes S: "contractible S" and T: "contractible T"
   shows "contractible (S \<times> T)"
 proof -
   obtain a h where conth: "continuous_on ({0..1} \<times> S) h"
              and hsub: "h ` ({0..1} \<times> S) \<subseteq> S"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow> h (0, x) = x"
              and [simp]: "\<And>x. x \<in> S \<Longrightarrow>  h (1::real, x) = a"
     using S by (auto simp: contractible_def homotopic_with)
   obtain b k where contk: "continuous_on ({0..1} \<times> T) k"
              and ksub: "k ` ({0..1} \<times> T) \<subseteq> T"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow> k (0, x) = x"
              and [simp]: "\<And>x. x \<in> T \<Longrightarrow>  k (1::real, x) = b"
     using T by (auto simp: contractible_def homotopic_with)
   show ?thesis
     apply (simp add: contractible_def homotopic_with)
     apply (rule exI [where x=a])
     apply (rule exI [where x=b])
     apply (rule exI [where x = "\<lambda>z. (h (fst z, fst(snd z)), k (fst z, snd(snd z)))"])
     apply (intro conjI ballI continuous_intros continuous_on_compose2 [OF conth] continuous_on_compose2 [OF contk])
     using hsub ksub
     apply auto
     done
 qed
 
 
 subsection\<open>Local versions of topological properties in general\<close>
 
 definition\<^marker>\<open>tag important\<close> locally :: "('a::topological_space set \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> bool"
 where
  "locally P S \<equiv>
         \<forall>w x. openin (top_of_set S) w \<and> x \<in> w
               \<longrightarrow> (\<exists>u v. openin (top_of_set S) u \<and> P v \<and>
                         x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w)"
 
 lemma locallyI:
   assumes "\<And>w x. \<lbrakk>openin (top_of_set S) w; x \<in> w\<rbrakk>
                   \<Longrightarrow> \<exists>u v. openin (top_of_set S) u \<and> P v \<and>
                         x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w"
     shows "locally P S"
 using assms by (force simp: locally_def)
 
 lemma locallyE:
   assumes "locally P S" "openin (top_of_set S) w" "x \<in> w"
   obtains u v where "openin (top_of_set S) u"
                     "P v" "x \<in> u" "u \<subseteq> v" "v \<subseteq> w"
   using assms unfolding locally_def by meson
 
 lemma locally_mono:
   assumes "locally P S" "\<And>t. P t \<Longrightarrow> Q t"
     shows "locally Q S"
 by (metis assms locally_def)
 
 lemma locally_open_subset:
   assumes "locally P S" "openin (top_of_set S) t"
     shows "locally P t"
 using assms
 apply (simp add: locally_def)
 apply (erule all_forward)+
 apply (rule impI)
 apply (erule impCE)
  using openin_trans apply blast
 apply (erule ex_forward)
 by (metis (no_types, hide_lams) Int_absorb1 Int_lower1 Int_subset_iff openin_open openin_subtopology_Int_subset)
 
 lemma locally_diff_closed:
     "\<lbrakk>locally P S; closedin (top_of_set S) t\<rbrakk> \<Longrightarrow> locally P (S - t)"
   using locally_open_subset closedin_def by fastforce
 
 lemma locally_empty [iff]: "locally P {}"
   by (simp add: locally_def openin_subtopology)
 
 lemma locally_singleton [iff]:
   fixes a :: "'a::metric_space"
   shows "locally P {a} \<longleftrightarrow> P {a}"
 apply (simp add: locally_def openin_euclidean_subtopology_iff subset_singleton_iff conj_disj_distribR cong: conj_cong)
 using zero_less_one by blast
 
 lemma locally_iff:
     "locally P S \<longleftrightarrow>
      (\<forall>T x. open T \<and> x \<in> S \<inter> T \<longrightarrow> (\<exists>U. open U \<and> (\<exists>v. P v \<and> x \<in> S \<inter> U \<and> S \<inter> U \<subseteq> v \<and> v \<subseteq> S \<inter> T)))"
 apply (simp add: le_inf_iff locally_def openin_open, safe)
 apply (metis IntE IntI le_inf_iff)
 apply (metis IntI Int_subset_iff)
 done
 
 lemma locally_Int:
   assumes S: "locally P S" and t: "locally P t"
       and P: "\<And>S t. P S \<and> P t \<Longrightarrow> P(S \<inter> t)"
     shows "locally P (S \<inter> t)"
 using S t unfolding locally_iff
 apply clarify
 apply (drule_tac x=T in spec)+
 apply (drule_tac x=x in spec)+
 apply clarsimp
 apply (rename_tac U1 U2 V1 V2)
 apply (rule_tac x="U1 \<inter> U2" in exI)
 apply (simp add: open_Int)
 apply (rule_tac x="V1 \<inter> V2" in exI)
 apply (auto intro: P)
   done
 
 lemma locally_Times:
   fixes S :: "('a::metric_space) set" and T :: "('b::metric_space) set"
   assumes PS: "locally P S" and QT: "locally Q T" and R: "\<And>S T. P S \<and> Q T \<Longrightarrow> R(S \<times> T)"
   shows "locally R (S \<times> T)"
     unfolding locally_def
 proof (clarify)
   fix W x y
   assume W: "openin (top_of_set (S \<times> T)) W" and xy: "(x, y) \<in> W"
   then obtain U V where "openin (top_of_set S) U" "x \<in> U"
                         "openin (top_of_set T) V" "y \<in> V" "U \<times> V \<subseteq> W"
     using Times_in_interior_subtopology by metis
   then obtain U1 U2 V1 V2
          where opeS: "openin (top_of_set S) U1 \<and> P U2 \<and> x \<in> U1 \<and> U1 \<subseteq> U2 \<and> U2 \<subseteq> U"
            and opeT: "openin (top_of_set T) V1 \<and> Q V2 \<and> y \<in> V1 \<and> V1 \<subseteq> V2 \<and> V2 \<subseteq> V"
     by (meson PS QT locallyE)
   with \<open>U \<times> V \<subseteq> W\<close> show "\<exists>u v. openin (top_of_set (S \<times> T)) u \<and> R v \<and> (x,y) \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> W"
     apply (rule_tac x="U1 \<times> V1" in exI)
     apply (rule_tac x="U2 \<times> V2" in exI)
     apply (auto simp: openin_Times R openin_Times_eq)
     done
 qed
 
 
 proposition homeomorphism_locally_imp:
   fixes S :: "'a::metric_space set" and t :: "'b::t2_space set"
   assumes S: "locally P S" and hom: "homeomorphism S t f g"
       and Q: "\<And>S S'. \<lbrakk>P S; homeomorphism S S' f g\<rbrakk> \<Longrightarrow> Q S'"
     shows "locally Q t"
 proof (clarsimp simp: locally_def)
   fix W y
   assume "y \<in> W" and "openin (top_of_set t) W"
   then obtain T where T: "open T" "W = t \<inter> T"
     by (force simp: openin_open)
   then have "W \<subseteq> t" by auto
   have f: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "f ` S = t" "continuous_on S f"
    and g: "\<And>y. y \<in> t \<Longrightarrow> f(g y) = y" "g ` t = S" "continuous_on t g"
     using hom by (auto simp: homeomorphism_def)
   have gw: "g ` W = S \<inter> f -` W"
     using \<open>W \<subseteq> t\<close>
     apply auto
     using \<open>g ` t = S\<close> \<open>W \<subseteq> t\<close> apply blast
     using g \<open>W \<subseteq> t\<close> apply auto[1]
     by (simp add: f rev_image_eqI)
   have \<circ>: "openin (top_of_set S) (g ` W)"
   proof -
     have "continuous_on S f"
       using f(3) by blast
     then show "openin (top_of_set S) (g ` W)"
       by (simp add: gw Collect_conj_eq \<open>openin (top_of_set t) W\<close> continuous_on_open f(2))
   qed
   then obtain u v
     where osu: "openin (top_of_set S) u" and uv: "P v" "g y \<in> u" "u \<subseteq> v" "v \<subseteq> g ` W"
     using S [unfolded locally_def, rule_format, of "g ` W" "g y"] \<open>y \<in> W\<close> by force
   have "v \<subseteq> S" using uv by (simp add: gw)
   have fv: "f ` v = t \<inter> {x. g x \<in> v}"
     using \<open>f ` S = t\<close> f \<open>v \<subseteq> S\<close> by auto
   have "f ` v \<subseteq> W"
     using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto
   have contvf: "continuous_on v f"
     using \<open>v \<subseteq> S\<close> continuous_on_subset f(3) by blast
   have contvg: "continuous_on (f ` v) g"
     using \<open>f ` v \<subseteq> W\<close> \<open>W \<subseteq> t\<close> continuous_on_subset [OF g(3)] by blast
   have homv: "homeomorphism v (f ` v) f g"
     using \<open>v \<subseteq> S\<close> \<open>W \<subseteq> t\<close> f
     apply (simp add: homeomorphism_def contvf contvg, auto)
     by (metis f(1) rev_image_eqI rev_subsetD)
   have 1: "openin (top_of_set t) (t \<inter> g -` u)"
     apply (rule continuous_on_open [THEN iffD1, rule_format])
     apply (rule \<open>continuous_on t g\<close>)
     using \<open>g ` t = S\<close> apply (simp add: osu)
     done
   have 2: "\<exists>V. Q V \<and> y \<in> (t \<inter> g -` u) \<and> (t \<inter> g -` u) \<subseteq> V \<and> V \<subseteq> W"
     apply (rule_tac x="f ` v" in exI)
     apply (intro conjI Q [OF \<open>P v\<close> homv])
     using \<open>W \<subseteq> t\<close> \<open>y \<in> W\<close>  \<open>f ` v \<subseteq> W\<close>  uv  apply (auto simp: fv)
     done
   show "\<exists>U. openin (top_of_set t) U \<and> (\<exists>v. Q v \<and> y \<in> U \<and> U \<subseteq> v \<and> v \<subseteq> W)"
     by (meson 1 2)
 qed
 
 lemma homeomorphism_locally:
   fixes f:: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes hom: "homeomorphism S t f g"
       and eq: "\<And>S t. homeomorphism S t f g \<Longrightarrow> (P S \<longleftrightarrow> Q t)"
     shows "locally P S \<longleftrightarrow> locally Q t"
 apply (rule iffI)
 apply (erule homeomorphism_locally_imp [OF _ hom])
 apply (simp add: eq)
 apply (erule homeomorphism_locally_imp)
 using eq homeomorphism_sym homeomorphism_symD [OF hom] apply blast+
 done
 
 lemma homeomorphic_locally:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   assumes hom: "S homeomorphic T"
           and iff: "\<And>X Y. X homeomorphic Y \<Longrightarrow> (P X \<longleftrightarrow> Q Y)"
     shows "locally P S \<longleftrightarrow> locally Q T"
 proof -
   obtain f g where hom: "homeomorphism S T f g"
     using assms by (force simp: homeomorphic_def)
   then show ?thesis
     using homeomorphic_def local.iff
     by (blast intro!: homeomorphism_locally)
 qed
 
 lemma homeomorphic_local_compactness:
   fixes S:: "'a::metric_space set" and T:: "'b::metric_space set"
   shows "S homeomorphic T \<Longrightarrow> locally compact S \<longleftrightarrow> locally compact T"
 by (simp add: homeomorphic_compactness homeomorphic_locally)
 
 lemma locally_translation:
   fixes P :: "'a :: real_normed_vector set \<Rightarrow> bool"
   shows
    "(\<And>S. P (image (\<lambda>x. a + x) S) \<longleftrightarrow> P S)
         \<Longrightarrow> locally P (image (\<lambda>x. a + x) S) \<longleftrightarrow> locally P S"
 apply (rule homeomorphism_locally [OF homeomorphism_translation])
 apply (simp add: homeomorphism_def)
 by metis
 
 lemma locally_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes f: "linear f" "inj f" and iff: "\<And>S. P (f ` S) \<longleftrightarrow> Q S"
     shows "locally P (f ` S) \<longleftrightarrow> locally Q S"
 apply (rule linear_homeomorphism_image [OF f])
 apply (rule_tac f=g and g = f in homeomorphism_locally, assumption)
 by (metis iff homeomorphism_def)
 
 lemma locally_open_map_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes P: "locally P S"
       and f: "continuous_on S f"
       and oo: "\<And>t. openin (top_of_set S) t
                    \<Longrightarrow> openin (top_of_set (f ` S)) (f ` t)"
       and Q: "\<And>t. \<lbrakk>t \<subseteq> S; P t\<rbrakk> \<Longrightarrow> Q(f ` t)"
     shows "locally Q (f ` S)"
 proof (clarsimp simp add: locally_def)
   fix W y
   assume oiw: "openin (top_of_set (f ` S)) W" and "y \<in> W"
   then have "W \<subseteq> f ` S" by (simp add: openin_euclidean_subtopology_iff)
   have oivf: "openin (top_of_set S) (S \<inter> f -` W)"
     by (rule continuous_on_open [THEN iffD1, rule_format, OF f oiw])
   then obtain x where "x \<in> S" "f x = y"
     using \<open>W \<subseteq> f ` S\<close> \<open>y \<in> W\<close> by blast
   then obtain U V
     where "openin (top_of_set S) U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> S \<inter> f -` W"
     using P [unfolded locally_def, rule_format, of "(S \<inter> f -` W)" x] oivf \<open>y \<in> W\<close>
     by auto
   then show "\<exists>X. openin (top_of_set (f ` S)) X \<and> (\<exists>Y. Q Y \<and> y \<in> X \<and> X \<subseteq> Y \<and> Y \<subseteq> W)"
     apply (rule_tac x="f ` U" in exI)
     apply (rule conjI, blast intro!: oo)
     apply (rule_tac x="f ` V" in exI)
     apply (force simp: \<open>f x = y\<close> rev_image_eqI intro: Q)
     done
 qed
 
 
 subsection\<open>An induction principle for connected sets\<close>
 
 proposition connected_induction:
   assumes "connected S"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<and> Q x \<longrightarrow> Q y)"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b" "Q a"
     shows "Q b"
 proof -
   have 1: "openin (top_of_set S)
              {b. \<exists>T. openin (top_of_set S) T \<and>
                      b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> Q x)}"
     apply (subst openin_subopen, clarify)
     apply (rule_tac x=T in exI, auto)
     done
   have 2: "openin (top_of_set S)
              {b. \<exists>T. openin (top_of_set S) T \<and>
                      b \<in> T \<and> (\<forall>x\<in>T. P x \<longrightarrow> \<not> Q x)}"
     apply (subst openin_subopen, clarify)
     apply (rule_tac x=T in exI, auto)
     done
   show ?thesis
     using \<open>connected S\<close>
     apply (simp only: connected_openin HOL.not_ex HOL.de_Morgan_conj)
     apply (elim disjE allE)
          apply (blast intro: 1)
         apply (blast intro: 2, simp_all)
        apply clarify apply (metis opI)
       using opD apply (blast intro: etc elim: dest:)
      using opI etc apply meson+
     done
 qed
 
 lemma connected_equivalence_relation_gen:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a" "P b"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z"
       and opD: "\<And>T a. \<lbrakk>openin (top_of_set S) T; a \<in> T\<rbrakk> \<Longrightarrow> \<exists>z. z \<in> T \<and> P z"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<and> P y \<longrightarrow> R x y)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; P a; b \<in> S; c \<in> S; P b; P c; R a b\<rbrakk> \<Longrightarrow> R a c"
     apply (rule connected_induction [OF \<open>connected S\<close> opD], simp_all)
     by (meson trans opI)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma connected_induction_simple:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S" "P a"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and>
                      (\<forall>x \<in> T. \<forall>y \<in> T. P x \<longrightarrow> P y)"
     shows "P b"
 apply (rule connected_induction [OF \<open>connected S\<close> _, where P = "\<lambda>x. True"], blast)
 apply (frule opI)
 using etc apply simp_all
 done
 
 lemma connected_equivalence_relation:
   assumes "connected S"
       and etc: "a \<in> S" "b \<in> S"
       and sym: "\<And>x y. \<lbrakk>R x y; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> R y x"
       and trans: "\<And>x y z. \<lbrakk>R x y; R y z; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> R x z"
       and opI: "\<And>a. a \<in> S \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. R a x)"
     shows "R a b"
 proof -
   have "\<And>a b c. \<lbrakk>a \<in> S; b \<in> S; c \<in> S; R a b\<rbrakk> \<Longrightarrow> R a c"
     apply (rule connected_induction_simple [OF \<open>connected S\<close>], simp_all)
     by (meson local.sym local.trans opI openin_imp_subset subsetCE)
   then show ?thesis by (metis etc opI)
 qed
 
 lemma locally_constant_imp_constant:
   assumes "connected S"
       and opI: "\<And>a. a \<in> S
              \<Longrightarrow> \<exists>T. openin (top_of_set S) T \<and> a \<in> T \<and> (\<forall>x \<in> T. f x = f a)"
     shows "f constant_on S"
 proof -
   have "\<And>x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> f x = f y"
     apply (rule connected_equivalence_relation [OF \<open>connected S\<close>], simp_all)
     by (metis opI)
   then show ?thesis
     by (metis constant_on_def)
 qed
 
 lemma locally_constant:
      "connected S \<Longrightarrow> locally (\<lambda>U. f constant_on U) S \<longleftrightarrow> f constant_on S"
 apply (simp add: locally_def)
 apply (rule iffI)
  apply (rule locally_constant_imp_constant, assumption)
  apply (metis (mono_tags, hide_lams) constant_on_def constant_on_subset openin_subtopology_self)
 by (meson constant_on_subset openin_imp_subset order_refl)
 
 
 subsection\<open>Basic properties of local compactness\<close>
 
 proposition locally_compact:
   fixes s :: "'a :: metric_space set"
   shows
     "locally compact s \<longleftrightarrow>
      (\<forall>x \<in> s. \<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
                     openin (top_of_set s) u \<and> compact v)"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply clarify
     apply (erule_tac w = "s \<inter> ball x 1" in locallyE)
     by auto
 next
   assume r [rule_format]: ?rhs
   have *: "\<exists>u v.
               openin (top_of_set s) u \<and>
               compact v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<inter> T"
           if "open T" "x \<in> s" "x \<in> T" for x T
   proof -
     obtain u v where uv: "x \<in> u" "u \<subseteq> v" "v \<subseteq> s" "compact v" "openin (top_of_set s) u"
       using r [OF \<open>x \<in> s\<close>] by auto
     obtain e where "e>0" and e: "cball x e \<subseteq> T"
       using open_contains_cball \<open>open T\<close> \<open>x \<in> T\<close> by blast
     show ?thesis
       apply (rule_tac x="(s \<inter> ball x e) \<inter> u" in exI)
       apply (rule_tac x="cball x e \<inter> v" in exI)
       using that \<open>e > 0\<close> e uv
       apply auto
       done
   qed
   show ?lhs
     apply (rule locallyI)
     apply (subst (asm) openin_open)
     apply (blast intro: *)
     done
 qed
 
 lemma locally_compactE:
   fixes s :: "'a :: metric_space set"
   assumes "locally compact s"
   obtains u v where "\<And>x. x \<in> s \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> s \<and>
                              openin (top_of_set s) (u x) \<and> compact (v x)"
 using assms
 unfolding locally_compact by metis
 
 lemma locally_compact_alt:
   fixes s :: "'a :: heine_borel set"
   shows "locally compact s \<longleftrightarrow>
          (\<forall>x \<in> s. \<exists>u. x \<in> u \<and>
                     openin (top_of_set s) u \<and> compact(closure u) \<and> closure u \<subseteq> s)"
 apply (simp add: locally_compact)
 apply (intro ball_cong ex_cong refl iffI)
 apply (metis bounded_subset closure_eq closure_mono compact_eq_bounded_closed dual_order.trans)
 by (meson closure_subset compact_closure)
 
 lemma locally_compact_Int_cball:
   fixes s :: "'a :: heine_borel set"
   shows "locally compact s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>e. 0 < e \<and> closed(cball x e \<inter> s))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp add: locally_compact openin_contains_cball)
     apply (clarify | assumption | drule bspec)+
     by (metis (no_types, lifting)  compact_cball compact_imp_closed compact_Int inf.absorb_iff2 inf.orderE inf_sup_aci(2))
 next
   assume ?rhs
   then show ?lhs
     apply (simp add: locally_compact openin_contains_cball)
     apply (clarify | assumption | drule bspec)+
     apply (rule_tac x="ball x e \<inter> s" in exI, simp)
     apply (rule_tac x="cball x e \<inter> s" in exI)
     using compact_eq_bounded_closed
     apply auto
     apply (metis open_ball le_infI1 mem_ball open_contains_cball_eq)
     done
 qed
 
 lemma locally_compact_compact:
   fixes s :: "'a :: heine_borel set"
   shows "locally compact s \<longleftrightarrow>
          (\<forall>k. k \<subseteq> s \<and> compact k
               \<longrightarrow> (\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
                          openin (top_of_set s) u \<and> compact v))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain u v where
     uv: "\<And>x. x \<in> s \<Longrightarrow> x \<in> u x \<and> u x \<subseteq> v x \<and> v x \<subseteq> s \<and>
                              openin (top_of_set s) (u x) \<and> compact (v x)"
     by (metis locally_compactE)
   have *: "\<exists>u v. k \<subseteq> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (top_of_set s) u \<and> compact v"
           if "k \<subseteq> s" "compact k" for k
   proof -
     have "\<And>C. (\<forall>c\<in>C. openin (top_of_set k) c) \<and> k \<subseteq> \<Union>C \<Longrightarrow>
                     \<exists>D\<subseteq>C. finite D \<and> k \<subseteq> \<Union>D"
       using that by (simp add: compact_eq_openin_cover)
     moreover have "\<forall>c \<in> (\<lambda>x. k \<inter> u x) ` k. openin (top_of_set k) c"
       using that by clarify (metis subsetD inf.absorb_iff2 openin_subset openin_subtopology_Int_subset topspace_euclidean_subtopology uv)
     moreover have "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` k)"
       using that by clarsimp (meson subsetCE uv)
     ultimately obtain D where "D \<subseteq> (\<lambda>x. k \<inter> u x) ` k" "finite D" "k \<subseteq> \<Union>D"
       by metis
     then obtain T where T: "T \<subseteq> k" "finite T" "k \<subseteq> \<Union>((\<lambda>x. k \<inter> u x) ` T)"
       by (metis finite_subset_image)
     have Tuv: "\<Union>(u ` T) \<subseteq> \<Union>(v ` T)"
       using T that by (force simp: dest!: uv)
     show ?thesis
       apply (rule_tac x="\<Union>(u ` T)" in exI)
       apply (rule_tac x="\<Union>(v ` T)" in exI)
       apply (simp add: Tuv)
       using T that
       apply (auto simp: dest!: uv)
       done
   qed
   show ?rhs
     by (blast intro: *)
 next
   assume ?rhs
   then show ?lhs
     apply (clarsimp simp add: locally_compact)
     apply (drule_tac x="{x}" in spec, simp)
     done
 qed
 
 lemma open_imp_locally_compact:
   fixes s :: "'a :: heine_borel set"
   assumes "open s"
     shows "locally compact s"
 proof -
   have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and> openin (top_of_set s) u \<and> compact v"
           if "x \<in> s" for x
   proof -
     obtain e where "e>0" and e: "cball x e \<subseteq> s"
       using open_contains_cball assms \<open>x \<in> s\<close> by blast
     have ope: "openin (top_of_set s) (ball x e)"
       by (meson e open_ball ball_subset_cball dual_order.trans open_subset)
     show ?thesis
       apply (rule_tac x="ball x e" in exI)
       apply (rule_tac x="cball x e" in exI)
       using \<open>e > 0\<close> e apply (auto simp: ope)
       done
   qed
   show ?thesis
     unfolding locally_compact
     by (blast intro: *)
 qed
 
 lemma closed_imp_locally_compact:
   fixes s :: "'a :: heine_borel set"
   assumes "closed s"
     shows "locally compact s"
 proof -
   have *: "\<exists>u v. x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> s \<and>
                  openin (top_of_set s) u \<and> compact v"
           if "x \<in> s" for x
   proof -
     show ?thesis
       apply (rule_tac x = "s \<inter> ball x 1" in exI)
       apply (rule_tac x = "s \<inter> cball x 1" in exI)
       using \<open>x \<in> s\<close> assms apply auto
       done
   qed
   show ?thesis
     unfolding locally_compact
     by (blast intro: *)
 qed
 
 lemma locally_compact_UNIV: "locally compact (UNIV :: 'a :: heine_borel set)"
   by (simp add: closed_imp_locally_compact)
 
 lemma locally_compact_Int:
   fixes s :: "'a :: t2_space set"
   shows "\<lbrakk>locally compact s; locally compact t\<rbrakk> \<Longrightarrow> locally compact (s \<inter> t)"
 by (simp add: compact_Int locally_Int)
 
 lemma locally_compact_closedin:
   fixes s :: "'a :: heine_borel set"
   shows "\<lbrakk>closedin (top_of_set s) t; locally compact s\<rbrakk>
         \<Longrightarrow> locally compact t"
 unfolding closedin_closed
 using closed_imp_locally_compact locally_compact_Int by blast
 
 lemma locally_compact_delete:
      fixes s :: "'a :: t1_space set"
      shows "locally compact s \<Longrightarrow> locally compact (s - {a})"
   by (auto simp: openin_delete locally_open_subset)
 
 lemma locally_closed:
   fixes s :: "'a :: heine_borel set"
   shows "locally closed s \<longleftrightarrow> locally compact s"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp only: locally_def)
     apply (erule all_forward imp_forward asm_rl exE)+
     apply (rule_tac x = "u \<inter> ball x 1" in exI)
     apply (rule_tac x = "v \<inter> cball x 1" in exI)
     apply (force intro: openin_trans)
     done
 next
   assume ?rhs then show ?lhs
     using compact_eq_bounded_closed locally_mono by blast
 qed
 
 lemma locally_compact_openin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT:"locally compact T"
       and opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> S"
       by (meson \<open>x \<in> S\<close> opS openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> S"
       by force
     ultimately show ?thesis
       apply (rule_tac x="min e1 e2" in exI)
       apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
       by (metis closed_Int closed_cball inf_left_commute)
   qed
   moreover have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover obtain e2 where "e2 > 0" and e2: "cball x e2 \<inter> (S \<union> T) \<subseteq> T"
       by (meson \<open>x \<in> T\<close> opT openin_contains_cball)
     then have "cball x e2 \<inter> (S \<union> T) = cball x e2 \<inter> T"
       by force
     ultimately show ?thesis
       apply (rule_tac x="min e1 e2" in exI)
       apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int)
       by (metis closed_Int closed_cball inf_left_commute)
   qed
   ultimately show ?thesis
     by (force simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_closedin_Un:
   fixes S :: "'a::euclidean_space set"
   assumes LCS: "locally compact S" and LCT:"locally compact T"
       and clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
     shows "locally compact (S \<union> T)"
 proof -
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if "x \<in> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2 > 0" and e2: "closed (cball x e2 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     ultimately show ?thesis
       apply (rule_tac x="min e1 e2" in exI)
       apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
       by (metis closed_Int closed_Un closed_cball inf_left_commute)
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<in> S" "x \<notin> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> S)"
       using LCS \<open>x \<in> S\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S - T"
       using clT x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> T)"
     proof -
       have "{} = T - (T - cball x e2)"
         using Diff_subset Int_Diff \<open>cball x e2 \<inter> (S \<union> T) \<subseteq> S - T\<close> by auto
       then show ?thesis
         by (simp add: Diff_Diff_Int inf_commute)
     qed
     ultimately show ?thesis
       apply (rule_tac x="min e1 e2" in exI)
       apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
       by (metis closed_Int closed_Un closed_cball inf_left_commute)
   qed
   moreover
   have "\<exists>e>0. closed (cball x e \<inter> (S \<union> T))" if x: "x \<notin> S" "x \<in> T" for x
   proof -
     obtain e1 where "e1 > 0" and e1: "closed (cball x e1 \<inter> T)"
       using LCT \<open>x \<in> T\<close> unfolding locally_compact_Int_cball by blast
     moreover
     obtain e2 where "e2>0" and "cball x e2 \<inter> (S \<union> T) \<subseteq> S \<union> T - S"
       using clS x by (fastforce simp: openin_contains_cball closedin_def)
     then have "closed (cball x e2 \<inter> S)"
       by (metis Diff_disjoint Int_empty_right closed_empty inf.left_commute inf.orderE inf_sup_absorb)
     ultimately show ?thesis
       apply (rule_tac x="min e1 e2" in exI)
       apply (auto simp: cball_min_Int \<open>e2 > 0\<close> inf_assoc closed_Int Int_Un_distrib)
       by (metis closed_Int closed_Un closed_cball inf_left_commute)
   qed
   ultimately show ?thesis
     by (auto simp: locally_compact_Int_cball)
 qed
 
 lemma locally_compact_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   shows "\<lbrakk>locally compact S; locally compact T\<rbrakk> \<Longrightarrow> locally compact (S \<times> T)"
   by (auto simp: compact_Times locally_Times)
 
 lemma locally_compact_compact_subopen:
   fixes S :: "'a :: heine_borel set"
   shows
    "locally compact S \<longleftrightarrow>
     (\<forall>K T. K \<subseteq> S \<and> compact K \<and> open T \<and> K \<subseteq> T
           \<longrightarrow> (\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                      openin (top_of_set S) U \<and> compact V))"
    (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof clarify
     fix K :: "'a set" and T :: "'a set"
     assume "K \<subseteq> S" and "compact K" and "open T" and "K \<subseteq> T"
     obtain U V where "K \<subseteq> U" "U \<subseteq> V" "V \<subseteq> S" "compact V"
                  and ope: "openin (top_of_set S) U"
       using L unfolding locally_compact_compact by (meson \<open>K \<subseteq> S\<close> \<open>compact K\<close>)
     show "\<exists>U V. K \<subseteq> U \<and> U \<subseteq> V \<and> U \<subseteq> T \<and> V \<subseteq> S \<and>
                 openin (top_of_set S) U \<and> compact V"
     proof (intro exI conjI)
       show "K \<subseteq> U \<inter> T"
         by (simp add: \<open>K \<subseteq> T\<close> \<open>K \<subseteq> U\<close>)
       show "U \<inter> T \<subseteq> closure(U \<inter> T)"
         by (rule closure_subset)
       show "closure (U \<inter> T) \<subseteq> S"
         by (metis \<open>U \<subseteq> V\<close> \<open>V \<subseteq> S\<close> \<open>compact V\<close> closure_closed closure_mono compact_imp_closed inf.cobounded1 subset_trans)
       show "openin (top_of_set S) (U \<inter> T)"
         by (simp add: \<open>open T\<close> ope openin_Int_open)
       show "compact (closure (U \<inter> T))"
         by (meson Int_lower1 \<open>U \<subseteq> V\<close> \<open>compact V\<close> bounded_subset compact_closure compact_eq_bounded_closed)
     qed auto
   qed
 next
   assume ?rhs then show ?lhs
     unfolding locally_compact_compact
     by (metis open_openin openin_topspace subtopology_superset top.extremum topspace_euclidean_subtopology)
 qed
 
 
 subsection\<open>Sura-Bura's results about compact components of sets\<close>
 
 proposition Sura_Bura_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" and C: "C \<in> components S"
   shows "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set S) T \<and>
                            closedin (top_of_set S) T}"
          (is "C = \<Inter>?\<T>")
 proof
   obtain x where x: "C = connected_component_set S x" and "x \<in> S"
     using C by (auto simp: components_def)
   have "C \<subseteq> S"
     by (simp add: C in_components_subset)
   have "\<Inter>?\<T> \<subseteq> connected_component_set S x"
   proof (rule connected_component_maximal)
     have "x \<in> C"
       by (simp add: \<open>x \<in> S\<close> x)
     then show "x \<in> \<Inter>?\<T>"
       by blast
     have clo: "closed (\<Inter>?\<T>)"
       by (simp add: \<open>compact S\<close> closed_Inter closedin_compact_eq compact_imp_closed)
     have False
       if K1: "closedin (top_of_set (\<Inter>?\<T>)) K1" and
          K2: "closedin (top_of_set (\<Inter>?\<T>)) K2" and
          K12_Int: "K1 \<inter> K2 = {}" and K12_Un: "K1 \<union> K2 = \<Inter>?\<T>" and "K1 \<noteq> {}" "K2 \<noteq> {}"
        for K1 K2
     proof -
       have "closed K1" "closed K2"
         using closedin_closed_trans clo K1 K2 by blast+
       then obtain V1 V2 where "open V1" "open V2" "K1 \<subseteq> V1" "K2 \<subseteq> V2" and V12: "V1 \<inter> V2 = {}"
         using separation_normal \<open>K1 \<inter> K2 = {}\<close> by metis
       have SV12_ne: "(S - (V1 \<union> V2)) \<inter> (\<Inter>?\<T>) \<noteq> {}"
       proof (rule compact_imp_fip)
         show "compact (S - (V1 \<union> V2))"
           by (simp add: \<open>open V1\<close> \<open>open V2\<close> \<open>compact S\<close> compact_diff open_Un)
         show clo\<T>: "closed T" if "T \<in> ?\<T>" for T
           using that \<open>compact S\<close>
           by (force intro: closedin_closed_trans simp add: compact_imp_closed)
         show "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> \<noteq> {}" if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
         proof
           assume djo: "(S - (V1 \<union> V2)) \<inter> \<Inter>\<F> = {}"
           obtain D where opeD: "openin (top_of_set S) D"
                    and cloD: "closedin (top_of_set S) D"
                    and "C \<subseteq> D" and DV12: "D \<subseteq> V1 \<union> V2"
           proof (cases "\<F> = {}")
             case True
             with \<open>C \<subseteq> S\<close> djo that show ?thesis
               by force
           next
             case False show ?thesis
             proof
               show ope: "openin (top_of_set S) (\<Inter>\<F>)"
                 using openin_Inter \<open>finite \<F>\<close> False \<F> by blast
               then show "closedin (top_of_set S) (\<Inter>\<F>)"
                 by (meson clo\<T> \<F> closed_Inter closed_subset openin_imp_subset subset_eq)
               show "C \<subseteq> \<Inter>\<F>"
                 using \<F> by auto
               show "\<Inter>\<F> \<subseteq> V1 \<union> V2"
                 using ope djo openin_imp_subset by fastforce
             qed
           qed
           have "connected C"
             by (simp add: x)
           have "closed D"
             using \<open>compact S\<close> cloD closedin_closed_trans compact_imp_closed by blast
           have cloV1: "closedin (top_of_set D) (D \<inter> closure V1)"
             and cloV2: "closedin (top_of_set D) (D \<inter> closure V2)"
             by (simp_all add: closedin_closed_Int)
           moreover have "D \<inter> closure V1 = D \<inter> V1" "D \<inter> closure V2 = D \<inter> V2"
             apply safe
             using \<open>D \<subseteq> V1 \<union> V2\<close> \<open>open V1\<close> \<open>open V2\<close> V12
                apply (simp_all add: closure_subset [THEN subsetD] closure_iff_nhds_not_empty, blast+)
             done
           ultimately have cloDV1: "closedin (top_of_set D) (D \<inter> V1)"
                       and cloDV2:  "closedin (top_of_set D) (D \<inter> V2)"
             by metis+
           then obtain U1 U2 where "closed U1" "closed U2"
                and D1: "D \<inter> V1 = D \<inter> U1" and D2: "D \<inter> V2 = D \<inter> U2"
             by (auto simp: closedin_closed)
           have "D \<inter> U1 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U1 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V2"
               using D1 DV12 \<open>C \<subseteq> D\<close> by auto
             have "\<Inter>?\<T> \<subseteq> D \<inter> V2"
               apply (rule Inter_lower)
               using * apply simp
               by (meson cloDV2 \<open>open V2\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
             then show False
               using K1 V12 \<open>K1 \<noteq> {}\<close> \<open>K1 \<subseteq> V1\<close> closedin_imp_subset by blast
           qed
           moreover have "D \<inter> U2 \<inter> C \<noteq> {}"
           proof
             assume "D \<inter> U2 \<inter> C = {}"
             then have *: "C \<subseteq> D \<inter> V1"
               using D2 DV12 \<open>C \<subseteq> D\<close> by auto
             have "\<Inter>?\<T> \<subseteq> D \<inter> V1"
               apply (rule Inter_lower)
               using * apply simp
               by (meson cloDV1 \<open>open V1\<close> cloD closedin_trans le_inf_iff opeD openin_Int_open)
             then show False
               using K2 V12 \<open>K2 \<noteq> {}\<close> \<open>K2 \<subseteq> V2\<close> closedin_imp_subset by blast
           qed
           ultimately show False
             using \<open>connected C\<close> unfolding connected_closed
             apply (simp only: not_ex)
             apply (drule_tac x="D \<inter> U1" in spec)
             apply (drule_tac x="D \<inter> U2" in spec)
             using \<open>C \<subseteq> D\<close> D1 D2 V12 DV12 \<open>closed U1\<close> \<open>closed U2\<close> \<open>closed D\<close>
             by blast
         qed
       qed
       show False
         by (metis (full_types) DiffE UnE Un_upper2 SV12_ne \<open>K1 \<subseteq> V1\<close> \<open>K2 \<subseteq> V2\<close> disjoint_iff_not_equal subsetCE sup_ge1 K12_Un)
     qed
     then show "connected (\<Inter>?\<T>)"
       by (auto simp: connected_closedin_eq)
     show "\<Inter>?\<T> \<subseteq> S"
       by (fastforce simp: C in_components_subset)
   qed
   with x show "\<Inter>?\<T> \<subseteq> C" by simp
 qed auto
 
 
 corollary Sura_Bura_clopen_subset:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and U: "open U" "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof (rule ccontr)
   assume "\<not> thesis"
   with that have neg: "\<nexists>K. openin (top_of_set S) K \<and> compact K \<and> C \<subseteq> K \<and> K \<subseteq> U"
     by metis
   obtain V K where "C \<subseteq> V" "V \<subseteq> U" "V \<subseteq> K" "K \<subseteq> S" "compact K"
                and opeSV: "openin (top_of_set S) V"
     using S U \<open>compact C\<close>
     apply (simp add: locally_compact_compact_subopen)
     by (meson C in_components_subset)
   let ?\<T> = "{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> compact T \<and> T \<subseteq> K}"
   have CK: "C \<in> components K"
     by (meson C \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> components_intermediate_subset subset_trans)
   with \<open>compact K\<close>
   have "C = \<Inter>{T. C \<subseteq> T \<and> openin (top_of_set K) T \<and> closedin (top_of_set K) T}"
     by (simp add: Sura_Bura_compact)
   then have Ceq: "C = \<Inter>?\<T>"
     by (simp add: closedin_compact_eq \<open>compact K\<close>)
   obtain W where "open W" and W: "V = S \<inter> W"
     using opeSV by (auto simp: openin_open)
   have "-(U \<inter> W) \<inter> \<Inter>?\<T> \<noteq> {}"
   proof (rule closed_imp_fip_compact)
     show "- (U \<inter> W) \<inter> \<Inter>\<F> \<noteq> {}"
       if "finite \<F>" and \<F>: "\<F> \<subseteq> ?\<T>" for \<F>
     proof (cases "\<F> = {}")
       case True
       have False if "U = UNIV" "W = UNIV"
       proof -
         have "V = S"
           by (simp add: W \<open>W = UNIV\<close>)
         with neg show False
           using \<open>C \<subseteq> V\<close> \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> \<open>V \<subseteq> U\<close> \<open>compact K\<close> by auto
       qed
       with True show ?thesis
         by auto
     next
       case False
       show ?thesis
       proof
         assume "- (U \<inter> W) \<inter> \<Inter>\<F> = {}"
         then have FUW: "\<Inter>\<F> \<subseteq> U \<inter> W"
           by blast
         have "C \<subseteq> \<Inter>\<F>"
           using \<F> by auto
         moreover have "compact (\<Inter>\<F>)"
           by (metis (no_types, lifting) compact_Inter False mem_Collect_eq subsetCE \<F>)
         moreover have "\<Inter>\<F> \<subseteq> K"
           using False that(2) by fastforce
         moreover have opeKF: "openin (top_of_set K) (\<Inter>\<F>)"
           using False \<F> \<open>finite \<F>\<close> by blast
         then have opeVF: "openin (top_of_set V) (\<Inter>\<F>)"
           using W \<open>K \<subseteq> S\<close> \<open>V \<subseteq> K\<close> opeKF \<open>\<Inter>\<F> \<subseteq> K\<close> FUW openin_subset_trans by fastforce
         then have "openin (top_of_set S) (\<Inter>\<F>)"
           by (metis opeSV openin_trans)
         moreover have "\<Inter>\<F> \<subseteq> U"
           by (meson \<open>V \<subseteq> U\<close> opeVF dual_order.trans openin_imp_subset)
         ultimately show False
           using neg by blast
       qed
     qed
   qed (use \<open>open W\<close> \<open>open U\<close> in auto)
   with W Ceq \<open>C \<subseteq> V\<close> \<open>C \<subseteq> U\<close> show False
     by auto
 qed
 
 
 corollary Sura_Bura_clopen_subset_alt:
   fixes S :: "'a::euclidean_space set"
   assumes S: "locally compact S" and C: "C \<in> components S" and "compact C"
       and opeSU: "openin (top_of_set S) U" and "C \<subseteq> U"
   obtains K where "openin (top_of_set S) K" "compact K" "C \<subseteq> K" "K \<subseteq> U"
 proof -
   obtain V where "open V" "U = S \<inter> V"
     using opeSU by (auto simp: openin_open)
   with \<open>C \<subseteq> U\<close> have "C \<subseteq> V"
     by auto
   then show ?thesis
     using Sura_Bura_clopen_subset [OF S C \<open>compact C\<close> \<open>open V\<close>]
     by (metis \<open>U = S \<inter> V\<close> inf.bounded_iff openin_imp_subset that)
 qed
 
 corollary Sura_Bura:
   fixes S :: "'a::euclidean_space set"
   assumes "locally compact S" "C \<in> components S" "compact C"
   shows "C = \<Inter> {K. C \<subseteq> K \<and> compact K \<and> openin (top_of_set S) K}"
          (is "C = ?rhs")
 proof
   show "?rhs \<subseteq> C"
   proof (clarsimp, rule ccontr)
     fix x
     assume *: "\<forall>X. C \<subseteq> X \<and> compact X \<and> openin (top_of_set S) X \<longrightarrow> x \<in> X"
       and "x \<notin> C"
     obtain U V where "open U" "open V" "{x} \<subseteq> U" "C \<subseteq> V" "U \<inter> V = {}"
       using separation_normal [of "{x}" C]
       by (metis Int_empty_left \<open>x \<notin> C\<close> \<open>compact C\<close> closed_empty closed_insert compact_imp_closed insert_disjoint(1))
     have "x \<notin> V"
       using \<open>U \<inter> V = {}\<close> \<open>{x} \<subseteq> U\<close> by blast
     then show False
       by (meson "*" Sura_Bura_clopen_subset \<open>C \<subseteq> V\<close> \<open>open V\<close> assms(1) assms(2) assms(3) subsetCE)
   qed
 qed blast
 
 
 subsection\<open>Special cases of local connectedness and path connectedness\<close>
 
 lemma locally_connected_1:
   assumes
     "\<And>v x. \<lbrakk>openin (top_of_set S) v; x \<in> v\<rbrakk>
               \<Longrightarrow> \<exists>u. openin (top_of_set S) u \<and>
                       connected u \<and> x \<in> u \<and> u \<subseteq> v"
    shows "locally connected S"
 apply (clarsimp simp add: locally_def)
 apply (drule assms; blast)
 done
 
 lemma locally_connected_2:
   assumes "locally connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (connected_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "connected_component t x y"
     then have "y \<in> t" and y: "y \<in> connected_component_set t x"
       using connected_component_subset by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> connected_component_set t y"
       by (metis (no_types) * connected_component_eq_self connected_component_mono contra_subsetD)
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> connected_component_set t x"
       by (metis (no_types) * connected_component_eq dual_order.trans y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S)
                           (connected_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v"
 using assms connected_component_subset by fastforce
 
 lemma locally_connected:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
           \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and> connected u \<and> x \<in> u \<and> u \<subseteq> v))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_connected_open_connected_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (connected_component_set t x))"
 by (metis locally_connected_1 locally_connected_2 locally_connected_3)
 
 lemma locally_path_connected_1:
   assumes
     "\<And>v x. \<lbrakk>openin (top_of_set S) v; x \<in> v\<rbrakk>
               \<Longrightarrow> \<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
    shows "locally path_connected S"
 apply (clarsimp simp add: locally_def)
 apply (drule assms; blast)
 done
 
 lemma locally_path_connected_2:
   assumes "locally path_connected S"
           "openin (top_of_set S) t"
           "x \<in> t"
    shows "openin (top_of_set S) (path_component_set t x)"
 proof -
   { fix y :: 'a
     let ?SS = "top_of_set S"
     assume 1: "openin ?SS t"
               "\<forall>w x. openin ?SS w \<and> x \<in> w \<longrightarrow> (\<exists>u. openin ?SS u \<and> (\<exists>v. path_connected v \<and> x \<in> u \<and> u \<subseteq> v \<and> v \<subseteq> w))"
     and "path_component t x y"
     then have "y \<in> t" and y: "y \<in> path_component_set t x"
       using path_component_mem(2) by blast+
     obtain F where
       "\<forall>x y. (\<exists>w. openin ?SS w \<and> (\<exists>u. path_connected u \<and> x \<in> w \<and> w \<subseteq> u \<and> u \<subseteq> y)) = (openin ?SS (F x y) \<and> (\<exists>u. path_connected u \<and> x \<in> F x y \<and> F x y \<subseteq> u \<and> u \<subseteq> y))"
       by moura
     then obtain G where
        "\<forall>a A. (\<exists>U. openin ?SS U \<and> (\<exists>V. path_connected V \<and> a \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> A)) = (openin ?SS (F a A) \<and> path_connected (G a A) \<and> a \<in> F a A \<and> F a A \<subseteq> G a A \<and> G a A \<subseteq> A)"
       by moura
     then have *: "openin ?SS (F y t) \<and> path_connected (G y t) \<and> y \<in> F y t \<and> F y t \<subseteq> G y t \<and> G y t \<subseteq> t"
       using 1 \<open>y \<in> t\<close> by presburger
     have "G y t \<subseteq> path_component_set t y"
       using * path_component_maximal rev_subsetD by blast
     then have "\<exists>A. openin ?SS A \<and> y \<in> A \<and> A \<subseteq> path_component_set t x"
       by (metis "*" \<open>G y t \<subseteq> path_component_set t y\<close> dual_order.trans path_component_eq y)
   }
   then show ?thesis
     using assms openin_subopen by (force simp: locally_def)
 qed
 
 lemma locally_path_connected_3:
   assumes "\<And>t x. \<lbrakk>openin (top_of_set S) t; x \<in> t\<rbrakk>
               \<Longrightarrow> openin (top_of_set S) (path_component_set t x)"
           "openin (top_of_set S) v" "x \<in> v"
    shows  "\<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v"
 proof -
   have "path_component v x x"
     by (meson assms(3) path_component_refl)
   then show ?thesis
     by (metis assms(1) assms(2) assms(3) mem_Collect_eq path_component_subset path_connected_path_component)
 qed
 
 proposition locally_path_connected:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
           \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and> path_connected u \<and> x \<in> u \<and> u \<subseteq> v))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 proposition locally_path_connected_open_path_component:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>t x. openin (top_of_set S) t \<and> x \<in> t
           \<longrightarrow> openin (top_of_set S) (path_component_set t x))"
   by (metis locally_path_connected_1 locally_path_connected_2 locally_path_connected_3)
 
 lemma locally_connected_open_component:
   "locally connected S \<longleftrightarrow>
    (\<forall>t c. openin (top_of_set S) t \<and> c \<in> components t
           \<longrightarrow> openin (top_of_set S) c)"
 by (metis components_iff locally_connected_open_connected_component)
 
 proposition locally_connected_im_kleinen:
   "locally connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> v \<and> x \<in> c \<and> y \<in> c))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (fastforce simp add: locally_connected)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> c"
        if "openin (top_of_set S) t" and c: "c \<in> components t" and "x \<in> c" for t c x
   proof -
     from that \<open>?rhs\<close> [rule_format, of t x]
     obtain u where u:
       "openin (top_of_set S) u \<and> x \<in> u \<and> u \<subseteq> t \<and>
        (\<forall>y. y \<in> u \<longrightarrow> (\<exists>c. connected c \<and> c \<subseteq> t \<and> x \<in> c \<and> y \<in> c))"
       using in_components_subset by auto
     obtain F :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
       "\<forall>x y. (\<exists>z. z \<in> x \<and> y = connected_component_set x z) = (F x y \<in> x \<and> y = connected_component_set x (F x y))"
       by moura
     then have F: "F t c \<in> t \<and> c = connected_component_set t (F t c)"
       by (meson components_iff c)
     obtain G :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a" where
         G: "\<forall>x y. (\<exists>z. z \<in> y \<and> z \<notin> x) = (G x y \<in> y \<and> G x y \<notin> x)"
       by moura
      have "G c u \<notin> u \<or> G c u \<in> c"
       using F by (metis (full_types) u connected_componentI connected_component_eq mem_Collect_eq that(3))
     then show ?thesis
       using G u by auto
   qed
   show ?lhs
     apply (clarsimp simp add: locally_connected_open_component)
     apply (subst openin_subopen)
     apply (blast intro: *)
     done
 qed
 
 proposition locally_path_connected_im_kleinen:
   "locally path_connected S \<longleftrightarrow>
    (\<forall>v x. openin (top_of_set S) v \<and> x \<in> v
        \<longrightarrow> (\<exists>u. openin (top_of_set S) u \<and>
                 x \<in> u \<and> u \<subseteq> v \<and>
                 (\<forall>y. y \<in> u \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> v \<and>
                                 pathstart p = x \<and> pathfinish p = y))))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp add: locally_path_connected path_connected_def)
     apply (erule all_forward ex_forward imp_forward conjE | simp)+
     by (meson dual_order.trans)
 next
   assume ?rhs
   have *: "\<exists>T. openin (top_of_set S) T \<and>
                x \<in> T \<and> T \<subseteq> path_component_set u z"
        if "openin (top_of_set S) u" and "z \<in> u" and c: "path_component u z x" for u z x
   proof -
     have "x \<in> u"
       by (meson c path_component_mem(2))
     with that \<open>?rhs\<close> [rule_format, of u x]
     obtain U where U:
       "openin (top_of_set S) U \<and> x \<in> U \<and> U \<subseteq> u \<and>
        (\<forall>y. y \<in> U \<longrightarrow> (\<exists>p. path p \<and> path_image p \<subseteq> u \<and> pathstart p = x \<and> pathfinish p = y))"
        by blast
     show ?thesis
       apply (rule_tac x=U in exI)
       apply (auto simp: U)
       apply (metis U c path_component_trans path_component_def)
       done
   qed
   show ?lhs
     apply (clarsimp simp add: locally_path_connected_open_path_component)
     apply (subst openin_subopen)
     apply (blast intro: *)
     done
 qed
 
 lemma locally_path_connected_imp_locally_connected:
   "locally path_connected S \<Longrightarrow> locally connected S"
 using locally_mono path_connected_imp_connected by blast
 
 lemma locally_connected_components:
   "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally connected c"
 by (meson locally_connected_open_component locally_open_subset openin_subtopology_self)
 
 lemma locally_path_connected_components:
   "\<lbrakk>locally path_connected S; c \<in> components S\<rbrakk> \<Longrightarrow> locally path_connected c"
 by (meson locally_connected_open_component locally_open_subset locally_path_connected_imp_locally_connected openin_subtopology_self)
 
 lemma locally_path_connected_connected_component:
   "locally path_connected S \<Longrightarrow> locally path_connected (connected_component_set S x)"
 by (metis components_iff connected_component_eq_empty locally_empty locally_path_connected_components)
 
 lemma open_imp_locally_path_connected:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> locally path_connected S"
 apply (rule locally_mono [of convex])
 apply (simp_all add: locally_def openin_open_eq convex_imp_path_connected)
 apply (meson open_ball centre_in_ball convex_ball openE order_trans)
 done
 
 lemma open_imp_locally_connected:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> locally connected S"
 by (simp add: locally_path_connected_imp_locally_connected open_imp_locally_path_connected)
 
 lemma locally_path_connected_UNIV: "locally path_connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_path_connected)
 
 lemma locally_connected_UNIV: "locally connected (UNIV::'a :: real_normed_vector set)"
   by (simp add: open_imp_locally_connected)
 
 lemma openin_connected_component_locally_connected:
     "locally connected S
      \<Longrightarrow> openin (top_of_set S) (connected_component_set S x)"
 apply (simp add: locally_connected_open_connected_component)
 by (metis connected_component_eq_empty connected_component_subset open_empty open_subset openin_subtopology_self)
 
 lemma openin_components_locally_connected:
     "\<lbrakk>locally connected S; c \<in> components S\<rbrakk> \<Longrightarrow> openin (top_of_set S) c"
   using locally_connected_open_component openin_subtopology_self by blast
 
 lemma openin_path_component_locally_path_connected:
   "locally path_connected S
         \<Longrightarrow> openin (top_of_set S) (path_component_set S x)"
 by (metis (no_types) empty_iff locally_path_connected_2 openin_subopen openin_subtopology_self path_component_eq_empty)
 
 lemma closedin_path_component_locally_path_connected:
     "locally path_connected S
         \<Longrightarrow> closedin (top_of_set S) (path_component_set S x)"
 apply  (simp add: closedin_def path_component_subset complement_path_component_Union)
 apply (rule openin_Union)
 using openin_path_component_locally_path_connected by auto
 
 lemma convex_imp_locally_path_connected:
   fixes S :: "'a:: real_normed_vector set"
   shows "convex S \<Longrightarrow> locally path_connected S"
 apply (clarsimp simp add: locally_path_connected)
 apply (subst (asm) openin_open)
 apply clarify
 apply (erule (1) openE)
 apply (rule_tac x = "S \<inter> ball x e" in exI)
 apply (force simp: convex_Int convex_imp_path_connected)
 done
 
 lemma convex_imp_locally_connected:
   fixes S :: "'a:: real_normed_vector set"
   shows "convex S \<Longrightarrow> locally connected S"
   by (simp add: locally_path_connected_imp_locally_connected convex_imp_locally_path_connected)
 
 
 subsection\<open>Relations between components and path components\<close>
 
 lemma path_component_eq_connected_component:
   assumes "locally path_connected S"
     shows "(path_component S x = connected_component S x)"
 proof (cases "x \<in> S")
   case True
   have "openin (top_of_set (connected_component_set S x)) (path_component_set S x)"
     apply (rule openin_subset_trans [of S])
     apply (intro conjI openin_path_component_locally_path_connected [OF assms])
     using path_component_subset_connected_component   apply (auto simp: connected_component_subset)
     done
   moreover have "closedin (top_of_set (connected_component_set S x)) (path_component_set S x)"
     apply (rule closedin_subset_trans [of S])
     apply (intro conjI closedin_path_component_locally_path_connected [OF assms])
     using path_component_subset_connected_component   apply (auto simp: connected_component_subset)
     done
   ultimately have *: "path_component_set S x = connected_component_set S x"
     by (metis connected_connected_component connected_clopen True path_component_eq_empty)
   then show ?thesis
     by blast
 next
   case False then show ?thesis
     by (metis Collect_empty_eq_bot connected_component_eq_empty path_component_eq_empty)
 qed
 
 lemma path_component_eq_connected_component_set:
      "locally path_connected S \<Longrightarrow> (path_component_set S x = connected_component_set S x)"
 by (simp add: path_component_eq_connected_component)
 
 lemma locally_path_connected_path_component:
      "locally path_connected S \<Longrightarrow> locally path_connected (path_component_set S x)"
 using locally_path_connected_connected_component path_component_eq_connected_component by fastforce
 
 lemma open_path_connected_component:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component S x = connected_component S x"
 by (simp add: path_component_eq_connected_component open_imp_locally_path_connected)
 
 lemma open_path_connected_component_set:
   fixes S :: "'a :: real_normed_vector set"
   shows "open S \<Longrightarrow> path_component_set S x = connected_component_set S x"
 by (simp add: open_path_connected_component)
 
 proposition locally_connected_quotient_image:
   assumes lcS: "locally connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
                     openin (top_of_set (f ` S)) T"
     shows "locally connected (f ` S)"
 proof (clarsimp simp: locally_connected_open_component)
   fix U C
   assume opefSU: "openin (top_of_set (f ` S)) U" and "C \<in> components U"
   then have "C \<subseteq> U" "U \<subseteq> f ` S"
     by (meson in_components_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) C \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` C)"
     by (auto simp: oo)
   moreover have "openin (top_of_set S) (S \<inter> f -` C)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" "f x \<in> C"
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` C)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (connected_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           using \<open>U \<subseteq> f ` S\<close> opefSU lcS locally_connected_2 oo by blast
         with ** show False
           by (metis (no_types) connected_component_eq_empty empty_iff openin_subopen)
       qed
     next
       show "x \<in> connected_component_set (S \<inter> f -` U) x"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by auto
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (connected_component_set (S \<inter> f -` U) x) f"
         apply (rule continuous_on_subset)
         using connected_component_subset apply blast
         done
       then have "connected (f ` connected_component_set (S \<inter> f -` U) x)"
         by (rule connected_continuous_image [OF _ connected_connected_component])
       moreover have "f ` connected_component_set (S \<inter> f -` U) x \<subseteq> U"
         using connected_component_in by blast
       moreover have "C \<inter> f ` connected_component_set (S \<inter> f -` U) x \<noteq> {}"
         using \<open>C \<subseteq> U\<close> \<open>f x \<in> C\<close> \<open>x \<in> S\<close> by fastforce
       ultimately have fC: "f ` (connected_component_set (S \<inter> f -` U) x) \<subseteq> C"
         by (rule components_maximal [OF \<open>C \<in> components U\<close>])
       have cUC: "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)"
         using connected_component_subset fC by blast
       have "connected_component_set (S \<inter> f -` U) x \<subseteq> connected_component_set (S \<inter> f -` C) x"
       proof -
         { assume "x \<in> connected_component_set (S \<inter> f -` U) x"
           then have ?thesis
             using cUC connected_component_idemp connected_component_mono by blast }
         then show ?thesis
           using connected_component_eq_empty by auto
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` C)"
         by (rule connected_component_subset)
       finally show "connected_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` C)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) C"
     by metis
 qed
 
 text\<open>The proof resembles that above but is not identical!\<close>
 proposition locally_path_connected_quotient_image:
   assumes lcS: "locally path_connected S"
       and oo: "\<And>T. T \<subseteq> f ` S
                 \<Longrightarrow> openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow> openin (top_of_set (f ` S)) T"
     shows "locally path_connected (f ` S)"
 proof (clarsimp simp: locally_path_connected_open_path_component)
   fix U y
   assume opefSU: "openin (top_of_set (f ` S)) U" and "y \<in> U"
   then have "path_component_set U y \<subseteq> U" "U \<subseteq> f ` S"
     by (meson path_component_subset openin_imp_subset)+
   then have "openin (top_of_set (f ` S)) (path_component_set U y) \<longleftrightarrow>
              openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof -
     have "path_component_set U y \<subseteq> f ` S"
       using \<open>U \<subseteq> f ` S\<close> \<open>path_component_set U y \<subseteq> U\<close> by blast
     then show ?thesis
       using oo by blast
   qed
   moreover have "openin (top_of_set S) (S \<inter> f -` path_component_set U y)"
   proof (subst openin_subopen, clarify)
     fix x
     assume "x \<in> S" and Uyfx: "path_component U y (f x)"
     then have "f x \<in> U"
       using path_component_mem by blast
     show "\<exists>T. openin (top_of_set S) T \<and> x \<in> T \<and> T \<subseteq> (S \<inter> f -` path_component_set U y)"
     proof (intro conjI exI)
       show "openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
       proof (rule ccontr)
         assume **: "\<not> openin (top_of_set S) (path_component_set (S \<inter> f -` U) x)"
         then have "x \<notin> (S \<inter> f -` U)"
           by (metis (no_types, lifting) \<open>U \<subseteq> f ` S\<close> opefSU lcS oo locally_path_connected_open_path_component)
         then show False
           using ** \<open>path_component_set U y \<subseteq> U\<close>  \<open>x \<in> S\<close> \<open>path_component U y (f x)\<close> by blast
       qed
     next
       show "x \<in> path_component_set (S \<inter> f -` U) x"
         by (simp add: \<open>f x \<in> U\<close> \<open>x \<in> S\<close> path_component_refl)
     next
       have contf: "continuous_on S f"
         by (simp add: continuous_on_open oo openin_imp_subset)
       then have "continuous_on (path_component_set (S \<inter> f -` U) x) f"
         apply (rule continuous_on_subset)
         using path_component_subset apply blast
         done
       then have "path_connected (f ` path_component_set (S \<inter> f -` U) x)"
         by (simp add: path_connected_continuous_image)
       moreover have "f ` path_component_set (S \<inter> f -` U) x \<subseteq> U"
         using path_component_mem by fastforce
       moreover have "f x \<in> f ` path_component_set (S \<inter> f -` U) x"
         by (force simp: \<open>x \<in> S\<close> \<open>f x \<in> U\<close> path_component_refl_eq)
       ultimately have "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U (f x)"
         by (meson path_component_maximal)
        also have  "\<dots> \<subseteq> path_component_set U y"
         by (simp add: Uyfx path_component_maximal path_component_subset path_component_sym)
       finally have fC: "f ` (path_component_set (S \<inter> f -` U) x) \<subseteq> path_component_set U y" .
       have cUC: "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)"
         using path_component_subset fC by blast
       have "path_component_set (S \<inter> f -` U) x \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) x"
       proof -
         have "\<And>a. path_component_set (path_component_set (S \<inter> f -` U) x) a \<subseteq> path_component_set (S \<inter> f -` path_component_set U y) a"
           using cUC path_component_mono by blast
         then show ?thesis
           using path_component_path_component by blast
       qed
       also have "\<dots> \<subseteq> (S \<inter> f -` path_component_set U y)"
         by (rule path_component_subset)
       finally show "path_component_set (S \<inter> f -` U) x \<subseteq> (S \<inter> f -` path_component_set U y)" .
     qed
   qed
   ultimately show "openin (top_of_set (f ` S)) (path_component_set U y)"
     by metis
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Components, continuity, openin, closedin\<close>
 
 lemma continuous_on_components_gen:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "\<And>c. c \<in> components S \<Longrightarrow>
               openin (top_of_set S) c \<and> continuous_on c f"
     shows "continuous_on S f"
 proof (clarsimp simp: continuous_openin_preimage_eq)
   fix t :: "'b set"
   assume "open t"
   have *: "S \<inter> f -` t = (\<Union>c \<in> components S. c \<inter> f -` t)"
     by auto
   show "openin (top_of_set S) (S \<inter> f -` t)"
     unfolding * using \<open>open t\<close> assms continuous_openin_preimage_gen openin_trans openin_Union by blast
 qed
 
 lemma continuous_on_components:
  fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   assumes "locally connected S "
           "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
     shows "continuous_on S f"
 apply (rule continuous_on_components_gen)
 apply (auto simp: assms intro: openin_components_locally_connected)
 done
 
 lemma continuous_on_components_eq:
     "locally connected S
      \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 by (meson continuous_on_components continuous_on_subset in_components_subset)
 
 lemma continuous_on_components_open:
  fixes S :: "'a::real_normed_vector set"
   assumes "open S "
           "\<And>c. c \<in> components S \<Longrightarrow> continuous_on c f"
     shows "continuous_on S f"
 using continuous_on_components open_imp_locally_connected assms by blast
 
 lemma continuous_on_components_open_eq:
   fixes S :: "'a::real_normed_vector set"
   shows "open S \<Longrightarrow> (continuous_on S f \<longleftrightarrow> (\<forall>c \<in> components S. continuous_on c f))"
 using continuous_on_subset in_components_subset
 by (blast intro: continuous_on_components_open)
 
 lemma closedin_union_complement_components:
   assumes u: "locally connected u"
       and S: "closedin (top_of_set u) S"
       and cuS: "c \<subseteq> components(u - S)"
     shows "closedin (top_of_set u) (S \<union> \<Union>c)"
 proof -
   have di: "(\<And>S t. S \<in> c \<and> t \<in> c' \<Longrightarrow> disjnt S t) \<Longrightarrow> disjnt (\<Union> c) (\<Union> c')" for c'
     by (simp add: disjnt_def) blast
   have "S \<subseteq> u"
     using S closedin_imp_subset by blast
   moreover have "u - S = \<Union>c \<union> \<Union>(components (u - S) - c)"
     by (metis Diff_partition Union_components Union_Un_distrib assms(3))
   moreover have "disjnt (\<Union>c) (\<Union>(components (u - S) - c))"
     apply (rule di)
     by (metis DiffD1 DiffD2 assms(3) components_nonoverlap disjnt_def subsetCE)
   ultimately have eq: "S \<union> \<Union>c = u - (\<Union>(components(u - S) - c))"
     by (auto simp: disjnt_def)
   have *: "openin (top_of_set u) (\<Union>(components (u - S) - c))"
     apply (rule openin_Union)
     apply (rule openin_trans [of "u - S"])
     apply (simp add: u S locally_diff_closed openin_components_locally_connected)
     apply (simp add: openin_diff S)
     done
   have "openin (top_of_set u) (u - (u - \<Union>(components (u - S) - c)))"
     apply (rule openin_diff, simp)
     apply (metis closedin_diff closedin_topspace topspace_euclidean_subtopology *)
     done
   then show ?thesis
     by (force simp: eq closedin_def)
 qed
 
 lemma closed_union_complement_components:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: "c \<subseteq> components(- S)"
     shows "closed(S \<union> \<Union> c)"
 proof -
   have "closedin (top_of_set UNIV) (S \<union> \<Union>c)"
     apply (rule closedin_union_complement_components [OF locally_connected_UNIV])
     using S c apply (simp_all add: Compl_eq_Diff_UNIV)
     done
   then show ?thesis by simp
 qed
 
 lemma closedin_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes u: "locally connected u"
       and S: "closedin (top_of_set u) S"
       and c: " c \<in> components(u - S)"
     shows "closedin (top_of_set u) (S \<union> c)"
 proof -
   have "closedin (top_of_set u) (S \<union> \<Union>{c})"
     using c by (blast intro: closedin_union_complement_components [OF u S])
   then show ?thesis
     by simp
 qed
 
 lemma closed_Un_complement_component:
   fixes S :: "'a::real_normed_vector set"
   assumes S: "closed S" and c: " c \<in> components(-S)"
     shows "closed (S \<union> c)"
   by (metis Compl_eq_Diff_UNIV S c closed_closedin closedin_Un_complement_component
       locally_connected_UNIV subtopology_UNIV)
 
 
 subsection\<open>Existence of isometry between subspaces of same dimension\<close>
 
 lemma isometry_subset_subspace:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S \<le> dim T"
   obtains f where "linear f" "f ` S \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_finite)
   obtain fb where "fb ` B \<subseteq> C" "inj_on fb B"
     by (metis \<open>card B = dim S\<close> \<open>card C = dim T\<close> \<open>finite B\<close> \<open>finite C\<close> card_le_inj d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth
     apply (auto simp: pairwise_def orthogonal_clauses)
     by (meson subsetD image_eqI inj_on_def)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>fb ` B \<subseteq> C\<close> ffb image_cong span_mono)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close> span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>fb ` B \<subseteq> C\<close> by auto
   have "norm (f x) = norm x" if "x \<in> S" for x
   proof -
     interpret linear f by fact
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "norm (f x)^2 = norm (\<Sum>v\<in>B. a v *\<^sub>R fb v)^2" by (simp add: sum scale ffb x)
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
       apply (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       apply (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
       done
     also have "\<dots> = norm x ^2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show ?thesis
       by (simp add: norm_eq_sqrt_inner)
   qed
   then show ?thesis
     by (rule that [OF \<open>linear f\<close> \<open>f ` S \<subseteq> T\<close>])
 qed
 
 proposition isometries_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                     "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
                     "\<And>x. x \<in> T \<Longrightarrow> norm(g x) = norm x"
                     "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
                     "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
 proof -
   obtain B where "B \<subseteq> S" and Borth: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" "finite B" "card B = dim S" "span B = S"
     by (metis orthonormal_basis_subspace [OF S] independent_finite)
   obtain C where "C \<subseteq> T" and Corth: "pairwise orthogonal C"
              and C1:"\<And>x. x \<in> C \<Longrightarrow> norm x = 1"
              and "independent C" "finite C" "card C = dim T" "span C = T"
     by (metis orthonormal_basis_subspace [OF T] independent_finite)
   obtain fb where "bij_betw fb B C"
     by (metis \<open>finite B\<close> \<open>finite C\<close> bij_betw_iff_card \<open>card B = dim S\<close> \<open>card C = dim T\<close> d)
   then have pairwise_orth_fb: "pairwise (\<lambda>v j. orthogonal (fb v) (fb j)) B"
     using Corth
     apply (auto simp: pairwise_def orthogonal_clauses bij_betw_def)
     by (meson subsetD image_eqI inj_on_def)
   obtain f where "linear f" and ffb: "\<And>x. x \<in> B \<Longrightarrow> f x = fb x"
     using linear_independent_extend \<open>independent B\<close> by fastforce
   interpret f: linear f by fact
   define gb where "gb \<equiv> inv_into B fb"
   then have pairwise_orth_gb: "pairwise (\<lambda>v j. orthogonal (gb v) (gb j)) C"
     using Borth
     apply (auto simp: pairwise_def orthogonal_clauses bij_betw_def)
     by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on bij_betw_inv_into_right inv_into_into)
   obtain g where "linear g" and ggb: "\<And>x. x \<in> C \<Longrightarrow> g x = gb x"
     using linear_independent_extend \<open>independent C\<close> by fastforce
   interpret g: linear g by fact
   have "span (f ` B) \<subseteq> span C"
     by (metis \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on eq_iff ffb image_cong)
   then have "f ` S \<subseteq> T"
     unfolding \<open>span B = S\<close> \<open>span C = T\<close>
       span_linear_image[OF \<open>linear f\<close>] .
   have [simp]: "\<And>x. x \<in> B \<Longrightarrow> norm (fb x) = norm x"
     using B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on by fastforce
   have f [simp]: "norm (f x) = norm x" "g (f x) = x" if "x \<in> S" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> B. a v *\<^sub>R v)"
       using \<open>finite B\<close> \<open>span B = S\<close> \<open>x \<in> S\<close> span_finite by fastforce
     have "f x = (\<Sum>v \<in> B. f (a v *\<^sub>R v))"
       using linear_sum [OF \<open>linear f\<close>] x by auto
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R f v)"
       by (simp add: f.sum f.scale)
     also have "\<dots> = (\<Sum>v \<in> B. a v *\<^sub>R fb v)"
       by (simp add: ffb cong: sum.cong)
     finally have *: "f x = (\<Sum>v\<in>B. a v *\<^sub>R fb v)" .
     then have "(norm (f x))\<^sup>2 = (norm (\<Sum>v\<in>B. a v *\<^sub>R fb v))\<^sup>2" by simp
     also have "\<dots> = (\<Sum>v\<in>B. norm ((a v *\<^sub>R fb v))^2)"
       apply (rule norm_sum_Pythagorean [OF \<open>finite B\<close>])
       apply (rule pairwise_ortho_scaleR [OF pairwise_orth_fb])
       done
     also have "\<dots> = (norm x)\<^sup>2"
       by (simp add: x pairwise_ortho_scaleR Borth norm_sum_Pythagorean [OF \<open>finite B\<close>])
     finally show "norm (f x) = norm x"
       by (simp add: norm_eq_sqrt_inner)
     have "g (f x) = g (\<Sum>v\<in>B. a v *\<^sub>R fb v)" by (simp add: *)
     also have "\<dots> = (\<Sum>v\<in>B. g (a v *\<^sub>R fb v))"
       by (simp add: g.sum g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R g (fb v))"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v\<in>B. a v *\<^sub>R v)"
       apply (rule sum.cong [OF refl])
       using \<open>bij_betw fb B C\<close> gb_def bij_betwE bij_betw_inv_into_left gb_def ggb by fastforce
     also have "\<dots> = x"
       using x by blast
     finally show "g (f x) = x" .
   qed
   have [simp]: "\<And>x. x \<in> C \<Longrightarrow> norm (gb x) = norm x"
     by (metis B1 C1 \<open>bij_betw fb B C\<close> bij_betw_imp_surj_on gb_def inv_into_into)
   have g [simp]: "f (g x) = x" if "x \<in> T" for x
   proof -
     obtain a where x: "x = (\<Sum>v \<in> C. a v *\<^sub>R v)"
       using \<open>finite C\<close> \<open>span C = T\<close> \<open>x \<in> T\<close> span_finite by fastforce
     have "g x = (\<Sum>v \<in> C. g (a v *\<^sub>R v))"
       by (simp add: x g.sum)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R g v)"
       by (simp add: g.scale)
     also have "\<dots> = (\<Sum>v \<in> C. a v *\<^sub>R gb v)"
       by (simp add: ggb cong: sum.cong)
     finally have "f (g x) = f (\<Sum>v\<in>C. a v *\<^sub>R gb v)" by simp
     also have "\<dots> = (\<Sum>v\<in>C. f (a v *\<^sub>R gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R f (gb v))"
       by (simp add: f.scale f.sum)
     also have "\<dots> = (\<Sum>v\<in>C. a v *\<^sub>R v)"
       using \<open>bij_betw fb B C\<close>
       by (simp add: bij_betw_def gb_def bij_betw_inv_into_right ffb inv_into_into)
     also have "\<dots> = x"
       using x by blast
     finally show "f (g x) = x" .
   qed
   have gim: "g ` T = S"
     by (metis (full_types) S T \<open>f ` S \<subseteq> T\<close> d dim_eq_span dim_image_le f(2) g.linear_axioms
         image_iff linear_subspace_image span_eq_iff subset_iff)
   have fim: "f ` S = T"
     using \<open>g ` T = S\<close> image_iff by fastforce
   have [simp]: "norm (g x) = norm x" if "x \<in> T" for x
     using fim that by auto
   show ?thesis
     apply (rule that [OF \<open>linear f\<close> \<open>linear g\<close>])
     apply (simp_all add: fim gim)
     done
 qed
 
 corollary isometry_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
   obtains f where "linear f" "f ` S = T" "\<And>x. x \<in> S \<Longrightarrow> norm(f x) = norm x"
 using isometries_subspaces [OF assms]
 by metis
 
 corollary isomorphisms_UNIV_UNIV:
   assumes "DIM('M) = DIM('N)"
   obtains f::"'M::euclidean_space \<Rightarrow>'N::euclidean_space" and g
   where "linear f" "linear g"
                     "\<And>x. norm(f x) = norm x" "\<And>y. norm(g y) = norm y"
                     "\<And>x. g (f x) = x" "\<And>y. f(g y) = y"
   using assms by (auto intro: isometries_subspaces [of "UNIV::'M set" "UNIV::'N set"])
 
 lemma homeomorphic_subspaces:
   fixes S :: "'a::euclidean_space set"
     and T :: "'b::euclidean_space set"
   assumes S: "subspace S"
       and T: "subspace T"
       and d: "dim S = dim T"
     shows "S homeomorphic T"
 proof -
   obtain f g where "linear f" "linear g" "f ` S = T" "g ` T = S"
                    "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x" "\<And>x. x \<in> T \<Longrightarrow> f(g x) = x"
     by (blast intro: isometries_subspaces [OF assms])
   then show ?thesis
     apply (simp add: homeomorphic_def homeomorphism_def)
     apply (rule_tac x=f in exI)
     apply (rule_tac x=g in exI)
     apply (auto simp: linear_continuous_on linear_conv_bounded_linear)
     done
 qed
 
 lemma homeomorphic_affine_sets:
   assumes "affine S" "affine T" "aff_dim S = aff_dim T"
     shows "S homeomorphic T"
 proof (cases "S = {} \<or> T = {}")
   case True  with assms aff_dim_empty homeomorphic_empty show ?thesis
     by metis
 next
   case False
   then obtain a b where ab: "a \<in> S" "b \<in> T" by auto
   then have ss: "subspace ((+) (- a) ` S)" "subspace ((+) (- b) ` T)"
     using affine_diffs_subspace assms by blast+
   have dd: "dim ((+) (- a) ` S) = dim ((+) (- b) ` T)"
     using assms ab  by (simp add: aff_dim_eq_dim  [OF hull_inc] image_def)
   have "S homeomorphic ((+) (- a) ` S)"
     by (fact homeomorphic_translation)
   also have "\<dots> homeomorphic ((+) (- b) ` T)"
     by (rule homeomorphic_subspaces [OF ss dd])
   also have "\<dots> homeomorphic T"
     using homeomorphic_translation [of T "- b"] by (simp add: homeomorphic_sym [of T])
   finally show ?thesis .
 qed
 
 
 subsection\<open>Retracts, in a general sense, preserve (co)homotopic triviality)\<close>
 
 locale\<^marker>\<open>tag important\<close> Retracts =
   fixes s h t k
   assumes conth: "continuous_on s h"
       and imh: "h ` s = t"
       and contk: "continuous_on t k"
       and imk: "k ` t \<subseteq> s"
       and idhk: "\<And>y. y \<in> t \<Longrightarrow> h(k y) = y"
 
 begin
 
 lemma homotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> u \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f;
                        continuous_on u g; g ` u \<subseteq> s; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P u s f g"
       and contf: "continuous_on u f" and imf: "f ` u \<subseteq> t" and Qf: "Q f"
       and contg: "continuous_on u g" and img: "g ` u \<subseteq> t" and Qg: "Q g"
     shows "homotopic_with_canon Q u t f g"
 proof -
   have feq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
   have geq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> g)) x = g x" using idhk img by auto
   have "continuous_on u (k \<circ> f)"
     using contf continuous_on_compose continuous_on_subset contk imf by blast
   moreover have "(k \<circ> f) ` u \<subseteq> s"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on u (k \<circ> g)"
     using contg continuous_on_compose continuous_on_subset contk img by blast
   moreover have "(k \<circ> g) ` u \<subseteq> s"
     using img imk by fastforce
   moreover have "P (k \<circ> g)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P u s (k \<circ> f) (k \<circ> g)"
     by (rule hom)
   then have "homotopic_with_canon Q u t (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q by (auto simp: conth imh)
   then show ?thesis
     apply (rule homotopic_with_eq)
     using feq geq apply fastforce+
     using Qeq topspace_euclidean_subtopology by blast
 qed
 
 lemma homotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> t; Q f\<rbrakk> \<Longrightarrow> P(k \<circ> f)"
       and Q: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk> \<Longrightarrow> Q(h \<circ> f)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> u \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s; P f\<rbrakk>
                      \<Longrightarrow> \<exists>c. homotopic_with_canon P u s f (\<lambda>x. c)"
       and contf: "continuous_on u f" and imf:"f ` u \<subseteq> t" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q u t f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> u \<Longrightarrow> (h \<circ> (k \<circ> f)) x = f x" using idhk imf by auto
   have "continuous_on u (k \<circ> f)"
     using contf continuous_on_compose continuous_on_subset contk imf by blast
   moreover have "(k \<circ> f) ` u \<subseteq> s"
     using imf imk by fastforce
   moreover have "P (k \<circ> f)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P u s (k \<circ> f) (\<lambda>x. c)"
     by (metis hom)
   then have "homotopic_with_canon Q u t (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono])
     using Q by (auto simp: conth imh)
   then show ?thesis
     apply (rule_tac c = "h c" in that)
     apply (erule homotopic_with_eq)
     using feq apply auto[1]
     apply simp
     using Qeq topspace_euclidean_subtopology by blast
 qed
 
 lemma cohomotopically_trivial_retraction_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> u; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f;
                        continuous_on s g; g ` s \<subseteq> u; P g\<rbrakk>
                        \<Longrightarrow> homotopic_with_canon P s u f g"
       and contf: "continuous_on t f" and imf: "f ` t \<subseteq> u" and Qf: "Q f"
       and contg: "continuous_on t g" and img: "g ` t \<subseteq> u" and Qg: "Q g"
     shows "homotopic_with_canon Q t u f g"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have geq: "\<And>x. x \<in> t \<Longrightarrow> (g \<circ> h \<circ> k) x = g x" using idhk img by auto
   have "continuous_on s (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) ` s \<subseteq> u"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   moreover have "continuous_on s (g \<circ> h)"
     using contg continuous_on_compose continuous_on_subset conth imh by blast
   moreover have "(g \<circ> h) ` s \<subseteq> u"
     using img imh by fastforce
   moreover have "P (g \<circ> h)"
     by (simp add: P Qg contg img)
   ultimately have "homotopic_with_canon P s u (f \<circ> h) (g \<circ> h)"
     by (rule hom)
   then have "homotopic_with_canon Q t u (f \<circ> h \<circ> k) (g \<circ> h \<circ> k)"
     apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     using Q by (auto simp: contk imk)
   then show ?thesis
     apply (rule homotopic_with_eq)
     using feq apply auto[1]
     using geq apply auto[1]
     using Qeq topspace_euclidean_subtopology by blast
 qed
 
 lemma cohomotopically_trivial_retraction_null_gen:
   assumes P: "\<And>f. \<lbrakk>continuous_on t f; f ` t \<subseteq> u; Q f\<rbrakk> \<Longrightarrow> P(f \<circ> h)"
       and Q: "\<And>f. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk> \<Longrightarrow> Q(f \<circ> k)"
       and Qeq: "\<And>h k. (\<And>x. x \<in> t \<Longrightarrow> h x = k x) \<Longrightarrow> Q h = Q k"
       and hom: "\<And>f g. \<lbrakk>continuous_on s f; f ` s \<subseteq> u; P f\<rbrakk>
                        \<Longrightarrow> \<exists>c. homotopic_with_canon P s u f (\<lambda>x. c)"
       and contf: "continuous_on t f" and imf: "f ` t \<subseteq> u" and Qf: "Q f"
   obtains c where "homotopic_with_canon Q t u f (\<lambda>x. c)"
 proof -
   have feq: "\<And>x. x \<in> t \<Longrightarrow> (f \<circ> h \<circ> k) x = f x" using idhk imf by auto
   have "continuous_on s (f \<circ> h)"
     using contf conth continuous_on_compose imh by blast
   moreover have "(f \<circ> h) ` s \<subseteq> u"
     using imf imh by fastforce
   moreover have "P (f \<circ> h)"
     by (simp add: P Qf contf imf)
   ultimately obtain c where "homotopic_with_canon P s u (f \<circ> h) (\<lambda>x. c)"
     by (metis hom)
   then have "homotopic_with_canon Q t u (f \<circ> h \<circ> k) ((\<lambda>x. c) \<circ> k)"
     apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono])
     using Q by (auto simp: contk imk)
   then show ?thesis
     apply (rule_tac c = c in that)
     apply (erule homotopic_with_eq)
     using feq apply auto[1]
     apply simp
     using Qeq topspace_euclidean_subtopology by blast
 qed
 
 end
 
 lemma simply_connected_retraction_gen:
   shows "\<lbrakk>simply_connected 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\<rbrakk>
         \<Longrightarrow> simply_connected T"
 apply (simp add: simply_connected_def path_def path_image_def homotopic_loops_def, clarify)
 apply (rule Retracts.homotopically_trivial_retraction_gen
         [of S h _ k _ "\<lambda>p. pathfinish p = pathstart p"  "\<lambda>p. pathfinish p = pathstart p"])
 apply (simp_all add: Retracts_def pathfinish_def pathstart_def)
 done
 
 lemma homeomorphic_simply_connected:
     "\<lbrakk>S homeomorphic T; simply_connected S\<rbrakk> \<Longrightarrow> simply_connected T"
   by (auto simp: homeomorphic_def homeomorphism_def intro: simply_connected_retraction_gen)
 
 lemma homeomorphic_simply_connected_eq:
     "S homeomorphic T \<Longrightarrow> (simply_connected S \<longleftrightarrow> simply_connected T)"
   by (metis homeomorphic_simply_connected homeomorphic_sym)
 
 
 subsection\<open>Homotopy equivalence\<close>
 
 subsection\<open>Homotopy equivalence of topological spaces.\<close>
 
 definition\<^marker>\<open>tag important\<close> homotopy_equivalent_space
              (infix "homotopy'_equivalent'_space" 50)
   where "X homotopy_equivalent_space Y \<equiv>
         (\<exists>f g. continuous_map X Y f \<and>
               continuous_map Y X g \<and>
               homotopic_with (\<lambda>x. True) X X (g \<circ> f) id \<and>
               homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id)"
 
 lemma homeomorphic_imp_homotopy_equivalent_space:
   "X homeomorphic_space Y \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homeomorphic_space_def homotopy_equivalent_space_def
   apply (erule ex_forward)+
   by (simp add: homotopic_with_equal homotopic_with_sym homeomorphic_maps_def)
 
 lemma homotopy_equivalent_space_refl:
    "X homotopy_equivalent_space X"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homeomorphic_space_refl)
 
 lemma homotopy_equivalent_space_sym:
    "X homotopy_equivalent_space Y \<longleftrightarrow> Y homotopy_equivalent_space X"
   by (meson homotopy_equivalent_space_def)
 
 lemma homotopy_eqv_trans [trans]:
   assumes 1: "X homotopy_equivalent_space Y" and 2: "Y homotopy_equivalent_space U"
     shows "X homotopy_equivalent_space U"
 proof -
   obtain f1 g1 where f1: "continuous_map X Y f1"
                  and g1: "continuous_map Y X g1"
                  and hom1: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> f1) id"
                            "homotopic_with (\<lambda>x. True) Y Y (f1 \<circ> g1) id"
     using 1 by (auto simp: homotopy_equivalent_space_def)
   obtain f2 g2 where f2: "continuous_map Y U f2"
                  and g2: "continuous_map U Y g2"
                  and hom2: "homotopic_with (\<lambda>x. True) Y Y (g2 \<circ> f2) id"
                            "homotopic_with (\<lambda>x. True) U U (f2 \<circ> g2) id"
     using 2 by (auto simp: homotopy_equivalent_space_def)
   have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> f2 \<circ> f1) (id \<circ> f1)"
     using f1 hom2(1) homotopic_compose_continuous_map_right by blast
   then have "homotopic_with (\<lambda>f. True) X Y (g2 \<circ> (f2 \<circ> f1)) (id \<circ> f1)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) X X
          (g1 \<circ> (g2 \<circ> (f2 \<circ> f1))) (g1 \<circ> (id \<circ> f1))"
     by (simp add: g1 homotopic_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) X X (g1 \<circ> id \<circ> f1) id"
     using hom1 by simp
   ultimately have SS: "homotopic_with (\<lambda>x. True) X X (g1 \<circ> g2 \<circ> (f2 \<circ> f1)) id"
     apply (simp add: o_assoc)
     apply (blast intro: homotopic_with_trans)
     done
   have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> g1 \<circ> g2) (id \<circ> g2)"
     using g2 hom1(2) homotopic_with_compose_continuous_map_right by fastforce
   then have "homotopic_with (\<lambda>f. True) U Y (f1 \<circ> (g1 \<circ> g2)) (id \<circ> g2)"
     by (simp add: o_assoc)
   then have "homotopic_with (\<lambda>x. True) U U
          (f2 \<circ> (f1 \<circ> (g1 \<circ> g2))) (f2 \<circ> (id \<circ> g2))"
     by (simp add: f2 homotopic_with_compose_continuous_map_left)
   moreover have "homotopic_with (\<lambda>x. True) U U (f2 \<circ> id \<circ> g2) id"
     using hom2 by simp
   ultimately have UU: "homotopic_with (\<lambda>x. True) U U (f2 \<circ> f1 \<circ> (g1 \<circ> g2)) id"
     apply (simp add: o_assoc)
     apply (blast intro: homotopic_with_trans)
     done
   show ?thesis
     unfolding homotopy_equivalent_space_def
     by (blast intro: f1 f2 g1 g2 continuous_map_compose SS UU)
 qed
 
 lemma deformation_retraction_imp_homotopy_equivalent_space:
   "\<lbrakk>homotopic_with (\<lambda>x. True) X X (s \<circ> r) id; retraction_maps X Y r s\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   unfolding homotopy_equivalent_space_def retraction_maps_def
   apply (rule_tac x=r in exI)
   apply (rule_tac x=s in exI)
   apply (auto simp: homotopic_with_equal continuous_map_compose)
   done
 
 lemma deformation_retract_imp_homotopy_equivalent_space:
    "\<lbrakk>homotopic_with (\<lambda>x. True) X X r id; retraction_maps X Y r id\<rbrakk>
     \<Longrightarrow> X homotopy_equivalent_space Y"
   using deformation_retraction_imp_homotopy_equivalent_space by force
 
 lemma deformation_retract_of_space:
   "S \<subseteq> topspace X \<and>
    (\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id) \<longleftrightarrow>
    S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` (topspace X) \<subseteq> S)"
 proof (cases "S \<subseteq> topspace X")
   case True
   moreover have "(\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id)
              \<longleftrightarrow> (S retract_of_space X \<and> (\<exists>f. homotopic_with (\<lambda>x. True) X X id f \<and> f ` topspace X \<subseteq> S))"
     unfolding retract_of_space_def
   proof safe
     fix f r
     assume f: "homotopic_with (\<lambda>x. True) X X id f"
       and fS: "f ` topspace X \<subseteq> S"
       and r: "continuous_map X (subtopology X S) r"
       and req: "\<forall>x\<in>S. r x = x"
     show "\<exists>r. homotopic_with (\<lambda>x. True) X X id r \<and> retraction_maps X (subtopology X S) r id"
     proof (intro exI conjI)
       have "homotopic_with (\<lambda>x. True) X X f r"
         proof (rule homotopic_with_eq)
           show "homotopic_with (\<lambda>x. True) X X (r \<circ> f) (r \<circ> id)"
             using homotopic_with_symD continuous_map_into_fulltopology f homotopic_compose_continuous_map_left r by blast
           show "f x = (r \<circ> f) x" if "x \<in> topspace X" for x
             using that fS req by auto
         qed auto
       then show "homotopic_with (\<lambda>x. True) X X id r"
         by (rule homotopic_with_trans [OF f])
     next
       show "retraction_maps X (subtopology X S) r id"
-        by (simp add: r req retraction_maps_def topspace_subtopology)
+        by (simp add: r req retraction_maps_def)
     qed
   qed (use True in \<open>auto simp: retraction_maps_def topspace_subtopology_subset continuous_map_in_subtopology\<close>)
   ultimately show ?thesis by simp
 qed (auto simp: retract_of_space_def retraction_maps_def)
 
 
 
 subsection\<open>Contractible spaces\<close>
 
 text\<open>The definition (which agrees with "contractible" on subsets of Euclidean space)
 is a little cryptic because we don't in fact assume that the constant "a" is in the space.
 This forces the convention that the empty space / set is contractible, avoiding some special cases. \<close>
 
 definition contractible_space where
   "contractible_space X \<equiv> \<exists>a. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
 
 lemma contractible_space_top_of_set [simp]:"contractible_space (top_of_set S) \<longleftrightarrow> contractible S"
   by (auto simp: contractible_space_def contractible_def)
 
 lemma contractible_space_empty:
    "topspace X = {} \<Longrightarrow> contractible_space X"
   apply (simp add: contractible_space_def homotopic_with_def)
   apply (rule_tac x=undefined in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else undefined" in exI)
   apply (auto simp: continuous_map_on_empty)
   done
 
 lemma contractible_space_singleton:
   "topspace X = {a} \<Longrightarrow> contractible_space X"
   apply (simp add: contractible_space_def homotopic_with_def)
   apply (rule_tac x=a in exI)
   apply (rule_tac x="\<lambda>(t,x). if t = 0 then x else a" in exI)
   apply (auto intro: continuous_map_eq [where f = "\<lambda>z. a"])
   done
 
 lemma contractible_space_subset_singleton:
    "topspace X \<subseteq> {a} \<Longrightarrow> contractible_space X"
   by (meson contractible_space_empty contractible_space_singleton subset_singletonD)
 
 lemma contractible_space_subtopology_singleton:
    "contractible_space(subtopology X {a})"
   by (meson contractible_space_subset_singleton insert_subset path_connectedin_singleton path_connectedin_subtopology subsetI)
 
 lemma contractible_space:
    "contractible_space X \<longleftrightarrow>
         topspace X = {} \<or>
         (\<exists>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))"
 proof (cases "topspace X = {}")
   case False
   then show ?thesis
     apply (auto simp: contractible_space_def)
     using homotopic_with_imp_continuous_maps by fastforce
 qed (simp add: contractible_space_empty)
 
 lemma contractible_imp_path_connected_space:
   assumes "contractible_space X" shows "path_connected_space X"
 proof (cases "topspace X = {}")
   case False
   have *: "path_connected_space X"
     if "a \<in> topspace X" and conth: "continuous_map (prod_topology (top_of_set {0..1}) X) X h"
       and h: "\<forall>x. h (0, x) = x" "\<forall>x. h (1, x) = a"
     for a and h :: "real \<times> 'a \<Rightarrow> 'a"
   proof -
     have "path_component_of X b a" if "b \<in> topspace X" for b
       using that unfolding path_component_of_def
       apply (rule_tac x="h \<circ> (\<lambda>x. (x,b))" in exI)
       apply (simp add: h pathin_def)
       apply (rule continuous_map_compose [OF _ conth])
       apply (auto simp: continuous_map_pairwise intro!: continuous_intros continuous_map_compose continuous_map_id [unfolded id_def])
       done
   then show ?thesis
     by (metis path_component_of_equiv path_connected_space_iff_path_component)
   qed
   show ?thesis
     using assms False by (auto simp: contractible_space homotopic_with_def *)
 qed (simp add: path_connected_space_topspace_empty)
 
 lemma contractible_imp_connected_space:
    "contractible_space X \<Longrightarrow> connected_space X"
   by (simp add: contractible_imp_path_connected_space path_connected_imp_connected_space)
 
 lemma contractible_space_alt:
    "contractible_space X \<longleftrightarrow> (\<forall>a \<in> topspace X. homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a))" (is "?lhs = ?rhs")
 proof
   assume X: ?lhs
   then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     by (auto simp: contractible_space_def)
   show ?rhs
   proof
     show "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. b)" if "b \<in> topspace X" for b
       apply (rule homotopic_with_trans [OF a])
       using homotopic_constant_maps path_connected_space_imp_path_component_of
       by (metis (full_types) X a continuous_map_const contractible_imp_path_connected_space homotopic_with_imp_continuous_maps that)
   qed
 next
   assume R: ?rhs
   then show ?lhs
     apply (simp add: contractible_space_def)
     by (metis equals0I homotopic_on_emptyI)
 qed
 
 
 lemma compose_const [simp]: "f \<circ> (\<lambda>x. a) = (\<lambda>x. f a)" "(\<lambda>x. a) \<circ> g = (\<lambda>x. a)"
   by (simp_all add: o_def)
 
 lemma nullhomotopic_through_contractible_space:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y Z g" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Z (g \<circ> f) (\<lambda>x. c)"
 proof -
   obtain b where b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
     using Y by (auto simp: contractible_space_def)
   show thesis
     using homotopic_compose_continuous_map_right
            [OF homotopic_compose_continuous_map_left [OF b g] f]
     by (simp add: that)
 qed
 
 lemma nullhomotopic_into_contractible_space:
   assumes f: "continuous_map X Y f" and Y: "contractible_space Y"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF f _ Y]
   by (metis continuous_map_id id_comp)
 
 lemma nullhomotopic_from_contractible_space:
   assumes f: "continuous_map X Y f" and X: "contractible_space X"
   obtains c where "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
   using nullhomotopic_through_contractible_space [OF _ f X]
   by (metis comp_id continuous_map_id)
 
 lemma homotopy_dominated_contractibility:
   assumes f: "continuous_map X Y f" and g: "continuous_map Y X g"
     and hom: "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) id" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain c where c: "homotopic_with (\<lambda>h. True) X Y f (\<lambda>x. c)"
     using nullhomotopic_from_contractible_space [OF f X] .
   have "homotopic_with (\<lambda>x. True) Y Y (f \<circ> g) (\<lambda>x. c)"
     using homotopic_compose_continuous_map_right [OF c g] by fastforce
   then have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. c)"
     using homotopic_with_trans [OF _ hom] homotopic_with_symD by blast
   then show ?thesis
     unfolding contractible_space_def ..
 qed
 
 lemma homotopy_equivalent_space_contractibility:
    "X homotopy_equivalent_space Y \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   unfolding homotopy_equivalent_space_def
   by (blast intro: homotopy_dominated_contractibility)
 
 lemma homeomorphic_space_contractibility:
    "X homeomorphic_space Y
         \<Longrightarrow> (contractible_space X \<longleftrightarrow> contractible_space Y)"
   by (simp add: homeomorphic_imp_homotopy_equivalent_space homotopy_equivalent_space_contractibility)
 
 lemma contractible_eq_homotopy_equivalent_singleton_subtopology:
    "contractible_space X \<longleftrightarrow>
         topspace X = {} \<or> (\<exists>a \<in> topspace X. X homotopy_equivalent_space (subtopology X {a}))"(is "?lhs = ?rhs")
 proof (cases "topspace X = {}")
   case False
   show ?thesis
   proof
     assume ?lhs
     then obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
       by (auto simp: contractible_space_def)
     then have "a \<in> topspace X"
       by (metis False continuous_map_const homotopic_with_imp_continuous_maps)
     then have "X homotopy_equivalent_space subtopology X {a}"
       unfolding homotopy_equivalent_space_def
       apply (rule_tac x="\<lambda>x. a" in exI)
       apply (rule_tac x=id in exI)
       apply (auto simp: homotopic_with_sym topspace_subtopology_subset a)
       using connectedin_absolute connectedin_sing contractible_space_alt contractible_space_subtopology_singleton by fastforce
     with \<open>a \<in> topspace X\<close> show ?rhs
       by blast
   next
     assume ?rhs
     then show ?lhs
       by (meson False contractible_space_subtopology_singleton homotopy_equivalent_space_contractibility)
   qed
 qed (simp add: contractible_space_empty)
 
 lemma contractible_space_retraction_map_image:
   assumes "retraction_map X Y f" and X: "contractible_space X"
   shows "contractible_space Y"
 proof -
   obtain g where f: "continuous_map X Y f" and g: "continuous_map Y X g" and fg: "\<forall>y \<in> topspace Y. f(g y) = y"
     using assms by (auto simp: retraction_map_def retraction_maps_def)
   obtain a where a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
     using X by (auto simp: contractible_space_def)
   have "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. f a)"
   proof (rule homotopic_with_eq)
     show "homotopic_with (\<lambda>x. True) Y Y (f \<circ> id \<circ> g) (f \<circ> (\<lambda>x. a) \<circ> g)"
       using f g a homotopic_compose_continuous_map_left homotopic_compose_continuous_map_right by metis
   qed (use fg in auto)
   then show ?thesis
     unfolding contractible_space_def by blast
 qed
 
 lemma contractible_space_prod_topology:
    "contractible_space(prod_topology X Y) \<longleftrightarrow>
     topspace X = {} \<or> topspace Y = {} \<or> contractible_space X \<and> contractible_space Y"
 proof (cases "topspace X = {} \<or> topspace Y = {}")
   case True
   then have "topspace (prod_topology X Y) = {}"
     by simp
   then show ?thesis
     by (auto simp: contractible_space_empty)
 next
   case False
   have "contractible_space(prod_topology X Y) \<longleftrightarrow> contractible_space X \<and> contractible_space Y"
   proof safe
     assume XY: "contractible_space (prod_topology X Y)"
     with False have "retraction_map (prod_topology X Y) X fst"
       by (auto simp: contractible_space False retraction_map_fst)
     then show "contractible_space X"
       by (rule contractible_space_retraction_map_image [OF _ XY])
     have "retraction_map (prod_topology X Y) Y snd"
       using False XY  by (auto simp: contractible_space False retraction_map_snd)
     then show "contractible_space Y"
       by (rule contractible_space_retraction_map_image [OF _ XY])
   next
     assume "contractible_space X" and "contractible_space Y"
     with False obtain a b
       where "a \<in> topspace X" and a: "homotopic_with (\<lambda>x. True) X X id (\<lambda>x. a)"
         and "b \<in> topspace Y" and b: "homotopic_with (\<lambda>x. True) Y Y id (\<lambda>x. b)"
       by (auto simp: contractible_space)
     with False show "contractible_space (prod_topology X Y)"
       apply (simp add: contractible_space)
       apply (rule_tac x=a in bexI)
        apply (rule_tac x=b in bexI)
       using homotopic_with_prod_topology [OF a b]
         apply (metis (no_types, lifting) case_prod_Pair case_prod_beta' eq_id_iff)
        apply auto
       done
   qed
   with False show ?thesis
     by auto
 qed
 
 
-
-
 lemma contractible_space_product_topology:
   "contractible_space(product_topology X I) \<longleftrightarrow>
     topspace (product_topology X I) = {} \<or> (\<forall>i \<in> I. contractible_space(X i))"
 proof (cases "topspace (product_topology X I) = {}")
   case False
   have 1: "contractible_space (X i)"
     if XI: "contractible_space (product_topology X I)" and "i \<in> I"
     for i
   proof (rule contractible_space_retraction_map_image [OF _ XI])
     show "retraction_map (product_topology X I) (X i) (\<lambda>x. x i)"
       using False by (simp add: retraction_map_product_projection \<open>i \<in> I\<close>)
   qed
   have 2: "contractible_space (product_topology X I)"
     if "x \<in> topspace (product_topology X I)" and cs: "\<forall>i\<in>I. contractible_space (X i)"
     for x :: "'a \<Rightarrow> 'b"
   proof -
     obtain f where f: "\<And>i. i\<in>I \<Longrightarrow> homotopic_with (\<lambda>x. True) (X i) (X i) id (\<lambda>x. f i)"
       using cs unfolding contractible_space_def by metis
     have "homotopic_with (\<lambda>x. True)
                          (product_topology X I) (product_topology X I) id (\<lambda>x. restrict f I)"
-      by (rule homotopic_with_eq [OF homotopic_with_product_topology [OF f]]) (auto simp: topspace_product_topology)
+      by (rule homotopic_with_eq [OF homotopic_with_product_topology [OF f]]) (auto)
     then show ?thesis
       by (auto simp: contractible_space_def)
   qed
   show ?thesis
     using False 1 2 by blast
 qed (simp add: contractible_space_empty)
 
 
 lemma contractible_space_subtopology_euclideanreal [simp]:
   "contractible_space(subtopology euclideanreal S) \<longleftrightarrow> is_interval S"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "path_connectedin (subtopology euclideanreal S) S"
     using contractible_imp_path_connected_space path_connectedin_topspace path_connectedin_absolute
     by (simp add: contractible_imp_path_connected) 
   then show ?rhs
     by (simp add: is_interval_path_connected_1)
 next
   assume ?rhs
   then have "convex S"
     by (simp add: is_interval_convex_1)
   show ?lhs
   proof (cases "S = {}")
     case False
     then obtain z where "z \<in> S"
       by blast
     show ?thesis
       unfolding contractible_space_def homotopic_with_def
     proof (intro exI conjI allI)
       show "continuous_map (prod_topology (top_of_set {0..1}) (top_of_set S)) (top_of_set S)
                            (\<lambda>(t,x). (1 - t) * x + t * z)"
         apply (auto simp: case_prod_unfold)
          apply (intro continuous_intros)
         using  \<open>z \<in> S\<close> apply (auto intro: convexD [OF \<open>convex S\<close>, simplified])
         done
     qed auto
   qed (simp add: contractible_space_empty)
 qed
 
 
 corollary contractible_space_euclideanreal: "contractible_space euclideanreal"
 proof -
   have "contractible_space (subtopology euclideanreal UNIV)"
     using contractible_space_subtopology_euclideanreal by blast
   then show ?thesis
     by simp
 qed
 
 
 abbreviation\<^marker>\<open>tag important\<close> homotopy_eqv :: "'a::topological_space set \<Rightarrow> 'b::topological_space set \<Rightarrow> bool"
              (infix "homotopy'_eqv" 50)
   where "S homotopy_eqv T \<equiv> top_of_set S homotopy_equivalent_space top_of_set T"
 
 
 
 
 
 lemma homeomorphic_imp_homotopy_eqv: "S homeomorphic T \<Longrightarrow> S homotopy_eqv T"
   unfolding homeomorphic_def homeomorphism_def homotopy_equivalent_space_def
   apply (erule ex_forward)+
   apply auto
    apply (metis homotopic_with_id2 topspace_euclidean_subtopology)
   by (metis (full_types) homotopic_with_id2 imageE topspace_euclidean_subtopology)
 
 
 lemma homotopy_eqv_inj_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "(f ` S) homotopy_eqv S"
 apply (rule homeomorphic_imp_homotopy_eqv)
 using assms homeomorphic_sym linear_homeomorphic_image by auto
 
 lemma homotopy_eqv_translation:
     fixes S :: "'a::real_normed_vector set"
     shows "(+) a ` S homotopy_eqv S"
   apply (rule homeomorphic_imp_homotopy_eqv)
   using homeomorphic_translation homeomorphic_sym by blast
 
 lemma homotopy_eqv_homotopic_triviality_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f ` U \<subseteq> T"
       and g: "continuous_on U g" "g ` U \<subseteq> T"
       and homUS: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S;
                          continuous_on U g; g ` U \<subseteq> S\<rbrakk>
                          \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g"
     shows "homotopic_with_canon (\<lambda>x. True) U T f g"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   have "homotopic_with_canon (\<lambda>f. True) U S (k \<circ> f) (k \<circ> g)"
     apply (rule homUS)
     using f g k
     apply (safe intro!: continuous_on_compose h k f elim!: continuous_on_subset)
     apply (force simp: o_def)+
     done
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (k \<circ> g))"
     apply (rule homotopic_with_compose_continuous_left)
     apply (simp_all add: h)
     done
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> f) (id \<circ> f)"
     apply (rule homotopic_with_compose_continuous_right [where X=T and Y=T])
     apply (auto simp: hom f)
     done
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> k \<circ> g) (id \<circ> g)"
     apply (rule homotopic_with_compose_continuous_right [where X=T and Y=T])
     apply (auto simp: hom g)
     done
   ultimately show "homotopic_with_canon (\<lambda>x. True) U T f g"
     apply (simp add: o_assoc)
     using homotopic_with_trans homotopic_with_sym by blast
 qed
 
 lemma homotopy_eqv_homotopic_triviality:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> S \<and>
                    continuous_on U g \<and> g ` U \<subseteq> S
                    \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U S f g) \<longleftrightarrow>
            (\<forall>f g. continuous_on U f \<and> f ` U \<subseteq> T \<and>
                   continuous_on U g \<and> g ` U \<subseteq> T
                   \<longrightarrow> homotopic_with_canon (\<lambda>x. True) U T f g)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     by (metis assms homotopy_eqv_homotopic_triviality_imp)
 next
   assume ?rhs
   moreover
   have "T homotopy_eqv S"
     using assms homotopy_equivalent_space_sym by blast
   ultimately show ?lhs
     by (blast intro: homotopy_eqv_homotopic_triviality_imp)
 qed
 
 
 lemma homotopy_eqv_cohomotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on T f" "f ` T \<subseteq> U"
       and homSU: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> U\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c)"
   obtains c where "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   obtain c where "homotopic_with_canon (\<lambda>x. True) S U (f \<circ> h) (\<lambda>x. c)"
     apply (rule exE [OF homSU [of "f \<circ> h"]])
     apply (intro continuous_on_compose h)
     using h f  apply (force elim!: continuous_on_subset)+
     done
   then have "homotopic_with_canon (\<lambda>x. True) T U ((f \<circ> h) \<circ> k) ((\<lambda>x. c) \<circ> k)"
     apply (rule homotopic_with_compose_continuous_right [where X=S])
     using k by auto
   moreover have "homotopic_with_canon (\<lambda>x. True) T U (f \<circ> id) (f \<circ> (h \<circ> k))"
     apply (rule homotopic_with_compose_continuous_left [where Y=T])
       apply (simp add: hom homotopic_with_symD)
      using f apply auto
     done
   ultimately show ?thesis
     apply (rule_tac c=c in that)
     apply (simp add: o_def)
     using homotopic_with_trans by blast
 qed
 
 lemma homotopy_eqv_cohomotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) S U f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on T f \<and> f ` T \<subseteq> U
                 \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. c)))"
 apply (rule iffI)
 apply (metis assms homotopy_eqv_cohomotopic_triviality_null_imp)
 by (metis assms homotopy_eqv_cohomotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 lemma homotopy_eqv_homotopic_triviality_null_imp:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
       and f: "continuous_on U f" "f ` U \<subseteq> T"
       and homSU: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk>
                       \<Longrightarrow> \<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c)"
     shows "\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)"
 proof -
   obtain h k where h: "continuous_on S h" "h ` S \<subseteq> T"
                and k: "continuous_on T k" "k ` T \<subseteq> S"
                and hom: "homotopic_with_canon (\<lambda>x. True) S S (k \<circ> h) id"
                         "homotopic_with_canon (\<lambda>x. True) T T (h \<circ> k) id"
     using assms by (auto simp: homotopy_equivalent_space_def)
   obtain c::'a where "homotopic_with_canon (\<lambda>x. True) U S (k \<circ> f) (\<lambda>x. c)"
     apply (rule exE [OF homSU [of "k \<circ> f"]])
     apply (intro continuous_on_compose h)
     using k f  apply (force elim!: continuous_on_subset)+
     done
   then have "homotopic_with_canon (\<lambda>x. True) U T (h \<circ> (k \<circ> f)) (h \<circ> (\<lambda>x. c))"
     apply (rule homotopic_with_compose_continuous_left [where Y=S])
     using h by auto
   moreover have "homotopic_with_canon (\<lambda>x. True) U T (id \<circ> f) ((h \<circ> k) \<circ> f)"
     apply (rule homotopic_with_compose_continuous_right [where X=T])
       apply (simp add: hom homotopic_with_symD)
      using f apply auto
     done
   ultimately show ?thesis
     using homotopic_with_trans by (fastforce simp add: o_def)
 qed
 
 lemma homotopy_eqv_homotopic_triviality_null:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
     and U :: "'c::real_normed_vector set"
   assumes "S homotopy_eqv T"
     shows "(\<forall>f. continuous_on U f \<and> f ` U \<subseteq> S
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U S f (\<lambda>x. c))) \<longleftrightarrow>
            (\<forall>f. continuous_on U f \<and> f ` U \<subseteq> T
                   \<longrightarrow> (\<exists>c. homotopic_with_canon (\<lambda>x. True) U T f (\<lambda>x. c)))"
 apply (rule iffI)
 apply (metis assms homotopy_eqv_homotopic_triviality_null_imp)
 by (metis assms homotopy_eqv_homotopic_triviality_null_imp homotopy_equivalent_space_sym)
 
 lemma homotopy_eqv_contractible_sets:
   fixes S :: "'a::real_normed_vector set"
     and T :: "'b::real_normed_vector set"
   assumes "contractible S" "contractible T" "S = {} \<longleftrightarrow> T = {}"
     shows "S homotopy_eqv T"
 proof (cases "S = {}")
   case True with assms show ?thesis
     by (simp add: homeomorphic_imp_homotopy_eqv)
 next
   case False
   with assms obtain a b where "a \<in> S" "b \<in> T"
     by auto
   then show ?thesis
     unfolding homotopy_equivalent_space_def
     apply (rule_tac x="\<lambda>x. b" in exI)
     apply (rule_tac x="\<lambda>x. a" in exI)
     apply (intro assms conjI continuous_on_id' homotopic_into_contractible)
-    apply (auto simp: o_def continuous_on_const)
+    apply (auto simp: o_def)
     done
 qed
 
 lemma homotopy_eqv_empty1 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "S homotopy_eqv ({}::'b::real_normed_vector set) \<longleftrightarrow> S = {}"
   apply (rule iffI)
    apply (metis Abstract_Topology.continuous_map_subtopology_eu emptyE equals0I homotopy_equivalent_space_def image_subset_iff)
   by (simp add: homotopy_eqv_contractible_sets)
 
 lemma homotopy_eqv_empty2 [simp]:
   fixes S :: "'a::real_normed_vector set"
   shows "({}::'b::real_normed_vector set) homotopy_eqv S \<longleftrightarrow> S = {}"
   using homotopy_equivalent_space_sym homotopy_eqv_empty1 by blast
 
 lemma homotopy_eqv_contractibility:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homotopy_eqv T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
   by (meson contractible_space_top_of_set homotopy_equivalent_space_contractibility)
 
 lemma homotopy_eqv_sing:
   fixes S :: "'a::real_normed_vector set" and a :: "'b::real_normed_vector"
   shows "S homotopy_eqv {a} \<longleftrightarrow> S \<noteq> {} \<and> contractible S"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False then show ?thesis
     by (metis contractible_sing empty_not_insert homotopy_eqv_contractibility homotopy_eqv_contractible_sets)
 qed
 
 lemma homeomorphic_contractible_eq:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "S homeomorphic T \<Longrightarrow> (contractible S \<longleftrightarrow> contractible T)"
 by (simp add: homeomorphic_imp_homotopy_eqv homotopy_eqv_contractibility)
 
 lemma homeomorphic_contractible:
   fixes S :: "'a::real_normed_vector set" and T :: "'b::real_normed_vector set"
   shows "\<lbrakk>contractible S; S homeomorphic T\<rbrakk> \<Longrightarrow> contractible T"
   by (metis homeomorphic_contractible_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Misc other results\<close>
 
 lemma bounded_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" and conn: "connected(- S)"
     shows "S = {}"
 proof -
   obtain a b where "S \<subseteq> box a b"
     by (meson assms bounded_subset_box_symmetric)
   then have "a \<notin> S" "b \<notin> S"
     by auto
   then have "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> - S"
     by (meson Compl_iff conn connected_iff_interval)
   then show ?thesis
     using \<open>S \<subseteq> box a b\<close> by auto
 qed
 
 corollary bounded_path_connected_Compl_real:
   fixes S :: "real set"
   assumes "bounded S" "path_connected(- S)" shows "S = {}"
   by (simp add: assms bounded_connected_Compl_real path_connected_imp_connected)
 
 lemma bounded_connected_Compl_1:
   fixes S :: "'a::{euclidean_space} set"
   assumes "bounded S" and conn: "connected(- S)" and 1: "DIM('a) = 1"
     shows "S = {}"
 proof -
   have "DIM('a) = DIM(real)"
     by (simp add: "1")
   then obtain f::"'a \<Rightarrow> real" and g
   where "linear f" "\<And>x. norm(f x) = norm x" "\<And>x. g(f x) = x" "\<And>y. f(g y) = y"
     by (rule isomorphisms_UNIV_UNIV) blast
   with \<open>bounded S\<close> have "bounded (f ` S)"
     using bounded_linear_image linear_linear by blast
   have "connected (f ` (-S))"
     using connected_linear_image assms \<open>linear f\<close> by blast
   moreover have "f ` (-S) = - (f ` S)"
     apply (rule bij_image_Compl_eq)
     apply (auto simp: bij_def)
      apply (metis \<open>\<And>x. g (f x) = x\<close> injI)
     by (metis UNIV_I \<open>\<And>y. f (g y) = y\<close> image_iff)
   finally have "connected (- (f ` S))"
     by simp
   then have "f ` S = {}"
     using \<open>bounded (f ` S)\<close> bounded_connected_Compl_real by blast
   then show ?thesis
     by blast
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some Uncountable Sets\<close>
 
 lemma uncountable_closed_segment:
   fixes a :: "'a::real_normed_vector"
   assumes "a \<noteq> b" shows "uncountable (closed_segment a b)"
 unfolding path_image_linepath [symmetric] path_image_def
   using inj_on_linepath [OF assms] uncountable_closed_interval [of 0 1]
         countable_image_inj_on by auto
 
 lemma uncountable_open_segment:
   fixes a :: "'a::real_normed_vector"
   assumes "a \<noteq> b" shows "uncountable (open_segment a b)"
   by (simp add: assms open_segment_def uncountable_closed_segment uncountable_minus_countable)
 
 lemma uncountable_convex:
   fixes a :: "'a::real_normed_vector"
   assumes "convex S" "a \<in> S" "b \<in> S" "a \<noteq> b"
     shows "uncountable S"
 proof -
   have "uncountable (closed_segment a b)"
     by (simp add: uncountable_closed_segment assms)
   then show ?thesis
     by (meson assms convex_contains_segment countable_subset)
 qed
 
 lemma uncountable_ball:
   fixes a :: "'a::euclidean_space"
   assumes "r > 0"
     shows "uncountable (ball a r)"
 proof -
   have "uncountable (open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)))"
     by (metis Basis_zero SOME_Basis add_cancel_right_right assms less_le scale_eq_0_iff uncountable_open_segment)
   moreover have "open_segment a (a + r *\<^sub>R (SOME i. i \<in> Basis)) \<subseteq> ball a r"
     using assms by (auto simp: in_segment algebra_simps dist_norm SOME_Basis)
   ultimately show ?thesis
     by (metis countable_subset)
 qed
 
 lemma ball_minus_countable_nonempty:
   assumes "countable (A :: 'a :: euclidean_space set)" "r > 0"
   shows   "ball z r - A \<noteq> {}"
 proof
   assume *: "ball z r - A = {}"
   have "uncountable (ball z r - A)"
     by (intro uncountable_minus_countable assms uncountable_ball)
   thus False by (subst (asm) *) auto
 qed
 
 lemma uncountable_cball:
   fixes a :: "'a::euclidean_space"
   assumes "r > 0"
   shows "uncountable (cball a r)"
   using assms countable_subset uncountable_ball by auto
 
 lemma pairwise_disjnt_countable:
   fixes \<N> :: "nat set set"
   assumes "pairwise disjnt \<N>"
     shows "countable \<N>"
 proof -
   have "inj_on (\<lambda>X. SOME n. n \<in> X) (\<N> - {{}})"
     apply (clarsimp simp add: inj_on_def)
     by (metis assms disjnt_insert2 insert_absorb pairwise_def subsetI subset_empty tfl_some)
   then show ?thesis
     by (metis countable_Diff_eq countable_def)
 qed
 
 lemma pairwise_disjnt_countable_Union:
     assumes "countable (\<Union>\<N>)" and pwd: "pairwise disjnt \<N>"
     shows "countable \<N>"
 proof -
   obtain f :: "_ \<Rightarrow> nat" where f: "inj_on f (\<Union>\<N>)"
     using assms by blast
   then have "pairwise disjnt (\<Union> X \<in> \<N>. {f ` X})"
     using assms by (force simp: pairwise_def disjnt_inj_on_iff [OF f])
   then have "countable (\<Union> X \<in> \<N>. {f ` X})"
     using pairwise_disjnt_countable by blast
   then show ?thesis
     by (meson pwd countable_image_inj_on disjoint_image f inj_on_image pairwise_disjnt_countable)
 qed
 
 lemma connected_uncountable:
   fixes S :: "'a::metric_space set"
   assumes "connected S" "a \<in> S" "b \<in> S" "a \<noteq> b" shows "uncountable S"
 proof -
   have "continuous_on S (dist a)"
     by (intro continuous_intros)
   then have "connected (dist a ` S)"
     by (metis connected_continuous_image \<open>connected S\<close>)
   then have "closed_segment 0 (dist a b) \<subseteq> (dist a ` S)"
     by (simp add: assms closed_segment_subset is_interval_connected_1 is_interval_convex)
   then have "uncountable (dist a ` S)"
     by (metis \<open>a \<noteq> b\<close> countable_subset dist_eq_0_iff uncountable_closed_segment)
   then show ?thesis
     by blast
 qed
 
 lemma path_connected_uncountable:
   fixes S :: "'a::metric_space set"
   assumes "path_connected S" "a \<in> S" "b \<in> S" "a \<noteq> b" shows "uncountable S"
   using path_connected_imp_connected assms connected_uncountable by metis
 
 lemma connected_finite_iff_sing:
   fixes S :: "'a::metric_space set"
   assumes "connected S"
   shows "finite S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})"  (is "_ = ?rhs")
 proof -
   have "uncountable S" if "\<not> ?rhs"
     using connected_uncountable assms that by blast
   then show ?thesis
     using uncountable_infinite by auto
 qed
 
 lemma connected_card_eq_iff_nontrivial:
   fixes S :: "'a::metric_space set"
   shows "connected S \<Longrightarrow> uncountable S \<longleftrightarrow> \<not>(\<exists>a. S \<subseteq> {a})"
   apply (auto simp: countable_finite finite_subset)
   by (metis connected_uncountable is_singletonI' is_singleton_the_elem subset_singleton_iff)
 
 lemma simple_path_image_uncountable:
   fixes g :: "real \<Rightarrow> 'a::metric_space"
   assumes "simple_path g"
   shows "uncountable (path_image g)"
 proof -
   have "g 0 \<in> path_image g" "g (1/2) \<in> path_image g"
     by (simp_all add: path_defs)
   moreover have "g 0 \<noteq> g (1/2)"
     using assms by (fastforce simp add: simple_path_def)
   ultimately show ?thesis
     apply (simp add: assms connected_card_eq_iff_nontrivial connected_simple_path_image)
     by blast
 qed
 
 lemma arc_image_uncountable:
   fixes g :: "real \<Rightarrow> 'a::metric_space"
   assumes "arc g"
   shows "uncountable (path_image g)"
   by (simp add: arc_imp_simple_path assms simple_path_image_uncountable)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some simple positive connection theorems\<close>
 
 proposition path_connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
     shows "path_connected(U - S)"
 proof (clarsimp simp add: path_connected_def)
   fix a b
   assume "a \<in> U" "a \<notin> S" "b \<in> U" "b \<notin> S"
   let ?m = "midpoint a b"
   show "\<exists>g. path g \<and> path_image g \<subseteq> U - S \<and> pathstart g = a \<and> pathfinish g = b"
   proof (cases "a = b")
     case True
     then show ?thesis
       by (metis DiffI \<open>a \<in> U\<close> \<open>a \<notin> S\<close> path_component_def path_component_refl)
   next
     case False
     then have "a \<noteq> ?m" "b \<noteq> ?m"
       using midpoint_eq_endpoint by fastforce+
     have "?m \<in> U"
       using \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>convex U\<close> convex_contains_segment by force
     obtain c where "c \<in> U" and nc_abc: "\<not> collinear {a,b,c}"
       by (metis False \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>\<not> collinear U\<close> collinear_triples insert_absorb)
     have ncoll_mca: "\<not> collinear {?m,c,a}"
       by (metis (full_types) \<open>a \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have ncoll_mcb: "\<not> collinear {?m,c,b}"
       by (metis (full_types) \<open>b \<noteq> ?m\<close> collinear_3_trans collinear_midpoint insert_commute nc_abc)
     have "c \<noteq> ?m"
       by (metis collinear_midpoint insert_commute nc_abc)
     then have "closed_segment ?m c \<subseteq> U"
       by (simp add: \<open>c \<in> U\<close> \<open>?m \<in> U\<close> \<open>convex U\<close> closed_segment_subset)
     then obtain z where z: "z \<in> closed_segment ?m c"
                     and disjS: "(closed_segment a z \<union> closed_segment z b) \<inter> S = {}"
     proof -
       have False if "closed_segment ?m c \<subseteq> {z. (closed_segment a z \<union> closed_segment z b) \<inter> S \<noteq> {}}"
       proof -
         have closb: "closed_segment ?m c \<subseteq>
                  {z \<in> closed_segment ?m c. closed_segment a z \<inter> S \<noteq> {}} \<union> {z \<in> closed_segment ?m c. closed_segment z b \<inter> S \<noteq> {}}"
           using that by blast
         have *: "countable {z \<in> closed_segment ?m c. closed_segment z u \<inter> S \<noteq> {}}"
           if "u \<in> U" "u \<notin> S" and ncoll: "\<not> collinear {?m, c, u}" for u
         proof -
           have **: False if x1: "x1 \<in> closed_segment ?m c" and x2: "x2 \<in> closed_segment ?m c"
                             and "x1 \<noteq> x2" "x1 \<noteq> u"
                             and w: "w \<in> closed_segment x1 u" "w \<in> closed_segment x2 u"
                             and "w \<in> S" for x1 x2 w
           proof -
             have "x1 \<in> affine hull {?m,c}" "x2 \<in> affine hull {?m,c}"
               using segment_as_ball x1 x2 by auto
             then have coll_x1: "collinear {x1, ?m, c}" and coll_x2: "collinear {?m, c, x2}"
               by (simp_all add: affine_hull_3_imp_collinear) (metis affine_hull_3_imp_collinear insert_commute)
             have "\<not> collinear {x1, u, x2}"
             proof
               assume "collinear {x1, u, x2}"
               then have "collinear {?m, c, u}"
                 by (metis (full_types) \<open>c \<noteq> ?m\<close> coll_x1 coll_x2 collinear_3_trans insert_commute ncoll \<open>x1 \<noteq> x2\<close>)
               with ncoll show False ..
             qed
             then have "closed_segment x1 u \<inter> closed_segment u x2 = {u}"
               by (blast intro!: Int_closed_segment)
             then have "w = u"
               using closed_segment_commute w by auto
             show ?thesis
               using \<open>u \<notin> S\<close> \<open>w = u\<close> that(7) by auto
           qed
           then have disj: "disjoint ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}))"
             by (fastforce simp: pairwise_def disjnt_def)
           have cou: "countable ((\<Union>z \<in> closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             apply (rule pairwise_disjnt_countable_Union [OF _ pairwise_subset [OF disj]])
              apply (rule countable_subset [OF _ \<open>countable S\<close>], auto)
             done
           define f where "f \<equiv> \<lambda>X. (THE z. z \<in> closed_segment ?m c \<and> X = closed_segment z u \<inter> S)"
           show ?thesis
           proof (rule countable_subset [OF _ countable_image [OF cou, where f=f]], clarify)
             fix x
             assume x: "x \<in> closed_segment ?m c" "closed_segment x u \<inter> S \<noteq> {}"
             show "x \<in> f ` ((\<Union>z\<in>closed_segment ?m c. {closed_segment z u \<inter> S}) - {{}})"
             proof (rule_tac x="closed_segment x u \<inter> S" in image_eqI)
               show "x = f (closed_segment x u \<inter> S)"
                 unfolding f_def
                 apply (rule the_equality [symmetric])
                 using x  apply (auto simp: dest: **)
                 done
             qed (use x in auto)
           qed
         qed
         have "uncountable (closed_segment ?m c)"
           by (metis \<open>c \<noteq> ?m\<close> uncountable_closed_segment)
         then show False
           using closb * [OF \<open>a \<in> U\<close> \<open>a \<notin> S\<close> ncoll_mca] * [OF \<open>b \<in> U\<close> \<open>b \<notin> S\<close> ncoll_mcb]
           apply (simp add: closed_segment_commute)
           by (simp add: countable_subset)
       qed
       then show ?thesis
         by (force intro: that)
     qed
     show ?thesis
     proof (intro exI conjI)
       have "path_image (linepath a z +++ linepath z b) \<subseteq> U"
         by (metis \<open>a \<in> U\<close> \<open>b \<in> U\<close> \<open>closed_segment ?m c \<subseteq> U\<close> z \<open>convex U\<close> closed_segment_subset contra_subsetD path_image_linepath subset_path_image_join)
       with disjS show "path_image (linepath a z +++ linepath z b) \<subseteq> U - S"
         by (force simp: path_image_join)
     qed auto
   qed
 qed
 
 
 corollary connected_convex_diff_countable:
   fixes U :: "'a::euclidean_space set"
   assumes "convex U" "\<not> collinear U" "countable S"
   shows "connected(U - S)"
   by (simp add: assms path_connected_convex_diff_countable path_connected_imp_connected)
 
 lemma path_connected_punctured_convex:
   assumes "convex S" and aff: "aff_dim S \<noteq> 1"
     shows "path_connected(S - {a})"
 proof -
   consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S \<ge> 2"
     using assms aff_dim_geq [of S] by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then show ?thesis
       by (metis aff_dim_empty empty_Diff path_connected_empty)
   next
     assume "aff_dim S = 0"
     then show ?thesis
       by (metis aff_dim_eq_0 Diff_cancel Diff_empty Diff_insert0 convex_empty convex_imp_path_connected path_connected_singleton singletonD)
   next
     assume ge2: "aff_dim S \<ge> 2"
     then have "\<not> collinear S"
     proof (clarsimp simp add: collinear_affine_hull)
       fix u v
       assume "S \<subseteq> affine hull {u, v}"
       then have "aff_dim S \<le> aff_dim {u, v}"
         by (metis (no_types) aff_dim_affine_hull aff_dim_subset)
       with ge2 show False
         by (metis (no_types) aff_dim_2 antisym aff not_numeral_le_zero one_le_numeral order_trans)
     qed
     then show ?thesis
       apply (rule path_connected_convex_diff_countable [OF \<open>convex S\<close>])
       by simp
   qed
 qed
 
 lemma connected_punctured_convex:
   shows "\<lbrakk>convex S; aff_dim S \<noteq> 1\<rbrakk> \<Longrightarrow> connected(S - {a})"
   using path_connected_imp_connected path_connected_punctured_convex by blast
 
 lemma path_connected_complement_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "countable S"
   shows "path_connected(- S)"
 proof -
   have "path_connected(UNIV - S)"
     apply (rule path_connected_convex_diff_countable)
     using assms by (auto simp: collinear_aff_dim [of "UNIV :: 'a set"])
   then show ?thesis
     by (simp add: Compl_eq_Diff_UNIV)
 qed
 
 proposition path_connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "path_connected(S - T)"
 proof (clarsimp simp add: path_connected_component)
   fix x y
   assume xy: "x \<in> S" "x \<notin> T" "y \<in> S" "y \<notin> T"
   show "path_component (S - T) x y"
   proof (rule connected_equivalence_relation_gen [OF \<open>connected S\<close>, where P = "\<lambda>x. x \<notin> T"])
     show "\<exists>z. z \<in> U \<and> z \<notin> T" if opeU: "openin (top_of_set S) U" and "x \<in> U" for U x
     proof -
       have "openin (top_of_set (affine hull S)) U"
         using opeU ope openin_trans by blast
       with \<open>x \<in> U\<close> obtain r where Usub: "U \<subseteq> affine hull S" and "r > 0"
                               and subU: "ball x r \<inter> affine hull S \<subseteq> U"
         by (auto simp: openin_contains_ball)
       with \<open>x \<in> U\<close> have x: "x \<in> ball x r \<inter> affine hull S"
         by auto
       have "\<not> S \<subseteq> {x}"
         using \<open>\<not> collinear S\<close>  collinear_subset by blast
       then obtain x' where "x' \<noteq> x" "x' \<in> S"
         by blast
       obtain y where y: "y \<noteq> x" "y \<in> ball x r \<inter> affine hull S"
       proof
         show "x + (r / 2 / norm(x' - x)) *\<^sub>R (x' - x) \<noteq> x"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> by auto
         show "x + (r / 2 / norm (x' - x)) *\<^sub>R (x' - x) \<in> ball x r \<inter> affine hull S"
           using \<open>x' \<noteq> x\<close> \<open>r > 0\<close> \<open>x' \<in> S\<close> x
           by (simp add: dist_norm mem_affine_3_minus hull_inc)
       qed
       have "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       with x y subU have "uncountable U"
         by (meson countable_subset uncountable_convex)
       then have "\<not> U \<subseteq> T"
         using \<open>countable T\<close> countable_subset by blast
       then show ?thesis by blast
     qed
     show "\<exists>U. openin (top_of_set S) U \<and> x \<in> U \<and>
               (\<forall>x\<in>U. \<forall>y\<in>U. x \<notin> T \<and> y \<notin> T \<longrightarrow> path_component (S - T) x y)"
           if "x \<in> S" for x
     proof -
       obtain r where Ssub: "S \<subseteq> affine hull S" and "r > 0"
                  and subS: "ball x r \<inter> affine hull S \<subseteq> S"
         using ope \<open>x \<in> S\<close> by (auto simp: openin_contains_ball)
       then have conv: "convex (ball x r \<inter> affine hull S)"
         by (simp add: affine_imp_convex convex_Int)
       have "\<not> aff_dim (affine hull S) \<le> 1"
         using \<open>\<not> collinear S\<close> collinear_aff_dim by auto
       then have "\<not> collinear (ball x r \<inter> affine hull S)"
         apply (simp add: collinear_aff_dim)
         by (metis (no_types, hide_lams) aff_dim_convex_Int_open IntI open_ball \<open>0 < r\<close> aff_dim_affine_hull affine_affine_hull affine_imp_convex centre_in_ball empty_iff hull_subset inf_commute subsetCE that)
       then have *: "path_connected ((ball x r \<inter> affine hull S) - T)"
         by (rule path_connected_convex_diff_countable [OF conv _ \<open>countable T\<close>])
       have ST: "ball x r \<inter> affine hull S - T \<subseteq> S - T"
         using subS by auto
       show ?thesis
       proof (intro exI conjI)
         show "x \<in> ball x r \<inter> affine hull S"
           using \<open>x \<in> S\<close> \<open>r > 0\<close> by (simp add: hull_inc)
         have "openin (top_of_set (affine hull S)) (ball x r \<inter> affine hull S)"
           by (subst inf.commute) (simp add: openin_Int_open)
         then show "openin (top_of_set S) (ball x r \<inter> affine hull S)"
           by (rule openin_subset_trans [OF _ subS Ssub])
       qed (use * path_component_trans in \<open>auto simp: path_connected_component path_component_of_subset [OF ST]\<close>)
     qed
   qed (use xy path_component_trans in auto)
 qed
 
 corollary connected_openin_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "connected S" and ope: "openin (top_of_set (affine hull S)) S"
       and "\<not> collinear S" "countable T"
     shows "connected(S - T)"
   by (metis path_connected_imp_connected path_connected_openin_diff_countable [OF assms])
 
 corollary path_connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "path_connected(S - T)"
 proof (cases "S = {}")
   case True
   then show ?thesis
-    by (simp add: path_connected_empty)
+    by (simp)
 next
   case False
   show ?thesis
   proof (rule path_connected_openin_diff_countable)
     show "openin (top_of_set (affine hull S)) S"
       by (simp add: assms hull_subset open_subset)
     show "\<not> collinear S"
       using assms False by (simp add: collinear_aff_dim aff_dim_open)
   qed (simp_all add: assms)
 qed
 
 corollary connected_open_diff_countable:
   fixes S :: "'a::euclidean_space set"
   assumes "2 \<le> DIM('a)" "open S" "connected S" "countable T"
   shows "connected(S - T)"
 by (simp add: assms path_connected_imp_connected path_connected_open_diff_countable)
 
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Self-homeomorphisms shuffling points about\<close>
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_moving_points_exists\<close>\<close>
 
 lemma homeomorphism_moving_point_1:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f a = u" "\<And>x. x \<in> sphere a r \<Longrightarrow> f x = x"
 proof -
   have nou: "norm (u - a) < r" and "u \<in> T"
     using u by (auto simp: dist_norm norm_minus_commute)
   then have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   define f where "f \<equiv> \<lambda>x. (1 - norm(x - a) / r) *\<^sub>R (u - a) + x"
   have *: "False" if eq: "x + (norm y / r) *\<^sub>R u = y + (norm x / r) *\<^sub>R u"
                   and nou: "norm u < r" and yx: "norm y < norm x" for x y and u::'a
   proof -
     have "x = y + (norm x / r - (norm y / r)) *\<^sub>R u"
       using eq by (simp add: algebra_simps)
     then have "norm x = norm (y + ((norm x - norm y) / r) *\<^sub>R u)"
       by (metis diff_divide_distrib)
     also have "\<dots> \<le> norm y + norm(((norm x - norm y) / r) *\<^sub>R u)"
       using norm_triangle_ineq by blast
     also have "\<dots> = norm y + (norm x - norm y) * (norm u / r)"
       using yx \<open>r > 0\<close>
       by (simp add: field_split_simps)
     also have "\<dots> < norm y + (norm x - norm y) * 1"
       apply (subst add_less_cancel_left)
       apply (rule mult_strict_left_mono)
       using nou \<open>0 < r\<close> yx
        apply (simp_all add: field_simps)
       done
     also have "\<dots> = norm x"
       by simp
     finally show False by simp
   qed
   have "inj f"
     unfolding f_def
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "(1 - norm (x - a) / r) *\<^sub>R (u - a) + x =
             (1 - norm (y - a) / r) *\<^sub>R (u - a) + y"
     then have eq: "(x - a) + (norm (y - a) / r) *\<^sub>R (u - a) = (y - a) + (norm (x - a) / r) *\<^sub>R (u - a)"
       by (auto simp: algebra_simps)
     show "x=y"
     proof (cases "norm (x - a) = norm (y - a)")
       case True
       then show ?thesis
         using eq by auto
     next
       case False
       then consider "norm (x - a) < norm (y - a)" | "norm (x - a) > norm (y - a)"
         by linarith
       then have "False"
       proof cases
         case 1 show False
           using * [OF _ nou 1] eq by simp
       next
         case 2 with * [OF eq nou] show False
           by auto
       qed
       then show "x=y" ..
     qed
   qed
   then have inj_onf: "inj_on f (cball a r \<inter> T)"
     using inj_on_Int by fastforce
   have contf: "continuous_on (cball a r \<inter> T) f"
     unfolding f_def using \<open>0 < r\<close>  by (intro continuous_intros) blast
   have fim: "f ` (cball a r \<inter> T) = cball a r \<inter> T"
   proof
     have *: "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> r" if "norm y \<le> r" "norm u < r" for y u::'a
     proof -
       have "norm (y + (1 - norm y / r) *\<^sub>R u) \<le> norm y + norm((1 - norm y / r) *\<^sub>R u)"
         using norm_triangle_ineq by blast
       also have "\<dots> = norm y + abs(1 - norm y / r) * norm u"
         by simp
       also have "\<dots> \<le> r"
       proof -
         have "(r - norm u) * (r - norm y) \<ge> 0"
           using that by auto
         then have "r * norm u + r * norm y \<le> r * r + norm u * norm y"
           by (simp add: algebra_simps)
         then show ?thesis
         using that \<open>0 < r\<close> by (simp add: abs_if field_simps)
       qed
       finally show ?thesis .
     qed
     have "f ` (cball a r) \<subseteq> cball a r"
       apply (clarsimp simp add: dist_norm norm_minus_commute f_def)
       using * by (metis diff_add_eq diff_diff_add diff_diff_eq2 norm_minus_commute nou)
     moreover have "f ` T \<subseteq> T"
       unfolding f_def using \<open>affine T\<close> \<open>a \<in> T\<close> \<open>u \<in> T\<close>
       by (force simp: add.commute mem_affine_3_minus)
     ultimately show "f ` (cball a r \<inter> T) \<subseteq> cball a r \<inter> T"
       by blast
   next
     show "cball a r \<inter> T \<subseteq> f ` (cball a r \<inter> T)"
     proof (clarsimp simp add: dist_norm norm_minus_commute)
       fix x
       assume x: "norm (x - a) \<le> r" and "x \<in> T"
       have "\<exists>v \<in> {0..1}. ((1 - v) * r - norm ((x - a) - v *\<^sub>R (u - a))) \<bullet> 1 = 0"
         by (rule ivt_decreasing_component_on_1) (auto simp: x continuous_intros)
       then obtain v where "0 \<le> v" "v \<le> 1"
         and v: "(1 - v) * r = norm ((x - a) - v *\<^sub>R (u - a))"
         by auto
       then have n: "norm (a - (x - v *\<^sub>R (u - a))) = r - r * v"
         by (simp add: field_simps norm_minus_commute)
       show "x \<in> f ` (cball a r \<inter> T)"
       proof (rule image_eqI)
         show "x = f (x - v *\<^sub>R (u - a))"
           using \<open>r > 0\<close> v by (simp add: f_def) (simp add: field_simps)
         have "x - v *\<^sub>R (u - a) \<in> cball a r"
           using \<open>r > 0\<close>\<open>0 \<le> v\<close>
           by (simp add: dist_norm n)
         moreover have "x - v *\<^sub>R (u - a) \<in> T"
-          by (simp add: f_def \<open>affine T\<close> \<open>u \<in> T\<close> \<open>x \<in> T\<close> assms mem_affine_3_minus2)
+          by (simp add: f_def \<open>u \<in> T\<close> \<open>x \<in> T\<close> assms mem_affine_3_minus2)
         ultimately show "x - v *\<^sub>R (u - a) \<in> cball a r \<inter> T"
           by blast
       qed
     qed
   qed
   have "\<exists>g. homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
     apply (rule homeomorphism_compact [OF _ contf fim inj_onf])
     apply (simp add: affine_closed compact_Int_closed \<open>affine T\<close>)
     done
   then show ?thesis
     apply (rule exE)
     apply (erule_tac f=f in that)
     using \<open>r > 0\<close>
      apply (simp_all add: f_def dist_norm norm_minus_commute)
     done
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_2:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                     "f u = v" "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
 proof -
   have "0 < r"
     by (metis DiffD1 Diff_Diff_Int ball_eq_empty centre_in_ball not_le u)
   obtain f1 g1 where hom1: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f1 g1"
                  and "f1 a = u" and f1: "\<And>x. x \<in> sphere a r \<Longrightarrow> f1 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u] by blast
   obtain f2 g2 where hom2: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f2 g2"
                  and "f2 a = v" and f2: "\<And>x. x \<in> sphere a r \<Longrightarrow> f2 x = x"
     using homeomorphism_moving_point_1 [OF \<open>affine T\<close> \<open>a \<in> T\<close> v] by blast
   show ?thesis
   proof
     show "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) (f2 \<circ> g1) (f1 \<circ> g2)"
       by (metis homeomorphism_compose homeomorphism_symD hom1 hom2)
     have "g1 u = a"
       using \<open>0 < r\<close> \<open>f1 a = u\<close> assms hom1 homeomorphism_apply1 by fastforce
     then show "(f2 \<circ> g1) u = v"
       by (simp add: \<open>f2 a = v\<close>)
     show "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> (f2 \<circ> g1) x = x"
       using f1 f2 hom1 homeomorphism_apply1 by fastforce
   qed
 qed
 
 
 corollary\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point_3:
   fixes a :: "'a::euclidean_space"
   assumes "affine T" "a \<in> T" and ST: "ball a r \<inter> T \<subseteq> S" "S \<subseteq> T"
       and u: "u \<in> ball a r \<inter> T" and v: "v \<in> ball a r \<inter> T"
   obtains f g where "homeomorphism S S f g"
                     "f u = v" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> ball a r \<inter> T"
 proof -
   obtain f g where hom: "homeomorphism (cball a r \<inter> T) (cball a r \<inter> T) f g"
                and "f u = v" and fid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> f x = x"
     using homeomorphism_moving_point_2 [OF \<open>affine T\<close> \<open>a \<in> T\<close> u v] by blast
   have gid: "\<And>x. \<lbrakk>x \<in> sphere a r; x \<in> T\<rbrakk> \<Longrightarrow> g x = x"
     using fid hom homeomorphism_apply1 by fastforce
   define ff where "ff \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then f x else x"
   define gg where "gg \<equiv> \<lambda>x. if x \<in> ball a r \<inter> T then g x else x"
   show ?thesis
   proof
     show "homeomorphism S S ff gg"
     proof (rule homeomorphismI)
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) ff"
         apply (simp add: ff_def)
         apply (rule continuous_on_cases)
         using homeomorphism_cont1 [OF hom]
-            apply (auto simp: affine_closed \<open>affine T\<close> continuous_on_id fid)
+            apply (auto simp: affine_closed \<open>affine T\<close> fid)
         done
       then show "continuous_on S ff"
         apply (rule continuous_on_subset)
         using ST by auto
       have "continuous_on ((cball a r \<inter> T) \<union> (T - ball a r)) gg"
         apply (simp add: gg_def)
         apply (rule continuous_on_cases)
         using homeomorphism_cont2 [OF hom]
-            apply (auto simp: affine_closed \<open>affine T\<close> continuous_on_id gid)
+            apply (auto simp: affine_closed \<open>affine T\<close> gid)
         done
       then show "continuous_on S gg"
         apply (rule continuous_on_subset)
         using ST by auto
       show "ff ` S \<subseteq> S"
       proof (clarsimp simp add: ff_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "f x \<in> cball a r \<inter> T"
           using homeomorphism_image1 [OF hom] by force
         then show "f x \<in> S"
           using ST(1) \<open>x \<in> T\<close> gid hom homeomorphism_def x by fastforce
       qed
       show "gg ` S \<subseteq> S"
       proof (clarsimp simp add: gg_def)
         fix x
         assume "x \<in> S" and x: "dist a x < r" and "x \<in> T"
         then have "g x \<in> cball a r \<inter> T"
           using homeomorphism_image2 [OF hom] by force
         then have "g x \<in> ball a r"
           using homeomorphism_apply2 [OF hom]
             by (metis Diff_Diff_Int Diff_iff  \<open>x \<in> T\<close> cball_def fid le_less mem_Collect_eq mem_ball mem_sphere x)
         then show "g x \<in> S"
           using ST(1) \<open>g x \<in> cball a r \<inter> T\<close> by force
         qed
       show "\<And>x. x \<in> S \<Longrightarrow> gg (ff x) = x"
         apply (simp add: ff_def gg_def)
         using homeomorphism_apply1 [OF hom] homeomorphism_image1 [OF hom]
         apply auto
         apply (metis Int_iff homeomorphism_apply1 [OF hom] fid image_eqI less_eq_real_def mem_cball mem_sphere)
         done
       show "\<And>x. x \<in> S \<Longrightarrow> ff (gg x) = x"
         apply (simp add: ff_def gg_def)
         using homeomorphism_apply2 [OF hom] homeomorphism_image2 [OF hom]
         apply auto
         apply (metis Int_iff fid image_eqI less_eq_real_def mem_cball mem_sphere)
         done
     qed
     show "ff u = v"
       using u by (auto simp: ff_def \<open>f u = v\<close>)
     show "{x. \<not> (ff x = x \<and> gg x = x)} \<subseteq> ball a r \<inter> T"
       by (auto simp: ff_def gg_def)
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_point:
   fixes a :: "'a::euclidean_space"
   assumes ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T"
       and TS: "T \<subseteq> affine hull S"
       and S: "connected S" "a \<in> S" "b \<in> S"
   obtains f g where "homeomorphism T T f g" "f a = b"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                     "bounded {x. \<not> (f x = x \<and> g x = x)}"
 proof -
   have 1: "\<exists>h k. homeomorphism T T h k \<and> h (f d) = d \<and>
               {x. \<not> (h x = x \<and> k x = x)} \<subseteq> S \<and> bounded {x. \<not> (h x = x \<and> k x = x)}"
         if "d \<in> S" "f d \<in> S" and homfg: "homeomorphism T T f g"
         and S: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
         and bo: "bounded {x. \<not> (f x = x \<and> g x = x)}" for d f g
   proof (intro exI conjI)
     show homgf: "homeomorphism T T g f"
       by (metis homeomorphism_symD homfg)
     then show "g (f d) = d"
       by (meson \<open>S \<subseteq> T\<close> homeomorphism_def subsetD \<open>d \<in> S\<close>)
     show "{x. \<not> (g x = x \<and> f x = x)} \<subseteq> S"
       using S by blast
     show "bounded {x. \<not> (g x = x \<and> f x = x)}"
       using bo by (simp add: conj_commute)
   qed
   have 2: "\<exists>f g. homeomorphism T T f g \<and> f x = f2 (f1 x) \<and>
                  {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
              if "x \<in> S" "f1 x \<in> S" "f2 (f1 x) \<in> S"
                 and hom: "homeomorphism T T f1 g1" "homeomorphism T T f2 g2"
                 and sub: "{x. \<not> (f1 x = x \<and> g1 x = x)} \<subseteq> S"   "{x. \<not> (f2 x = x \<and> g2 x = x)} \<subseteq> S"
                 and bo: "bounded {x. \<not> (f1 x = x \<and> g1 x = x)}"  "bounded {x. \<not> (f2 x = x \<and> g2 x = x)}"
              for x f1 f2 g1 g2
   proof (intro exI conjI)
     show homgf: "homeomorphism T T (f2 \<circ> f1) (g1 \<circ> g2)"
       by (metis homeomorphism_compose hom)
     then show "(f2 \<circ> f1) x = f2 (f1 x)"
       by force
     show "{x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)} \<subseteq> S"
       using sub by force
     have "bounded ({x. \<not>(f1 x = x \<and> g1 x = x)} \<union> {x. \<not>(f2 x = x \<and> g2 x = x)})"
       using bo by simp
     then show "bounded {x. \<not> ((f2 \<circ> f1) x = x \<and> (g1 \<circ> g2) x = x)}"
       by (rule bounded_subset) auto
   qed
   have 3: "\<exists>U. openin (top_of_set S) U \<and>
               d \<in> U \<and>
               (\<forall>x\<in>U.
                   \<exists>f g. homeomorphism T T f g \<and> f d = x \<and>
                         {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                         bounded {x. \<not> (f x = x \<and> g x = x)})"
            if "d \<in> S" for d
   proof -
     obtain r where "r > 0" and r: "ball d r \<inter> affine hull S \<subseteq> S"
       by (metis \<open>d \<in> S\<close> ope openin_contains_ball)
     have *: "\<exists>f g. homeomorphism T T f g \<and> f d = e \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and>
                    bounded {x. \<not> (f x = x \<and> g x = x)}" if "e \<in> S" "e \<in> ball d r" for e
       apply (rule homeomorphism_moving_point_3 [of "affine hull S" d r T d e])
       using r \<open>S \<subseteq> T\<close> TS that
             apply (auto simp: \<open>d \<in> S\<close> \<open>0 < r\<close> hull_inc)
       using bounded_subset by blast
     show ?thesis
       apply (rule_tac x="S \<inter> ball d r" in exI)
       apply (intro conjI)
         apply (simp add: openin_open_Int)
        apply (simp add: \<open>0 < r\<close> that)
       apply (blast intro: *)
       done
   qed
   have "\<exists>f g. homeomorphism T T f g \<and> f a = b \<and>
               {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     apply (rule connected_equivalence_relation [OF S], safe)
       apply (blast intro: 1 2 3)+
     done
   then show ?thesis
     using that by auto
 qed
 
 
 lemma homeomorphism_moving_points_exists_gen:
   assumes K: "finite K" "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
              "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and "2 \<le> aff_dim S"
       and ope: "openin (top_of_set (affine hull S)) S"
       and "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   shows "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   using assms
 proof (induction K)
   case empty
   then show ?case
     by (force simp: homeomorphism_ident)
 next
   case (insert i K)
   then have xney: "\<And>j. \<lbrakk>j \<in> K; j \<noteq> i\<rbrakk> \<Longrightarrow> x i \<noteq> x j \<and> y i \<noteq> y j"
        and pw: "pairwise (\<lambda>i j. x i \<noteq> x j \<and> y i \<noteq> y j) K"
        and "x i \<in> S" "y i \<in> S"
        and xyS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
     by (simp_all add: pairwise_insert)
   obtain f g where homfg: "homeomorphism T T f g" and feq: "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                and fg_sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S"
                and bo_fg: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert.IH [OF xyS pw] insert.prems by (blast intro: that)
   then have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(x i) = y i) \<and>
                    {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
     using insert by blast
   have aff_eq: "affine hull (S - y ` K) = affine hull S"
     apply (rule affine_hull_Diff)
     apply (auto simp: insert)
     using \<open>y i \<in> S\<close> insert.hyps(2) xney xyS by fastforce
   have f_in_S: "f x \<in> S" if "x \<in> S" for x
     using homfg fg_sub homeomorphism_apply1 \<open>S \<subseteq> T\<close>
   proof -
     have "(f (f x) \<noteq> f x \<or> g (f x) \<noteq> f x) \<or> f x \<in> S"
       by (metis \<open>S \<subseteq> T\<close> homfg subsetD homeomorphism_apply1 that)
     then show ?thesis
       using fg_sub by force
   qed
   obtain h k where homhk: "homeomorphism T T h k" and heq: "h (f (x i)) = y i"
                and hk_sub: "{x. \<not> (h x = x \<and> k x = x)} \<subseteq> S - y ` K"
                and bo_hk:  "bounded {x. \<not> (h x = x \<and> k x = x)}"
   proof (rule homeomorphism_moving_point [of "S - y`K" T "f(x i)" "y i"])
     show "openin (top_of_set (affine hull (S - y ` K))) (S - y ` K)"
       by (simp add: aff_eq openin_diff finite_imp_closedin image_subset_iff hull_inc insert xyS)
     show "S - y ` K \<subseteq> T"
       using \<open>S \<subseteq> T\<close> by auto
     show "T \<subseteq> affine hull (S - y ` K)"
       using insert by (simp add: aff_eq)
     show "connected (S - y ` K)"
     proof (rule connected_openin_diff_countable [OF \<open>connected S\<close> ope])
       show "\<not> collinear S"
         using collinear_aff_dim \<open>2 \<le> aff_dim S\<close> by force
       show "countable (y ` K)"
         using countable_finite insert.hyps(1) by blast
     qed
     show "f (x i) \<in> S - y ` K"
       apply (auto simp: f_in_S \<open>x i \<in> S\<close>)
         by (metis feq homfg \<open>x i \<in> S\<close> homeomorphism_def \<open>S \<subseteq> T\<close> \<open>i \<notin> K\<close> subsetCE xney xyS)
     show "y i \<in> S - y ` K"
       using insert.hyps xney by (auto simp: \<open>y i \<in> S\<close>)
   qed blast
   show ?case
   proof (intro exI conjI)
     show "homeomorphism T T (h \<circ> f) (g \<circ> k)"
       using homfg homhk homeomorphism_compose by blast
     show "\<forall>i \<in> insert i K. (h \<circ> f) (x i) = y i"
       using feq hk_sub by (auto simp: heq)
     show "{x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)} \<subseteq> S"
       using fg_sub hk_sub by force
     have "bounded ({x. \<not>(f x = x \<and> g x = x)} \<union> {x. \<not>(h x = x \<and> k x = x)})"
       using bo_fg bo_hk bounded_Un by blast
     then show "bounded {x. \<not> ((h \<circ> f) x = x \<and> (g \<circ> k) x = x)}"
       by (rule bounded_subset) auto
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_moving_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes 2: "2 \<le> DIM('a)" "open S" "connected S" "S \<subseteq> T" "finite K"
       and KS: "\<And>i. i \<in> K \<Longrightarrow> x i \<in> S \<and> y i \<in> S"
       and pw: "pairwise (\<lambda>i j. (x i \<noteq> x j) \<and> (y i \<noteq> y j)) K"
       and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f(x i) = y i"
                     "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using KS homeomorphism_ident that by fastforce
 next
   case False
   then have affS: "affine hull S = UNIV"
     by (simp add: affine_hull_open \<open>open S\<close>)
   then have ope: "openin (top_of_set (affine hull S)) S"
     using \<open>open S\<close> open_openin by auto
   have "2 \<le> DIM('a)" by (rule 2)
   also have "\<dots> = aff_dim (UNIV :: 'a set)"
     by simp
   also have "\<dots> \<le> aff_dim S"
     by (metis aff_dim_UNIV aff_dim_affine_hull aff_dim_le_DIM affS)
   finally have "2 \<le> aff_dim S"
     by linarith
   then show ?thesis
     using homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> KS pw _ ope S] that by fastforce
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>The theorem \<open>homeomorphism_grouping_points_exists\<close>\<close>
 
 lemma homeomorphism_grouping_point_1:
   fixes a::real and c::real
   assumes "a < b" "c < d"
   obtains f g where "homeomorphism (cbox a b) (cbox c d) f g" "f a = c" "f b = d"
 proof -
   define f where "f \<equiv> \<lambda>x. ((d - c) / (b - a)) * x + (c - a * ((d - c) / (b - a)))"
   have "\<exists>g. homeomorphism (cbox a b) (cbox c d) f g"
   proof (rule homeomorphism_compact)
     show "continuous_on (cbox a b) f"
       apply (simp add: f_def)
       apply (intro continuous_intros)
       using assms by auto
     have "f ` {a..b} = {c..d}"
       unfolding f_def image_affinity_atLeastAtMost
-      using assms sum_sqs_eq by (auto simp: field_split_simps algebra_simps)
+      using assms sum_sqs_eq by (auto simp: field_split_simps)
     then show "f ` cbox a b = cbox c d"
       by auto
     show "inj_on f (cbox a b)"
       unfolding f_def inj_on_def using assms by auto
   qed auto
   then obtain g where "homeomorphism (cbox a b) (cbox c d) f g" ..
   then show ?thesis
   proof
     show "f a = c"
       by (simp add: f_def)
     show "f b = d"
-      using assms sum_sqs_eq [of a b] by (auto simp: f_def field_split_simps algebra_simps)
+      using assms sum_sqs_eq [of a b] by (auto simp: f_def field_split_simps)
   qed
 qed
 
 lemma homeomorphism_grouping_point_2:
   fixes a::real and w::real
   assumes hom_ab: "homeomorphism (cbox a b) (cbox u v) f1 g1"
       and hom_bc: "homeomorphism (cbox b c) (cbox v w) f2 g2"
       and "b \<in> cbox a c" "v \<in> cbox u w"
       and eq: "f1 a = u" "f1 b = v" "f2 b = v" "f2 c = w"
  obtains f g where "homeomorphism (cbox a c) (cbox u w) f g" "f a = u" "f c = w"
                    "\<And>x. x \<in> cbox a b \<Longrightarrow> f x = f1 x" "\<And>x. x \<in> cbox b c \<Longrightarrow> f x = f2 x"
 proof -
   have le: "a \<le> b" "b \<le> c" "u \<le> v" "v \<le> w"
     using assms by simp_all
   then have ac: "cbox a c = cbox a b \<union> cbox b c" and uw: "cbox u w = cbox u v \<union> cbox v w"
     by auto
   define f where "f \<equiv> \<lambda>x. if x \<le> b then f1 x else f2 x"
   have "\<exists>g. homeomorphism (cbox a c) (cbox u w) f g"
   proof (rule homeomorphism_compact)
     have cf1: "continuous_on (cbox a b) f1"
       using hom_ab homeomorphism_cont1 by blast
     have cf2: "continuous_on (cbox b c) f2"
       using hom_bc homeomorphism_cont1 by blast
     show "continuous_on (cbox a c) f"
       apply (simp add: f_def)
       apply (rule continuous_on_cases_le [OF continuous_on_subset [OF cf1] continuous_on_subset [OF cf2]])
-      using le eq apply (force simp: continuous_on_id)+
+      using le eq apply (force)+
       done
     have "f ` cbox a b = f1 ` cbox a b" "f ` cbox b c = f2 ` cbox b c"
       unfolding f_def using eq by force+
     then show "f ` cbox a c = cbox u w"
       apply (simp only: ac uw image_Un)
       by (metis hom_ab hom_bc homeomorphism_def)
     have neq12: "f1 x \<noteq> f2 y" if x: "a \<le> x" "x \<le> b" and y: "b < y" "y \<le> c" for x y
     proof -
       have "f1 x \<in> cbox u v"
         by (metis hom_ab homeomorphism_def image_eqI mem_box_real(2) x)
       moreover have "f2 y \<in> cbox v w"
         by (metis (full_types) hom_bc homeomorphism_def image_subset_iff mem_box_real(2) not_le not_less_iff_gr_or_eq order_refl y)
       moreover have "f2 y \<noteq> f2 b"
         by (metis cancel_comm_monoid_add_class.diff_cancel diff_gt_0_iff_gt hom_bc homeomorphism_def le(2) less_imp_le less_numeral_extra(3) mem_box_real(2) order_refl y)
       ultimately show ?thesis
         using le eq by simp
     qed
     have "inj_on f1 (cbox a b)"
       by (metis (full_types) hom_ab homeomorphism_def inj_onI)
     moreover have "inj_on f2 (cbox b c)"
       by (metis (full_types) hom_bc homeomorphism_def inj_onI)
     ultimately show "inj_on f (cbox a c)"
       apply (simp (no_asm) add: inj_on_def)
       apply (simp add: f_def inj_on_eq_iff)
       using neq12  apply force
       done
   qed auto
   then obtain g where "homeomorphism (cbox a c) (cbox u w) f g" ..
   then show ?thesis
     apply (rule that)
     using eq le by (auto simp: f_def)
 qed
 
 lemma homeomorphism_grouping_point_3:
   fixes a::real
   assumes cbox_sub: "cbox c d \<subseteq> box a b" "cbox u v \<subseteq> box a b"
       and box_ne: "box c d \<noteq> {}" "box u v \<noteq> {}"
   obtains f g where "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                     "\<And>x. x \<in> cbox c d \<Longrightarrow> f x \<in> cbox u v"
 proof -
   have less: "a < c" "a < u" "d < b" "v < b" "c < d" "u < v" "cbox c d \<noteq> {}"
     using assms
     by (simp_all add: cbox_sub subset_eq)
   obtain f1 g1 where 1: "homeomorphism (cbox a c) (cbox a u) f1 g1"
                    and f1_eq: "f1 a = a" "f1 c = u"
     using homeomorphism_grouping_point_1 [OF \<open>a < c\<close> \<open>a < u\<close>] .
   obtain f2 g2 where 2: "homeomorphism (cbox c d) (cbox u v) f2 g2"
                    and f2_eq: "f2 c = u" "f2 d = v"
     using homeomorphism_grouping_point_1 [OF \<open>c < d\<close> \<open>u < v\<close>] .
   obtain f3 g3 where 3: "homeomorphism (cbox d b) (cbox v b) f3 g3"
                    and f3_eq: "f3 d = v" "f3 b = b"
     using homeomorphism_grouping_point_1 [OF \<open>d < b\<close> \<open>v < b\<close>] .
   obtain f4 g4 where 4: "homeomorphism (cbox a d) (cbox a v) f4 g4" and "f4 a = a" "f4 d = v"
                  and f4_eq: "\<And>x. x \<in> cbox a c \<Longrightarrow> f4 x = f1 x" "\<And>x. x \<in> cbox c d \<Longrightarrow> f4 x = f2 x"
     using homeomorphism_grouping_point_2 [OF 1 2] less  by (auto simp: f1_eq f2_eq)
   obtain f g where fg: "homeomorphism (cbox a b) (cbox a b) f g" "f a = a" "f b = b"
                and f_eq: "\<And>x. x \<in> cbox a d \<Longrightarrow> f x = f4 x" "\<And>x. x \<in> cbox d b \<Longrightarrow> f x = f3 x"
     using homeomorphism_grouping_point_2 [OF 4 3] less by (auto simp: f4_eq f3_eq f2_eq f1_eq)
   show ?thesis
     apply (rule that [OF fg])
     using f4_eq f_eq homeomorphism_image1 [OF 2]
     apply simp
     by (metis atLeastAtMost_iff box_real(1) box_real(2) cbox_sub(1) greaterThanLessThan_iff imageI less_eq_real_def subset_eq)
 qed
 
 
 lemma homeomorphism_grouping_point_4:
   fixes T :: "real set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g"
                     "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}"
 proof -
   obtain c d where "box c d \<noteq> {}" "cbox c d \<subseteq> U"
   proof -
     obtain u where "u \<in> U"
       using \<open>U \<noteq> {}\<close> by blast
     then obtain e where "e > 0" "cball u e \<subseteq> U"
       using \<open>open U\<close> open_contains_cball by blast
     then show ?thesis
       by (rule_tac c=u and d="u+e" in that) (auto simp: dist_norm subset_iff)
   qed
   have "compact K"
     by (simp add: \<open>finite K\<close> finite_imp_compact)
   obtain a b where "box a b \<noteq> {}" "K \<subseteq> cbox a b" "cbox a b \<subseteq> S"
   proof (cases "K = {}")
     case True then show ?thesis
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> that by blast
   next
     case False
     then obtain a b where "a \<in> K" "b \<in> K"
             and a: "\<And>x. x \<in> K \<Longrightarrow> a \<le> x" and b: "\<And>x. x \<in> K \<Longrightarrow> x \<le> b"
       using compact_attains_inf compact_attains_sup by (metis \<open>compact K\<close>)+
     obtain e where "e > 0" "cball b e \<subseteq> S"
       using \<open>open S\<close> open_contains_cball
       by (metis \<open>b \<in> K\<close> \<open>K \<subseteq> S\<close> subsetD)
     show ?thesis
     proof
       show "box a (b + e) \<noteq> {}"
         using \<open>0 < e\<close> \<open>b \<in> K\<close> a by force
       show "K \<subseteq> cbox a (b + e)"
         using \<open>0 < e\<close> a b by fastforce
       have "a \<in> S"
         using \<open>a \<in> K\<close> assms(6) by blast
       have "b + e \<in> S"
         using \<open>0 < e\<close> \<open>cball b e \<subseteq> S\<close>  by (force simp: dist_norm)
       show "cbox a (b + e) \<subseteq> S"
         using \<open>a \<in> S\<close> \<open>b + e \<in> S\<close> \<open>connected S\<close> connected_contains_Icc by auto
     qed
   qed
   obtain w z where "cbox w z \<subseteq> S" and sub_wz: "cbox a b \<union> cbox c d \<subseteq> box w z"
   proof -
     have "a \<in> S" "b \<in> S"
       using \<open>box a b \<noteq> {}\<close> \<open>cbox a b \<subseteq> S\<close> by auto
     moreover have "c \<in> S" "d \<in> S"
       using \<open>box c d \<noteq> {}\<close> \<open>cbox c d \<subseteq> U\<close> \<open>U \<subseteq> S\<close> by force+
     ultimately have "min a c \<in> S" "max b d \<in> S"
       by linarith+
     then obtain e1 e2 where "e1 > 0" "cball (min a c) e1 \<subseteq> S" "e2 > 0" "cball (max b d) e2 \<subseteq> S"
       using \<open>open S\<close> open_contains_cball by metis
     then have *: "min a c - e1 \<in> S" "max b d + e2 \<in> S"
       by (auto simp: dist_norm)
     show ?thesis
     proof
       show "cbox (min a c - e1) (max b d+ e2) \<subseteq> S"
         using * \<open>connected S\<close> connected_contains_Icc by auto
       show "cbox a b \<union> cbox c d \<subseteq> box (min a c - e1) (max b d + e2)"
         using \<open>0 < e1\<close> \<open>0 < e2\<close> by auto
     qed
   qed
   then
   obtain f g where hom: "homeomorphism (cbox w z) (cbox w z) f g"
                and "f w = w" "f z = z"
                and fin: "\<And>x. x \<in> cbox a b \<Longrightarrow> f x \<in> cbox c d"
     using homeomorphism_grouping_point_3 [of a b w z c d]
     using \<open>box a b \<noteq> {}\<close> \<open>box c d \<noteq> {}\<close> by blast
   have contfg: "continuous_on (cbox w z) f" "continuous_on (cbox w z) g"
     using hom homeomorphism_def by blast+
   define f' where "f' \<equiv> \<lambda>x. if x \<in> cbox w z then f x else x"
   define g' where "g' \<equiv> \<lambda>x. if x \<in> cbox w z then g x else x"
   show ?thesis
   proof
     have T: "cbox w z \<union> (T - box w z) = T"
       using \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> by auto
     show "homeomorphism T T f' g'"
     proof
       have clo: "closedin (top_of_set (cbox w z \<union> (T - box w z))) (T - box w z)"
         by (metis Diff_Diff_Int Diff_subset T closedin_def open_box openin_open_Int topspace_euclidean_subtopology)
       have "continuous_on (cbox w z \<union> (T - box w z)) f'" "continuous_on (cbox w z \<union> (T - box w z)) g'"
         unfolding f'_def g'_def
          apply (safe intro!: continuous_on_cases_local contfg continuous_on_id clo)
          apply (simp_all add: closed_subset)
         using \<open>f w = w\<close> \<open>f z = z\<close> apply force
         by (metis \<open>f w = w\<close> \<open>f z = z\<close> hom homeomorphism_def less_eq_real_def mem_box_real(2))
       then show "continuous_on T f'" "continuous_on T g'"
         by (simp_all only: T)
       show "f' ` T \<subseteq> T"
         unfolding f'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "g' ` T \<subseteq> T"
         unfolding g'_def
         by clarsimp (metis \<open>cbox w z \<subseteq> S\<close> \<open>S \<subseteq> T\<close> subsetD hom homeomorphism_def imageI mem_box_real(2))
       show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
         unfolding f'_def g'_def
         using homeomorphism_apply1 [OF hom]  homeomorphism_image1 [OF hom] by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
         unfolding f'_def g'_def
         using homeomorphism_apply2 [OF hom]  homeomorphism_image2 [OF hom] by fastforce
     qed
     show "\<And>x. x \<in> K \<Longrightarrow> f' x \<in> U"
       using fin sub_wz \<open>K \<subseteq> cbox a b\<close> \<open>cbox c d \<subseteq> U\<close> by (force simp: f'_def)
     show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
       using \<open>cbox w z \<subseteq> S\<close> by (auto simp: f'_def g'_def)
     show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
       apply (rule bounded_subset [of "cbox w z"])
       using bounded_cbox apply blast
       apply (auto simp: f'_def g'_def)
       done
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists:
   fixes S :: "'a::euclidean_space set"
   assumes "open U" "open S" "connected S" "U \<noteq> {}" "finite K" "K \<subseteq> S" "U \<subseteq> S" "S \<subseteq> T"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> DIM('a)")
   case True
   have TS: "T \<subseteq> affine hull S"
     using affine_hull_open assms by blast
   have "infinite U"
     using \<open>open U\<close> \<open>U \<noteq> {}\<close> finite_imp_not_open by blast
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   obtain f g where "homeomorphism T T f g" "\<And>i. i \<in> K \<Longrightarrow> f (id i) = \<gamma> i" "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> S" "bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists [OF True \<open>open S\<close> \<open>connected S\<close> \<open>S \<subseteq> T\<close> \<open>finite K\<close>])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       using \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> \<open>U \<subseteq> S\<close> bij_betwE by blast
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed (use affine_hull_open assms that in auto)
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
 next
   case False
   with DIM_positive have "DIM('a) = 1"
     by (simp add: dual_order.antisym)
   then obtain h::"'a \<Rightarrow>real" and j
   where "linear h" "linear j"
     and noh: "\<And>x. norm(h x) = norm x" and noj: "\<And>y. norm(j y) = norm y"
     and hj:  "\<And>x. j(h x) = x" "\<And>y. h(j y) = y"
     and ranh: "surj h"
     using isomorphisms_UNIV_UNIV
     by (metis (mono_tags, hide_lams) DIM_real UNIV_eq_I range_eqI)
   obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
     apply (rule homeomorphism_grouping_point_4 [of "h ` U" "h ` S" "h ` K" "h ` T"])
     by (simp_all add: assms image_mono  \<open>linear h\<close> open_surjective_linear_image connected_linear_image ranh)
   have jf: "j (f (h x)) = x \<longleftrightarrow> f (h x) = h x" for x
     by (metis hj)
   have jg: "j (g (h x)) = x \<longleftrightarrow> g (h x) = h x" for x
     by (metis hj)
   have cont_hj: "continuous_on X h"  "continuous_on Y j" for X Y
     by (simp_all add: \<open>linear h\<close> \<open>linear j\<close> linear_linear linear_continuous_on)
   show ?thesis
   proof
     show "homeomorphism T T (j \<circ> f \<circ> h) (j \<circ> g \<circ> h)"
     proof
       show "continuous_on T (j \<circ> f \<circ> h)" "continuous_on T (j \<circ> g \<circ> h)"
         using hom homeomorphism_def
         by (blast intro: continuous_on_compose cont_hj)+
       show "(j \<circ> f \<circ> h) ` T \<subseteq> T" "(j \<circ> g \<circ> h) ` T \<subseteq> T"
         by auto (metis (mono_tags, hide_lams) hj(1) hom homeomorphism_def imageE imageI)+
       show "\<And>x. x \<in> T \<Longrightarrow> (j \<circ> g \<circ> h) ((j \<circ> f \<circ> h) x) = x"
         using hj hom homeomorphism_apply1 by fastforce
       show "\<And>y. y \<in> T \<Longrightarrow> (j \<circ> f \<circ> h) ((j \<circ> g \<circ> h) y) = y"
         using hj hom homeomorphism_apply2 by fastforce
     qed
     show "{x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} \<subseteq> S"
       apply (clarsimp simp: jf jg hj)
       using sub hj
       apply (drule_tac c="h x" in subsetD, force)
       by (metis imageE)
     have "bounded (j ` {x. (\<not> (f x = x \<and> g x = x))})"
       by (rule bounded_linear_image [OF bou]) (use \<open>linear j\<close> linear_conv_bounded_linear in auto)
     moreover
     have *: "{x. \<not>((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
       using hj by (auto simp: jf jg image_iff, metis+)
     ultimately show "bounded {x. \<not> ((j \<circ> f \<circ> h) x = x \<and> (j \<circ> g \<circ> h) x = x)}"
       by metis
     show "\<And>x. x \<in> K \<Longrightarrow> (j \<circ> f \<circ> h) x \<in> U"
       using f hj by fastforce
   qed
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> homeomorphism_grouping_points_exists_gen:
   fixes S :: "'a::euclidean_space set"
   assumes opeU: "openin (top_of_set S) U"
       and opeS: "openin (top_of_set (affine hull S)) S"
       and "U \<noteq> {}" "finite K" "K \<subseteq> S" and S: "S \<subseteq> T" "T \<subseteq> affine hull S" "connected S"
   obtains f g where "homeomorphism T T f g" "{x. (\<not> (f x = x \<and> g x = x))} \<subseteq> S"
                     "bounded {x. (\<not> (f x = x \<and> g x = x))}" "\<And>x. x \<in> K \<Longrightarrow> f x \<in> U"
 proof (cases "2 \<le> aff_dim S")
   case True
   have opeU': "openin (top_of_set (affine hull S)) U"
     using opeS opeU openin_trans by blast
   obtain u where "u \<in> U" "u \<in> S"
     using \<open>U \<noteq> {}\<close> opeU openin_imp_subset by fastforce+
   have "infinite U"
     apply (rule infinite_openin [OF opeU \<open>u \<in> U\<close>])
     apply (rule connected_imp_perfect_aff_dim [OF \<open>connected S\<close> _ \<open>u \<in> S\<close>])
     using True apply simp
     done
   then obtain P where "P \<subseteq> U" "finite P" "card K = card P"
     using infinite_arbitrarily_large by metis
   then obtain \<gamma> where \<gamma>: "bij_betw \<gamma> K P"
     using \<open>finite K\<close> finite_same_card_bij by blast
   have "\<exists>f g. homeomorphism T T f g \<and> (\<forall>i \<in> K. f(id i) = \<gamma> i) \<and>
                {x. \<not> (f x = x \<and> g x = x)} \<subseteq> S \<and> bounded {x. \<not> (f x = x \<and> g x = x)}"
   proof (rule homeomorphism_moving_points_exists_gen [OF \<open>finite K\<close> _ _ True opeS S])
     show "\<And>i. i \<in> K \<Longrightarrow> id i \<in> S \<and> \<gamma> i \<in> S"
       by (metis id_apply opeU openin_contains_cball subsetCE \<open>P \<subseteq> U\<close> \<open>bij_betw \<gamma> K P\<close> \<open>K \<subseteq> S\<close> bij_betwE)
     show "pairwise (\<lambda>i j. id i \<noteq> id j \<and> \<gamma> i \<noteq> \<gamma> j) K"
       using \<gamma> by (auto simp: pairwise_def bij_betw_def inj_on_def)
   qed
   then show ?thesis
     using \<gamma> \<open>P \<subseteq> U\<close> bij_betwE by (fastforce simp add: intro!: that)
 next
   case False
   with aff_dim_geq [of S] consider "aff_dim S = -1" | "aff_dim S = 0" | "aff_dim S = 1" by linarith
   then show ?thesis
   proof cases
     assume "aff_dim S = -1"
     then have "S = {}"
       using aff_dim_empty by blast
     then have "False"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     then show ?thesis ..
   next
     assume "aff_dim S = 0"
     then obtain a where "S = {a}"
       using aff_dim_eq_0 by blast
     then have "K \<subseteq> U"
       using \<open>U \<noteq> {}\<close> \<open>K \<subseteq> S\<close> openin_imp_subset [OF opeU] by blast
     show ?thesis
       apply (rule that [of id id])
-      using \<open>K \<subseteq> U\<close> by (auto simp: continuous_on_id intro: homeomorphismI)
+      using \<open>K \<subseteq> U\<close> by (auto intro: homeomorphismI)
   next
     assume "aff_dim S = 1"
     then have "affine hull S homeomorphic (UNIV :: real set)"
       by (auto simp: homeomorphic_affine_sets)
     then obtain h::"'a\<Rightarrow>real" and j where homhj: "homeomorphism (affine hull S) UNIV h j"
       using homeomorphic_def by blast
     then have h: "\<And>x. x \<in> affine hull S \<Longrightarrow> j(h(x)) = x" and j: "\<And>y. j y \<in> affine hull S \<and> h(j y) = y"
       by (auto simp: homeomorphism_def)
     have connh: "connected (h ` S)"
       by (meson Topological_Spaces.connected_continuous_image \<open>connected S\<close> homeomorphism_cont1 homeomorphism_of_subsets homhj hull_subset top_greatest)
     have hUS: "h ` U \<subseteq> h ` S"
       by (meson homeomorphism_imp_open_map homeomorphism_of_subsets homhj hull_subset opeS opeU open_UNIV openin_open_eq)
     have opn: "openin (top_of_set (affine hull S)) U \<Longrightarrow> open (h ` U)" for U
       using homeomorphism_imp_open_map [OF homhj]  by simp
     have "open (h ` U)" "open (h ` S)"
       by (auto intro: opeS opeU openin_trans opn)
     then obtain f g where hom: "homeomorphism (h ` T) (h ` T) f g"
                  and f: "\<And>x. x \<in> h ` K \<Longrightarrow> f x \<in> h ` U"
                  and sub: "{x. \<not> (f x = x \<and> g x = x)} \<subseteq> h ` S"
                  and bou: "bounded {x. \<not> (f x = x \<and> g x = x)}"
       apply (rule homeomorphism_grouping_points_exists [of "h ` U" "h ` S" "h ` K" "h ` T"])
       using assms by (auto simp: connh hUS)
     have jf: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (f (h x)) = x \<longleftrightarrow> f (h x) = h x"
       by (metis h j)
     have jg: "\<And>x. x \<in> affine hull S \<Longrightarrow> j (g (h x)) = x \<longleftrightarrow> g (h x) = h x"
       by (metis h j)
     have cont_hj: "continuous_on T h"  "continuous_on Y j" for Y
       apply (rule continuous_on_subset [OF _ \<open>T \<subseteq> affine hull S\<close>])
       using homeomorphism_def homhj apply blast
       by (meson continuous_on_subset homeomorphism_def homhj top_greatest)
     define f' where "f' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> f \<circ> h) x else x"
     define g' where "g' \<equiv> \<lambda>x. if x \<in> affine hull S then (j \<circ> g \<circ> h) x else x"
     show ?thesis
     proof
       show "homeomorphism T T f' g'"
       proof
         have "continuous_on T (j \<circ> f \<circ> h)"
           apply (intro continuous_on_compose cont_hj)
           using hom homeomorphism_def by blast
         then show "continuous_on T f'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> f'_def by auto
         have "continuous_on T (j \<circ> g \<circ> h)"
           apply (intro continuous_on_compose cont_hj)
           using hom homeomorphism_def by blast
         then show "continuous_on T g'"
           apply (rule continuous_on_eq)
           using \<open>T \<subseteq> affine hull S\<close> g'_def by auto
         show "f' ` T \<subseteq> T"
         proof (clarsimp simp: f'_def)
           fix x assume "x \<in> T"
           then have "f (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (f (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "g' ` T \<subseteq> T"
         proof (clarsimp simp: g'_def)
           fix x assume "x \<in> T"
           then have "g (h x) \<in> h ` T"
             by (metis (no_types) hom homeomorphism_def image_subset_iff subset_refl)
           then show "j (g (h x)) \<in> T"
             using \<open>T \<subseteq> affine hull S\<close> h by auto
         qed
         show "\<And>x. x \<in> T \<Longrightarrow> g' (f' x) = x"
           using h j hom homeomorphism_apply1 by (fastforce simp add: f'_def g'_def)
         show "\<And>y. y \<in> T \<Longrightarrow> f' (g' y) = y"
           using h j hom homeomorphism_apply2 by (fastforce simp add: f'_def g'_def)
       qed
     next
       show "{x. \<not> (f' x = x \<and> g' x = x)} \<subseteq> S"
         apply (clarsimp simp: f'_def g'_def jf jg)
         apply (rule imageE [OF subsetD [OF sub]], force)
         by (metis h hull_inc)
     next
       have "compact (j ` closure {x. \<not> (f x = x \<and> g x = x)})"
         using bou by (auto simp: compact_continuous_image cont_hj)
       then have "bounded (j ` {x. \<not> (f x = x \<and> g x = x)})"
         by (rule bounded_closure_image [OF compact_imp_bounded])
       moreover
       have *: "{x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x} = j ` {x. (\<not> (f x = x \<and> g x = x))}"
         using h j by (auto simp: image_iff; metis)
       ultimately have "bounded {x \<in> affine hull S. j (f (h x)) \<noteq> x \<or> j (g (h x)) \<noteq> x}"
         by metis
       then show "bounded {x. \<not> (f' x = x \<and> g' x = x)}"
         by (simp add: f'_def g'_def Collect_mono bounded_subset)
     next
       show "f' x \<in> U" if "x \<in> K" for x
       proof -
         have "U \<subseteq> S"
           using opeU openin_imp_subset by blast
         then have "j (f (h x)) \<in> U"
           using f h hull_subset that by fastforce
         then show "f' x \<in> U"
           using \<open>K \<subseteq> S\<close> S f'_def that by auto
       qed
     qed
   qed
 qed
 
 
 subsection\<open>Nullhomotopic mappings\<close>
 
 text\<open> A mapping out of a sphere is nullhomotopic iff it extends to the ball.
 This even works out in the degenerate cases when the radius is \<open>\<le>\<close> 0, and
 we also don't need to explicitly assume continuity since it's already implicit
 in both sides of the equivalence.\<close>
 
 lemma nullhomotopic_from_lemma:
   assumes contg: "continuous_on (cball a r - {a}) g"
       and fa: "\<And>e. 0 < e
                \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>x. x \<noteq> a \<and> norm(x - a) < d \<longrightarrow> norm(g x - f a) < e)"
       and r: "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> f x = g x"
     shows "continuous_on (cball a r) f"
 proof (clarsimp simp: continuous_on_eq_continuous_within Ball_def)
   fix x
   assume x: "dist a x \<le> r"
   show "continuous (at x within cball a r) f"
   proof (cases "x=a")
     case True
     then show ?thesis
       by (metis continuous_within_eps_delta fa dist_norm dist_self r)
   next
     case False
     show ?thesis
     proof (rule continuous_transform_within [where f=g and d = "norm(x-a)"])
       have "\<exists>d>0. \<forall>x'\<in>cball a r.
                       dist x' x < d \<longrightarrow> dist (g x') (g x) < e" if "e>0" for e
       proof -
         obtain d where "d > 0"
            and d: "\<And>x'. \<lbrakk>dist x' a \<le> r; x' \<noteq> a; dist x' x < d\<rbrakk> \<Longrightarrow>
                                  dist (g x') (g x) < e"
           using contg False x \<open>e>0\<close>
           unfolding continuous_on_iff by (fastforce simp add: dist_commute intro: that)
         show ?thesis
           using \<open>d > 0\<close> \<open>x \<noteq> a\<close>
           by (rule_tac x="min d (norm(x - a))" in exI)
              (auto simp: dist_commute dist_norm [symmetric]  intro!: d)
       qed
       then show "continuous (at x within cball a r) g"
         using contg False by (auto simp: continuous_within_eps_delta)
       show "0 < norm (x - a)"
         using False by force
       show "x \<in> cball a r"
         by (simp add: x)
       show "\<And>x'. \<lbrakk>x' \<in> cball a r; dist x' x < norm (x - a)\<rbrakk>
         \<Longrightarrow> g x' = f x'"
         by (metis dist_commute dist_norm less_le r)
     qed
   qed
 qed
 
 proposition nullhomotopic_from_sphere_extension:
   fixes f :: "'M::euclidean_space \<Rightarrow> 'a::real_normed_vector"
   shows  "(\<exists>c. homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)) \<longleftrightarrow>
           (\<exists>g. continuous_on (cball a r) g \<and> g ` (cball a r) \<subseteq> S \<and>
                (\<forall>x \<in> sphere a r. g x = f x))"
          (is "?lhs = ?rhs")
 proof (cases r "0::real" rule: linorder_cases)
   case less
   then show ?thesis
     by (simp add: homotopic_on_emptyI)
 next
   case equal
   then show ?thesis
     apply (auto simp: homotopic_with)
     apply (rule_tac x="\<lambda>x. h (0, a)" in exI)
      apply (fastforce simp add:)
     using continuous_on_const by blast
 next
   case greater
   let ?P = "continuous_on {x. norm(x - a) = r} f \<and> f ` {x. norm(x - a) = r} \<subseteq> S"
   have ?P if ?lhs using that
   proof
     fix c
     assume c: "homotopic_with_canon (\<lambda>x. True) (sphere a r) S f (\<lambda>x. c)"
     then have contf: "continuous_on (sphere a r) f" 
       by (metis homotopic_with_imp_continuous)
     moreover have fim: "f ` sphere a r \<subseteq> S"
       by (meson continuous_map_subtopology_eu c homotopic_with_imp_continuous_maps)
     show ?P
       using contf fim by (auto simp: sphere_def dist_norm norm_minus_commute)
   qed
   moreover have ?P if ?rhs using that
   proof
     fix g
     assume g: "continuous_on (cball a r) g \<and> g ` cball a r \<subseteq> S \<and> (\<forall>xa\<in>sphere a r. g xa = f xa)"
     then
     show ?P
       apply (safe elim!: continuous_on_eq [OF continuous_on_subset])
       apply (auto simp: dist_norm norm_minus_commute)
       by (metis dist_norm image_subset_iff mem_sphere norm_minus_commute sphere_cball subsetCE)
   qed
   moreover have ?thesis if ?P
   proof
     assume ?lhs
     then obtain c where "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. c) f"
       using homotopic_with_sym by blast
     then obtain h where conth: "continuous_on ({0..1::real} \<times> sphere a r) h"
                     and him: "h ` ({0..1} \<times> sphere a r) \<subseteq> S"
                     and h: "\<And>x. h(0, x) = c" "\<And>x. h(1, x) = f x"
       by (auto simp: homotopic_with_def)
     obtain b1::'M where "b1 \<in> Basis"
       using SOME_Basis by auto
     have "c \<in> S"
       apply (rule him [THEN subsetD])
       apply (rule_tac x = "(0, a + r *\<^sub>R b1)" in image_eqI)
       using h greater \<open>b1 \<in> Basis\<close>
        apply (auto simp: dist_norm)
       done
     have uconth: "uniformly_continuous_on ({0..1::real} \<times> (sphere a r)) h"
       by (force intro: compact_Times conth compact_uniformly_continuous)
     let ?g = "\<lambda>x. h (norm (x - a)/r,
                      a + (if x = a then r *\<^sub>R b1 else (r / norm(x - a)) *\<^sub>R (x - a)))"
     let ?g' = "\<lambda>x. h (norm (x - a)/r, a + (r / norm(x - a)) *\<^sub>R (x - a))"
     show ?rhs
     proof (intro exI conjI)
       have "continuous_on (cball a r - {a}) ?g'"
         apply (rule continuous_on_compose2 [OF conth])
          apply (intro continuous_intros)
         using greater apply (auto simp: dist_norm norm_minus_commute)
         done
       then show "continuous_on (cball a r) ?g"
       proof (rule nullhomotopic_from_lemma)
         show "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> norm (?g' x - ?g a) < e" if "0 < e" for e
         proof -
           obtain d where "0 < d"
              and d: "\<And>x x'. \<lbrakk>x \<in> {0..1} \<times> sphere a r; x' \<in> {0..1} \<times> sphere a r; dist x' x < d\<rbrakk>
                         \<Longrightarrow> dist (h x') (h x) < e"
             using uniformly_continuous_onE [OF uconth \<open>0 < e\<close>] by auto
           have *: "norm (h (norm (x - a) / r,
                          a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) < e"
                    if "x \<noteq> a" "norm (x - a) < r" "norm (x - a) < d * r" for x
           proof -
             have "norm (h (norm (x - a) / r, a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + r *\<^sub>R b1)) =
                   norm (h (norm (x - a) / r, a + (r / norm (x - a)) *\<^sub>R (x - a)) - h (0, a + (r / norm (x - a)) *\<^sub>R (x - a)))"
               by (simp add: h)
             also have "\<dots> < e"
               apply (rule d [unfolded dist_norm])
               using greater \<open>0 < d\<close> \<open>b1 \<in> Basis\<close> that
                 by (simp_all add: dist_norm) (simp add: field_simps)
             finally show ?thesis .
           qed
           show ?thesis
             apply (rule_tac x = "min r (d * r)" in exI)
             using greater \<open>0 < d\<close> by (auto simp: *)
         qed
         show "\<And>x. x \<in> cball a r \<and> x \<noteq> a \<Longrightarrow> ?g x = ?g' x"
           by auto
       qed
     next
       show "?g ` cball a r \<subseteq> S"
         using greater him \<open>c \<in> S\<close>
         by (force simp: h dist_norm norm_minus_commute)
     next
       show "\<forall>x\<in>sphere a r. ?g x = f x"
         using greater by (auto simp: h dist_norm norm_minus_commute)
     qed
   next
     assume ?rhs
     then obtain g where contg: "continuous_on (cball a r) g"
                     and gim: "g ` cball a r \<subseteq> S"
                     and gf: "\<forall>x \<in> sphere a r. g x = f x"
       by auto
     let ?h = "\<lambda>y. g (a + (fst y) *\<^sub>R (snd y - a))"
     have "continuous_on ({0..1} \<times> sphere a r) ?h"
     proof (rule continuous_on_compose2 [OF contg])
       show "continuous_on ({0..1} \<times> sphere a r) (\<lambda>x. a + fst x *\<^sub>R (snd x - a))"
         by (intro continuous_intros)
       qed (auto simp: dist_norm norm_minus_commute mult_left_le_one_le)
     moreover
     have "?h ` ({0..1} \<times> sphere a r) \<subseteq> S"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gim [THEN subsetD])
     moreover
     have "\<forall>x\<in>sphere a r. ?h (0, x) = g a" "\<forall>x\<in>sphere a r. ?h (1, x) = f x"
       by (auto simp: dist_norm norm_minus_commute mult_left_le_one_le gf)
     ultimately have "homotopic_with_canon (\<lambda>x. True) (sphere a r) S (\<lambda>x. g a) f"
       by (auto simp: homotopic_with)
     then show ?lhs
       using homotopic_with_symD by blast
   qed
   ultimately
   show ?thesis by meson
 qed 
 
 end
\ No newline at end of file
diff --git a/src/HOL/Analysis/Lebesgue_Measure.thy b/src/HOL/Analysis/Lebesgue_Measure.thy
--- a/src/HOL/Analysis/Lebesgue_Measure.thy
+++ b/src/HOL/Analysis/Lebesgue_Measure.thy
@@ -1,1813 +1,1813 @@
 (*  Title:      HOL/Analysis/Lebesgue_Measure.thy
     Author:     Johannes Hölzl, TU München
     Author:     Robert Himmelmann, TU München
     Author:     Jeremy Avigad
     Author:     Luke Serafin
 *)
 
 section \<open>Lebesgue Measure\<close>
 
 theory Lebesgue_Measure
 imports
   Finite_Product_Measure
   Caratheodory
   Complete_Measure
   Summation_Tests
   Regularity
 begin
 
 lemma measure_eqI_lessThan:
   fixes M N :: "real measure"
   assumes sets: "sets M = sets borel" "sets N = sets borel"
   assumes fin: "\<And>x. emeasure M {x <..} < \<infinity>"
   assumes "\<And>x. emeasure M {x <..} = emeasure N {x <..}"
   shows "M = N"
 proof (rule measure_eqI_generator_eq_countable)
   let ?LT = "\<lambda>a::real. {a <..}" let ?E = "range ?LT"
   show "Int_stable ?E"
     by (auto simp: Int_stable_def lessThan_Int_lessThan)
 
   show "?E \<subseteq> Pow UNIV" "sets M = sigma_sets UNIV ?E" "sets N = sigma_sets UNIV ?E"
     unfolding sets borel_Ioi by auto
 
   show "?LT`Rats \<subseteq> ?E" "(\<Union>i\<in>Rats. ?LT i) = UNIV" "\<And>a. a \<in> ?LT`Rats \<Longrightarrow> emeasure M a \<noteq> \<infinity>"
     using fin by (auto intro: Rats_no_bot_less simp: less_top)
 qed (auto intro: assms countable_rat)
 
 subsection \<open>Measures defined by monotonous functions\<close>
 
 text \<open>
   Every right-continuous and nondecreasing function gives rise to a measure on the reals:
 \<close>
 
 definition\<^marker>\<open>tag important\<close> interval_measure :: "(real \<Rightarrow> real) \<Rightarrow> real measure" where
   "interval_measure F =
      extend_measure UNIV {(a, b). a \<le> b} (\<lambda>(a, b). {a<..b}) (\<lambda>(a, b). ennreal (F b - F a))"
 
 lemma\<^marker>\<open>tag important\<close> emeasure_interval_measure_Ioc:
   assumes "a \<le> b"
   assumes mono_F: "\<And>x y. x \<le> y \<Longrightarrow> F x \<le> F y"
   assumes right_cont_F : "\<And>a. continuous (at_right a) F"
   shows "emeasure (interval_measure F) {a<..b} = F b - F a"
 proof (rule extend_measure_caratheodory_pair[OF interval_measure_def \<open>a \<le> b\<close>])
   show "semiring_of_sets UNIV {{a<..b} |a b :: real. a \<le> b}"
   proof (unfold_locales, safe)
     fix a b c d :: real assume *: "a \<le> b" "c \<le> d"
     then show "\<exists>C\<subseteq>{{a<..b} |a b. a \<le> b}. finite C \<and> disjoint C \<and> {a<..b} - {c<..d} = \<Union>C"
     proof cases
       let ?C = "{{a<..b}}"
       assume "b < c \<or> d \<le> a \<or> d \<le> c"
       with * have "?C \<subseteq> {{a<..b} |a b. a \<le> b} \<and> finite ?C \<and> disjoint ?C \<and> {a<..b} - {c<..d} = \<Union>?C"
         by (auto simp add: disjoint_def)
       thus ?thesis ..
     next
       let ?C = "{{a<..c}, {d<..b}}"
       assume "\<not> (b < c \<or> d \<le> a \<or> d \<le> c)"
       with * have "?C \<subseteq> {{a<..b} |a b. a \<le> b} \<and> finite ?C \<and> disjoint ?C \<and> {a<..b} - {c<..d} = \<Union>?C"
         by (auto simp add: disjoint_def Ioc_inj) (metis linear)+
       thus ?thesis ..
     qed
   qed (auto simp: Ioc_inj, metis linear)
 next
   fix l r :: "nat \<Rightarrow> real" and a b :: real
   assume l_r[simp]: "\<And>n. l n \<le> r n" and "a \<le> b" and disj: "disjoint_family (\<lambda>n. {l n<..r n})"
   assume lr_eq_ab: "(\<Union>i. {l i<..r i}) = {a<..b}"
 
   have [intro, simp]: "\<And>a b. a \<le> b \<Longrightarrow> F a \<le> F b"
     by (auto intro!: l_r mono_F)
 
   { fix S :: "nat set" assume "finite S"
     moreover note \<open>a \<le> b\<close>
     moreover have "\<And>i. i \<in> S \<Longrightarrow> {l i <.. r i} \<subseteq> {a <.. b}"
       unfolding lr_eq_ab[symmetric] by auto
     ultimately have "(\<Sum>i\<in>S. F (r i) - F (l i)) \<le> F b - F a"
     proof (induction S arbitrary: a rule: finite_psubset_induct)
       case (psubset S)
       show ?case
       proof cases
         assume "\<exists>i\<in>S. l i < r i"
         with \<open>finite S\<close> have "Min (l ` {i\<in>S. l i < r i}) \<in> l ` {i\<in>S. l i < r i}"
           by (intro Min_in) auto
         then obtain m where m: "m \<in> S" "l m < r m" "l m = Min (l ` {i\<in>S. l i < r i})"
           by fastforce
 
         have "(\<Sum>i\<in>S. F (r i) - F (l i)) = (F (r m) - F (l m)) + (\<Sum>i\<in>S - {m}. F (r i) - F (l i))"
           using m psubset by (intro sum.remove) auto
         also have "(\<Sum>i\<in>S - {m}. F (r i) - F (l i)) \<le> F b - F (r m)"
         proof (intro psubset.IH)
           show "S - {m} \<subset> S"
             using \<open>m\<in>S\<close> by auto
           show "r m \<le> b"
             using psubset.prems(2)[OF \<open>m\<in>S\<close>] \<open>l m < r m\<close> by auto
         next
           fix i assume "i \<in> S - {m}"
           then have i: "i \<in> S" "i \<noteq> m" by auto
           { assume i': "l i < r i" "l i < r m"
             with \<open>finite S\<close> i m have "l m \<le> l i"
               by auto
             with i' have "{l i <.. r i} \<inter> {l m <.. r m} \<noteq> {}"
               by auto
             then have False
               using disjoint_family_onD[OF disj, of i m] i by auto }
           then have "l i \<noteq> r i \<Longrightarrow> r m \<le> l i"
             unfolding not_less[symmetric] using l_r[of i] by auto
           then show "{l i <.. r i} \<subseteq> {r m <.. b}"
             using psubset.prems(2)[OF \<open>i\<in>S\<close>] by auto
         qed
         also have "F (r m) - F (l m) \<le> F (r m) - F a"
           using psubset.prems(2)[OF \<open>m \<in> S\<close>] \<open>l m < r m\<close>
           by (auto simp add: Ioc_subset_iff intro!: mono_F)
         finally show ?case
           by (auto intro: add_mono)
       qed (auto simp add: \<open>a \<le> b\<close> less_le)
     qed }
   note claim1 = this
 
   (* second key induction: a lower bound on the measures of any finite collection of Ai's
      that cover an interval {u..v} *)
 
   { fix S u v and l r :: "nat \<Rightarrow> real"
     assume "finite S" "\<And>i. i\<in>S \<Longrightarrow> l i < r i" "{u..v} \<subseteq> (\<Union>i\<in>S. {l i<..< r i})"
     then have "F v - F u \<le> (\<Sum>i\<in>S. F (r i) - F (l i))"
     proof (induction arbitrary: v u rule: finite_psubset_induct)
       case (psubset S)
       show ?case
       proof cases
         assume "S = {}" then show ?case
           using psubset by (simp add: mono_F)
       next
         assume "S \<noteq> {}"
         then obtain j where "j \<in> S"
           by auto
 
         let ?R = "r j < u \<or> l j > v \<or> (\<exists>i\<in>S-{j}. l i \<le> l j \<and> r j \<le> r i)"
         show ?case
         proof cases
           assume "?R"
           with \<open>j \<in> S\<close> psubset.prems have "{u..v} \<subseteq> (\<Union>i\<in>S-{j}. {l i<..< r i})"
             apply (auto simp: subset_eq Ball_def)
             apply (metis Diff_iff less_le_trans leD linear singletonD)
             apply (metis Diff_iff less_le_trans leD linear singletonD)
             apply (metis order_trans less_le_not_le linear)
             done
           with \<open>j \<in> S\<close> have "F v - F u \<le> (\<Sum>i\<in>S - {j}. F (r i) - F (l i))"
             by (intro psubset) auto
           also have "\<dots> \<le> (\<Sum>i\<in>S. F (r i) - F (l i))"
             using psubset.prems
             by (intro sum_mono2 psubset) (auto intro: less_imp_le)
           finally show ?thesis .
         next
           assume "\<not> ?R"
           then have j: "u \<le> r j" "l j \<le> v" "\<And>i. i \<in> S - {j} \<Longrightarrow> r i < r j \<or> l i > l j"
             by (auto simp: not_less)
           let ?S1 = "{i \<in> S. l i < l j}"
           let ?S2 = "{i \<in> S. r i > r j}"
 
           have "(\<Sum>i\<in>S. F (r i) - F (l i)) \<ge> (\<Sum>i\<in>?S1 \<union> ?S2 \<union> {j}. F (r i) - F (l i))"
             using \<open>j \<in> S\<close> \<open>finite S\<close> psubset.prems j
             by (intro sum_mono2) (auto intro: less_imp_le)
           also have "(\<Sum>i\<in>?S1 \<union> ?S2 \<union> {j}. F (r i) - F (l i)) =
             (\<Sum>i\<in>?S1. F (r i) - F (l i)) + (\<Sum>i\<in>?S2 . F (r i) - F (l i)) + (F (r j) - F (l j))"
             using psubset(1) psubset.prems(1) j
             apply (subst sum.union_disjoint)
             apply simp_all
             apply (subst sum.union_disjoint)
             apply auto
             apply (metis less_le_not_le)
             done
           also (xtrans) have "(\<Sum>i\<in>?S1. F (r i) - F (l i)) \<ge> F (l j) - F u"
             using \<open>j \<in> S\<close> \<open>finite S\<close> psubset.prems j
             apply (intro psubset.IH psubset)
             apply (auto simp: subset_eq Ball_def)
             apply (metis less_le_trans not_le)
             done
           also (xtrans) have "(\<Sum>i\<in>?S2. F (r i) - F (l i)) \<ge> F v - F (r j)"
             using \<open>j \<in> S\<close> \<open>finite S\<close> psubset.prems j
             apply (intro psubset.IH psubset)
             apply (auto simp: subset_eq Ball_def)
             apply (metis le_less_trans not_le)
             done
           finally (xtrans) show ?case
             by (auto simp: add_mono)
         qed
       qed
     qed }
   note claim2 = this
 
   (* now prove the inequality going the other way *)
   have "ennreal (F b - F a) \<le> (\<Sum>i. ennreal (F (r i) - F (l i)))"
   proof (rule ennreal_le_epsilon)
     fix epsilon :: real assume egt0: "epsilon > 0"
     have "\<forall>i. \<exists>d>0. F (r i + d) < F (r i) + epsilon / 2^(i+2)"
     proof
       fix i
       note right_cont_F [of "r i"]
       thus "\<exists>d>0. F (r i + d) < F (r i) + epsilon / 2^(i+2)"
         apply -
         apply (subst (asm) continuous_at_right_real_increasing)
         apply (rule mono_F, assumption)
         apply (drule_tac x = "epsilon / 2 ^ (i + 2)" in spec)
         apply (erule impE)
         using egt0 by (auto simp add: field_simps)
     qed
     then obtain delta where
         deltai_gt0: "\<And>i. delta i > 0" and
         deltai_prop: "\<And>i. F (r i + delta i) < F (r i) + epsilon / 2^(i+2)"
       by metis
     have "\<exists>a' > a. F a' - F a < epsilon / 2"
       apply (insert right_cont_F [of a])
       apply (subst (asm) continuous_at_right_real_increasing)
       using mono_F apply force
       apply (drule_tac x = "epsilon / 2" in spec)
       using egt0 unfolding mult.commute [of 2] by force
     then obtain a' where a'lea [arith]: "a' > a" and
       a_prop: "F a' - F a < epsilon / 2"
       by auto
     define S' where "S' = {i. l i < r i}"
     obtain S :: "nat set" where
       "S \<subseteq> S'" and finS: "finite S" and
       Sprop: "{a'..b} \<subseteq> (\<Union>i \<in> S. {l i<..<r i + delta i})"
     proof (rule compactE_image)
       show "compact {a'..b}"
         by (rule compact_Icc)
       show "\<And>i. i \<in> S' \<Longrightarrow> open ({l i<..<r i + delta i})" by auto
       have "{a'..b} \<subseteq> {a <.. b}"
         by auto
       also have "{a <.. b} = (\<Union>i\<in>S'. {l i<..r i})"
         unfolding lr_eq_ab[symmetric] by (fastforce simp add: S'_def intro: less_le_trans)
       also have "\<dots> \<subseteq> (\<Union>i \<in> S'. {l i<..<r i + delta i})"
         apply (intro UN_mono)
         apply (auto simp: S'_def)
         apply (cut_tac i=i in deltai_gt0)
         apply simp
         done
       finally show "{a'..b} \<subseteq> (\<Union>i \<in> S'. {l i<..<r i + delta i})" .
     qed
     with S'_def have Sprop2: "\<And>i. i \<in> S \<Longrightarrow> l i < r i" by auto
     from finS have "\<exists>n. \<forall>i \<in> S. i \<le> n"
       by (subst finite_nat_set_iff_bounded_le [symmetric])
     then obtain n where Sbound [rule_format]: "\<forall>i \<in> S. i \<le> n" ..
     have "F b - F a' \<le> (\<Sum>i\<in>S. F (r i + delta i) - F (l i))"
       apply (rule claim2 [rule_format])
       using finS Sprop apply auto
       apply (frule Sprop2)
       apply (subgoal_tac "delta i > 0")
       apply arith
       by (rule deltai_gt0)
     also have "... \<le> (\<Sum>i \<in> S. F(r i) - F(l i) + epsilon / 2^(i+2))"
       apply (rule sum_mono)
       apply simp
       apply (rule order_trans)
       apply (rule less_imp_le)
       apply (rule deltai_prop)
       by auto
     also have "... = (\<Sum>i \<in> S. F(r i) - F(l i)) +
         (epsilon / 4) * (\<Sum>i \<in> S. (1 / 2)^i)" (is "_ = ?t + _")
       by (subst sum.distrib) (simp add: field_simps sum_distrib_left)
     also have "... \<le> ?t + (epsilon / 4) * (\<Sum> i < Suc n. (1 / 2)^i)"
       apply (rule add_left_mono)
       apply (rule mult_left_mono)
       apply (rule sum_mono2)
       using egt0 apply auto
       by (frule Sbound, auto)
     also have "... \<le> ?t + (epsilon / 2)"
       apply (rule add_left_mono)
       apply (subst geometric_sum)
       apply auto
       apply (rule mult_left_mono)
       using egt0 apply auto
       done
     finally have aux2: "F b - F a' \<le> (\<Sum>i\<in>S. F (r i) - F (l i)) + epsilon / 2"
       by simp
 
     have "F b - F a = (F b - F a') + (F a' - F a)"
       by auto
     also have "... \<le> (F b - F a') + epsilon / 2"
       using a_prop by (intro add_left_mono) simp
     also have "... \<le> (\<Sum>i\<in>S. F (r i) - F (l i)) + epsilon / 2 + epsilon / 2"
       apply (intro add_right_mono)
       apply (rule aux2)
       done
     also have "... = (\<Sum>i\<in>S. F (r i) - F (l i)) + epsilon"
       by auto
     also have "... \<le> (\<Sum>i\<le>n. F (r i) - F (l i)) + epsilon"
       using finS Sbound Sprop by (auto intro!: add_right_mono sum_mono2)
     finally have "ennreal (F b - F a) \<le> (\<Sum>i\<le>n. ennreal (F (r i) - F (l i))) + epsilon"
       using egt0 by (simp add: sum_nonneg flip: ennreal_plus)
     then show "ennreal (F b - F a) \<le> (\<Sum>i. ennreal (F (r i) - F (l i))) + (epsilon :: real)"
       by (rule order_trans) (auto intro!: add_mono sum_le_suminf simp del: sum_ennreal)
   qed
   moreover have "(\<Sum>i. ennreal (F (r i) - F (l i))) \<le> ennreal (F b - F a)"
     using \<open>a \<le> b\<close> by (auto intro!: suminf_le_const ennreal_le_iff[THEN iffD2] claim1)
   ultimately show "(\<Sum>n. ennreal (F (r n) - F (l n))) = ennreal (F b - F a)"
     by (rule antisym[rotated])
 qed (auto simp: Ioc_inj mono_F)
 
 lemma measure_interval_measure_Ioc:
   assumes "a \<le> b" and "\<And>x y. x \<le> y \<Longrightarrow> F x \<le> F y" and "\<And>a. continuous (at_right a) F"
   shows "measure (interval_measure F) {a <.. b} = F b - F a"
   unfolding measure_def
   by (simp add: assms emeasure_interval_measure_Ioc)
 
 lemma emeasure_interval_measure_Ioc_eq:
   "(\<And>x y. x \<le> y \<Longrightarrow> F x \<le> F y) \<Longrightarrow> (\<And>a. continuous (at_right a) F) \<Longrightarrow>
     emeasure (interval_measure F) {a <.. b} = (if a \<le> b then F b - F a else 0)"
   using emeasure_interval_measure_Ioc[of a b F] by auto
 
 lemma\<^marker>\<open>tag important\<close> sets_interval_measure [simp, measurable_cong]:
     "sets (interval_measure F) = sets borel"
   apply (simp add: sets_extend_measure interval_measure_def borel_sigma_sets_Ioc)
   apply (rule sigma_sets_eqI)
   apply auto
   apply (case_tac "a \<le> ba")
   apply (auto intro: sigma_sets.Empty)
   done
 
 lemma space_interval_measure [simp]: "space (interval_measure F) = UNIV"
   by (simp add: interval_measure_def space_extend_measure)
 
 lemma emeasure_interval_measure_Icc:
   assumes "a \<le> b"
   assumes mono_F: "\<And>x y. x \<le> y \<Longrightarrow> F x \<le> F y"
   assumes cont_F : "continuous_on UNIV F"
   shows "emeasure (interval_measure F) {a .. b} = F b - F a"
 proof (rule tendsto_unique)
   { fix a b :: real assume "a \<le> b" then have "emeasure (interval_measure F) {a <.. b} = F b - F a"
       using cont_F
       by (subst emeasure_interval_measure_Ioc)
          (auto intro: mono_F continuous_within_subset simp: continuous_on_eq_continuous_within) }
   note * = this
 
   let ?F = "interval_measure F"
   show "((\<lambda>a. F b - F a) \<longlongrightarrow> emeasure ?F {a..b}) (at_left a)"
   proof (rule tendsto_at_left_sequentially)
     show "a - 1 < a" by simp
     fix X assume "\<And>n. X n < a" "incseq X" "X \<longlonglongrightarrow> a"
     with \<open>a \<le> b\<close> have "(\<lambda>n. emeasure ?F {X n<..b}) \<longlonglongrightarrow> emeasure ?F (\<Inter>n. {X n <..b})"
       apply (intro Lim_emeasure_decseq)
       apply (auto simp: decseq_def incseq_def emeasure_interval_measure_Ioc *)
       apply force
       apply (subst (asm ) *)
       apply (auto intro: less_le_trans less_imp_le)
       done
     also have "(\<Inter>n. {X n <..b}) = {a..b}"
       using \<open>\<And>n. X n < a\<close>
       apply auto
       apply (rule LIMSEQ_le_const2[OF \<open>X \<longlonglongrightarrow> a\<close>])
       apply (auto intro: less_imp_le)
       apply (auto intro: less_le_trans)
       done
     also have "(\<lambda>n. emeasure ?F {X n<..b}) = (\<lambda>n. F b - F (X n))"
       using \<open>\<And>n. X n < a\<close> \<open>a \<le> b\<close> by (subst *) (auto intro: less_imp_le less_le_trans)
     finally show "(\<lambda>n. F b - F (X n)) \<longlonglongrightarrow> emeasure ?F {a..b}" .
   qed
   show "((\<lambda>a. ennreal (F b - F a)) \<longlongrightarrow> F b - F a) (at_left a)"
     by (rule continuous_on_tendsto_compose[where g="\<lambda>x. x" and s=UNIV])
-       (auto simp: continuous_on_ennreal continuous_on_diff cont_F continuous_on_const)
+       (auto simp: continuous_on_ennreal continuous_on_diff cont_F)
 qed (rule trivial_limit_at_left_real)
 
 lemma\<^marker>\<open>tag important\<close> sigma_finite_interval_measure:
   assumes mono_F: "\<And>x y. x \<le> y \<Longrightarrow> F x \<le> F y"
   assumes right_cont_F : "\<And>a. continuous (at_right a) F"
   shows "sigma_finite_measure (interval_measure F)"
   apply unfold_locales
   apply (intro exI[of _ "(\<lambda>(a, b). {a <.. b}) ` (\<rat> \<times> \<rat>)"])
   apply (auto intro!: Rats_no_top_le Rats_no_bot_less countable_rat simp: emeasure_interval_measure_Ioc_eq[OF assms])
   done
 
 subsection \<open>Lebesgue-Borel measure\<close>
 
 definition\<^marker>\<open>tag important\<close> lborel :: "('a :: euclidean_space) measure" where
   "lborel = distr (\<Pi>\<^sub>M b\<in>Basis. interval_measure (\<lambda>x. x)) borel (\<lambda>f. \<Sum>b\<in>Basis. f b *\<^sub>R b)"
 
 abbreviation\<^marker>\<open>tag important\<close> lebesgue :: "'a::euclidean_space measure"
   where "lebesgue \<equiv> completion lborel"
 
 abbreviation\<^marker>\<open>tag important\<close> lebesgue_on :: "'a set \<Rightarrow> 'a::euclidean_space measure"
   where "lebesgue_on \<Omega> \<equiv> restrict_space (completion lborel) \<Omega>"
 
 lemma lebesgue_on_mono:
   assumes major: "AE x in lebesgue_on S. P x" and minor: "\<And>x.\<lbrakk>P x; x \<in> S\<rbrakk> \<Longrightarrow> Q x"
   shows "AE x in lebesgue_on S. Q x"
 proof -
   have "AE a in lebesgue_on S. P a \<longrightarrow> Q a"
     using minor space_restrict_space by fastforce
   then show ?thesis
     using major by auto
 qed
 
 lemma integral_eq_zero_null_sets:
   assumes "S \<in> null_sets lebesgue"
   shows "integral\<^sup>L (lebesgue_on S) f = 0"
 proof (rule integral_eq_zero_AE)
   show "AE x in lebesgue_on S. f x = 0"
     by (metis (no_types, lifting) assms AE_not_in lebesgue_on_mono null_setsD2 null_sets_restrict_space order_refl)
 qed
 
 lemma
   shows sets_lborel[simp, measurable_cong]: "sets lborel = sets borel"
     and space_lborel[simp]: "space lborel = space borel"
     and measurable_lborel1[simp]: "measurable M lborel = measurable M borel"
     and measurable_lborel2[simp]: "measurable lborel M = measurable borel M"
   by (simp_all add: lborel_def)
 
 lemma space_lebesgue_on [simp]: "space (lebesgue_on S) = S"
   by (simp add: space_restrict_space)
 
 lemma sets_lebesgue_on_refl [iff]: "S \<in> sets (lebesgue_on S)"
     by (metis inf_top.right_neutral sets.top space_borel space_completion space_lborel space_restrict_space)
 
 lemma Compl_in_sets_lebesgue: "-A \<in> sets lebesgue \<longleftrightarrow> A  \<in> sets lebesgue"
   by (metis Compl_eq_Diff_UNIV double_compl space_borel space_completion space_lborel Sigma_Algebra.sets.compl_sets)
 
 lemma measurable_lebesgue_cong:
   assumes "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "f \<in> measurable (lebesgue_on S) M \<longleftrightarrow> g \<in> measurable (lebesgue_on S) M"
   by (metis (mono_tags, lifting) IntD1 assms measurable_cong_simp space_restrict_space)
 
 lemma lebesgue_on_UNIV_eq: "lebesgue_on UNIV = lebesgue"
 proof -
   have "measure_of UNIV (sets lebesgue) (emeasure lebesgue) = lebesgue"
     by (metis measure_of_of_measure space_borel space_completion space_lborel)
   then show ?thesis
     by (auto simp: restrict_space_def)
 qed
 
 lemma integral_restrict_Int:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<in> sets lebesgue" "T \<in> sets lebesgue"
   shows "integral\<^sup>L (lebesgue_on T) (\<lambda>x. if x \<in> S then f x else 0) = integral\<^sup>L (lebesgue_on (S \<inter> T)) f"
 proof -
   have "(\<lambda>x. indicat_real T x *\<^sub>R (if x \<in> S then f x else 0)) = (\<lambda>x. indicat_real (S \<inter> T) x *\<^sub>R f x)"
     by (force simp: indicator_def)
   then show ?thesis
     by (simp add: assms sets.Int Bochner_Integration.integral_restrict_space)
 qed
 
 lemma integral_restrict:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<subseteq> T" "S \<in> sets lebesgue" "T \<in> sets lebesgue"
   shows "integral\<^sup>L (lebesgue_on T) (\<lambda>x. if x \<in> S then f x else 0) = integral\<^sup>L (lebesgue_on S) f"
   using integral_restrict_Int [of S T f] assms
   by (simp add: Int_absorb2)
 
 lemma integral_restrict_UNIV:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<in> sets lebesgue"
   shows "integral\<^sup>L lebesgue (\<lambda>x. if x \<in> S then f x else 0) = integral\<^sup>L (lebesgue_on S) f"
   using integral_restrict_Int [of S UNIV f] assms
   by (simp add: lebesgue_on_UNIV_eq)
 
 lemma integrable_lebesgue_on_empty [iff]:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{second_countable_topology,banach}"
   shows "integrable (lebesgue_on {}) f"
   by (simp add: integrable_restrict_space)
 
 lemma integral_lebesgue_on_empty [simp]:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{second_countable_topology,banach}"
   shows "integral\<^sup>L (lebesgue_on {}) f = 0"
   by (simp add: Bochner_Integration.integral_empty)
 lemma has_bochner_integral_restrict_space:
   fixes f :: "'a \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes \<Omega>: "\<Omega> \<inter> space M \<in> sets M"
   shows "has_bochner_integral (restrict_space M \<Omega>) f i
      \<longleftrightarrow> has_bochner_integral M (\<lambda>x. indicator \<Omega> x *\<^sub>R f x) i"
   by (simp add: integrable_restrict_space [OF assms] integral_restrict_space [OF assms] has_bochner_integral_iff)
 
 lemma integrable_restrict_UNIV:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes S: "S \<in> sets lebesgue"
   shows  "integrable lebesgue (\<lambda>x. if x \<in> S then f x else 0) \<longleftrightarrow> integrable (lebesgue_on S) f"
   using has_bochner_integral_restrict_space [of S lebesgue f] assms
   by (simp add: integrable.simps indicator_scaleR_eq_if)
 
 lemma integral_mono_lebesgue_on_AE:
   fixes f::"_ \<Rightarrow> real"
   assumes f: "integrable (lebesgue_on T) f"
     and gf: "AE x in (lebesgue_on S). g x \<le> f x"
     and f0: "AE x in (lebesgue_on T). 0 \<le> f x"
     and "S \<subseteq> T" and S: "S \<in> sets lebesgue" and T: "T \<in> sets lebesgue"
   shows "(\<integral>x. g x \<partial>(lebesgue_on S)) \<le> (\<integral>x. f x \<partial>(lebesgue_on T))"
 proof -
   have "(\<integral>x. g x \<partial>(lebesgue_on S)) = (\<integral>x. (if x \<in> S then g x else 0) \<partial>lebesgue)"
     by (simp add: Lebesgue_Measure.integral_restrict_UNIV S)
   also have "\<dots> \<le> (\<integral>x. (if x \<in> T then f x else 0) \<partial>lebesgue)"
   proof (rule Bochner_Integration.integral_mono_AE')
     show "integrable lebesgue (\<lambda>x. if x \<in> T then f x else 0)"
       by (simp add: integrable_restrict_UNIV T f)
     show "AE x in lebesgue. (if x \<in> S then g x else 0) \<le> (if x \<in> T then f x else 0)"
       using assms by (auto simp: AE_restrict_space_iff)
     show "AE x in lebesgue. 0 \<le> (if x \<in> T then f x else 0)"
       using f0 by (simp add: AE_restrict_space_iff T)
   qed
   also have "\<dots> = (\<integral>x. f x \<partial>(lebesgue_on T))"
     using Lebesgue_Measure.integral_restrict_UNIV T by blast
   finally show ?thesis .
 qed
 
 
 subsection \<open>Borel measurability\<close>
 
 lemma borel_measurable_if_I:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes f: "f \<in> borel_measurable (lebesgue_on S)" and S: "S \<in> sets lebesgue"
   shows "(\<lambda>x. if x \<in> S then f x else 0) \<in> borel_measurable lebesgue"
 proof -
   have eq: "{x. x \<notin> S} \<union> {x. f x \<in> Y} = {x. x \<notin> S} \<union> {x. f x \<in> Y} \<inter> S" for Y
     by blast
   show ?thesis
   using f S
   apply (simp add: vimage_def in_borel_measurable_borel Ball_def)
   apply (elim all_forward imp_forward asm_rl)
   apply (simp only: Collect_conj_eq Collect_disj_eq imp_conv_disj eq)
   apply (auto simp: Compl_eq [symmetric] Compl_in_sets_lebesgue sets_restrict_space_iff)
   done
 qed
 
 lemma borel_measurable_if_D:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "(\<lambda>x. if x \<in> S then f x else 0) \<in> borel_measurable lebesgue"
   shows "f \<in> borel_measurable (lebesgue_on S)"
   using assms
   apply (simp add: in_borel_measurable_borel Ball_def)
   apply (elim all_forward imp_forward asm_rl)
   apply (force simp: space_restrict_space sets_restrict_space image_iff intro: rev_bexI)
   done
 
 lemma borel_measurable_if:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<in> sets lebesgue"
   shows "(\<lambda>x. if x \<in> S then f x else 0) \<in> borel_measurable lebesgue \<longleftrightarrow> f \<in> borel_measurable (lebesgue_on S)"
   using assms borel_measurable_if_D borel_measurable_if_I by blast
 
 lemma borel_measurable_if_lebesgue_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "S \<in> sets lebesgue" "T \<in> sets lebesgue" "S \<subseteq> T"
   shows "(\<lambda>x. if x \<in> S then f x else 0) \<in> borel_measurable (lebesgue_on T) \<longleftrightarrow> f \<in> borel_measurable (lebesgue_on S)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     using measurable_restrict_mono [OF _ \<open>S \<subseteq> T\<close>]
     by (subst measurable_lebesgue_cong [where g = "(\<lambda>x. if x \<in> S then f x else 0)"]) auto
 next
   assume ?rhs then show ?lhs
     by (simp add: \<open>S \<in> sets lebesgue\<close> borel_measurable_if_I measurable_restrict_space1)
 qed
 
 lemma borel_measurable_vimage_halfspace_component_lt:
      "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
       (\<forall>a i. i \<in> Basis \<longrightarrow> {x \<in> S. f x \<bullet> i < a} \<in> sets (lebesgue_on S))"
   apply (rule trans [OF borel_measurable_iff_halfspace_less])
   apply (fastforce simp add: space_restrict_space)
   done
 
 lemma borel_measurable_vimage_halfspace_component_ge:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>a i. i \<in> Basis \<longrightarrow> {x \<in> S. f x \<bullet> i \<ge> a} \<in> sets (lebesgue_on S))"
   apply (rule trans [OF borel_measurable_iff_halfspace_ge])
   apply (fastforce simp add: space_restrict_space)
   done
 
 lemma borel_measurable_vimage_halfspace_component_gt:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>a i. i \<in> Basis \<longrightarrow> {x \<in> S. f x \<bullet> i > a} \<in> sets (lebesgue_on S))"
   apply (rule trans [OF borel_measurable_iff_halfspace_greater])
   apply (fastforce simp add: space_restrict_space)
   done
 
 lemma borel_measurable_vimage_halfspace_component_le:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>a i. i \<in> Basis \<longrightarrow> {x \<in> S. f x \<bullet> i \<le> a} \<in> sets (lebesgue_on S))"
   apply (rule trans [OF borel_measurable_iff_halfspace_le])
   apply (fastforce simp add: space_restrict_space)
   done
 
 lemma
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows borel_measurable_vimage_open_interval:
          "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>a b. {x \<in> S. f x \<in> box a b} \<in> sets (lebesgue_on S))" (is ?thesis1)
    and borel_measurable_vimage_open:
          "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>T. open T \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S))" (is ?thesis2)
 proof -
   have "{x \<in> S. f x \<in> box a b} \<in> sets (lebesgue_on S)" if "f \<in> borel_measurable (lebesgue_on S)" for a b
   proof -
     have "S = S \<inter> space lebesgue"
       by simp
     then have "S \<inter> (f -` box a b) \<in> sets (lebesgue_on S)"
       by (metis (no_types) box_borel in_borel_measurable_borel inf_sup_aci(1) space_restrict_space that)
     then show ?thesis
       by (simp add: Collect_conj_eq vimage_def)
   qed
   moreover
   have "{x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S)"
        if T: "\<And>a b. {x \<in> S. f x \<in> box a b} \<in> sets (lebesgue_on S)" "open T" for T
   proof -
     obtain \<D> where "countable \<D>" and \<D>: "\<And>X. X \<in> \<D> \<Longrightarrow> \<exists>a b. X = box a b" "\<Union>\<D> = T"
       using open_countable_Union_open_box that \<open>open T\<close> by metis
     then have eq: "{x \<in> S. f x \<in> T} = (\<Union>U \<in> \<D>. {x \<in> S. f x \<in> U})"
       by blast
     have "{x \<in> S. f x \<in> U} \<in> sets (lebesgue_on S)" if "U \<in> \<D>" for U
       using that T \<D> by blast
     then show ?thesis
       by (auto simp: eq intro: Sigma_Algebra.sets.countable_UN' [OF \<open>countable \<D>\<close>])
   qed
   moreover
   have eq: "{x \<in> S. f x \<bullet> i < a} = {x \<in> S. f x \<in> {y. y \<bullet> i < a}}" for i a
     by auto
   have "f \<in> borel_measurable (lebesgue_on S)"
     if "\<And>T. open T \<Longrightarrow> {x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S)"
     by (metis (no_types) eq borel_measurable_vimage_halfspace_component_lt open_halfspace_component_lt that)
   ultimately show "?thesis1" "?thesis2"
     by blast+
 qed
 
 lemma borel_measurable_vimage_closed:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>T. closed T \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S))"
         (is "?lhs = ?rhs")
 proof -
   have eq: "{x \<in> S. f x \<in> T} = S - {x \<in> S. f x \<in> (- T)}" for T
     by auto
   show ?thesis
     apply (simp add: borel_measurable_vimage_open, safe)
      apply (simp_all (no_asm) add: eq)
      apply (intro sets.Diff sets_lebesgue_on_refl, force simp: closed_open)
     apply (intro sets.Diff sets_lebesgue_on_refl, force simp: open_closed)
     done
 qed
 
 lemma borel_measurable_vimage_closed_interval:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>a b. {x \<in> S. f x \<in> cbox a b} \<in> sets (lebesgue_on S))"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     using borel_measurable_vimage_closed by blast
 next
   assume RHS: ?rhs
   have "{x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S)" if "open T" for T
   proof -
     obtain \<D> where "countable \<D>" and \<D>: "\<D> \<subseteq> Pow T" "\<And>X. X \<in> \<D> \<Longrightarrow> \<exists>a b. X = cbox a b" "\<Union>\<D> = T"
       using open_countable_Union_open_cbox that \<open>open T\<close> by metis
     then have eq: "{x \<in> S. f x \<in> T} = (\<Union>U \<in> \<D>. {x \<in> S. f x \<in> U})"
       by blast
     have "{x \<in> S. f x \<in> U} \<in> sets (lebesgue_on S)" if "U \<in> \<D>" for U
       using that \<D> by (metis RHS)
     then show ?thesis
       by (auto simp: eq intro: Sigma_Algebra.sets.countable_UN' [OF \<open>countable \<D>\<close>])
   qed
   then show ?lhs
     by (simp add: borel_measurable_vimage_open)
 qed
 
 lemma borel_measurable_vimage_borel:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable (lebesgue_on S) \<longleftrightarrow>
          (\<forall>T. T \<in> sets borel \<longrightarrow> {x \<in> S. f x \<in> T} \<in> sets (lebesgue_on S))"
         (is "?lhs = ?rhs")
 proof
   assume f: ?lhs
   then show ?rhs
     using measurable_sets [OF f]
       by (simp add: Collect_conj_eq inf_sup_aci(1) space_restrict_space vimage_def)
 qed (simp add: borel_measurable_vimage_open_interval)
 
 lemma lebesgue_measurable_vimage_borel:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "f \<in> borel_measurable lebesgue" "T \<in> sets borel"
   shows "{x. f x \<in> T} \<in> sets lebesgue"
   using assms borel_measurable_vimage_borel [of f UNIV] by auto
 
 lemma borel_measurable_lebesgue_preimage_borel:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   shows "f \<in> borel_measurable lebesgue \<longleftrightarrow>
          (\<forall>T. T \<in> sets borel \<longrightarrow> {x. f x \<in> T} \<in> sets lebesgue)"
   apply (intro iffI allI impI lebesgue_measurable_vimage_borel)
     apply (auto simp: in_borel_measurable_borel vimage_def)
   done
 
 
 subsection \<^marker>\<open>tag unimportant\<close> \<open>Measurability of continuous functions\<close>
 
 lemma continuous_imp_measurable_on_sets_lebesgue:
   assumes f: "continuous_on S f" and S: "S \<in> sets lebesgue"
   shows "f \<in> borel_measurable (lebesgue_on S)"
 proof -
   have "sets (restrict_space borel S) \<subseteq> sets (lebesgue_on S)"
     by (simp add: mono_restrict_space subsetI)
   then show ?thesis
     by (simp add: borel_measurable_continuous_on_restrict [OF f] borel_measurable_subalgebra 
                   space_restrict_space)
 qed
 
 lemma id_borel_measurable_lebesgue [iff]: "id \<in> borel_measurable lebesgue"
   by (simp add: measurable_completion)
 
 lemma id_borel_measurable_lebesgue_on [iff]: "id \<in> borel_measurable (lebesgue_on S)"
   by (simp add: measurable_completion measurable_restrict_space1)
 
 context
 begin
 
 interpretation sigma_finite_measure "interval_measure (\<lambda>x. x)"
   by (rule sigma_finite_interval_measure) auto
 interpretation finite_product_sigma_finite "\<lambda>_. interval_measure (\<lambda>x. x)" Basis
   proof qed simp
 
 lemma lborel_eq_real: "lborel = interval_measure (\<lambda>x. x)"
   unfolding lborel_def Basis_real_def
   using distr_id[of "interval_measure (\<lambda>x. x)"]
   by (subst distr_component[symmetric])
      (simp_all add: distr_distr comp_def del: distr_id cong: distr_cong)
 
 lemma lborel_eq: "lborel = distr (\<Pi>\<^sub>M b\<in>Basis. lborel) borel (\<lambda>f. \<Sum>b\<in>Basis. f b *\<^sub>R b)"
   by (subst lborel_def) (simp add: lborel_eq_real)
 
 lemma nn_integral_lborel_prod:
   assumes [measurable]: "\<And>b. b \<in> Basis \<Longrightarrow> f b \<in> borel_measurable borel"
   assumes nn[simp]: "\<And>b x. b \<in> Basis \<Longrightarrow> 0 \<le> f b x"
   shows "(\<integral>\<^sup>+x. (\<Prod>b\<in>Basis. f b (x \<bullet> b)) \<partial>lborel) = (\<Prod>b\<in>Basis. (\<integral>\<^sup>+x. f b x \<partial>lborel))"
   by (simp add: lborel_def nn_integral_distr product_nn_integral_prod
                 product_nn_integral_singleton)
 
 lemma emeasure_lborel_Icc[simp]:
   fixes l u :: real
   assumes [simp]: "l \<le> u"
   shows "emeasure lborel {l .. u} = u - l"
 proof -
   have "((\<lambda>f. f 1) -` {l..u} \<inter> space (Pi\<^sub>M {1} (\<lambda>b. interval_measure (\<lambda>x. x)))) = {1::real} \<rightarrow>\<^sub>E {l..u}"
     by (auto simp: space_PiM)
   then show ?thesis
-    by (simp add: lborel_def emeasure_distr emeasure_PiM emeasure_interval_measure_Icc continuous_on_id)
+    by (simp add: lborel_def emeasure_distr emeasure_PiM emeasure_interval_measure_Icc)
 qed
 
 lemma emeasure_lborel_Icc_eq: "emeasure lborel {l .. u} = ennreal (if l \<le> u then u - l else 0)"
   by simp
 
 lemma\<^marker>\<open>tag important\<close> emeasure_lborel_cbox[simp]:
   assumes [simp]: "\<And>b. b \<in> Basis \<Longrightarrow> l \<bullet> b \<le> u \<bullet> b"
   shows "emeasure lborel (cbox l u) = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
 proof -
   have "(\<lambda>x. \<Prod>b\<in>Basis. indicator {l\<bullet>b .. u\<bullet>b} (x \<bullet> b) :: ennreal) = indicator (cbox l u)"
     by (auto simp: fun_eq_iff cbox_def split: split_indicator)
   then have "emeasure lborel (cbox l u) = (\<integral>\<^sup>+x. (\<Prod>b\<in>Basis. indicator {l\<bullet>b .. u\<bullet>b} (x \<bullet> b)) \<partial>lborel)"
     by simp
   also have "\<dots> = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
     by (subst nn_integral_lborel_prod) (simp_all add: prod_ennreal inner_diff_left)
   finally show ?thesis .
 qed
 
 lemma AE_lborel_singleton: "AE x in lborel::'a::euclidean_space measure. x \<noteq> c"
   using SOME_Basis AE_discrete_difference [of "{c}" lborel] emeasure_lborel_cbox [of c c]
   by (auto simp add: power_0_left)
 
 lemma emeasure_lborel_Ioo[simp]:
   assumes [simp]: "l \<le> u"
   shows "emeasure lborel {l <..< u} = ennreal (u - l)"
 proof -
   have "emeasure lborel {l <..< u} = emeasure lborel {l .. u}"
     using AE_lborel_singleton[of u] AE_lborel_singleton[of l] by (intro emeasure_eq_AE) auto
   then show ?thesis
     by simp
 qed
 
 lemma emeasure_lborel_Ioc[simp]:
   assumes [simp]: "l \<le> u"
   shows "emeasure lborel {l <.. u} = ennreal (u - l)"
 proof -
   have "emeasure lborel {l <.. u} = emeasure lborel {l .. u}"
     using AE_lborel_singleton[of u] AE_lborel_singleton[of l] by (intro emeasure_eq_AE) auto
   then show ?thesis
     by simp
 qed
 
 lemma emeasure_lborel_Ico[simp]:
   assumes [simp]: "l \<le> u"
   shows "emeasure lborel {l ..< u} = ennreal (u - l)"
 proof -
   have "emeasure lborel {l ..< u} = emeasure lborel {l .. u}"
     using AE_lborel_singleton[of u] AE_lborel_singleton[of l] by (intro emeasure_eq_AE) auto
   then show ?thesis
     by simp
 qed
 
 lemma emeasure_lborel_box[simp]:
   assumes [simp]: "\<And>b. b \<in> Basis \<Longrightarrow> l \<bullet> b \<le> u \<bullet> b"
   shows "emeasure lborel (box l u) = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
 proof -
   have "(\<lambda>x. \<Prod>b\<in>Basis. indicator {l\<bullet>b <..< u\<bullet>b} (x \<bullet> b) :: ennreal) = indicator (box l u)"
     by (auto simp: fun_eq_iff box_def split: split_indicator)
   then have "emeasure lborel (box l u) = (\<integral>\<^sup>+x. (\<Prod>b\<in>Basis. indicator {l\<bullet>b <..< u\<bullet>b} (x \<bullet> b)) \<partial>lborel)"
     by simp
   also have "\<dots> = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
     by (subst nn_integral_lborel_prod) (simp_all add: prod_ennreal inner_diff_left)
   finally show ?thesis .
 qed
 
 lemma emeasure_lborel_cbox_eq:
   "emeasure lborel (cbox l u) = (if \<forall>b\<in>Basis. l \<bullet> b \<le> u \<bullet> b then \<Prod>b\<in>Basis. (u - l) \<bullet> b else 0)"
   using box_eq_empty(2)[THEN iffD2, of u l] by (auto simp: not_le)
 
 lemma emeasure_lborel_box_eq:
   "emeasure lborel (box l u) = (if \<forall>b\<in>Basis. l \<bullet> b \<le> u \<bullet> b then \<Prod>b\<in>Basis. (u - l) \<bullet> b else 0)"
   using box_eq_empty(1)[THEN iffD2, of u l] by (auto simp: not_le dest!: less_imp_le) force
 
 lemma emeasure_lborel_singleton[simp]: "emeasure lborel {x} = 0"
   using emeasure_lborel_cbox[of x x] nonempty_Basis
-  by (auto simp del: emeasure_lborel_cbox nonempty_Basis simp add: prod_constant)
+  by (auto simp del: emeasure_lborel_cbox nonempty_Basis)
 
 lemma fmeasurable_cbox [iff]: "cbox a b \<in> fmeasurable lborel"
   and fmeasurable_box [iff]: "box a b \<in> fmeasurable lborel"
   by (auto simp: fmeasurable_def emeasure_lborel_box_eq emeasure_lborel_cbox_eq)
 
 lemma
   fixes l u :: real
   assumes [simp]: "l \<le> u"
   shows measure_lborel_Icc[simp]: "measure lborel {l .. u} = u - l"
     and measure_lborel_Ico[simp]: "measure lborel {l ..< u} = u - l"
     and measure_lborel_Ioc[simp]: "measure lborel {l <.. u} = u - l"
     and measure_lborel_Ioo[simp]: "measure lborel {l <..< u} = u - l"
   by (simp_all add: measure_def)
 
 lemma
   assumes [simp]: "\<And>b. b \<in> Basis \<Longrightarrow> l \<bullet> b \<le> u \<bullet> b"
   shows measure_lborel_box[simp]: "measure lborel (box l u) = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
     and measure_lborel_cbox[simp]: "measure lborel (cbox l u) = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
   by (simp_all add: measure_def inner_diff_left prod_nonneg)
 
 lemma measure_lborel_cbox_eq:
   "measure lborel (cbox l u) = (if \<forall>b\<in>Basis. l \<bullet> b \<le> u \<bullet> b then \<Prod>b\<in>Basis. (u - l) \<bullet> b else 0)"
   using box_eq_empty(2)[THEN iffD2, of u l] by (auto simp: not_le)
 
 lemma measure_lborel_box_eq:
   "measure lborel (box l u) = (if \<forall>b\<in>Basis. l \<bullet> b \<le> u \<bullet> b then \<Prod>b\<in>Basis. (u - l) \<bullet> b else 0)"
   using box_eq_empty(1)[THEN iffD2, of u l] by (auto simp: not_le dest!: less_imp_le) force
 
 lemma measure_lborel_singleton[simp]: "measure lborel {x} = 0"
   by (simp add: measure_def)
 
 lemma sigma_finite_lborel: "sigma_finite_measure lborel"
 proof
   show "\<exists>A::'a set set. countable A \<and> A \<subseteq> sets lborel \<and> \<Union>A = space lborel \<and> (\<forall>a\<in>A. emeasure lborel a \<noteq> \<infinity>)"
     by (intro exI[of _ "range (\<lambda>n::nat. box (- real n *\<^sub>R One) (real n *\<^sub>R One))"])
        (auto simp: emeasure_lborel_cbox_eq UN_box_eq_UNIV)
 qed
 
 end
 
 lemma emeasure_lborel_UNIV [simp]: "emeasure lborel (UNIV::'a::euclidean_space set) = \<infinity>"
 proof -
   { fix n::nat
     let ?Ba = "Basis :: 'a set"
     have "real n \<le> (2::real) ^ card ?Ba * real n"
       by (simp add: mult_le_cancel_right1)
     also
     have "... \<le> (2::real) ^ card ?Ba * real (Suc n) ^ card ?Ba"
       apply (rule mult_left_mono)
       apply (metis DIM_positive One_nat_def less_eq_Suc_le less_imp_le of_nat_le_iff of_nat_power self_le_power zero_less_Suc)
-      apply (simp add: DIM_positive)
+      apply (simp)
       done
     finally have "real n \<le> (2::real) ^ card ?Ba * real (Suc n) ^ card ?Ba" .
   } note [intro!] = this
   show ?thesis
     unfolding UN_box_eq_UNIV[symmetric]
     apply (subst SUP_emeasure_incseq[symmetric])
-    apply (auto simp: incseq_def subset_box inner_add_left prod_constant
+    apply (auto simp: incseq_def subset_box inner_add_left
       simp del: Sup_eq_top_iff SUP_eq_top_iff
       intro!: ennreal_SUP_eq_top)
     done
 qed
 
 lemma emeasure_lborel_countable:
   fixes A :: "'a::euclidean_space set"
   assumes "countable A"
   shows "emeasure lborel A = 0"
 proof -
   have "A \<subseteq> (\<Union>i. {from_nat_into A i})" using from_nat_into_surj assms by force
   then have "emeasure lborel A \<le> emeasure lborel (\<Union>i. {from_nat_into A i})"
     by (intro emeasure_mono) auto
   also have "emeasure lborel (\<Union>i. {from_nat_into A i}) = 0"
     by (rule emeasure_UN_eq_0) auto
   finally show ?thesis
     by (auto simp add: )
 qed
 
 lemma countable_imp_null_set_lborel: "countable A \<Longrightarrow> A \<in> null_sets lborel"
   by (simp add: null_sets_def emeasure_lborel_countable sets.countable)
 
 lemma finite_imp_null_set_lborel: "finite A \<Longrightarrow> A \<in> null_sets lborel"
   by (intro countable_imp_null_set_lborel countable_finite)
 
 lemma insert_null_sets_iff [simp]: "insert a N \<in> null_sets lebesgue \<longleftrightarrow> N \<in> null_sets lebesgue"     
     (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (meson completion.complete2 subset_insertI)
 next
   assume ?rhs then show ?lhs
   by (simp add: null_sets.insert_in_sets null_setsI)
 qed
 
 lemma insert_null_sets_lebesgue_on_iff [simp]:
   assumes "a \<in> S" "S \<in> sets lebesgue"
   shows "insert a N \<in> null_sets (lebesgue_on S) \<longleftrightarrow> N \<in> null_sets (lebesgue_on S)"     
   by (simp add: assms null_sets_restrict_space)
 
 lemma lborel_neq_count_space[simp]: "lborel \<noteq> count_space (A::('a::ordered_euclidean_space) set)"
 proof
   assume asm: "lborel = count_space A"
   have "space lborel = UNIV" by simp
   hence [simp]: "A = UNIV" by (subst (asm) asm) (simp only: space_count_space)
   have "emeasure lborel {undefined::'a} = 1"
       by (subst asm, subst emeasure_count_space_finite) auto
   moreover have "emeasure lborel {undefined} \<noteq> 1" by simp
   ultimately show False by contradiction
 qed
 
 lemma mem_closed_if_AE_lebesgue_open:
   assumes "open S" "closed C"
   assumes "AE x \<in> S in lebesgue. x \<in> C"
   assumes "x \<in> S"
   shows "x \<in> C"
 proof (rule ccontr)
   assume xC: "x \<notin> C"
   with openE[of "S - C"] assms
   obtain e where e: "0 < e" "ball x e \<subseteq> S - C"
     by blast
   then obtain a b where box: "x \<in> box a b" "box a b \<subseteq> S - C"
     by (metis rational_boxes order_trans)
   then have "0 < emeasure lebesgue (box a b)"
     by (auto simp: emeasure_lborel_box_eq mem_box algebra_simps intro!: prod_pos)
   also have "\<dots> \<le> emeasure lebesgue (S - C)"
     using assms box
     by (auto intro!: emeasure_mono)
   also have "\<dots> = 0"
     using assms
     by (auto simp: eventually_ae_filter completion.complete2 set_diff_eq null_setsD1)
   finally show False by simp
 qed
 
 lemma mem_closed_if_AE_lebesgue: "closed C \<Longrightarrow> (AE x in lebesgue. x \<in> C) \<Longrightarrow> x \<in> C"
   using mem_closed_if_AE_lebesgue_open[OF open_UNIV] by simp
 
 
 subsection \<open>Affine transformation on the Lebesgue-Borel\<close>
 
 lemma\<^marker>\<open>tag important\<close> lborel_eqI:
   fixes M :: "'a::euclidean_space measure"
   assumes emeasure_eq: "\<And>l u. (\<And>b. b \<in> Basis \<Longrightarrow> l \<bullet> b \<le> u \<bullet> b) \<Longrightarrow> emeasure M (box l u) = (\<Prod>b\<in>Basis. (u - l) \<bullet> b)"
   assumes sets_eq: "sets M = sets borel"
   shows "lborel = M"
 proof (rule measure_eqI_generator_eq)
   let ?E = "range (\<lambda>(a, b). box a b::'a set)"
   show "Int_stable ?E"
     by (auto simp: Int_stable_def box_Int_box)
 
   show "?E \<subseteq> Pow UNIV" "sets lborel = sigma_sets UNIV ?E" "sets M = sigma_sets UNIV ?E"
     by (simp_all add: borel_eq_box sets_eq)
 
   let ?A = "\<lambda>n::nat. box (- (real n *\<^sub>R One)) (real n *\<^sub>R One) :: 'a set"
   show "range ?A \<subseteq> ?E" "(\<Union>i. ?A i) = UNIV"
     unfolding UN_box_eq_UNIV by auto
 
   { fix i show "emeasure lborel (?A i) \<noteq> \<infinity>" by auto }
   { fix X assume "X \<in> ?E" then show "emeasure lborel X = emeasure M X"
       apply (auto simp: emeasure_eq emeasure_lborel_box_eq)
       apply (subst box_eq_empty(1)[THEN iffD2])
       apply (auto intro: less_imp_le simp: not_le)
       done }
 qed
 
 lemma\<^marker>\<open>tag important\<close> lborel_affine_euclidean:
   fixes c :: "'a::euclidean_space \<Rightarrow> real" and t
   defines "T x \<equiv> t + (\<Sum>j\<in>Basis. (c j * (x \<bullet> j)) *\<^sub>R j)"
   assumes c: "\<And>j. j \<in> Basis \<Longrightarrow> c j \<noteq> 0"
   shows "lborel = density (distr lborel borel T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))" (is "_ = ?D")
 proof (rule lborel_eqI)
   let ?B = "Basis :: 'a set"
   fix l u assume le: "\<And>b. b \<in> ?B \<Longrightarrow> l \<bullet> b \<le> u \<bullet> b"
   have [measurable]: "T \<in> borel \<rightarrow>\<^sub>M borel"
     by (simp add: T_def[abs_def])
   have eq: "T -` box l u = box
     (\<Sum>j\<in>Basis. (((if 0 < c j then l - t else u - t) \<bullet> j) / c j) *\<^sub>R j)
     (\<Sum>j\<in>Basis. (((if 0 < c j then u - t else l - t) \<bullet> j) / c j) *\<^sub>R j)"
     using c by (auto simp: box_def T_def field_simps inner_simps divide_less_eq)
   with le c show "emeasure ?D (box l u) = (\<Prod>b\<in>?B. (u - l) \<bullet> b)"
     by (auto simp: emeasure_density emeasure_distr nn_integral_multc emeasure_lborel_box_eq inner_simps
-                   field_simps field_split_simps ennreal_mult'[symmetric] prod_nonneg prod.distrib[symmetric]
+                   field_split_simps ennreal_mult'[symmetric] prod_nonneg prod.distrib[symmetric]
              intro!: prod.cong)
 qed simp
 
 lemma lborel_affine:
   fixes t :: "'a::euclidean_space"
   shows "c \<noteq> 0 \<Longrightarrow> lborel = density (distr lborel borel (\<lambda>x. t + c *\<^sub>R x)) (\<lambda>_. \<bar>c\<bar>^DIM('a))"
   using lborel_affine_euclidean[where c="\<lambda>_::'a. c" and t=t]
   unfolding scaleR_scaleR[symmetric] scaleR_sum_right[symmetric] euclidean_representation prod_constant by simp
 
 lemma lborel_real_affine:
   "c \<noteq> 0 \<Longrightarrow> lborel = density (distr lborel borel (\<lambda>x. t + c * x)) (\<lambda>_. ennreal (abs c))"
   using lborel_affine[of c t] by simp
 
 lemma AE_borel_affine:
   fixes P :: "real \<Rightarrow> bool"
   shows "c \<noteq> 0 \<Longrightarrow> Measurable.pred borel P \<Longrightarrow> AE x in lborel. P x \<Longrightarrow> AE x in lborel. P (t + c * x)"
   by (subst lborel_real_affine[where t="- t / c" and c="1 / c"])
      (simp_all add: AE_density AE_distr_iff field_simps)
 
 lemma nn_integral_real_affine:
   fixes c :: real assumes [measurable]: "f \<in> borel_measurable borel" and c: "c \<noteq> 0"
   shows "(\<integral>\<^sup>+x. f x \<partial>lborel) = \<bar>c\<bar> * (\<integral>\<^sup>+x. f (t + c * x) \<partial>lborel)"
   by (subst lborel_real_affine[OF c, of t])
      (simp add: nn_integral_density nn_integral_distr nn_integral_cmult)
 
 lemma lborel_integrable_real_affine:
   fixes f :: "real \<Rightarrow> 'a :: {banach, second_countable_topology}"
   assumes f: "integrable lborel f"
   shows "c \<noteq> 0 \<Longrightarrow> integrable lborel (\<lambda>x. f (t + c * x))"
   using f f[THEN borel_measurable_integrable] unfolding integrable_iff_bounded
   by (subst (asm) nn_integral_real_affine[where c=c and t=t]) (auto simp: ennreal_mult_less_top)
 
 lemma lborel_integrable_real_affine_iff:
   fixes f :: "real \<Rightarrow> 'a :: {banach, second_countable_topology}"
   shows "c \<noteq> 0 \<Longrightarrow> integrable lborel (\<lambda>x. f (t + c * x)) \<longleftrightarrow> integrable lborel f"
   using
     lborel_integrable_real_affine[of f c t]
     lborel_integrable_real_affine[of "\<lambda>x. f (t + c * x)" "1/c" "-t/c"]
   by (auto simp add: field_simps)
 
 lemma\<^marker>\<open>tag important\<close> lborel_integral_real_affine:
   fixes f :: "real \<Rightarrow> 'a :: {banach, second_countable_topology}" and c :: real
   assumes c: "c \<noteq> 0" shows "(\<integral>x. f x \<partial> lborel) = \<bar>c\<bar> *\<^sub>R (\<integral>x. f (t + c * x) \<partial>lborel)"
 proof cases
   assume f[measurable]: "integrable lborel f" then show ?thesis
     using c f f[THEN borel_measurable_integrable] f[THEN lborel_integrable_real_affine, of c t]
     by (subst lborel_real_affine[OF c, of t])
        (simp add: integral_density integral_distr)
 next
   assume "\<not> integrable lborel f" with c show ?thesis
     by (simp add: lborel_integrable_real_affine_iff not_integrable_integral_eq)
 qed
 
 lemma
   fixes c :: "'a::euclidean_space \<Rightarrow> real" and t
   assumes c: "\<And>j. j \<in> Basis \<Longrightarrow> c j \<noteq> 0"
   defines "T == (\<lambda>x. t + (\<Sum>j\<in>Basis. (c j * (x \<bullet> j)) *\<^sub>R j))"
   shows lebesgue_affine_euclidean: "lebesgue = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))" (is "_ = ?D")
     and lebesgue_affine_measurable: "T \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
 proof -
   have T_borel[measurable]: "T \<in> borel \<rightarrow>\<^sub>M borel"
     by (auto simp: T_def[abs_def])
   { fix A :: "'a set" assume A: "A \<in> sets borel"
     then have "emeasure lborel A = 0 \<longleftrightarrow> emeasure (density (distr lborel borel T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))) A = 0"
       unfolding T_def using c by (subst lborel_affine_euclidean[symmetric]) auto
     also have "\<dots> \<longleftrightarrow> emeasure (distr lebesgue lborel T) A = 0"
       using A c by (simp add: distr_completion emeasure_density nn_integral_cmult prod_nonneg cong: distr_cong)
     finally have "emeasure lborel A = 0 \<longleftrightarrow> emeasure (distr lebesgue lborel T) A = 0" . }
   then have eq: "null_sets lborel = null_sets (distr lebesgue lborel T)"
     by (auto simp: null_sets_def)
 
   show "T \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
     by (rule completion.measurable_completion2) (auto simp: eq measurable_completion)
 
   have "lebesgue = completion (density (distr lborel borel T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>)))"
     using c by (subst lborel_affine_euclidean[of c t]) (simp_all add: T_def[abs_def])
   also have "\<dots> = density (completion (distr lebesgue lborel T)) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))"
     using c by (auto intro!: always_eventually prod_pos completion_density_eq simp: distr_completion cong: distr_cong)
   also have "\<dots> = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))"
     by (subst completion.completion_distr_eq) (auto simp: eq measurable_completion)
   finally show "lebesgue = density (distr lebesgue lebesgue T) (\<lambda>_. (\<Prod>j\<in>Basis. \<bar>c j\<bar>))" .
 qed
 
 corollary lebesgue_real_affine:
   "c \<noteq> 0 \<Longrightarrow> lebesgue = density (distr lebesgue lebesgue (\<lambda>x. t + c * x)) (\<lambda>_. ennreal (abs c))"
     using lebesgue_affine_euclidean [where c= "\<lambda>x::real. c"] by simp
 
 lemma nn_integral_real_affine_lebesgue:
   fixes c :: real assumes f[measurable]: "f \<in> borel_measurable lebesgue" and c: "c \<noteq> 0"
   shows "(\<integral>\<^sup>+x. f x \<partial>lebesgue) = ennreal\<bar>c\<bar> * (\<integral>\<^sup>+x. f(t + c * x) \<partial>lebesgue)"
 proof -
   have "(\<integral>\<^sup>+x. f x \<partial>lebesgue) = (\<integral>\<^sup>+x. f x \<partial>density (distr lebesgue lebesgue (\<lambda>x. t + c * x)) (\<lambda>x. ennreal \<bar>c\<bar>))"
     using lebesgue_real_affine c by auto
   also have "\<dots> = \<integral>\<^sup>+ x. ennreal \<bar>c\<bar> * f x \<partial>distr lebesgue lebesgue (\<lambda>x. t + c * x)"
     by (subst nn_integral_density) auto
   also have "\<dots> = ennreal \<bar>c\<bar> * integral\<^sup>N (distr lebesgue lebesgue (\<lambda>x. t + c * x)) f"
     using f measurable_distr_eq1 nn_integral_cmult by blast
   also have "\<dots> = \<bar>c\<bar> * (\<integral>\<^sup>+x. f(t + c * x) \<partial>lebesgue)"
     using lebesgue_affine_measurable[where c= "\<lambda>x::real. c"]
     by (subst nn_integral_distr) (force+)
   finally show ?thesis .
 qed
 
 lemma lebesgue_measurable_scaling[measurable]: "(*\<^sub>R) x \<in> lebesgue \<rightarrow>\<^sub>M lebesgue"
 proof cases
   assume "x = 0"
   then have "(*\<^sub>R) x = (\<lambda>x. 0::'a)"
     by (auto simp: fun_eq_iff)
   then show ?thesis by auto
 next
   assume "x \<noteq> 0" then show ?thesis
     using lebesgue_affine_measurable[of "\<lambda>_. x" 0]
     unfolding scaleR_scaleR[symmetric] scaleR_sum_right[symmetric] euclidean_representation
     by (auto simp add: ac_simps)
 qed
 
 lemma
   fixes m :: real and \<delta> :: "'a::euclidean_space"
   defines "T r d x \<equiv> r *\<^sub>R x + d"
   shows emeasure_lebesgue_affine: "emeasure lebesgue (T m \<delta> ` S) = \<bar>m\<bar> ^ DIM('a) * emeasure lebesgue S" (is ?e)
     and measure_lebesgue_affine: "measure lebesgue (T m \<delta> ` S) = \<bar>m\<bar> ^ DIM('a) * measure lebesgue S" (is ?m)
 proof -
   show ?e
   proof cases
     assume "m = 0" then show ?thesis
       by (simp add: image_constant_conv T_def[abs_def])
   next
     let ?T = "T m \<delta>" and ?T' = "T (1 / m) (- ((1/m) *\<^sub>R \<delta>))"
     assume "m \<noteq> 0"
     then have s_comp_s: "?T' \<circ> ?T = id" "?T \<circ> ?T' = id"
       by (auto simp: T_def[abs_def] fun_eq_iff scaleR_add_right scaleR_diff_right)
     then have "inv ?T' = ?T" "bij ?T'"
       by (auto intro: inv_unique_comp o_bij)
     then have eq: "T m \<delta> ` S = T (1 / m) ((-1/m) *\<^sub>R \<delta>) -` S \<inter> space lebesgue"
       using bij_vimage_eq_inv_image[OF \<open>bij ?T'\<close>, of S] by auto
 
     have trans_eq_T: "(\<lambda>x. \<delta> + (\<Sum>j\<in>Basis. (m * (x \<bullet> j)) *\<^sub>R j)) = T m \<delta>" for m \<delta>
       unfolding T_def[abs_def] scaleR_scaleR[symmetric] scaleR_sum_right[symmetric]
       by (auto simp add: euclidean_representation ac_simps)
 
     have T[measurable]: "T r d \<in> lebesgue \<rightarrow>\<^sub>M lebesgue" for r d
       using lebesgue_affine_measurable[of "\<lambda>_. r" d]
       by (cases "r = 0") (auto simp: trans_eq_T T_def[abs_def])
 
     show ?thesis
     proof cases
       assume "S \<in> sets lebesgue" with \<open>m \<noteq> 0\<close> show ?thesis
         unfolding eq
         apply (subst lebesgue_affine_euclidean[of "\<lambda>_. m" \<delta>])
         apply (simp_all add: emeasure_density trans_eq_T nn_integral_cmult emeasure_distr
                         del: space_completion emeasure_completion)
-        apply (simp add: vimage_comp s_comp_s prod_constant)
+        apply (simp add: vimage_comp s_comp_s)
         done
     next
       assume "S \<notin> sets lebesgue"
       moreover have "?T ` S \<notin> sets lebesgue"
       proof
         assume "?T ` S \<in> sets lebesgue"
         then have "?T -` (?T ` S) \<inter> space lebesgue \<in> sets lebesgue"
           by (rule measurable_sets[OF T])
         also have "?T -` (?T ` S) \<inter> space lebesgue = S"
           by (simp add: vimage_comp s_comp_s eq)
         finally show False using \<open>S \<notin> sets lebesgue\<close> by auto
       qed
       ultimately show ?thesis
         by (simp add: emeasure_notin_sets)
     qed
   qed
   show ?m
     unfolding measure_def \<open>?e\<close> by (simp add: enn2real_mult prod_nonneg)
 qed
 
 lemma lebesgue_real_scale:
   assumes "c \<noteq> 0"
   shows   "lebesgue = density (distr lebesgue lebesgue (\<lambda>x. c * x)) (\<lambda>x. ennreal \<bar>c\<bar>)"
   using assms by (subst lebesgue_affine_euclidean[of "\<lambda>_. c" 0]) simp_all
 
 lemma divideR_right:
   fixes x y :: "'a::real_normed_vector"
   shows "r \<noteq> 0 \<Longrightarrow> y = x /\<^sub>R r \<longleftrightarrow> r *\<^sub>R y = x"
   using scaleR_cancel_left[of r y "x /\<^sub>R r"] by simp
 
 lemma lborel_has_bochner_integral_real_affine_iff:
   fixes x :: "'a :: {banach, second_countable_topology}"
   shows "c \<noteq> 0 \<Longrightarrow>
     has_bochner_integral lborel f x \<longleftrightarrow>
     has_bochner_integral lborel (\<lambda>x. f (t + c * x)) (x /\<^sub>R \<bar>c\<bar>)"
   unfolding has_bochner_integral_iff lborel_integrable_real_affine_iff
   by (simp_all add: lborel_integral_real_affine[symmetric] divideR_right cong: conj_cong)
 
 lemma lborel_distr_uminus: "distr lborel borel uminus = (lborel :: real measure)"
   by (subst lborel_real_affine[of "-1" 0])
      (auto simp: density_1 one_ennreal_def[symmetric])
 
 lemma lborel_distr_mult:
   assumes "(c::real) \<noteq> 0"
   shows "distr lborel borel ((*) c) = density lborel (\<lambda>_. inverse \<bar>c\<bar>)"
 proof-
   have "distr lborel borel ((*) c) = distr lborel lborel ((*) c)" by (simp cong: distr_cong)
   also from assms have "... = density lborel (\<lambda>_. inverse \<bar>c\<bar>)"
     by (subst lborel_real_affine[of "inverse c" 0]) (auto simp: o_def distr_density_distr)
   finally show ?thesis .
 qed
 
 lemma lborel_distr_mult':
   assumes "(c::real) \<noteq> 0"
   shows "lborel = density (distr lborel borel ((*) c)) (\<lambda>_. \<bar>c\<bar>)"
 proof-
   have "lborel = density lborel (\<lambda>_. 1)" by (rule density_1[symmetric])
   also from assms have "(\<lambda>_. 1 :: ennreal) = (\<lambda>_. inverse \<bar>c\<bar> * \<bar>c\<bar>)" by (intro ext) simp
   also have "density lborel ... = density (density lborel (\<lambda>_. inverse \<bar>c\<bar>)) (\<lambda>_. \<bar>c\<bar>)"
     by (subst density_density_eq) (auto simp: ennreal_mult)
   also from assms have "density lborel (\<lambda>_. inverse \<bar>c\<bar>) = distr lborel borel ((*) c)"
     by (rule lborel_distr_mult[symmetric])
   finally show ?thesis .
 qed
 
 lemma lborel_distr_plus:
   fixes c :: "'a::euclidean_space"
   shows "distr lborel borel ((+) c) = lborel"
 by (subst lborel_affine[of 1 c], auto simp: density_1)
 
 interpretation lborel: sigma_finite_measure lborel
   by (rule sigma_finite_lborel)
 
 interpretation lborel_pair: pair_sigma_finite lborel lborel ..
 
 lemma\<^marker>\<open>tag important\<close> lborel_prod:
   "lborel \<Otimes>\<^sub>M lborel = (lborel :: ('a::euclidean_space \<times> 'b::euclidean_space) measure)"
 proof (rule lborel_eqI[symmetric], clarify)
   fix la ua :: 'a and lb ub :: 'b
   assume lu: "\<And>a b. (a, b) \<in> Basis \<Longrightarrow> (la, lb) \<bullet> (a, b) \<le> (ua, ub) \<bullet> (a, b)"
   have [simp]:
     "\<And>b. b \<in> Basis \<Longrightarrow> la \<bullet> b \<le> ua \<bullet> b"
     "\<And>b. b \<in> Basis \<Longrightarrow> lb \<bullet> b \<le> ub \<bullet> b"
     "inj_on (\<lambda>u. (u, 0)) Basis" "inj_on (\<lambda>u. (0, u)) Basis"
     "(\<lambda>u. (u, 0)) ` Basis \<inter> (\<lambda>u. (0, u)) ` Basis = {}"
     "box (la, lb) (ua, ub) = box la ua \<times> box lb ub"
     using lu[of _ 0] lu[of 0] by (auto intro!: inj_onI simp add: Basis_prod_def ball_Un box_def)
   show "emeasure (lborel \<Otimes>\<^sub>M lborel) (box (la, lb) (ua, ub)) =
       ennreal (prod ((\<bullet>) ((ua, ub) - (la, lb))) Basis)"
     by (simp add: lborel.emeasure_pair_measure_Times Basis_prod_def prod.union_disjoint
                   prod.reindex ennreal_mult inner_diff_left prod_nonneg)
 qed (simp add: borel_prod[symmetric])
 
 (* FIXME: conversion in measurable prover *)
 lemma lborelD_Collect[measurable (raw)]: "{x\<in>space borel. P x} \<in> sets borel \<Longrightarrow> {x\<in>space lborel. P x} \<in> sets lborel" 
   by simp
 
 lemma lborelD[measurable (raw)]: "A \<in> sets borel \<Longrightarrow> A \<in> sets lborel"
   by simp
 
 lemma emeasure_bounded_finite:
   assumes "bounded A" shows "emeasure lborel A < \<infinity>"
 proof -
   obtain a b where "A \<subseteq> cbox a b"
     by (meson bounded_subset_cbox_symmetric \<open>bounded A\<close>)
   then have "emeasure lborel A \<le> emeasure lborel (cbox a b)"
     by (intro emeasure_mono) auto
   then show ?thesis
     by (auto simp: emeasure_lborel_cbox_eq prod_nonneg less_top[symmetric] top_unique split: if_split_asm)
 qed
 
 lemma emeasure_compact_finite: "compact A \<Longrightarrow> emeasure lborel A < \<infinity>"
   using emeasure_bounded_finite[of A] by (auto intro: compact_imp_bounded)
 
 lemma borel_integrable_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::{banach, second_countable_topology}"
   assumes "compact S" "continuous_on S f"
   shows "integrable lborel (\<lambda>x. indicator S x *\<^sub>R f x)"
 proof cases
   assume "S \<noteq> {}"
   have "continuous_on S (\<lambda>x. norm (f x))"
     using assms by (intro continuous_intros)
   from continuous_attains_sup[OF \<open>compact S\<close> \<open>S \<noteq> {}\<close> this]
   obtain M where M: "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> M"
     by auto
   show ?thesis
   proof (rule integrable_bound)
     show "integrable lborel (\<lambda>x. indicator S x * M)"
       using assms by (auto intro!: emeasure_compact_finite borel_compact integrable_mult_left)
     show "(\<lambda>x. indicator S x *\<^sub>R f x) \<in> borel_measurable lborel"
       using assms by (auto intro!: borel_measurable_continuous_on_indicator borel_compact)
     show "AE x in lborel. norm (indicator S x *\<^sub>R f x) \<le> norm (indicator S x * M)"
       by (auto split: split_indicator simp: abs_real_def dest!: M)
   qed
 qed simp
 
 lemma borel_integrable_atLeastAtMost:
   fixes f :: "real \<Rightarrow> real"
   assumes f: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> isCont f x"
   shows "integrable lborel (\<lambda>x. f x * indicator {a .. b} x)" (is "integrable _ ?f")
 proof -
   have "integrable lborel (\<lambda>x. indicator {a .. b} x *\<^sub>R f x)"
   proof (rule borel_integrable_compact)
     from f show "continuous_on {a..b} f"
       by (auto intro: continuous_at_imp_continuous_on)
   qed simp
   then show ?thesis
     by (auto simp: mult.commute)
 qed
 
 subsection \<open>Lebesgue measurable sets\<close>
 
 abbreviation\<^marker>\<open>tag important\<close> lmeasurable :: "'a::euclidean_space set set"
 where
   "lmeasurable \<equiv> fmeasurable lebesgue"
 
 lemma not_measurable_UNIV [simp]: "UNIV \<notin> lmeasurable"
   by (simp add: fmeasurable_def)
 
 lemma\<^marker>\<open>tag important\<close> lmeasurable_iff_integrable:
   "S \<in> lmeasurable \<longleftrightarrow> integrable lebesgue (indicator S :: 'a::euclidean_space \<Rightarrow> real)"
   by (auto simp: fmeasurable_def integrable_iff_bounded borel_measurable_indicator_iff ennreal_indicator)
 
 lemma lmeasurable_cbox [iff]: "cbox a b \<in> lmeasurable"
   and lmeasurable_box [iff]: "box a b \<in> lmeasurable"
   by (auto simp: fmeasurable_def emeasure_lborel_box_eq emeasure_lborel_cbox_eq)
 
 lemma
   fixes a::real
   shows lmeasurable_interval [iff]: "{a..b} \<in> lmeasurable" "{a<..<b} \<in> lmeasurable"
   apply (metis box_real(2) lmeasurable_cbox)
   by (metis box_real(1) lmeasurable_box)
 
 lemma fmeasurable_compact: "compact S \<Longrightarrow> S \<in> fmeasurable lborel"
   using emeasure_compact_finite[of S] by (intro fmeasurableI) (auto simp: borel_compact)
 
 lemma lmeasurable_compact: "compact S \<Longrightarrow> S \<in> lmeasurable"
   using fmeasurable_compact by (force simp: fmeasurable_def)
 
 lemma measure_frontier:
    "bounded S \<Longrightarrow> measure lebesgue (frontier S) = measure lebesgue (closure S) - measure lebesgue (interior S)"
   using closure_subset interior_subset
   by (auto simp: frontier_def fmeasurable_compact intro!: measurable_measure_Diff)
 
 lemma lmeasurable_closure:
    "bounded S \<Longrightarrow> closure S \<in> lmeasurable"
   by (simp add: lmeasurable_compact)
 
 lemma lmeasurable_frontier:
    "bounded S \<Longrightarrow> frontier S \<in> lmeasurable"
   by (simp add: compact_frontier_bounded lmeasurable_compact)
 
 lemma lmeasurable_open: "bounded S \<Longrightarrow> open S \<Longrightarrow> S \<in> lmeasurable"
   using emeasure_bounded_finite[of S] by (intro fmeasurableI) (auto simp: borel_open)
 
 lemma lmeasurable_ball [simp]: "ball a r \<in> lmeasurable"
   by (simp add: lmeasurable_open)
 
 lemma lmeasurable_cball [simp]: "cball a r \<in> lmeasurable"
   by (simp add: lmeasurable_compact)
 
 lemma lmeasurable_interior: "bounded S \<Longrightarrow> interior S \<in> lmeasurable"
   by (simp add: bounded_interior lmeasurable_open)
 
 lemma null_sets_cbox_Diff_box: "cbox a b - box a b \<in> null_sets lborel"
 proof -
   have "emeasure lborel (cbox a b - box a b) = 0"
     by (subst emeasure_Diff) (auto simp: emeasure_lborel_cbox_eq emeasure_lborel_box_eq box_subset_cbox)
   then have "cbox a b - box a b \<in> null_sets lborel"
     by (auto simp: null_sets_def)
   then show ?thesis
     by (auto dest!: AE_not_in)
 qed
 
 lemma bounded_set_imp_lmeasurable:
   assumes "bounded S" "S \<in> sets lebesgue" shows "S \<in> lmeasurable"
   by (metis assms bounded_Un emeasure_bounded_finite emeasure_completion fmeasurableI main_part_null_part_Un)
 
 lemma finite_measure_lebesgue_on: "S \<in> lmeasurable \<Longrightarrow> finite_measure (lebesgue_on S)"
   by (auto simp: finite_measureI fmeasurable_def emeasure_restrict_space)
 
 lemma integrable_const_ivl [iff]:
   fixes a::"'a::ordered_euclidean_space"
   shows "integrable (lebesgue_on {a..b}) (\<lambda>x. c)"
   by (metis cbox_interval finite_measure.integrable_const finite_measure_lebesgue_on lmeasurable_cbox)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Translation preserves Lebesgue measure\<close>
 
 lemma sigma_sets_image:
   assumes S: "S \<in> sigma_sets \<Omega> M" and "M \<subseteq> Pow \<Omega>" "f ` \<Omega> = \<Omega>" "inj_on f \<Omega>"
     and M: "\<And>y. y \<in> M \<Longrightarrow> f ` y \<in> M"
   shows "(f ` S) \<in> sigma_sets \<Omega> M"
   using S
 proof (induct S rule: sigma_sets.induct)
   case (Basic a) then show ?case
     by (simp add: M)
 next
   case Empty then show ?case
     by (simp add: sigma_sets.Empty)
 next
   case (Compl a)
   then have "\<Omega> - a \<subseteq> \<Omega>" "a \<subseteq> \<Omega>"
     by (auto simp: sigma_sets_into_sp [OF \<open>M \<subseteq> Pow \<Omega>\<close>])
   then show ?case
     by (auto simp: inj_on_image_set_diff [OF \<open>inj_on f \<Omega>\<close>] assms intro: Compl sigma_sets.Compl)
 next
   case (Union a) then show ?case
     by (metis image_UN sigma_sets.simps)
 qed
 
 lemma null_sets_translation:
   assumes "N \<in> null_sets lborel" shows "{x. x - a \<in> N} \<in> null_sets lborel"
 proof -
   have [simp]: "(\<lambda>x. x + a) ` N = {x. x - a \<in> N}"
     by force
   show ?thesis
     using assms emeasure_lebesgue_affine [of 1 a N] by (auto simp: null_sets_def)
 qed
 
 lemma lebesgue_sets_translation:
   fixes f :: "'a \<Rightarrow> 'a::euclidean_space"
   assumes S: "S \<in> sets lebesgue"
   shows "((\<lambda>x. a + x) ` S) \<in> sets lebesgue"
 proof -
   have im_eq: "(+) a ` A = {x. x - a \<in> A}" for A
     by force
   have "((\<lambda>x. a + x) ` S) = ((\<lambda>x. -a + x) -` S) \<inter> (space lebesgue)"
     using image_iff by fastforce
   also have "\<dots> \<in> sets lebesgue"
   proof (rule measurable_sets [OF measurableI assms])
     fix A :: "'b set"
     assume A: "A \<in> sets lebesgue"
     have vim_eq: "(\<lambda>x. x - a) -` A = (+) a ` A" for A
       by force
     have "\<exists>s n N'. (+) a ` (S \<union> N) = s \<union> n \<and> s \<in> sets borel \<and> N' \<in> null_sets lborel \<and> n \<subseteq> N'"
       if "S \<in> sets borel" and "N' \<in> null_sets lborel" and "N \<subseteq> N'" for S N N'
     proof (intro exI conjI)
       show "(+) a ` (S \<union> N) = (\<lambda>x. a + x) ` S \<union> (\<lambda>x. a + x) ` N"
         by auto
       show "(\<lambda>x. a + x) ` N' \<in> null_sets lborel"
         using that by (auto simp: null_sets_translation im_eq)
     qed (use that im_eq in auto)
     with A have "(\<lambda>x. x - a) -` A \<in> sets lebesgue"
       by (force simp: vim_eq completion_def intro!: sigma_sets_image)
     then show "(+) (- a) -` A \<inter> space lebesgue \<in> sets lebesgue"
       by (auto simp: vimage_def im_eq)
   qed auto
   finally show ?thesis .
 qed
 
 lemma measurable_translation:
    "S \<in> lmeasurable \<Longrightarrow> ((+) a ` S) \<in> lmeasurable"
   using emeasure_lebesgue_affine [of 1 a S]
   apply (auto intro: lebesgue_sets_translation simp add: fmeasurable_def cong: image_cong_simp)
   apply (simp add: ac_simps)
   done
 
 lemma measurable_translation_subtract:
    "S \<in> lmeasurable \<Longrightarrow> ((\<lambda>x. x - a) ` S) \<in> lmeasurable"
   using measurable_translation [of S "- a"] by (simp cong: image_cong_simp)
 
 lemma measure_translation:
   "measure lebesgue ((+) a ` S) = measure lebesgue S"
   using measure_lebesgue_affine [of 1 a S] by (simp add: ac_simps cong: image_cong_simp)
 
 lemma measure_translation_subtract:
   "measure lebesgue ((\<lambda>x. x - a) ` S) = measure lebesgue S"
   using measure_translation [of "- a"] by (simp cong: image_cong_simp)
 
 
 subsection \<open>A nice lemma for negligibility proofs\<close>
 
 lemma summable_iff_suminf_neq_top: "(\<And>n. f n \<ge> 0) \<Longrightarrow> \<not> summable f \<Longrightarrow> (\<Sum>i. ennreal (f i)) = top"
   by (metis summable_suminf_not_top)
 
 proposition\<^marker>\<open>tag important\<close> starlike_negligible_bounded_gmeasurable:
   fixes S :: "'a :: euclidean_space set"
   assumes S: "S \<in> sets lebesgue" and "bounded S"
       and eq1: "\<And>c x. \<lbrakk>(c *\<^sub>R x) \<in> S; 0 \<le> c; x \<in> S\<rbrakk> \<Longrightarrow> c = 1"
     shows "S \<in> null_sets lebesgue"
 proof -
   obtain M where "0 < M" "S \<subseteq> ball 0 M"
     using \<open>bounded S\<close> by (auto dest: bounded_subset_ballD)
 
   let ?f = "\<lambda>n. root DIM('a) (Suc n)"
 
   have vimage_eq_image: "(*\<^sub>R) (?f n) -` S = (*\<^sub>R) (1 / ?f n) ` S" for n
     apply safe
     subgoal for x by (rule image_eqI[of _ _ "?f n *\<^sub>R x"]) auto
     subgoal by auto
     done
 
   have eq: "(1 / ?f n) ^ DIM('a) = 1 / Suc n" for n
     by (simp add: field_simps)
 
   { fix n x assume x: "root DIM('a) (1 + real n) *\<^sub>R x \<in> S"
     have "1 * norm x \<le> root DIM('a) (1 + real n) * norm x"
       by (rule mult_mono) auto
     also have "\<dots> < M"
       using x \<open>S \<subseteq> ball 0 M\<close> by auto
     finally have "norm x < M" by simp }
   note less_M = this
 
   have "(\<Sum>n. ennreal (1 / Suc n)) = top"
     using not_summable_harmonic[where 'a=real] summable_Suc_iff[where f="\<lambda>n. 1 / (real n)"]
     by (intro summable_iff_suminf_neq_top) (auto simp add: inverse_eq_divide)
   then have "top * emeasure lebesgue S = (\<Sum>n. (1 / ?f n)^DIM('a) * emeasure lebesgue S)"
     unfolding ennreal_suminf_multc eq by simp
   also have "\<dots> = (\<Sum>n. emeasure lebesgue ((*\<^sub>R) (?f n) -` S))"
     unfolding vimage_eq_image using emeasure_lebesgue_affine[of "1 / ?f n" 0 S for n] by simp
   also have "\<dots> = emeasure lebesgue (\<Union>n. (*\<^sub>R) (?f n) -` S)"
   proof (intro suminf_emeasure)
     show "disjoint_family (\<lambda>n. (*\<^sub>R) (?f n) -` S)"
       unfolding disjoint_family_on_def
     proof safe
       fix m n :: nat and x assume "m \<noteq> n" "?f m *\<^sub>R x \<in> S" "?f n *\<^sub>R x \<in> S"
       with eq1[of "?f m / ?f n" "?f n *\<^sub>R x"] show "x \<in> {}"
         by auto
     qed
     have "(*\<^sub>R) (?f i) -` S \<in> sets lebesgue" for i
       using measurable_sets[OF lebesgue_measurable_scaling[of "?f i"] S] by auto
     then show "range (\<lambda>i. (*\<^sub>R) (?f i) -` S) \<subseteq> sets lebesgue"
       by auto
   qed
   also have "\<dots> \<le> emeasure lebesgue (ball 0 M :: 'a set)"
     using less_M by (intro emeasure_mono) auto
   also have "\<dots> < top"
     using lmeasurable_ball by (auto simp: fmeasurable_def)
   finally have "emeasure lebesgue S = 0"
     by (simp add: ennreal_top_mult split: if_split_asm)
   then show "S \<in> null_sets lebesgue"
     unfolding null_sets_def using \<open>S \<in> sets lebesgue\<close> by auto
 qed
 
 corollary starlike_negligible_compact:
   "compact S \<Longrightarrow> (\<And>c x. \<lbrakk>(c *\<^sub>R x) \<in> S; 0 \<le> c; x \<in> S\<rbrakk> \<Longrightarrow> c = 1) \<Longrightarrow> S \<in> null_sets lebesgue"
   using starlike_negligible_bounded_gmeasurable[of S] by (auto simp: compact_eq_bounded_closed)
 
 proposition outer_regular_lborel_le:
   assumes B[measurable]: "B \<in> sets borel" and "0 < (e::real)"
   obtains U where "open U" "B \<subseteq> U" and "emeasure lborel (U - B) \<le> e"
 proof -
   let ?\<mu> = "emeasure lborel"
   let ?B = "\<lambda>n::nat. ball 0 n :: 'a set"
   let ?e = "\<lambda>n. e*((1/2)^Suc n)"
   have "\<forall>n. \<exists>U. open U \<and> ?B n \<inter> B \<subseteq> U \<and> ?\<mu> (U - B) < ?e n"
   proof
     fix n :: nat
     let ?A = "density lborel (indicator (?B n))"
     have emeasure_A: "X \<in> sets borel \<Longrightarrow> emeasure ?A X = ?\<mu> (?B n \<inter> X)" for X
       by (auto simp: emeasure_density borel_measurable_indicator indicator_inter_arith[symmetric])
 
     have finite_A: "emeasure ?A (space ?A) \<noteq> \<infinity>"
       using emeasure_bounded_finite[of "?B n"] by (auto simp: emeasure_A)
     interpret A: finite_measure ?A
       by rule fact
     have "emeasure ?A B + ?e n > (INF U\<in>{U. B \<subseteq> U \<and> open U}. emeasure ?A U)"
       using \<open>0<e\<close> by (auto simp: outer_regular[OF _ finite_A B, symmetric])
     then obtain U where U: "B \<subseteq> U" "open U" and muU: "?\<mu> (?B n \<inter> B) + ?e n > ?\<mu> (?B n \<inter> U)"
       unfolding INF_less_iff by (auto simp: emeasure_A)
     moreover
     { have "?\<mu> ((?B n \<inter> U) - B) = ?\<mu> ((?B n \<inter> U) - (?B n \<inter> B))"
         using U by (intro arg_cong[where f="?\<mu>"]) auto
       also have "\<dots> = ?\<mu> (?B n \<inter> U) - ?\<mu> (?B n \<inter> B)"
         using U A.emeasure_finite[of B]
         by (intro emeasure_Diff) (auto simp del: A.emeasure_finite simp: emeasure_A)
       also have "\<dots> < ?e n"
         using U muU A.emeasure_finite[of B]
         by (subst minus_less_iff_ennreal)
           (auto simp del: A.emeasure_finite simp: emeasure_A less_top ac_simps intro!: emeasure_mono)
       finally have "?\<mu> ((?B n \<inter> U) - B) < ?e n" . }
     ultimately show "\<exists>U. open U \<and> ?B n \<inter> B \<subseteq> U \<and> ?\<mu> (U - B) < ?e n"
       by (intro exI[of _ "?B n \<inter> U"]) auto
   qed
   then obtain U
     where U: "\<And>n. open (U n)" "\<And>n. ?B n \<inter> B \<subseteq> U n" "\<And>n. ?\<mu> (U n - B) < ?e n"
     by metis
   show ?thesis
   proof
     { fix x assume "x \<in> B"
       moreover
       obtain n where "norm x < real n"
         using reals_Archimedean2 by blast
       ultimately have "x \<in> (\<Union>n. U n)"
         using U(2)[of n] by auto }
     note * = this
     then show "open (\<Union>n. U n)" "B \<subseteq> (\<Union>n. U n)"
       using U by auto
     have "?\<mu> (\<Union>n. U n - B) \<le> (\<Sum>n. ?\<mu> (U n - B))"
       using U(1) by (intro emeasure_subadditive_countably) auto
     also have "\<dots> \<le> (\<Sum>n. ennreal (?e n))"
       using U(3) by (intro suminf_le) (auto intro: less_imp_le)
     also have "\<dots> = ennreal (e * 1)"
       using \<open>0<e\<close> by (intro suminf_ennreal_eq sums_mult power_half_series) auto
     finally show "emeasure lborel ((\<Union>n. U n) - B) \<le> ennreal e"
       by simp
   qed
 qed
 
 lemma\<^marker>\<open>tag important\<close> outer_regular_lborel:
   assumes B: "B \<in> sets borel" and "0 < (e::real)"
   obtains U where "open U" "B \<subseteq> U" "emeasure lborel (U - B) < e"
 proof -
   obtain U where U: "open U" "B \<subseteq> U" and "emeasure lborel (U-B) \<le> e/2"
     using outer_regular_lborel_le [OF B, of "e/2"] \<open>e > 0\<close>
     by force
   moreover have "ennreal (e/2) < ennreal e"
     using \<open>e > 0\<close> by (simp add: ennreal_lessI)
   ultimately have "emeasure lborel (U-B) < e"
     by auto
   with U show ?thesis
     using that by auto
 qed
 
 lemma completion_upper:
   assumes A: "A \<in> sets (completion M)"
   obtains A' where "A \<subseteq> A'" "A' \<in> sets M" "A' - A \<in> null_sets (completion M)"
                    "emeasure (completion M) A = emeasure M A'"
 proof -
   from AE_notin_null_part[OF A] obtain N where N: "N \<in> null_sets M" "null_part M A \<subseteq> N"
     unfolding eventually_ae_filter using null_part_null_sets[OF A, THEN null_setsD2, THEN sets.sets_into_space] by auto
   let ?A' = "main_part M A \<union> N"
   show ?thesis
   proof
     show "A \<subseteq> ?A'"
       using \<open>null_part M A \<subseteq> N\<close> by (subst main_part_null_part_Un[symmetric, OF A]) auto
     have "main_part M A \<subseteq> A"
       using assms main_part_null_part_Un by auto
     then have "?A' - A \<subseteq> N"
       by blast
     with N show "?A' - A \<in> null_sets (completion M)"
       by (blast intro: null_sets_completionI completion.complete_measure_axioms complete_measure.complete2)
     show "emeasure (completion M) A = emeasure M (main_part M A \<union> N)"
       using A \<open>N \<in> null_sets M\<close> by (simp add: emeasure_Un_null_set)
   qed (use A N in auto)
 qed
 
 lemma sets_lebesgue_outer_open:
   fixes e::real
   assumes S: "S \<in> sets lebesgue" and "e > 0"
   obtains T where "open T" "S \<subseteq> T" "(T - S) \<in> lmeasurable" "emeasure lebesgue (T - S) < ennreal e"
 proof -
   obtain S' where S': "S \<subseteq> S'" "S' \<in> sets borel"
               and null: "S' - S \<in> null_sets lebesgue"
               and em: "emeasure lebesgue S = emeasure lborel S'"
     using completion_upper[of S lborel] S by auto
   then have f_S': "S' \<in> sets borel"
     using S by (auto simp: fmeasurable_def)
   with outer_regular_lborel[OF _ \<open>0<e\<close>]
   obtain U where U: "open U" "S' \<subseteq> U" "emeasure lborel (U - S') < e"
     by blast
   show thesis
   proof
     show "open U" "S \<subseteq> U"
       using f_S' U S' by auto
   have "(U - S) = (U - S') \<union> (S' - S)"
     using S' U by auto
   then have eq: "emeasure lebesgue (U - S) = emeasure lborel (U - S')"
     using null  by (simp add: U(1) emeasure_Un_null_set f_S' sets.Diff)
   have "(U - S) \<in> sets lebesgue"
     by (simp add: S U(1) sets.Diff)
   then show "(U - S) \<in> lmeasurable"
     unfolding fmeasurable_def using U(3) eq less_le_trans by fastforce
   with eq U show "emeasure lebesgue (U - S) < e"
     by (simp add: eq)
   qed
 qed
 
 lemma sets_lebesgue_inner_closed:
   fixes e::real
   assumes "S \<in> sets lebesgue" "e > 0"
   obtains T where "closed T" "T \<subseteq> S" "S-T \<in> lmeasurable" "emeasure lebesgue (S - T) < ennreal e"
 proof -
   have "-S \<in> sets lebesgue"
     using assms by (simp add: Compl_in_sets_lebesgue)
   then obtain T where "open T" "-S \<subseteq> T"
           and T: "(T - -S) \<in> lmeasurable" "emeasure lebesgue (T - -S) < e"
     using sets_lebesgue_outer_open assms  by blast
   show thesis
   proof
     show "closed (-T)"
       using \<open>open T\<close> by blast
     show "-T \<subseteq> S"
       using \<open>- S \<subseteq> T\<close> by auto
     show "S - ( -T) \<in> lmeasurable" "emeasure lebesgue (S - (- T)) < e"
       using T by (auto simp: Int_commute)
   qed
 qed
 
 lemma lebesgue_openin:
    "\<lbrakk>openin (top_of_set S) T; S \<in> sets lebesgue\<rbrakk> \<Longrightarrow> T \<in> sets lebesgue"
   by (metis borel_open openin_open sets.Int sets_completionI_sets sets_lborel)
 
 lemma lebesgue_closedin:
    "\<lbrakk>closedin (top_of_set S) T; S \<in> sets lebesgue\<rbrakk> \<Longrightarrow> T \<in> sets lebesgue"
   by (metis borel_closed closedin_closed sets.Int sets_completionI_sets sets_lborel)
 
 
 subsection\<open>\<open>F_sigma\<close> and \<open>G_delta\<close> sets.\<close> 
 
 \<comment> \<open>\<^url>\<open>https://en.wikipedia.org/wiki/F-sigma_set\<close>\<close>
 inductive\<^marker>\<open>tag important\<close> fsigma :: "'a::topological_space set \<Rightarrow> bool" where
   "(\<And>n::nat. closed (F n)) \<Longrightarrow> fsigma (\<Union>(F ` UNIV))"
 
 inductive\<^marker>\<open>tag important\<close> gdelta :: "'a::topological_space set \<Rightarrow> bool" where
   "(\<And>n::nat. open (F n)) \<Longrightarrow> gdelta (\<Inter>(F ` UNIV))"
 
 lemma fsigma_Union_compact:
   fixes S :: "'a::{real_normed_vector,heine_borel} set"
   shows "fsigma S \<longleftrightarrow> (\<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> Collect compact \<and> S = \<Union>(F ` UNIV))"
 proof safe
   assume "fsigma S"
   then obtain F :: "nat \<Rightarrow> 'a set" where F: "range F \<subseteq> Collect closed" "S = \<Union>(F ` UNIV)"
     by (meson fsigma.cases image_subsetI mem_Collect_eq)
   then have "\<exists>D::nat \<Rightarrow> 'a set. range D \<subseteq> Collect compact \<and> \<Union>(D ` UNIV) = F i" for i
     using closed_Union_compact_subsets [of "F i"]
     by (metis image_subsetI mem_Collect_eq range_subsetD)
   then obtain D :: "nat \<Rightarrow> nat \<Rightarrow> 'a set"
     where D: "\<And>i. range (D i) \<subseteq> Collect compact \<and> \<Union>((D i) ` UNIV) = F i"
     by metis
   let ?DD = "\<lambda>n. (\<lambda>(i,j). D i j) (prod_decode n)"
   show "\<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> Collect compact \<and> S = \<Union>(F ` UNIV)"
   proof (intro exI conjI)
     show "range ?DD \<subseteq> Collect compact"
       using D by clarsimp (metis mem_Collect_eq rangeI split_conv subsetCE surj_pair)
     show "S = \<Union> (range ?DD)"
     proof
       show "S \<subseteq> \<Union> (range ?DD)"
         using D F
         by clarsimp (metis UN_iff old.prod.case prod_decode_inverse prod_encode_eq)
       show "\<Union> (range ?DD) \<subseteq> S"
         using D F  by fastforce
     qed
   qed
 next
   fix F :: "nat \<Rightarrow> 'a set"
   assume "range F \<subseteq> Collect compact" and "S = \<Union>(F ` UNIV)"
   then show "fsigma (\<Union>(F ` UNIV))"
     by (simp add: compact_imp_closed fsigma.intros image_subset_iff)
 qed
 
 lemma gdelta_imp_fsigma: "gdelta S \<Longrightarrow> fsigma (- S)"
 proof (induction rule: gdelta.induct)
   case (1 F)
   have "- \<Inter>(F ` UNIV) = (\<Union>i. -(F i))"
     by auto
   then show ?case
     by (simp add: fsigma.intros closed_Compl 1)
 qed
 
 lemma fsigma_imp_gdelta: "fsigma S \<Longrightarrow> gdelta (- S)"
 proof (induction rule: fsigma.induct)
   case (1 F)
   have "- \<Union>(F ` UNIV) = (\<Inter>i. -(F i))"
     by auto
   then show ?case
     by (simp add: 1 gdelta.intros open_closed)
 qed
 
 lemma gdelta_complement: "gdelta(- S) \<longleftrightarrow> fsigma S"
   using fsigma_imp_gdelta gdelta_imp_fsigma by force
 
 lemma lebesgue_set_almost_fsigma:
   assumes "S \<in> sets lebesgue"
   obtains C T where "fsigma C" "T \<in> null_sets lebesgue" "C \<union> T = S" "disjnt C T"
 proof -
   { fix n::nat
     obtain T where "closed T" "T \<subseteq> S" "S-T \<in> lmeasurable" "emeasure lebesgue (S - T) < ennreal (1 / Suc n)"
       using sets_lebesgue_inner_closed [OF assms]
       by (metis of_nat_0_less_iff zero_less_Suc zero_less_divide_1_iff)
     then have "\<exists>T. closed T \<and> T \<subseteq> S \<and> S - T \<in> lmeasurable \<and> measure lebesgue (S-T) < 1 / Suc n"
       by (metis emeasure_eq_measure2 ennreal_leI not_le)
   }
   then obtain F where F: "\<And>n::nat. closed (F n) \<and> F n \<subseteq> S \<and> S - F n \<in> lmeasurable \<and> measure lebesgue (S - F n) < 1 / Suc n"
     by metis
   let ?C = "\<Union>(F ` UNIV)"
   show thesis
   proof
     show "fsigma ?C"
       using F by (simp add: fsigma.intros)
     show "(S - ?C) \<in> null_sets lebesgue"
     proof (clarsimp simp add: completion.null_sets_outer_le)
       fix e :: "real"
       assume "0 < e"
       then obtain n where n: "1 / Suc n < e"
         using nat_approx_posE by metis
       show "\<exists>T \<in> lmeasurable. S - (\<Union>x. F x) \<subseteq> T \<and> measure lebesgue T \<le> e"
       proof (intro bexI conjI)
         show "measure lebesgue (S - F n) \<le> e"
           by (meson F n less_trans not_le order.asym)
       qed (use F in auto)
     qed
     show "?C \<union> (S - ?C) = S"
       using F by blast
     show "disjnt ?C (S - ?C)"
       by (auto simp: disjnt_def)
   qed
 qed
 
 lemma lebesgue_set_almost_gdelta:
   assumes "S \<in> sets lebesgue"
   obtains C T where "gdelta C" "T \<in> null_sets lebesgue" "S \<union> T = C" "disjnt S T"
 proof -
   have "-S \<in> sets lebesgue"
     using assms Compl_in_sets_lebesgue by blast
   then obtain C T where C: "fsigma C" "T \<in> null_sets lebesgue" "C \<union> T = -S" "disjnt C T"
     using lebesgue_set_almost_fsigma by metis
   show thesis
   proof
     show "gdelta (-C)"
       by (simp add: \<open>fsigma C\<close> fsigma_imp_gdelta)
     show "S \<union> T = -C" "disjnt S T"
       using C by (auto simp: disjnt_def)
   qed (use C in auto)
 qed
 
 end
diff --git a/src/HOL/Analysis/Locally.thy b/src/HOL/Analysis/Locally.thy
--- a/src/HOL/Analysis/Locally.thy
+++ b/src/HOL/Analysis/Locally.thy
@@ -1,451 +1,451 @@
 section \<open>Neighbourhood bases and Locally path-connected spaces\<close>
 
 theory Locally
   imports
     Path_Connected Function_Topology
 begin
 
 subsection\<open>Neighbourhood Bases\<close>
 
 text \<open>Useful for "local" properties of various kinds\<close>
 
 definition neighbourhood_base_at where
  "neighbourhood_base_at x P X \<equiv>
         \<forall>W. openin X W \<and> x \<in> W
             \<longrightarrow> (\<exists>U V. openin X U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W)"
 
 definition neighbourhood_base_of where
  "neighbourhood_base_of P X \<equiv>
         \<forall>x \<in> topspace X. neighbourhood_base_at x P X"
 
 lemma neighbourhood_base_of:
    "neighbourhood_base_of P X \<longleftrightarrow>
         (\<forall>W x. openin X W \<and> x \<in> W
           \<longrightarrow> (\<exists>U V. openin X U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W))"
   unfolding neighbourhood_base_at_def neighbourhood_base_of_def
   using openin_subset by blast
 
 lemma neighbourhood_base_at_mono:
    "\<lbrakk>neighbourhood_base_at x P X; \<And>S. \<lbrakk>P S; x \<in> S\<rbrakk> \<Longrightarrow> Q S\<rbrakk> \<Longrightarrow> neighbourhood_base_at x Q X"
   unfolding neighbourhood_base_at_def
   by (meson subset_eq)
 
 lemma neighbourhood_base_of_mono:
    "\<lbrakk>neighbourhood_base_of P X; \<And>S. P S \<Longrightarrow> Q S\<rbrakk> \<Longrightarrow> neighbourhood_base_of Q X"
   unfolding neighbourhood_base_of_def
   using neighbourhood_base_at_mono by force
 
 lemma open_neighbourhood_base_at:
    "(\<And>S. \<lbrakk>P S; x \<in> S\<rbrakk> \<Longrightarrow> openin X S)
         \<Longrightarrow> neighbourhood_base_at x P X \<longleftrightarrow> (\<forall>W. openin X W \<and> x \<in> W \<longrightarrow> (\<exists>U. P U \<and> x \<in> U \<and> U \<subseteq> W))"
   unfolding neighbourhood_base_at_def
   by (meson subsetD)
 
 lemma open_neighbourhood_base_of:
   "(\<forall>S. P S \<longrightarrow> openin X S)
         \<Longrightarrow> neighbourhood_base_of P X \<longleftrightarrow> (\<forall>W x. openin X W \<and> x \<in> W \<longrightarrow> (\<exists>U. P U \<and> x \<in> U \<and> U \<subseteq> W))"
   apply (simp add: neighbourhood_base_of, safe, blast)
   by meson
 
 lemma neighbourhood_base_of_open_subset:
    "\<lbrakk>neighbourhood_base_of P X; openin X S\<rbrakk>
         \<Longrightarrow> neighbourhood_base_of P (subtopology X S)"
   apply (clarsimp simp add: neighbourhood_base_of openin_subtopology_alt image_def)
   apply (rename_tac x V)
   apply (drule_tac x="S \<inter> V" in spec)
   apply (simp add: Int_ac)
   by (metis IntI le_infI1 openin_Int)
 
 lemma neighbourhood_base_of_topology_base:
    "openin X = arbitrary union_of (\<lambda>W. W \<in> \<B>)
         \<Longrightarrow> neighbourhood_base_of P X \<longleftrightarrow>
              (\<forall>W x. W \<in> \<B> \<and> x \<in> W  \<longrightarrow> (\<exists>U V. openin X U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W))"
   apply (auto simp: openin_topology_base_unique neighbourhood_base_of)
   by (meson subset_trans)
 
 lemma neighbourhood_base_at_unlocalized:
   assumes "\<And>S T. \<lbrakk>P S; openin X T; x \<in> T; T \<subseteq> S\<rbrakk> \<Longrightarrow> P T"
   shows "neighbourhood_base_at x P X
      \<longleftrightarrow> (x \<in> topspace X \<longrightarrow> (\<exists>U V. openin X U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> topspace X))"
          (is "?lhs = ?rhs")
 proof
   assume R: ?rhs show ?lhs
     unfolding neighbourhood_base_at_def
   proof clarify
     fix W
     assume "openin X W" "x \<in> W"
     then have "x \<in> topspace X"
       using openin_subset by blast
     with R obtain U V where "openin X U" "P V" "x \<in> U" "U \<subseteq> V" "V \<subseteq> topspace X"
       by blast
     then show "\<exists>U V. openin X U \<and> P V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W"
       by (metis IntI \<open>openin X W\<close> \<open>x \<in> W\<close> assms inf_le1 inf_le2 openin_Int)
   qed
 qed (simp add: neighbourhood_base_at_def)
 
 lemma neighbourhood_base_at_with_subset:
    "\<lbrakk>openin X U; x \<in> U\<rbrakk>
         \<Longrightarrow> (neighbourhood_base_at x P X \<longleftrightarrow> neighbourhood_base_at x (\<lambda>T. T \<subseteq> U \<and> P T) X)"
   apply (simp add: neighbourhood_base_at_def)
   apply (metis IntI Int_subset_iff openin_Int)
   done
 
 lemma neighbourhood_base_of_with_subset:
    "neighbourhood_base_of P X \<longleftrightarrow> neighbourhood_base_of (\<lambda>t. t \<subseteq> topspace X \<and> P t) X"
   using neighbourhood_base_at_with_subset
   by (fastforce simp add: neighbourhood_base_of_def)
 
 subsection\<open>Locally path-connected spaces\<close>
 
 definition weakly_locally_path_connected_at
   where "weakly_locally_path_connected_at x X \<equiv> neighbourhood_base_at x (path_connectedin X) X"
 
 definition locally_path_connected_at
   where "locally_path_connected_at x X \<equiv>
     neighbourhood_base_at x (\<lambda>U. openin X U \<and> path_connectedin X U) X"
 
 definition locally_path_connected_space
   where "locally_path_connected_space X \<equiv> neighbourhood_base_of (path_connectedin X) X"
 
 lemma locally_path_connected_space_alt:
   "locally_path_connected_space X \<longleftrightarrow> neighbourhood_base_of (\<lambda>U. openin X U \<and> path_connectedin X U) X"
   (is "?P = ?Q")
   and locally_path_connected_space_eq_open_path_component_of:
   "locally_path_connected_space X \<longleftrightarrow>
         (\<forall>U x. openin X U \<and> x \<in> U \<longrightarrow> openin X (Collect (path_component_of (subtopology X U) x)))"
   (is "?P = ?R")
 proof -
   have ?P if ?Q
     using locally_path_connected_space_def neighbourhood_base_of_mono that by auto
   moreover have ?R if P: ?P
   proof -
     show ?thesis
     proof clarify
       fix U y
       assume "openin X U" "y \<in> U"
       have "\<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> Collect (path_component_of (subtopology X U) y)"
         if "path_component_of (subtopology X U) y x" for x
 
       proof -
         have "x \<in> U"
           using path_component_of_equiv that topspace_subtopology by fastforce
         then have "\<exists>Ua. openin X Ua \<and> (\<exists>V. path_connectedin X V \<and> x \<in> Ua \<and> Ua \<subseteq> V \<and> V \<subseteq> U)"
       using P
       by (simp add: \<open>openin X U\<close> locally_path_connected_space_def neighbourhood_base_of)
         then show ?thesis
           by (metis dual_order.trans path_component_of_equiv path_component_of_maximal path_connectedin_subtopology subset_iff that)
       qed
       then show "openin X (Collect (path_component_of (subtopology X U) y))"
         using openin_subopen by force
     qed
   qed
   moreover have ?Q if ?R
     using that
     apply (simp add: open_neighbourhood_base_of)
     by (metis mem_Collect_eq openin_subset path_component_of_refl path_connectedin_path_component_of path_connectedin_subtopology that topspace_subtopology_subset)
   ultimately show "?P = ?Q" "?P = ?R"
     by blast+
 qed
 
 lemma locally_path_connected_space:
    "locally_path_connected_space X
    \<longleftrightarrow> (\<forall>V x. openin X V \<and> x \<in> V \<longrightarrow> (\<exists>U. openin X U \<and> path_connectedin X U \<and> x \<in> U \<and> U \<subseteq> V))"
   by (simp add: locally_path_connected_space_alt open_neighbourhood_base_of)
 
 lemma locally_path_connected_space_open_path_components:
    "locally_path_connected_space X \<longleftrightarrow>
         (\<forall>U c. openin X U \<and> c \<in> path_components_of(subtopology X U) \<longrightarrow> openin X c)"
-  apply (auto simp: locally_path_connected_space_eq_open_path_component_of path_components_of_def topspace_subtopology)
+  apply (auto simp: locally_path_connected_space_eq_open_path_component_of path_components_of_def)
   by (metis imageI inf.absorb_iff2 openin_closedin_eq)
 
 lemma openin_path_component_of_locally_path_connected_space:
    "locally_path_connected_space X \<Longrightarrow> openin X (Collect (path_component_of X x))"
   apply (auto simp: locally_path_connected_space_eq_open_path_component_of)
   by (metis openin_empty openin_topspace path_component_of_eq_empty subtopology_topspace)
 
 lemma openin_path_components_of_locally_path_connected_space:
    "\<lbrakk>locally_path_connected_space X; c \<in> path_components_of X\<rbrakk> \<Longrightarrow> openin X c"
   apply (auto simp: locally_path_connected_space_eq_open_path_component_of)
   by (metis (no_types, lifting) imageE openin_topspace path_components_of_def subtopology_topspace)
 
 lemma closedin_path_components_of_locally_path_connected_space:
    "\<lbrakk>locally_path_connected_space X; c \<in> path_components_of X\<rbrakk> \<Longrightarrow> closedin X c"
   by (simp add: closedin_def complement_path_components_of_Union openin_path_components_of_locally_path_connected_space openin_clauses(3) path_components_of_subset)
 
 lemma closedin_path_component_of_locally_path_connected_space:
   assumes "locally_path_connected_space X"
   shows "closedin X (Collect (path_component_of X x))"
 proof (cases "x \<in> topspace X")
   case True
   then show ?thesis
     by (simp add: assms closedin_path_components_of_locally_path_connected_space path_component_in_path_components_of)
 next
   case False
   then show ?thesis
     by (metis closedin_empty path_component_of_eq_empty)
 qed
 
 lemma weakly_locally_path_connected_at:
    "weakly_locally_path_connected_at x X \<longleftrightarrow>
     (\<forall>V. openin X V \<and> x \<in> V
           \<longrightarrow> (\<exists>U. openin X U \<and> x \<in> U \<and> U \<subseteq> V \<and>
                   (\<forall>y \<in> U. \<exists>C. path_connectedin X C \<and> C \<subseteq> V \<and> x \<in> C \<and> y \<in> C)))"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     apply (simp add: weakly_locally_path_connected_at_def neighbourhood_base_at_def)
     by (meson order_trans subsetD)
 next
   have *: "\<exists>V. path_connectedin X V \<and> U \<subseteq> V \<and> V \<subseteq> W"
     if "(\<forall>y\<in>U. \<exists>C. path_connectedin X C \<and> C \<subseteq> W \<and> x \<in> C \<and> y \<in> C)"
     for W U
   proof (intro exI conjI)
     let ?V = "(Collect (path_component_of (subtopology X W) x))"
       show "path_connectedin X (Collect (path_component_of (subtopology X W) x))"
         by (meson path_connectedin_path_component_of path_connectedin_subtopology)
       show "U \<subseteq> ?V"
         by (auto simp: path_component_of path_connectedin_subtopology that)
       show "?V \<subseteq> W"
         by (meson path_connectedin_path_component_of path_connectedin_subtopology)
     qed
   assume ?rhs
   then show ?lhs
     unfolding weakly_locally_path_connected_at_def neighbourhood_base_at_def by (metis "*")
 qed
 
 lemma locally_path_connected_space_im_kleinen:
    "locally_path_connected_space X \<longleftrightarrow>
       (\<forall>V x. openin X V \<and> x \<in> V
              \<longrightarrow> (\<exists>U. openin X U \<and>
                     x \<in> U \<and> U \<subseteq> V \<and>
                     (\<forall>y \<in> U. \<exists>c. path_connectedin X c \<and>
                                 c \<subseteq> V \<and> x \<in> c \<and> y \<in> c)))"
   apply (simp add: locally_path_connected_space_def neighbourhood_base_of_def)
   apply (simp add: weakly_locally_path_connected_at flip: weakly_locally_path_connected_at_def)
   using openin_subset apply force
   done
 
 lemma locally_path_connected_space_open_subset:
    "\<lbrakk>locally_path_connected_space X; openin X s\<rbrakk>
         \<Longrightarrow> locally_path_connected_space (subtopology X s)"
   apply (simp add: locally_path_connected_space_def neighbourhood_base_of openin_open_subtopology path_connectedin_subtopology)
   by (meson order_trans)
 
 lemma locally_path_connected_space_quotient_map_image:
   assumes f: "quotient_map X Y f" and X: "locally_path_connected_space X"
   shows "locally_path_connected_space Y"
   unfolding locally_path_connected_space_open_path_components
 proof clarify
   fix V C
   assume V: "openin Y V" and c: "C \<in> path_components_of (subtopology Y V)"
   then have sub: "C \<subseteq> topspace Y"
     using path_connectedin_path_components_of path_connectedin_subset_topspace path_connectedin_subtopology by blast
   have "openin X {x \<in> topspace X. f x \<in> C}"
   proof (subst openin_subopen, clarify)
     fix x
     assume x: "x \<in> topspace X" and "f x \<in> C"
     let ?T = "Collect (path_component_of (subtopology X {z \<in> topspace X. f z \<in> V}) x)"
     show "\<exists>T. openin X T \<and> x \<in> T \<and> T \<subseteq> {x \<in> topspace X. f x \<in> C}"
     proof (intro exI conjI)
       have "\<exists>U. openin X U \<and> ?T \<in> path_components_of (subtopology X U)"
       proof (intro exI conjI)
         show "openin X ({z \<in> topspace X. f z \<in> V})"
           using V f openin_subset quotient_map_def by fastforce
         show "Collect (path_component_of (subtopology X {z \<in> topspace X. f z \<in> V}) x)
         \<in> path_components_of (subtopology X {z \<in> topspace X. f z \<in> V})"
           by (metis (no_types, lifting) Int_iff \<open>f x \<in> C\<close> c mem_Collect_eq path_component_in_path_components_of path_components_of_subset topspace_subtopology topspace_subtopology_subset x)
       qed
       with X show "openin X ?T"
         using locally_path_connected_space_open_path_components by blast
       show x: "x \<in> ?T"
         using V \<open>f x \<in> C\<close> c openin_subset path_component_of_equiv path_components_of_subset topspace_subtopology topspace_subtopology_subset x
         by fastforce
       have "f ` ?T \<subseteq> C"
       proof (rule path_components_of_maximal)
         show "C \<in> path_components_of (subtopology Y V)"
           by (simp add: c)
         show "path_connectedin (subtopology Y V) (f ` ?T)"
         proof -
           have "quotient_map (subtopology X {a \<in> topspace X. f a \<in> V}) (subtopology Y V) f"
             by (simp add: V f quotient_map_restriction)
           then show ?thesis
             by (meson path_connectedin_continuous_map_image path_connectedin_path_component_of quotient_imp_continuous_map)
         qed
         show "\<not> disjnt C (f ` ?T)"
           by (metis (no_types, lifting) \<open>f x \<in> C\<close> x disjnt_iff image_eqI)
       qed
       then show "?T \<subseteq> {x \<in> topspace X. f x \<in> C}"
-        by (force simp: path_component_of_equiv topspace_subtopology)
+        by (force simp: path_component_of_equiv)
     qed
   qed
   then show "openin Y C"
     using f sub by (simp add: quotient_map_def)
 qed
 
 lemma homeomorphic_locally_path_connected_space:
   assumes "X homeomorphic_space Y"
   shows "locally_path_connected_space X \<longleftrightarrow> locally_path_connected_space Y"
 proof -
   obtain f g where "homeomorphic_maps X Y f g"
     using assms homeomorphic_space_def by fastforce
   then show ?thesis
     by (metis (no_types) homeomorphic_map_def homeomorphic_maps_map locally_path_connected_space_quotient_map_image)
 qed
 
 lemma locally_path_connected_space_retraction_map_image:
    "\<lbrakk>retraction_map X Y r; locally_path_connected_space X\<rbrakk>
         \<Longrightarrow> locally_path_connected_space Y"
   using Abstract_Topology.retraction_imp_quotient_map locally_path_connected_space_quotient_map_image by blast
 
 lemma locally_path_connected_space_euclideanreal: "locally_path_connected_space euclideanreal"
   unfolding locally_path_connected_space_def neighbourhood_base_of
   proof clarsimp
   fix W and x :: "real"
   assume "open W" "x \<in> W"
   then obtain e where "e > 0" and e: "\<And>x'. \<bar>x' - x\<bar> < e \<longrightarrow> x' \<in> W"
     by (auto simp: open_real)
   then show "\<exists>U. open U \<and> (\<exists>V. path_connected V \<and> x \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> W)"
     by (force intro!: convex_imp_path_connected exI [where x = "{x-e<..<x+e}"])
 qed
 
 lemma locally_path_connected_space_discrete_topology:
    "locally_path_connected_space (discrete_topology U)"
   using locally_path_connected_space_open_path_components by fastforce
 
 lemma path_component_eq_connected_component_of:
   assumes "locally_path_connected_space X"
   shows "(path_component_of_set X x = connected_component_of_set X x)"
 proof (cases "x \<in> topspace X")
   case True
   then show ?thesis
     using connectedin_connected_component_of [of X x]
     apply (clarsimp simp add: connectedin_def connected_space_clopen_in topspace_subtopology_subset cong: conj_cong)
     apply (drule_tac x="path_component_of_set X x" in spec)
     by (metis assms closedin_closed_subtopology closedin_connected_component_of closedin_path_component_of_locally_path_connected_space inf.absorb_iff2 inf.orderE openin_path_component_of_locally_path_connected_space openin_subtopology path_component_of_eq_empty path_component_subset_connected_component_of)
 next
   case False
   then show ?thesis
     using connected_component_of_eq_empty path_component_of_eq_empty by fastforce
 qed
 
 lemma path_components_eq_connected_components_of:
    "locally_path_connected_space X \<Longrightarrow> (path_components_of X = connected_components_of X)"
   by (simp add: path_components_of_def connected_components_of_def image_def path_component_eq_connected_component_of)
 
 lemma path_connected_eq_connected_space:
    "locally_path_connected_space X
          \<Longrightarrow> path_connected_space X \<longleftrightarrow> connected_space X"
   by (metis connected_components_of_subset_sing path_components_eq_connected_components_of path_components_of_subset_singleton)
 
 lemma locally_path_connected_space_product_topology:
    "locally_path_connected_space(product_topology X I) \<longleftrightarrow>
         topspace(product_topology X I) = {} \<or>
         finite {i. i \<in> I \<and> ~path_connected_space(X i)} \<and>
         (\<forall>i \<in> I. locally_path_connected_space(X i))"
     (is "?lhs \<longleftrightarrow> ?empty \<or> ?rhs")
 proof (cases ?empty)
   case True
   then show ?thesis
     by (simp add: locally_path_connected_space_def neighbourhood_base_of openin_closedin_eq)
 next
   case False
   then obtain z where z: "z \<in> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
     by auto
   have ?rhs if L: ?lhs
   proof -
     obtain U C where U: "openin (product_topology X I) U"
       and V: "path_connectedin (product_topology X I) C"
       and "z \<in> U" "U \<subseteq> C" and Csub: "C \<subseteq> (\<Pi>\<^sub>E i\<in>I. topspace (X i))"
       using L apply (clarsimp simp add: locally_path_connected_space_def neighbourhood_base_of)
       by (metis openin_topspace topspace_product_topology z)
     then obtain V where finV: "finite {i \<in> I. V i \<noteq> topspace (X i)}"
       and XV: "\<And>i. i\<in>I \<Longrightarrow> openin (X i) (V i)" and "z \<in> Pi\<^sub>E I V" and subU: "Pi\<^sub>E I V \<subseteq> U"
       by (force simp: openin_product_topology_alt)
     show ?thesis
     proof (intro conjI ballI)
       have "path_connected_space (X i)" if "i \<in> I" "V i = topspace (X i)" for i
       proof -
         have pc: "path_connectedin (X i) ((\<lambda>x. x i) ` C)"
           apply (rule path_connectedin_continuous_map_image [OF _ V])
           by (simp add: continuous_map_product_projection \<open>i \<in> I\<close>)
         moreover have "((\<lambda>x. x i) ` C) = topspace (X i)"
         proof
           show "(\<lambda>x. x i) ` C \<subseteq> topspace (X i)"
             by (simp add: pc path_connectedin_subset_topspace)
           have "V i \<subseteq> (\<lambda>x. x i) ` (\<Pi>\<^sub>E i\<in>I. V i)"
             by (metis \<open>z \<in> Pi\<^sub>E I V\<close> empty_iff image_projection_PiE order_refl that(1))
           also have "\<dots> \<subseteq> (\<lambda>x. x i) ` U"
             using subU by blast
           finally show "topspace (X i) \<subseteq> (\<lambda>x. x i) ` C"
             using \<open>U \<subseteq> C\<close> that by blast
         qed
         ultimately show ?thesis
           by (simp add: path_connectedin_topspace)
       qed
       then have "{i \<in> I. \<not> path_connected_space (X i)} \<subseteq> {i \<in> I. V i \<noteq> topspace (X i)}"
         by blast
       with finV show "finite {i \<in> I. \<not> path_connected_space (X i)}"
         using finite_subset by blast
     next
       show "locally_path_connected_space (X i)" if "i \<in> I" for i
         apply (rule locally_path_connected_space_quotient_map_image [OF _ L, where f = "\<lambda>x. x i"])
         by (metis False Abstract_Topology.retraction_imp_quotient_map retraction_map_product_projection that)
     qed
   qed
   moreover have ?lhs if R: ?rhs
   proof (clarsimp simp add: locally_path_connected_space_def neighbourhood_base_of)
     fix F z
     assume "openin (product_topology X I) F" and "z \<in> F"
     then obtain W where finW: "finite {i \<in> I. W i \<noteq> topspace (X i)}"
             and opeW: "\<And>i. i \<in> I \<Longrightarrow> openin (X i) (W i)" and "z \<in> Pi\<^sub>E I W" "Pi\<^sub>E I W \<subseteq> F"
       by (auto simp: openin_product_topology_alt)
     have "\<forall>i \<in> I. \<exists>U C. openin (X i) U \<and> path_connectedin (X i) C \<and> z i \<in> U \<and> U \<subseteq> C \<and> C \<subseteq> W i \<and>
                         (W i = topspace (X i) \<and>
                          path_connected_space (X i) \<longrightarrow> U = topspace (X i) \<and> C = topspace (X i))"
           (is "\<forall>i \<in> I. ?\<Phi> i")
     proof
       fix i assume "i \<in> I"
       have "locally_path_connected_space (X i)"
         by (simp add: R \<open>i \<in> I\<close>)
       moreover have "openin (X i) (W i) " "z i \<in> W i"
         using \<open>z \<in> Pi\<^sub>E I W\<close> opeW \<open>i \<in> I\<close> by auto
       ultimately obtain U C where UC: "openin (X i) U" "path_connectedin (X i) C" "z i \<in> U" "U \<subseteq> C" "C \<subseteq> W i"
         using \<open>i \<in> I\<close> by (force simp: locally_path_connected_space_def neighbourhood_base_of)
       show "?\<Phi> i"
       proof (cases "W i = topspace (X i) \<and> path_connected_space(X i)")
         case True
         then show ?thesis
           using \<open>z i \<in> W i\<close> path_connectedin_topspace by blast
       next
         case False
         then show ?thesis
           by (meson UC)
       qed
     qed
     then obtain U C where
       *: "\<And>i. i \<in> I \<Longrightarrow> openin (X i) (U i) \<and> path_connectedin (X i) (C i) \<and> z i \<in> (U i) \<and> (U i) \<subseteq> (C i) \<and> (C i) \<subseteq> W i \<and>
                         (W i = topspace (X i) \<and> path_connected_space (X i)
                          \<longrightarrow> (U i) = topspace (X i) \<and> (C i) = topspace (X i))"
       by metis
     let ?A = "{i \<in> I. \<not> path_connected_space (X i)} \<union> {i \<in> I. W i \<noteq> topspace (X i)}"
     have "{i \<in> I. U i \<noteq> topspace (X i)} \<subseteq> ?A"
       by (clarsimp simp add: "*")
     moreover have "finite ?A"
       by (simp add: that finW)
     ultimately have "finite {i \<in> I. U i \<noteq> topspace (X i)}"
       using finite_subset by auto
     then have "openin (product_topology X I) (Pi\<^sub>E I U)"
       using * by (simp add: openin_PiE_gen)
     then show "\<exists>U. openin (product_topology X I) U \<and>
             (\<exists>V. path_connectedin (product_topology X I) V \<and> z \<in> U \<and> U \<subseteq> V \<and> V \<subseteq> F)"
       apply (rule_tac x="PiE I U" in exI, simp)
       apply (rule_tac x="PiE I C" in exI)
       using \<open>z \<in> Pi\<^sub>E I W\<close> \<open>Pi\<^sub>E I W \<subseteq> F\<close> *
       apply (simp add: path_connectedin_PiE subset_PiE PiE_iff PiE_mono dual_order.trans)
       done
   qed
   ultimately show ?thesis
     using False by blast
 qed
 
 end
diff --git a/src/HOL/Analysis/Path_Connected.thy b/src/HOL/Analysis/Path_Connected.thy
--- a/src/HOL/Analysis/Path_Connected.thy
+++ b/src/HOL/Analysis/Path_Connected.thy
@@ -1,4006 +1,4006 @@
 (*  Title:      HOL/Analysis/Path_Connected.thy
     Authors:    LC Paulson and Robert Himmelmann (TU Muenchen), based on material from HOL Light
 *)
 
 section \<open>Path-Connectedness\<close>
 
 theory Path_Connected
   imports Starlike T1_Spaces
 begin
 
 subsection \<open>Paths and Arcs\<close>
 
 definition\<^marker>\<open>tag important\<close> path :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "path g \<longleftrightarrow> continuous_on {0..1} g"
 
 definition\<^marker>\<open>tag important\<close> pathstart :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathstart g = g 0"
 
 definition\<^marker>\<open>tag important\<close> pathfinish :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a"
   where "pathfinish g = g 1"
 
 definition\<^marker>\<open>tag important\<close> path_image :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> 'a set"
   where "path_image g = g ` {0 .. 1}"
 
 definition\<^marker>\<open>tag important\<close> reversepath :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> real \<Rightarrow> 'a"
   where "reversepath g = (\<lambda>x. g(1 - x))"
 
 definition\<^marker>\<open>tag important\<close> joinpaths :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> real \<Rightarrow> 'a"
     (infixr "+++" 75)
   where "g1 +++ g2 = (\<lambda>x. if x \<le> 1/2 then g1 (2 * x) else g2 (2 * x - 1))"
 
 definition\<^marker>\<open>tag important\<close> simple_path :: "(real \<Rightarrow> 'a::topological_space) \<Rightarrow> bool"
   where "simple_path g \<longleftrightarrow>
      path g \<and> (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0)"
 
 definition\<^marker>\<open>tag important\<close> arc :: "(real \<Rightarrow> 'a :: topological_space) \<Rightarrow> bool"
   where "arc g \<longleftrightarrow> path g \<and> inj_on g {0..1}"
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Invariance theorems\<close>
 
 lemma path_eq: "path p \<Longrightarrow> (\<And>t. t \<in> {0..1} \<Longrightarrow> p t = q t) \<Longrightarrow> path q"
   using continuous_on_eq path_def by blast
 
 lemma path_continuous_image: "path g \<Longrightarrow> continuous_on (path_image g) f \<Longrightarrow> path(f \<circ> g)"
   unfolding path_def path_image_def
   using continuous_on_compose by blast
 
 lemma path_translation_eq:
   fixes g :: "real \<Rightarrow> 'a :: real_normed_vector"
   shows "path((\<lambda>x. a + x) \<circ> g) = path g"
 proof -
   have g: "g = (\<lambda>x. -a + x) \<circ> ((\<lambda>x. a + x) \<circ> g)"
     by (rule ext) simp
   show ?thesis
     unfolding path_def
     apply safe
     apply (subst g)
     apply (rule continuous_on_compose)
     apply (auto intro: continuous_intros)
     done
 qed
 
 lemma path_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
    assumes "linear f" "inj f"
      shows "path(f \<circ> g) = path g"
 proof -
   from linear_injective_left_inverse [OF assms]
   obtain h where h: "linear h" "h \<circ> f = id"
     by blast
   then have g: "g = h \<circ> (f \<circ> g)"
     by (metis comp_assoc id_comp)
   show ?thesis
     unfolding path_def
     using h assms
     by (metis g continuous_on_compose linear_continuous_on linear_conv_bounded_linear)
 qed
 
 lemma pathstart_translation: "pathstart((\<lambda>x. a + x) \<circ> g) = a + pathstart g"
   by (simp add: pathstart_def)
 
 lemma pathstart_linear_image_eq: "linear f \<Longrightarrow> pathstart(f \<circ> g) = f(pathstart g)"
   by (simp add: pathstart_def)
 
 lemma pathfinish_translation: "pathfinish((\<lambda>x. a + x) \<circ> g) = a + pathfinish g"
   by (simp add: pathfinish_def)
 
 lemma pathfinish_linear_image: "linear f \<Longrightarrow> pathfinish(f \<circ> g) = f(pathfinish g)"
   by (simp add: pathfinish_def)
 
 lemma path_image_translation: "path_image((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) ` (path_image g)"
   by (simp add: image_comp path_image_def)
 
 lemma path_image_linear_image: "linear f \<Longrightarrow> path_image(f \<circ> g) = f ` (path_image g)"
   by (simp add: image_comp path_image_def)
 
 lemma reversepath_translation: "reversepath((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) \<circ> reversepath g"
   by (rule ext) (simp add: reversepath_def)
 
 lemma reversepath_linear_image: "linear f \<Longrightarrow> reversepath(f \<circ> g) = f \<circ> reversepath g"
   by (rule ext) (simp add: reversepath_def)
 
 lemma joinpaths_translation:
     "((\<lambda>x. a + x) \<circ> g1) +++ ((\<lambda>x. a + x) \<circ> g2) = (\<lambda>x. a + x) \<circ> (g1 +++ g2)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma joinpaths_linear_image: "linear f \<Longrightarrow> (f \<circ> g1) +++ (f \<circ> g2) = f \<circ> (g1 +++ g2)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma simple_path_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "simple_path((\<lambda>x. a + x) \<circ> g) = simple_path g"
   by (simp add: simple_path_def path_translation_eq)
 
 lemma simple_path_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "simple_path(f \<circ> g) = simple_path g"
   using assms inj_on_eq_iff [of f]
   by (auto simp: path_linear_image_eq simple_path_def path_translation_eq)
 
 lemma arc_translation_eq:
   fixes g :: "real \<Rightarrow> 'a::euclidean_space"
   shows "arc((\<lambda>x. a + x) \<circ> g) = arc g"
   by (auto simp: arc_def inj_on_def path_translation_eq)
 
 lemma arc_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
    assumes "linear f" "inj f"
      shows  "arc(f \<circ> g) = arc g"
   using assms inj_on_eq_iff [of f]
   by (auto simp: arc_def inj_on_def path_linear_image_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic lemmas about paths\<close>
 
 lemma pathin_iff_path_real [simp]: "pathin euclideanreal g \<longleftrightarrow> path g"
   by (simp add: pathin_def path_def)
 
 lemma continuous_on_path: "path f \<Longrightarrow> t \<subseteq> {0..1} \<Longrightarrow> continuous_on t f"
   using continuous_on_subset path_def by blast
 
 lemma arc_imp_simple_path: "arc g \<Longrightarrow> simple_path g"
   by (simp add: arc_def inj_on_def simple_path_def)
 
 lemma arc_imp_path: "arc g \<Longrightarrow> path g"
   using arc_def by blast
 
 lemma arc_imp_inj_on: "arc g \<Longrightarrow> inj_on g {0..1}"
   by (auto simp: arc_def)
 
 lemma simple_path_imp_path: "simple_path g \<Longrightarrow> path g"
   using simple_path_def by blast
 
 lemma simple_path_cases: "simple_path g \<Longrightarrow> arc g \<or> pathfinish g = pathstart g"
   unfolding simple_path_def arc_def inj_on_def pathfinish_def pathstart_def
   by force
 
 lemma simple_path_imp_arc: "simple_path g \<Longrightarrow> pathfinish g \<noteq> pathstart g \<Longrightarrow> arc g"
   using simple_path_cases by auto
 
 lemma arc_distinct_ends: "arc g \<Longrightarrow> pathfinish g \<noteq> pathstart g"
   unfolding arc_def inj_on_def pathfinish_def pathstart_def
   by fastforce
 
 lemma arc_simple_path: "arc g \<longleftrightarrow> simple_path g \<and> pathfinish g \<noteq> pathstart g"
   using arc_distinct_ends arc_imp_simple_path simple_path_cases by blast
 
 lemma simple_path_eq_arc: "pathfinish g \<noteq> pathstart g \<Longrightarrow> (simple_path g = arc g)"
   by (simp add: arc_simple_path)
 
 lemma path_image_const [simp]: "path_image (\<lambda>t. a) = {a}"
   by (force simp: path_image_def)
 
 lemma path_image_nonempty [simp]: "path_image g \<noteq> {}"
   unfolding path_image_def image_is_empty box_eq_empty
   by auto
 
 lemma pathstart_in_path_image[intro]: "pathstart g \<in> path_image g"
   unfolding pathstart_def path_image_def
   by auto
 
 lemma pathfinish_in_path_image[intro]: "pathfinish g \<in> path_image g"
   unfolding pathfinish_def path_image_def
   by auto
 
 lemma connected_path_image[intro]: "path g \<Longrightarrow> connected (path_image g)"
   unfolding path_def path_image_def
   using connected_continuous_image connected_Icc by blast
 
 lemma compact_path_image[intro]: "path g \<Longrightarrow> compact (path_image g)"
   unfolding path_def path_image_def
   using compact_continuous_image connected_Icc by blast
 
 lemma reversepath_reversepath[simp]: "reversepath (reversepath g) = g"
   unfolding reversepath_def
   by auto
 
 lemma pathstart_reversepath[simp]: "pathstart (reversepath g) = pathfinish g"
   unfolding pathstart_def reversepath_def pathfinish_def
   by auto
 
 lemma pathfinish_reversepath[simp]: "pathfinish (reversepath g) = pathstart g"
   unfolding pathstart_def reversepath_def pathfinish_def
   by auto
 
 lemma pathstart_join[simp]: "pathstart (g1 +++ g2) = pathstart g1"
   unfolding pathstart_def joinpaths_def pathfinish_def
   by auto
 
 lemma pathfinish_join[simp]: "pathfinish (g1 +++ g2) = pathfinish g2"
   unfolding pathstart_def joinpaths_def pathfinish_def
   by auto
 
 lemma path_image_reversepath[simp]: "path_image (reversepath g) = path_image g"
 proof -
   have *: "\<And>g. path_image (reversepath g) \<subseteq> path_image g"
     unfolding path_image_def subset_eq reversepath_def Ball_def image_iff
     by force
   show ?thesis
     using *[of g] *[of "reversepath g"]
     unfolding reversepath_reversepath
     by auto
 qed
 
 lemma path_reversepath [simp]: "path (reversepath g) \<longleftrightarrow> path g"
 proof -
   have *: "\<And>g. path g \<Longrightarrow> path (reversepath g)"
     unfolding path_def reversepath_def
     apply (rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
     apply (auto intro: continuous_intros continuous_on_subset[of "{0..1}"])
     done
   show ?thesis
     using *[of "reversepath g"] *[of g]
     unfolding reversepath_reversepath
     by (rule iffI)
 qed
 
 lemma arc_reversepath:
   assumes "arc g" shows "arc(reversepath g)"
 proof -
   have injg: "inj_on g {0..1}"
     using assms
     by (simp add: arc_def)
   have **: "\<And>x y::real. 1-x = 1-y \<Longrightarrow> x = y"
     by simp
   show ?thesis
     using assms  by (clarsimp simp: arc_def intro!: inj_onI) (simp add: inj_onD reversepath_def **)
 qed
 
 lemma simple_path_reversepath: "simple_path g \<Longrightarrow> simple_path (reversepath g)"
   apply (simp add: simple_path_def)
   apply (force simp: reversepath_def)
   done
 
 lemmas reversepath_simps =
   path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
 
 lemma path_join[simp]:
   assumes "pathfinish g1 = pathstart g2"
   shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
   unfolding path_def pathfinish_def pathstart_def
 proof safe
   assume cont: "continuous_on {0..1} (g1 +++ g2)"
   have g1: "continuous_on {0..1} g1 \<longleftrightarrow> continuous_on {0..1} ((g1 +++ g2) \<circ> (\<lambda>x. x / 2))"
     by (intro continuous_on_cong refl) (auto simp: joinpaths_def)
   have g2: "continuous_on {0..1} g2 \<longleftrightarrow> continuous_on {0..1} ((g1 +++ g2) \<circ> (\<lambda>x. x / 2 + 1/2))"
     using assms
     by (intro continuous_on_cong refl) (auto simp: joinpaths_def pathfinish_def pathstart_def)
   show "continuous_on {0..1} g1" and "continuous_on {0..1} g2"
     unfolding g1 g2
     by (auto intro!: continuous_intros continuous_on_subset[OF cont] simp del: o_apply)
 next
   assume g1g2: "continuous_on {0..1} g1" "continuous_on {0..1} g2"
   have 01: "{0 .. 1} = {0..1/2} \<union> {1/2 .. 1::real}"
     by auto
   {
     fix x :: real
     assume "0 \<le> x" and "x \<le> 1"
     then have "x \<in> (\<lambda>x. x * 2) ` {0..1 / 2}"
       by (intro image_eqI[where x="x/2"]) auto
   }
   note 1 = this
   {
     fix x :: real
     assume "0 \<le> x" and "x \<le> 1"
     then have "x \<in> (\<lambda>x. x * 2 - 1) ` {1 / 2..1}"
       by (intro image_eqI[where x="x/2 + 1/2"]) auto
   }
   note 2 = this
   show "continuous_on {0..1} (g1 +++ g2)"
     using assms
     unfolding joinpaths_def 01
     apply (intro continuous_on_cases closed_atLeastAtMost g1g2[THEN continuous_on_compose2] continuous_intros)
     apply (auto simp: field_simps pathfinish_def pathstart_def intro!: 1 2)
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Path Images\<close>
 
 lemma bounded_path_image: "path g \<Longrightarrow> bounded(path_image g)"
   by (simp add: compact_imp_bounded compact_path_image)
 
 lemma closed_path_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "path g \<Longrightarrow> closed(path_image g)"
   by (metis compact_path_image compact_imp_closed)
 
 lemma connected_simple_path_image: "simple_path g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image simple_path_imp_path)
 
 lemma compact_simple_path_image: "simple_path g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image simple_path_imp_path)
 
 lemma bounded_simple_path_image: "simple_path g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image simple_path_imp_path)
 
 lemma closed_simple_path_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "simple_path g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image simple_path_imp_path)
 
 lemma connected_arc_image: "arc g \<Longrightarrow> connected(path_image g)"
   by (metis connected_path_image arc_imp_path)
 
 lemma compact_arc_image: "arc g \<Longrightarrow> compact(path_image g)"
   by (metis compact_path_image arc_imp_path)
 
 lemma bounded_arc_image: "arc g \<Longrightarrow> bounded(path_image g)"
   by (metis bounded_path_image arc_imp_path)
 
 lemma closed_arc_image:
   fixes g :: "real \<Rightarrow> 'a::t2_space"
   shows "arc g \<Longrightarrow> closed(path_image g)"
   by (metis closed_path_image arc_imp_path)
 
 lemma path_image_join_subset: "path_image (g1 +++ g2) \<subseteq> path_image g1 \<union> path_image g2"
   unfolding path_image_def joinpaths_def
   by auto
 
 lemma subset_path_image_join:
   assumes "path_image g1 \<subseteq> s"
     and "path_image g2 \<subseteq> s"
   shows "path_image (g1 +++ g2) \<subseteq> s"
   using path_image_join_subset[of g1 g2] and assms
   by auto
 
 lemma path_image_join:
     "pathfinish g1 = pathstart g2 \<Longrightarrow> path_image(g1 +++ g2) = path_image g1 \<union> path_image g2"
   apply (rule subset_antisym [OF path_image_join_subset])
   apply (auto simp: pathfinish_def pathstart_def path_image_def joinpaths_def image_def)
   apply (drule sym)
   apply (rule_tac x="xa/2" in bexI, auto)
   apply (rule ccontr)
   apply (drule_tac x="(xa+1)/2" in bspec)
   apply (auto simp: field_simps)
   apply (drule_tac x="1/2" in bspec, auto)
   done
 
 lemma not_in_path_image_join:
   assumes "x \<notin> path_image g1"
     and "x \<notin> path_image g2"
   shows "x \<notin> path_image (g1 +++ g2)"
   using assms and path_image_join_subset[of g1 g2]
   by auto
 
 lemma pathstart_compose: "pathstart(f \<circ> p) = f(pathstart p)"
   by (simp add: pathstart_def)
 
 lemma pathfinish_compose: "pathfinish(f \<circ> p) = f(pathfinish p)"
   by (simp add: pathfinish_def)
 
 lemma path_image_compose: "path_image (f \<circ> p) = f ` (path_image p)"
   by (simp add: image_comp path_image_def)
 
 lemma path_compose_join: "f \<circ> (p +++ q) = (f \<circ> p) +++ (f \<circ> q)"
   by (rule ext) (simp add: joinpaths_def)
 
 lemma path_compose_reversepath: "f \<circ> reversepath p = reversepath(f \<circ> p)"
   by (rule ext) (simp add: reversepath_def)
 
 lemma joinpaths_eq:
   "(\<And>t. t \<in> {0..1} \<Longrightarrow> p t = p' t) \<Longrightarrow>
    (\<And>t. t \<in> {0..1} \<Longrightarrow> q t = q' t)
    \<Longrightarrow>  t \<in> {0..1} \<Longrightarrow> (p +++ q) t = (p' +++ q') t"
   by (auto simp: joinpaths_def)
 
 lemma simple_path_inj_on: "simple_path g \<Longrightarrow> inj_on g {0<..<1}"
   by (auto simp: simple_path_def path_image_def inj_on_def less_eq_real_def Ball_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Simple paths with the endpoints removed\<close>
 
 lemma simple_path_endless:
     "simple_path c \<Longrightarrow> path_image c - {pathstart c,pathfinish c} = c ` {0<..<1}"
   apply (auto simp: simple_path_def path_image_def pathstart_def pathfinish_def Ball_def Bex_def image_def)
   apply (metis eq_iff le_less_linear)
   apply (metis leD linear)
   using less_eq_real_def zero_le_one apply blast
   using less_eq_real_def zero_le_one apply blast
   done
 
 lemma connected_simple_path_endless:
     "simple_path c \<Longrightarrow> connected(path_image c - {pathstart c,pathfinish c})"
 apply (simp add: simple_path_endless)
 apply (rule connected_continuous_image)
 apply (meson continuous_on_subset greaterThanLessThan_subseteq_atLeastAtMost_iff le_numeral_extra(3) le_numeral_extra(4) path_def simple_path_imp_path)
 by auto
 
 lemma nonempty_simple_path_endless:
     "simple_path c \<Longrightarrow> path_image c - {pathstart c,pathfinish c} \<noteq> {}"
   by (simp add: simple_path_endless)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The operations on paths\<close>
 
 lemma path_image_subset_reversepath: "path_image(reversepath g) \<le> path_image g"
   by (auto simp: path_image_def reversepath_def)
 
 lemma path_imp_reversepath: "path g \<Longrightarrow> path(reversepath g)"
   apply (auto simp: path_def reversepath_def)
   using continuous_on_compose [of "{0..1}" "\<lambda>x. 1 - x" g]
   apply (auto simp: continuous_on_op_minus)
   done
 
 lemma half_bounded_equal: "1 \<le> x * 2 \<Longrightarrow> x * 2 \<le> 1 \<longleftrightarrow> x = (1/2::real)"
   by simp
 
 lemma continuous_on_joinpaths:
   assumes "continuous_on {0..1} g1" "continuous_on {0..1} g2" "pathfinish g1 = pathstart g2"
     shows "continuous_on {0..1} (g1 +++ g2)"
 proof -
   have *: "{0..1::real} = {0..1/2} \<union> {1/2..1}"
     by auto
   have gg: "g2 0 = g1 1"
     by (metis assms(3) pathfinish_def pathstart_def)
   have 1: "continuous_on {0..1/2} (g1 +++ g2)"
     apply (rule continuous_on_eq [of _ "g1 \<circ> (\<lambda>x. 2*x)"])
     apply (rule continuous_intros | simp add: joinpaths_def assms)+
     done
   have "continuous_on {1/2..1} (g2 \<circ> (\<lambda>x. 2*x-1))"
     apply (rule continuous_on_subset [of "{1/2..1}"])
     apply (rule continuous_intros | simp add: image_affinity_atLeastAtMost_diff assms)+
     done
   then have 2: "continuous_on {1/2..1} (g1 +++ g2)"
     apply (rule continuous_on_eq [of "{1/2..1}" "g2 \<circ> (\<lambda>x. 2*x-1)"])
     apply (rule assms continuous_intros | simp add: joinpaths_def mult.commute half_bounded_equal gg)+
     done
   show ?thesis
     apply (subst *)
     apply (rule continuous_on_closed_Un)
     using 1 2
     apply auto
     done
 qed
 
 lemma path_join_imp: "\<lbrakk>path g1; path g2; pathfinish g1 = pathstart g2\<rbrakk> \<Longrightarrow> path(g1 +++ g2)"
-  by (simp add: path_join)
+  by (simp)
 
 lemma simple_path_join_loop:
   assumes "arc g1" "arc g2"
           "pathfinish g1 = pathstart g2"  "pathfinish g2 = pathstart g1"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
   shows "simple_path(g1 +++ g2)"
 proof -
   have injg1: "inj_on g1 {0..1}"
     using assms
     by (simp add: arc_def)
   have injg2: "inj_on g2 {0..1}"
     using assms
     by (simp add: arc_def)
   have g12: "g1 1 = g2 0"
    and g21: "g2 1 = g1 0"
    and sb:  "g1 ` {0..1} \<inter> g2 ` {0..1} \<subseteq> {g1 0, g2 0}"
     using assms
     by (simp_all add: arc_def pathfinish_def pathstart_def path_image_def)
   { fix x and y::real
     assume xyI: "x = 1 \<longrightarrow> y \<noteq> 0"
        and xy: "x \<le> 1" "0 \<le> y" " y * 2 \<le> 1" "\<not> x * 2 \<le> 1" "g2 (2 * x - 1) = g1 (2 * y)"
     have g1im: "g1 (2 * y) \<in> g1 ` {0..1} \<inter> g2 ` {0..1}"
       using xy
       apply simp
       apply (rule_tac x="2 * x - 1" in image_eqI, auto)
       done
     have False
       using subsetD [OF sb g1im] xy
       apply auto
       apply (drule inj_onD [OF injg1])
       using g21 [symmetric] xyI
       apply (auto dest: inj_onD [OF injg2])
       done
    } note * = this
   { fix x and y::real
     assume xy: "y \<le> 1" "0 \<le> x" "\<not> y * 2 \<le> 1" "x * 2 \<le> 1" "g1 (2 * x) = g2 (2 * y - 1)"
     have g1im: "g1 (2 * x) \<in> g1 ` {0..1} \<inter> g2 ` {0..1}"
       using xy
       apply simp
       apply (rule_tac x="2 * x" in image_eqI, auto)
       done
     have "x = 0 \<and> y = 1"
       using subsetD [OF sb g1im] xy
       apply auto
       apply (force dest: inj_onD [OF injg1])
       using  g21 [symmetric]
       apply (auto dest: inj_onD [OF injg2])
       done
    } note ** = this
   show ?thesis
     using assms
     apply (simp add: arc_def simple_path_def path_join, clarify)
     apply (simp add: joinpaths_def split: if_split_asm)
     apply (force dest: inj_onD [OF injg1])
     apply (metis *)
     apply (metis **)
     apply (force dest: inj_onD [OF injg2])
     done
 qed
 
 lemma arc_join:
   assumes "arc g1" "arc g2"
           "pathfinish g1 = pathstart g2"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g2}"
     shows "arc(g1 +++ g2)"
 proof -
   have injg1: "inj_on g1 {0..1}"
     using assms
     by (simp add: arc_def)
   have injg2: "inj_on g2 {0..1}"
     using assms
     by (simp add: arc_def)
   have g11: "g1 1 = g2 0"
    and sb:  "g1 ` {0..1} \<inter> g2 ` {0..1} \<subseteq> {g2 0}"
     using assms
     by (simp_all add: arc_def pathfinish_def pathstart_def path_image_def)
   { fix x and y::real
     assume xy: "x \<le> 1" "0 \<le> y" " y * 2 \<le> 1" "\<not> x * 2 \<le> 1" "g2 (2 * x - 1) = g1 (2 * y)"
     have g1im: "g1 (2 * y) \<in> g1 ` {0..1} \<inter> g2 ` {0..1}"
       using xy
       apply simp
       apply (rule_tac x="2 * x - 1" in image_eqI, auto)
       done
     have False
       using subsetD [OF sb g1im] xy
       by (auto dest: inj_onD [OF injg2])
    } note * = this
   show ?thesis
     apply (simp add: arc_def inj_on_def)
-    apply (clarsimp simp add: arc_imp_path assms path_join)
+    apply (clarsimp simp add: arc_imp_path assms)
     apply (simp add: joinpaths_def split: if_split_asm)
     apply (force dest: inj_onD [OF injg1])
     apply (metis *)
     apply (metis *)
     apply (force dest: inj_onD [OF injg2])
     done
 qed
 
 lemma reversepath_joinpaths:
     "pathfinish g1 = pathstart g2 \<Longrightarrow> reversepath(g1 +++ g2) = reversepath g2 +++ reversepath g1"
   unfolding reversepath_def pathfinish_def pathstart_def joinpaths_def
   by (rule ext) (auto simp: mult.commute)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some reversed and "if and only if" versions of joining theorems\<close>
 
 lemma path_join_path_ends:
   fixes g1 :: "real \<Rightarrow> 'a::metric_space"
   assumes "path(g1 +++ g2)" "path g2"
     shows "pathfinish g1 = pathstart g2"
 proof (rule ccontr)
   define e where "e = dist (g1 1) (g2 0)"
   assume Neg: "pathfinish g1 \<noteq> pathstart g2"
   then have "0 < dist (pathfinish g1) (pathstart g2)"
     by auto
   then have "e > 0"
     by (metis e_def pathfinish_def pathstart_def)
   then obtain d1 where "d1 > 0"
        and d1: "\<And>x'. \<lbrakk>x'\<in>{0..1}; norm x' < d1\<rbrakk> \<Longrightarrow> dist (g2 x') (g2 0) < e/2"
     using assms(2) unfolding path_def continuous_on_iff
     apply (drule_tac x=0 in bspec, simp)
     by (metis half_gt_zero_iff norm_conv_dist)
   obtain d2 where "d2 > 0"
        and d2: "\<And>x'. \<lbrakk>x'\<in>{0..1}; dist x' (1/2) < d2\<rbrakk>
                       \<Longrightarrow> dist ((g1 +++ g2) x') (g1 1) < e/2"
     using assms(1) \<open>e > 0\<close> unfolding path_def continuous_on_iff
     apply (drule_tac x="1/2" in bspec, simp)
     apply (drule_tac x="e/2" in spec)
     apply (force simp: joinpaths_def)
     done
   have int01_1: "min (1/2) (min d1 d2) / 2 \<in> {0..1}"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have dist1: "norm (min (1 / 2) (min d1 d2) / 2) < d1"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def dist_norm)
   have int01_2: "1/2 + min (1/2) (min d1 d2) / 4 \<in> {0..1}"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have dist2: "dist (1 / 2 + min (1 / 2) (min d1 d2) / 4) (1 / 2) < d2"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def dist_norm)
   have [simp]: "\<not> min (1 / 2) (min d1 d2) \<le> 0"
     using \<open>d1 > 0\<close> \<open>d2 > 0\<close> by (simp add: min_def)
   have "dist (g2 (min (1 / 2) (min d1 d2) / 2)) (g1 1) < e/2"
        "dist (g2 (min (1 / 2) (min d1 d2) / 2)) (g2 0) < e/2"
     using d1 [OF int01_1 dist1] d2 [OF int01_2 dist2] by (simp_all add: joinpaths_def)
   then have "dist (g1 1) (g2 0) < e/2 + e/2"
     using dist_triangle_half_r e_def by blast
   then show False
     by (simp add: e_def [symmetric])
 qed
 
 lemma path_join_eq [simp]:
   fixes g1 :: "real \<Rightarrow> 'a::metric_space"
   assumes "path g1" "path g2"
     shows "path(g1 +++ g2) \<longleftrightarrow> pathfinish g1 = pathstart g2"
   using assms by (metis path_join_path_ends path_join_imp)
 
 lemma simple_path_joinE:
   assumes "simple_path(g1 +++ g2)" and "pathfinish g1 = pathstart g2"
   obtains "arc g1" "arc g2"
           "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
 proof -
   have *: "\<And>x y. \<lbrakk>0 \<le> x; x \<le> 1; 0 \<le> y; y \<le> 1; (g1 +++ g2) x = (g1 +++ g2) y\<rbrakk>
                \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     using assms by (simp add: simple_path_def)
   have "path g1"
     using assms path_join simple_path_imp_path by blast
   moreover have "inj_on g1 {0..1}"
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "g1 x = g1 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
     then show "x = y"
       using * [of "x/2" "y/2"] by (simp add: joinpaths_def split_ifs)
   qed
   ultimately have "arc g1"
     using assms  by (simp add: arc_def)
   have [simp]: "g2 0 = g1 1"
     using assms by (metis pathfinish_def pathstart_def)
   have "path g2"
     using assms path_join simple_path_imp_path by blast
   moreover have "inj_on g2 {0..1}"
   proof (clarsimp simp: inj_on_def)
     fix x y
     assume "g2 x = g2 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
     then show "x = y"
       using * [of "(x + 1) / 2" "(y + 1) / 2"]
       by (force simp: joinpaths_def split_ifs field_split_simps)
   qed
   ultimately have "arc g2"
     using assms  by (simp add: arc_def)
   have "g2 y = g1 0 \<or> g2 y = g1 1"
        if "g1 x = g2 y" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1" for x y
       using * [of "x / 2" "(y + 1) / 2"] that
       by (auto simp: joinpaths_def split_ifs field_split_simps)
   then have "path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
     by (fastforce simp: pathstart_def pathfinish_def path_image_def)
   with \<open>arc g1\<close> \<open>arc g2\<close> show ?thesis using that by blast
 qed
 
 lemma simple_path_join_loop_eq:
   assumes "pathfinish g2 = pathstart g1" "pathfinish g1 = pathstart g2"
     shows "simple_path(g1 +++ g2) \<longleftrightarrow>
              arc g1 \<and> arc g2 \<and> path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g1, pathstart g2}"
 by (metis assms simple_path_joinE simple_path_join_loop)
 
 lemma arc_join_eq:
   assumes "pathfinish g1 = pathstart g2"
     shows "arc(g1 +++ g2) \<longleftrightarrow>
            arc g1 \<and> arc g2 \<and> path_image g1 \<inter> path_image g2 \<subseteq> {pathstart g2}"
            (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "simple_path(g1 +++ g2)" by (rule arc_imp_simple_path)
   then have *: "\<And>x y. \<lbrakk>0 \<le> x; x \<le> 1; 0 \<le> y; y \<le> 1; (g1 +++ g2) x = (g1 +++ g2) y\<rbrakk>
                \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     using assms by (simp add: simple_path_def)
   have False if "g1 0 = g2 u" "0 \<le> u" "u \<le> 1" for u
     using * [of 0 "(u + 1) / 2"] that assms arc_distinct_ends [OF \<open>?lhs\<close>]
     by (auto simp: joinpaths_def pathstart_def pathfinish_def split_ifs field_split_simps)
   then have n1: "pathstart g1 \<notin> path_image g2"
     unfolding pathstart_def path_image_def
     using atLeastAtMost_iff by blast
   show ?rhs using \<open>?lhs\<close>
     apply (rule simple_path_joinE [OF arc_imp_simple_path assms])
     using n1 by force
 next
   assume ?rhs then show ?lhs
     using assms
     by (fastforce simp: pathfinish_def pathstart_def intro!: arc_join)
 qed
 
 lemma arc_join_eq_alt:
         "pathfinish g1 = pathstart g2
         \<Longrightarrow> (arc(g1 +++ g2) \<longleftrightarrow>
              arc g1 \<and> arc g2 \<and>
              path_image g1 \<inter> path_image g2 = {pathstart g2})"
 using pathfinish_in_path_image by (fastforce simp: arc_join_eq)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The joining of paths is associative\<close>
 
 lemma path_assoc:
     "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart r\<rbrakk>
      \<Longrightarrow> path(p +++ (q +++ r)) \<longleftrightarrow> path((p +++ q) +++ r)"
 by simp
 
 lemma simple_path_assoc:
   assumes "pathfinish p = pathstart q" "pathfinish q = pathstart r"
     shows "simple_path (p +++ (q +++ r)) \<longleftrightarrow> simple_path ((p +++ q) +++ r)"
 proof (cases "pathstart p = pathfinish r")
   case True show ?thesis
   proof
     assume "simple_path (p +++ q +++ r)"
     with assms True show "simple_path ((p +++ q) +++ r)"
       by (fastforce simp add: simple_path_join_loop_eq arc_join_eq path_image_join
                     dest: arc_distinct_ends [of r])
   next
     assume 0: "simple_path ((p +++ q) +++ r)"
     with assms True have q: "pathfinish r \<notin> path_image q"
       using arc_distinct_ends
       by (fastforce simp add: simple_path_join_loop_eq arc_join_eq path_image_join)
     have "pathstart r \<notin> path_image p"
       using assms
       by (metis 0 IntI arc_distinct_ends arc_join_eq_alt empty_iff insert_iff
               pathfinish_in_path_image pathfinish_join simple_path_joinE)
     with assms 0 q True show "simple_path (p +++ q +++ r)"
       by (auto simp: simple_path_join_loop_eq arc_join_eq path_image_join
                dest!: subsetD [OF _ IntI])
   qed
 next
   case False
   { fix x :: 'a
     assume a: "path_image p \<inter> path_image q \<subseteq> {pathstart q}"
               "(path_image p \<union> path_image q) \<inter> path_image r \<subseteq> {pathstart r}"
               "x \<in> path_image p" "x \<in> path_image r"
     have "pathstart r \<in> path_image q"
       by (metis assms(2) pathfinish_in_path_image)
     with a have "x = pathstart q"
       by blast
   }
   with False assms show ?thesis
     by (auto simp: simple_path_eq_arc simple_path_join_loop_eq arc_join_eq path_image_join)
 qed
 
 lemma arc_assoc:
      "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart r\<rbrakk>
       \<Longrightarrow> arc(p +++ (q +++ r)) \<longleftrightarrow> arc((p +++ q) +++ r)"
 by (simp add: arc_simple_path simple_path_assoc)
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Symmetry and loops\<close>
 
 lemma path_sym:
     "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk> \<Longrightarrow> path(p +++ q) \<longleftrightarrow> path(q +++ p)"
   by auto
 
 lemma simple_path_sym:
     "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
      \<Longrightarrow> simple_path(p +++ q) \<longleftrightarrow> simple_path(q +++ p)"
 by (metis (full_types) inf_commute insert_commute simple_path_joinE simple_path_join_loop)
 
 lemma path_image_sym:
     "\<lbrakk>pathfinish p = pathstart q; pathfinish q = pathstart p\<rbrakk>
      \<Longrightarrow> path_image(p +++ q) = path_image(q +++ p)"
 by (simp add: path_image_join sup_commute)
 
 
 subsection\<open>Subpath\<close>
 
 definition\<^marker>\<open>tag important\<close> subpath :: "real \<Rightarrow> real \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> real \<Rightarrow> 'a::real_normed_vector"
   where "subpath a b g \<equiv> \<lambda>x. g((b - a) * x + a)"
 
 lemma path_image_subpath_gen:
   fixes g :: "_ \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = g ` (closed_segment u v)"
   by (auto simp add: closed_segment_real_eq path_image_def subpath_def)
 
 lemma path_image_subpath:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = (if u \<le> v then g ` {u..v} else g ` {v..u})"
   by (simp add: path_image_subpath_gen closed_segment_eq_real_ivl)
 
 lemma path_image_subpath_commute:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "path_image(subpath u v g) = path_image(subpath v u g)"
   by (simp add: path_image_subpath_gen closed_segment_eq_real_ivl)
 
 lemma path_subpath [simp]:
   fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "path g" "u \<in> {0..1}" "v \<in> {0..1}"
     shows "path(subpath u v g)"
 proof -
   have "continuous_on {0..1} (g \<circ> (\<lambda>x. ((v-u) * x+ u)))"
     apply (rule continuous_intros | simp)+
     apply (simp add: image_affinity_atLeastAtMost [where c=u])
     using assms
     apply (auto simp: path_def continuous_on_subset)
     done
   then show ?thesis
     by (simp add: path_def subpath_def)
 qed
 
 lemma pathstart_subpath [simp]: "pathstart(subpath u v g) = g(u)"
   by (simp add: pathstart_def subpath_def)
 
 lemma pathfinish_subpath [simp]: "pathfinish(subpath u v g) = g(v)"
   by (simp add: pathfinish_def subpath_def)
 
 lemma subpath_trivial [simp]: "subpath 0 1 g = g"
   by (simp add: subpath_def)
 
 lemma subpath_reversepath: "subpath 1 0 g = reversepath g"
   by (simp add: reversepath_def subpath_def)
 
 lemma reversepath_subpath: "reversepath(subpath u v g) = subpath v u g"
   by (simp add: reversepath_def subpath_def algebra_simps)
 
 lemma subpath_translation: "subpath u v ((\<lambda>x. a + x) \<circ> g) = (\<lambda>x. a + x) \<circ> subpath u v g"
   by (rule ext) (simp add: subpath_def)
 
 lemma subpath_image: "subpath u v (f \<circ> g) = f \<circ> subpath u v g"
   by (rule ext) (simp add: subpath_def)
 
 lemma affine_ineq:
   fixes x :: "'a::linordered_idom"
   assumes "x \<le> 1" "v \<le> u"
     shows "v + x * u \<le> u + x * v"
 proof -
   have "(1-x)*(u-v) \<ge> 0"
     using assms by auto
   then show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma sum_le_prod1:
   fixes a::real shows "\<lbrakk>a \<le> 1; b \<le> 1\<rbrakk> \<Longrightarrow> a + b \<le> 1 + a * b"
-by (metis add.commute affine_ineq less_eq_real_def mult.right_neutral)
+by (metis add.commute affine_ineq mult.right_neutral)
 
 lemma simple_path_subpath_eq:
   "simple_path(subpath u v g) \<longleftrightarrow>
      path(subpath u v g) \<and> u\<noteq>v \<and>
      (\<forall>x y. x \<in> closed_segment u v \<and> y \<in> closed_segment u v \<and> g x = g y
                 \<longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u)"
     (is "?lhs = ?rhs")
 proof (rule iffI)
   assume ?lhs
   then have p: "path (\<lambda>x. g ((v - u) * x + u))"
         and sim: "(\<And>x y. \<lbrakk>x\<in>{0..1}; y\<in>{0..1}; g ((v - u) * x + u) = g ((v - u) * y + u)\<rbrakk>
                   \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0)"
     by (auto simp: simple_path_def subpath_def)
   { fix x y
     assume "x \<in> closed_segment u v" "y \<in> closed_segment u v" "g x = g y"
     then have "x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
       using sim [of "(x-u)/(v-u)" "(y-u)/(v-u)"] p
       by (auto split: if_split_asm simp add: closed_segment_real_eq image_affinity_atLeastAtMost)
         (simp_all add: field_split_simps)
   } moreover
   have "path(subpath u v g) \<and> u\<noteq>v"
     using sim [of "1/3" "2/3"] p
     by (auto simp: subpath_def)
   ultimately show ?rhs
     by metis
 next
   assume ?rhs
   then
   have d1: "\<And>x y. \<lbrakk>g x = g y; u \<le> x; x \<le> v; u \<le> y; y \<le> v\<rbrakk> \<Longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
    and d2: "\<And>x y. \<lbrakk>g x = g y; v \<le> x; x \<le> u; v \<le> y; y \<le> u\<rbrakk> \<Longrightarrow> x = y \<or> x = u \<and> y = v \<or> x = v \<and> y = u"
    and ne: "u < v \<or> v < u"
    and psp: "path (subpath u v g)"
     by (auto simp: closed_segment_real_eq image_affinity_atLeastAtMost)
   have [simp]: "\<And>x. u + x * v = v + x * u \<longleftrightarrow> u=v \<or> x=1"
     by algebra
   show ?lhs using psp ne
     unfolding simple_path_def subpath_def
     by (fastforce simp add: algebra_simps affine_ineq mult_left_mono crossproduct_eq dest: d1 d2)
 qed
 
 lemma arc_subpath_eq:
   "arc(subpath u v g) \<longleftrightarrow> path(subpath u v g) \<and> u\<noteq>v \<and> inj_on g (closed_segment u v)"
     (is "?lhs = ?rhs")
 proof (rule iffI)
   assume ?lhs
   then have p: "path (\<lambda>x. g ((v - u) * x + u))"
         and sim: "(\<And>x y. \<lbrakk>x\<in>{0..1}; y\<in>{0..1}; g ((v - u) * x + u) = g ((v - u) * y + u)\<rbrakk>
                   \<Longrightarrow> x = y)"
     by (auto simp: arc_def inj_on_def subpath_def)
   { fix x y
     assume "x \<in> closed_segment u v" "y \<in> closed_segment u v" "g x = g y"
     then have "x = y"
       using sim [of "(x-u)/(v-u)" "(y-u)/(v-u)"] p
       by (cases "v = u")
         (simp_all split: if_split_asm add: inj_on_def closed_segment_real_eq image_affinity_atLeastAtMost,
            simp add: field_simps)
   } moreover
   have "path(subpath u v g) \<and> u\<noteq>v"
     using sim [of "1/3" "2/3"] p
     by (auto simp: subpath_def)
   ultimately show ?rhs
     unfolding inj_on_def
     by metis
 next
   assume ?rhs
   then
   have d1: "\<And>x y. \<lbrakk>g x = g y; u \<le> x; x \<le> v; u \<le> y; y \<le> v\<rbrakk> \<Longrightarrow> x = y"
    and d2: "\<And>x y. \<lbrakk>g x = g y; v \<le> x; x \<le> u; v \<le> y; y \<le> u\<rbrakk> \<Longrightarrow> x = y"
    and ne: "u < v \<or> v < u"
    and psp: "path (subpath u v g)"
     by (auto simp: inj_on_def closed_segment_real_eq image_affinity_atLeastAtMost)
   show ?lhs using psp ne
     unfolding arc_def subpath_def inj_on_def
     by (auto simp: algebra_simps affine_ineq mult_left_mono crossproduct_eq dest: d1 d2)
 qed
 
 
 lemma simple_path_subpath:
   assumes "simple_path g" "u \<in> {0..1}" "v \<in> {0..1}" "u \<noteq> v"
   shows "simple_path(subpath u v g)"
   using assms
   apply (simp add: simple_path_subpath_eq simple_path_imp_path)
   apply (simp add: simple_path_def closed_segment_real_eq image_affinity_atLeastAtMost, fastforce)
   done
 
 lemma arc_simple_path_subpath:
     "\<lbrakk>simple_path g; u \<in> {0..1}; v \<in> {0..1}; g u \<noteq> g v\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
   by (force intro: simple_path_subpath simple_path_imp_arc)
 
 lemma arc_subpath_arc:
     "\<lbrakk>arc g; u \<in> {0..1}; v \<in> {0..1}; u \<noteq> v\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
   by (meson arc_def arc_imp_simple_path arc_simple_path_subpath inj_onD)
 
 lemma arc_simple_path_subpath_interior:
     "\<lbrakk>simple_path g; u \<in> {0..1}; v \<in> {0..1}; u \<noteq> v; \<bar>u-v\<bar> < 1\<rbrakk> \<Longrightarrow> arc(subpath u v g)"
     apply (rule arc_simple_path_subpath)
     apply (force simp: simple_path_def)+
     done
 
 lemma path_image_subpath_subset:
     "\<lbrakk>u \<in> {0..1}; v \<in> {0..1}\<rbrakk> \<Longrightarrow> path_image(subpath u v g) \<subseteq> path_image g"
   apply (simp add: closed_segment_real_eq image_affinity_atLeastAtMost path_image_subpath)
   apply (auto simp: path_image_def)
   done  
 
 lemma join_subpaths_middle: "subpath (0) ((1 / 2)) p +++ subpath ((1 / 2)) 1 p = p"
   by (rule ext) (simp add: joinpaths_def subpath_def field_split_simps)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>There is a subpath to the frontier\<close>
 
 lemma subpath_to_frontier_explicit:
     fixes S :: "'a::metric_space set"
     assumes g: "path g" and "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1"
                 "\<And>x. 0 \<le> x \<and> x < u \<Longrightarrow> g x \<in> interior S"
                 "(g u \<notin> interior S)" "(u = 0 \<or> g u \<in> closure S)"
 proof -
   have gcon: "continuous_on {0..1} g"     using g by (simp add: path_def)
   then have com: "compact ({0..1} \<inter> {u. g u \<in> closure (- S)})"
     apply (simp add: Int_commute [of "{0..1}"] compact_eq_bounded_closed closed_vimage_Int [unfolded vimage_def])
     using compact_eq_bounded_closed apply fastforce
     done
   have "1 \<in> {u. g u \<in> closure (- S)}"
     using assms by (simp add: pathfinish_def closure_def)
   then have dis: "{0..1} \<inter> {u. g u \<in> closure (- S)} \<noteq> {}"
     using atLeastAtMost_iff zero_le_one by blast
   then obtain u where "0 \<le> u" "u \<le> 1" and gu: "g u \<in> closure (- S)"
                   and umin: "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1; g t \<in> closure (- S)\<rbrakk> \<Longrightarrow> u \<le> t"
     using compact_attains_inf [OF com dis] by fastforce
   then have umin': "\<And>t. \<lbrakk>0 \<le> t; t \<le> 1; t < u\<rbrakk> \<Longrightarrow>  g t \<in> S"
     using closure_def by fastforce
   { assume "u \<noteq> 0"
     then have "u > 0" using \<open>0 \<le> u\<close> by auto
     { fix e::real assume "e > 0"
       obtain d where "d>0" and d: "\<And>x'. \<lbrakk>x' \<in> {0..1}; dist x' u \<le> d\<rbrakk> \<Longrightarrow> dist (g x') (g u) < e"
         using continuous_onE [OF gcon _ \<open>e > 0\<close>] \<open>0 \<le> _\<close> \<open>_ \<le> 1\<close> atLeastAtMost_iff by auto
       have *: "dist (max 0 (u - d / 2)) u \<le> d"
         using \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> \<open>d > 0\<close> by (simp add: dist_real_def)
       have "\<exists>y\<in>S. dist y (g u) < e"
         using \<open>0 < u\<close> \<open>u \<le> 1\<close> \<open>d > 0\<close>
         by (force intro: d [OF _ *] umin')
     }
     then have "g u \<in> closure S"
       by (simp add: frontier_def closure_approachable)
   }
   then show ?thesis
     apply (rule_tac u=u in that)
     apply (auto simp: \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> gu interior_closure umin)
     using \<open>_ \<le> 1\<close> interior_closure umin apply fastforce
     done
 qed
 
 lemma subpath_to_frontier_strong:
     assumes g: "path g" and "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1" "g u \<notin> interior S"
                     "u = 0 \<or> (\<forall>x. 0 \<le> x \<and> x < 1 \<longrightarrow> subpath 0 u g x \<in> interior S)  \<and>  g u \<in> closure S"
 proof -
   obtain u where "0 \<le> u" "u \<le> 1"
              and gxin: "\<And>x. 0 \<le> x \<and> x < u \<Longrightarrow> g x \<in> interior S"
              and gunot: "(g u \<notin> interior S)" and u0: "(u = 0 \<or> g u \<in> closure S)"
     using subpath_to_frontier_explicit [OF assms] by blast
   show ?thesis
     apply (rule that [OF \<open>0 \<le> u\<close> \<open>u \<le> 1\<close>])
     apply (simp add: gunot)
     using \<open>0 \<le> u\<close> u0 by (force simp: subpath_def gxin)
 qed
 
 lemma subpath_to_frontier:
     assumes g: "path g" and g0: "pathstart g \<in> closure S" and g1: "pathfinish g \<notin> S"
     obtains u where "0 \<le> u" "u \<le> 1" "g u \<in> frontier S" "(path_image(subpath 0 u g) - {g u}) \<subseteq> interior S"
 proof -
   obtain u where "0 \<le> u" "u \<le> 1"
              and notin: "g u \<notin> interior S"
              and disj: "u = 0 \<or>
                         (\<forall>x. 0 \<le> x \<and> x < 1 \<longrightarrow> subpath 0 u g x \<in> interior S) \<and> g u \<in> closure S"
     using subpath_to_frontier_strong [OF g g1] by blast
   show ?thesis
     apply (rule that [OF \<open>0 \<le> u\<close> \<open>u \<le> 1\<close>])
     apply (metis DiffI disj frontier_def g0 notin pathstart_def)
     using \<open>0 \<le> u\<close> g0 disj
     apply (simp add: path_image_subpath_gen)
     apply (auto simp: closed_segment_eq_real_ivl pathstart_def pathfinish_def subpath_def)
     apply (rename_tac y)
     apply (drule_tac x="y/u" in spec)
     apply (auto split: if_split_asm)
     done
 qed
 
 lemma exists_path_subpath_to_frontier:
     fixes S :: "'a::real_normed_vector set"
     assumes "path g" "pathstart g \<in> closure S" "pathfinish g \<notin> S"
     obtains h where "path h" "pathstart h = pathstart g" "path_image h \<subseteq> path_image g"
                     "path_image h - {pathfinish h} \<subseteq> interior S"
                     "pathfinish h \<in> frontier S"
 proof -
   obtain u where u: "0 \<le> u" "u \<le> 1" "g u \<in> frontier S" "(path_image(subpath 0 u g) - {g u}) \<subseteq> interior S"
     using subpath_to_frontier [OF assms] by blast
   show ?thesis
     apply (rule that [of "subpath 0 u g"])
     using assms u
     apply (simp_all add: path_image_subpath)
     apply (simp add: pathstart_def)
     apply (force simp: closed_segment_eq_real_ivl path_image_def)
     done
 qed
 
 lemma exists_path_subpath_to_frontier_closed:
     fixes S :: "'a::real_normed_vector set"
     assumes S: "closed S" and g: "path g" and g0: "pathstart g \<in> S" and g1: "pathfinish g \<notin> S"
     obtains h where "path h" "pathstart h = pathstart g" "path_image h \<subseteq> path_image g \<inter> S"
                     "pathfinish h \<in> frontier S"
 proof -
   obtain h where h: "path h" "pathstart h = pathstart g" "path_image h \<subseteq> path_image g"
                     "path_image h - {pathfinish h} \<subseteq> interior S"
                     "pathfinish h \<in> frontier S"
     using exists_path_subpath_to_frontier [OF g _ g1] closure_closed [OF S] g0 by auto
   show ?thesis
     apply (rule that [OF \<open>path h\<close>])
     using assms h
     apply auto
     apply (metis Diff_single_insert frontier_subset_eq insert_iff interior_subset subset_iff)
     done
 qed
 
 
 subsection \<open>Shift Path to Start at Some Given Point\<close>
 
 definition\<^marker>\<open>tag important\<close> shiftpath :: "real \<Rightarrow> (real \<Rightarrow> 'a::topological_space) \<Rightarrow> real \<Rightarrow> 'a"
   where "shiftpath a f = (\<lambda>x. if (a + x) \<le> 1 then f (a + x) else f (a + x - 1))"
 
 lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart (shiftpath a g) = g a"
   unfolding pathstart_def shiftpath_def by auto
 
 lemma pathfinish_shiftpath:
   assumes "0 \<le> a"
     and "pathfinish g = pathstart g"
   shows "pathfinish (shiftpath a g) = g a"
   using assms
   unfolding pathstart_def pathfinish_def shiftpath_def
   by auto
 
 lemma endpoints_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0 .. 1}"
   shows "pathfinish (shiftpath a g) = g a"
     and "pathstart (shiftpath a g) = g a"
   using assms
   by (auto intro!: pathfinish_shiftpath pathstart_shiftpath)
 
 lemma closed_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
   shows "pathfinish (shiftpath a g) = pathstart (shiftpath a g)"
   using endpoints_shiftpath[OF assms]
   by auto
 
 lemma path_shiftpath:
   assumes "path g"
     and "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
   shows "path (shiftpath a g)"
 proof -
   have *: "{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}"
     using assms(3) by auto
   have **: "\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
     using assms(2)[unfolded pathfinish_def pathstart_def]
     by auto
   show ?thesis
     unfolding path_def shiftpath_def *
   proof (rule continuous_on_closed_Un)
     have contg: "continuous_on {0..1} g"
       using \<open>path g\<close> path_def by blast
     show "continuous_on {0..1-a} (\<lambda>x. if a + x \<le> 1 then g (a + x) else g (a + x - 1))"
     proof (rule continuous_on_eq)
       show "continuous_on {0..1-a} (g \<circ> (+) a)"
         by (intro continuous_intros continuous_on_subset [OF contg]) (use \<open>a \<in> {0..1}\<close> in auto)
     qed auto
     show "continuous_on {1-a..1} (\<lambda>x. if a + x \<le> 1 then g (a + x) else g (a + x - 1))"
     proof (rule continuous_on_eq)
       show "continuous_on {1-a..1} (g \<circ> (+) (a - 1))"
         by (intro continuous_intros continuous_on_subset [OF contg]) (use \<open>a \<in> {0..1}\<close> in auto)
     qed (auto simp:  "**" add.commute add_diff_eq)
   qed auto
 qed
 
 lemma shiftpath_shiftpath:
   assumes "pathfinish g = pathstart g"
     and "a \<in> {0..1}"
     and "x \<in> {0..1}"
   shows "shiftpath (1 - a) (shiftpath a g) x = g x"
   using assms
   unfolding pathfinish_def pathstart_def shiftpath_def
   by auto
 
 lemma path_image_shiftpath:
   assumes a: "a \<in> {0..1}"
     and "pathfinish g = pathstart g"
   shows "path_image (shiftpath a g) = path_image g"
 proof -
   { fix x
     assume g: "g 1 = g 0" "x \<in> {0..1::real}" and gne: "\<And>y. y\<in>{0..1} \<inter> {x. \<not> a + x \<le> 1} \<Longrightarrow> g x \<noteq> g (a + y - 1)"
     then have "\<exists>y\<in>{0..1} \<inter> {x. a + x \<le> 1}. g x = g (a + y)"
     proof (cases "a \<le> x")
       case False
       then show ?thesis
         apply (rule_tac x="1 + x - a" in bexI)
         using g gne[of "1 + x - a"] a
         apply (force simp: field_simps)+
         done
     next
       case True
       then show ?thesis
         using g a  by (rule_tac x="x - a" in bexI) (auto simp: field_simps)
     qed
   }
   then show ?thesis
     using assms
     unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
     by (auto simp: image_iff)
 qed
 
 lemma simple_path_shiftpath:
   assumes "simple_path g" "pathfinish g = pathstart g" and a: "0 \<le> a" "a \<le> 1"
     shows "simple_path (shiftpath a g)"
   unfolding simple_path_def
 proof (intro conjI impI ballI)
   show "path (shiftpath a g)"
     by (simp add: assms path_shiftpath simple_path_imp_path)
   have *: "\<And>x y. \<lbrakk>g x = g y; x \<in> {0..1}; y \<in> {0..1}\<rbrakk> \<Longrightarrow> x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     using assms by (simp add:  simple_path_def)
   show "x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0"
     if "x \<in> {0..1}" "y \<in> {0..1}" "shiftpath a g x = shiftpath a g y" for x y
     using that a unfolding shiftpath_def
     by (force split: if_split_asm dest!: *)
 qed
 
 
 subsection \<open>Straight-Line Paths\<close>
 
 definition\<^marker>\<open>tag important\<close> linepath :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> real \<Rightarrow> 'a"
   where "linepath a b = (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b)"
 
 lemma pathstart_linepath[simp]: "pathstart (linepath a b) = a"
   unfolding pathstart_def linepath_def
   by auto
 
 lemma pathfinish_linepath[simp]: "pathfinish (linepath a b) = b"
   unfolding pathfinish_def linepath_def
   by auto
 
 lemma linepath_inner: "linepath a b x \<bullet> v = linepath (a \<bullet> v) (b \<bullet> v) x"
   by (simp add: linepath_def algebra_simps)
 
 lemma Re_linepath': "Re (linepath a b x) = linepath (Re a) (Re b) x"
   by (simp add: linepath_def)
 
 lemma Im_linepath': "Im (linepath a b x) = linepath (Im a) (Im b) x"
   by (simp add: linepath_def)
 
 lemma linepath_0': "linepath a b 0 = a"
   by (simp add: linepath_def)
 
 lemma linepath_1': "linepath a b 1 = b"
   by (simp add: linepath_def)
 
 lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
   unfolding linepath_def
   by (intro continuous_intros)
 
 lemma continuous_on_linepath [intro,continuous_intros]: "continuous_on s (linepath a b)"
   using continuous_linepath_at
   by (auto intro!: continuous_at_imp_continuous_on)
 
 lemma path_linepath[iff]: "path (linepath a b)"
   unfolding path_def
   by (rule continuous_on_linepath)
 
 lemma path_image_linepath[simp]: "path_image (linepath a b) = closed_segment a b"
   unfolding path_image_def segment linepath_def
   by auto
 
 lemma reversepath_linepath[simp]: "reversepath (linepath a b) = linepath b a"
   unfolding reversepath_def linepath_def
   by auto
 
 lemma linepath_0 [simp]: "linepath 0 b x = x *\<^sub>R b"
   by (simp add: linepath_def)
 
 lemma linepath_cnj: "cnj (linepath a b x) = linepath (cnj a) (cnj b) x"
   by (simp add: linepath_def)
 
 lemma arc_linepath:
   assumes "a \<noteq> b" shows [simp]: "arc (linepath a b)"
 proof -
   {
     fix x y :: "real"
     assume "x *\<^sub>R b + y *\<^sub>R a = x *\<^sub>R a + y *\<^sub>R b"
     then have "(x - y) *\<^sub>R a = (x - y) *\<^sub>R b"
       by (simp add: algebra_simps)
     with assms have "x = y"
       by simp
   }
   then show ?thesis
     unfolding arc_def inj_on_def
     by (fastforce simp: algebra_simps linepath_def)
 qed
 
 lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path (linepath a b)"
   by (simp add: arc_imp_simple_path)
 
 lemma linepath_trivial [simp]: "linepath a a x = a"
   by (simp add: linepath_def real_vector.scale_left_diff_distrib)
 
 lemma linepath_refl: "linepath a a = (\<lambda>x. a)"
   by auto
 
 lemma subpath_refl: "subpath a a g = linepath (g a) (g a)"
   by (simp add: subpath_def linepath_def algebra_simps)
 
 lemma linepath_of_real: "(linepath (of_real a) (of_real b) x) = of_real ((1 - x)*a + x*b)"
   by (simp add: scaleR_conv_of_real linepath_def)
 
 lemma of_real_linepath: "of_real (linepath a b x) = linepath (of_real a) (of_real b) x"
   by (metis linepath_of_real mult.right_neutral of_real_def real_scaleR_def)
 
 lemma inj_on_linepath:
   assumes "a \<noteq> b" shows "inj_on (linepath a b) {0..1}"
 proof (clarsimp simp: inj_on_def linepath_def)
   fix x y
   assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b" "0 \<le> x" "x \<le> 1" "0 \<le> y" "y \<le> 1"
   then have "x *\<^sub>R (a - b) = y *\<^sub>R (a - b)"
     by (auto simp: algebra_simps)
   then show "x=y"
     using assms by auto
 qed
 
 lemma linepath_le_1:
   fixes a::"'a::linordered_idom" shows "\<lbrakk>a \<le> 1; b \<le> 1; 0 \<le> u; u \<le> 1\<rbrakk> \<Longrightarrow> (1 - u) * a + u * b \<le> 1"
   using mult_left_le [of a "1-u"] mult_left_le [of b u] by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Segments via convex hulls\<close>
 
 lemma segments_subset_convex_hull:
     "closed_segment a b \<subseteq> (convex hull {a,b,c})"
     "closed_segment a c \<subseteq> (convex hull {a,b,c})"
     "closed_segment b c \<subseteq> (convex hull {a,b,c})"
     "closed_segment b a \<subseteq> (convex hull {a,b,c})"
     "closed_segment c a \<subseteq> (convex hull {a,b,c})"
     "closed_segment c b \<subseteq> (convex hull {a,b,c})"
 by (auto simp: segment_convex_hull linepath_of_real  elim!: rev_subsetD [OF _ hull_mono])
 
 lemma midpoints_in_convex_hull:
   assumes "x \<in> convex hull s" "y \<in> convex hull s"
     shows "midpoint x y \<in> convex hull s"
 proof -
   have "(1 - inverse(2)) *\<^sub>R x + inverse(2) *\<^sub>R y \<in> convex hull s"
     by (rule convexD_alt) (use assms in auto)
   then show ?thesis
     by (simp add: midpoint_def algebra_simps)
 qed
 
 lemma not_in_interior_convex_hull_3:
   fixes a :: "complex"
   shows "a \<notin> interior(convex hull {a,b,c})"
         "b \<notin> interior(convex hull {a,b,c})"
         "c \<notin> interior(convex hull {a,b,c})"
   by (auto simp: card_insert_le_m1 not_in_interior_convex_hull)
 
 lemma midpoint_in_closed_segment [simp]: "midpoint a b \<in> closed_segment a b"
   using midpoints_in_convex_hull segment_convex_hull by blast
 
 lemma midpoint_in_open_segment [simp]: "midpoint a b \<in> open_segment a b \<longleftrightarrow> a \<noteq> b"
   by (simp add: open_segment_def)
 
 lemma continuous_IVT_local_extremum:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and "a \<noteq> b" "f a = f b"
   obtains z where "z \<in> open_segment a b"
                   "(\<forall>w \<in> closed_segment a b. (f w) \<le> (f z)) \<or>
                    (\<forall>w \<in> closed_segment a b. (f z) \<le> (f w))"
 proof -
   obtain c where "c \<in> closed_segment a b" and c: "\<And>y. y \<in> closed_segment a b \<Longrightarrow> f y \<le> f c"
     using continuous_attains_sup [of "closed_segment a b" f] contf by auto
   obtain d where "d \<in> closed_segment a b" and d: "\<And>y. y \<in> closed_segment a b \<Longrightarrow> f d \<le> f y"
     using continuous_attains_inf [of "closed_segment a b" f] contf by auto
   show ?thesis
   proof (cases "c \<in> open_segment a b \<or> d \<in> open_segment a b")
     case True
     then show ?thesis
       using c d that by blast
   next
     case False
     then have "(c = a \<or> c = b) \<and> (d = a \<or> d = b)"
       by (simp add: \<open>c \<in> closed_segment a b\<close> \<open>d \<in> closed_segment a b\<close> open_segment_def)
     with \<open>a \<noteq> b\<close> \<open>f a = f b\<close> c d show ?thesis
       by (rule_tac z = "midpoint a b" in that) (fastforce+)
   qed
 qed
 
 text\<open>An injective map into R is also an open map w.r.T. the universe, and conversely. \<close>
 proposition injective_eq_1d_open_map_UNIV:
   fixes f :: "real \<Rightarrow> real"
   assumes contf: "continuous_on S f" and S: "is_interval S"
     shows "inj_on f S \<longleftrightarrow> (\<forall>T. open T \<and> T \<subseteq> S \<longrightarrow> open(f ` T))"
           (is "?lhs = ?rhs")
 proof safe
   fix T
   assume injf: ?lhs and "open T" and "T \<subseteq> S"
   have "\<exists>U. open U \<and> f x \<in> U \<and> U \<subseteq> f ` T" if "x \<in> T" for x
   proof -
     obtain \<delta> where "\<delta> > 0" and \<delta>: "cball x \<delta> \<subseteq> T"
       using \<open>open T\<close> \<open>x \<in> T\<close> open_contains_cball_eq by blast
     show ?thesis
     proof (intro exI conjI)
       have "closed_segment (x-\<delta>) (x+\<delta>) = {x-\<delta>..x+\<delta>}"
         using \<open>0 < \<delta>\<close> by (auto simp: closed_segment_eq_real_ivl)
       also have "\<dots> \<subseteq> S"
         using \<delta> \<open>T \<subseteq> S\<close> by (auto simp: dist_norm subset_eq)
       finally have "f ` (open_segment (x-\<delta>) (x+\<delta>)) = open_segment (f (x-\<delta>)) (f (x+\<delta>))"
         using continuous_injective_image_open_segment_1
         by (metis continuous_on_subset [OF contf] inj_on_subset [OF injf])
       then show "open (f ` {x-\<delta><..<x+\<delta>})"
         using \<open>0 < \<delta>\<close> by (simp add: open_segment_eq_real_ivl)
       show "f x \<in> f ` {x - \<delta><..<x + \<delta>}"
         by (auto simp: \<open>\<delta> > 0\<close>)
       show "f ` {x - \<delta><..<x + \<delta>} \<subseteq> f ` T"
         using \<delta> by (auto simp: dist_norm subset_iff)
     qed
   qed
   with open_subopen show "open (f ` T)"
     by blast
 next
   assume R: ?rhs
   have False if xy: "x \<in> S" "y \<in> S" and "f x = f y" "x \<noteq> y" for x y
   proof -
     have "open (f ` open_segment x y)"
       using R
       by (metis S convex_contains_open_segment is_interval_convex open_greaterThanLessThan open_segment_eq_real_ivl xy)
     moreover
     have "continuous_on (closed_segment x y) f"
       by (meson S closed_segment_subset contf continuous_on_subset is_interval_convex that)
     then obtain \<xi> where "\<xi> \<in> open_segment x y"
                     and \<xi>: "(\<forall>w \<in> closed_segment x y. (f w) \<le> (f \<xi>)) \<or>
                             (\<forall>w \<in> closed_segment x y. (f \<xi>) \<le> (f w))"
       using continuous_IVT_local_extremum [of x y f] \<open>f x = f y\<close> \<open>x \<noteq> y\<close> by blast
     ultimately obtain e where "e>0" and e: "\<And>u. dist u (f \<xi>) < e \<Longrightarrow> u \<in> f ` open_segment x y"
       using open_dist by (metis image_eqI)
     have fin: "f \<xi> + (e/2) \<in> f ` open_segment x y" "f \<xi> - (e/2) \<in> f ` open_segment x y"
       using e [of "f \<xi> + (e/2)"] e [of "f \<xi> - (e/2)"] \<open>e > 0\<close> by (auto simp: dist_norm)
     show ?thesis
       using \<xi> \<open>0 < e\<close> fin open_closed_segment by fastforce
   qed
   then show ?lhs
     by (force simp: inj_on_def)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounding a point away from a path\<close>
 
 lemma not_on_path_ball:
   fixes g :: "real \<Rightarrow> 'a::heine_borel"
   assumes "path g"
     and z: "z \<notin> path_image g"
   shows "\<exists>e > 0. ball z e \<inter> path_image g = {}"
 proof -
   have "closed (path_image g)"
     by (simp add: \<open>path g\<close> closed_path_image)
   then obtain a where "a \<in> path_image g" "\<forall>y \<in> path_image g. dist z a \<le> dist z y"
     by (auto intro: distance_attains_inf[OF _ path_image_nonempty, of g z])
   then show ?thesis
     by (rule_tac x="dist z a" in exI) (use dist_commute z in auto)
 qed
 
 lemma not_on_path_cball:
   fixes g :: "real \<Rightarrow> 'a::heine_borel"
   assumes "path g"
     and "z \<notin> path_image g"
   shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}"
 proof -
   obtain e where "ball z e \<inter> path_image g = {}" "e > 0"
     using not_on_path_ball[OF assms] by auto
   moreover have "cball z (e/2) \<subseteq> ball z e"
     using \<open>e > 0\<close> by auto
   ultimately show ?thesis
     by (rule_tac x="e/2" in exI) auto
 qed
 
 subsection \<open>Path component\<close>
 
 text \<open>Original formalization by Tom Hales\<close>
 
 definition\<^marker>\<open>tag important\<close> "path_component s x y \<longleftrightarrow>
   (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y)"
 
 abbreviation\<^marker>\<open>tag important\<close>
   "path_component_set s x \<equiv> Collect (path_component s x)"
 
 lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
 
 lemma path_component_mem:
   assumes "path_component s x y"
   shows "x \<in> s" and "y \<in> s"
   using assms
   unfolding path_defs
   by auto
 
 lemma path_component_refl:
   assumes "x \<in> s"
   shows "path_component s x x"
   unfolding path_defs
   apply (rule_tac x="\<lambda>u. x" in exI)
   using assms
   apply (auto intro!: continuous_intros)
   done
 
 lemma path_component_refl_eq: "path_component s x x \<longleftrightarrow> x \<in> s"
   by (auto intro!: path_component_mem path_component_refl)
 
 lemma path_component_sym: "path_component s x y \<Longrightarrow> path_component s y x"
   unfolding path_component_def
   apply (erule exE)
   apply (rule_tac x="reversepath g" in exI, auto)
   done
 
 lemma path_component_trans:
   assumes "path_component s x y" and "path_component s y z"
   shows "path_component s x z"
   using assms
   unfolding path_component_def
   apply (elim exE)
   apply (rule_tac x="g +++ ga" in exI)
   apply (auto simp: path_image_join)
   done
 
 lemma path_component_of_subset: "s \<subseteq> t \<Longrightarrow> path_component s x y \<Longrightarrow> path_component t x y"
   unfolding path_component_def by auto
 
 lemma path_component_linepath:
     fixes s :: "'a::real_normed_vector set"
     shows "closed_segment a b \<subseteq> s \<Longrightarrow> path_component s a b"
   unfolding path_component_def
   by (rule_tac x="linepath a b" in exI, auto)
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Path components as sets\<close>
 
 lemma path_component_set:
   "path_component_set s x =
     {y. (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y)}"
   by (auto simp: path_component_def)
 
 lemma path_component_subset: "path_component_set s x \<subseteq> s"
   by (auto simp: path_component_mem(2))
 
 lemma path_component_eq_empty: "path_component_set s x = {} \<longleftrightarrow> x \<notin> s"
   using path_component_mem path_component_refl_eq
     by fastforce
 
 lemma path_component_mono:
      "s \<subseteq> t \<Longrightarrow> (path_component_set s x) \<subseteq> (path_component_set t x)"
   by (simp add: Collect_mono path_component_of_subset)
 
 lemma path_component_eq:
    "y \<in> path_component_set s x \<Longrightarrow> path_component_set s y = path_component_set s x"
 by (metis (no_types, lifting) Collect_cong mem_Collect_eq path_component_sym path_component_trans)
 
 
 subsection \<open>Path connectedness of a space\<close>
 
 definition\<^marker>\<open>tag important\<close> "path_connected s \<longleftrightarrow>
   (\<forall>x\<in>s. \<forall>y\<in>s. \<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y)"
 
 lemma path_connectedin_iff_path_connected_real [simp]:
      "path_connectedin euclideanreal S \<longleftrightarrow> path_connected S"
   by (simp add: path_connectedin path_connected_def path_defs)
 
 lemma path_connected_component: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. path_component s x y)"
   unfolding path_connected_def path_component_def by auto
 
 lemma path_connected_component_set: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. path_component_set s x = s)"
   unfolding path_connected_component path_component_subset
   using path_component_mem by blast
 
 lemma path_component_maximal:
      "\<lbrakk>x \<in> t; path_connected t; t \<subseteq> s\<rbrakk> \<Longrightarrow> t \<subseteq> (path_component_set s x)"
   by (metis path_component_mono path_connected_component_set)
 
 lemma convex_imp_path_connected:
   fixes s :: "'a::real_normed_vector set"
   assumes "convex s"
   shows "path_connected s"
   unfolding path_connected_def
   using assms convex_contains_segment by fastforce
 
 lemma path_connected_UNIV [iff]: "path_connected (UNIV :: 'a::real_normed_vector set)"
   by (simp add: convex_imp_path_connected)
 
 lemma path_component_UNIV: "path_component_set UNIV x = (UNIV :: 'a::real_normed_vector set)"
   using path_connected_component_set by auto
 
 lemma path_connected_imp_connected:
   assumes "path_connected S"
   shows "connected S"
 proof (rule connectedI)
   fix e1 e2
   assume as: "open e1" "open e2" "S \<subseteq> e1 \<union> e2" "e1 \<inter> e2 \<inter> S = {}" "e1 \<inter> S \<noteq> {}" "e2 \<inter> S \<noteq> {}"
   then obtain x1 x2 where obt:"x1 \<in> e1 \<inter> S" "x2 \<in> e2 \<inter> S"
     by auto
   then obtain g where g: "path g" "path_image g \<subseteq> S" "pathstart g = x1" "pathfinish g = x2"
     using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
   have *: "connected {0..1::real}"
-    by (auto intro!: convex_connected convex_real_interval)
+    by (auto intro!: convex_connected)
   have "{0..1} \<subseteq> {x \<in> {0..1}. g x \<in> e1} \<union> {x \<in> {0..1}. g x \<in> e2}"
     using as(3) g(2)[unfolded path_defs] by blast
   moreover have "{x \<in> {0..1}. g x \<in> e1} \<inter> {x \<in> {0..1}. g x \<in> e2} = {}"
     using as(4) g(2)[unfolded path_defs]
     unfolding subset_eq
     by auto
   moreover have "{x \<in> {0..1}. g x \<in> e1} \<noteq> {} \<and> {x \<in> {0..1}. g x \<in> e2} \<noteq> {}"
     using g(3,4)[unfolded path_defs]
     using obt
     by (simp add: ex_in_conv [symmetric], metis zero_le_one order_refl)
   ultimately show False
     using *[unfolded connected_local not_ex, rule_format,
       of "{0..1} \<inter> g -` e1" "{0..1} \<inter> g -` e2"]
     using continuous_openin_preimage_gen[OF g(1)[unfolded path_def] as(1)]
     using continuous_openin_preimage_gen[OF g(1)[unfolded path_def] as(2)]
     by auto
 qed
 
 lemma open_path_component:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (path_component_set S x)"
   unfolding open_contains_ball
 proof
   fix y
   assume as: "y \<in> path_component_set S x"
   then have "y \<in> S"
     by (simp add: path_component_mem(2))
   then obtain e where e: "e > 0" "ball y e \<subseteq> S"
     using assms[unfolded open_contains_ball]
     by auto
 have "\<And>u. dist y u < e \<Longrightarrow> path_component S x u"
       by (metis (full_types) as centre_in_ball convex_ball convex_imp_path_connected e mem_Collect_eq mem_ball path_component_eq path_component_of_subset path_connected_component)
   then show "\<exists>e > 0. ball y e \<subseteq> path_component_set S x"
     using \<open>e>0\<close> by auto
 qed
 
 lemma open_non_path_component:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (S - path_component_set S x)"
   unfolding open_contains_ball
 proof
   fix y
   assume y: "y \<in> S - path_component_set S x"
   then obtain e where e: "e > 0" "ball y e \<subseteq> S"
     using assms openE by auto
   show "\<exists>e>0. ball y e \<subseteq> S - path_component_set S x"
   proof (intro exI conjI subsetI DiffI notI)
     show "\<And>x. x \<in> ball y e \<Longrightarrow> x \<in> S"
       using e by blast
     show False if "z \<in> ball y e" "z \<in> path_component_set S x" for z
     proof -
       have "y \<in> path_component_set S z"
         by (meson assms convex_ball convex_imp_path_connected e open_contains_ball_eq open_path_component path_component_maximal that(1))
       then have "y \<in> path_component_set S x"
         using path_component_eq that(2) by blast
       then show False
         using y by blast
     qed
   qed (use e in auto)
 qed
 
 lemma connected_open_path_connected:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
     and "connected S"
   shows "path_connected S"
   unfolding path_connected_component_set
 proof (rule, rule, rule path_component_subset, rule)
   fix x y
   assume "x \<in> S" and "y \<in> S"
   show "y \<in> path_component_set S x"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     moreover have "path_component_set S x \<inter> S \<noteq> {}"
       using \<open>x \<in> S\<close> path_component_eq_empty path_component_subset[of S x]
       by auto
     ultimately
     show False
       using \<open>y \<in> S\<close> open_non_path_component[OF assms(1)] open_path_component[OF assms(1)]
       using assms(2)[unfolded connected_def not_ex, rule_format,
         of "path_component_set S x" "S - path_component_set S x"]
       by auto
   qed
 qed
 
 lemma path_connected_continuous_image:
   assumes "continuous_on S f"
     and "path_connected S"
   shows "path_connected (f ` S)"
   unfolding path_connected_def
 proof (rule, rule)
   fix x' y'
   assume "x' \<in> f ` S" "y' \<in> f ` S"
   then obtain x y where x: "x \<in> S" and y: "y \<in> S" and x': "x' = f x" and y': "y' = f y"
     by auto
   from x y obtain g where "path g \<and> path_image g \<subseteq> S \<and> pathstart g = x \<and> pathfinish g = y"
     using assms(2)[unfolded path_connected_def] by fast
   then show "\<exists>g. path g \<and> path_image g \<subseteq> f ` S \<and> pathstart g = x' \<and> pathfinish g = y'"
     unfolding x' y'
     apply (rule_tac x="f \<circ> g" in exI)
     unfolding path_defs
     apply (intro conjI continuous_on_compose continuous_on_subset[OF assms(1)])
     apply auto
     done
 qed
 
 lemma path_connected_translationI:
   fixes a :: "'a :: topological_group_add"
   assumes "path_connected S" shows "path_connected ((\<lambda>x. a + x) ` S)"
   by (intro path_connected_continuous_image assms continuous_intros)
 
 lemma path_connected_translation:
   fixes a :: "'a :: topological_group_add"
   shows "path_connected ((\<lambda>x. a + x) ` S) = path_connected S"
 proof -
   have "\<forall>x y. (+) (x::'a) ` (+) (0 - x) ` y = y"
     by (simp add: image_image)
   then show ?thesis
     by (metis (no_types) path_connected_translationI)
 qed
 
 lemma path_connected_segment [simp]:
     fixes a :: "'a::real_normed_vector"
     shows "path_connected (closed_segment a b)"
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_open_segment [simp]:
     fixes a :: "'a::real_normed_vector"
     shows "path_connected (open_segment a b)"
   by (simp add: convex_imp_path_connected)
 
 lemma homeomorphic_path_connectedness:
   "S homeomorphic T \<Longrightarrow> path_connected S \<longleftrightarrow> path_connected T"
   unfolding homeomorphic_def homeomorphism_def by (metis path_connected_continuous_image)
 
 lemma path_connected_empty [simp]: "path_connected {}"
   unfolding path_connected_def by auto
 
 lemma path_connected_singleton [simp]: "path_connected {a}"
   unfolding path_connected_def pathstart_def pathfinish_def path_image_def
   apply clarify
   apply (rule_tac x="\<lambda>x. a" in exI)
   apply (simp add: image_constant_conv)
-  apply (simp add: path_def continuous_on_const)
+  apply (simp add: path_def)
   done
 
 lemma path_connected_Un:
   assumes "path_connected S"
     and "path_connected T"
     and "S \<inter> T \<noteq> {}"
   shows "path_connected (S \<union> T)"
   unfolding path_connected_component
 proof (intro ballI)
   fix x y
   assume x: "x \<in> S \<union> T" and y: "y \<in> S \<union> T"
   from assms obtain z where z: "z \<in> S" "z \<in> T"
     by auto
   show "path_component (S \<union> T) x y"
     using x y
   proof safe
     assume "x \<in> S" "y \<in> S"
     then show "path_component (S \<union> T) x y"
       by (meson Un_upper1 \<open>path_connected S\<close> path_component_of_subset path_connected_component)
   next
     assume "x \<in> S" "y \<in> T"
     then show "path_component (S \<union> T) x y"
       by (metis z assms(1-2) le_sup_iff order_refl path_component_of_subset path_component_trans path_connected_component)
   next
   assume "x \<in> T" "y \<in> S"
     then show "path_component (S \<union> T) x y"
       by (metis z assms(1-2) le_sup_iff order_refl path_component_of_subset path_component_trans path_connected_component)
   next
     assume "x \<in> T" "y \<in> T"
     then show "path_component (S \<union> T) x y"
       by (metis Un_upper1 assms(2) path_component_of_subset path_connected_component sup_commute)
   qed
 qed
 
 lemma path_connected_UNION:
   assumes "\<And>i. i \<in> A \<Longrightarrow> path_connected (S i)"
     and "\<And>i. i \<in> A \<Longrightarrow> z \<in> S i"
   shows "path_connected (\<Union>i\<in>A. S i)"
   unfolding path_connected_component
 proof clarify
   fix x i y j
   assume *: "i \<in> A" "x \<in> S i" "j \<in> A" "y \<in> S j"
   then have "path_component (S i) x z" and "path_component (S j) z y"
     using assms by (simp_all add: path_connected_component)
   then have "path_component (\<Union>i\<in>A. S i) x z" and "path_component (\<Union>i\<in>A. S i) z y"
     using *(1,3) by (auto elim!: path_component_of_subset [rotated])
   then show "path_component (\<Union>i\<in>A. S i) x y"
     by (rule path_component_trans)
 qed
 
 lemma path_component_path_image_pathstart:
   assumes p: "path p" and x: "x \<in> path_image p"
   shows "path_component (path_image p) (pathstart p) x"
 proof -
   obtain y where x: "x = p y" and y: "0 \<le> y" "y \<le> 1"
     using x by (auto simp: path_image_def)
   show ?thesis
     unfolding path_component_def 
   proof (intro exI conjI)
     have "continuous_on {0..1} (p \<circ> ((*) y))"
       apply (rule continuous_intros)+
       using p [unfolded path_def] y
       apply (auto simp: mult_le_one intro: continuous_on_subset [of _ p])
       done
     then show "path (\<lambda>u. p (y * u))"
       by (simp add: path_def)
     show "path_image (\<lambda>u. p (y * u)) \<subseteq> path_image p"
       using y mult_le_one by (fastforce simp: path_image_def image_iff)
   qed (auto simp: pathstart_def pathfinish_def x)
 qed
 
 lemma path_connected_path_image: "path p \<Longrightarrow> path_connected(path_image p)"
   unfolding path_connected_component
   by (meson path_component_path_image_pathstart path_component_sym path_component_trans)
 
 lemma path_connected_path_component [simp]:
    "path_connected (path_component_set s x)"
 proof -
   { fix y z
     assume pa: "path_component s x y" "path_component s x z"
     then have pae: "path_component_set s x = path_component_set s y"
       using path_component_eq by auto
     have yz: "path_component s y z"
       using pa path_component_sym path_component_trans by blast
     then have "\<exists>g. path g \<and> path_image g \<subseteq> path_component_set s x \<and> pathstart g = y \<and> pathfinish g = z"
       apply (simp add: path_component_def, clarify)
       apply (rule_tac x=g in exI)
       by (simp add: pae path_component_maximal path_connected_path_image pathstart_in_path_image)
   }
   then show ?thesis
     by (simp add: path_connected_def)
 qed
 
 lemma path_component: "path_component S x y \<longleftrightarrow> (\<exists>t. path_connected t \<and> t \<subseteq> S \<and> x \<in> t \<and> y \<in> t)"
   apply (intro iffI)
   apply (metis path_connected_path_image path_defs(5) pathfinish_in_path_image pathstart_in_path_image)
   using path_component_of_subset path_connected_component by blast
 
 lemma path_component_path_component [simp]:
    "path_component_set (path_component_set S x) x = path_component_set S x"
 proof (cases "x \<in> S")
   case True show ?thesis
     apply (rule subset_antisym)
     apply (simp add: path_component_subset)
-    by (simp add: True path_component_maximal path_component_refl path_connected_path_component)
+    by (simp add: True path_component_maximal path_component_refl)
 next
   case False then show ?thesis
     by (metis False empty_iff path_component_eq_empty)
 qed
 
 lemma path_component_subset_connected_component:
    "(path_component_set S x) \<subseteq> (connected_component_set S x)"
 proof (cases "x \<in> S")
   case True show ?thesis
     apply (rule connected_component_maximal)
     apply (auto simp: True path_component_subset path_component_refl path_connected_imp_connected)
     done
 next
   case False then show ?thesis
     using path_component_eq_empty by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Lemmas about path-connectedness\<close>
 
 lemma path_connected_linear_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "path_connected S" "bounded_linear f"
     shows "path_connected(f ` S)"
 by (auto simp: linear_continuous_on assms path_connected_continuous_image)
 
 lemma is_interval_path_connected: "is_interval S \<Longrightarrow> path_connected S"
   by (simp add: convex_imp_path_connected is_interval_convex)
 
 lemma path_connected_Ioi[simp]: "path_connected {a<..}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ici[simp]: "path_connected {a..}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Iio[simp]: "path_connected {..<a}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Iic[simp]: "path_connected {..a}" for a :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ioo[simp]: "path_connected {a<..<b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ioc[simp]: "path_connected {a<..b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connected_Ico[simp]: "path_connected {a..<b}" for a b :: real
   by (simp add: convex_imp_path_connected)
 
 lemma path_connectedin_path_image:
   assumes "pathin X g" shows "path_connectedin X (g ` ({0..1}))"
   unfolding pathin_def
 proof (rule path_connectedin_continuous_map_image)
   show "continuous_map (subtopology euclideanreal {0..1}) X g"
     using assms pathin_def by blast
 qed (auto simp: is_interval_1 is_interval_path_connected)
 
 lemma path_connected_space_subconnected:
      "path_connected_space X \<longleftrightarrow>
       (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. \<exists>S. path_connectedin X S \<and> x \<in> S \<and> y \<in> S)"
   unfolding path_connected_space_def Ball_def
   apply (intro all_cong1 imp_cong refl, safe)
   using path_connectedin_path_image apply fastforce
   by (meson path_connectedin)
 
 lemma connectedin_path_image: "pathin X g \<Longrightarrow> connectedin X (g ` ({0..1}))"
   by (simp add: path_connectedin_imp_connectedin path_connectedin_path_image)
 
 lemma compactin_path_image: "pathin X g \<Longrightarrow> compactin X (g ` ({0..1}))"
   unfolding pathin_def
   by (rule image_compactin [of "top_of_set {0..1}"]) auto
 
 lemma linear_homeomorphism_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     obtains g where "homeomorphism (f ` S) S g f"
 using linear_injective_left_inverse [OF assms]
 apply clarify
 apply (rule_tac g=g in that)
 using assms
 apply (auto simp: homeomorphism_def eq_id_iff [symmetric] image_comp comp_def linear_conv_bounded_linear linear_continuous_on)
 done
 
 lemma linear_homeomorphic_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
     shows "S homeomorphic f ` S"
 by (meson homeomorphic_def homeomorphic_sym linear_homeomorphism_image [OF assms])
 
 lemma path_connected_Times:
   assumes "path_connected s" "path_connected t"
     shows "path_connected (s \<times> t)"
 proof (simp add: path_connected_def Sigma_def, clarify)
   fix x1 y1 x2 y2
   assume "x1 \<in> s" "y1 \<in> t" "x2 \<in> s" "y2 \<in> t"
   obtain g where "path g" and g: "path_image g \<subseteq> s" and gs: "pathstart g = x1" and gf: "pathfinish g = x2"
     using \<open>x1 \<in> s\<close> \<open>x2 \<in> s\<close> assms by (force simp: path_connected_def)
   obtain h where "path h" and h: "path_image h \<subseteq> t" and hs: "pathstart h = y1" and hf: "pathfinish h = y2"
     using \<open>y1 \<in> t\<close> \<open>y2 \<in> t\<close> assms by (force simp: path_connected_def)
   have "path (\<lambda>z. (x1, h z))"
     using \<open>path h\<close>
     apply (simp add: path_def)
     apply (rule continuous_on_compose2 [where f = h])
     apply (rule continuous_intros | force)+
     done
   moreover have "path (\<lambda>z. (g z, y2))"
     using \<open>path g\<close>
     apply (simp add: path_def)
     apply (rule continuous_on_compose2 [where f = g])
     apply (rule continuous_intros | force)+
     done
   ultimately have 1: "path ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2)))"
     by (metis hf gs path_join_imp pathstart_def pathfinish_def)
   have "path_image ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2))) \<subseteq> path_image (\<lambda>z. (x1, h z)) \<union> path_image (\<lambda>z. (g z, y2))"
     by (rule Path_Connected.path_image_join_subset)
   also have "\<dots> \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)})"
     using g h \<open>x1 \<in> s\<close> \<open>y2 \<in> t\<close> by (force simp: path_image_def)
   finally have 2: "path_image ((\<lambda>z. (x1, h z)) +++ (\<lambda>z. (g z, y2))) \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)})" .
   show "\<exists>g. path g \<and> path_image g \<subseteq> (\<Union>x\<in>s. \<Union>x1\<in>t. {(x, x1)}) \<and>
             pathstart g = (x1, y1) \<and> pathfinish g = (x2, y2)"
     apply (intro exI conjI)
        apply (rule 1)
       apply (rule 2)
      apply (metis hs pathstart_def pathstart_join)
     by (metis gf pathfinish_def pathfinish_join)
 qed
 
 lemma is_interval_path_connected_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> path_connected s"
 using is_interval_connected_1 is_interval_path_connected path_connected_imp_connected by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Path components\<close>
 
 lemma Union_path_component [simp]:
    "Union {path_component_set S x |x. x \<in> S} = S"
 apply (rule subset_antisym)
 using path_component_subset apply force
 using path_component_refl by auto
 
 lemma path_component_disjoint:
    "disjnt (path_component_set S a) (path_component_set S b) \<longleftrightarrow>
     (a \<notin> path_component_set S b)"
 apply (auto simp: disjnt_def)
 using path_component_eq apply fastforce
 using path_component_sym path_component_trans by blast
 
 lemma path_component_eq_eq:
    "path_component S x = path_component S y \<longleftrightarrow>
         (x \<notin> S) \<and> (y \<notin> S) \<or> x \<in> S \<and> y \<in> S \<and> path_component S x y"
 apply (rule iffI, metis (no_types) path_component_mem(1) path_component_refl)
 apply (erule disjE, metis Collect_empty_eq_bot path_component_eq_empty)
 apply (rule ext)
 apply (metis path_component_trans path_component_sym)
 done
 
 lemma path_component_unique:
   assumes "x \<in> c" "c \<subseteq> S" "path_connected c"
           "\<And>c'. \<lbrakk>x \<in> c'; c' \<subseteq> S; path_connected c'\<rbrakk> \<Longrightarrow> c' \<subseteq> c"
    shows "path_component_set S x = c"
 apply (rule subset_antisym)
 using assms
 apply (metis mem_Collect_eq subsetCE path_component_eq_eq path_component_subset path_connected_path_component)
 by (simp add: assms path_component_maximal)
 
 lemma path_component_intermediate_subset:
    "path_component_set u a \<subseteq> t \<and> t \<subseteq> u
         \<Longrightarrow> path_component_set t a = path_component_set u a"
 by (metis (no_types) path_component_mono path_component_path_component subset_antisym)
 
 lemma complement_path_component_Union:
   fixes x :: "'a :: topological_space"
   shows "S - path_component_set S x =
          \<Union>({path_component_set S y| y. y \<in> S} - {path_component_set S x})"
 proof -
   have *: "(\<And>x. x \<in> S - {a} \<Longrightarrow> disjnt a x) \<Longrightarrow> \<Union>S - a = \<Union>(S - {a})"
     for a::"'a set" and S
     by (auto simp: disjnt_def)
   have "\<And>y. y \<in> {path_component_set S x |x. x \<in> S} - {path_component_set S x}
             \<Longrightarrow> disjnt (path_component_set S x) y"
     using path_component_disjoint path_component_eq by fastforce
   then have "\<Union>{path_component_set S x |x. x \<in> S} - path_component_set S x =
              \<Union>({path_component_set S y |y. y \<in> S} - {path_component_set S x})"
     by (meson *)
   then show ?thesis by simp
 qed
 
 
 subsection\<open>Path components\<close>
 
 definition path_component_of
   where "path_component_of X x y \<equiv> \<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y"
 
 abbreviation path_component_of_set
   where "path_component_of_set X x \<equiv> Collect (path_component_of X x)"
 
 definition path_components_of :: "'a topology \<Rightarrow> 'a set set"
   where "path_components_of X \<equiv> path_component_of_set X ` topspace X"
 
 lemma pathin_canon_iff: "pathin (top_of_set T) g \<longleftrightarrow> path g \<and> g ` {0..1} \<subseteq> T"
   by (simp add: path_def pathin_def)
 
 lemma path_component_of_canon_iff [simp]:
   "path_component_of (top_of_set T) a b \<longleftrightarrow> path_component T a b"
   by (simp add: path_component_of_def pathin_canon_iff path_defs)
 
 lemma path_component_in_topspace:
    "path_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (auto simp: path_component_of_def pathin_def continuous_map_def)
 
 lemma path_component_of_refl:
    "path_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   apply (auto simp: path_component_in_topspace)
   apply (force simp: path_component_of_def pathin_const)
   done
 
 lemma path_component_of_sym:
   assumes "path_component_of X x y"
   shows "path_component_of X y x"
   using assms
   apply (clarsimp simp: path_component_of_def pathin_def)
   apply (rule_tac x="g \<circ> (\<lambda>t. 1 - t)" in exI)
   apply (auto intro!: continuous_map_compose)
   apply (force simp: continuous_map_in_subtopology continuous_on_op_minus)
   done
 
 lemma path_component_of_sym_iff:
    "path_component_of X x y \<longleftrightarrow> path_component_of X y x"
   by (metis path_component_of_sym)
 
 lemma path_component_of_trans:
   assumes "path_component_of X x y" and "path_component_of X y z"
   shows "path_component_of X x z"
   unfolding path_component_of_def pathin_def
 proof -
   let ?T01 = "top_of_set {0..1::real}"
   obtain g1 g2 where g1: "continuous_map ?T01 X g1" "x = g1 0" "y = g1 1"
     and g2: "continuous_map ?T01 X g2" "g2 0 = g1 1" "z = g2 1"
     using assms unfolding path_component_of_def pathin_def by blast
   let ?g = "\<lambda>x. if x \<le> 1/2 then (g1 \<circ> (\<lambda>t. 2 * t)) x else (g2 \<circ> (\<lambda>t. 2 * t -1)) x"
   show "\<exists>g. continuous_map ?T01 X g \<and> g 0 = x \<and> g 1 = z"
   proof (intro exI conjI)
     show "continuous_map (subtopology euclideanreal {0..1}) X ?g"
     proof (intro continuous_map_cases_le continuous_map_compose, force, force)
       show "continuous_map (subtopology ?T01 {x \<in> topspace ?T01. x \<le> 1/2}) ?T01 ((*) 2)"
         by (auto simp: continuous_map_in_subtopology continuous_map_from_subtopology)
       have "continuous_map
              (subtopology (top_of_set {0..1}) {x. 0 \<le> x \<and> x \<le> 1 \<and> 1 \<le> x * 2})
              euclideanreal (\<lambda>t. 2 * t - 1)"
         by (intro continuous_intros) (force intro: continuous_map_from_subtopology)
       then show "continuous_map (subtopology ?T01 {x \<in> topspace ?T01. 1/2 \<le> x}) ?T01 (\<lambda>t. 2 * t - 1)"
         by (force simp: continuous_map_in_subtopology)
       show "(g1 \<circ> (*) 2) x = (g2 \<circ> (\<lambda>t. 2 * t - 1)) x" if "x \<in> topspace ?T01" "x = 1/2" for x
         using that by (simp add: g2(2) mult.commute continuous_map_from_subtopology)
     qed (auto simp: g1 g2)
   qed (auto simp: g1 g2)
 qed
 
 lemma path_component_of_mono:
    "\<lbrakk>path_component_of (subtopology X S) x y; S \<subseteq> T\<rbrakk> \<Longrightarrow> path_component_of (subtopology X T) x y"
   unfolding path_component_of_def
   by (metis subsetD pathin_subtopology)
 
 lemma path_component_of:
   "path_component_of X x y \<longleftrightarrow> (\<exists>T. path_connectedin X T \<and> x \<in> T \<and> y \<in> T)"
   apply (auto simp: path_component_of_def)
   using path_connectedin_path_image apply fastforce
   apply (metis path_connectedin)
   done
 
 lemma path_component_of_set:
    "path_component_of X x y \<longleftrightarrow> (\<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y)"
   by (auto simp: path_component_of_def)
 
 lemma path_component_of_subset_topspace:
    "Collect(path_component_of X x) \<subseteq> topspace X"
   using path_component_in_topspace by fastforce
 
 lemma path_component_of_eq_empty:
    "Collect(path_component_of X x) = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using path_component_in_topspace path_component_of_refl by fastforce
 
 lemma path_connected_space_iff_path_component:
    "path_connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. path_component_of X x y)"
   by (simp add: path_component_of path_connected_space_subconnected)
 
 lemma path_connected_space_imp_path_component_of:
    "\<lbrakk>path_connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk>
         \<Longrightarrow> path_component_of X a b"
   by (simp add: path_connected_space_iff_path_component)
 
 lemma path_connected_space_path_component_set:
    "path_connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. Collect(path_component_of X x) = topspace X)"
   using path_component_of_subset_topspace path_connected_space_iff_path_component by fastforce
 
 lemma path_component_of_maximal:
    "\<lbrakk>path_connectedin X s; x \<in> s\<rbrakk> \<Longrightarrow> s \<subseteq> Collect(path_component_of X x)"
   using path_component_of by fastforce
 
 lemma path_component_of_equiv:
    "path_component_of X x y \<longleftrightarrow> x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x = path_component_of X y"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (simp add: fun_eq_iff path_component_in_topspace)
     apply (meson path_component_of_sym path_component_of_trans)
     done
 qed (simp add: path_component_of_refl)
 
 lemma path_component_of_disjoint:
      "disjnt (Collect (path_component_of X x)) (Collect (path_component_of X y)) \<longleftrightarrow>
       ~(path_component_of X x y)"
   by (force simp: disjnt_def path_component_of_eq_empty path_component_of_equiv)
 
 lemma path_component_of_eq:
    "path_component_of X x = path_component_of X y \<longleftrightarrow>
         (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
         x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x y"
   by (metis Collect_empty_eq_bot path_component_of_eq_empty path_component_of_equiv)
 
 lemma path_connectedin_path_component_of:
   "path_connectedin X (Collect (path_component_of X x))"
 proof -
   have "\<And>y. path_component_of X x y
         \<Longrightarrow> path_component_of (subtopology X (Collect (path_component_of X x))) x y"
     by (meson path_component_of path_component_of_maximal path_connectedin_subtopology)
   then show ?thesis
     apply (simp add: path_connectedin_def path_component_of_subset_topspace path_connected_space_iff_path_component)
     by (metis Int_absorb1 mem_Collect_eq path_component_of_equiv path_component_of_subset_topspace topspace_subtopology)
 qed
 
 lemma path_connectedin_euclidean [simp]:
    "path_connectedin euclidean S \<longleftrightarrow> path_connected S"
   by (auto simp: path_connectedin_def path_connected_space_iff_path_component path_connected_component)
 
 lemma path_connected_space_euclidean_subtopology [simp]:
    "path_connected_space(subtopology euclidean S) \<longleftrightarrow> path_connected S"
   using path_connectedin_topspace by force
 
 lemma Union_path_components_of:
      "\<Union>(path_components_of X) = topspace X"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_components_of_maximal:
    "\<lbrakk>C \<in> path_components_of X; path_connectedin X S; ~disjnt C S\<rbrakk> \<Longrightarrow> S \<subseteq> C"
   apply (auto simp: path_components_of_def path_component_of_equiv)
   using path_component_of_maximal path_connectedin_def apply fastforce
   by (meson disjnt_subset2 path_component_of_disjoint path_component_of_equiv path_component_of_maximal)
 
 lemma pairwise_disjoint_path_components_of:
      "pairwise disjnt (path_components_of X)"
   by (auto simp: path_components_of_def pairwise_def path_component_of_disjoint path_component_of_equiv)
 
 lemma complement_path_components_of_Union:
    "C \<in> path_components_of X
         \<Longrightarrow> topspace X - C = \<Union>(path_components_of X - {C})"
   by (metis Diff_cancel Diff_subset Union_path_components_of cSup_singleton diff_Union_pairwise_disjoint insert_subset pairwise_disjoint_path_components_of)
 
 lemma nonempty_path_components_of:
   "C \<in> path_components_of X \<Longrightarrow> (C \<noteq> {})"
   apply (clarsimp simp: path_components_of_def path_component_of_eq_empty)
   by (meson path_component_of_refl)
 
 lemma path_components_of_subset: "C \<in> path_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_connectedin_path_components_of:
    "C \<in> path_components_of X \<Longrightarrow> path_connectedin X C"
   by (auto simp: path_components_of_def path_connectedin_path_component_of)
 
 lemma path_component_in_path_components_of:
   "Collect (path_component_of X a) \<in> path_components_of X \<longleftrightarrow> a \<in> topspace X"
   apply (rule iffI)
   using nonempty_path_components_of path_component_of_eq_empty apply fastforce
   by (simp add: path_components_of_def)
 
 lemma path_connectedin_Union:
   assumes \<A>: "\<And>S. S \<in> \<A> \<Longrightarrow> path_connectedin X S" "\<Inter>\<A> \<noteq> {}"
   shows "path_connectedin X (\<Union>\<A>)"
 proof -
   obtain a where "\<And>S. S \<in> \<A> \<Longrightarrow> a \<in> S"
     using assms by blast
   then have "\<And>x. x \<in> topspace (subtopology X (\<Union>\<A>)) \<Longrightarrow> path_component_of (subtopology X (\<Union>\<A>)) a x"
-    apply (simp add: topspace_subtopology)
+    apply (simp)
     by (meson Union_upper \<A> path_component_of path_connectedin_subtopology)
   then show ?thesis
     using \<A> unfolding path_connectedin_def
     by (metis Sup_le_iff path_component_of_equiv path_connected_space_iff_path_component)
 qed
 
 lemma path_connectedin_Un:
    "\<lbrakk>path_connectedin X S; path_connectedin X T; S \<inter> T \<noteq> {}\<rbrakk>
     \<Longrightarrow> path_connectedin X (S \<union> T)"
   by (blast intro: path_connectedin_Union [of "{S,T}", simplified])
 
 lemma path_connected_space_iff_components_eq:
   "path_connected_space X \<longleftrightarrow>
     (\<forall>C \<in> path_components_of X. \<forall>C' \<in> path_components_of X. C = C')"
   unfolding path_components_of_def
 proof (intro iffI ballI)
   assume "\<forall>C \<in> path_component_of_set X ` topspace X.
              \<forall>C' \<in> path_component_of_set X ` topspace X. C = C'"
   then show "path_connected_space X"
     using path_component_of_refl path_connected_space_iff_path_component by fastforce
 qed (auto simp: path_connected_space_path_component_set)
 
 lemma path_components_of_eq_empty:
    "path_components_of X = {} \<longleftrightarrow> topspace X = {}"
   using Union_path_components_of nonempty_path_components_of by fastforce
 
 lemma path_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> path_components_of X = {}"
   by (simp add: path_components_of_eq_empty)
 
 lemma path_components_of_subset_singleton:
   "path_components_of X \<subseteq> {S} \<longleftrightarrow>
         path_connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (auto simp: path_components_of_empty_space path_connected_space_topspace_empty)
 next
   case False
   have "(path_components_of X = {S}) \<longleftrightarrow> (path_connected_space X \<and> topspace X = S)"
   proof (intro iffI conjI)
     assume L: "path_components_of X = {S}"
     then show "path_connected_space X"
       by (simp add: path_connected_space_iff_components_eq)
     show "topspace X = S"
       by (metis L ccpo_Sup_singleton [of S] Union_path_components_of)
   next
     assume R: "path_connected_space X \<and> topspace X = S"
     then show "path_components_of X = {S}"
       using ccpo_Sup_singleton [of S]
       by (metis False all_not_in_conv insert_iff mk_disjoint_insert path_component_in_path_components_of path_connected_space_iff_components_eq path_connected_space_path_component_set)
   qed
   with False show ?thesis
     by (simp add: path_components_of_eq_empty subset_singleton_iff)
 qed
 
 lemma path_connected_space_iff_components_subset_singleton:
    "path_connected_space X \<longleftrightarrow> (\<exists>a. path_components_of X \<subseteq> {a})"
   by (simp add: path_components_of_subset_singleton)
 
 lemma path_components_of_eq_singleton:
    "path_components_of X = {S} \<longleftrightarrow> path_connected_space X \<and> topspace X \<noteq> {} \<and> S = topspace X"
   by (metis cSup_singleton insert_not_empty path_components_of_subset_singleton subset_singleton_iff)
 
 lemma path_components_of_path_connected_space:
    "path_connected_space X \<Longrightarrow> path_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: path_components_of_eq_empty path_components_of_eq_singleton)
 
 lemma path_component_subset_connected_component_of:
    "path_component_of_set X x \<subseteq> connected_component_of_set X x"
 proof (cases "x \<in> topspace X")
   case True
   then show ?thesis
     by (simp add: connected_component_of_maximal path_component_of_refl path_connectedin_imp_connectedin path_connectedin_path_component_of)
 next
   case False
   then show ?thesis
     using path_component_of_eq_empty by fastforce
 qed
 
 lemma exists_path_component_of_superset:
   assumes S: "path_connectedin X S" and ne: "topspace X \<noteq> {}"
   obtains C where "C \<in> path_components_of X" "S \<subseteq> C"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using ne path_components_of_eq_empty that by fastforce
 next
   case False
   then obtain a where "a \<in> S"
     by blast
   show ?thesis
   proof
     show "Collect (path_component_of X a) \<in> path_components_of X"
       by (meson \<open>a \<in> S\<close> S subsetD path_component_in_path_components_of path_connectedin_subset_topspace)
     show "S \<subseteq> Collect (path_component_of X a)"
       by (simp add: S \<open>a \<in> S\<close> path_component_of_maximal)
   qed
 qed
 
 lemma path_component_of_eq_overlap:
    "path_component_of X x = path_component_of X y \<longleftrightarrow>
       (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
       Collect (path_component_of X x) \<inter> Collect (path_component_of X y) \<noteq> {}"
   by (metis disjnt_def empty_iff inf_bot_right mem_Collect_eq path_component_of_disjoint path_component_of_eq path_component_of_eq_empty)
 
 lemma path_component_of_nonoverlap:
    "Collect (path_component_of X x) \<inter> Collect (path_component_of X y) = {} \<longleftrightarrow>
     (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
     path_component_of X x \<noteq> path_component_of X y"
   by (metis inf.idem path_component_of_eq_empty path_component_of_eq_overlap)
 
 lemma path_component_of_overlap:
    "Collect (path_component_of X x) \<inter> Collect (path_component_of X y) \<noteq> {} \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> path_component_of X x = path_component_of X y"
   by (meson path_component_of_nonoverlap)
 
 lemma path_components_of_disjoint:
      "\<lbrakk>C \<in> path_components_of X; C' \<in> path_components_of X\<rbrakk> \<Longrightarrow> disjnt C C' \<longleftrightarrow> C \<noteq> C'"
   by (auto simp: path_components_of_def path_component_of_disjoint path_component_of_equiv)
 
 lemma path_components_of_overlap:
     "\<lbrakk>C \<in> path_components_of X; C' \<in> path_components_of X\<rbrakk> \<Longrightarrow> C \<inter> C' \<noteq> {} \<longleftrightarrow> C = C'"
   by (auto simp: path_components_of_def path_component_of_equiv)
 
 lemma path_component_of_unique:
    "\<lbrakk>x \<in> C; path_connectedin X C; \<And>C'. \<lbrakk>x \<in> C'; path_connectedin X C'\<rbrakk> \<Longrightarrow> C' \<subseteq> C\<rbrakk>
         \<Longrightarrow> Collect (path_component_of X x) = C"
   by (meson subsetD eq_iff path_component_of_maximal path_connectedin_path_component_of)
 
 lemma path_component_of_discrete_topology [simp]:
   "Collect (path_component_of (discrete_topology U) x) = (if x \<in> U then {x} else {})"
 proof -
   have "\<And>C'. \<lbrakk>x \<in> C'; path_connectedin (discrete_topology U) C'\<rbrakk> \<Longrightarrow> C' \<subseteq> {x}"
     by (metis path_connectedin_discrete_topology subsetD singletonD)
   then have "x \<in> U \<Longrightarrow> Collect (path_component_of (discrete_topology U) x) = {x}"
     by (simp add: path_component_of_unique)
   then show ?thesis
     using path_component_in_topspace by fastforce
 qed
 
 lemma path_component_of_discrete_topology_iff [simp]:
   "path_component_of (discrete_topology U) x y \<longleftrightarrow> x \<in> U \<and> y=x"
   by (metis empty_iff insertI1 mem_Collect_eq path_component_of_discrete_topology singletonD)
 
 lemma path_components_of_discrete_topology [simp]:
    "path_components_of (discrete_topology U) = (\<lambda>x. {x}) ` U"
   by (auto simp: path_components_of_def image_def fun_eq_iff)
 
 lemma homeomorphic_map_path_component_of:
   assumes f: "homeomorphic_map X Y f" and x: "x \<in> topspace X"
   shows "Collect (path_component_of Y (f x)) = f ` Collect(path_component_of X x)"
 proof -
   obtain g where g: "homeomorphic_maps X Y f g"
     using f homeomorphic_map_maps by blast
   show ?thesis
   proof
     have "Collect (path_component_of Y (f x)) \<subseteq> topspace Y"
       by (simp add: path_component_of_subset_topspace)
     moreover have "g ` Collect(path_component_of Y (f x)) \<subseteq> Collect (path_component_of X (g (f x)))"
       using g x unfolding homeomorphic_maps_def
       by (metis f homeomorphic_imp_surjective_map imageI mem_Collect_eq path_component_of_maximal path_component_of_refl path_connectedin_continuous_map_image path_connectedin_path_component_of)
     ultimately show "Collect (path_component_of Y (f x)) \<subseteq> f ` Collect (path_component_of X x)"
       using g x unfolding homeomorphic_maps_def continuous_map_def image_iff subset_iff
       by metis
     show "f ` Collect (path_component_of X x) \<subseteq> Collect (path_component_of Y (f x))"
     proof (rule path_component_of_maximal)
       show "path_connectedin Y (f ` Collect (path_component_of X x))"
         by (meson f homeomorphic_map_path_connectedness_eq path_connectedin_path_component_of)
     qed (simp add: path_component_of_refl x)
   qed
 qed
 
 lemma homeomorphic_map_path_components_of:
   assumes "homeomorphic_map X Y f"
   shows "path_components_of Y = (image f) ` (path_components_of X)"
   unfolding path_components_of_def homeomorphic_imp_surjective_map [OF assms, symmetric]
   apply safe
   using assms homeomorphic_map_path_component_of apply fastforce
   by (metis assms homeomorphic_map_path_component_of imageI)
 
 
 subsection \<open>Sphere is path-connected\<close>
 
 lemma path_connected_punctured_universe:
   assumes "2 \<le> DIM('a::euclidean_space)"
   shows "path_connected (- {a::'a})"
 proof -
   let ?A = "{x::'a. \<exists>i\<in>Basis. x \<bullet> i < a \<bullet> i}"
   let ?B = "{x::'a. \<exists>i\<in>Basis. a \<bullet> i < x \<bullet> i}"
 
   have A: "path_connected ?A"
     unfolding Collect_bex_eq
   proof (rule path_connected_UNION)
     fix i :: 'a
     assume "i \<in> Basis"
     then show "(\<Sum>i\<in>Basis. (a \<bullet> i - 1)*\<^sub>R i) \<in> {x::'a. x \<bullet> i < a \<bullet> i}"
       by simp
     show "path_connected {x. x \<bullet> i < a \<bullet> i}"
       using convex_imp_path_connected [OF convex_halfspace_lt, of i "a \<bullet> i"]
       by (simp add: inner_commute)
   qed
   have B: "path_connected ?B"
     unfolding Collect_bex_eq
   proof (rule path_connected_UNION)
     fix i :: 'a
     assume "i \<in> Basis"
     then show "(\<Sum>i\<in>Basis. (a \<bullet> i + 1) *\<^sub>R i) \<in> {x::'a. a \<bullet> i < x \<bullet> i}"
       by simp
     show "path_connected {x. a \<bullet> i < x \<bullet> i}"
       using convex_imp_path_connected [OF convex_halfspace_gt, of "a \<bullet> i" i]
       by (simp add: inner_commute)
   qed
   obtain S :: "'a set" where "S \<subseteq> Basis" and "card S = Suc (Suc 0)"
     using ex_card[OF assms]
     by auto
   then obtain b0 b1 :: 'a where "b0 \<in> Basis" and "b1 \<in> Basis" and "b0 \<noteq> b1"
     unfolding card_Suc_eq by auto
   then have "a + b0 - b1 \<in> ?A \<inter> ?B"
     by (auto simp: inner_simps inner_Basis)
   then have "?A \<inter> ?B \<noteq> {}"
     by fast
   with A B have "path_connected (?A \<union> ?B)"
     by (rule path_connected_Un)
   also have "?A \<union> ?B = {x. \<exists>i\<in>Basis. x \<bullet> i \<noteq> a \<bullet> i}"
     unfolding neq_iff bex_disj_distrib Collect_disj_eq ..
   also have "\<dots> = {x. x \<noteq> a}"
     unfolding euclidean_eq_iff [where 'a='a]
     by (simp add: Bex_def)
   also have "\<dots> = - {a}"
     by auto
   finally show ?thesis .
 qed
 
 corollary connected_punctured_universe:
   "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> connected(- {a::'N})"
   by (simp add: path_connected_punctured_universe path_connected_imp_connected)
 
 proposition path_connected_sphere:
   fixes a :: "'a :: euclidean_space"
   assumes "2 \<le> DIM('a)"
   shows "path_connected(sphere a r)"
 proof (cases r "0::real" rule: linorder_cases)
   case less
   then show ?thesis
-    by (simp add: path_connected_empty)
+    by (simp)
 next
   case equal
   then show ?thesis
-    by (simp add: path_connected_singleton)
+    by (simp)
 next
   case greater
   then have eq: "(sphere (0::'a) r) = (\<lambda>x. (r / norm x) *\<^sub>R x) ` (- {0::'a})"
     by (force simp: image_iff split: if_split_asm)
   have "continuous_on (- {0::'a}) (\<lambda>x. (r / norm x) *\<^sub>R x)"
     by (intro continuous_intros) auto
   then have "path_connected ((\<lambda>x. (r / norm x) *\<^sub>R x) ` (- {0::'a}))"
     by (intro path_connected_continuous_image path_connected_punctured_universe assms)
   with eq have "path_connected (sphere (0::'a) r)"
     by auto
   then have "path_connected((+) a ` (sphere (0::'a) r))"
     by (simp add: path_connected_translation)
   then show ?thesis
     by (metis add.right_neutral sphere_translation)
 qed
 
 lemma connected_sphere:
     fixes a :: "'a :: euclidean_space"
     assumes "2 \<le> DIM('a)"
       shows "connected(sphere a r)"
   using path_connected_sphere [OF assms]
   by (simp add: path_connected_imp_connected)
 
 
 corollary path_connected_complement_bounded_convex:
     fixes s :: "'a :: euclidean_space set"
     assumes "bounded s" "convex s" and 2: "2 \<le> DIM('a)"
     shows "path_connected (- s)"
 proof (cases "s = {}")
   case True then show ?thesis
     using convex_imp_path_connected by auto
 next
   case False
   then obtain a where "a \<in> s" by auto
   { fix x y assume "x \<notin> s" "y \<notin> s"
     then have "x \<noteq> a" "y \<noteq> a" using \<open>a \<in> s\<close> by auto
     then have bxy: "bounded(insert x (insert y s))"
       by (simp add: \<open>bounded s\<close>)
     then obtain B::real where B: "0 < B" and Bx: "norm (a - x) < B" and By: "norm (a - y) < B"
                           and "s \<subseteq> ball a B"
       using bounded_subset_ballD [OF bxy, of a] by (auto simp: dist_norm)
     define C where "C = B / norm(x - a)"
     { fix u
       assume u: "(1 - u) *\<^sub>R x + u *\<^sub>R (a + C *\<^sub>R (x - a)) \<in> s" and "0 \<le> u" "u \<le> 1"
       have CC: "1 \<le> 1 + (C - 1) * u"
         using \<open>x \<noteq> a\<close> \<open>0 \<le> u\<close> Bx
         by (auto simp add: C_def norm_minus_commute)
       have *: "\<And>v. (1 - u) *\<^sub>R x + u *\<^sub>R (a + v *\<^sub>R (x - a)) = a + (1 + (v - 1) * u) *\<^sub>R (x - a)"
         by (simp add: algebra_simps)
       have "a + ((1 / (1 + C * u - u)) *\<^sub>R x + ((u / (1 + C * u - u)) *\<^sub>R a + (C * u / (1 + C * u - u)) *\<^sub>R x)) =
             (1 + (u / (1 + C * u - u))) *\<^sub>R a + ((1 / (1 + C * u - u)) + (C * u / (1 + C * u - u))) *\<^sub>R x"
         by (simp add: algebra_simps)
       also have "\<dots> = (1 + (u / (1 + C * u - u))) *\<^sub>R a + (1 + (u / (1 + C * u - u))) *\<^sub>R x"
         using CC by (simp add: field_simps)
       also have "\<dots> = x + (1 + (u / (1 + C * u - u))) *\<^sub>R a + (u / (1 + C * u - u)) *\<^sub>R x"
         by (simp add: algebra_simps)
       also have "\<dots> = x + ((1 / (1 + C * u - u)) *\<^sub>R a +
               ((u / (1 + C * u - u)) *\<^sub>R x + (C * u / (1 + C * u - u)) *\<^sub>R a))"
         using CC by (simp add: field_simps) (simp add: add_divide_distrib scaleR_add_left)
       finally have xeq: "(1 - 1 / (1 + (C - 1) * u)) *\<^sub>R a + (1 / (1 + (C - 1) * u)) *\<^sub>R (a + (1 + (C - 1) * u) *\<^sub>R (x - a)) = x"
         by (simp add: algebra_simps)
       have False
         using \<open>convex s\<close>
         apply (simp add: convex_alt)
         apply (drule_tac x=a in bspec)
          apply (rule  \<open>a \<in> s\<close>)
         apply (drule_tac x="a + (1 + (C - 1) * u) *\<^sub>R (x - a)" in bspec)
          using u apply (simp add: *)
         apply (drule_tac x="1 / (1 + (C - 1) * u)" in spec)
         using \<open>x \<noteq> a\<close> \<open>x \<notin> s\<close> \<open>0 \<le> u\<close> CC
         apply (auto simp: xeq)
         done
     }
     then have pcx: "path_component (- s) x (a + C *\<^sub>R (x - a))"
       by (force simp: closed_segment_def intro!: path_component_linepath)
     define D where "D = B / norm(y - a)"  \<comment> \<open>massive duplication with the proof above\<close>
     { fix u
       assume u: "(1 - u) *\<^sub>R y + u *\<^sub>R (a + D *\<^sub>R (y - a)) \<in> s" and "0 \<le> u" "u \<le> 1"
       have DD: "1 \<le> 1 + (D - 1) * u"
         using \<open>y \<noteq> a\<close> \<open>0 \<le> u\<close> By
         by (auto simp add: D_def norm_minus_commute)
       have *: "\<And>v. (1 - u) *\<^sub>R y + u *\<^sub>R (a + v *\<^sub>R (y - a)) = a + (1 + (v - 1) * u) *\<^sub>R (y - a)"
         by (simp add: algebra_simps)
       have "a + ((1 / (1 + D * u - u)) *\<^sub>R y + ((u / (1 + D * u - u)) *\<^sub>R a + (D * u / (1 + D * u - u)) *\<^sub>R y)) =
             (1 + (u / (1 + D * u - u))) *\<^sub>R a + ((1 / (1 + D * u - u)) + (D * u / (1 + D * u - u))) *\<^sub>R y"
         by (simp add: algebra_simps)
       also have "\<dots> = (1 + (u / (1 + D * u - u))) *\<^sub>R a + (1 + (u / (1 + D * u - u))) *\<^sub>R y"
         using DD by (simp add: field_simps)
       also have "\<dots> = y + (1 + (u / (1 + D * u - u))) *\<^sub>R a + (u / (1 + D * u - u)) *\<^sub>R y"
         by (simp add: algebra_simps)
       also have "\<dots> = y + ((1 / (1 + D * u - u)) *\<^sub>R a +
               ((u / (1 + D * u - u)) *\<^sub>R y + (D * u / (1 + D * u - u)) *\<^sub>R a))"
         using DD by (simp add: field_simps) (simp add: add_divide_distrib scaleR_add_left)
       finally have xeq: "(1 - 1 / (1 + (D - 1) * u)) *\<^sub>R a + (1 / (1 + (D - 1) * u)) *\<^sub>R (a + (1 + (D - 1) * u) *\<^sub>R (y - a)) = y"
         by (simp add: algebra_simps)
       have False
         using \<open>convex s\<close>
         apply (simp add: convex_alt)
         apply (drule_tac x=a in bspec)
          apply (rule  \<open>a \<in> s\<close>)
         apply (drule_tac x="a + (1 + (D - 1) * u) *\<^sub>R (y - a)" in bspec)
          using u apply (simp add: *)
         apply (drule_tac x="1 / (1 + (D - 1) * u)" in spec)
         using \<open>y \<noteq> a\<close> \<open>y \<notin> s\<close> \<open>0 \<le> u\<close> DD
         apply (auto simp: xeq)
         done
     }
     then have pdy: "path_component (- s) y (a + D *\<^sub>R (y - a))"
       by (force simp: closed_segment_def intro!: path_component_linepath)
     have pyx: "path_component (- s) (a + D *\<^sub>R (y - a)) (a + C *\<^sub>R (x - a))"
       apply (rule path_component_of_subset [of "sphere a B"])
        using \<open>s \<subseteq> ball a B\<close>
        apply (force simp: ball_def dist_norm norm_minus_commute)
       apply (rule path_connected_sphere [OF 2, of a B, simplified path_connected_component, rule_format])
        using \<open>x \<noteq> a\<close>  using \<open>y \<noteq> a\<close>  B apply (auto simp: dist_norm C_def D_def)
       done
     have "path_component (- s) x y"
       by (metis path_component_trans path_component_sym pcx pdy pyx)
   }
   then show ?thesis
     by (auto simp: path_connected_component)
 qed
 
 lemma connected_complement_bounded_convex:
     fixes s :: "'a :: euclidean_space set"
     assumes "bounded s" "convex s" "2 \<le> DIM('a)"
       shows  "connected (- s)"
   using path_connected_complement_bounded_convex [OF assms] path_connected_imp_connected by blast
 
 lemma connected_diff_ball:
     fixes s :: "'a :: euclidean_space set"
     assumes "connected s" "cball a r \<subseteq> s" "2 \<le> DIM('a)"
       shows "connected (s - ball a r)"
   apply (rule connected_diff_open_from_closed [OF ball_subset_cball])
   using assms connected_sphere
   apply (auto simp: cball_diff_eq_sphere dist_norm)
   done
 
 proposition connected_open_delete:
   assumes "open S" "connected S" and 2: "2 \<le> DIM('N::euclidean_space)"
     shows "connected(S - {a::'N})"
 proof (cases "a \<in> S")
   case True
   with \<open>open S\<close> obtain \<epsilon> where "\<epsilon> > 0" and \<epsilon>: "cball a \<epsilon> \<subseteq> S"
     using open_contains_cball_eq by blast
   have "dist a (a + \<epsilon> *\<^sub>R (SOME i. i \<in> Basis)) = \<epsilon>"
     by (simp add: dist_norm SOME_Basis \<open>0 < \<epsilon>\<close> less_imp_le)
   with \<epsilon> have "\<Inter>{S - ball a r |r. 0 < r \<and> r < \<epsilon>} \<subseteq> {} \<Longrightarrow> False"
     apply (drule_tac c="a + scaleR (\<epsilon>) ((SOME i. i \<in> Basis))" in subsetD)
     by auto
   then have nonemp: "(\<Inter>{S - ball a r |r. 0 < r \<and> r < \<epsilon>}) = {} \<Longrightarrow> False"
     by auto
   have con: "\<And>r. r < \<epsilon> \<Longrightarrow> connected (S - ball a r)"
     using \<epsilon> by (force intro: connected_diff_ball [OF \<open>connected S\<close> _ 2])
   have "x \<in> \<Union>{S - ball a r |r. 0 < r \<and> r < \<epsilon>}" if "x \<in> S - {a}" for x
     apply (rule UnionI [of "S - ball a (min \<epsilon> (dist a x) / 2)"])
      using that \<open>0 < \<epsilon>\<close> apply simp_all
     apply (rule_tac x="min \<epsilon> (dist a x) / 2" in exI)
     apply auto
     done
   then have "S - {a} = \<Union>{S - ball a r | r. 0 < r \<and> r < \<epsilon>}"
     by auto
   then show ?thesis
     by (auto intro: connected_Union con dest!: nonemp)
 next
   case False then show ?thesis
     by (simp add: \<open>connected S\<close>)
 qed
 
 corollary path_connected_open_delete:
   assumes "open S" "connected S" and 2: "2 \<le> DIM('N::euclidean_space)"
     shows "path_connected(S - {a::'N})"
 by (simp add: assms connected_open_delete connected_open_path_connected open_delete)
 
 corollary path_connected_punctured_ball:
    "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> path_connected(ball a r - {a::'N})"
 by (simp add: path_connected_open_delete)
 
 corollary connected_punctured_ball:
    "2 \<le> DIM('N::euclidean_space) \<Longrightarrow> connected(ball a r - {a::'N})"
 by (simp add: connected_open_delete)
 
 corollary connected_open_delete_finite:
   fixes S T::"'a::euclidean_space set"
   assumes S: "open S" "connected S" and 2: "2 \<le> DIM('a)" and "finite T"
   shows "connected(S - T)"
   using \<open>finite T\<close> S
 proof (induct T)
   case empty
   show ?case using \<open>connected S\<close> by simp
 next
   case (insert x F)
   then have "connected (S-F)" by auto
   moreover have "open (S - F)" using finite_imp_closed[OF \<open>finite F\<close>] \<open>open S\<close> by auto
   ultimately have "connected (S - F - {x})" using connected_open_delete[OF _ _ 2] by auto
   thus ?case by (metis Diff_insert)
 qed
 
 lemma sphere_1D_doubleton_zero:
   assumes 1: "DIM('a) = 1" and "r > 0"
   obtains x y::"'a::euclidean_space"
     where "sphere 0 r = {x,y} \<and> dist x y = 2*r"
 proof -
   obtain b::'a where b: "Basis = {b}"
     using 1 card_1_singletonE by blast
   show ?thesis
   proof (intro that conjI)
     have "x = norm x *\<^sub>R b \<or> x = - norm x *\<^sub>R b" if "r = norm x" for x
     proof -
       have xb: "(x \<bullet> b) *\<^sub>R b = x"
         using euclidean_representation [of x, unfolded b] by force
       then have "norm ((x \<bullet> b) *\<^sub>R b) = norm x"
         by simp
       with b have "\<bar>x \<bullet> b\<bar> = norm x"
         using norm_Basis by (simp add: b)
       with xb show ?thesis
         apply (simp add: abs_if split: if_split_asm)
         apply (metis add.inverse_inverse real_vector.scale_minus_left xb)
         done
     qed
     with \<open>r > 0\<close> b show "sphere 0 r = {r *\<^sub>R b, - r *\<^sub>R b}"
       by (force simp: sphere_def dist_norm)
     have "dist (r *\<^sub>R b) (- r *\<^sub>R b) = norm (r *\<^sub>R b + r *\<^sub>R b)"
       by (simp add: dist_norm)
     also have "\<dots> = norm ((2*r) *\<^sub>R b)"
       by (metis mult_2 scaleR_add_left)
     also have "\<dots> = 2*r"
       using \<open>r > 0\<close> b norm_Basis by fastforce
     finally show "dist (r *\<^sub>R b) (- r *\<^sub>R b) = 2*r" .
   qed
 qed
 
 lemma sphere_1D_doubleton:
   fixes a :: "'a :: euclidean_space"
   assumes "DIM('a) = 1" and "r > 0"
   obtains x y where "sphere a r = {x,y} \<and> dist x y = 2*r"
 proof -
   have "sphere a r = (+) a ` sphere 0 r"
     by (metis add.right_neutral sphere_translation)
   then show ?thesis
     using sphere_1D_doubleton_zero [OF assms]
     by (metis (mono_tags, lifting) dist_add_cancel image_empty image_insert that)
 qed
 
 lemma psubset_sphere_Compl_connected:
   fixes S :: "'a::euclidean_space set"
   assumes S: "S \<subset> sphere a r" and "0 < r" and 2: "2 \<le> DIM('a)"
   shows "connected(- S)"
 proof -
   have "S \<subseteq> sphere a r"
     using S by blast
   obtain b where "dist a b = r" and "b \<notin> S"
     using S mem_sphere by blast
   have CS: "- S = {x. dist a x \<le> r \<and> (x \<notin> S)} \<union> {x. r \<le> dist a x \<and> (x \<notin> S)}"
     by auto
   have "{x. dist a x \<le> r \<and> x \<notin> S} \<inter> {x. r \<le> dist a x \<and> x \<notin> S} \<noteq> {}"
     using \<open>b \<notin> S\<close> \<open>dist a b = r\<close> by blast
   moreover have "connected {x. dist a x \<le> r \<and> x \<notin> S}"
     apply (rule connected_intermediate_closure [of "ball a r"])
     using assms by auto
   moreover
   have "connected {x. r \<le> dist a x \<and> x \<notin> S}"
     apply (rule connected_intermediate_closure [of "- cball a r"])
     using assms apply (auto intro: connected_complement_bounded_convex)
     apply (metis ComplI interior_cball interior_closure mem_ball not_less)
     done
   ultimately show ?thesis
     by (simp add: CS connected_Un)
 qed
 
 
 subsection\<open>Every annulus is a connected set\<close>
 
 lemma path_connected_2DIM_I:
   fixes a :: "'N::euclidean_space"
   assumes 2: "2 \<le> DIM('N)" and pc: "path_connected {r. 0 \<le> r \<and> P r}"
   shows "path_connected {x. P(norm(x - a))}"
 proof -
   have "{x. P(norm(x - a))} = (+) a ` {x. P(norm x)}"
     by force
   moreover have "path_connected {x::'N. P(norm x)}"
   proof -
     let ?D = "{x. 0 \<le> x \<and> P x} \<times> sphere (0::'N) 1"
     have "x \<in> (\<lambda>z. fst z *\<^sub>R snd z) ` ?D"
       if "P (norm x)" for x::'N
     proof (cases "x=0")
       case True
       with that show ?thesis
         apply (simp add: image_iff)
         apply (rule_tac x=0 in exI, simp)
         using vector_choose_size zero_le_one by blast
     next
       case False
       with that show ?thesis
         by (rule_tac x="(norm x, x /\<^sub>R norm x)" in image_eqI) auto
     qed
     then have *: "{x::'N. P(norm x)} =  (\<lambda>z. fst z *\<^sub>R snd z) ` ?D"
       by auto
     have "continuous_on ?D (\<lambda>z:: real\<times>'N. fst z *\<^sub>R snd z)"
       by (intro continuous_intros)
     moreover have "path_connected ?D"
       by (metis path_connected_Times [OF pc] path_connected_sphere 2)
     ultimately show ?thesis
       apply (subst *)
       apply (rule path_connected_continuous_image, auto)
       done
   qed
   ultimately show ?thesis
     using path_connected_translation by metis
 qed
 
 proposition path_connected_annulus:
   fixes a :: "'N::euclidean_space"
   assumes "2 \<le> DIM('N)"
   shows "path_connected {x. r1 < norm(x - a) \<and> norm(x - a) < r2}"
         "path_connected {x. r1 < norm(x - a) \<and> norm(x - a) \<le> r2}"
         "path_connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) < r2}"
         "path_connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) \<le> r2}"
   by (auto simp: is_interval_def intro!: is_interval_convex convex_imp_path_connected path_connected_2DIM_I [OF assms])
 
 proposition connected_annulus:
   fixes a :: "'N::euclidean_space"
   assumes "2 \<le> DIM('N::euclidean_space)"
   shows "connected {x. r1 < norm(x - a) \<and> norm(x - a) < r2}"
         "connected {x. r1 < norm(x - a) \<and> norm(x - a) \<le> r2}"
         "connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) < r2}"
         "connected {x. r1 \<le> norm(x - a) \<and> norm(x - a) \<le> r2}"
   by (auto simp: path_connected_annulus [OF assms] path_connected_imp_connected)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Relations between components and path components\<close>
 
 lemma open_connected_component:
   fixes s :: "'a::real_normed_vector set"
   shows "open s \<Longrightarrow> open (connected_component_set s x)"
     apply (simp add: open_contains_ball, clarify)
     apply (rename_tac y)
     apply (drule_tac x=y in bspec)
      apply (simp add: connected_component_in, clarify)
     apply (rule_tac x=e in exI)
     by (metis mem_Collect_eq connected_component_eq connected_component_maximal centre_in_ball connected_ball)
 
 corollary open_components:
     fixes s :: "'a::real_normed_vector set"
     shows "\<lbrakk>open u; s \<in> components u\<rbrakk> \<Longrightarrow> open s"
   by (simp add: components_iff) (metis open_connected_component)
 
 lemma in_closure_connected_component:
   fixes s :: "'a::real_normed_vector set"
   assumes x: "x \<in> s" and s: "open s"
   shows "x \<in> closure (connected_component_set s y) \<longleftrightarrow>  x \<in> connected_component_set s y"
 proof -
   { assume "x \<in> closure (connected_component_set s y)"
     moreover have "x \<in> connected_component_set s x"
       using x by simp
     ultimately have "x \<in> connected_component_set s y"
       using s by (meson Compl_disjoint closure_iff_nhds_not_empty connected_component_disjoint disjoint_eq_subset_Compl open_connected_component)
   }
   then show ?thesis
     by (auto simp: closure_def)
 qed
 
 lemma connected_disjoint_Union_open_pick:
   assumes "pairwise disjnt B"
           "\<And>S. S \<in> A \<Longrightarrow> connected S \<and> S \<noteq> {}"
           "\<And>S. S \<in> B \<Longrightarrow> open S"
           "\<Union>A \<subseteq> \<Union>B"
           "S \<in> A"
   obtains T where "T \<in> B" "S \<subseteq> T" "S \<inter> \<Union>(B - {T}) = {}"
 proof -
   have "S \<subseteq> \<Union>B" "connected S" "S \<noteq> {}"
     using assms \<open>S \<in> A\<close> by blast+
   then obtain T where "T \<in> B" "S \<inter> T \<noteq> {}"
     by (metis Sup_inf_eq_bot_iff inf.absorb_iff2 inf_commute)
   have 1: "open T" by (simp add: \<open>T \<in> B\<close> assms)
   have 2: "open (\<Union>(B-{T}))" using assms by blast
   have 3: "S \<subseteq> T \<union> \<Union>(B - {T})" using \<open>S \<subseteq> \<Union>B\<close> by blast
   have "T \<inter> \<Union>(B - {T}) = {}" using \<open>T \<in> B\<close> \<open>pairwise disjnt B\<close>
     by (auto simp: pairwise_def disjnt_def)
   then have 4: "T \<inter> \<Union>(B - {T}) \<inter> S = {}" by auto
   from connectedD [OF \<open>connected S\<close> 1 2 3 4]
   have "S \<inter> \<Union>(B-{T}) = {}"
     by (auto simp: Int_commute \<open>S \<inter> T \<noteq> {}\<close>)
   with \<open>T \<in> B\<close> have "S \<subseteq> T"
     using "3" by auto
   show ?thesis
     using \<open>S \<inter> \<Union>(B - {T}) = {}\<close> \<open>S \<subseteq> T\<close> \<open>T \<in> B\<close> that by auto
 qed
 
 lemma connected_disjoint_Union_open_subset:
   assumes A: "pairwise disjnt A" and B: "pairwise disjnt B"
       and SA: "\<And>S. S \<in> A \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and SB: "\<And>S. S \<in> B \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and eq [simp]: "\<Union>A = \<Union>B"
     shows "A \<subseteq> B"
 proof
   fix S
   assume "S \<in> A"
   obtain T where "T \<in> B" "S \<subseteq> T" "S \<inter> \<Union>(B - {T}) = {}"
       apply (rule connected_disjoint_Union_open_pick [OF B, of A])
       using SA SB \<open>S \<in> A\<close> by auto
   moreover obtain S' where "S' \<in> A" "T \<subseteq> S'" "T \<inter> \<Union>(A - {S'}) = {}"
       apply (rule connected_disjoint_Union_open_pick [OF A, of B])
       using SA SB \<open>T \<in> B\<close> by auto
   ultimately have "S' = S"
     by (metis A Int_subset_iff SA \<open>S \<in> A\<close> disjnt_def inf.orderE pairwise_def)
   with \<open>T \<subseteq> S'\<close> have "T \<subseteq> S" by simp
   with \<open>S \<subseteq> T\<close> have "S = T" by blast
   with \<open>T \<in> B\<close> show "S \<in> B" by simp
 qed
 
 lemma connected_disjoint_Union_open_unique:
   assumes A: "pairwise disjnt A" and B: "pairwise disjnt B"
       and SA: "\<And>S. S \<in> A \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and SB: "\<And>S. S \<in> B \<Longrightarrow> open S \<and> connected S \<and> S \<noteq> {}"
       and eq [simp]: "\<Union>A = \<Union>B"
     shows "A = B"
 by (rule subset_antisym; metis connected_disjoint_Union_open_subset assms)
 
 proposition components_open_unique:
  fixes S :: "'a::real_normed_vector set"
   assumes "pairwise disjnt A" "\<Union>A = S"
           "\<And>X. X \<in> A \<Longrightarrow> open X \<and> connected X \<and> X \<noteq> {}"
     shows "components S = A"
 proof -
   have "open S" using assms by blast
   show ?thesis
     apply (rule connected_disjoint_Union_open_unique)
     apply (simp add: components_eq disjnt_def pairwise_def)
     using \<open>open S\<close>
     apply (simp_all add: assms open_components in_components_connected in_components_nonempty)
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Existence of unbounded components\<close>
 
 lemma cobounded_unbounded_component:
     fixes s :: "'a :: euclidean_space set"
     assumes "bounded (-s)"
       shows "\<exists>x. x \<in> s \<and> \<not> bounded (connected_component_set s x)"
 proof -
   obtain i::'a where i: "i \<in> Basis"
     using nonempty_Basis by blast
   obtain B where B: "B>0" "-s \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF assms, of 0] by auto
   then have *: "\<And>x. B \<le> norm x \<Longrightarrow> x \<in> s"
     by (force simp: ball_def dist_norm)
   have unbounded_inner: "\<not> bounded {x. inner i x \<ge> B}"
     apply (auto simp: bounded_def dist_norm)
     apply (rule_tac x="x + (max B e + 1 + \<bar>i \<bullet> x\<bar>) *\<^sub>R i" in exI)
     apply simp
     using i
     apply (auto simp: algebra_simps)
     done
   have **: "{x. B \<le> i \<bullet> x} \<subseteq> connected_component_set s (B *\<^sub>R i)"
     apply (rule connected_component_maximal)
     apply (auto simp: i intro: convex_connected convex_halfspace_ge [of B])
     apply (rule *)
     apply (rule order_trans [OF _ Basis_le_norm [OF i]])
     by (simp add: inner_commute)
   have "B *\<^sub>R i \<in> s"
     by (rule *) (simp add: norm_Basis [OF i])
   then show ?thesis
     apply (rule_tac x="B *\<^sub>R i" in exI, clarify)
     apply (frule bounded_subset [of _ "{x. B \<le> i \<bullet> x}", OF _ **])
     using unbounded_inner apply blast
     done
 qed
 
 lemma cobounded_unique_unbounded_component:
     fixes s :: "'a :: euclidean_space set"
     assumes bs: "bounded (-s)" and "2 \<le> DIM('a)"
         and bo: "\<not> bounded(connected_component_set s x)"
                 "\<not> bounded(connected_component_set s y)"
       shows "connected_component_set s x = connected_component_set s y"
 proof -
   obtain i::'a where i: "i \<in> Basis"
     using nonempty_Basis by blast
   obtain B where B: "B>0" "-s \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF bs, of 0] by auto
   then have *: "\<And>x. B \<le> norm x \<Longrightarrow> x \<in> s"
     by (force simp: ball_def dist_norm)
   have ccb: "connected (- ball 0 B :: 'a set)"
     using assms by (auto intro: connected_complement_bounded_convex)
   obtain x' where x': "connected_component s x x'" "norm x' > B"
     using bo [unfolded bounded_def dist_norm, simplified, rule_format]
     by (metis diff_zero norm_minus_commute not_less)
   obtain y' where y': "connected_component s y y'" "norm y' > B"
     using bo [unfolded bounded_def dist_norm, simplified, rule_format]
     by (metis diff_zero norm_minus_commute not_less)
   have x'y': "connected_component s x' y'"
     apply (simp add: connected_component_def)
     apply (rule_tac x="- ball 0 B" in exI)
     using x' y'
     apply (auto simp: ccb dist_norm *)
     done
   show ?thesis
     apply (rule connected_component_eq)
     using x' y' x'y'
     by (metis (no_types, lifting) connected_component_eq_empty connected_component_eq_eq connected_component_idemp connected_component_in)
 qed
 
 lemma cobounded_unbounded_components:
     fixes s :: "'a :: euclidean_space set"
     shows "bounded (-s) \<Longrightarrow> \<exists>c. c \<in> components s \<and> \<not>bounded c"
   by (metis cobounded_unbounded_component components_def imageI)
 
 lemma cobounded_unique_unbounded_components:
     fixes s :: "'a :: euclidean_space set"
     shows  "\<lbrakk>bounded (- s); c \<in> components s; \<not> bounded c; c' \<in> components s; \<not> bounded c'; 2 \<le> DIM('a)\<rbrakk> \<Longrightarrow> c' = c"
   unfolding components_iff
   by (metis cobounded_unique_unbounded_component)
 
 lemma cobounded_has_bounded_component:
   fixes S :: "'a :: euclidean_space set"
   assumes "bounded (- S)" "\<not> connected S" "2 \<le> DIM('a)"
   obtains C where "C \<in> components S" "bounded C"
   by (meson cobounded_unique_unbounded_components connected_eq_connected_components_eq assms)
 
 
 subsection\<open>The \<open>inside\<close> and \<open>outside\<close> of a Set\<close>
 
 text\<^marker>\<open>tag important\<close>\<open>The inside comprises the points in a bounded connected component of the set's complement.
   The outside comprises the points in unbounded connected component of the complement.\<close>
 
 definition\<^marker>\<open>tag important\<close> inside where
   "inside S \<equiv> {x. (x \<notin> S) \<and> bounded(connected_component_set ( - S) x)}"
 
 definition\<^marker>\<open>tag important\<close> outside where
   "outside S \<equiv> -S \<inter> {x. \<not> bounded(connected_component_set (- S) x)}"
 
 lemma outside: "outside S = {x. \<not> bounded(connected_component_set (- S) x)}"
   by (auto simp: outside_def) (metis Compl_iff bounded_empty connected_component_eq_empty)
 
 lemma inside_no_overlap [simp]: "inside S \<inter> S = {}"
   by (auto simp: inside_def)
 
 lemma outside_no_overlap [simp]:
    "outside S \<inter> S = {}"
   by (auto simp: outside_def)
 
 lemma inside_Int_outside [simp]: "inside S \<inter> outside S = {}"
   by (auto simp: inside_def outside_def)
 
 lemma inside_Un_outside [simp]: "inside S \<union> outside S = (- S)"
   by (auto simp: inside_def outside_def)
 
 lemma inside_eq_outside:
    "inside S = outside S \<longleftrightarrow> S = UNIV"
   by (auto simp: inside_def outside_def)
 
 lemma inside_outside: "inside S = (- (S \<union> outside S))"
   by (force simp: inside_def outside)
 
 lemma outside_inside: "outside S = (- (S \<union> inside S))"
   by (auto simp: inside_outside) (metis IntI equals0D outside_no_overlap)
 
 lemma union_with_inside: "S \<union> inside S = - outside S"
   by (auto simp: inside_outside) (simp add: outside_inside)
 
 lemma union_with_outside: "S \<union> outside S = - inside S"
   by (simp add: inside_outside)
 
 lemma outside_mono: "S \<subseteq> T \<Longrightarrow> outside T \<subseteq> outside S"
   by (auto simp: outside bounded_subset connected_component_mono)
 
 lemma inside_mono: "S \<subseteq> T \<Longrightarrow> inside S - T \<subseteq> inside T"
   by (auto simp: inside_def bounded_subset connected_component_mono)
 
 lemma segment_bound_lemma:
   fixes u::real
   assumes "x \<ge> B" "y \<ge> B" "0 \<le> u" "u \<le> 1"
   shows "(1 - u) * x + u * y \<ge> B"
 proof -
   obtain dx dy where "dx \<ge> 0" "dy \<ge> 0" "x = B + dx" "y = B + dy"
     using assms by auto (metis add.commute diff_add_cancel)
   with \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> show ?thesis
     by (simp add: add_increasing2 mult_left_le field_simps)
 qed
 
 lemma cobounded_outside:
   fixes S :: "'a :: real_normed_vector set"
   assumes "bounded S" shows "bounded (- outside S)"
 proof -
   obtain B where B: "B>0" "S \<subseteq> ball 0 B"
     using bounded_subset_ballD [OF assms, of 0] by auto
   { fix x::'a and C::real
     assume Bno: "B \<le> norm x" and C: "0 < C"
     have "\<exists>y. connected_component (- S) x y \<and> norm y > C"
     proof (cases "x = 0")
       case True with B Bno show ?thesis by force
     next
       case False 
       have "closed_segment x (((B + C) / norm x) *\<^sub>R x) \<subseteq> - ball 0 B"
       proof
         fix w
         assume "w \<in> closed_segment x (((B + C) / norm x) *\<^sub>R x)"
         then obtain u where
           w: "w = (1 - u + u * (B + C) / norm x) *\<^sub>R x" "0 \<le> u" "u \<le> 1"
           by (auto simp add: closed_segment_def real_vector_class.scaleR_add_left [symmetric])
         with False B C have "B \<le> (1 - u) * norm x + u * (B + C)"
           using segment_bound_lemma [of B "norm x" "B + C" u] Bno
           by simp
         with False B C show "w \<in> - ball 0 B"
           using distrib_right [of _ _ "norm x"]
           by (simp add: ball_def w not_less)
       qed
       also have "... \<subseteq> -S"
         by (simp add: B)
       finally have "\<exists>T. connected T \<and> T \<subseteq> - S \<and> x \<in> T \<and> ((B + C) / norm x) *\<^sub>R x \<in> T"
         by (rule_tac x="closed_segment x (((B+C)/norm x) *\<^sub>R x)" in exI) simp
       with False B
       show ?thesis
         by (rule_tac x="((B+C)/norm x) *\<^sub>R x" in exI) (simp add: connected_component_def)
     qed
   }
   then show ?thesis
     apply (simp add: outside_def assms)
     apply (rule bounded_subset [OF bounded_ball [of 0 B]])
     apply (force simp: dist_norm not_less bounded_pos)
     done
 qed
 
 lemma unbounded_outside:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "bounded S \<Longrightarrow> \<not> bounded(outside S)"
   using cobounded_imp_unbounded cobounded_outside by blast
 
 lemma bounded_inside:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "bounded S \<Longrightarrow> bounded(inside S)"
   by (simp add: bounded_Int cobounded_outside inside_outside)
 
 lemma connected_outside:
     fixes S :: "'a::euclidean_space set"
     assumes "bounded S" "2 \<le> DIM('a)"
       shows "connected(outside S)"
   apply (clarsimp simp add: connected_iff_connected_component outside)
   apply (rule_tac s="connected_component_set (- S) x" in connected_component_of_subset)
   apply (metis (no_types) assms cobounded_unbounded_component cobounded_unique_unbounded_component connected_component_eq_eq connected_component_idemp double_complement mem_Collect_eq)
   apply clarify
   apply (metis connected_component_eq_eq connected_component_in)
   done
 
 lemma outside_connected_component_lt:
     "outside S = {x. \<forall>B. \<exists>y. B < norm(y) \<and> connected_component (- S) x y}"
 apply (auto simp: outside bounded_def dist_norm)
 apply (metis diff_0 norm_minus_cancel not_less)
 by (metis less_diff_eq norm_minus_commute norm_triangle_ineq2 order.trans pinf(6))
 
 lemma outside_connected_component_le:
    "outside S =
             {x. \<forall>B. \<exists>y. B \<le> norm(y) \<and>
                          connected_component (- S) x y}"
 apply (simp add: outside_connected_component_lt)
 apply (simp add: Set.set_eq_iff)
 by (meson gt_ex leD le_less_linear less_imp_le order.trans)
 
 lemma not_outside_connected_component_lt:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S" and "2 \<le> DIM('a)"
       shows "- (outside S) = {x. \<forall>B. \<exists>y. B < norm(y) \<and> \<not> connected_component (- S) x y}"
 proof -
   obtain B::real where B: "0 < B" and Bno: "\<And>x. x \<in> S \<Longrightarrow> norm x \<le> B"
     using S [simplified bounded_pos] by auto
   { fix y::'a and z::'a
     assume yz: "B < norm z" "B < norm y"
     have "connected_component (- cball 0 B) y z"
       apply (rule connected_componentI [OF _ subset_refl])
       apply (rule connected_complement_bounded_convex)
       using assms yz
       by (auto simp: dist_norm)
     then have "connected_component (- S) y z"
       apply (rule connected_component_of_subset)
       apply (metis Bno Compl_anti_mono mem_cball_0 subset_iff)
       done
   } note cyz = this
   show ?thesis
     apply (auto simp: outside)
     apply (metis Compl_iff bounded_iff cobounded_imp_unbounded mem_Collect_eq not_le)
     apply (simp add: bounded_pos)
     by (metis B connected_component_trans cyz not_le)
 qed
 
 lemma not_outside_connected_component_le:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S"  "2 \<le> DIM('a)"
       shows "- (outside S) = {x. \<forall>B. \<exists>y. B \<le> norm(y) \<and> \<not> connected_component (- S) x y}"
 apply (auto intro: less_imp_le simp: not_outside_connected_component_lt [OF assms])
 by (meson gt_ex less_le_trans)
 
 lemma inside_connected_component_lt:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S"  "2 \<le> DIM('a)"
       shows "inside S = {x. (x \<notin> S) \<and> (\<forall>B. \<exists>y. B < norm(y) \<and> \<not> connected_component (- S) x y)}"
   by (auto simp: inside_outside not_outside_connected_component_lt [OF assms])
 
 lemma inside_connected_component_le:
     fixes S :: "'a::euclidean_space set"
     assumes S: "bounded S"  "2 \<le> DIM('a)"
       shows "inside S = {x. (x \<notin> S) \<and> (\<forall>B. \<exists>y. B \<le> norm(y) \<and> \<not> connected_component (- S) x y)}"
   by (auto simp: inside_outside not_outside_connected_component_le [OF assms])
 
 lemma inside_subset:
   assumes "connected U" and "\<not> bounded U" and "T \<union> U = - S"
   shows "inside S \<subseteq> T"
 apply (auto simp: inside_def)
 by (metis bounded_subset [of "connected_component_set (- S) _"] connected_component_maximal
        Compl_iff Un_iff assms subsetI)
 
 lemma frontier_not_empty:
   fixes S :: "'a :: real_normed_vector set"
   shows "\<lbrakk>S \<noteq> {}; S \<noteq> UNIV\<rbrakk> \<Longrightarrow> frontier S \<noteq> {}"
     using connected_Int_frontier [of UNIV S] by auto
 
 lemma frontier_eq_empty:
   fixes S :: "'a :: real_normed_vector set"
   shows "frontier S = {} \<longleftrightarrow> S = {} \<or> S = UNIV"
 using frontier_UNIV frontier_empty frontier_not_empty by blast
 
 lemma frontier_of_connected_component_subset:
   fixes S :: "'a::real_normed_vector set"
   shows "frontier(connected_component_set S x) \<subseteq> frontier S"
 proof -
   { fix y
     assume y1: "y \<in> closure (connected_component_set S x)"
        and y2: "y \<notin> interior (connected_component_set S x)"
     have "y \<in> closure S"
       using y1 closure_mono connected_component_subset by blast
     moreover have "z \<in> interior (connected_component_set S x)"
           if "0 < e" "ball y e \<subseteq> interior S" "dist y z < e" for e z
     proof -
       have "ball y e \<subseteq> connected_component_set S y"
         apply (rule connected_component_maximal)
         using that interior_subset mem_ball apply auto
         done
       then show ?thesis
         using y1 apply (simp add: closure_approachable open_contains_ball_eq [OF open_interior])
         by (metis connected_component_eq dist_commute mem_Collect_eq mem_ball mem_interior subsetD \<open>0 < e\<close> y2)
     qed
     then have "y \<notin> interior S"
       using y2 by (force simp: open_contains_ball_eq [OF open_interior])
     ultimately have "y \<in> frontier S"
       by (auto simp: frontier_def)
   }
   then show ?thesis by (auto simp: frontier_def)
 qed
 
 lemma frontier_Union_subset_closure:
   fixes F :: "'a::real_normed_vector set set"
   shows "frontier(\<Union>F) \<subseteq> closure(\<Union>t \<in> F. frontier t)"
 proof -
   have "\<exists>y\<in>F. \<exists>y\<in>frontier y. dist y x < e"
        if "T \<in> F" "y \<in> T" "dist y x < e"
           "x \<notin> interior (\<Union>F)" "0 < e" for x y e T
   proof (cases "x \<in> T")
     case True with that show ?thesis
       by (metis Diff_iff Sup_upper closure_subset contra_subsetD dist_self frontier_def interior_mono)
   next
     case False
     have 1: "closed_segment x y \<inter> T \<noteq> {}" using \<open>y \<in> T\<close> by blast
     have 2: "closed_segment x y - T \<noteq> {}"
       using False by blast
     obtain c where "c \<in> closed_segment x y" "c \<in> frontier T"
        using False connected_Int_frontier [OF connected_segment 1 2] by auto
     then show ?thesis
     proof -
       have "norm (y - x) < e"
         by (metis dist_norm \<open>dist y x < e\<close>)
       moreover have "norm (c - x) \<le> norm (y - x)"
         by (simp add: \<open>c \<in> closed_segment x y\<close> segment_bound(1))
       ultimately have "norm (c - x) < e"
         by linarith
       then show ?thesis
         by (metis (no_types) \<open>c \<in> frontier T\<close> dist_norm that(1))
     qed
   qed
   then show ?thesis
     by (fastforce simp add: frontier_def closure_approachable)
 qed
 
 lemma frontier_Union_subset:
   fixes F :: "'a::real_normed_vector set set"
   shows "finite F \<Longrightarrow> frontier(\<Union>F) \<subseteq> (\<Union>t \<in> F. frontier t)"
 by (rule order_trans [OF frontier_Union_subset_closure])
    (auto simp: closure_subset_eq)
 
 lemma frontier_of_components_subset:
   fixes S :: "'a::real_normed_vector set"
   shows "C \<in> components S \<Longrightarrow> frontier C \<subseteq> frontier S"
   by (metis Path_Connected.frontier_of_connected_component_subset components_iff)
 
 lemma frontier_of_components_closed_complement:
   fixes S :: "'a::real_normed_vector set"
   shows "\<lbrakk>closed S; C \<in> components (- S)\<rbrakk> \<Longrightarrow> frontier C \<subseteq> S"
   using frontier_complement frontier_of_components_subset frontier_subset_eq by blast
 
 lemma frontier_minimal_separating_closed:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
       and nconn: "\<not> connected(- S)"
       and C: "C \<in> components (- S)"
       and conn: "\<And>T. \<lbrakk>closed T; T \<subset> S\<rbrakk> \<Longrightarrow> connected(- T)"
     shows "frontier C = S"
 proof (rule ccontr)
   assume "frontier C \<noteq> S"
   then have "frontier C \<subset> S"
     using frontier_of_components_closed_complement [OF \<open>closed S\<close> C] by blast
   then have "connected(- (frontier C))"
     by (simp add: conn)
   have "\<not> connected(- (frontier C))"
     unfolding connected_def not_not
   proof (intro exI conjI)
     show "open C"
       using C \<open>closed S\<close> open_components by blast
     show "open (- closure C)"
       by blast
     show "C \<inter> - closure C \<inter> - frontier C = {}"
       using closure_subset by blast
     show "C \<inter> - frontier C \<noteq> {}"
       using C \<open>open C\<close> components_eq frontier_disjoint_eq by fastforce
     show "- frontier C \<subseteq> C \<union> - closure C"
       by (simp add: \<open>open C\<close> closed_Compl frontier_closures)
     then show "- closure C \<inter> - frontier C \<noteq> {}"
       by (metis (no_types, lifting) C Compl_subset_Compl_iff \<open>frontier C \<subset> S\<close> compl_sup frontier_closures in_components_subset psubsetE sup.absorb_iff2 sup.boundedE sup_bot.right_neutral sup_inf_absorb)
   qed
   then show False
     using \<open>connected (- frontier C)\<close> by blast
 qed
 
 lemma connected_component_UNIV [simp]:
     fixes x :: "'a::real_normed_vector"
     shows "connected_component_set UNIV x = UNIV"
 using connected_iff_eq_connected_component_set [of "UNIV::'a set"] connected_UNIV
 by auto
 
 lemma connected_component_eq_UNIV:
     fixes x :: "'a::real_normed_vector"
     shows "connected_component_set s x = UNIV \<longleftrightarrow> s = UNIV"
   using connected_component_in connected_component_UNIV by blast
 
 lemma components_UNIV [simp]: "components UNIV = {UNIV :: 'a::real_normed_vector set}"
   by (auto simp: components_eq_sing_iff)
 
 lemma interior_inside_frontier:
     fixes s :: "'a::real_normed_vector set"
     assumes "bounded s"
       shows "interior s \<subseteq> inside (frontier s)"
 proof -
   { fix x y
     assume x: "x \<in> interior s" and y: "y \<notin> s"
        and cc: "connected_component (- frontier s) x y"
     have "connected_component_set (- frontier s) x \<inter> frontier s \<noteq> {}"
       apply (rule connected_Int_frontier, simp)
       apply (metis IntI cc connected_component_in connected_component_refl empty_iff interiorE mem_Collect_eq rev_subsetD x)
       using  y cc
       by blast
     then have "bounded (connected_component_set (- frontier s) x)"
       using connected_component_in by auto
   }
   then show ?thesis
     apply (auto simp: inside_def frontier_def)
     apply (rule classical)
     apply (rule bounded_subset [OF assms], blast)
     done
 qed
 
 lemma inside_empty [simp]: "inside {} = ({} :: 'a :: {real_normed_vector, perfect_space} set)"
-  by (simp add: inside_def connected_component_UNIV)
+  by (simp add: inside_def)
 
 lemma outside_empty [simp]: "outside {} = (UNIV :: 'a :: {real_normed_vector, perfect_space} set)"
 using inside_empty inside_Un_outside by blast
 
 lemma inside_same_component:
    "\<lbrakk>connected_component (- s) x y; x \<in> inside s\<rbrakk> \<Longrightarrow> y \<in> inside s"
   using connected_component_eq connected_component_in
   by (fastforce simp add: inside_def)
 
 lemma outside_same_component:
    "\<lbrakk>connected_component (- s) x y; x \<in> outside s\<rbrakk> \<Longrightarrow> y \<in> outside s"
   using connected_component_eq connected_component_in
   by (fastforce simp add: outside_def)
 
 lemma convex_in_outside:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   assumes s: "convex s" and z: "z \<notin> s"
     shows "z \<in> outside s"
 proof (cases "s={}")
   case True then show ?thesis by simp
 next
   case False then obtain a where "a \<in> s" by blast
   with z have zna: "z \<noteq> a" by auto
   { assume "bounded (connected_component_set (- s) z)"
     with bounded_pos_less obtain B where "B>0" and B: "\<And>x. connected_component (- s) z x \<Longrightarrow> norm x < B"
       by (metis mem_Collect_eq)
     define C where "C = (B + 1 + norm z) / norm (z-a)"
     have "C > 0"
       using \<open>0 < B\<close> zna by (simp add: C_def field_split_simps add_strict_increasing)
     have "\<bar>norm (z + C *\<^sub>R (z-a)) - norm (C *\<^sub>R (z-a))\<bar> \<le> norm z"
       by (metis add_diff_cancel norm_triangle_ineq3)
     moreover have "norm (C *\<^sub>R (z-a)) > norm z + B"
       using zna \<open>B>0\<close> by (simp add: C_def le_max_iff_disj)
     ultimately have C: "norm (z + C *\<^sub>R (z-a)) > B" by linarith
     { fix u::real
       assume u: "0\<le>u" "u\<le>1" and ins: "(1 - u) *\<^sub>R z + u *\<^sub>R (z + C *\<^sub>R (z - a)) \<in> s"
       then have Cpos: "1 + u * C > 0"
         by (meson \<open>0 < C\<close> add_pos_nonneg less_eq_real_def zero_le_mult_iff zero_less_one)
       then have *: "(1 / (1 + u * C)) *\<^sub>R z + (u * C / (1 + u * C)) *\<^sub>R z = z"
         by (simp add: scaleR_add_left [symmetric] field_split_simps)
       then have False
         using convexD_alt [OF s \<open>a \<in> s\<close> ins, of "1/(u*C + 1)"] \<open>C>0\<close> \<open>z \<notin> s\<close> Cpos u
-        by (simp add: * field_split_simps algebra_simps)
+        by (simp add: * field_split_simps)
     } note contra = this
     have "connected_component (- s) z (z + C *\<^sub>R (z-a))"
       apply (rule connected_componentI [OF connected_segment [of z "z + C *\<^sub>R (z-a)"]])
       apply (simp add: closed_segment_def)
       using contra
       apply auto
       done
     then have False
       using zna B [of "z + C *\<^sub>R (z-a)"] C
       by (auto simp: field_split_simps max_mult_distrib_right)
   }
   then show ?thesis
     by (auto simp: outside_def z)
 qed
 
 lemma outside_convex:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   assumes "convex s"
     shows "outside s = - s"
   by (metis ComplD assms convex_in_outside equalityI inside_Un_outside subsetI sup.cobounded2)
 
 lemma outside_singleton [simp]:
   fixes x :: "'a :: {real_normed_vector, perfect_space}"
   shows "outside {x} = -{x}"
   by (auto simp: outside_convex)
 
 lemma inside_convex:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   shows "convex s \<Longrightarrow> inside s = {}"
   by (simp add: inside_outside outside_convex)
 
 lemma inside_singleton [simp]:
   fixes x :: "'a :: {real_normed_vector, perfect_space}"
   shows "inside {x} = {}"
   by (auto simp: inside_convex)
 
 lemma outside_subset_convex:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
   shows "\<lbrakk>convex t; s \<subseteq> t\<rbrakk> \<Longrightarrow> - t \<subseteq> outside s"
   using outside_convex outside_mono by blast
 
 lemma outside_Un_outside_Un:
   fixes S :: "'a::real_normed_vector set"
   assumes "S \<inter> outside(T \<union> U) = {}"
   shows "outside(T \<union> U) \<subseteq> outside(T \<union> S)"
 proof
   fix x
   assume x: "x \<in> outside (T \<union> U)"
   have "Y \<subseteq> - S" if "connected Y" "Y \<subseteq> - T" "Y \<subseteq> - U" "x \<in> Y" "u \<in> Y" for u Y
   proof -
     have "Y \<subseteq> connected_component_set (- (T \<union> U)) x"
       by (simp add: connected_component_maximal that)
     also have "\<dots> \<subseteq> outside(T \<union> U)"
       by (metis (mono_tags, lifting) Collect_mono mem_Collect_eq outside outside_same_component x)
     finally have "Y \<subseteq> outside(T \<union> U)" .
     with assms show ?thesis by auto
   qed
   with x show "x \<in> outside (T \<union> S)"
     by (simp add: outside_connected_component_lt connected_component_def) meson
 qed
 
 lemma outside_frontier_misses_closure:
     fixes s :: "'a::real_normed_vector set"
     assumes "bounded s"
     shows  "outside(frontier s) \<subseteq> - closure s"
   unfolding outside_inside Lattices.boolean_algebra_class.compl_le_compl_iff
 proof -
   { assume "interior s \<subseteq> inside (frontier s)"
     hence "interior s \<union> inside (frontier s) = inside (frontier s)"
       by (simp add: subset_Un_eq)
     then have "closure s \<subseteq> frontier s \<union> inside (frontier s)"
       using frontier_def by auto
   }
   then show "closure s \<subseteq> frontier s \<union> inside (frontier s)"
     using interior_inside_frontier [OF assms] by blast
 qed
 
 lemma outside_frontier_eq_complement_closure:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
     assumes "bounded s" "convex s"
       shows "outside(frontier s) = - closure s"
 by (metis Diff_subset assms convex_closure frontier_def outside_frontier_misses_closure
           outside_subset_convex subset_antisym)
 
 lemma inside_frontier_eq_interior:
      fixes s :: "'a :: {real_normed_vector, perfect_space} set"
      shows "\<lbrakk>bounded s; convex s\<rbrakk> \<Longrightarrow> inside(frontier s) = interior s"
   apply (simp add: inside_outside outside_frontier_eq_complement_closure)
   using closure_subset interior_subset
   apply (auto simp: frontier_def)
   done
 
 lemma open_inside:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "open (inside s)"
 proof -
   { fix x assume x: "x \<in> inside s"
     have "open (connected_component_set (- s) x)"
       using assms open_connected_component by blast
     then obtain e where e: "e>0" and e: "\<And>y. dist y x < e \<longrightarrow> connected_component (- s) x y"
       using dist_not_less_zero
       apply (simp add: open_dist)
       by (metis (no_types, lifting) Compl_iff connected_component_refl_eq inside_def mem_Collect_eq x)
     then have "\<exists>e>0. ball x e \<subseteq> inside s"
       by (metis e dist_commute inside_same_component mem_ball subsetI x)
   }
   then show ?thesis
     by (simp add: open_contains_ball)
 qed
 
 lemma open_outside:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "open (outside s)"
 proof -
   { fix x assume x: "x \<in> outside s"
     have "open (connected_component_set (- s) x)"
       using assms open_connected_component by blast
     then obtain e where e: "e>0" and e: "\<And>y. dist y x < e \<longrightarrow> connected_component (- s) x y"
       using dist_not_less_zero
       apply (simp add: open_dist)
       by (metis Int_iff outside_def connected_component_refl_eq  x)
     then have "\<exists>e>0. ball x e \<subseteq> outside s"
       by (metis e dist_commute outside_same_component mem_ball subsetI x)
   }
   then show ?thesis
     by (simp add: open_contains_ball)
 qed
 
 lemma closure_inside_subset:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "closure(inside s) \<subseteq> s \<union> inside s"
 by (metis assms closure_minimal open_closed open_outside sup.cobounded2 union_with_inside)
 
 lemma frontier_inside_subset:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "frontier(inside s) \<subseteq> s"
 proof -
   have "closure (inside s) \<inter> - inside s = closure (inside s) - interior (inside s)"
     by (metis (no_types) Diff_Compl assms closure_closed interior_closure open_closed open_inside)
   moreover have "- inside s \<inter> - outside s = s"
     by (metis (no_types) compl_sup double_compl inside_Un_outside)
   moreover have "closure (inside s) \<subseteq> - outside s"
     by (metis (no_types) assms closure_inside_subset union_with_inside)
   ultimately have "closure (inside s) - interior (inside s) \<subseteq> s"
     by blast
   then show ?thesis
     by (simp add: frontier_def open_inside interior_open)
 qed
 
 lemma closure_outside_subset:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "closure(outside s) \<subseteq> s \<union> outside s"
   apply (rule closure_minimal, simp)
   by (metis assms closed_open inside_outside open_inside)
 
 lemma frontier_outside_subset:
     fixes s :: "'a::real_normed_vector set"
     assumes "closed s"
       shows "frontier(outside s) \<subseteq> s"
   apply (simp add: frontier_def open_outside interior_open)
   by (metis Diff_subset_conv assms closure_outside_subset interior_eq open_outside sup.commute)
 
 lemma inside_complement_unbounded_connected_empty:
      "\<lbrakk>connected (- s); \<not> bounded (- s)\<rbrakk> \<Longrightarrow> inside s = {}"
   apply (simp add: inside_def)
   by (meson Compl_iff bounded_subset connected_component_maximal order_refl)
 
 lemma inside_bounded_complement_connected_empty:
     fixes s :: "'a::{real_normed_vector, perfect_space} set"
     shows "\<lbrakk>connected (- s); bounded s\<rbrakk> \<Longrightarrow> inside s = {}"
   by (metis inside_complement_unbounded_connected_empty cobounded_imp_unbounded)
 
 lemma inside_inside:
     assumes "s \<subseteq> inside t"
     shows "inside s - t \<subseteq> inside t"
 unfolding inside_def
 proof clarify
   fix x
   assume x: "x \<notin> t" "x \<notin> s" and bo: "bounded (connected_component_set (- s) x)"
   show "bounded (connected_component_set (- t) x)"
   proof (cases "s \<inter> connected_component_set (- t) x = {}")
     case True show ?thesis
       apply (rule bounded_subset [OF bo])
       apply (rule connected_component_maximal)
       using x True apply auto
       done
   next
     case False then show ?thesis
       using assms [unfolded inside_def] x
       apply (simp add: disjoint_iff_not_equal, clarify)
       apply (drule subsetD, assumption, auto)
       by (metis (no_types, hide_lams) ComplI connected_component_eq_eq)
   qed
 qed
 
 lemma inside_inside_subset: "inside(inside s) \<subseteq> s"
   using inside_inside union_with_outside by fastforce
 
 lemma inside_outside_intersect_connected:
       "\<lbrakk>connected t; inside s \<inter> t \<noteq> {}; outside s \<inter> t \<noteq> {}\<rbrakk> \<Longrightarrow> s \<inter> t \<noteq> {}"
   apply (simp add: inside_def outside_def ex_in_conv [symmetric] disjoint_eq_subset_Compl, clarify)
   by (metis (no_types, hide_lams) Compl_anti_mono connected_component_eq connected_component_maximal contra_subsetD double_compl)
 
 lemma outside_bounded_nonempty:
   fixes s :: "'a :: {real_normed_vector, perfect_space} set"
     assumes "bounded s" shows "outside s \<noteq> {}"
   by (metis (no_types, lifting) Collect_empty_eq Collect_mem_eq Compl_eq_Diff_UNIV Diff_cancel
                    Diff_disjoint UNIV_I assms ball_eq_empty bounded_diff cobounded_outside convex_ball
                    double_complement order_refl outside_convex outside_def)
 
 lemma outside_compact_in_open:
     fixes s :: "'a :: {real_normed_vector,perfect_space} set"
     assumes s: "compact s" and t: "open t" and "s \<subseteq> t" "t \<noteq> {}"
       shows "outside s \<inter> t \<noteq> {}"
 proof -
   have "outside s \<noteq> {}"
     by (simp add: compact_imp_bounded outside_bounded_nonempty s)
   with assms obtain a b where a: "a \<in> outside s" and b: "b \<in> t" by auto
   show ?thesis
   proof (cases "a \<in> t")
     case True with a show ?thesis by blast
   next
     case False
       have front: "frontier t \<subseteq> - s"
         using \<open>s \<subseteq> t\<close> frontier_disjoint_eq t by auto
       { fix \<gamma>
         assume "path \<gamma>" and pimg_sbs: "path_image \<gamma> - {pathfinish \<gamma>} \<subseteq> interior (- t)"
            and pf: "pathfinish \<gamma> \<in> frontier t" and ps: "pathstart \<gamma> = a"
         define c where "c = pathfinish \<gamma>"
         have "c \<in> -s" unfolding c_def using front pf by blast
         moreover have "open (-s)" using s compact_imp_closed by blast
         ultimately obtain \<epsilon>::real where "\<epsilon> > 0" and \<epsilon>: "cball c \<epsilon> \<subseteq> -s"
           using open_contains_cball[of "-s"] s by blast
         then obtain d where "d \<in> t" and d: "dist d c < \<epsilon>"
           using closure_approachable [of c t] pf unfolding c_def
           by (metis Diff_iff frontier_def)
         then have "d \<in> -s" using \<epsilon>
           using dist_commute by (metis contra_subsetD mem_cball not_le not_less_iff_gr_or_eq)
         have pimg_sbs_cos: "path_image \<gamma> \<subseteq> -s"
           using pimg_sbs apply (auto simp: path_image_def)
           apply (drule subsetD)
           using \<open>c \<in> - s\<close> \<open>s \<subseteq> t\<close> interior_subset apply (auto simp: c_def)
           done
         have "closed_segment c d \<le> cball c \<epsilon>"
           apply (simp add: segment_convex_hull)
           apply (rule hull_minimal)
           using  \<open>\<epsilon> > 0\<close> d apply (auto simp: dist_commute)
           done
         with \<epsilon> have "closed_segment c d \<subseteq> -s" by blast
         moreover have con_gcd: "connected (path_image \<gamma> \<union> closed_segment c d)"
           by (rule connected_Un) (auto simp: c_def \<open>path \<gamma>\<close> connected_path_image)
         ultimately have "connected_component (- s) a d"
           unfolding connected_component_def using pimg_sbs_cos ps by blast
         then have "outside s \<inter> t \<noteq> {}"
           using outside_same_component [OF _ a]  by (metis IntI \<open>d \<in> t\<close> empty_iff)
       } note * = this
       have pal: "pathstart (linepath a b) \<in> closure (- t)"
         by (auto simp: False closure_def)
       show ?thesis
         by (rule exists_path_subpath_to_frontier [OF path_linepath pal _ *]) (auto simp: b)
   qed
 qed
 
 lemma inside_inside_compact_connected:
     fixes s :: "'a :: euclidean_space set"
     assumes s: "closed s" and t: "compact t" and "connected t" "s \<subseteq> inside t"
       shows "inside s \<subseteq> inside t"
 proof (cases "inside t = {}")
   case True with assms show ?thesis by auto
 next
   case False
   consider "DIM('a) = 1" | "DIM('a) \<ge> 2"
     using antisym not_less_eq_eq by fastforce
   then show ?thesis
   proof cases
     case 1 then show ?thesis
              using connected_convex_1_gen assms False inside_convex by blast
   next
     case 2
     have coms: "compact s"
       using assms apply (simp add: s compact_eq_bounded_closed)
        by (meson bounded_inside bounded_subset compact_imp_bounded)
     then have bst: "bounded (s \<union> t)"
       by (simp add: compact_imp_bounded t)
     then obtain r where "0 < r" and r: "s \<union> t \<subseteq> ball 0 r"
       using bounded_subset_ballD by blast
     have outst: "outside s \<inter> outside t \<noteq> {}"
     proof -
       have "- ball 0 r \<subseteq> outside s"
         apply (rule outside_subset_convex)
         using r by auto
       moreover have "- ball 0 r \<subseteq> outside t"
         apply (rule outside_subset_convex)
         using r by auto
       ultimately show ?thesis
         by (metis Compl_subset_Compl_iff Int_subset_iff bounded_ball inf.orderE outside_bounded_nonempty outside_no_overlap)
     qed
     have "s \<inter> t = {}" using assms
       by (metis disjoint_iff_not_equal inside_no_overlap subsetCE)
     moreover have "outside s \<inter> inside t \<noteq> {}"
       by (meson False assms(4) compact_eq_bounded_closed coms open_inside outside_compact_in_open t)
     ultimately have "inside s \<inter> t = {}"
       using inside_outside_intersect_connected [OF \<open>connected t\<close>, of s]
       by (metis "2" compact_eq_bounded_closed coms connected_outside inf.commute inside_outside_intersect_connected outst)
     then show ?thesis
       using inside_inside [OF \<open>s \<subseteq> inside t\<close>] by blast
   qed
 qed
 
 lemma connected_with_inside:
     fixes s :: "'a :: real_normed_vector set"
     assumes s: "closed s" and cons: "connected s"
       shows "connected(s \<union> inside s)"
 proof (cases "s \<union> inside s = UNIV")
   case True with assms show ?thesis by auto
 next
   case False
   then obtain b where b: "b \<notin> s" "b \<notin> inside s" by blast
   have *: "\<exists>y t. y \<in> s \<and> connected t \<and> a \<in> t \<and> y \<in> t \<and> t \<subseteq> (s \<union> inside s)" if "a \<in> (s \<union> inside s)" for a
   using that proof
     assume "a \<in> s" then show ?thesis
       apply (rule_tac x=a in exI)
       apply (rule_tac x="{a}" in exI, simp)
       done
   next
     assume a: "a \<in> inside s"
     show ?thesis
       apply (rule exists_path_subpath_to_frontier [OF path_linepath [of a b], of "inside s"])
       using a apply (simp add: closure_def)
       apply (simp add: b)
       apply (rule_tac x="pathfinish h" in exI)
       apply (rule_tac x="path_image h" in exI)
       apply (simp add: pathfinish_in_path_image connected_path_image, auto)
       using frontier_inside_subset s apply fastforce
       by (metis (no_types, lifting) frontier_inside_subset insertE insert_Diff interior_eq open_inside pathfinish_in_path_image s subsetCE)
   qed
   show ?thesis
     apply (simp add: connected_iff_connected_component)
     apply (simp add: connected_component_def)
     apply (clarify dest!: *)
     apply (rename_tac u u' t t')
     apply (rule_tac x="(s \<union> t \<union> t')" in exI)
     apply (auto simp: intro!: connected_Un cons)
     done
 qed
 
 text\<open>The proof is virtually the same as that above.\<close>
 lemma connected_with_outside:
     fixes s :: "'a :: real_normed_vector set"
     assumes s: "closed s" and cons: "connected s"
       shows "connected(s \<union> outside s)"
 proof (cases "s \<union> outside s = UNIV")
   case True with assms show ?thesis by auto
 next
   case False
   then obtain b where b: "b \<notin> s" "b \<notin> outside s" by blast
   have *: "\<exists>y t. y \<in> s \<and> connected t \<and> a \<in> t \<and> y \<in> t \<and> t \<subseteq> (s \<union> outside s)" if "a \<in> (s \<union> outside s)" for a
   using that proof
     assume "a \<in> s" then show ?thesis
       apply (rule_tac x=a in exI)
       apply (rule_tac x="{a}" in exI, simp)
       done
   next
     assume a: "a \<in> outside s"
     show ?thesis
       apply (rule exists_path_subpath_to_frontier [OF path_linepath [of a b], of "outside s"])
       using a apply (simp add: closure_def)
       apply (simp add: b)
       apply (rule_tac x="pathfinish h" in exI)
       apply (rule_tac x="path_image h" in exI)
       apply (simp add: pathfinish_in_path_image connected_path_image, auto)
       using frontier_outside_subset s apply fastforce
       by (metis (no_types, lifting) frontier_outside_subset insertE insert_Diff interior_eq open_outside pathfinish_in_path_image s subsetCE)
   qed
   show ?thesis
     apply (simp add: connected_iff_connected_component)
     apply (simp add: connected_component_def)
     apply (clarify dest!: *)
     apply (rename_tac u u' t t')
     apply (rule_tac x="(s \<union> t \<union> t')" in exI)
     apply (auto simp: intro!: connected_Un cons)
     done
 qed
 
 lemma inside_inside_eq_empty [simp]:
     fixes s :: "'a :: {real_normed_vector, perfect_space} set"
     assumes s: "closed s" and cons: "connected s"
       shows "inside (inside s) = {}"
   by (metis (no_types) unbounded_outside connected_with_outside [OF assms] bounded_Un
            inside_complement_unbounded_connected_empty unbounded_outside union_with_outside)
 
 lemma inside_in_components:
      "inside s \<in> components (- s) \<longleftrightarrow> connected(inside s) \<and> inside s \<noteq> {}"
   apply (simp add: in_components_maximal)
   apply (auto intro: inside_same_component connected_componentI)
   apply (metis IntI empty_iff inside_no_overlap)
   done
 
 text\<open>The proof is virtually the same as that above.\<close>
 lemma outside_in_components:
      "outside s \<in> components (- s) \<longleftrightarrow> connected(outside s) \<and> outside s \<noteq> {}"
   apply (simp add: in_components_maximal)
   apply (auto intro: outside_same_component connected_componentI)
   apply (metis IntI empty_iff outside_no_overlap)
   done
 
 lemma bounded_unique_outside:
     fixes s :: "'a :: euclidean_space set"
     shows "\<lbrakk>bounded s; DIM('a) \<ge> 2\<rbrakk> \<Longrightarrow> (c \<in> components (- s) \<and> \<not> bounded c \<longleftrightarrow> c = outside s)"
   apply (rule iffI)
   apply (metis cobounded_unique_unbounded_components connected_outside double_compl outside_bounded_nonempty outside_in_components unbounded_outside)
   by (simp add: connected_outside outside_bounded_nonempty outside_in_components unbounded_outside)
 
 
 subsection\<open>Condition for an open map's image to contain a ball\<close>
 
 proposition ball_subset_open_map_image:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b :: {real_normed_vector,heine_borel}"
   assumes contf: "continuous_on (closure S) f"
       and oint: "open (f ` interior S)"
       and le_no: "\<And>z. z \<in> frontier S \<Longrightarrow> r \<le> norm(f z - f a)"
       and "bounded S" "a \<in> S" "0 < r"
     shows "ball (f a) r \<subseteq> f ` S"
 proof (cases "f ` S = UNIV")
   case True then show ?thesis by simp
 next
   case False
     obtain w where w: "w \<in> frontier (f ` S)"
                and dw_le: "\<And>y. y \<in> frontier (f ` S) \<Longrightarrow> norm (f a - w) \<le> norm (f a - y)"
       apply (rule distance_attains_inf [of "frontier(f ` S)" "f a"])
       using \<open>a \<in> S\<close> by (auto simp: frontier_eq_empty dist_norm False)
     then obtain \<xi> where \<xi>: "\<And>n. \<xi> n \<in> f ` S" and tendsw: "\<xi> \<longlonglongrightarrow> w"
       by (metis Diff_iff frontier_def closure_sequential)
     then have "\<And>n. \<exists>x \<in> S. \<xi> n = f x" by force
     then obtain z where zs: "\<And>n. z n \<in> S" and fz: "\<And>n. \<xi> n = f (z n)"
       by metis
     then obtain y K where y: "y \<in> closure S" and "strict_mono (K :: nat \<Rightarrow> nat)" 
                       and Klim: "(z \<circ> K) \<longlonglongrightarrow> y"
       using \<open>bounded S\<close>
       apply (simp add: compact_closure [symmetric] compact_def)
       apply (drule_tac x=z in spec)
       using closure_subset apply force
       done
     then have ftendsw: "((\<lambda>n. f (z n)) \<circ> K) \<longlonglongrightarrow> w"
       by (metis LIMSEQ_subseq_LIMSEQ fun.map_cong0 fz tendsw)
     have zKs: "\<And>n. (z \<circ> K) n \<in> S" by (simp add: zs)
     have fz: "f \<circ> z = \<xi>"  "(\<lambda>n. f (z n)) = \<xi>"
       using fz by auto
     then have "(\<xi> \<circ> K) \<longlonglongrightarrow> f y"
       by (metis (no_types) Klim zKs y contf comp_assoc continuous_on_closure_sequentially)
     with fz have wy: "w = f y" using fz LIMSEQ_unique ftendsw by auto
     have rle: "r \<le> norm (f y - f a)"
       apply (rule le_no)
       using w wy oint
       by (force simp: imageI image_mono interiorI interior_subset frontier_def y)
     have **: "(b \<inter> (- S) \<noteq> {} \<and> b - (- S) \<noteq> {} \<Longrightarrow> b \<inter> f \<noteq> {})
               \<Longrightarrow> (b \<inter> S \<noteq> {}) \<Longrightarrow> b \<inter> f = {} \<Longrightarrow>
               b \<subseteq> S" for b f and S :: "'b set"
       by blast
     show ?thesis
       apply (rule **)   (*such a horrible mess*)
       apply (rule connected_Int_frontier [where t = "f`S", OF connected_ball])
       using \<open>a \<in> S\<close> \<open>0 < r\<close>
       apply (auto simp: disjoint_iff_not_equal dist_norm)
       by (metis dw_le norm_minus_commute not_less order_trans rle wy)
 qed
 
 
 subsubsection\<open>Special characterizations of classes of functions into and out of R.\<close>
 
 proposition embedding_map_into_euclideanreal:
   assumes "path_connected_space X"
   shows "embedding_map X euclideanreal f \<longleftrightarrow>
          continuous_map X euclideanreal f \<and> inj_on f (topspace X)"
   proof safe
   show "continuous_map X euclideanreal f"
     if "embedding_map X euclideanreal f"
     using continuous_map_in_subtopology homeomorphic_imp_continuous_map that
     unfolding embedding_map_def by blast
   show "inj_on f (topspace X)"
     if "embedding_map X euclideanreal f"
     using that homeomorphic_imp_injective_map
     unfolding embedding_map_def by blast
   show "embedding_map X euclideanreal f"
     if cont: "continuous_map X euclideanreal f" and inj: "inj_on f (topspace X)"
   proof -
     obtain g where gf: "\<And>x. x \<in> topspace X \<Longrightarrow> g (f x) = x"
       using inv_into_f_f [OF inj] by auto
     show ?thesis
       unfolding embedding_map_def homeomorphic_map_maps homeomorphic_maps_def
     proof (intro exI conjI)
       show "continuous_map X (top_of_set (f ` topspace X)) f"
         by (simp add: cont continuous_map_in_subtopology)
       let ?S = "f ` topspace X"
       have eq: "{x \<in> ?S. g x \<in> U} = f ` U" if "openin X U" for U
         using openin_subset [OF that] by (auto simp: gf)
       have 1: "g ` ?S \<subseteq> topspace X"
         using eq by blast
       have "openin (top_of_set ?S) {x \<in> ?S. g x \<in> T}"
         if "openin X T" for T
       proof -
         have "T \<subseteq> topspace X"
           by (simp add: openin_subset that)
         have RR: "\<forall>x \<in> ?S \<inter> g -` T. \<exists>d>0. \<forall>x' \<in> ?S \<inter> ball x d. g x' \<in> T"
         proof (clarsimp simp add: gf)
           have pcS: "path_connectedin euclidean ?S"
             using assms cont path_connectedin_continuous_map_image path_connectedin_topspace by blast
           show "\<exists>d>0. \<forall>x'\<in>f ` topspace X \<inter> ball (f x) d. g x' \<in> T"
             if "x \<in> T" for x
           proof -
             have x: "x \<in> topspace X"
               using \<open>T \<subseteq> topspace X\<close> \<open>x \<in> T\<close> by blast
             obtain u v d where "0 < d" "u \<in> topspace X" "v \<in> topspace X"
                          and sub_fuv: "?S \<inter> {f x - d .. f x + d} \<subseteq> {f u..f v}"
             proof (cases "\<exists>u \<in> topspace X. f u < f x")
               case True
               then obtain u where u: "u \<in> topspace X" "f u < f x" ..
               show ?thesis
               proof (cases "\<exists>v \<in> topspace X. f x < f v")
                 case True
                 then obtain v where v: "v \<in> topspace X" "f x < f v" ..
                 show ?thesis
                 proof
                   let ?d = "min (f x - f u) (f v - f x)"
                   show "0 < ?d"
                     by (simp add: \<open>f u < f x\<close> \<open>f x < f v\<close>)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f u..f v}"
                     by fastforce
                 qed (auto simp: u v)
               next
                 case False
                 show ?thesis
                 proof
                   let ?d = "f x - f u"
                   show "0 < ?d"
                     by (simp add: u)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f u..f x}"
                     using x u False by auto
                 qed (auto simp: x u)
               qed
             next
               case False
               note no_u = False
               show ?thesis
               proof (cases "\<exists>v \<in> topspace X. f x < f v")
                 case True
                 then obtain v where v: "v \<in> topspace X" "f x < f v" ..
                 show ?thesis
                 proof
                   let ?d = "f v - f x"
                   show "0 < ?d"
                     by (simp add: v)
                   show "f ` topspace X \<inter> {f x - ?d..f x + ?d} \<subseteq> {f x..f v}"
                     using False by auto
                 qed (auto simp: x v)
               next
                 case False
                 show ?thesis
                 proof
                   show "f ` topspace X \<inter> {f x - 1..f x + 1} \<subseteq> {f x..f x}"
                     using False no_u by fastforce
                 qed (auto simp: x)
               qed
             qed
             then obtain h where "pathin X h" "h 0 = u" "h 1 = v"
               using assms unfolding path_connected_space_def by blast
             obtain C where "compactin X C" "connectedin X C" "u \<in> C" "v \<in> C"
             proof
               show "compactin X (h ` {0..1})"
                 using that by (simp add: \<open>pathin X h\<close> compactin_path_image)
               show "connectedin X (h ` {0..1})"
                 using \<open>pathin X h\<close> connectedin_path_image by blast
             qed (use \<open>h 0 = u\<close> \<open>h 1 = v\<close> in auto)
             have "continuous_map (subtopology euclideanreal (?S \<inter> {f x - d .. f x + d})) (subtopology X C) g"
             proof (rule continuous_inverse_map)
               show "compact_space (subtopology X C)"
                 using \<open>compactin X C\<close> compactin_subspace by blast
               show "continuous_map (subtopology X C) euclideanreal f"
                 by (simp add: cont continuous_map_from_subtopology)
               have "{f u .. f v} \<subseteq> f ` topspace (subtopology X C)"
               proof (rule connected_contains_Icc)
                 show "connected (f ` topspace (subtopology X C))"
                   using connectedin_continuous_map_image [OF cont]
                   by (simp add: \<open>compactin X C\<close> \<open>connectedin X C\<close> compactin_subset_topspace inf_absorb2)
                 show "f u \<in> f ` topspace (subtopology X C)"
                   by (simp add: \<open>u \<in> C\<close> \<open>u \<in> topspace X\<close>)
                 show "f v \<in> f ` topspace (subtopology X C)"
                   by (simp add: \<open>v \<in> C\<close> \<open>v \<in> topspace X\<close>)
               qed
               then show "f ` topspace X \<inter> {f x - d..f x + d} \<subseteq> f ` topspace (subtopology X C)"
                 using sub_fuv by blast
             qed (auto simp: gf)
             then have contg: "continuous_map (subtopology euclideanreal (?S \<inter> {f x - d .. f x + d})) X g"
               using continuous_map_in_subtopology by blast
             have "\<exists>e>0. \<forall>x \<in> ?S \<inter> {f x - d .. f x + d} \<inter> ball (f x) e. g x \<in> T"
               using openin_continuous_map_preimage [OF contg \<open>openin X T\<close>] x \<open>x \<in> T\<close> \<open>0 < d\<close>
               unfolding openin_euclidean_subtopology_iff
               by (force simp: gf dist_commute)
             then obtain e where "e > 0 \<and> (\<forall>x\<in>f ` topspace X \<inter> {f x - d..f x + d} \<inter> ball (f x) e. g x \<in> T)"
               by metis
             with \<open>0 < d\<close> have "min d e > 0" "\<forall>u. u \<in> topspace X \<longrightarrow> \<bar>f x - f u\<bar> < min d e \<longrightarrow> u \<in> T"
               using dist_real_def gf by force+
             then show ?thesis
               by (metis (full_types) Int_iff dist_real_def image_iff mem_ball gf)
           qed
         qed
         then obtain d where d: "\<And>r. r \<in> ?S \<inter> g -` T \<Longrightarrow>
                 d r > 0 \<and> (\<forall>x \<in> ?S \<inter> ball r (d r). g x \<in> T)"
           by metis
         show ?thesis
           unfolding openin_subtopology
         proof (intro exI conjI)
           show "{x \<in> ?S. g x \<in> T} = (\<Union>r \<in> ?S \<inter> g -` T. ball r (d r)) \<inter> f ` topspace X"
             using d by (auto simp: gf)
         qed auto
       qed
       then show "continuous_map (top_of_set ?S) X g"
         by (simp add: continuous_map_def gf)
     qed (auto simp: gf)
   qed
 qed
 
 subsubsection \<open>An injective function into R is a homeomorphism and so an open map.\<close>
 
 lemma injective_into_1d_eq_homeomorphism:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on S f" and S: "path_connected S"
   shows "inj_on f S \<longleftrightarrow> (\<exists>g. homeomorphism S (f ` S) f g)"
 proof
   show "\<exists>g. homeomorphism S (f ` S) f g"
     if "inj_on f S"
   proof -
     have "embedding_map (top_of_set S) euclideanreal f"
       using that embedding_map_into_euclideanreal [of "top_of_set S" f] assms by auto
     then show ?thesis
       by (simp add: embedding_map_def) (metis all_closedin_homeomorphic_image f homeomorphism_injective_closed_map that)
   qed
 qed (metis homeomorphism_def inj_onI)
 
 lemma injective_into_1d_imp_open_map:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes "continuous_on S f" "path_connected S" "inj_on f S" "openin (subtopology euclidean S) T"
   shows "openin (subtopology euclidean (f ` S)) (f ` T)"
   using assms homeomorphism_imp_open_map injective_into_1d_eq_homeomorphism by blast
 
 lemma homeomorphism_into_1d:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes "path_connected S" "continuous_on S f" "f ` S = T" "inj_on f S"
   shows "\<exists>g. homeomorphism S T f g"
   using assms injective_into_1d_eq_homeomorphism by blast
 
 end
diff --git a/src/HOL/Analysis/Retracts.thy b/src/HOL/Analysis/Retracts.thy
--- a/src/HOL/Analysis/Retracts.thy
+++ b/src/HOL/Analysis/Retracts.thy
@@ -1,2593 +1,2593 @@
 section \<open>Absolute Retracts, Absolute Neighbourhood Retracts and Euclidean Neighbourhood Retracts\<close>
 
 theory Retracts
 imports
   Brouwer_Fixpoint
   Continuous_Extension
   Ordered_Euclidean_Space
 begin
 
 text \<open>Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also Euclidean neighbourhood
 retracts (ENR). We define AR and ANR by specializing the standard definitions for a set to embedding
 in spaces of higher dimension.
 
 John Harrison writes: "This turns out to be sufficient (since any set in \<open>\<real>\<^sup>n\<close> can be
 embedded as a closed subset of a convex subset of \<open>\<real>\<^sup>n\<^sup>+\<^sup>1\<close>) to derive the usual
 definitions, but we need to split them into two implications because of the lack of type
 quantifiers. Then ENR turns out to be equivalent to ANR plus local compactness."\<close>
 
 definition\<^marker>\<open>tag important\<close> AR :: "'a::topological_space set \<Rightarrow> bool" where
 "AR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
   S homeomorphic S' \<and> closedin (top_of_set U) S' \<longrightarrow> S' retract_of U"
 
 definition\<^marker>\<open>tag important\<close> ANR :: "'a::topological_space set \<Rightarrow> bool" where
 "ANR S \<equiv> \<forall>U. \<forall>S'::('a * real) set.
   S homeomorphic S' \<and> closedin (top_of_set U) S'
   \<longrightarrow> (\<exists>T. openin (top_of_set U) T \<and> S' retract_of T)"
 
 definition\<^marker>\<open>tag important\<close> ENR :: "'a::topological_space set \<Rightarrow> bool" where
 "ENR S \<equiv> \<exists>U. open U \<and> S retract_of U"
 
 text \<open>First, show that we do indeed get the "usual" properties of ARs and ANRs.\<close>
 
 lemma AR_imp_absolute_extensor:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "AR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
       and cloUT: "closedin (top_of_set U) T"
   obtains g where "continuous_on U g" "g ` U \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
 proof -
   have "aff_dim S < int (DIM('b \<times> real))"
     using aff_dim_le_DIM [of S] by simp
   then obtain C and S' :: "('b * real) set"
           where C: "convex C" "C \<noteq> {}"
             and cloCS: "closedin (top_of_set C) S'"
             and hom: "S homeomorphic S'"
     by (metis that homeomorphic_closedin_convex)
   then have "S' retract_of C"
     using \<open>AR S\<close> by (simp add: AR_def)
   then obtain r where "S' \<subseteq> C" and contr: "continuous_on C r"
                   and "r ` C \<subseteq> S'" and rid: "\<And>x. x\<in>S' \<Longrightarrow> r x = x"
     by (auto simp: retraction_def retract_of_def)
   obtain g h where "homeomorphism S S' g h"
     using hom by (force simp: homeomorphic_def)
   then have "continuous_on (f ` T) g"
     by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def)
   then have contgf: "continuous_on T (g \<circ> f)"
     by (metis continuous_on_compose contf)
   have gfTC: "(g \<circ> f) ` T \<subseteq> C"
   proof -
     have "g ` S = S'"
       by (metis (no_types) \<open>homeomorphism S S' g h\<close> homeomorphism_def)
     with \<open>S' \<subseteq> C\<close> \<open>f ` T \<subseteq> S\<close> show ?thesis by force
   qed
   obtain f' where f': "continuous_on U f'"  "f' ` U \<subseteq> C"
                       "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
     by (metis Dugundji [OF C cloUT contgf gfTC])
   show ?thesis
   proof (rule_tac g = "h \<circ> r \<circ> f'" in that)
     show "continuous_on U (h \<circ> r \<circ> f')"
       apply (intro continuous_on_compose f')
        using continuous_on_subset contr f' apply blast
       by (meson \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> continuous_on_subset \<open>f' ` U \<subseteq> C\<close> homeomorphism_def image_mono)
     show "(h \<circ> r \<circ> f') ` U \<subseteq> S"
       using \<open>homeomorphism S S' g h\<close> \<open>r ` C \<subseteq> S'\<close> \<open>f' ` U \<subseteq> C\<close>
       by (fastforce simp: homeomorphism_def)
     show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
       using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> f'
       by (auto simp: rid homeomorphism_def)
   qed
 qed
 
 lemma AR_imp_absolute_retract:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "AR S" "S homeomorphic S'"
       and clo: "closedin (top_of_set U) S'"
     shows "S' retract_of U"
 proof -
   obtain g h where hom: "homeomorphism S S' g h"
     using assms by (force simp: homeomorphic_def)
   have h: "continuous_on S' h" " h ` S' \<subseteq> S"
     using hom homeomorphism_def apply blast
     apply (metis hom equalityE homeomorphism_def)
     done
   obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
               and h'h: "\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
     by (blast intro: AR_imp_absolute_extensor [OF \<open>AR S\<close> h clo])
   have [simp]: "S' \<subseteq> U" using clo closedin_limpt by blast
   show ?thesis
   proof (simp add: retraction_def retract_of_def, intro exI conjI)
     show "continuous_on U (g \<circ> h')"
       apply (intro continuous_on_compose h')
       apply (meson hom continuous_on_subset h' homeomorphism_cont1)
       done
     show "(g \<circ> h') ` U \<subseteq> S'"
       using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
     show "\<forall>x\<in>S'. (g \<circ> h') x = x"
       by clarsimp (metis h'h hom homeomorphism_def)
   qed
 qed
 
 lemma AR_imp_absolute_retract_UNIV:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "AR S" and hom: "S homeomorphic S'"
       and clo: "closed S'"
     shows "S' retract_of UNIV"
 apply (rule AR_imp_absolute_retract [OF \<open>AR S\<close> hom])
 using clo closed_closedin by auto
 
 lemma absolute_extensor_imp_AR:
   fixes S :: "'a::euclidean_space set"
   assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
            \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
                   closedin (top_of_set U) T\<rbrakk>
                  \<Longrightarrow> \<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
   shows "AR S"
 proof (clarsimp simp: AR_def)
   fix U and T :: "('a * real) set"
   assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
   then obtain g h where hom: "homeomorphism S T g h"
     by (force simp: homeomorphic_def)
   have h: "continuous_on T h" " h ` T \<subseteq> S"
     using hom homeomorphism_def apply blast
     apply (metis hom equalityE homeomorphism_def)
     done
   obtain h' where h': "continuous_on U h'" "h' ` U \<subseteq> S"
               and h'h: "\<forall>x\<in>T. h' x = h x"
     using assms [OF h clo] by blast
   have [simp]: "T \<subseteq> U"
     using clo closedin_imp_subset by auto
   show "T retract_of U"
   proof (simp add: retraction_def retract_of_def, intro exI conjI)
     show "continuous_on U (g \<circ> h')"
       apply (intro continuous_on_compose h')
       apply (meson hom continuous_on_subset h' homeomorphism_cont1)
       done
     show "(g \<circ> h') ` U \<subseteq> T"
       using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
     show "\<forall>x\<in>T. (g \<circ> h') x = x"
       by clarsimp (metis h'h hom homeomorphism_def)
   qed
 qed
 
 lemma AR_eq_absolute_extensor:
   fixes S :: "'a::euclidean_space set"
   shows "AR S \<longleftrightarrow>
        (\<forall>f :: 'a * real \<Rightarrow> 'a.
         \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
                closedin (top_of_set U) T \<longrightarrow>
                 (\<exists>g. continuous_on U g \<and> g ` U \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
 apply (rule iffI)
  apply (metis AR_imp_absolute_extensor)
 apply (simp add: absolute_extensor_imp_AR)
 done
 
 lemma AR_imp_retract:
   fixes S :: "'a::euclidean_space set"
   assumes "AR S \<and> closedin (top_of_set U) S"
     shows "S retract_of U"
 using AR_imp_absolute_retract assms homeomorphic_refl by blast
 
 lemma AR_homeomorphic_AR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "AR T" "S homeomorphic T"
     shows "AR S"
 unfolding AR_def
 by (metis assms AR_imp_absolute_retract homeomorphic_trans [of _ S] homeomorphic_sym)
 
 lemma homeomorphic_AR_iff_AR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   shows "S homeomorphic T \<Longrightarrow> AR S \<longleftrightarrow> AR T"
 by (metis AR_homeomorphic_AR homeomorphic_sym)
 
 
 lemma ANR_imp_absolute_neighbourhood_extensor:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "ANR S" and contf: "continuous_on T f" and "f ` T \<subseteq> S"
       and cloUT: "closedin (top_of_set U) T"
   obtains V g where "T \<subseteq> V" "openin (top_of_set U) V"
                     "continuous_on V g"
                     "g ` V \<subseteq> S" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
 proof -
   have "aff_dim S < int (DIM('b \<times> real))"
     using aff_dim_le_DIM [of S] by simp
   then obtain C and S' :: "('b * real) set"
           where C: "convex C" "C \<noteq> {}"
             and cloCS: "closedin (top_of_set C) S'"
             and hom: "S homeomorphic S'"
     by (metis that homeomorphic_closedin_convex)
   then obtain D where opD: "openin (top_of_set C) D" and "S' retract_of D"
     using \<open>ANR S\<close> by (auto simp: ANR_def)
   then obtain r where "S' \<subseteq> D" and contr: "continuous_on D r"
                   and "r ` D \<subseteq> S'" and rid: "\<And>x. x \<in> S' \<Longrightarrow> r x = x"
     by (auto simp: retraction_def retract_of_def)
   obtain g h where homgh: "homeomorphism S S' g h"
     using hom by (force simp: homeomorphic_def)
   have "continuous_on (f ` T) g"
     by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def homgh)
   then have contgf: "continuous_on T (g \<circ> f)"
     by (intro continuous_on_compose contf)
   have gfTC: "(g \<circ> f) ` T \<subseteq> C"
   proof -
     have "g ` S = S'"
       by (metis (no_types) homeomorphism_def homgh)
     then show ?thesis
       by (metis (no_types) assms(3) cloCS closedin_def image_comp image_mono order.trans topspace_euclidean_subtopology)
   qed
   obtain f' where contf': "continuous_on U f'"
               and "f' ` U \<subseteq> C"
               and eq: "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
     by (metis Dugundji [OF C cloUT contgf gfTC])
   show ?thesis
   proof (rule_tac V = "U \<inter> f' -` D" and g = "h \<circ> r \<circ> f'" in that)
     show "T \<subseteq> U \<inter> f' -` D"
       using cloUT closedin_imp_subset \<open>S' \<subseteq> D\<close> \<open>f ` T \<subseteq> S\<close> eq homeomorphism_image1 homgh
       by fastforce
     show ope: "openin (top_of_set U) (U \<inter> f' -` D)"
       using  \<open>f' ` U \<subseteq> C\<close> by (auto simp: opD contf' continuous_openin_preimage)
     have conth: "continuous_on (r ` f' ` (U \<inter> f' -` D)) h"
       apply (rule continuous_on_subset [of S'])
       using homeomorphism_def homgh apply blast
       using \<open>r ` D \<subseteq> S'\<close> by blast
     show "continuous_on (U \<inter> f' -` D) (h \<circ> r \<circ> f')"
       apply (intro continuous_on_compose conth
                    continuous_on_subset [OF contr] continuous_on_subset [OF contf'], auto)
       done
     show "(h \<circ> r \<circ> f') ` (U \<inter> f' -` D) \<subseteq> S"
       using \<open>homeomorphism S S' g h\<close>  \<open>f' ` U \<subseteq> C\<close>  \<open>r ` D \<subseteq> S'\<close>
       by (auto simp: homeomorphism_def)
     show "\<And>x. x \<in> T \<Longrightarrow> (h \<circ> r \<circ> f') x = f x"
       using \<open>homeomorphism S S' g h\<close> \<open>f ` T \<subseteq> S\<close> eq
       by (auto simp: rid homeomorphism_def)
   qed
 qed
 
 
 corollary ANR_imp_absolute_neighbourhood_retract:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "ANR S" "S homeomorphic S'"
       and clo: "closedin (top_of_set U) S'"
   obtains V where "openin (top_of_set U) V" "S' retract_of V"
 proof -
   obtain g h where hom: "homeomorphism S S' g h"
     using assms by (force simp: homeomorphic_def)
   have h: "continuous_on S' h" " h ` S' \<subseteq> S"
     using hom homeomorphism_def apply blast
     apply (metis hom equalityE homeomorphism_def)
     done
     from ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo]
   obtain V h' where "S' \<subseteq> V" and opUV: "openin (top_of_set U) V"
                 and h': "continuous_on V h'" "h' ` V \<subseteq> S"
                 and h'h:"\<And>x. x \<in> S' \<Longrightarrow> h' x = h x"
     by (blast intro: ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo])
   have "S' retract_of V"
   proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>S' \<subseteq> V\<close>)
     show "continuous_on V (g \<circ> h')"
       apply (intro continuous_on_compose h')
       apply (meson hom continuous_on_subset h' homeomorphism_cont1)
       done
     show "(g \<circ> h') ` V \<subseteq> S'"
       using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
     show "\<forall>x\<in>S'. (g \<circ> h') x = x"
       by clarsimp (metis h'h hom homeomorphism_def)
   qed
   then show ?thesis
     by (rule that [OF opUV])
 qed
 
 corollary ANR_imp_absolute_neighbourhood_retract_UNIV:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "ANR S" and hom: "S homeomorphic S'" and clo: "closed S'"
   obtains V where "open V" "S' retract_of V"
   using ANR_imp_absolute_neighbourhood_retract [OF \<open>ANR S\<close> hom]
 by (metis clo closed_closedin open_openin subtopology_UNIV)
 
 corollary neighbourhood_extension_into_ANR:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and "ANR T" "closed S"
   obtains V g where "S \<subseteq> V" "open V" "continuous_on V g"
                     "g ` V \<subseteq> T" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   using ANR_imp_absolute_neighbourhood_extensor [OF  \<open>ANR T\<close> contf fim]
   by (metis \<open>closed S\<close> closed_closedin open_openin subtopology_UNIV)
 
 lemma absolute_neighbourhood_extensor_imp_ANR:
   fixes S :: "'a::euclidean_space set"
   assumes "\<And>f :: 'a * real \<Rightarrow> 'a.
            \<And>U T. \<lbrakk>continuous_on T f;  f ` T \<subseteq> S;
                   closedin (top_of_set U) T\<rbrakk>
                  \<Longrightarrow> \<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
                        continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)"
   shows "ANR S"
 proof (clarsimp simp: ANR_def)
   fix U and T :: "('a * real) set"
   assume "S homeomorphic T" and clo: "closedin (top_of_set U) T"
   then obtain g h where hom: "homeomorphism S T g h"
     by (force simp: homeomorphic_def)
   have h: "continuous_on T h" " h ` T \<subseteq> S"
     using hom homeomorphism_def apply blast
     apply (metis hom equalityE homeomorphism_def)
     done
   obtain V h' where "T \<subseteq> V" and opV: "openin (top_of_set U) V"
                 and h': "continuous_on V h'" "h' ` V \<subseteq> S"
               and h'h: "\<forall>x\<in>T. h' x = h x"
     using assms [OF h clo] by blast
   have [simp]: "T \<subseteq> U"
     using clo closedin_imp_subset by auto
   have "T retract_of V"
   proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>T \<subseteq> V\<close>)
     show "continuous_on V (g \<circ> h')"
       apply (intro continuous_on_compose h')
       apply (meson hom continuous_on_subset h' homeomorphism_cont1)
       done
     show "(g \<circ> h') ` V \<subseteq> T"
       using h'  by clarsimp (metis hom subsetD homeomorphism_def imageI)
     show "\<forall>x\<in>T. (g \<circ> h') x = x"
       by clarsimp (metis h'h hom homeomorphism_def)
   qed
   then show "\<exists>V. openin (top_of_set U) V \<and> T retract_of V"
     using opV by blast
 qed
 
 lemma ANR_eq_absolute_neighbourhood_extensor:
   fixes S :: "'a::euclidean_space set"
   shows "ANR S \<longleftrightarrow>
          (\<forall>f :: 'a * real \<Rightarrow> 'a.
           \<forall>U T. continuous_on T f \<longrightarrow> f ` T \<subseteq> S \<longrightarrow>
                 closedin (top_of_set U) T \<longrightarrow>
                (\<exists>V g. T \<subseteq> V \<and> openin (top_of_set U) V \<and>
                        continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x \<in> T. g x = f x)))"
 apply (rule iffI)
  apply (metis ANR_imp_absolute_neighbourhood_extensor)
 apply (simp add: absolute_neighbourhood_extensor_imp_ANR)
 done
 
 lemma ANR_imp_neighbourhood_retract:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S" "closedin (top_of_set U) S"
   obtains V where "openin (top_of_set U) V" "S retract_of V"
 using ANR_imp_absolute_neighbourhood_retract assms homeomorphic_refl by blast
 
 lemma ANR_imp_absolute_closed_neighbourhood_retract:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "ANR S" "S homeomorphic S'" and US': "closedin (top_of_set U) S'"
   obtains V W
     where "openin (top_of_set U) V"
           "closedin (top_of_set U) W"
           "S' \<subseteq> V" "V \<subseteq> W" "S' retract_of W"
 proof -
   obtain Z where "openin (top_of_set U) Z" and S'Z: "S' retract_of Z"
     by (blast intro: assms ANR_imp_absolute_neighbourhood_retract)
   then have UUZ: "closedin (top_of_set U) (U - Z)"
     by auto
   have "S' \<inter> (U - Z) = {}"
     using \<open>S' retract_of Z\<close> closedin_retract closedin_subtopology by fastforce
   then obtain V W
       where "openin (top_of_set U) V"
         and "openin (top_of_set U) W"
         and "S' \<subseteq> V" "U - Z \<subseteq> W" "V \<inter> W = {}"
       using separation_normal_local [OF US' UUZ]  by auto
   moreover have "S' retract_of U - W"
     apply (rule retract_of_subset [OF S'Z])
     using US' \<open>S' \<subseteq> V\<close> \<open>V \<inter> W = {}\<close> closedin_subset apply fastforce
     using Diff_subset_conv \<open>U - Z \<subseteq> W\<close> by blast
   ultimately show ?thesis
     apply (rule_tac V=V and W = "U-W" in that)
     using openin_imp_subset apply force+
     done
 qed
 
 lemma ANR_imp_closed_neighbourhood_retract:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S" "closedin (top_of_set U) S"
   obtains V W where "openin (top_of_set U) V"
                     "closedin (top_of_set U) W"
                     "S \<subseteq> V" "V \<subseteq> W" "S retract_of W"
 by (meson ANR_imp_absolute_closed_neighbourhood_retract assms homeomorphic_refl)
 
 lemma ANR_homeomorphic_ANR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "ANR T" "S homeomorphic T"
     shows "ANR S"
 unfolding ANR_def
 by (metis assms ANR_imp_absolute_neighbourhood_retract homeomorphic_trans [of _ S] homeomorphic_sym)
 
 lemma homeomorphic_ANR_iff_ANR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   shows "S homeomorphic T \<Longrightarrow> ANR S \<longleftrightarrow> ANR T"
 by (metis ANR_homeomorphic_ANR homeomorphic_sym)
 
 subsection \<open>Analogous properties of ENRs\<close>
 
 lemma ENR_imp_absolute_neighbourhood_retract:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "ENR S" and hom: "S homeomorphic S'"
       and "S' \<subseteq> U"
   obtains V where "openin (top_of_set U) V" "S' retract_of V"
 proof -
   obtain X where "open X" "S retract_of X"
     using \<open>ENR S\<close> by (auto simp: ENR_def)
   then obtain r where "retraction X S r"
     by (auto simp: retract_of_def)
   have "locally compact S'"
     using retract_of_locally_compact open_imp_locally_compact
           homeomorphic_local_compactness \<open>S retract_of X\<close> \<open>open X\<close> hom by blast
   then obtain W where UW: "openin (top_of_set U) W"
                   and WS': "closedin (top_of_set W) S'"
     apply (rule locally_compact_closedin_open)
     apply (rename_tac W)
     apply (rule_tac W = "U \<inter> W" in that, blast)
     by (simp add: \<open>S' \<subseteq> U\<close> closedin_limpt)
   obtain f g where hom: "homeomorphism S S' f g"
     using assms by (force simp: homeomorphic_def)
   have contg: "continuous_on S' g"
     using hom homeomorphism_def by blast
   moreover have "g ` S' \<subseteq> S" by (metis hom equalityE homeomorphism_def)
   ultimately obtain h where conth: "continuous_on W h" and hg: "\<And>x. x \<in> S' \<Longrightarrow> h x = g x"
     using Tietze_unbounded [of S' g W] WS' by blast
   have "W \<subseteq> U" using UW openin_open by auto
   have "S' \<subseteq> W" using WS' closedin_closed by auto
   have him: "\<And>x. x \<in> S' \<Longrightarrow> h x \<in> X"
     by (metis (no_types) \<open>S retract_of X\<close> hg hom homeomorphism_def image_insert insert_absorb insert_iff retract_of_imp_subset subset_eq)
   have "S' retract_of (W \<inter> h -` X)"
   proof (simp add: retraction_def retract_of_def, intro exI conjI)
     show "S' \<subseteq> W" "S' \<subseteq> h -` X"
       using him WS' closedin_imp_subset by blast+
     show "continuous_on (W \<inter> h -` X) (f \<circ> r \<circ> h)"
     proof (intro continuous_on_compose)
       show "continuous_on (W \<inter> h -` X) h"
         by (meson conth continuous_on_subset inf_le1)
       show "continuous_on (h ` (W \<inter> h -` X)) r"
       proof -
         have "h ` (W \<inter> h -` X) \<subseteq> X"
           by blast
         then show "continuous_on (h ` (W \<inter> h -` X)) r"
           by (meson \<open>retraction X S r\<close> continuous_on_subset retraction)
       qed
       show "continuous_on (r ` h ` (W \<inter> h -` X)) f"
         apply (rule continuous_on_subset [of S])
          using hom homeomorphism_def apply blast
         apply clarify
         apply (meson \<open>retraction X S r\<close> subsetD imageI retraction_def)
         done
     qed
     show "(f \<circ> r \<circ> h) ` (W \<inter> h -` X) \<subseteq> S'"
       using \<open>retraction X S r\<close> hom
       by (auto simp: retraction_def homeomorphism_def)
     show "\<forall>x\<in>S'. (f \<circ> r \<circ> h) x = x"
       using \<open>retraction X S r\<close> hom by (auto simp: retraction_def homeomorphism_def hg)
   qed
   then show ?thesis
     apply (rule_tac V = "W \<inter> h -` X" in that)
      apply (rule openin_trans [OF _ UW])
      using \<open>continuous_on W h\<close> \<open>open X\<close> continuous_openin_preimage_eq apply blast+
      done
 qed
 
 corollary ENR_imp_absolute_neighbourhood_retract_UNIV:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "ENR S" "S homeomorphic S'"
   obtains T' where "open T'" "S' retract_of T'"
 by (metis ENR_imp_absolute_neighbourhood_retract UNIV_I assms(1) assms(2) open_openin subsetI subtopology_UNIV)
 
 lemma ENR_homeomorphic_ENR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "ENR T" "S homeomorphic T"
     shows "ENR S"
 unfolding ENR_def
 by (meson ENR_imp_absolute_neighbourhood_retract_UNIV assms homeomorphic_sym)
 
 lemma homeomorphic_ENR_iff_ENR:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "S homeomorphic T"
     shows "ENR S \<longleftrightarrow> ENR T"
 by (meson ENR_homeomorphic_ENR assms homeomorphic_sym)
 
 lemma ENR_translation:
   fixes S :: "'a::euclidean_space set"
   shows "ENR(image (\<lambda>x. a + x) S) \<longleftrightarrow> ENR S"
 by (meson homeomorphic_sym homeomorphic_translation homeomorphic_ENR_iff_ENR)
 
 lemma ENR_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f"
   shows "ENR (image f S) \<longleftrightarrow> ENR S"
 apply (rule homeomorphic_ENR_iff_ENR)
 using assms homeomorphic_sym linear_homeomorphic_image by auto
 
 text \<open>Some relations among the concepts. We also relate AR to being a retract of UNIV, which is
 often a more convenient proxy in the closed case.\<close>
 
 lemma AR_imp_ANR: "AR S \<Longrightarrow> ANR S"
   using ANR_def AR_def by fastforce
 
 lemma ENR_imp_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "ENR S \<Longrightarrow> ANR S"
 apply (simp add: ANR_def)
 by (metis ENR_imp_absolute_neighbourhood_retract closedin_imp_subset)
 
 lemma ENR_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "ENR S \<longleftrightarrow> ANR S \<and> locally compact S"
 proof
   assume "ENR S"
   then have "locally compact S"
     using ENR_def open_imp_locally_compact retract_of_locally_compact by auto
   then show "ANR S \<and> locally compact S"
     using ENR_imp_ANR \<open>ENR S\<close> by blast
 next
   assume "ANR S \<and> locally compact S"
   then have "ANR S" "locally compact S" by auto
   then obtain T :: "('a * real) set" where "closed T" "S homeomorphic T"
     using locally_compact_homeomorphic_closed
     by (metis DIM_prod DIM_real Suc_eq_plus1 lessI)
   then show "ENR S"
     using \<open>ANR S\<close>
     apply (simp add: ANR_def)
     apply (drule_tac x=UNIV in spec)
     apply (drule_tac x=T in spec, clarsimp)
     apply (meson ENR_def ENR_homeomorphic_ENR open_openin)
     done
 qed
 
 
 lemma AR_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "AR S \<longleftrightarrow> ANR S \<and> contractible S \<and> S \<noteq> {}"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   obtain C and S' :: "('a * real) set"
     where "convex C" "C \<noteq> {}" "closedin (top_of_set C) S'" "S homeomorphic S'"
       apply (rule homeomorphic_closedin_convex [of S, where 'n = "'a * real"])
       using aff_dim_le_DIM [of S] by auto
   with \<open>AR S\<close> have "contractible S"
     apply (simp add: AR_def)
     apply (drule_tac x=C in spec)
     apply (drule_tac x="S'" in spec, simp)
     using convex_imp_contractible homeomorphic_contractible_eq retract_of_contractible by fastforce
   with \<open>AR S\<close> show ?rhs
     apply (auto simp: AR_imp_ANR)
     apply (force simp: AR_def)
     done
 next
   assume ?rhs
   then obtain a and h:: "real \<times> 'a \<Rightarrow> 'a"
       where conth: "continuous_on ({0..1} \<times> S) h"
         and hS: "h ` ({0..1} \<times> S) \<subseteq> S"
         and [simp]: "\<And>x. h(0, x) = x"
         and [simp]: "\<And>x. h(1, x) = a"
         and "ANR S" "S \<noteq> {}"
     by (auto simp: contractible_def homotopic_with_def)
   then have "a \<in> S"
     by (metis all_not_in_conv atLeastAtMost_iff image_subset_iff mem_Sigma_iff order_refl zero_le_one)
   have "\<exists>g. continuous_on W g \<and> g ` W \<subseteq> S \<and> (\<forall>x\<in>T. g x = f x)"
          if      f: "continuous_on T f" "f ` T \<subseteq> S"
             and WT: "closedin (top_of_set W) T"
          for W T and f :: "'a \<times> real \<Rightarrow> 'a"
   proof -
     obtain U g
       where "T \<subseteq> U" and WU: "openin (top_of_set W) U"
         and contg: "continuous_on U g"
         and "g ` U \<subseteq> S" and gf: "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
       using iffD1 [OF ANR_eq_absolute_neighbourhood_extensor \<open>ANR S\<close>, rule_format, OF f WT]
       by auto
     have WWU: "closedin (top_of_set W) (W - U)"
       using WU closedin_diff by fastforce
     moreover have "(W - U) \<inter> T = {}"
       using \<open>T \<subseteq> U\<close> by auto
     ultimately obtain V V'
       where WV': "openin (top_of_set W) V'"
         and WV: "openin (top_of_set W) V"
         and "W - U \<subseteq> V'" "T \<subseteq> V" "V' \<inter> V = {}"
       using separation_normal_local [of W "W-U" T] WT by blast
     then have WVT: "T \<inter> (W - V) = {}"
       by auto
     have WWV: "closedin (top_of_set W) (W - V)"
       using WV closedin_diff by fastforce
     obtain j :: " 'a \<times> real \<Rightarrow> real"
       where contj: "continuous_on W j"
         and j:  "\<And>x. x \<in> W \<Longrightarrow> j x \<in> {0..1}"
         and j0: "\<And>x. x \<in> W - V \<Longrightarrow> j x = 1"
         and j1: "\<And>x. x \<in> T \<Longrightarrow> j x = 0"
       by (rule Urysohn_local [OF WT WWV WVT, of 0 "1::real"]) (auto simp: in_segment)
     have Weq: "W = (W - V) \<union> (W - V')"
       using \<open>V' \<inter> V = {}\<close> by force
     show ?thesis
     proof (intro conjI exI)
       have *: "continuous_on (W - V') (\<lambda>x. h (j x, g x))"
         apply (rule continuous_on_compose2 [OF conth continuous_on_Pair])
           apply (rule continuous_on_subset [OF contj Diff_subset])
          apply (rule continuous_on_subset [OF contg])
          apply (metis Diff_subset_conv Un_commute \<open>W - U \<subseteq> V'\<close>)
         using j \<open>g ` U \<subseteq> S\<close> \<open>W - U \<subseteq> V'\<close> apply fastforce
         done
       show "continuous_on W (\<lambda>x. if x \<in> W - V then a else h (j x, g x))"
         apply (subst Weq)
         apply (rule continuous_on_cases_local)
-            apply (simp_all add: Weq [symmetric] WWV continuous_on_const *)
+            apply (simp_all add: Weq [symmetric] WWV *)
           using WV' closedin_diff apply fastforce
          apply (auto simp: j0 j1)
         done
     next
       have "h (j (x, y), g (x, y)) \<in> S" if "(x, y) \<in> W" "(x, y) \<in> V" for x y
       proof -
         have "j(x, y) \<in> {0..1}"
           using j that by blast
         moreover have "g(x, y) \<in> S"
           using \<open>V' \<inter> V = {}\<close> \<open>W - U \<subseteq> V'\<close> \<open>g ` U \<subseteq> S\<close> that by fastforce
         ultimately show ?thesis
           using hS by blast
       qed
       with \<open>a \<in> S\<close> \<open>g ` U \<subseteq> S\<close>
       show "(\<lambda>x. if x \<in> W - V then a else h (j x, g x)) ` W \<subseteq> S"
         by auto
     next
       show "\<forall>x\<in>T. (if x \<in> W - V then a else h (j x, g x)) = f x"
         using \<open>T \<subseteq> V\<close> by (auto simp: j0 j1 gf)
     qed
   qed
   then show ?lhs
     by (simp add: AR_eq_absolute_extensor)
 qed
 
 
 lemma ANR_retract_of_ANR:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR T" "S retract_of T"
   shows "ANR S"
 using assms
 apply (simp add: ANR_eq_absolute_neighbourhood_extensor retract_of_def retraction_def)
 apply (clarsimp elim!: all_forward)
 apply (erule impCE, metis subset_trans)
 apply (clarsimp elim!: ex_forward)
 apply (rule_tac x="r \<circ> g" in exI)
 by (metis comp_apply continuous_on_compose continuous_on_subset subsetD imageI image_comp image_mono subset_trans)
 
 lemma AR_retract_of_AR:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>AR T; S retract_of T\<rbrakk> \<Longrightarrow> AR S"
 using ANR_retract_of_ANR AR_ANR retract_of_contractible by fastforce
 
 lemma ENR_retract_of_ENR:
    "\<lbrakk>ENR T; S retract_of T\<rbrakk> \<Longrightarrow> ENR S"
 by (meson ENR_def retract_of_trans)
 
 lemma retract_of_UNIV:
   fixes S :: "'a::euclidean_space set"
   shows "S retract_of UNIV \<longleftrightarrow> AR S \<and> closed S"
 by (metis AR_ANR AR_imp_retract ENR_def ENR_imp_ANR closed_UNIV closed_closedin contractible_UNIV empty_not_UNIV open_UNIV retract_of_closed retract_of_contractible retract_of_empty(1) subtopology_UNIV)
 
 lemma compact_AR:
   fixes S :: "'a::euclidean_space set"
   shows "compact S \<and> AR S \<longleftrightarrow> compact S \<and> S retract_of UNIV"
 using compact_imp_closed retract_of_UNIV by blast
 
 text \<open>More properties of ARs, ANRs and ENRs\<close>
 
 lemma not_AR_empty [simp]: "\<not> AR({})"
   by (auto simp: AR_def)
 
 lemma ENR_empty [simp]: "ENR {}"
   by (simp add: ENR_def)
 
 lemma ANR_empty [simp]: "ANR ({} :: 'a::euclidean_space set)"
   by (simp add: ENR_imp_ANR)
 
 lemma convex_imp_AR:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>convex S; S \<noteq> {}\<rbrakk> \<Longrightarrow> AR S"
 apply (rule absolute_extensor_imp_AR)
 apply (rule Dugundji, assumption+)
 by blast
 
 lemma convex_imp_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "convex S \<Longrightarrow> ANR S"
 using ANR_empty AR_imp_ANR convex_imp_AR by blast
 
 lemma ENR_convex_closed:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>closed S; convex S\<rbrakk> \<Longrightarrow> ENR S"
 using ENR_def ENR_empty convex_imp_AR retract_of_UNIV by blast
 
 lemma AR_UNIV [simp]: "AR (UNIV :: 'a::euclidean_space set)"
   using retract_of_UNIV by auto
 
 lemma ANR_UNIV [simp]: "ANR (UNIV :: 'a::euclidean_space set)"
   by (simp add: AR_imp_ANR)
 
 lemma ENR_UNIV [simp]:"ENR UNIV"
   using ENR_def by blast
 
 lemma AR_singleton:
     fixes a :: "'a::euclidean_space"
     shows "AR {a}"
   using retract_of_UNIV by blast
 
 lemma ANR_singleton:
     fixes a :: "'a::euclidean_space"
     shows "ANR {a}"
   by (simp add: AR_imp_ANR AR_singleton)
 
 lemma ENR_singleton: "ENR {a}"
   using ENR_def by blast
 
 text \<open>ARs closed under union\<close>
 
 lemma AR_closed_Un_local_aux:
   fixes U :: "'a::euclidean_space set"
   assumes "closedin (top_of_set U) S"
           "closedin (top_of_set U) T"
           "AR S" "AR T" "AR(S \<inter> T)"
   shows "(S \<union> T) retract_of U"
 proof -
   have "S \<inter> T \<noteq> {}"
     using assms AR_def by fastforce
   have "S \<subseteq> U" "T \<subseteq> U"
     using assms by (auto simp: closedin_imp_subset)
   define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
   define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
   define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
   have US': "closedin (top_of_set U) S'"
     using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
     by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
   have UT': "closedin (top_of_set U) T'"
     using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
     by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
   have "S \<subseteq> S'"
     using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
   have "T \<subseteq> T'"
     using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
   have "S \<inter> T \<subseteq> W" "W \<subseteq> U"
     using \<open>S \<subseteq> U\<close> by (auto simp: W_def setdist_sing_in_set)
   have "(S \<inter> T) retract_of W"
     apply (rule AR_imp_absolute_retract [OF \<open>AR(S \<inter> T)\<close>])
      apply (simp add: homeomorphic_refl)
     apply (rule closedin_subset_trans [of U])
     apply (simp_all add: assms closedin_Int \<open>S \<inter> T \<subseteq> W\<close> \<open>W \<subseteq> U\<close>)
     done
   then obtain r0
     where "S \<inter> T \<subseteq> W" and contr0: "continuous_on W r0"
       and "r0 ` W \<subseteq> S \<inter> T"
       and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
       by (auto simp: retract_of_def retraction_def)
   have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
     using setdist_eq_0_closedin \<open>S \<inter> T \<noteq> {}\<close> assms
     by (force simp: W_def setdist_sing_in_set)
   have "S' \<inter> T' = W"
     by (auto simp: S'_def T'_def W_def)
   then have cloUW: "closedin (top_of_set U) W"
     using closedin_Int US' UT' by blast
   define r where "r \<equiv> \<lambda>x. if x \<in> W then r0 x else x"
   have "r ` (W \<union> S) \<subseteq> S" "r ` (W \<union> T) \<subseteq> T"
     using \<open>r0 ` W \<subseteq> S \<inter> T\<close> r_def by auto
   have contr: "continuous_on (W \<union> (S \<union> T)) r"
   unfolding r_def
   proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
     show "closedin (top_of_set (W \<union> (S \<union> T))) W"
       using \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> \<open>closedin (top_of_set U) W\<close> closedin_subset_trans by fastforce
     show "closedin (top_of_set (W \<union> (S \<union> T))) (S \<union> T)"
       by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
     show "\<And>x. x \<in> W \<and> x \<notin> W \<or> x \<in> S \<union> T \<and> x \<in> W \<Longrightarrow> r0 x = x"
       by (auto simp: ST)
   qed
   have cloUWS: "closedin (top_of_set U) (W \<union> S)"
     by (simp add: cloUW assms closedin_Un)
   obtain g where contg: "continuous_on U g"
              and "g ` U \<subseteq> S" and geqr: "\<And>x. x \<in> W \<union> S \<Longrightarrow> g x = r x"
     apply (rule AR_imp_absolute_extensor [OF \<open>AR S\<close> _ _ cloUWS])
       apply (rule continuous_on_subset [OF contr])
       using \<open>r ` (W \<union> S) \<subseteq> S\<close> apply auto
     done
   have cloUWT: "closedin (top_of_set U) (W \<union> T)"
     by (simp add: cloUW assms closedin_Un)
   obtain h where conth: "continuous_on U h"
              and "h ` U \<subseteq> T" and heqr: "\<And>x. x \<in> W \<union> T \<Longrightarrow> h x = r x"
     apply (rule AR_imp_absolute_extensor [OF \<open>AR T\<close> _ _ cloUWT])
       apply (rule continuous_on_subset [OF contr])
       using \<open>r ` (W \<union> T) \<subseteq> T\<close> apply auto
     done
   have "U = S' \<union> T'"
     by (force simp: S'_def T'_def)
   then have cont: "continuous_on U (\<lambda>x. if x \<in> S' then g x else h x)"
     apply (rule ssubst)
     apply (rule continuous_on_cases_local)
     using US' UT' \<open>S' \<inter> T' = W\<close> \<open>U = S' \<union> T'\<close>
           contg conth continuous_on_subset geqr heqr apply auto
     done
   have UST: "(\<lambda>x. if x \<in> S' then g x else h x) ` U \<subseteq> S \<union> T"
     using \<open>g ` U \<subseteq> S\<close> \<open>h ` U \<subseteq> T\<close> by auto
   show ?thesis
     apply (simp add: retract_of_def retraction_def \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close>)
     apply (rule_tac x="\<lambda>x. if x \<in> S' then g x else h x" in exI)
     apply (intro conjI cont UST)
     by (metis IntI ST Un_iff \<open>S \<subseteq> S'\<close> \<open>S' \<inter> T' = W\<close> \<open>T \<subseteq> T'\<close> subsetD geqr heqr r0 r_def)
 qed
 
 
 lemma AR_closed_Un_local:
   fixes S :: "'a::euclidean_space set"
   assumes STS: "closedin (top_of_set (S \<union> T)) S"
       and STT: "closedin (top_of_set (S \<union> T)) T"
       and "AR S" "AR T" "AR(S \<inter> T)"
     shows "AR(S \<union> T)"
 proof -
   have "C retract_of U"
        if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
        for U and C :: "('a * real) set"
   proof -
     obtain f g where hom: "homeomorphism (S \<union> T) C f g"
       using hom by (force simp: homeomorphic_def)
     have US: "closedin (top_of_set U) (C \<inter> g -` S)"
       apply (rule closedin_trans [OF _ UC])
       apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
       using hom homeomorphism_def apply blast
       apply (metis hom homeomorphism_def set_eq_subset)
       done
     have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
       apply (rule closedin_trans [OF _ UC])
       apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
       using hom homeomorphism_def apply blast
       apply (metis hom homeomorphism_def set_eq_subset)
       done
     have ARS: "AR (C \<inter> g -` S)"
       apply (rule AR_homeomorphic_AR [OF \<open>AR S\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have ART: "AR (C \<inter> g -` T)"
       apply (rule AR_homeomorphic_AR [OF \<open>AR T\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have ARI: "AR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
       apply (rule AR_homeomorphic_AR [OF \<open>AR (S \<inter> T)\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom
       apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
       using hom  by (auto simp: homeomorphism_def)
     then show ?thesis
       by (metis AR_closed_Un_local_aux [OF US UT ARS ART ARI])
   qed
   then show ?thesis
     by (force simp: AR_def)
 qed
 
 corollary AR_closed_Un:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>closed S; closed T; AR S; AR T; AR (S \<inter> T)\<rbrakk> \<Longrightarrow> AR (S \<union> T)"
 by (metis AR_closed_Un_local_aux closed_closedin retract_of_UNIV subtopology_UNIV)
 
 text \<open>ANRs closed under union\<close>
 
 lemma ANR_closed_Un_local_aux:
   fixes U :: "'a::euclidean_space set"
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "ANR S" "ANR T" "ANR(S \<inter> T)"
   obtains V where "openin (top_of_set U) V" "(S \<union> T) retract_of V"
 proof (cases "S = {} \<or> T = {}")
   case True with assms that show ?thesis
     by (metis ANR_imp_neighbourhood_retract Un_commute inf_bot_right sup_inf_absorb)
 next
   case False
   then have [simp]: "S \<noteq> {}" "T \<noteq> {}" by auto
   have "S \<subseteq> U" "T \<subseteq> U"
     using assms by (auto simp: closedin_imp_subset)
   define S' where "S' \<equiv> {x \<in> U. setdist {x} S \<le> setdist {x} T}"
   define T' where "T' \<equiv> {x \<in> U. setdist {x} T \<le> setdist {x} S}"
   define W  where "W \<equiv> {x \<in> U. setdist {x} S = setdist {x} T}"
   have cloUS': "closedin (top_of_set U) S'"
     using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} S - setdist {x} T" "{..0}"]
     by (simp add: S'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
   have cloUT': "closedin (top_of_set U) T'"
     using continuous_closedin_preimage [of U "\<lambda>x. setdist {x} T - setdist {x} S" "{..0}"]
     by (simp add: T'_def vimage_def Collect_conj_eq continuous_on_diff continuous_on_setdist)
   have "S \<subseteq> S'"
     using S'_def \<open>S \<subseteq> U\<close> setdist_sing_in_set by fastforce
   have "T \<subseteq> T'"
     using T'_def \<open>T \<subseteq> U\<close> setdist_sing_in_set by fastforce
   have "S' \<union> T' = U"
     by (auto simp: S'_def T'_def)
   have "W \<subseteq> S'"
     by (simp add: Collect_mono S'_def W_def)
   have "W \<subseteq> T'"
     by (simp add: Collect_mono T'_def W_def)
   have ST_W: "S \<inter> T \<subseteq> W" and "W \<subseteq> U"
     using \<open>S \<subseteq> U\<close> by (force simp: W_def setdist_sing_in_set)+
   have "S' \<inter> T' = W"
     by (auto simp: S'_def T'_def W_def)
   then have cloUW: "closedin (top_of_set U) W"
     using closedin_Int cloUS' cloUT' by blast
   obtain W' W0 where "openin (top_of_set W) W'"
                  and cloWW0: "closedin (top_of_set W) W0"
                  and "S \<inter> T \<subseteq> W'" "W' \<subseteq> W0"
                  and ret: "(S \<inter> T) retract_of W0"
     apply (rule ANR_imp_closed_neighbourhood_retract [OF \<open>ANR(S \<inter> T)\<close>])
     apply (rule closedin_subset_trans [of U, OF _ ST_W \<open>W \<subseteq> U\<close>])
     apply (blast intro: assms)+
     done
   then obtain U0 where opeUU0: "openin (top_of_set U) U0"
                    and U0: "S \<inter> T \<subseteq> U0" "U0 \<inter> W \<subseteq> W0"
     unfolding openin_open  using \<open>W \<subseteq> U\<close> by blast
   have "W0 \<subseteq> U"
     using \<open>W \<subseteq> U\<close> cloWW0 closedin_subset by fastforce
   obtain r0
     where "S \<inter> T \<subseteq> W0" and contr0: "continuous_on W0 r0" and "r0 ` W0 \<subseteq> S \<inter> T"
       and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
     using ret  by (force simp: retract_of_def retraction_def)
   have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
     using assms by (auto simp: W_def setdist_sing_in_set dest!: setdist_eq_0_closedin)
   define r where "r \<equiv> \<lambda>x. if x \<in> W0 then r0 x else x"
   have "r ` (W0 \<union> S) \<subseteq> S" "r ` (W0 \<union> T) \<subseteq> T"
     using \<open>r0 ` W0 \<subseteq> S \<inter> T\<close> r_def by auto
   have contr: "continuous_on (W0 \<union> (S \<union> T)) r"
   unfolding r_def
   proof (rule continuous_on_cases_local [OF _ _ contr0 continuous_on_id])
     show "closedin (top_of_set (W0 \<union> (S \<union> T))) W0"
       apply (rule closedin_subset_trans [of U])
       using cloWW0 cloUW closedin_trans \<open>W0 \<subseteq> U\<close> \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> apply blast+
       done
     show "closedin (top_of_set (W0 \<union> (S \<union> T))) (S \<union> T)"
       by (meson \<open>S \<subseteq> U\<close> \<open>T \<subseteq> U\<close> \<open>W0 \<subseteq> U\<close> assms closedin_Un closedin_subset_trans sup.bounded_iff sup.cobounded2)
     show "\<And>x. x \<in> W0 \<and> x \<notin> W0 \<or> x \<in> S \<union> T \<and> x \<in> W0 \<Longrightarrow> r0 x = x"
       using ST cloWW0 closedin_subset by fastforce
   qed
   have cloS'WS: "closedin (top_of_set S') (W0 \<union> S)"
     by (meson closedin_subset_trans US cloUS' \<open>S \<subseteq> S'\<close> \<open>W \<subseteq> S'\<close> cloUW cloWW0 
               closedin_Un closedin_imp_subset closedin_trans)
   obtain W1 g where "W0 \<union> S \<subseteq> W1" and contg: "continuous_on W1 g"
                 and opeSW1: "openin (top_of_set S') W1"
                 and "g ` W1 \<subseteq> S" and geqr: "\<And>x. x \<in> W0 \<union> S \<Longrightarrow> g x = r x"
     apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> _ \<open>r ` (W0 \<union> S) \<subseteq> S\<close> cloS'WS])
      apply (rule continuous_on_subset [OF contr], blast+)
     done
   have cloT'WT: "closedin (top_of_set T') (W0 \<union> T)"
     by (meson closedin_subset_trans UT cloUT' \<open>T \<subseteq> T'\<close> \<open>W \<subseteq> T'\<close> cloUW cloWW0 
               closedin_Un closedin_imp_subset closedin_trans)
   obtain W2 h where "W0 \<union> T \<subseteq> W2" and conth: "continuous_on W2 h"
                 and opeSW2: "openin (top_of_set T') W2"
                 and "h ` W2 \<subseteq> T" and heqr: "\<And>x. x \<in> W0 \<union> T \<Longrightarrow> h x = r x"
     apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> _ \<open>r ` (W0 \<union> T) \<subseteq> T\<close> cloT'WT])
      apply (rule continuous_on_subset [OF contr], blast+)
     done
   have "S' \<inter> T' = W"
     by (force simp: S'_def T'_def W_def)
   obtain O1 O2 where "open O1" "W1 = S' \<inter> O1" "open O2" "W2 = T' \<inter> O2"
     using opeSW1 opeSW2 by (force simp: openin_open)
   show ?thesis
   proof
     have eq: "W1 - (W - U0) \<union> (W2 - (W - U0)) =
          ((U - T') \<inter> O1 \<union> (U - S') \<inter> O2 \<union> U \<inter> O1 \<inter> O2) - (W - U0)"
      using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close>
       by (auto simp: \<open>S' \<union> T' = U\<close> [symmetric] \<open>S' \<inter> T' = W\<close> [symmetric] \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close>)
     show "openin (top_of_set U) (W1 - (W - U0) \<union> (W2 - (W - U0)))"
       apply (subst eq)
       apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>, simp_all)
       done
     have cloW1: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W1 - (W - U0))"
       using cloUS' apply (simp add: closedin_closed)
       apply (erule ex_forward)
       using U0 \<open>W0 \<union> S \<subseteq> W1\<close>
       apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
       done
     have cloW2: "closedin (top_of_set (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W2 - (W - U0))"
       using cloUT' apply (simp add: closedin_closed)
       apply (erule ex_forward)
       using U0 \<open>W0 \<union> T \<subseteq> W2\<close>
       apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
       done
     have *: "\<forall>x\<in>S \<union> T. (if x \<in> S' then g x else h x) = x"
       using ST \<open>S' \<inter> T' = W\<close> cloT'WT closedin_subset geqr heqr 
       apply (auto simp: r_def, fastforce)
       using \<open>S \<subseteq> S'\<close> \<open>T \<subseteq> T'\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W1 = S' \<inter> O1\<close>  by auto
     have "\<exists>r. continuous_on (W1 - (W - U0) \<union> (W2 - (W - U0))) r \<and>
               r ` (W1 - (W - U0) \<union> (W2 - (W - U0))) \<subseteq> S \<union> T \<and> 
               (\<forall>x\<in>S \<union> T. r x = x)"
       apply (rule_tac x = "\<lambda>x. if  x \<in> S' then g x else h x" in exI)
       apply (intro conjI *)
       apply (rule continuous_on_cases_local 
                   [OF cloW1 cloW2 continuous_on_subset [OF contg] continuous_on_subset [OF conth]])
       using \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<inter> T' = W\<close>
             \<open>g ` W1 \<subseteq> S\<close> \<open>h ` W2 \<subseteq> T\<close> apply auto
       using \<open>U0 \<inter> W \<subseteq> W0\<close> \<open>W0 \<union> S \<subseteq> W1\<close> apply (fastforce simp add: geqr heqr)+
       done
     then show "S \<union> T retract_of W1 - (W - U0) \<union> (W2 - (W - U0))"
       using  \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> ST opeUU0 U0
       by (auto simp: retract_of_def retraction_def)
   qed
 qed
 
 
 lemma ANR_closed_Un_local:
   fixes S :: "'a::euclidean_space set"
   assumes STS: "closedin (top_of_set (S \<union> T)) S"
       and STT: "closedin (top_of_set (S \<union> T)) T"
       and "ANR S" "ANR T" "ANR(S \<inter> T)" 
     shows "ANR(S \<union> T)"
 proof -
   have "\<exists>T. openin (top_of_set U) T \<and> C retract_of T"
        if hom: "S \<union> T homeomorphic C" and UC: "closedin (top_of_set U) C"
        for U and C :: "('a * real) set"
   proof -
     obtain f g where hom: "homeomorphism (S \<union> T) C f g"
       using hom by (force simp: homeomorphic_def)
     have US: "closedin (top_of_set U) (C \<inter> g -` S)"
       apply (rule closedin_trans [OF _ UC])
       apply (rule continuous_closedin_preimage_gen [OF _ _ STS])
       using hom [unfolded homeomorphism_def] apply blast
       apply (metis hom homeomorphism_def set_eq_subset)
       done
     have UT: "closedin (top_of_set U) (C \<inter> g -` T)"
       apply (rule closedin_trans [OF _ UC])
       apply (rule continuous_closedin_preimage_gen [OF _ _ STT])
       using hom [unfolded homeomorphism_def] apply blast
       apply (metis hom homeomorphism_def set_eq_subset)
       done
     have ANRS: "ANR (C \<inter> g -` S)"
       apply (rule ANR_homeomorphic_ANR [OF \<open>ANR S\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have ANRT: "ANR (C \<inter> g -` T)"
       apply (rule ANR_homeomorphic_ANR [OF \<open>ANR T\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have ANRI: "ANR ((C \<inter> g -` S) \<inter> (C \<inter> g -` T))"
       apply (rule ANR_homeomorphic_ANR [OF \<open>ANR (S \<inter> T)\<close>])
       apply (simp add: homeomorphic_def)
       apply (rule_tac x=g in exI)
       apply (rule_tac x=f in exI)
       using hom
       apply (auto simp: homeomorphism_def elim!: continuous_on_subset)
       apply (rule_tac x="f x" in image_eqI, auto)
       done
     have "C = (C \<inter> g -` S) \<union> (C \<inter> g -` T)"
       using hom by (auto simp: homeomorphism_def)
     then show ?thesis
       by (metis ANR_closed_Un_local_aux [OF US UT ANRS ANRT ANRI])
   qed
   then show ?thesis
     by (auto simp: ANR_def)
 qed    
 
 corollary ANR_closed_Un:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>closed S; closed T; ANR S; ANR T; ANR (S \<inter> T)\<rbrakk> \<Longrightarrow> ANR (S \<union> T)"
 by (simp add: ANR_closed_Un_local closedin_def diff_eq open_Compl openin_open_Int)
 
 lemma ANR_openin:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR T" and opeTS: "openin (top_of_set T) S"
   shows "ANR S"
 proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
   fix f :: "'a \<times> real \<Rightarrow> 'a" and U C
   assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> S"
      and cloUC: "closedin (top_of_set U) C"
   have "f ` C \<subseteq> T"
     using fim opeTS openin_imp_subset by blast
   obtain W g where "C \<subseteq> W"
                and UW: "openin (top_of_set U) W"
                and contg: "continuous_on W g"
                and gim: "g ` W \<subseteq> T"
                and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
     apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf \<open>f ` C \<subseteq> T\<close> cloUC])
     using fim by auto
   show "\<exists>V g. C \<subseteq> V \<and> openin (top_of_set U) V \<and> continuous_on V g \<and> g ` V \<subseteq> S \<and> (\<forall>x\<in>C. g x = f x)"
   proof (intro exI conjI)
     show "C \<subseteq> W \<inter> g -` S"
       using \<open>C \<subseteq> W\<close> fim geq by blast
     show "openin (top_of_set U) (W \<inter> g -` S)"
       by (metis (mono_tags, lifting) UW contg continuous_openin_preimage gim opeTS openin_trans)
     show "continuous_on (W \<inter> g -` S) g"
       by (blast intro: continuous_on_subset [OF contg])
     show "g ` (W \<inter> g -` S) \<subseteq> S"
       using gim by blast
     show "\<forall>x\<in>C. g x = f x"
       using geq by blast
   qed
 qed
 
 lemma ENR_openin:
     fixes S :: "'a::euclidean_space set"
     assumes "ENR T" and opeTS: "openin (top_of_set T) S"
     shows "ENR S"
   using assms apply (simp add: ENR_ANR)
   using ANR_openin locally_open_subset by blast
 
 lemma ANR_neighborhood_retract:
     fixes S :: "'a::euclidean_space set"
     assumes "ANR U" "S retract_of T" "openin (top_of_set U) T"
     shows "ANR S"
   using ANR_openin ANR_retract_of_ANR assms by blast
 
 lemma ENR_neighborhood_retract:
     fixes S :: "'a::euclidean_space set"
     assumes "ENR U" "S retract_of T" "openin (top_of_set U) T"
     shows "ENR S"
   using ENR_openin ENR_retract_of_ENR assms by blast
 
 lemma ANR_rel_interior:
   fixes S :: "'a::euclidean_space set"
   shows "ANR S \<Longrightarrow> ANR(rel_interior S)"
    by (blast intro: ANR_openin openin_set_rel_interior)
 
 lemma ANR_delete:
   fixes S :: "'a::euclidean_space set"
   shows "ANR S \<Longrightarrow> ANR(S - {a})"
    by (blast intro: ANR_openin openin_delete openin_subtopology_self)
 
 lemma ENR_rel_interior:
   fixes S :: "'a::euclidean_space set"
   shows "ENR S \<Longrightarrow> ENR(rel_interior S)"
    by (blast intro: ENR_openin openin_set_rel_interior)
 
 lemma ENR_delete:
   fixes S :: "'a::euclidean_space set"
   shows "ENR S \<Longrightarrow> ENR(S - {a})"
    by (blast intro: ENR_openin openin_delete openin_subtopology_self)
 
 lemma open_imp_ENR: "open S \<Longrightarrow> ENR S"
     using ENR_def by blast
 
 lemma open_imp_ANR:
     fixes S :: "'a::euclidean_space set"
     shows "open S \<Longrightarrow> ANR S"
   by (simp add: ENR_imp_ANR open_imp_ENR)
 
 lemma ANR_ball [iff]:
     fixes a :: "'a::euclidean_space"
     shows "ANR(ball a r)"
   by (simp add: convex_imp_ANR)
 
 lemma ENR_ball [iff]: "ENR(ball a r)"
   by (simp add: open_imp_ENR)
 
 lemma AR_ball [simp]:
     fixes a :: "'a::euclidean_space"
     shows "AR(ball a r) \<longleftrightarrow> 0 < r"
   by (auto simp: AR_ANR convex_imp_contractible)
 
 lemma ANR_cball [iff]:
     fixes a :: "'a::euclidean_space"
     shows "ANR(cball a r)"
   by (simp add: convex_imp_ANR)
 
 lemma ENR_cball:
     fixes a :: "'a::euclidean_space"
     shows "ENR(cball a r)"
   using ENR_convex_closed by blast
 
 lemma AR_cball [simp]:
     fixes a :: "'a::euclidean_space"
     shows "AR(cball a r) \<longleftrightarrow> 0 \<le> r"
   by (auto simp: AR_ANR convex_imp_contractible)
 
 lemma ANR_box [iff]:
     fixes a :: "'a::euclidean_space"
     shows "ANR(cbox a b)" "ANR(box a b)"
   by (auto simp: convex_imp_ANR open_imp_ANR)
 
 lemma ENR_box [iff]:
     fixes a :: "'a::euclidean_space"
     shows "ENR(cbox a b)" "ENR(box a b)"
 apply (simp add: ENR_convex_closed closed_cbox)
 by (simp add: open_box open_imp_ENR)
 
 lemma AR_box [simp]:
     "AR(cbox a b) \<longleftrightarrow> cbox a b \<noteq> {}" "AR(box a b) \<longleftrightarrow> box a b \<noteq> {}"
   by (auto simp: AR_ANR convex_imp_contractible)
 
 lemma ANR_interior:
      fixes S :: "'a::euclidean_space set"
      shows "ANR(interior S)"
   by (simp add: open_imp_ANR)
 
 lemma ENR_interior:
      fixes S :: "'a::euclidean_space set"
      shows "ENR(interior S)"
   by (simp add: open_imp_ENR)
 
 lemma AR_imp_contractible:
     fixes S :: "'a::euclidean_space set"
     shows "AR S \<Longrightarrow> contractible S"
   by (simp add: AR_ANR)
 
 lemma ENR_imp_locally_compact:
     fixes S :: "'a::euclidean_space set"
     shows "ENR S \<Longrightarrow> locally compact S"
   by (simp add: ENR_ANR)
 
 lemma ANR_imp_locally_path_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S"
     shows "locally path_connected S"
 proof -
   obtain U and T :: "('a \<times> real) set"
      where "convex U" "U \<noteq> {}"
        and UT: "closedin (top_of_set U) T"
        and "S homeomorphic T"
     apply (rule homeomorphic_closedin_convex [of S])
     using aff_dim_le_DIM [of S] apply auto
     done
   then have "locally path_connected T"
     by (meson ANR_imp_absolute_neighbourhood_retract
         assms convex_imp_locally_path_connected locally_open_subset retract_of_locally_path_connected)
   then have S: "locally path_connected S"
       if "openin (top_of_set U) V" "T retract_of V" "U \<noteq> {}" for V
     using \<open>S homeomorphic T\<close> homeomorphic_locally homeomorphic_path_connectedness by blast
   show ?thesis
     using assms
     apply (clarsimp simp: ANR_def)
     apply (drule_tac x=U in spec)
     apply (drule_tac x=T in spec)
     using \<open>S homeomorphic T\<close> \<open>U \<noteq> {}\<close> UT  apply (blast intro: S)
     done
 qed
 
 lemma ANR_imp_locally_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S"
     shows "locally connected S"
 using locally_path_connected_imp_locally_connected ANR_imp_locally_path_connected assms by auto
 
 lemma AR_imp_locally_path_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "AR S"
     shows "locally path_connected S"
 by (simp add: ANR_imp_locally_path_connected AR_imp_ANR assms)
 
 lemma AR_imp_locally_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "AR S"
     shows "locally connected S"
 using ANR_imp_locally_connected AR_ANR assms by blast
 
 lemma ENR_imp_locally_path_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "ENR S"
     shows "locally path_connected S"
 by (simp add: ANR_imp_locally_path_connected ENR_imp_ANR assms)
 
 lemma ENR_imp_locally_connected:
   fixes S :: "'a::euclidean_space set"
   assumes "ENR S"
     shows "locally connected S"
 using ANR_imp_locally_connected ENR_ANR assms by blast
 
 lemma ANR_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "ANR S" "ANR T" shows "ANR(S \<times> T)"
 proof (clarsimp simp only: ANR_eq_absolute_neighbourhood_extensor)
   fix f :: " ('a \<times> 'b) \<times> real \<Rightarrow> 'a \<times> 'b" and U C
   assume "continuous_on C f" and fim: "f ` C \<subseteq> S \<times> T"
      and cloUC: "closedin (top_of_set U) C"
   have contf1: "continuous_on C (fst \<circ> f)"
     by (simp add: \<open>continuous_on C f\<close> continuous_on_fst)
   obtain W1 g where "C \<subseteq> W1"
                and UW1: "openin (top_of_set U) W1"
                and contg: "continuous_on W1 g"
                and gim: "g ` W1 \<subseteq> S"
                and geq: "\<And>x. x \<in> C \<Longrightarrow> g x = (fst \<circ> f) x"
     apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> contf1 _ cloUC])
     using fim apply auto
     done
   have contf2: "continuous_on C (snd \<circ> f)"
     by (simp add: \<open>continuous_on C f\<close> continuous_on_snd)
   obtain W2 h where "C \<subseteq> W2"
                and UW2: "openin (top_of_set U) W2"
                and conth: "continuous_on W2 h"
                and him: "h ` W2 \<subseteq> T"
                and heq: "\<And>x. x \<in> C \<Longrightarrow> h x = (snd \<circ> f) x"
     apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> contf2 _ cloUC])
     using fim apply auto
     done
   show "\<exists>V g. C \<subseteq> V \<and>
                openin (top_of_set U) V \<and>
                continuous_on V g \<and> g ` V \<subseteq> S \<times> T \<and> (\<forall>x\<in>C. g x = f x)"
   proof (intro exI conjI)
     show "C \<subseteq> W1 \<inter> W2"
       by (simp add: \<open>C \<subseteq> W1\<close> \<open>C \<subseteq> W2\<close>)
     show "openin (top_of_set U) (W1 \<inter> W2)"
       by (simp add: UW1 UW2 openin_Int)
     show  "continuous_on (W1 \<inter> W2) (\<lambda>x. (g x, h x))"
       by (metis (no_types) contg conth continuous_on_Pair continuous_on_subset inf_commute inf_le1)
     show  "(\<lambda>x. (g x, h x)) ` (W1 \<inter> W2) \<subseteq> S \<times> T"
       using gim him by blast
     show  "(\<forall>x\<in>C. (g x, h x) = f x)"
       using geq heq by auto
   qed
 qed
 
 lemma AR_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "AR S" "AR T" shows "AR(S \<times> T)"
   using assms by (simp add: AR_ANR ANR_Times contractible_Times)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Retracts and intervals in ordered euclidean space\<close>
 
 lemma ANR_interval [iff]:
   fixes a :: "'a::ordered_euclidean_space"
   shows "ANR{a..b}"
   by (simp add: interval_cbox)
 
 lemma ENR_interval [iff]:
   fixes a :: "'a::ordered_euclidean_space"
   shows "ENR{a..b}"
   by (auto simp: interval_cbox)
 
 subsection \<open>More advanced properties of ANRs and ENRs\<close>
 
 lemma ENR_rel_frontier_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S" "convex S"
     shows "ENR(rel_frontier S)"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   with assms have "rel_interior S \<noteq> {}"
     by (simp add: rel_interior_eq_empty)
   then obtain a where a: "a \<in> rel_interior S"
     by auto
   have ahS: "affine hull S - {a} \<subseteq> {x. closest_point (affine hull S) x \<noteq> a}"
     by (auto simp: closest_point_self)
   have "rel_frontier S retract_of affine hull S - {a}"
     by (simp add: assms a rel_frontier_retract_of_punctured_affine_hull)
   also have "\<dots> retract_of {x. closest_point (affine hull S) x \<noteq> a}"
     apply (simp add: retract_of_def retraction_def ahS)
     apply (rule_tac x="closest_point (affine hull S)" in exI)
     apply (auto simp: False closest_point_self affine_imp_convex closest_point_in_set continuous_on_closest_point)
     done
   finally have "rel_frontier S retract_of {x. closest_point (affine hull S) x \<noteq> a}" .
   moreover have "openin (top_of_set UNIV) (UNIV \<inter> closest_point (affine hull S) -` (- {a}))"
     apply (rule continuous_openin_preimage_gen)
     apply (auto simp: False affine_imp_convex continuous_on_closest_point)
     done
   ultimately show ?thesis
     unfolding ENR_def
     apply (rule_tac x = "closest_point (affine hull S) -` (- {a})" in exI)
     apply (simp add: vimage_def)
     done
 qed
 
 lemma ANR_rel_frontier_convex:
                  fixes S :: "'a::euclidean_space set"
   assumes "bounded S" "convex S"
     shows "ANR(rel_frontier S)"
 by (simp add: ENR_imp_ANR ENR_rel_frontier_convex assms)
     
 lemma ENR_closedin_Un_local:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>ENR S; ENR T; ENR(S \<inter> T);
           closedin (top_of_set (S \<union> T)) S; closedin (top_of_set (S \<union> T)) T\<rbrakk>
         \<Longrightarrow> ENR(S \<union> T)"
 by (simp add: ENR_ANR ANR_closed_Un_local locally_compact_closedin_Un)
 
 lemma ENR_closed_Un:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>closed S; closed T; ENR S; ENR T; ENR(S \<inter> T)\<rbrakk> \<Longrightarrow> ENR(S \<union> T)"
 by (auto simp: closed_subset ENR_closedin_Un_local)
 
 lemma absolute_retract_Un:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>S retract_of UNIV; T retract_of UNIV; (S \<inter> T) retract_of UNIV\<rbrakk>
          \<Longrightarrow> (S \<union> T) retract_of UNIV"
   by (meson AR_closed_Un_local_aux closed_subset retract_of_UNIV retract_of_imp_subset)
 
 lemma retract_from_Un_Int:
   fixes S :: "'a::euclidean_space set"
   assumes clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
       and Un: "(S \<union> T) retract_of U" and Int: "(S \<inter> T) retract_of T"
     shows "S retract_of U"
 proof -
   obtain r where r: "continuous_on T r" "r ` T \<subseteq> S \<inter> T" "\<forall>x\<in>S \<inter> T. r x = x"
     using Int by (auto simp: retraction_def retract_of_def)
   have "S retract_of S \<union> T"
     unfolding retraction_def retract_of_def
   proof (intro exI conjI)
     show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then x else r x)"
       apply (rule continuous_on_cases_local [OF clS clT])
-      using r by (auto simp: continuous_on_id)
+      using r by (auto)
   qed (use r in auto)
   also have "\<dots> retract_of U"
     by (rule Un)
   finally show ?thesis .
 qed
 
 lemma AR_from_Un_Int_local:
   fixes S :: "'a::euclidean_space set"
   assumes clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
       and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
     shows "AR S"
   apply (rule AR_retract_of_AR [OF Un])
   by (meson AR_imp_retract clS clT closedin_closed_subset local.Int retract_from_Un_Int retract_of_refl sup_ge2)
 
 lemma AR_from_Un_Int_local':
   fixes S :: "'a::euclidean_space set"
   assumes "closedin (top_of_set (S \<union> T)) S"
       and "closedin (top_of_set (S \<union> T)) T"
       and "AR(S \<union> T)" "AR(S \<inter> T)"
     shows "AR T"
   using AR_from_Un_Int_local [of T S] assms by (simp add: Un_commute Int_commute)
 
 lemma AR_from_Un_Int:
   fixes S :: "'a::euclidean_space set"
   assumes clo: "closed S" "closed T" and Un: "AR(S \<union> T)" and Int: "AR(S \<inter> T)"
   shows "AR S"
   by (metis AR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
 
 lemma ANR_from_Un_Int_local:
   fixes S :: "'a::euclidean_space set"
   assumes clS: "closedin (top_of_set (S \<union> T)) S"
       and clT: "closedin (top_of_set (S \<union> T)) T"
       and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
     shows "ANR S"
 proof -
   obtain V where clo: "closedin (top_of_set (S \<union> T)) (S \<inter> T)"
              and ope: "openin (top_of_set (S \<union> T)) V"
              and ret: "S \<inter> T retract_of V"
     using ANR_imp_neighbourhood_retract [OF Int] by (metis clS clT closedin_Int)
   then obtain r where r: "continuous_on V r" and rim: "r ` V \<subseteq> S \<inter> T" and req: "\<forall>x\<in>S \<inter> T. r x = x"
     by (auto simp: retraction_def retract_of_def)
   have Vsub: "V \<subseteq> S \<union> T"
     by (meson ope openin_contains_cball)
   have Vsup: "S \<inter> T \<subseteq> V"
     by (simp add: retract_of_imp_subset ret)
   then have eq: "S \<union> V = ((S \<union> T) - T) \<union> V"
     by auto
   have eq': "S \<union> V = S \<union> (V \<inter> T)"
     using Vsub by blast
   have "continuous_on (S \<union> V \<inter> T) (\<lambda>x. if x \<in> S then x else r x)"
   proof (rule continuous_on_cases_local)
     show "closedin (top_of_set (S \<union> V \<inter> T)) S"
       using clS closedin_subset_trans inf.boundedE by blast
     show "closedin (top_of_set (S \<union> V \<inter> T)) (V \<inter> T)"
       using clT Vsup by (auto simp: closedin_closed)
     show "continuous_on (V \<inter> T) r"
       by (meson Int_lower1 continuous_on_subset r)
   qed (use req continuous_on_id in auto)
   with rim have "S retract_of S \<union> V"
     unfolding retraction_def retract_of_def
     apply (rule_tac x="\<lambda>x. if x \<in> S then x else r x" in exI)
     apply (auto simp: eq')
     done
   then show ?thesis
     using ANR_neighborhood_retract [OF Un]
     using \<open>S \<union> V = S \<union> T - T \<union> V\<close> clT ope by fastforce
 qed
 
 lemma ANR_from_Un_Int:
   fixes S :: "'a::euclidean_space set"
   assumes clo: "closed S" "closed T" and Un: "ANR(S \<union> T)" and Int: "ANR(S \<inter> T)"
   shows "ANR S"
   by (metis ANR_from_Un_Int_local [OF _ _ Un Int] Un_commute clo closed_closedin closedin_closed_subset inf_sup_absorb subtopology_UNIV top_greatest)
 
 lemma ANR_finite_Union_convex_closed:
   fixes \<T> :: "'a::euclidean_space set set"
   assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
   shows "ANR(\<Union>\<T>)"
 proof -
   have "ANR(\<Union>\<T>)" if "card \<T> < n" for n
   using assms that
   proof (induction n arbitrary: \<T>)
     case 0 then show ?case by simp
   next
     case (Suc n)
     have "ANR(\<Union>\<U>)" if "finite \<U>" "\<U> \<subseteq> \<T>" for \<U>
       using that
     proof (induction \<U>)
       case empty
       then show ?case  by simp
     next
       case (insert C \<U>)
       have "ANR (C \<union> \<Union>\<U>)"
       proof (rule ANR_closed_Un)
         show "ANR (C \<inter> \<Union>\<U>)"
           unfolding Int_Union
         proof (rule Suc)
           show "finite ((\<inter>) C ` \<U>)"
             by (simp add: insert.hyps(1))
           show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> closed Ca"
             by (metis (no_types, hide_lams) Suc.prems(2) closed_Int subsetD imageE insert.prems insertI1 insertI2)
           show "\<And>Ca. Ca \<in> (\<inter>) C ` \<U> \<Longrightarrow> convex Ca"
             by (metis (mono_tags, lifting) Suc.prems(3) convex_Int imageE insert.prems insert_subset subsetCE)
           show "card ((\<inter>) C ` \<U>) < n"
           proof -
             have "card \<T> \<le> n"
               by (meson Suc.prems(4) not_less not_less_eq)
             then show ?thesis
               by (metis Suc.prems(1) card_image_le card_seteq insert.hyps insert.prems insert_subset le_trans not_less)
           qed
         qed
         show "closed (\<Union>\<U>)"
           using Suc.prems(2) insert.hyps(1) insert.prems by blast
       qed (use Suc.prems convex_imp_ANR insert.prems insert.IH in auto)
       then show ?case
         by simp
     qed
     then show ?case
       using Suc.prems(1) by blast
   qed
   then show ?thesis
     by blast
 qed
 
 
 lemma finite_imp_ANR:
   fixes S :: "'a::euclidean_space set"
   assumes "finite S"
   shows "ANR S"
 proof -
   have "ANR(\<Union>x \<in> S. {x})"
     by (blast intro: ANR_finite_Union_convex_closed assms)
   then show ?thesis
     by simp
 qed
 
 lemma ANR_insert:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S" "closed S"
   shows "ANR(insert a S)"
   by (metis ANR_closed_Un ANR_empty ANR_singleton Diff_disjoint Diff_insert_absorb assms closed_singleton insert_absorb insert_is_Un)
 
 lemma ANR_path_component_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "ANR S \<Longrightarrow> ANR(path_component_set S x)"
   using ANR_imp_locally_path_connected ANR_openin openin_path_component_locally_path_connected by blast
 
 lemma ANR_connected_component_ANR:
   fixes S :: "'a::euclidean_space set"
   shows "ANR S \<Longrightarrow> ANR(connected_component_set S x)"
   by (metis ANR_openin openin_connected_component_locally_connected ANR_imp_locally_connected)
 
 lemma ANR_component_ANR:
   fixes S :: "'a::euclidean_space set"
   assumes "ANR S" "c \<in> components S"
   shows "ANR c"
   by (metis ANR_connected_component_ANR assms componentsE)
 
 subsection\<open>Original ANR material, now for ENRs\<close>
 
 lemma ENR_bounded:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S"
   shows "ENR S \<longleftrightarrow> (\<exists>U. open U \<and> bounded U \<and> S retract_of U)"
          (is "?lhs = ?rhs")
 proof
   obtain r where "0 < r" and r: "S \<subseteq> ball 0 r"
     using bounded_subset_ballD assms by blast
   assume ?lhs
   then show ?rhs
     apply (clarsimp simp: ENR_def)
     apply (rule_tac x="ball 0 r \<inter> U" in exI, auto)
     using r retract_of_imp_subset retract_of_subset by fastforce
 next
   assume ?rhs
   then show ?lhs
     using ENR_def by blast
 qed
 
 lemma absolute_retract_imp_AR_gen:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "S retract_of T" "convex T" "T \<noteq> {}" "S homeomorphic S'" "closedin (top_of_set U) S'"
   shows "S' retract_of U"
 proof -
   have "AR T"
     by (simp add: assms convex_imp_AR)
   then have "AR S"
     using AR_retract_of_AR assms by auto
   then show ?thesis
     using assms AR_imp_absolute_retract by metis
 qed
 
 lemma absolute_retract_imp_AR:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "S retract_of UNIV" "S homeomorphic S'" "closed S'"
   shows "S' retract_of UNIV"
   using AR_imp_absolute_retract_UNIV assms retract_of_UNIV by blast
 
 lemma homeomorphic_compact_arness:
   fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   assumes "S homeomorphic S'"
   shows "compact S \<and> S retract_of UNIV \<longleftrightarrow> compact S' \<and> S' retract_of UNIV"
   using assms homeomorphic_compactness
   apply auto
    apply (meson assms compact_AR homeomorphic_AR_iff_AR homeomorphic_compactness)+
   done
 
 lemma absolute_retract_from_Un_Int:
   fixes S :: "'a::euclidean_space set"
   assumes "(S \<union> T) retract_of UNIV" "(S \<inter> T) retract_of UNIV" "closed S" "closed T"
   shows "S retract_of UNIV"
   using AR_from_Un_Int assms retract_of_UNIV by auto
 
 lemma ENR_from_Un_Int_gen:
   fixes S :: "'a::euclidean_space set"
   assumes "closedin (top_of_set (S \<union> T)) S" "closedin (top_of_set (S \<union> T)) T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
   shows "ENR S"
   apply (simp add: ENR_ANR)
   using ANR_from_Un_Int_local ENR_ANR assms locally_compact_closedin by blast
 
 
 lemma ENR_from_Un_Int:
   fixes S :: "'a::euclidean_space set"
   assumes "closed S" "closed T" "ENR(S \<union> T)" "ENR(S \<inter> T)"
   shows "ENR S"
   by (meson ENR_from_Un_Int_gen assms closed_subset sup_ge1 sup_ge2)
 
 
 lemma ENR_finite_Union_convex_closed:
   fixes \<T> :: "'a::euclidean_space set set"
   assumes \<T>: "finite \<T>" and clo: "\<And>C. C \<in> \<T> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<T> \<Longrightarrow> convex C"
   shows "ENR(\<Union> \<T>)"
   by (simp add: ENR_ANR ANR_finite_Union_convex_closed \<T> clo closed_Union closed_imp_locally_compact con)
 
 lemma finite_imp_ENR:
   fixes S :: "'a::euclidean_space set"
   shows "finite S \<Longrightarrow> ENR S"
   by (simp add: ENR_ANR finite_imp_ANR finite_imp_closed closed_imp_locally_compact)
 
 lemma ENR_insert:
   fixes S :: "'a::euclidean_space set"
   assumes "closed S" "ENR S"
   shows "ENR(insert a S)"
 proof -
   have "ENR ({a} \<union> S)"
     by (metis ANR_insert ENR_ANR Un_commute Un_insert_right assms closed_imp_locally_compact closed_insert sup_bot_right)
   then show ?thesis
     by auto
 qed
 
 lemma ENR_path_component_ENR:
   fixes S :: "'a::euclidean_space set"
   assumes "ENR S"
   shows "ENR(path_component_set S x)"
   by (metis ANR_imp_locally_path_connected ENR_empty ENR_imp_ANR ENR_openin assms
             locally_path_connected_2 openin_subtopology_self path_component_eq_empty)
 
 (*UNUSED
 lemma ENR_Times:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "ENR S" "ENR T" shows "ENR(S \<times> T)"
 using assms apply (simp add: ENR_ANR ANR_Times)
 thm locally_compact_Times
 oops
   SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);;
 *)
 
 subsection\<open>Finally, spheres are ANRs and ENRs\<close>
 
 lemma absolute_retract_homeomorphic_convex_compact:
   fixes S :: "'a::euclidean_space set" and U :: "'b::euclidean_space set"
   assumes "S homeomorphic U" "S \<noteq> {}" "S \<subseteq> T" "convex U" "compact U"
   shows "S retract_of T"
   by (metis UNIV_I assms compact_AR convex_imp_AR homeomorphic_AR_iff_AR homeomorphic_compactness homeomorphic_empty(1) retract_of_subset subsetI)
 
 lemma frontier_retract_of_punctured_universe:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "bounded S" "a \<in> interior S"
   shows "(frontier S) retract_of (- {a})"
   using rel_frontier_retract_of_punctured_affine_hull
   by (metis Compl_eq_Diff_UNIV affine_hull_nonempty_interior assms empty_iff rel_frontier_frontier rel_interior_nonempty_interior)
 
 lemma sphere_retract_of_punctured_universe_gen:
   fixes a :: "'a::euclidean_space"
   assumes "b \<in> ball a r"
   shows  "sphere a r retract_of (- {b})"
 proof -
   have "frontier (cball a r) retract_of (- {b})"
     apply (rule frontier_retract_of_punctured_universe)
     using assms by auto
   then show ?thesis
     by simp
 qed
 
 lemma sphere_retract_of_punctured_universe:
   fixes a :: "'a::euclidean_space"
   assumes "0 < r"
   shows "sphere a r retract_of (- {a})"
   by (simp add: assms sphere_retract_of_punctured_universe_gen)
 
 lemma ENR_sphere:
   fixes a :: "'a::euclidean_space"
   shows "ENR(sphere a r)"
 proof (cases "0 < r")
   case True
   then have "sphere a r retract_of -{a}"
     by (simp add: sphere_retract_of_punctured_universe)
   with open_delete show ?thesis
     by (auto simp: ENR_def)
 next
   case False
   then show ?thesis
     using finite_imp_ENR
     by (metis finite_insert infinite_imp_nonempty less_linear sphere_eq_empty sphere_trivial)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> ANR_sphere:
   fixes a :: "'a::euclidean_space"
   shows "ANR(sphere a r)"
   by (simp add: ENR_imp_ANR ENR_sphere)
 
 subsection\<open>Spheres are connected, etc\<close>
 
 lemma locally_path_connected_sphere_gen:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S" and "convex S" 
   shows "locally path_connected (rel_frontier S)"
 proof (cases "rel_interior S = {}")
   case True
   with assms show ?thesis
     by (simp add: rel_interior_eq_empty)
 next
   case False
   then obtain a where a: "a \<in> rel_interior S"
     by blast
   show ?thesis
   proof (rule retract_of_locally_path_connected)
     show "locally path_connected (affine hull S - {a})"
       by (meson convex_affine_hull convex_imp_locally_path_connected locally_open_subset openin_delete openin_subtopology_self)
     show "rel_frontier S retract_of affine hull S - {a}"
       using a assms rel_frontier_retract_of_punctured_affine_hull by blast
   qed
 qed
 
 lemma locally_connected_sphere_gen:
   fixes S :: "'a::euclidean_space set"
   assumes "bounded S" and "convex S" 
   shows "locally connected (rel_frontier S)"
   by (simp add: ANR_imp_locally_connected ANR_rel_frontier_convex assms)
 
 lemma locally_path_connected_sphere:
   fixes a :: "'a::euclidean_space"
   shows "locally path_connected (sphere a r)"
   using ENR_imp_locally_path_connected ENR_sphere by blast
 
 lemma locally_connected_sphere:
   fixes a :: "'a::euclidean_space"
   shows "locally connected(sphere a r)"
   using ANR_imp_locally_connected ANR_sphere by blast
 
 subsection\<open>Borsuk homotopy extension theorem\<close>
 
 text\<open>It's only this late so we can use the concept of retraction,
   saying that the domain sets or range set are ENRs.\<close>
 
 theorem Borsuk_homotopy_extension_homotopic:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes cloTS: "closedin (top_of_set T) S"
       and anr: "(ANR S \<and> ANR T) \<or> ANR U"
       and contf: "continuous_on T f"
       and "f ` T \<subseteq> U"
       and "homotopic_with_canon (\<lambda>x. True) S U f g"
    obtains g' where "homotopic_with_canon (\<lambda>x. True) T U f g'"
                     "continuous_on T g'" "image g' T \<subseteq> U"
                     "\<And>x. x \<in> S \<Longrightarrow> g' x = g x"
 proof -
   have "S \<subseteq> T" using assms closedin_imp_subset by blast
   obtain h where conth: "continuous_on ({0..1} \<times> S) h"
              and him: "h ` ({0..1} \<times> S) \<subseteq> U"
              and [simp]: "\<And>x. h(0, x) = f x" "\<And>x. h(1::real, x) = g x"
        using assms by (auto simp: homotopic_with_def)
   define h' where "h' \<equiv>  \<lambda>z. if snd z \<in> S then h z else (f \<circ> snd) z"
   define B where "B \<equiv> {0::real} \<times> T \<union> {0..1} \<times> S"
   have clo0T: "closedin (top_of_set ({0..1} \<times> T)) ({0::real} \<times> T)"
     by (simp add: Abstract_Topology.closedin_Times)
   moreover have cloT1S: "closedin (top_of_set ({0..1} \<times> T)) ({0..1} \<times> S)"
     by (simp add: Abstract_Topology.closedin_Times assms)
   ultimately have clo0TB:"closedin (top_of_set ({0..1} \<times> T)) B"
     by (auto simp: B_def)
   have cloBS: "closedin (top_of_set B) ({0..1} \<times> S)"
     by (metis (no_types) Un_subset_iff B_def closedin_subset_trans [OF cloT1S] clo0TB closedin_imp_subset closedin_self)
   moreover have cloBT: "closedin (top_of_set B) ({0} \<times> T)"
     using \<open>S \<subseteq> T\<close> closedin_subset_trans [OF clo0T]
     by (metis B_def Un_upper1 clo0TB closedin_closed inf_le1)
   moreover have "continuous_on ({0} \<times> T) (f \<circ> snd)"
     apply (rule continuous_intros)+
     apply (simp add: contf)
     done
   ultimately have conth': "continuous_on B h'"
     apply (simp add: h'_def B_def Un_commute [of "{0} \<times> T"])
     apply (auto intro!: continuous_on_cases_local conth)
     done
   have "image h' B \<subseteq> U"
     using \<open>f ` T \<subseteq> U\<close> him by (auto simp: h'_def B_def)
   obtain V k where "B \<subseteq> V" and opeTV: "openin (top_of_set ({0..1} \<times> T)) V"
                and contk: "continuous_on V k" and kim: "k ` V \<subseteq> U"
                and keq: "\<And>x. x \<in> B \<Longrightarrow> k x = h' x"
   using anr
   proof
     assume ST: "ANR S \<and> ANR T"
     have eq: "({0} \<times> T \<inter> {0..1} \<times> S) = {0::real} \<times> S"
       using \<open>S \<subseteq> T\<close> by auto
     have "ANR B"
       apply (simp add: B_def)
       apply (rule ANR_closed_Un_local)
           apply (metis cloBT B_def)
          apply (metis Un_commute cloBS B_def)
         apply (simp_all add: ANR_Times convex_imp_ANR ANR_singleton ST eq)
       done
     note Vk = that
     have *: thesis if "openin (top_of_set ({0..1::real} \<times> T)) V"
                       "retraction V B r" for V r
       using that
       apply (clarsimp simp add: retraction_def)
       apply (rule Vk [of V "h' \<circ> r"], assumption+)
         apply (metis continuous_on_compose conth' continuous_on_subset) 
       using \<open>h' ` B \<subseteq> U\<close> apply force+
       done
     show thesis
         apply (rule ANR_imp_neighbourhood_retract [OF \<open>ANR B\<close> clo0TB])
         apply (auto simp: ANR_Times ANR_singleton ST retract_of_def *)
         done
   next
     assume "ANR U"
     with ANR_imp_absolute_neighbourhood_extensor \<open>h' ` B \<subseteq> U\<close> clo0TB conth' that
     show ?thesis by blast
   qed
   define S' where "S' \<equiv> {x. \<exists>u::real. u \<in> {0..1} \<and> (u, x::'a) \<in> {0..1} \<times> T - V}"
   have "closedin (top_of_set T) S'"
     unfolding S'_def
     apply (rule closedin_compact_projection, blast)
     using closedin_self opeTV by blast
   have S'_def: "S' = {x. \<exists>u::real.  (u, x::'a) \<in> {0..1} \<times> T - V}"
     by (auto simp: S'_def)
   have cloTS': "closedin (top_of_set T) S'"
     using S'_def \<open>closedin (top_of_set T) S'\<close> by blast
   have "S \<inter> S' = {}"
     using S'_def B_def \<open>B \<subseteq> V\<close> by force
   obtain a :: "'a \<Rightarrow> real" where conta: "continuous_on T a"
       and "\<And>x. x \<in> T \<Longrightarrow> a x \<in> closed_segment 1 0"
       and a1: "\<And>x. x \<in> S \<Longrightarrow> a x = 1"
       and a0: "\<And>x. x \<in> S' \<Longrightarrow> a x = 0"
     apply (rule Urysohn_local [OF cloTS cloTS' \<open>S \<inter> S' = {}\<close>, of 1 0], blast)
     done
   then have ain: "\<And>x. x \<in> T \<Longrightarrow> a x \<in> {0..1}"
     using closed_segment_eq_real_ivl by auto
   have inV: "(u * a t, t) \<in> V" if "t \<in> T" "0 \<le> u" "u \<le> 1" for t u
   proof (rule ccontr)
     assume "(u * a t, t) \<notin> V"
     with ain [OF \<open>t \<in> T\<close>] have "a t = 0"
       apply simp
       apply (rule a0)
       by (metis (no_types, lifting) Diff_iff S'_def SigmaI atLeastAtMost_iff mem_Collect_eq mult_le_one mult_nonneg_nonneg that)
     show False
       using B_def \<open>(u * a t, t) \<notin> V\<close> \<open>B \<subseteq> V\<close> \<open>a t = 0\<close> that by auto
   qed
   show ?thesis
   proof
     show hom: "homotopic_with_canon (\<lambda>x. True) T U f (\<lambda>x. k (a x, x))"
     proof (simp add: homotopic_with, intro exI conjI)
       show "continuous_on ({0..1} \<times> T) (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z)))"
         apply (intro continuous_on_compose continuous_intros)
         apply (rule continuous_on_subset [OF conta], force)
         apply (rule continuous_on_subset [OF contk])
         apply (force intro: inV)
         done
       show "(k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) ` ({0..1} \<times> T) \<subseteq> U"
         using inV kim by auto
       show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (0, x) = f x"
         by (simp add: B_def h'_def keq)
       show "\<forall>x\<in>T. (k \<circ> (\<lambda>z. (fst z *\<^sub>R (a \<circ> snd) z, snd z))) (1, x) = k (a x, x)"
         by auto
     qed
   show "continuous_on T (\<lambda>x. k (a x, x))"
     using homotopic_with_imp_continuous_maps [OF hom] by auto
   show "(\<lambda>x. k (a x, x)) ` T \<subseteq> U"
   proof clarify
     fix t
     assume "t \<in> T"
     show "k (a t, t) \<in> U"
       by (metis \<open>t \<in> T\<close> image_subset_iff inV kim not_one_le_zero linear mult_cancel_right1)
   qed
   show "\<And>x. x \<in> S \<Longrightarrow> k (a x, x) = g x"
     by (simp add: B_def a1 h'_def keq)
   qed
 qed
 
 
 corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_ANR_extension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "closed S"
       and contf: "continuous_on S f"
       and "ANR T"
       and fim: "f ` S \<subseteq> T"
       and "S \<noteq> {}"
    shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S T f (\<lambda>x. c)) \<longleftrightarrow>
           (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> T \<and> (\<forall>x \<in> S. g x = f x))"
        (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain c where c: "homotopic_with_canon (\<lambda>x. True) S T (\<lambda>x. c) f"
     by (blast intro: homotopic_with_symD)
   have "closedin (top_of_set UNIV) S"
     using \<open>closed S\<close> closed_closedin by fastforce
   then obtain g where "continuous_on UNIV g" "range g \<subseteq> T"
                       "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
     apply (rule Borsuk_homotopy_extension_homotopic [OF _ _ continuous_on_const _ c, where T=UNIV])
     using \<open>ANR T\<close> \<open>S \<noteq> {}\<close> c homotopic_with_imp_subset1 apply fastforce+
     done
   then show ?rhs by blast
 next
   assume ?rhs
   then obtain g where "continuous_on UNIV g" "range g \<subseteq> T" "\<And>x. x\<in>S \<Longrightarrow> g x = f x"
     by blast
   then obtain c where "homotopic_with_canon (\<lambda>h. True) UNIV T g (\<lambda>x. c)"
     using nullhomotopic_from_contractible [of UNIV g T] contractible_UNIV by blast
   then have "homotopic_with_canon (\<lambda>x. True) S T g (\<lambda>x. c)"
     by (simp add: homotopic_from_subtopology)
   then show ?lhs
     by (force elim: homotopic_with_eq [of _ _ _ g "\<lambda>x. c"] simp: \<open>\<And>x. x \<in> S \<Longrightarrow> g x = f x\<close>)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_rel_frontier_extension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "closed S"
       and contf: "continuous_on S f"
       and "convex T" "bounded T"
       and fim: "f ` S \<subseteq> rel_frontier T"
       and "S \<noteq> {}"
    shows "(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (rel_frontier T) f (\<lambda>x. c)) \<longleftrightarrow>
           (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> rel_frontier T \<and> (\<forall>x \<in> S. g x = f x))"
 by (simp add: nullhomotopic_into_ANR_extension assms ANR_rel_frontier_convex)
 
 corollary\<^marker>\<open>tag unimportant\<close> nullhomotopic_into_sphere_extension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b :: euclidean_space"
   assumes "closed S" and contf: "continuous_on S f"
       and "S \<noteq> {}" and fim: "f ` S \<subseteq> sphere a r"
     shows "((\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere a r) f (\<lambda>x. c)) \<longleftrightarrow>
            (\<exists>g. continuous_on UNIV g \<and> range g \<subseteq> sphere a r \<and> (\<forall>x \<in> S. g x = f x)))"
            (is "?lhs = ?rhs")
 proof (cases "r = 0")
   case True with fim show ?thesis
     apply auto
     using fim continuous_on_const apply fastforce
     by (metis contf contractible_sing nullhomotopic_into_contractible)
 next
   case False
   then have eq: "sphere a r = rel_frontier (cball a r)" by simp
   show ?thesis
     using fim unfolding eq
     apply (rule nullhomotopic_into_rel_frontier_extension [OF \<open>closed S\<close> contf convex_cball bounded_cball])
     apply (rule \<open>S \<noteq> {}\<close>)
     done
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> Borsuk_map_essential_bounded_component:
   fixes a :: "'a :: euclidean_space"
   assumes "compact S" and "a \<notin> S"
    shows "bounded (connected_component_set (- S) a) \<longleftrightarrow>
           \<not>(\<exists>c. homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
                                (\<lambda>x. inverse(norm(x - a)) *\<^sub>R (x - a)) (\<lambda>x. c))"
    (is "?lhs = ?rhs")
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   have "closed S" "bounded S"
     using \<open>compact S\<close> compact_eq_bounded_closed by auto
   have s01: "(\<lambda>x. (x - a) /\<^sub>R norm (x - a)) ` S \<subseteq> sphere 0 1"
     using \<open>a \<notin> S\<close>  by clarsimp (metis dist_eq_0_iff dist_norm mult.commute right_inverse)
   have aincc: "a \<in> connected_component_set (- S) a"
     by (simp add: \<open>a \<notin> S\<close>)
   obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
     using bounded_subset_ballD \<open>bounded S\<close> by blast
   have "\<not> ?rhs \<longleftrightarrow> \<not> ?lhs"
   proof
     assume notr: "\<not> ?rhs"
     have nog: "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
                    g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
                    (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
          if "bounded (connected_component_set (- S) a)"
       apply (rule non_extensible_Borsuk_map [OF \<open>compact S\<close> componentsI _ aincc])
       using  \<open>a \<notin> S\<close> that by auto
     obtain g where "range g \<subseteq> sphere 0 1" "continuous_on UNIV g"
                         "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
       using notr
       by (auto simp: nullhomotopic_into_sphere_extension
                  [OF \<open>closed S\<close> continuous_on_Borsuk_map [OF \<open>a \<notin> S\<close>] False s01])
     with \<open>a \<notin> S\<close> show  "\<not> ?lhs"
       apply (clarsimp simp: Borsuk_map_into_sphere [of a S, symmetric] dest!: nog)
       apply (drule_tac x=g in spec)
       using continuous_on_subset by fastforce 
   next
     assume "\<not> ?lhs"
     then obtain b where b: "b \<in> connected_component_set (- S) a" and "r \<le> norm b"
       using bounded_iff linear by blast
     then have bnot: "b \<notin> ball 0 r"
       by simp
     have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
                                                    (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
       apply (rule Borsuk_maps_homotopic_in_path_component)
       using \<open>closed S\<close> b open_Compl open_path_connected_component apply fastforce
       done
     moreover
     obtain c where "homotopic_with_canon (\<lambda>x. True) (ball 0 r) (sphere 0 1)
                                    (\<lambda>x. inverse (norm (x - b)) *\<^sub>R (x - b)) (\<lambda>x. c)"
     proof (rule nullhomotopic_from_contractible)
       show "contractible (ball (0::'a) r)"
         by (metis convex_imp_contractible convex_ball)
       show "continuous_on (ball 0 r) (\<lambda>x. inverse(norm (x - b)) *\<^sub>R (x - b))"
         by (rule continuous_on_Borsuk_map [OF bnot])
       show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ball 0 r \<subseteq> sphere 0 1"
         using bnot Borsuk_map_into_sphere by blast
     qed blast
     ultimately have "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1) (\<lambda>x. (x - a) /\<^sub>R norm (x - a)) (\<lambda>x. c)"
       by (meson homotopic_with_subset_left homotopic_with_trans r)
     then show "\<not> ?rhs"
       by blast
   qed
   then show ?thesis by blast
 qed
 
 lemma homotopic_Borsuk_maps_in_bounded_component:
   fixes a :: "'a :: euclidean_space"
   assumes "compact S" and "a \<notin> S"and "b \<notin> S"
       and boc: "bounded (connected_component_set (- S) a)"
       and hom: "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
                                (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
                                (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
    shows "connected_component (- S) a b"
 proof (rule ccontr)
   assume notcc: "\<not> connected_component (- S) a b"
   let ?T = "S \<union> connected_component_set (- S) a"
   have "\<nexists>g. continuous_on (S \<union> connected_component_set (- S) a) g \<and>
             g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1 \<and>
             (\<forall>x\<in>S. g x = (x - a) /\<^sub>R norm (x - a))"
     by (simp add: \<open>a \<notin> S\<close> componentsI non_extensible_Borsuk_map [OF \<open>compact S\<close> _ boc])
   moreover obtain g where "continuous_on (S \<union> connected_component_set (- S) a) g"
                           "g ` (S \<union> connected_component_set (- S) a) \<subseteq> sphere 0 1"
                           "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
   proof (rule Borsuk_homotopy_extension_homotopic)
     show "closedin (top_of_set ?T) S"
       by (simp add: \<open>compact S\<close> closed_subset compact_imp_closed)
     show "continuous_on ?T (\<lambda>x. (x - b) /\<^sub>R norm (x - b))"
       by (simp add: \<open>b \<notin> S\<close> notcc continuous_on_Borsuk_map)
     show "(\<lambda>x. (x - b) /\<^sub>R norm (x - b)) ` ?T \<subseteq> sphere 0 1"
       by (simp add: \<open>b \<notin> S\<close> notcc Borsuk_map_into_sphere)
     show "homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
              (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) (\<lambda>x. (x - a) /\<^sub>R norm (x - a))"
       by (simp add: hom homotopic_with_symD)
     qed (auto simp: ANR_sphere intro: that)
   ultimately show False by blast
 qed
 
 
 lemma Borsuk_maps_homotopic_in_connected_component_eq:
   fixes a :: "'a :: euclidean_space"
   assumes S: "compact S" "a \<notin> S" "b \<notin> S" and 2: "2 \<le> DIM('a)"
     shows "(homotopic_with_canon (\<lambda>x. True) S (sphere 0 1)
                    (\<lambda>x. (x - a) /\<^sub>R norm (x - a))
                    (\<lambda>x. (x - b) /\<^sub>R norm (x - b)) \<longleftrightarrow>
            connected_component (- S) a b)"
          (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof (cases "bounded(connected_component_set (- S) a)")
     case True
     show ?thesis
       by (rule homotopic_Borsuk_maps_in_bounded_component [OF S True L])
   next
     case not_bo_a: False
     show ?thesis
     proof (cases "bounded(connected_component_set (- S) b)")
       case True
       show ?thesis
         using homotopic_Borsuk_maps_in_bounded_component [OF S]
         by (simp add: L True assms connected_component_sym homotopic_Borsuk_maps_in_bounded_component homotopic_with_sym)
     next
       case False
       then show ?thesis
         using cobounded_unique_unbounded_component [of "-S" a b] \<open>compact S\<close> not_bo_a
         by (auto simp: compact_eq_bounded_closed assms connected_component_eq_eq)
     qed
   qed
 next
   assume R: ?rhs
   then have "path_component (- S) a b"
     using assms(1) compact_eq_bounded_closed open_Compl open_path_connected_component_set by fastforce
   then show ?lhs
     by (simp add: Borsuk_maps_homotopic_in_path_component)
 qed
 
 subsection\<open>More extension theorems\<close>
 
 lemma extension_from_clopen:
   assumes ope: "openin (top_of_set S) T"
       and clo: "closedin (top_of_set S) T"
       and contf: "continuous_on T f" and fim: "f ` T \<subseteq> U" and null: "U = {} \<Longrightarrow> S = {}"
  obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> g x = f x"
 proof (cases "U = {}")
   case True
   then show ?thesis
     by (simp add: null that)
 next
   case False
   then obtain a where "a \<in> U"
     by auto
   let ?g = "\<lambda>x. if x \<in> T then f x else a"
   have Seq: "S = T \<union> (S - T)"
     using clo closedin_imp_subset by fastforce
   show ?thesis
   proof
     have "continuous_on (T \<union> (S - T)) ?g"
       apply (rule continuous_on_cases_local)
-      using Seq clo ope by (auto simp: contf continuous_on_const intro: continuous_on_cases_local)
+      using Seq clo ope by (auto simp: contf intro: continuous_on_cases_local)
     with Seq show "continuous_on S ?g"
       by metis
     show "?g ` S \<subseteq> U"
       using \<open>a \<in> U\<close> fim by auto
     show "\<And>x. x \<in> T \<Longrightarrow> ?g x = f x"
       by auto
   qed
 qed
 
 
 lemma extension_from_component:
   fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
   assumes S: "locally connected S \<or> compact S" and "ANR U"
      and C: "C \<in> components S" and contf: "continuous_on C f" and fim: "f ` C \<subseteq> U"
  obtains g where "continuous_on S g" "g ` S \<subseteq> U" "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
 proof -
   obtain T g where ope: "openin (top_of_set S) T"
                and clo: "closedin (top_of_set S) T"
                and "C \<subseteq> T" and contg: "continuous_on T g" and gim: "g ` T \<subseteq> U"
                and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
     using S
   proof
     assume "locally connected S"
     show ?thesis
       by (metis C \<open>locally connected S\<close> openin_components_locally_connected closedin_component contf fim order_refl that)
   next
     assume "compact S"
     then obtain W g where "C \<subseteq> W" and opeW: "openin (top_of_set S) W"
                  and contg: "continuous_on W g"
                  and gim: "g ` W \<subseteq> U" and gf: "\<And>x. x \<in> C \<Longrightarrow> g x = f x"
       using ANR_imp_absolute_neighbourhood_extensor [of U C f S] C \<open>ANR U\<close> closedin_component contf fim by blast
     then obtain V where "open V" and V: "W = S \<inter> V"
       by (auto simp: openin_open)
     moreover have "locally compact S"
       by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
     ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
       by (metis C Int_subset_iff \<open>C \<subseteq> W\<close> \<open>compact S\<close> compact_components Sura_Bura_clopen_subset)
     show ?thesis
     proof
       show "closedin (top_of_set S) K"
         by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
       show "continuous_on K g"
         by (metis Int_subset_iff V \<open>K \<subseteq> V\<close> contg continuous_on_subset opeK openin_subtopology subset_eq)
       show "g ` K \<subseteq> U"
         using V \<open>K \<subseteq> V\<close> gim opeK openin_imp_subset by fastforce
     qed (use opeK gf \<open>C \<subseteq> K\<close> in auto)
   qed
   obtain h where "continuous_on S h" "h ` S \<subseteq> U" "\<And>x. x \<in> T \<Longrightarrow> h x = g x"
     using extension_from_clopen
     by (metis C bot.extremum_uniqueI clo contg gim fim image_is_empty in_components_nonempty ope)
   then show ?thesis
     by (metis \<open>C \<subseteq> T\<close> gf subset_eq that)
 qed
 
 
 lemma tube_lemma:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" and S: "S \<noteq> {}" "(\<lambda>x. (x,a)) ` S \<subseteq> U" 
       and ope: "openin (top_of_set (S \<times> T)) U"
   obtains V where "openin (top_of_set T) V" "a \<in> V" "S \<times> V \<subseteq> U"
 proof -
   let ?W = "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> (S \<times> T - U)}"
   have "U \<subseteq> S \<times> T" "closedin (top_of_set (S \<times> T)) (S \<times> T - U)"
     using ope by (auto simp: openin_closedin_eq)
   then have "closedin (top_of_set T) ?W"
     using \<open>compact S\<close> closedin_compact_projection by blast
   moreover have "a \<in> T - ?W"
     using \<open>U \<subseteq> S \<times> T\<close> S by auto
   moreover have "S \<times> (T - ?W) \<subseteq> U"
     by auto
   ultimately show ?thesis
     by (metis (no_types, lifting) Sigma_cong closedin_def that topspace_euclidean_subtopology)
 qed
 
 lemma tube_lemma_gen:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" "S \<noteq> {}" "T \<subseteq> T'" "S \<times> T \<subseteq> U"
       and ope: "openin (top_of_set (S \<times> T')) U"
   obtains V where "openin (top_of_set T') V" "T \<subseteq> V" "S \<times> V \<subseteq> U"
 proof -
   have "\<And>x. x \<in> T \<Longrightarrow> \<exists>V. openin (top_of_set T') V \<and> x \<in> V \<and> S \<times> V \<subseteq> U"
     using assms by (auto intro:  tube_lemma [OF \<open>compact S\<close>])
   then obtain F where F: "\<And>x. x \<in> T \<Longrightarrow> openin (top_of_set T') (F x) \<and> x \<in> F x \<and> S \<times> F x \<subseteq> U"
     by metis
   show ?thesis
   proof
     show "openin (top_of_set T') (\<Union>(F ` T))"
       using F by blast
     show "T \<subseteq> \<Union>(F ` T)"
       using F by blast
     show "S \<times> \<Union>(F ` T) \<subseteq> U"
       using F by auto
   qed
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> homotopic_neighbourhood_extension:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> U"
       and contg: "continuous_on S g" and gim: "g ` S \<subseteq> U"
       and clo: "closedin (top_of_set S) T"
       and "ANR U" and hom: "homotopic_with_canon (\<lambda>x. True) T U f g"
     obtains V where "T \<subseteq> V" "openin (top_of_set S) V"
                     "homotopic_with_canon (\<lambda>x. True) V U f g"
 proof -
   have "T \<subseteq> S"
     using clo closedin_imp_subset by blast
   obtain h where conth: "continuous_on ({0..1::real} \<times> T) h"
              and him: "h ` ({0..1} \<times> T) \<subseteq> U"
              and h0: "\<And>x. h(0, x) = f x" and h1: "\<And>x. h(1, x) = g x"
     using hom by (auto simp: homotopic_with_def)
   define h' where "h' \<equiv> \<lambda>z. if fst z \<in> {0} then f(snd z)
                              else if fst z \<in> {1} then g(snd z)
                              else h z"
   let ?S0 = "{0::real} \<times> S" and ?S1 = "{1::real} \<times> S"
   have "continuous_on(?S0 \<union> (?S1 \<union> {0..1} \<times> T)) h'"
     unfolding h'_def
   proof (intro continuous_on_cases_local)
     show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) ?S0"
          "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ?S1"
       using \<open>T \<subseteq> S\<close> by (force intro: closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
     show "closedin (top_of_set (?S0 \<union> (?S1 \<union> {0..1} \<times> T))) (?S1 \<union> {0..1} \<times> T)"
          "closedin (top_of_set (?S1 \<union> {0..1} \<times> T)) ({0..1} \<times> T)"
       using \<open>T \<subseteq> S\<close> by (force intro: clo closedin_Times closedin_subset_trans [of "{0..1} \<times> S"])+
     show "continuous_on (?S0) (\<lambda>x. f (snd x))"
       by (intro continuous_intros continuous_on_compose2 [OF contf]) auto
     show "continuous_on (?S1) (\<lambda>x. g (snd x))"
       by (intro continuous_intros continuous_on_compose2 [OF contg]) auto
   qed (use h0 h1 conth in auto)
   then have "continuous_on ({0,1} \<times> S \<union> ({0..1} \<times> T)) h'"
     by (metis Sigma_Un_distrib1 Un_assoc insert_is_Un) 
   moreover have "h' ` ({0,1} \<times> S \<union> {0..1} \<times> T) \<subseteq> U"
     using fim gim him \<open>T \<subseteq> S\<close> unfolding h'_def by force
   moreover have "closedin (top_of_set ({0..1::real} \<times> S)) ({0,1} \<times> S \<union> {0..1::real} \<times> T)"
     by (intro closedin_Times closedin_Un clo) (simp_all add: closed_subset)
   ultimately
   obtain W k where W: "({0,1} \<times> S) \<union> ({0..1} \<times> T) \<subseteq> W"
                and opeW: "openin (top_of_set ({0..1} \<times> S)) W"
                and contk: "continuous_on W k"
                and kim: "k ` W \<subseteq> U"
                and kh': "\<And>x. x \<in> ({0,1} \<times> S) \<union> ({0..1} \<times> T) \<Longrightarrow> k x = h' x"
     by (metis ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR U\<close>, of "({0,1} \<times> S) \<union> ({0..1} \<times> T)" h' "{0..1} \<times> S"])
   obtain T' where opeT': "openin (top_of_set S) T'" 
               and "T \<subseteq> T'" and TW: "{0..1} \<times> T' \<subseteq> W"
     using tube_lemma_gen [of "{0..1::real}" T S W] W \<open>T \<subseteq> S\<close> opeW by auto
   moreover have "homotopic_with_canon (\<lambda>x. True) T' U f g"
   proof (simp add: homotopic_with, intro exI conjI)
     show "continuous_on ({0..1} \<times> T') k"
       using TW continuous_on_subset contk by auto
     show "k ` ({0..1} \<times> T') \<subseteq> U"
       using TW kim by fastforce
     have "T' \<subseteq> S"
       by (meson opeT' subsetD openin_imp_subset)
     then show "\<forall>x\<in>T'. k (0, x) = f x" "\<forall>x\<in>T'. k (1, x) = g x"
       by (auto simp: kh' h'_def)
   qed
   ultimately show ?thesis
     by (blast intro: that)
 qed
 
 text\<open> Homotopy on a union of closed-open sets.\<close>
 proposition\<^marker>\<open>tag unimportant\<close> homotopic_on_clopen_Union:
   fixes \<F> :: "'a::euclidean_space set set"
   assumes "\<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 "\<And>S. S \<in> \<F> \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) S T f g"
   shows "homotopic_with_canon (\<lambda>x. True) (\<Union>\<F>) T f g"
 proof -
   obtain \<V> where "\<V> \<subseteq> \<F>" "countable \<V>" and eqU: "\<Union>\<V> = \<Union>\<F>"
     using Lindelof_openin assms by blast
   show ?thesis
   proof (cases "\<V> = {}")
     case True
     then show ?thesis
       by (metis Union_empty eqU homotopic_with_canon_on_empty)
   next
     case False
     then obtain V :: "nat \<Rightarrow> 'a set" where V: "range V = \<V>"
       using range_from_nat_into \<open>countable \<V>\<close> by metis
     with \<open>\<V> \<subseteq> \<F>\<close> have clo: "\<And>n. closedin (top_of_set (\<Union>\<F>)) (V n)"
                   and ope: "\<And>n. openin (top_of_set (\<Union>\<F>)) (V n)"
                   and hom: "\<And>n. homotopic_with_canon (\<lambda>x. True) (V n) T f g"
       using assms by auto 
     then obtain h where conth: "\<And>n. continuous_on ({0..1::real} \<times> V n) (h n)"
                   and him: "\<And>n. h n ` ({0..1} \<times> V n) \<subseteq> T" 
                   and h0: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (0, x) = f x" 
                   and h1: "\<And>n. \<And>x. x \<in> V n \<Longrightarrow> h n (1, x) = g x"
       by (simp add: homotopic_with) metis
     have wop: "b \<in> V x \<Longrightarrow> \<exists>k. b \<in> V k \<and> (\<forall>j<k. b \<notin> V j)" for b x
         using nat_less_induct [where P = "\<lambda>i. b \<notin> V i"] by meson
     obtain \<zeta> where cont: "continuous_on ({0..1} \<times> \<Union>(V ` UNIV)) \<zeta>"
               and eq: "\<And>x i. \<lbrakk>x \<in> {0..1} \<times> \<Union>(V ` UNIV) \<inter>
                                    {0..1} \<times> (V i - (\<Union>m<i. V m))\<rbrakk> \<Longrightarrow> \<zeta> x = h i x"
     proof (rule pasting_lemma_exists)
       let ?X = "top_of_set ({0..1::real} \<times> \<Union>(range V))"
       show "topspace ?X \<subseteq> (\<Union>i. {0..1::real} \<times> (V i - (\<Union>m<i. V m)))"
         by (force simp: Ball_def dest: wop)
       show "openin (top_of_set ({0..1} \<times> \<Union>(V ` UNIV))) 
                    ({0..1::real} \<times> (V i - (\<Union>m<i. V m)))" for i
       proof (intro openin_Times openin_subtopology_self openin_diff)
         show "openin (top_of_set (\<Union>(V ` UNIV))) (V i)"
           using ope V eqU by auto
         show "closedin (top_of_set (\<Union>(V ` UNIV))) (\<Union>m<i. V m)"
           using V clo eqU by (force intro: closedin_Union)
       qed
       show "continuous_map (subtopology ?X ({0..1} \<times> (V i - \<Union> (V ` {..<i})))) euclidean (h i)"  for i
         by (auto simp add: subtopology_subtopology intro!: continuous_on_subset [OF conth])
       show "\<And>i j x. x \<in> topspace ?X \<inter> {0..1} \<times> (V i - (\<Union>m<i. V m)) \<inter> {0..1} \<times> (V j - (\<Union>m<j. V m))
                     \<Longrightarrow> h i x = h j x"
         by clarsimp (metis lessThan_iff linorder_neqE_nat)
     qed auto
     show ?thesis
     proof (simp add: homotopic_with eqU [symmetric], intro exI conjI ballI)
       show "continuous_on ({0..1} \<times> \<Union>\<V>) \<zeta>"
         using V eqU by (blast intro!:  continuous_on_subset [OF cont])
       show "\<zeta>` ({0..1} \<times> \<Union>\<V>) \<subseteq> T"
       proof clarsimp
         fix t :: real and y :: "'a" and X :: "'a set"
         assume "y \<in> X" "X \<in> \<V>" and t: "0 \<le> t" "t \<le> 1"
         then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
           by (metis image_iff V wop)
         with him t show "\<zeta>(t, y) \<in> T"
           by (subst eq) force+
       qed
       fix X y
       assume "X \<in> \<V>" "y \<in> X"
       then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
         by (metis image_iff V wop)
       then show "\<zeta>(0, y) = f y" and "\<zeta>(1, y) = g y"
         by (subst eq [where i=k]; force simp: h0 h1)+ 
     qed
   qed
 qed
 
 lemma homotopic_on_components_eq:
   fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
   assumes S: "locally connected S \<or> compact S" and "ANR T"
   shows "homotopic_with_canon (\<lambda>x. True) S T f g \<longleftrightarrow>
          (continuous_on S f \<and> f ` S \<subseteq> T \<and> continuous_on S g \<and> g ` S \<subseteq> T) \<and>
          (\<forall>C \<in> components S. homotopic_with_canon (\<lambda>x. True) C T f g)"
     (is "?lhs \<longleftrightarrow> ?C \<and> ?rhs")
 proof -
   have "continuous_on S f" "f ` S \<subseteq> T" "continuous_on S g" "g ` S \<subseteq> T" if ?lhs
     using homotopic_with_imp_continuous homotopic_with_imp_subset1 homotopic_with_imp_subset2 that by blast+
   moreover have "?lhs \<longleftrightarrow> ?rhs"
     if contf: "continuous_on S f" and fim: "f ` S \<subseteq> T" and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
   proof
     assume ?lhs
     with that show ?rhs
       by (simp add: homotopic_with_subset_left in_components_subset)
   next
     assume R: ?rhs
     have "\<exists>U. C \<subseteq> U \<and> closedin (top_of_set S) U \<and>
               openin (top_of_set S) U \<and>
               homotopic_with_canon (\<lambda>x. True) U T f g" if C: "C \<in> components S" for C
     proof -
       have "C \<subseteq> S"
         by (simp add: in_components_subset that)
       show ?thesis
         using S
       proof
         assume "locally connected S"
         show ?thesis
         proof (intro exI conjI)
           show "closedin (top_of_set S) C"
             by (simp add: closedin_component that)
           show "openin (top_of_set S) C"
             by (simp add: \<open>locally connected S\<close> openin_components_locally_connected that)
           show "homotopic_with_canon (\<lambda>x. True) C T f g"
             by (simp add: R that)
         qed auto
       next
         assume "compact S"
         have hom: "homotopic_with_canon (\<lambda>x. True) C T f g"
           using R that by blast
         obtain U where "C \<subseteq> U" and opeU: "openin (top_of_set S) U"
                   and hom: "homotopic_with_canon (\<lambda>x. True) U T f g"
           using homotopic_neighbourhood_extension [OF contf fim contg gim _ \<open>ANR T\<close> hom]
             \<open>C \<in> components S\<close> closedin_component by blast
         then obtain V where "open V" and V: "U = S \<inter> V"
           by (auto simp: openin_open)
         moreover have "locally compact S"
           by (simp add: \<open>compact S\<close> closed_imp_locally_compact compact_imp_closed)
         ultimately obtain K where opeK: "openin (top_of_set S) K" and "compact K" "C \<subseteq> K" "K \<subseteq> V"
           by (metis C Int_subset_iff Sura_Bura_clopen_subset \<open>C \<subseteq> U\<close> \<open>compact S\<close> compact_components)
         show ?thesis
         proof (intro exI conjI)
           show "closedin (top_of_set S) K"
             by (meson \<open>compact K\<close> \<open>compact S\<close> closedin_compact_eq opeK openin_imp_subset)
           show "homotopic_with_canon (\<lambda>x. True) K T f g"
             using V \<open>K \<subseteq> V\<close> hom homotopic_with_subset_left opeK openin_imp_subset by fastforce
         qed (use opeK \<open>C \<subseteq> K\<close> in auto)
       qed
     qed
     then obtain \<phi> where \<phi>: "\<And>C. C \<in> components S \<Longrightarrow> C \<subseteq> \<phi> C"
                   and clo\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> closedin (top_of_set S) (\<phi> C)"
                   and ope\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> openin (top_of_set S) (\<phi> C)"
                   and hom\<phi>: "\<And>C. C \<in> components S \<Longrightarrow> homotopic_with_canon (\<lambda>x. True) (\<phi> C) T f g"
       by metis
     have Seq: "S = \<Union> (\<phi> ` components S)"
     proof
       show "S \<subseteq> \<Union> (\<phi> ` components S)"
         by (metis Sup_mono Union_components \<phi> imageI)
       show "\<Union> (\<phi> ` components S) \<subseteq> S"
         using ope\<phi> openin_imp_subset by fastforce
     qed
     show ?lhs
       apply (subst Seq)
       apply (rule homotopic_on_clopen_Union)
       using Seq clo\<phi> ope\<phi> hom\<phi> by auto
   qed
   ultimately show ?thesis by blast
 qed
 
 
 lemma cohomotopically_trivial_on_components:
   fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set"
   assumes S: "locally connected S \<or> compact S" and "ANR T"
   shows
    "(\<forall>f g. continuous_on S f \<longrightarrow> f ` S \<subseteq> T \<longrightarrow> continuous_on S g \<longrightarrow> g ` S \<subseteq> T \<longrightarrow>
            homotopic_with_canon (\<lambda>x. True) S T f g)
     \<longleftrightarrow>
     (\<forall>C\<in>components S.
         \<forall>f g. continuous_on C f \<longrightarrow> f ` C \<subseteq> T \<longrightarrow> continuous_on C g \<longrightarrow> g ` C \<subseteq> T \<longrightarrow>
               homotopic_with_canon (\<lambda>x. True) C T f g)"
      (is "?lhs = ?rhs")
 proof
   assume L[rule_format]: ?lhs
   show ?rhs
   proof clarify
     fix C f g
     assume contf: "continuous_on C f" and fim: "f ` C \<subseteq> T"
        and contg: "continuous_on C g" and gim: "g ` C \<subseteq> T" and C: "C \<in> components S"
     obtain f' where contf': "continuous_on S f'" and f'im: "f' ` S \<subseteq> T" and f'f: "\<And>x. x \<in> C \<Longrightarrow> f' x = f x"
       using extension_from_component [OF S \<open>ANR T\<close> C contf fim] by metis
     obtain g' where contg': "continuous_on S g'" and g'im: "g' ` S \<subseteq> T" and g'g: "\<And>x. x \<in> C \<Longrightarrow> g' x = g x"
       using extension_from_component [OF S \<open>ANR T\<close> C contg gim] by metis
     have "homotopic_with_canon (\<lambda>x. True) C T f' g'"
       using L [OF contf' f'im contg' g'im] homotopic_with_subset_left C in_components_subset by fastforce
     then show "homotopic_with_canon (\<lambda>x. True) C T f g"
       using f'f g'g homotopic_with_eq by force
   qed
 next
   assume R [rule_format]: ?rhs
   show ?lhs
   proof clarify
     fix f g
     assume contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
       and contg: "continuous_on S g" and gim: "g ` S \<subseteq> T"
     moreover have "homotopic_with_canon (\<lambda>x. True) C T f g" if "C \<in> components S" for C
       using R [OF that]
       by (meson contf contg continuous_on_subset fim gim image_mono in_components_subset order.trans that)
     ultimately show "homotopic_with_canon (\<lambda>x. True) S T f g"
       by (subst homotopic_on_components_eq [OF S \<open>ANR T\<close>]) auto
   qed
 qed
 
 subsection\<open>The complement of a set and path-connectedness\<close>
 
 text\<open>Complement in dimension N > 1 of set homeomorphic to any interval in
  any dimension is (path-)connected. This naively generalizes the argument
  in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer fixed point theorem",
 American Mathematical Monthly 1984.\<close>
 
 lemma unbounded_components_complement_absolute_retract:
   fixes S :: "'a::euclidean_space set"
   assumes C: "C \<in> components(- S)" and S: "compact S" "AR S"
     shows "\<not> bounded C"
 proof -
   obtain y where y: "C = connected_component_set (- S) y" and "y \<notin> S"
     using C by (auto simp: components_def)
   have "open(- S)"
     using S by (simp add: closed_open compact_eq_bounded_closed)
   have "S retract_of UNIV"
     using S compact_AR by blast
   then obtain r where contr: "continuous_on UNIV r" and ontor: "range r \<subseteq> S"
                   and r: "\<And>x. x \<in> S \<Longrightarrow> r x = x"
     by (auto simp: retract_of_def retraction_def)
   show ?thesis
   proof
     assume "bounded C"
     have "connected_component_set (- S) y \<subseteq> S"
     proof (rule frontier_subset_retraction)
       show "bounded (connected_component_set (- S) y)"
         using \<open>bounded C\<close> y by blast
       show "frontier (connected_component_set (- S) y) \<subseteq> S"
         using C \<open>compact S\<close> compact_eq_bounded_closed frontier_of_components_closed_complement y by blast
       show "continuous_on (closure (connected_component_set (- S) y)) r"
         by (blast intro: continuous_on_subset [OF contr])
     qed (use ontor r in auto)
     with \<open>y \<notin> S\<close> show False by force
   qed
 qed
 
 lemma connected_complement_absolute_retract:
   fixes S :: "'a::euclidean_space set"
   assumes S: "compact S" "AR S" and 2: "2 \<le> DIM('a)"
     shows "connected(- S)"
 proof -
   have "S retract_of UNIV"
     using S compact_AR by blast
   show ?thesis
     apply (clarsimp simp: connected_iff_connected_component_eq)
     apply (rule cobounded_unique_unbounded_component [OF _ 2])
       apply (simp add: \<open>compact S\<close> compact_imp_bounded)
      apply (meson ComplI S componentsI unbounded_components_complement_absolute_retract)+
     done
 qed
 
 lemma path_connected_complement_absolute_retract:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "AR S" "2 \<le> DIM('a)"
     shows "path_connected(- S)"
   using connected_complement_absolute_retract [OF assms]
   using \<open>compact S\<close> compact_eq_bounded_closed connected_open_path_connected by blast
 
 theorem connected_complement_homeomorphic_convex_compact:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes hom: "S homeomorphic T" and T: "convex T" "compact T" and 2: "2 \<le> DIM('a)"
     shows "connected(- S)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: connected_UNIV)
 next
   case False
   show ?thesis
   proof (rule connected_complement_absolute_retract)
     show "compact S"
       using \<open>compact T\<close> hom homeomorphic_compactness by auto
     show "AR S"
       by (meson AR_ANR False \<open>convex T\<close> convex_imp_ANR convex_imp_contractible hom homeomorphic_ANR_iff_ANR homeomorphic_contractible_eq)
   qed (rule 2)
 qed
 
 corollary path_connected_complement_homeomorphic_convex_compact:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes hom: "S homeomorphic T" "convex T" "compact T" "2 \<le> DIM('a)"
     shows "path_connected(- S)"
   using connected_complement_homeomorphic_convex_compact [OF assms]
   using \<open>compact T\<close> compact_eq_bounded_closed connected_open_path_connected hom homeomorphic_compactness by blast
 
 lemma path_connected_complement_homeomorphic_interval:
   fixes S :: "'a::euclidean_space set"
   assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
   shows "path_connected(-S)"
   using assms compact_cbox convex_box(1) path_connected_complement_homeomorphic_convex_compact by blast
 
 lemma connected_complement_homeomorphic_interval:
   fixes S :: "'a::euclidean_space set"
   assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
   shows "connected(-S)"
   using assms path_connected_complement_homeomorphic_interval path_connected_imp_connected by blast
 
 end
diff --git a/src/HOL/Analysis/Starlike.thy b/src/HOL/Analysis/Starlike.thy
--- a/src/HOL/Analysis/Starlike.thy
+++ b/src/HOL/Analysis/Starlike.thy
@@ -1,6924 +1,6924 @@
 (* Title:      HOL/Analysis/Starlike.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 chapter \<open>Unsorted\<close>
 
 theory Starlike
   imports
     Convex_Euclidean_Space
     Abstract_Limits
     Line_Segment
 begin
 
 subsection\<open>Starlike sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
 
 lemma starlike_UNIV [simp]: "starlike UNIV"
   by (simp add: starlike_def)
 
 lemma convex_imp_starlike:
   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
   unfolding convex_contains_segment starlike_def by auto
 
 
 lemma affine_hull_closed_segment [simp]:
      "affine hull (closed_segment a b) = affine hull {a,b}"
   by (simp add: segment_convex_hull)
 
 lemma affine_hull_open_segment [simp]:
     fixes a :: "'a::euclidean_space"
     shows "affine hull (open_segment a b) = (if a = b then {} else affine hull {a,b})"
 by (metis affine_hull_convex_hull affine_hull_empty closure_open_segment closure_same_affine_hull segment_convex_hull)
 
 lemma rel_interior_closure_convex_segment:
   fixes S :: "_::euclidean_space set"
   assumes "convex S" "a \<in> rel_interior S" "b \<in> closure S"
     shows "open_segment a b \<subseteq> rel_interior S"
 proof
   fix x
   have [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)" for u
     by (simp add: algebra_simps)
   assume "x \<in> open_segment a b"
   then show "x \<in> rel_interior S"
     unfolding closed_segment_def open_segment_def  using assms
     by (auto intro: rel_interior_closure_convex_shrink)
 qed
 
 lemma convex_hull_insert_segments:
    "convex hull (insert a S) =
     (if S = {} then {a} else  \<Union>x \<in> convex hull S. closed_segment a x)"
   by (force simp add: convex_hull_insert_alt in_segment)
 
 lemma Int_convex_hull_insert_rel_exterior:
   fixes z :: "'a::euclidean_space"
   assumes "convex C" "T \<subseteq> C" and z: "z \<in> rel_interior C" and dis: "disjnt S (rel_interior C)"
   shows "S \<inter> (convex hull (insert z T)) = S \<inter> (convex hull T)" (is "?lhs = ?rhs")
 proof
   have "T = {} \<Longrightarrow> z \<notin> S"
     using dis z by (auto simp add: disjnt_def)
   then show "?lhs \<subseteq> ?rhs"
   proof (clarsimp simp add: convex_hull_insert_segments)
     fix x y
     assume "x \<in> S" and y: "y \<in> convex hull T" and "x \<in> closed_segment z y"
     have "y \<in> closure C"
       by (metis y \<open>convex C\<close> \<open>T \<subseteq> C\<close> closure_subset contra_subsetD convex_hull_eq hull_mono)
     moreover have "x \<notin> rel_interior C"
       by (meson \<open>x \<in> S\<close> dis disjnt_iff)
     moreover have "x \<in> open_segment z y \<union> {z, y}"
       using \<open>x \<in> closed_segment z y\<close> closed_segment_eq_open by blast
     ultimately show "x \<in> convex hull T"
       using rel_interior_closure_convex_segment [OF \<open>convex C\<close> z]
       using y z by blast
   qed
   show "?rhs \<subseteq> ?lhs"
     by (meson hull_mono inf_mono subset_insertI subset_refl)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>More results about segments\<close>
 
 lemma dist_half_times2:
   fixes a :: "'a :: real_normed_vector"
   shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)"
 proof -
   have "norm ((1 / 2) *\<^sub>R (a + b) - x) * 2 = norm (2 *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x))"
     by simp
   also have "... = norm ((a + b) - 2 *\<^sub>R x)"
     by (simp add: real_vector.scale_right_diff_distrib)
   finally show ?thesis
     by (simp only: dist_norm)
 qed
 
 lemma closed_segment_as_ball:
     "closed_segment a b = affine hull {a,b} \<inter> cball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 proof (cases "b = a")
   case True then show ?thesis by (auto simp: hull_inc)
 next
   case False
   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)" for x
   proof -
     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a))"
       unfolding eq_diff_eq [symmetric] by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           norm ((a+b) - (2 *\<^sub>R x)) \<le> norm (b - a))"
       by (simp add: dist_half_times2) (simp add: dist_norm)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) \<le> norm (b - a))"
       by auto
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                 norm ((1 - u * 2) *\<^sub>R (b - a)) \<le> norm (b - a))"
       by (simp add: algebra_simps scaleR_2)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           \<bar>1 - u * 2\<bar> * norm (b - a) \<le> norm (b - a))"
       by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> \<le> 1)"
       by (simp add: mult_le_cancel_right2 False)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)"
       by auto
     finally show ?thesis .
   qed
   show ?thesis
     by (simp add: affine_hull_2 Set.set_eq_iff closed_segment_def *)
 qed
 
 lemma open_segment_as_ball:
     "open_segment a b =
      affine hull {a,b} \<inter> ball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 proof (cases "b = a")
   case True then show ?thesis by (auto simp: hull_inc)
 next
   case False
   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)" for x
   proof -
     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a))"
       unfolding eq_diff_eq [symmetric] by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           norm ((a+b) - (2 *\<^sub>R x)) < norm (b - a))"
       by (simp add: dist_half_times2) (simp add: dist_norm)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) < norm (b - a))"
       by auto
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                 norm ((1 - u * 2) *\<^sub>R (b - a)) < norm (b - a))"
       by (simp add: algebra_simps scaleR_2)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           \<bar>1 - u * 2\<bar> * norm (b - a) < norm (b - a))"
       by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> < 1)"
       by (simp add: mult_le_cancel_right2 False)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)"
       by auto
     finally show ?thesis .
   qed
   show ?thesis
     using False by (force simp: affine_hull_2 Set.set_eq_iff open_segment_image_interval *)
 qed
 
 lemmas segment_as_ball = closed_segment_as_ball open_segment_as_ball
 
 lemma closed_segment_neq_empty [simp]: "closed_segment a b \<noteq> {}"
   by auto
 
 lemma open_segment_eq_empty [simp]: "open_segment a b = {} \<longleftrightarrow> a = b"
 proof -
   { assume a1: "open_segment a b = {}"
     have "{} \<noteq> {0::real<..<1}"
       by simp
     then have "a = b"
       using a1 open_segment_image_interval by fastforce
   } then show ?thesis by auto
 qed
 
 lemma open_segment_eq_empty' [simp]: "{} = open_segment a b \<longleftrightarrow> a = b"
   using open_segment_eq_empty by blast
 
 lemmas segment_eq_empty = closed_segment_neq_empty open_segment_eq_empty
 
 lemma inj_segment:
   fixes a :: "'a :: real_vector"
   assumes "a \<noteq> b"
     shows "inj_on (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) I"
 proof
   fix x y
   assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b"
   then have "x *\<^sub>R (b - a) = y *\<^sub>R (b - a)"
     by (simp add: algebra_simps)
   with assms show "x = y"
     by (simp add: real_vector.scale_right_imp_eq)
 qed
 
 lemma finite_closed_segment [simp]: "finite(closed_segment a b) \<longleftrightarrow> a = b"
   apply auto
   apply (rule ccontr)
   apply (simp add: segment_image_interval)
   using infinite_Icc [OF zero_less_one] finite_imageD [OF _ inj_segment] apply blast
   done
 
 lemma finite_open_segment [simp]: "finite(open_segment a b) \<longleftrightarrow> a = b"
   by (auto simp: open_segment_def)
 
 lemmas finite_segment = finite_closed_segment finite_open_segment
 
 lemma closed_segment_eq_sing: "closed_segment a b = {c} \<longleftrightarrow> a = c \<and> b = c"
   by auto
 
 lemma open_segment_eq_sing: "open_segment a b \<noteq> {c}"
   by (metis finite_insert finite_open_segment insert_not_empty open_segment_image_interval)
 
 lemmas segment_eq_sing = closed_segment_eq_sing open_segment_eq_sing
 
 lemma subset_closed_segment:
     "closed_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
      a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
   by auto (meson contra_subsetD convex_closed_segment convex_contains_segment)
 
 lemma subset_co_segment:
     "closed_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
      a \<in> open_segment c d \<and> b \<in> open_segment c d"
 using closed_segment_subset by blast
 
 lemma subset_open_segment:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
         (is "?lhs = ?rhs")
 proof (cases "a = b")
   case True then show ?thesis by simp
 next
   case False show ?thesis
   proof
     assume rhs: ?rhs
     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
       using closed_segment_idem singleton_iff by auto
     have "\<exists>uc. (1 - u) *\<^sub>R ((1 - ua) *\<^sub>R c + ua *\<^sub>R d) + u *\<^sub>R ((1 - ub) *\<^sub>R c + ub *\<^sub>R d) =
                (1 - uc) *\<^sub>R c + uc *\<^sub>R d \<and> 0 < uc \<and> uc < 1"
         if neq: "(1 - ua) *\<^sub>R c + ua *\<^sub>R d \<noteq> (1 - ub) *\<^sub>R c + ub *\<^sub>R d" "c \<noteq> d"
            and "a = (1 - ua) *\<^sub>R c + ua *\<^sub>R d" "b = (1 - ub) *\<^sub>R c + ub *\<^sub>R d"
            and u: "0 < u" "u < 1" and uab: "0 \<le> ua" "ua \<le> 1" "0 \<le> ub" "ub \<le> 1"
         for u ua ub
     proof -
       have "ua \<noteq> ub"
         using neq by auto
       moreover have "(u - 1) * ua \<le> 0" using u uab
         by (simp add: mult_nonpos_nonneg)
       ultimately have lt: "(u - 1) * ua < u * ub" using u uab
         by (metis antisym_conv diff_ge_0_iff_ge le_less_trans mult_eq_0_iff mult_le_0_iff not_less)
       have "p * ua + q * ub < p+q" if p: "0 < p" and  q: "0 < q" for p q
       proof -
         have "\<not> p \<le> 0" "\<not> q \<le> 0"
           using p q not_less by blast+
         then show ?thesis
           by (metis \<open>ua \<noteq> ub\<close> add_less_cancel_left add_less_cancel_right add_mono_thms_linordered_field(5)
                     less_eq_real_def mult_cancel_left1 mult_less_cancel_left2 uab(2) uab(4))
       qed
       then have "(1 - u) * ua + u * ub < 1" using u \<open>ua \<noteq> ub\<close>
         by (metis diff_add_cancel diff_gt_0_iff_gt)
       with lt show ?thesis
         by (rule_tac x="ua + u*(ub-ua)" in exI) (simp add: algebra_simps)
     qed
     with rhs \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close> show ?lhs
       unfolding open_segment_image_interval closed_segment_def
       by (fastforce simp add:)
   next
     assume lhs: ?lhs
     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
       by (meson finite_open_segment rev_finite_subset)
     have "closure (open_segment a b) \<subseteq> closure (open_segment c d)"
       using lhs closure_mono by blast
     then have "closed_segment a b \<subseteq> closed_segment c d"
       by (simp add: \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close>)
     then show ?rhs
       by (force simp: \<open>a \<noteq> b\<close>)
   qed
 qed
 
 lemma subset_oc_segment:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
 apply (simp add: subset_open_segment [symmetric])
 apply (rule iffI)
  apply (metis closure_closed_segment closure_mono closure_open_segment subset_closed_segment subset_open_segment)
 apply (meson dual_order.trans segment_open_subset_closed)
 done
 
 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Shrinking towards the interior of a convex set\<close>
 
 lemma mem_interior_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> interior S"
     and "x \<in> S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
     using assms(2) unfolding mem_interior by auto
   show ?thesis
     unfolding mem_interior
   proof (intro exI subsetI conjI)
     fix y
     assume "y \<in> ball (x - e *\<^sub>R (x - c)) (e*d)"
     then have as: "dist (x - e *\<^sub>R (x - c)) y < e * d"
       by simp
     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
       using \<open>e > 0\<close> by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
     have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = \<bar>1/e\<bar> * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
       unfolding dist_norm
       unfolding norm_scaleR[symmetric]
       apply (rule arg_cong[where f=norm])
       using \<open>e > 0\<close>
       by (auto simp add: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
     also have "\<dots> < d"
       using as[unfolded dist_norm] and \<open>e > 0\<close>
       by (auto simp add:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
     finally show "y \<in> S"
       apply (subst *)
       apply (rule assms(1)[unfolded convex_alt,rule_format])
       apply (rule d[unfolded subset_eq,rule_format])
       unfolding mem_ball
       using assms(3-5)
       apply auto
       done
   qed (insert \<open>e>0\<close> \<open>d>0\<close>, auto)
 qed
 
 lemma mem_interior_closure_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> interior S"
     and "x \<in> closure S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
     using assms(2) unfolding mem_interior by auto
   have "\<exists>y\<in>S. norm (y - x) * (1 - e) < e * d"
   proof (cases "x \<in> S")
     case True
     then show ?thesis
       using \<open>e > 0\<close> \<open>d > 0\<close>
       apply (rule_tac bexI[where x=x])
       apply (auto)
       done
   next
     case False
     then have x: "x islimpt S"
       using assms(3)[unfolded closure_def] by auto
     show ?thesis
     proof (cases "e = 1")
       case True
       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding True
         using \<open>d > 0\<close>
         apply auto
         done
     next
       case False
       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding dist_norm
         using pos_less_divide_eq[OF *]
         apply auto
         done
     qed
   qed
   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
     by auto
   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
     unfolding z_def using \<open>e > 0\<close>
     by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
   have "z \<in> interior S"
     apply (rule interior_mono[OF d,unfolded subset_eq,rule_format])
     unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
     by simp (simp add: field_simps norm_minus_commute)
   then show ?thesis
     unfolding *
     using mem_interior_convex_shrink \<open>y \<in> S\<close> assms by blast
 qed
 
 lemma in_interior_closure_convex_segment:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and a: "a \<in> interior S" and b: "b \<in> closure S"
     shows "open_segment a b \<subseteq> interior S"
 proof (clarsimp simp: in_segment)
   fix u::real
   assume u: "0 < u" "u < 1"
   have "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)"
     by (simp add: algebra_simps)
   also have "... \<in> interior S" using mem_interior_closure_convex_shrink [OF assms] u
     by simp
   finally show "(1 - u) *\<^sub>R a + u *\<^sub>R b \<in> interior S" .
 qed
 
 lemma closure_open_Int_superset:
   assumes "open S" "S \<subseteq> closure T"
   shows "closure(S \<inter> T) = closure S"
 proof -
   have "closure S \<subseteq> closure(S \<inter> T)"
     by (metis assms closed_closure closure_minimal inf.orderE open_Int_closure_subset)
   then show ?thesis
     by (simp add: closure_mono dual_order.antisym)
 qed
 
 lemma convex_closure_interior:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and int: "interior S \<noteq> {}"
   shows "closure(interior S) = closure S"
 proof -
   obtain a where a: "a \<in> interior S"
     using int by auto
   have "closure S \<subseteq> closure(interior S)"
   proof
     fix x
     assume x: "x \<in> closure S"
     show "x \<in> closure (interior S)"
     proof (cases "x=a")
       case True
       then show ?thesis
         using \<open>a \<in> interior S\<close> closure_subset by blast
     next
       case False
       show ?thesis
       proof (clarsimp simp add: closure_def islimpt_approachable)
         fix e::real
         assume xnotS: "x \<notin> interior S" and "0 < e"
         show "\<exists>x'\<in>interior S. x' \<noteq> x \<and> dist x' x < e"
         proof (intro bexI conjI)
           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<noteq> x"
             using False \<open>0 < e\<close> by (auto simp: algebra_simps min_def)
           show "dist (x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a)) x < e"
             using \<open>0 < e\<close> by (auto simp: dist_norm min_def)
           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<in> interior S"
             apply (clarsimp simp add: min_def a)
             apply (rule mem_interior_closure_convex_shrink [OF \<open>convex S\<close> a x])
             using \<open>0 < e\<close> False apply (auto simp: field_split_simps)
             done
         qed
       qed
     qed
   qed
   then show ?thesis
     by (simp add: closure_mono interior_subset subset_antisym)
 qed
 
 lemma closure_convex_Int_superset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "interior S \<noteq> {}" "interior S \<subseteq> closure T"
   shows "closure(S \<inter> T) = closure S"
 proof -
   have "closure S \<subseteq> closure(interior S)"
     by (simp add: convex_closure_interior assms)
   also have "... \<subseteq> closure (S \<inter> T)"
     using interior_subset [of S] assms
     by (metis (no_types, lifting) Int_assoc Int_lower2 closure_mono closure_open_Int_superset inf.orderE open_interior)
   finally show ?thesis
     by (simp add: closure_mono dual_order.antisym)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some obvious but surprisingly hard simplex lemmas\<close>
 
 lemma simplex:
   assumes "finite S"
     and "0 \<notin> S"
   shows "convex hull (insert 0 S) = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S \<le> 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
 proof (simp add: convex_hull_finite set_eq_iff assms, safe)
   fix x and u :: "'a \<Rightarrow> real"
   assume "0 \<le> u 0" "\<forall>x\<in>S. 0 \<le> u x" "u 0 + sum u S = 1"
   then show "\<exists>v. (\<forall>x\<in>S. 0 \<le> v x) \<and> sum v S \<le> 1 \<and> (\<Sum>x\<in>S. v x *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
     by force
 next
   fix x and u :: "'a \<Rightarrow> real"
   assume "\<forall>x\<in>S. 0 \<le> u x" "sum u S \<le> 1"
   then show "\<exists>v. 0 \<le> v 0 \<and> (\<forall>x\<in>S. 0 \<le> v x) \<and> v 0 + sum v S = 1 \<and> (\<Sum>x\<in>S. v x *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
     by (rule_tac x="\<lambda>x. if x = 0 then 1 - sum u S else u x" in exI) (auto simp: sum_delta_notmem assms if_smult)
 qed
 
 lemma substd_simplex:
   assumes d: "d \<subseteq> Basis"
   shows "convex hull (insert 0 d) =
     {x. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i) \<and> (\<Sum>i\<in>d. x\<bullet>i) \<le> 1 \<and> (\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0)}"
   (is "convex hull (insert 0 ?p) = ?s")
 proof -
   let ?D = d
   have "0 \<notin> ?p"
     using assms by (auto simp: image_def)
   from d have "finite d"
     by (blast intro: finite_subset finite_Basis)
   show ?thesis
     unfolding simplex[OF \<open>finite d\<close> \<open>0 \<notin> ?p\<close>]
   proof (intro set_eqI; safe)
     fix u :: "'a \<Rightarrow> real"
     assume as: "\<forall>x\<in>?D. 0 \<le> u x" "sum u ?D \<le> 1" 
     let ?x = "(\<Sum>x\<in>?D. u x *\<^sub>R x)"
     have ind: "\<forall>i\<in>Basis. i \<in> d \<longrightarrow> u i = ?x \<bullet> i"
       and notind: "(\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> ?x \<bullet> i = 0)"
       using substdbasis_expansion_unique[OF assms] by blast+
     then have **: "sum u ?D = sum ((\<bullet>) ?x) ?D"
       using assms by (auto intro!: sum.cong)
     show "0 \<le> ?x \<bullet> i" if "i \<in> Basis" for i
       using as(1) ind notind that by fastforce
     show "sum ((\<bullet>) ?x) ?D \<le> 1"
       using "**" as(2) by linarith
     show "?x \<bullet> i = 0" if "i \<in> Basis" "i \<notin> d" for i
       using notind that by blast
   next
     fix x 
     assume "\<forall>i\<in>Basis. 0 \<le> x \<bullet> i" "sum ((\<bullet>) x) ?D \<le> 1" "(\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0)"
     with d show "\<exists>u. (\<forall>x\<in>?D. 0 \<le> u x) \<and> sum u ?D \<le> 1 \<and> (\<Sum>x\<in>?D. u x *\<^sub>R x) = x"
       unfolding substdbasis_expansion_unique[OF assms] 
       by (rule_tac x="inner x" in exI) auto
   qed
 qed
 
 lemma std_simplex:
   "convex hull (insert 0 Basis) =
     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis \<le> 1}"
   using substd_simplex[of Basis] by auto
 
 lemma interior_std_simplex:
   "interior (convex hull (insert 0 Basis)) =
     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 < x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis < 1}"
   unfolding set_eq_iff mem_interior std_simplex
 proof (intro allI iffI CollectI; clarify)
   fix x :: 'a
   fix e
   assume "e > 0" and as: "ball x e \<subseteq> {x. (\<forall>i\<in>Basis. 0 \<le> x \<bullet> i) \<and> sum ((\<bullet>) x) Basis \<le> 1}"
   show "(\<forall>i\<in>Basis. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) Basis < 1"
   proof safe
     fix i :: 'a
     assume i: "i \<in> Basis"
     then show "0 < x \<bullet> i"
       using as[THEN subsetD[where c="x - (e / 2) *\<^sub>R i"]] and \<open>e > 0\<close> 
       by (force simp add: inner_simps)
   next
     have **: "dist x (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) < e" using \<open>e > 0\<close>
       unfolding dist_norm
       by (auto intro!: mult_strict_left_mono simp: SOME_Basis)
     have "\<And>i. i \<in> Basis \<Longrightarrow> (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) \<bullet> i =
       x\<bullet>i + (if i = (SOME i. i\<in>Basis) then e/2 else 0)"
       by (auto simp: SOME_Basis inner_Basis inner_simps)
     then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis =
       sum (\<lambda>i. x\<bullet>i + (if (SOME i. i\<in>Basis) = i then e/2 else 0)) Basis"
       by (auto simp: intro!: sum.cong)
     have "sum ((\<bullet>) x) Basis < sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis"
       using \<open>e > 0\<close> DIM_positive by (auto simp: SOME_Basis sum.distrib *)
     also have "\<dots> \<le> 1"
       using ** as by force
     finally show "sum ((\<bullet>) x) Basis < 1" by auto
   qed 
 next
   fix x :: 'a
   assume as: "\<forall>i\<in>Basis. 0 < x \<bullet> i" "sum ((\<bullet>) x) Basis < 1"
   obtain a :: 'b where "a \<in> UNIV" using UNIV_witness ..
   let ?d = "(1 - sum ((\<bullet>) x) Basis) / real (DIM('a))"
   show "\<exists>e>0. ball x e \<subseteq> {x. (\<forall>i\<in>Basis. 0 \<le> x \<bullet> i) \<and> sum ((\<bullet>) x) Basis \<le> 1}"
   proof (rule_tac x="min (Min (((\<bullet>) x) ` Basis)) D" for D in exI, intro conjI subsetI CollectI)
     fix y
     assume y: "y \<in> ball x (min (Min ((\<bullet>) x ` Basis)) ?d)"
     have "sum ((\<bullet>) y) Basis \<le> sum (\<lambda>i. x\<bullet>i + ?d) Basis"
     proof (rule sum_mono)
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
         by (metis Basis_le_norm i inner_commute inner_diff_right)
       also have "... < ?d"
         using y by (simp add: dist_norm norm_minus_commute)
       finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
       then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
     qed
     also have "\<dots> \<le> 1"
       unfolding sum.distrib sum_constant
       by (auto simp add: Suc_le_eq)
     finally show "sum ((\<bullet>) y) Basis \<le> 1" .
     show "(\<forall>i\<in>Basis. 0 \<le> y \<bullet> i)"
     proof safe
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "norm (x - y) < Min (((\<bullet>) x) ` Basis)"
         using y by (auto simp: dist_norm less_eq_real_def)
       also have "... \<le> x\<bullet>i"
         using i by auto
       finally have "norm (x - y) < x\<bullet>i" .
       then show "0 \<le> y\<bullet>i"
         using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format, OF i]
         by (auto simp: inner_simps)
     qed
   next
     have "Min (((\<bullet>) x) ` Basis) > 0"
       using as by simp
     moreover have "?d > 0"
       using as by (auto simp: Suc_le_eq)
     ultimately show "0 < min (Min ((\<bullet>) x ` Basis)) ((1 - sum ((\<bullet>) x) Basis) / real DIM('a))"
       by linarith
   qed 
 qed
 
 lemma interior_std_simplex_nonempty:
   obtains a :: "'a::euclidean_space" where
     "a \<in> interior(convex hull (insert 0 Basis))"
 proof -
   let ?D = "Basis :: 'a set"
   let ?a = "sum (\<lambda>b::'a. inverse (2 * real DIM('a)) *\<^sub>R b) Basis"
   {
     fix i :: 'a
     assume i: "i \<in> Basis"
     have "?a \<bullet> i = inverse (2 * real DIM('a))"
       by (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real DIM('a)) else 0) ?D"])
          (simp_all add: sum.If_cases i) }
   note ** = this
   show ?thesis
     apply (rule that[of ?a])
     unfolding interior_std_simplex mem_Collect_eq
   proof safe
     fix i :: 'a
     assume i: "i \<in> Basis"
     show "0 < ?a \<bullet> i"
-      unfolding **[OF i] by (auto simp add: Suc_le_eq DIM_positive)
+      unfolding **[OF i] by (auto simp add: Suc_le_eq)
   next
     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real DIM('a))) ?D"
       apply (rule sum.cong)
       apply rule
       apply auto
       done
     also have "\<dots> < 1"
       unfolding sum_constant divide_inverse[symmetric]
       by (auto simp add: field_simps)
     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
   qed
 qed
 
 lemma rel_interior_substd_simplex:
   assumes D: "D \<subseteq> Basis"
   shows "rel_interior (convex hull (insert 0 D)) =
     {x::'a::euclidean_space. (\<forall>i\<in>D. 0 < x\<bullet>i) \<and> (\<Sum>i\<in>D. x\<bullet>i) < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)}"
   (is "rel_interior (convex hull (insert 0 ?p)) = ?s")
 proof -
   have "finite D"
     using D finite_Basis finite_subset by blast
   show ?thesis
   proof (cases "D = {}")
     case True
     then show ?thesis
       using rel_interior_sing using euclidean_eq_iff[of _ 0] by auto
   next
     case False
     have h0: "affine hull (convex hull (insert 0 ?p)) =
       {x::'a::euclidean_space. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)}"
       using affine_hull_convex_hull affine_hull_substd_basis assms by auto
     have aux: "\<And>x::'a. \<forall>i\<in>Basis. (\<forall>i\<in>D. 0 \<le> x\<bullet>i) \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0) \<longrightarrow> 0 \<le> x\<bullet>i"
       by auto
     {
       fix x :: "'a::euclidean_space"
       assume x: "x \<in> rel_interior (convex hull (insert 0 ?p))"
       then obtain e where "e > 0" and
         "ball x e \<inter> {xa. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> xa\<bullet>i = 0)} \<subseteq> convex hull (insert 0 ?p)"
         using mem_rel_interior_ball[of x "convex hull (insert 0 ?p)"] h0 by auto
       then have as [rule_format]: "\<And>y. dist x y < e \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> y\<bullet>i = 0) \<longrightarrow>
         (\<forall>i\<in>D. 0 \<le> y \<bullet> i) \<and> sum ((\<bullet>) y) D \<le> 1"
         unfolding ball_def unfolding substd_simplex[OF assms] using assms by auto
       have x0: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)"
         using x rel_interior_subset  substd_simplex[OF assms] by auto
       have "(\<forall>i\<in>D. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) D < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)"
       proof (intro conjI ballI)
         fix i :: 'a
         assume "i \<in> D"
         then have "\<forall>j\<in>D. 0 \<le> (x - (e / 2) *\<^sub>R i) \<bullet> j"
           apply -
           apply (rule as[THEN conjunct1])
           using D \<open>e > 0\<close> x0
           apply (auto simp: dist_norm inner_simps inner_Basis)
           done
         then show "0 < x \<bullet> i"
           using \<open>e > 0\<close> \<open>i \<in> D\<close> D  by (force simp: inner_simps inner_Basis)
       next
         obtain a where a: "a \<in> D"
           using \<open>D \<noteq> {}\<close> by auto
         then have **: "dist x (x + (e / 2) *\<^sub>R a) < e"
           using \<open>e > 0\<close> norm_Basis[of a] D
           unfolding dist_norm
           by auto
         have "\<And>i. i \<in> Basis \<Longrightarrow> (x + (e / 2) *\<^sub>R a) \<bullet> i = x\<bullet>i + (if i = a then e/2 else 0)"
           using a D by (auto simp: inner_simps inner_Basis)
         then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D =
           sum (\<lambda>i. x\<bullet>i + (if a = i then e/2 else 0)) D"
           using D by (intro sum.cong) auto
         have "a \<in> Basis"
           using \<open>a \<in> D\<close> D by auto
         then have h1: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> (x + (e / 2) *\<^sub>R a) \<bullet> i = 0)"
           using x0 D \<open>a\<in>D\<close> by (auto simp add: inner_add_left inner_Basis)
         have "sum ((\<bullet>) x) D < sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D"
           using \<open>e > 0\<close> \<open>a \<in> D\<close> \<open>finite D\<close> by (auto simp add: * sum.distrib)
         also have "\<dots> \<le> 1"
           using ** h1 as[rule_format, of "x + (e / 2) *\<^sub>R a"]
           by auto
         finally show "sum ((\<bullet>) x) D < 1" "\<And>i. i\<in>Basis \<Longrightarrow> i \<notin> D \<longrightarrow> x\<bullet>i = 0"
           using x0 by auto
       qed
     }
     moreover
     {
       fix x :: "'a::euclidean_space"
       assume as: "x \<in> ?s"
       have "\<forall>i. 0 < x\<bullet>i \<or> 0 = x\<bullet>i \<longrightarrow> 0 \<le> x\<bullet>i"
         by auto
       moreover have "\<forall>i. i \<in> D \<or> i \<notin> D" by auto
       ultimately
       have "\<forall>i. (\<forall>i\<in>D. 0 < x\<bullet>i) \<and> (\<forall>i. i \<notin> D \<longrightarrow> x\<bullet>i = 0) \<longrightarrow> 0 \<le> x\<bullet>i"
         by metis
       then have h2: "x \<in> convex hull (insert 0 ?p)"
         using as assms
         unfolding substd_simplex[OF assms] by fastforce
       obtain a where a: "a \<in> D"
         using \<open>D \<noteq> {}\<close> by auto
       let ?d = "(1 - sum ((\<bullet>) x) D) / real (card D)"
       have "0 < card D" using \<open>D \<noteq> {}\<close> \<open>finite D\<close>
         by (simp add: card_gt_0_iff)
       have "Min (((\<bullet>) x) ` D) > 0"
         using as \<open>D \<noteq> {}\<close> \<open>finite D\<close> by (simp add: Min_gr_iff)
       moreover have "?d > 0" using as using \<open>0 < card D\<close> by auto
       ultimately have h3: "min (Min (((\<bullet>) x) ` D)) ?d > 0"
         by auto
 
       have "x \<in> rel_interior (convex hull (insert 0 ?p))"
         unfolding rel_interior_ball mem_Collect_eq h0
         apply (rule,rule h2)
         unfolding substd_simplex[OF assms]
         apply (rule_tac x="min (Min (((\<bullet>) x) ` D)) ?d" in exI)
         apply (rule, rule h3)
         apply safe
         unfolding mem_ball
       proof -
         fix y :: 'a
         assume y: "dist x y < min (Min ((\<bullet>) x ` D)) ?d"
         assume y2: "\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> y\<bullet>i = 0"
         have "sum ((\<bullet>) y) D \<le> sum (\<lambda>i. x\<bullet>i + ?d) D"
         proof (rule sum_mono)
           fix i
           assume "i \<in> D"
           with D have i: "i \<in> Basis"
             by auto
           have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
             by (metis i inner_commute inner_diff_right norm_bound_Basis_le order_refl)
           also have "... < ?d"
             by (metis dist_norm min_less_iff_conj norm_minus_commute y)
           finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
           then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
         qed
         also have "\<dots> \<le> 1"
           unfolding sum.distrib sum_constant  using \<open>0 < card D\<close>
           by auto
         finally show "sum ((\<bullet>) y) D \<le> 1" .
 
         fix i :: 'a
         assume i: "i \<in> Basis"
         then show "0 \<le> y\<bullet>i"
         proof (cases "i\<in>D")
           case True
           have "norm (x - y) < x\<bullet>i"
             using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
             using Min_gr_iff[of "(\<bullet>) x ` D" "norm (x - y)"] \<open>0 < card D\<close> \<open>i \<in> D\<close>
             by (simp add: card_gt_0_iff)
           then show "0 \<le> y\<bullet>i"
             using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format]
             by (auto simp: inner_simps)
         qed (insert y2, auto)
       qed
     }
     ultimately have
       "\<And>x. x \<in> rel_interior (convex hull insert 0 D) \<longleftrightarrow>
         x \<in> {x. (\<forall>i\<in>D. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) D < 1 \<and> (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x \<bullet> i = 0)}"
       by blast
     then show ?thesis by (rule set_eqI)
   qed
 qed
 
 lemma rel_interior_substd_simplex_nonempty:
   assumes "D \<noteq> {}"
     and "D \<subseteq> Basis"
   obtains a :: "'a::euclidean_space"
     where "a \<in> rel_interior (convex hull (insert 0 D))"
 proof -
   let ?D = D
   let ?a = "sum (\<lambda>b::'a::euclidean_space. inverse (2 * real (card D)) *\<^sub>R b) ?D"
   have "finite D"
     apply (rule finite_subset)
     using assms(2)
     apply auto
     done
   then have d1: "0 < real (card D)"
     using \<open>D \<noteq> {}\<close> by auto
   {
     fix i
     assume "i \<in> D"
     have "?a \<bullet> i = inverse (2 * real (card D))"
       apply (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real (card D)) else 0) ?D"])
       unfolding inner_sum_left
       apply (rule sum.cong)
       using \<open>i \<in> D\<close> \<open>finite D\<close> sum.delta'[of D i "(\<lambda>k. inverse (2 * real (card D)))"]
         d1 assms(2)
       by (auto simp: inner_Basis rev_subsetD[OF _ assms(2)])
   }
   note ** = this
   show ?thesis
     apply (rule that[of ?a])
     unfolding rel_interior_substd_simplex[OF assms(2)] mem_Collect_eq
   proof safe
     fix i
     assume "i \<in> D"
     have "0 < inverse (2 * real (card D))"
       using d1 by auto
     also have "\<dots> = ?a \<bullet> i" using **[of i] \<open>i \<in> D\<close>
       by auto
     finally show "0 < ?a \<bullet> i" by auto
   next
     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real (card D))) ?D"
       by (rule sum.cong) (rule refl, rule **)
     also have "\<dots> < 1"
       unfolding sum_constant divide_real_def[symmetric]
       by (auto simp add: field_simps)
     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
   next
     fix i
     assume "i \<in> Basis" and "i \<notin> D"
     have "?a \<in> span D"
     proof (rule span_sum[of D "(\<lambda>b. b /\<^sub>R (2 * real (card D)))" D])
       {
         fix x :: "'a::euclidean_space"
         assume "x \<in> D"
         then have "x \<in> span D"
           using span_base[of _ "D"] by auto
         then have "x /\<^sub>R (2 * real (card D)) \<in> span D"
           using span_mul[of x "D" "(inverse (real (card D)) / 2)"] by auto
       }
       then show "\<And>x. x\<in>D \<Longrightarrow> x /\<^sub>R (2 * real (card D)) \<in> span D"
         by auto
     qed
     then show "?a \<bullet> i = 0 "
       using \<open>i \<notin> D\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex set\<close>
 
 lemma rel_interior_convex_nonempty_aux:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "0 \<in> S"
   shows "rel_interior S \<noteq> {}"
 proof (cases "S = {0}")
   case True
   then show ?thesis using rel_interior_sing by auto
 next
   case False
   obtain B where B: "independent B \<and> B \<le> S \<and> S \<le> span B \<and> card B = dim S"
     using basis_exists[of S] by metis
   then have "B \<noteq> {}"
     using B assms \<open>S \<noteq> {0}\<close> span_empty by auto
   have "insert 0 B \<le> span B"
     using subspace_span[of B] subspace_0[of "span B"]
       span_superset by auto
   then have "span (insert 0 B) \<le> span B"
     using span_span[of B] span_mono[of "insert 0 B" "span B"] by blast
   then have "convex hull insert 0 B \<le> span B"
     using convex_hull_subset_span[of "insert 0 B"] by auto
   then have "span (convex hull insert 0 B) \<le> span B"
     using span_span[of B]
       span_mono[of "convex hull insert 0 B" "span B"] by blast
   then have *: "span (convex hull insert 0 B) = span B"
     using span_mono[of B "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
   then have "span (convex hull insert 0 B) = span S"
     using B span_mono[of B S] span_mono[of S "span B"]
       span_span[of B] by auto
   moreover have "0 \<in> affine hull (convex hull insert 0 B)"
     using hull_subset[of "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
   ultimately have **: "affine hull (convex hull insert 0 B) = affine hull S"
     using affine_hull_span_0[of "convex hull insert 0 B"] affine_hull_span_0[of "S"]
       assms hull_subset[of S]
     by auto
   obtain d and f :: "'n \<Rightarrow> 'n" where
     fd: "card d = card B" "linear f" "f ` B = d"
       "f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = (0::real)} \<and> inj_on f (span B)"
     and d: "d \<subseteq> Basis"
     using basis_to_substdbasis_subspace_isomorphism[of B,OF _ ] B by auto
   then have "bounded_linear f"
     using linear_conv_bounded_linear by auto
   have "d \<noteq> {}"
     using fd B \<open>B \<noteq> {}\<close> by auto
   have "insert 0 d = f ` (insert 0 B)"
     using fd linear_0 by auto
   then have "(convex hull (insert 0 d)) = f ` (convex hull (insert 0 B))"
     using convex_hull_linear_image[of f "(insert 0 d)"]
       convex_hull_linear_image[of f "(insert 0 B)"] \<open>linear f\<close>
     by auto
   moreover have "rel_interior (f ` (convex hull insert 0 B)) =
     f ` rel_interior (convex hull insert 0 B)"
     apply (rule  rel_interior_injective_on_span_linear_image[of f "(convex hull insert 0 B)"])
     using \<open>bounded_linear f\<close> fd *
     apply auto
     done
   ultimately have "rel_interior (convex hull insert 0 B) \<noteq> {}"
     using rel_interior_substd_simplex_nonempty[OF \<open>d \<noteq> {}\<close> d]
     apply auto
     apply blast
     done
   moreover have "convex hull (insert 0 B) \<subseteq> S"
     using B assms hull_mono[of "insert 0 B" "S" "convex"] convex_hull_eq
     by auto
   ultimately show ?thesis
     using subset_rel_interior[of "convex hull insert 0 B" S] ** by auto
 qed
 
 lemma rel_interior_eq_empty:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior S = {} \<longleftrightarrow> S = {}"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain a where "a \<in> S" by auto
     then have "0 \<in> (+) (-a) ` S"
       using assms exI[of "(\<lambda>x. x \<in> S \<and> - a + x = 0)" a] by auto
     then have "rel_interior ((+) (-a) ` S) \<noteq> {}"
       using rel_interior_convex_nonempty_aux[of "(+) (-a) ` S"]
         convex_translation[of S "-a"] assms
       by auto
     then have "rel_interior S \<noteq> {}"
       using rel_interior_translation [of "- a"] by simp
   }
   then show ?thesis
     using rel_interior_empty by auto
 qed
 
 lemma interior_simplex_nonempty:
   fixes S :: "'N :: euclidean_space set"
   assumes "independent S" "finite S" "card S = DIM('N)"
   obtains a where "a \<in> interior (convex hull (insert 0 S))"
 proof -
   have "affine hull (insert 0 S) = UNIV"
     by (simp add: hull_inc affine_hull_span_0 dim_eq_full[symmetric]
          assms(1) assms(3) dim_eq_card_independent)
   moreover have "rel_interior (convex hull insert 0 S) \<noteq> {}"
     using rel_interior_eq_empty [of "convex hull (insert 0 S)"] by auto
   ultimately have "interior (convex hull insert 0 S) \<noteq> {}"
     by (simp add: rel_interior_interior)
   with that show ?thesis
     by auto
 qed
 
 lemma convex_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "convex (rel_interior S)"
 proof -
   {
     fix x y and u :: real
     assume assm: "x \<in> rel_interior S" "y \<in> rel_interior S" "0 \<le> u" "u \<le> 1"
     then have "x \<in> S"
       using rel_interior_subset by auto
     have "x - u *\<^sub>R (x-y) \<in> rel_interior S"
     proof (cases "0 = u")
       case False
       then have "0 < u" using assm by auto
       then show ?thesis
         using assm rel_interior_convex_shrink[of S y x u] assms \<open>x \<in> S\<close> by auto
     next
       case True
       then show ?thesis using assm by auto
     qed
     then have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> rel_interior S"
       by (simp add: algebra_simps)
   }
   then show ?thesis
     unfolding convex_alt by auto
 qed
 
 lemma convex_closure_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "closure (rel_interior S) = closure S"
 proof -
   have h1: "closure (rel_interior S) \<le> closure S"
     using closure_mono[of "rel_interior S" S] rel_interior_subset[of S] by auto
   show ?thesis
   proof (cases "S = {}")
     case False
     then obtain a where a: "a \<in> rel_interior S"
       using rel_interior_eq_empty assms by auto
     { fix x
       assume x: "x \<in> closure S"
       {
         assume "x = a"
         then have "x \<in> closure (rel_interior S)"
           using a unfolding closure_def by auto
       }
       moreover
       {
         assume "x \<noteq> a"
          {
            fix e :: real
            assume "e > 0"
            define e1 where "e1 = min 1 (e/norm (x - a))"
            then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (x - a) \<le> e"
              using \<open>x \<noteq> a\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (x - a)"]
              by simp_all
            then have *: "x - e1 *\<^sub>R (x - a) \<in> rel_interior S"
              using rel_interior_closure_convex_shrink[of S a x e1] assms x a e1_def
              by auto
            have "\<exists>y. y \<in> rel_interior S \<and> y \<noteq> x \<and> dist y x \<le> e"
               apply (rule_tac x="x - e1 *\<^sub>R (x - a)" in exI)
               using * e1 dist_norm[of "x - e1 *\<^sub>R (x - a)" x] \<open>x \<noteq> a\<close>
               apply simp
               done
         }
         then have "x islimpt rel_interior S"
           unfolding islimpt_approachable_le by auto
         then have "x \<in> closure(rel_interior S)"
           unfolding closure_def by auto
       }
       ultimately have "x \<in> closure(rel_interior S)" by auto
     }
     then show ?thesis using h1 by auto
   next
     case True
     then have "rel_interior S = {}"
       using rel_interior_empty by auto
     then have "closure (rel_interior S) = {}"
       using closure_empty by auto
     with True show ?thesis by auto
   qed
 qed
 
 lemma rel_interior_same_affine_hull:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "affine hull (rel_interior S) = affine hull S"
   by (metis assms closure_same_affine_hull convex_closure_rel_interior)
 
 lemma rel_interior_aff_dim:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "aff_dim (rel_interior S) = aff_dim S"
   by (metis aff_dim_affine_hull2 assms rel_interior_same_affine_hull)
 
 lemma rel_interior_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (rel_interior S) = rel_interior S"
 proof -
   have "openin (top_of_set (affine hull (rel_interior S))) (rel_interior S)"
     using openin_rel_interior[of S] rel_interior_same_affine_hull[of S] assms by auto
   then show ?thesis
     using rel_interior_def by auto
 qed
 
 lemma rel_interior_rel_open:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_open (rel_interior S)"
   unfolding rel_open_def using rel_interior_rel_interior assms by auto
 
 lemma convex_rel_interior_closure_aux:
   fixes x y z :: "'n::euclidean_space"
   assumes "0 < a" "0 < b" "(a + b) *\<^sub>R z = a *\<^sub>R x + b *\<^sub>R y"
   obtains e where "0 < e" "e \<le> 1" "z = y - e *\<^sub>R (y - x)"
 proof -
   define e where "e = a / (a + b)"
   have "z = (1 / (a + b)) *\<^sub>R ((a + b) *\<^sub>R z)"
     using assms  by (simp add: eq_vector_fraction_iff)
   also have "\<dots> = (1 / (a + b)) *\<^sub>R (a *\<^sub>R x + b *\<^sub>R y)"
     using assms scaleR_cancel_left[of "1/(a+b)" "(a + b) *\<^sub>R z" "a *\<^sub>R x + b *\<^sub>R y"]
     by auto
   also have "\<dots> = y - e *\<^sub>R (y-x)"
     using e_def
     apply (simp add: algebra_simps)
     using scaleR_left_distrib[of "a/(a+b)" "b/(a+b)" y] assms add_divide_distrib[of a b "a+b"]
     apply auto
     done
   finally have "z = y - e *\<^sub>R (y-x)"
     by auto
   moreover have "e > 0" using e_def assms by auto
   moreover have "e \<le> 1" using e_def assms by auto
   ultimately show ?thesis using that[of e] by auto
 qed
 
 lemma convex_rel_interior_closure:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (closure S) = rel_interior S"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using assms rel_interior_eq_empty by auto
 next
   case False
   have "rel_interior (closure S) \<supseteq> rel_interior S"
     using subset_rel_interior[of S "closure S"] closure_same_affine_hull closure_subset
     by auto
   moreover
   {
     fix z
     assume z: "z \<in> rel_interior (closure S)"
     obtain x where x: "x \<in> rel_interior S"
       using \<open>S \<noteq> {}\<close> assms rel_interior_eq_empty by auto
     have "z \<in> rel_interior S"
     proof (cases "x = z")
       case True
       then show ?thesis using x by auto
     next
       case False
       obtain e where e: "e > 0" "cball z e \<inter> affine hull closure S \<le> closure S"
         using z rel_interior_cball[of "closure S"] by auto
       hence *: "0 < e/norm(z-x)" using e False by auto
       define y where "y = z + (e/norm(z-x)) *\<^sub>R (z-x)"
       have yball: "y \<in> cball z e"
         using mem_cball y_def dist_norm[of z y] e by auto
       have "x \<in> affine hull closure S"
         using x rel_interior_subset_closure hull_inc[of x "closure S"] by blast
       moreover have "z \<in> affine hull closure S"
         using z rel_interior_subset hull_subset[of "closure S"] by blast
       ultimately have "y \<in> affine hull closure S"
         using y_def affine_affine_hull[of "closure S"]
           mem_affine_3_minus [of "affine hull closure S" z z x "e/norm(z-x)"] by auto
       then have "y \<in> closure S" using e yball by auto
       have "(1 + (e/norm(z-x))) *\<^sub>R z = (e/norm(z-x)) *\<^sub>R x + y"
         using y_def by (simp add: algebra_simps)
       then obtain e1 where "0 < e1" "e1 \<le> 1" "z = y - e1 *\<^sub>R (y - x)"
         using * convex_rel_interior_closure_aux[of "e / norm (z - x)" 1 z x y]
         by (auto simp add: algebra_simps)
       then show ?thesis
         using rel_interior_closure_convex_shrink assms x \<open>y \<in> closure S\<close>
         by auto
     qed
   }
   ultimately show ?thesis by auto
 qed
 
 lemma convex_interior_closure:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "interior (closure S) = interior S"
   using closure_aff_dim[of S] interior_rel_interior_gen[of S]
     interior_rel_interior_gen[of "closure S"]
     convex_rel_interior_closure[of S] assms
   by auto
 
 lemma closure_eq_rel_interior_eq:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 = rel_interior S2"
   by (metis convex_rel_interior_closure convex_closure_rel_interior assms)
 
 lemma closure_eq_between:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 \<le> S2 \<and> S2 \<subseteq> closure S1"
   (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then show ?B
     by (metis assms closure_subset convex_rel_interior_closure rel_interior_subset)
 next
   assume ?B
   then have "closure S1 \<subseteq> closure S2"
     by (metis assms(1) convex_closure_rel_interior closure_mono)
   moreover from \<open>?B\<close> have "closure S1 \<supseteq> closure S2"
     by (metis closed_closure closure_minimal)
   ultimately show ?A ..
 qed
 
 lemma open_inter_closure_rel_interior:
   fixes S A :: "'n::euclidean_space set"
   assumes "convex S"
     and "open A"
   shows "A \<inter> closure S = {} \<longleftrightarrow> A \<inter> rel_interior S = {}"
   by (metis assms convex_closure_rel_interior open_Int_closure_eq_empty)
 
 lemma rel_interior_open_segment:
   fixes a :: "'a :: euclidean_space"
   shows "rel_interior(open_segment a b) = open_segment a b"
 proof (cases "a = b")
   case True then show ?thesis by auto
 next
   case False then show ?thesis
     apply (simp add: rel_interior_eq openin_open)
     apply (rule_tac x="ball (inverse 2 *\<^sub>R (a + b)) (norm(b - a) / 2)" in exI)
     apply (simp add: open_segment_as_ball)
     done
 qed
 
 lemma rel_interior_closed_segment:
   fixes a :: "'a :: euclidean_space"
   shows "rel_interior(closed_segment a b) =
          (if a = b then {a} else open_segment a b)"
 proof (cases "a = b")
   case True then show ?thesis by auto
 next
   case False then show ?thesis
     by simp
        (metis closure_open_segment convex_open_segment convex_rel_interior_closure
               rel_interior_open_segment)
 qed
 
 lemmas rel_interior_segment = rel_interior_closed_segment rel_interior_open_segment
 
 lemma starlike_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
   shows "starlike T"
 proof -
   have "rel_interior S \<noteq> {}"
     by (simp add: assms rel_interior_eq_empty)
   then obtain a where a: "a \<in> rel_interior S"  by blast
   with ST have "a \<in> T"  by blast
   have *: "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
     using assms by blast
   show ?thesis
     unfolding starlike_def
     apply (rule bexI [OF _ \<open>a \<in> T\<close>])
     apply (simp add: closed_segment_eq_open)
     apply (intro conjI ballI a \<open>a \<in> T\<close> rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
     apply (simp add: order_trans [OF * ST])
     done
 qed
 
 subsection\<open>The relative frontier of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_frontier S = closure S - rel_interior S"
 
 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
   by (simp add: rel_frontier_def)
 
 lemma rel_frontier_eq_empty:
     fixes S :: "'n::euclidean_space set"
     shows "rel_frontier S = {} \<longleftrightarrow> affine S"
   unfolding rel_frontier_def
   using rel_interior_subset_closure  by (auto simp add: rel_interior_eq_closure [symmetric])
 
 lemma rel_frontier_sing [simp]:
     fixes a :: "'n::euclidean_space"
     shows "rel_frontier {a} = {}"
   by (simp add: rel_frontier_def)
 
 lemma rel_frontier_affine_hull:
   fixes S :: "'a::euclidean_space set"
   shows "rel_frontier S \<subseteq> affine hull S"
 using closure_affine_hull rel_frontier_def by fastforce
 
 lemma rel_frontier_cball [simp]:
     fixes a :: "'n::euclidean_space"
     shows "rel_frontier(cball a r) = (if r = 0 then {} else sphere a r)"
 proof (cases rule: linorder_cases [of r 0])
   case less then show ?thesis
     by (force simp: sphere_def)
 next
   case equal then show ?thesis by simp
 next
   case greater then show ?thesis
     apply simp
     by (metis centre_in_ball empty_iff frontier_cball frontier_def interior_cball interior_rel_interior_gen rel_frontier_def)
 qed
 
 lemma rel_frontier_translation:
   fixes a :: "'a::euclidean_space"
   shows "rel_frontier((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (rel_frontier S)"
 by (simp add: rel_frontier_def translation_diff rel_interior_translation closure_translation)
 
 lemma closed_affine_hull [iff]:
   fixes S :: "'n::euclidean_space set"
   shows "closed (affine hull S)"
   by (metis affine_affine_hull affine_closed)
 
 lemma rel_frontier_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> rel_frontier S = frontier S"
 by (metis frontier_def interior_rel_interior_gen rel_frontier_def)
 
 lemma rel_frontier_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "affine hull S = UNIV \<Longrightarrow> rel_frontier S = frontier S"
 by (simp add: frontier_def rel_frontier_def rel_interior_interior)
 
 lemma closest_point_in_rel_frontier:
    "\<lbrakk>closed S; S \<noteq> {}; x \<in> affine hull S - rel_interior S\<rbrakk>
    \<Longrightarrow> closest_point S x \<in> rel_frontier S"
   by (simp add: closest_point_in_rel_interior closest_point_in_set rel_frontier_def)
 
 lemma closed_rel_frontier [iff]:
   fixes S :: "'n::euclidean_space set"
   shows "closed (rel_frontier S)"
 proof -
   have *: "closedin (top_of_set (affine hull S)) (closure S - rel_interior S)"
     by (simp add: closed_subset closedin_diff closure_affine_hull openin_rel_interior)
   show ?thesis
     apply (rule closedin_closed_trans[of "affine hull S" "rel_frontier S"])
     unfolding rel_frontier_def
     using * closed_affine_hull
     apply auto
     done
 qed
 
 lemma closed_rel_boundary:
   fixes S :: "'n::euclidean_space set"
   shows "closed S \<Longrightarrow> closed(S - rel_interior S)"
 by (metis closed_rel_frontier closure_closed rel_frontier_def)
 
 lemma compact_rel_boundary:
   fixes S :: "'n::euclidean_space set"
   shows "compact S \<Longrightarrow> compact(S - rel_interior S)"
 by (metis bounded_diff closed_rel_boundary closure_eq compact_closure compact_imp_closed)
 
 lemma bounded_rel_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "bounded S \<Longrightarrow> bounded(rel_frontier S)"
 by (simp add: bounded_closure bounded_diff rel_frontier_def)
 
 lemma compact_rel_frontier_bounded:
   fixes S :: "'n::euclidean_space set"
   shows "bounded S \<Longrightarrow> compact(rel_frontier S)"
 using bounded_rel_frontier closed_rel_frontier compact_eq_bounded_closed by blast
 
 lemma compact_rel_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "compact S \<Longrightarrow> compact(rel_frontier S)"
 by (meson compact_eq_bounded_closed compact_rel_frontier_bounded)
 
 lemma convex_same_rel_interior_closure:
   fixes S :: "'n::euclidean_space set"
   shows "\<lbrakk>convex S; convex T\<rbrakk>
          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow> closure S = closure T"
 by (simp add: closure_eq_rel_interior_eq)
 
 lemma convex_same_rel_interior_closure_straddle:
   fixes S :: "'n::euclidean_space set"
   shows "\<lbrakk>convex S; convex T\<rbrakk>
          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow>
              rel_interior S \<subseteq> T \<and> T \<subseteq> closure S"
 by (simp add: closure_eq_between convex_same_rel_interior_closure)
 
 lemma convex_rel_frontier_aff_dim:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
     and "S2 \<noteq> {}"
     and "S1 \<le> rel_frontier S2"
   shows "aff_dim S1 < aff_dim S2"
 proof -
   have "S1 \<subseteq> closure S2"
     using assms unfolding rel_frontier_def by auto
   then have *: "affine hull S1 \<subseteq> affine hull S2"
     using hull_mono[of "S1" "closure S2"] closure_same_affine_hull[of S2] by blast
   then have "aff_dim S1 \<le> aff_dim S2"
     using * aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
       aff_dim_subset[of "affine hull S1" "affine hull S2"]
     by auto
   moreover
   {
     assume eq: "aff_dim S1 = aff_dim S2"
     then have "S1 \<noteq> {}"
       using aff_dim_empty[of S1] aff_dim_empty[of S2] \<open>S2 \<noteq> {}\<close> by auto
     have **: "affine hull S1 = affine hull S2"
        apply (rule affine_dim_equal)
        using * affine_affine_hull
        apply auto
        using \<open>S1 \<noteq> {}\<close> hull_subset[of S1]
        apply auto
        using eq aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
        apply auto
        done
     obtain a where a: "a \<in> rel_interior S1"
       using \<open>S1 \<noteq> {}\<close> rel_interior_eq_empty assms by auto
     obtain T where T: "open T" "a \<in> T \<inter> S1" "T \<inter> affine hull S1 \<subseteq> S1"
        using mem_rel_interior[of a S1] a by auto
     then have "a \<in> T \<inter> closure S2"
       using a assms unfolding rel_frontier_def by auto
     then obtain b where b: "b \<in> T \<inter> rel_interior S2"
       using open_inter_closure_rel_interior[of S2 T] assms T by auto
     then have "b \<in> affine hull S1"
       using rel_interior_subset hull_subset[of S2] ** by auto
     then have "b \<in> S1"
       using T b by auto
     then have False
       using b assms unfolding rel_frontier_def by auto
   }
   ultimately show ?thesis
     using less_le by auto
 qed
 
 lemma convex_rel_interior_if:
   fixes S ::  "'n::euclidean_space set"
   assumes "convex S"
     and "z \<in> rel_interior S"
   shows "\<forall>x\<in>affine hull S. \<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
 proof -
   obtain e1 where e1: "e1 > 0 \<and> cball z e1 \<inter> affine hull S \<subseteq> S"
     using mem_rel_interior_cball[of z S] assms by auto
   {
     fix x
     assume x: "x \<in> affine hull S"
     {
       assume "x \<noteq> z"
       define m where "m = 1 + e1/norm(x-z)"
       hence "m > 1" using e1 \<open>x \<noteq> z\<close> by auto
       {
         fix e
         assume e: "e > 1 \<and> e \<le> m"
         have "z \<in> affine hull S"
           using assms rel_interior_subset hull_subset[of S] by auto
         then have *: "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> affine hull S"
           using mem_affine[of "affine hull S" x z "(1-e)" e] affine_affine_hull[of S] x
           by auto
         have "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) = norm ((e - 1) *\<^sub>R (x - z))"
           by (simp add: algebra_simps)
         also have "\<dots> = (e - 1) * norm (x-z)"
           using norm_scaleR e by auto
         also have "\<dots> \<le> (m - 1) * norm (x - z)"
           using e mult_right_mono[of _ _ "norm(x-z)"] by auto
         also have "\<dots> = (e1 / norm (x - z)) * norm (x - z)"
           using m_def by auto
         also have "\<dots> = e1"
           using \<open>x \<noteq> z\<close> e1 by simp
         finally have **: "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) \<le> e1"
           by auto
         have "(1 - e)*\<^sub>R x+ e *\<^sub>R z \<in> cball z e1"
           using m_def **
           unfolding cball_def dist_norm
           by (auto simp add: algebra_simps)
         then have "(1 - e) *\<^sub>R x+ e *\<^sub>R z \<in> S"
           using e * e1 by auto
       }
       then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S )"
         using \<open>m> 1 \<close> by auto
     }
     moreover
     {
       assume "x = z"
       define m where "m = 1 + e1"
       then have "m > 1"
         using e1 by auto
       {
         fix e
         assume e: "e > 1 \<and> e \<le> m"
         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
           using e1 x \<open>x = z\<close> by (auto simp add: algebra_simps)
         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
           using e by auto
       }
       then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
         using \<open>m > 1\<close> by auto
     }
     ultimately have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S )"
       by blast
   }
   then show ?thesis by auto
 qed
 
 lemma convex_rel_interior_if2:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   assumes "z \<in> rel_interior S"
   shows "\<forall>x\<in>affine hull S. \<exists>e. e > 1 \<and> (1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
   using convex_rel_interior_if[of S z] assms by auto
 
 lemma convex_rel_interior_only_if:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   assumes "\<forall>x\<in>S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
   shows "z \<in> rel_interior S"
 proof -
   obtain x where x: "x \<in> rel_interior S"
     using rel_interior_eq_empty assms by auto
   then have "x \<in> S"
     using rel_interior_subset by auto
   then obtain e where e: "e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
     using assms by auto
   define y where [abs_def]: "y = (1 - e) *\<^sub>R x + e *\<^sub>R z"
   then have "y \<in> S" using e by auto
   define e1 where "e1 = 1/e"
   then have "0 < e1 \<and> e1 < 1" using e by auto
   then have "z  =y - (1 - e1) *\<^sub>R (y - x)"
     using e1_def y_def by (auto simp add: algebra_simps)
   then show ?thesis
     using rel_interior_convex_shrink[of S x y "1-e1"] \<open>0 < e1 \<and> e1 < 1\<close> \<open>y \<in> S\<close> x assms
     by auto
 qed
 
 lemma convex_rel_interior_iff:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   shows "z \<in> rel_interior S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
   using assms hull_subset[of S "affine"]
     convex_rel_interior_if[of S z] convex_rel_interior_only_if[of S z]
   by auto
 
 lemma convex_rel_interior_iff2:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   shows "z \<in> rel_interior S \<longleftrightarrow> (\<forall>x\<in>affine hull S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)"
   using assms hull_subset[of S] convex_rel_interior_if2[of S z] convex_rel_interior_only_if[of S z]
   by auto
 
 lemma convex_interior_iff:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "z \<in> interior S \<longleftrightarrow> (\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S)"
 proof (cases "aff_dim S = int DIM('n)")
   case False
   { assume "z \<in> interior S"
     then have False
       using False interior_rel_interior_gen[of S] by auto }
   moreover
   { assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
     { fix x
       obtain e1 where e1: "e1 > 0 \<and> z + e1 *\<^sub>R (x - z) \<in> S"
         using r by auto
       obtain e2 where e2: "e2 > 0 \<and> z + e2 *\<^sub>R (z - x) \<in> S"
         using r by auto
       define x1 where [abs_def]: "x1 = z + e1 *\<^sub>R (x - z)"
       then have x1: "x1 \<in> affine hull S"
         using e1 hull_subset[of S] by auto
       define x2 where [abs_def]: "x2 = z + e2 *\<^sub>R (z - x)"
       then have x2: "x2 \<in> affine hull S"
         using e2 hull_subset[of S] by auto
       have *: "e1/(e1+e2) + e2/(e1+e2) = 1"
         using add_divide_distrib[of e1 e2 "e1+e2"] e1 e2 by simp
       then have "z = (e2/(e1+e2)) *\<^sub>R x1 + (e1/(e1+e2)) *\<^sub>R x2"
         using x1_def x2_def
         apply (auto simp add: algebra_simps)
         using scaleR_left_distrib[of "e1/(e1+e2)" "e2/(e1+e2)" z]
         apply auto
         done
       then have z: "z \<in> affine hull S"
         using mem_affine[of "affine hull S" x1 x2 "e2/(e1+e2)" "e1/(e1+e2)"]
           x1 x2 affine_affine_hull[of S] *
         by auto
       have "x1 - x2 = (e1 + e2) *\<^sub>R (x - z)"
         using x1_def x2_def by (auto simp add: algebra_simps)
       then have "x = z+(1/(e1+e2)) *\<^sub>R (x1-x2)"
         using e1 e2 by simp
       then have "x \<in> affine hull S"
         using mem_affine_3_minus[of "affine hull S" z x1 x2 "1/(e1+e2)"]
           x1 x2 z affine_affine_hull[of S]
         by auto
     }
     then have "affine hull S = UNIV"
       by auto
     then have "aff_dim S = int DIM('n)"
       using aff_dim_affine_hull[of S] by (simp add: aff_dim_UNIV)
     then have False
       using False by auto
   }
   ultimately show ?thesis by auto
 next
   case True
   then have "S \<noteq> {}"
     using aff_dim_empty[of S] by auto
   have *: "affine hull S = UNIV"
     using True affine_hull_UNIV by auto
   {
     assume "z \<in> interior S"
     then have "z \<in> rel_interior S"
       using True interior_rel_interior_gen[of S] by auto
     then have **: "\<forall>x. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> * by auto
     fix x
     obtain e1 where e1: "e1 > 1" "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z \<in> S"
       using **[rule_format, of "z-x"] by auto
     define e where [abs_def]: "e = e1 - 1"
     then have "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z = z + e *\<^sub>R x"
       by (simp add: algebra_simps)
     then have "e > 0" "z + e *\<^sub>R x \<in> S"
       using e1 e_def by auto
     then have "\<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
       by auto
   }
   moreover
   {
     assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
     {
       fix x
       obtain e1 where e1: "e1 > 0" "z + e1 *\<^sub>R (z - x) \<in> S"
         using r[rule_format, of "z-x"] by auto
       define e where "e = e1 + 1"
       then have "z + e1 *\<^sub>R (z - x) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
         by (simp add: algebra_simps)
       then have "e > 1" "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
         using e1 e_def by auto
       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S" by auto
     }
     then have "z \<in> rel_interior S"
       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> by auto
     then have "z \<in> interior S"
       using True interior_rel_interior_gen[of S] by auto
   }
   ultimately show ?thesis by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior and closure under common operations\<close>
 
 lemma rel_interior_inter_aux: "\<Inter>{rel_interior S |S. S \<in> I} \<subseteq> \<Inter>I"
 proof -
   {
     fix y
     assume "y \<in> \<Inter>{rel_interior S |S. S \<in> I}"
     then have y: "\<forall>S \<in> I. y \<in> rel_interior S"
       by auto
     {
       fix S
       assume "S \<in> I"
       then have "y \<in> S"
         using rel_interior_subset y by auto
     }
     then have "y \<in> \<Inter>I" by auto
   }
   then show ?thesis by auto
 qed
 
 lemma closure_Int: "closure (\<Inter>I) \<le> \<Inter>{closure S |S. S \<in> I}"
 proof -
   {
     fix y
     assume "y \<in> \<Inter>I"
     then have y: "\<forall>S \<in> I. y \<in> S" by auto
     {
       fix S
       assume "S \<in> I"
       then have "y \<in> closure S"
         using closure_subset y by auto
     }
     then have "y \<in> \<Inter>{closure S |S. S \<in> I}"
       by auto
   }
   then have "\<Inter>I \<subseteq> \<Inter>{closure S |S. S \<in> I}"
     by auto
   moreover have "closed (\<Inter>{closure S |S. S \<in> I})"
     unfolding closed_Inter closed_closure by auto
   ultimately show ?thesis using closure_hull[of "\<Inter>I"]
     hull_minimal[of "\<Inter>I" "\<Inter>{closure S |S. S \<in> I}" "closed"] by auto
 qed
 
 lemma convex_closure_rel_interior_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
 proof -
   obtain x where x: "\<forall>S\<in>I. x \<in> rel_interior S"
     using assms by auto
   {
     fix y
     assume "y \<in> \<Inter>{closure S |S. S \<in> I}"
     then have y: "\<forall>S \<in> I. y \<in> closure S"
       by auto
     {
       assume "y = x"
       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
         using x closure_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
     }
     moreover
     {
       assume "y \<noteq> x"
       { fix e :: real
         assume e: "e > 0"
         define e1 where "e1 = min 1 (e/norm (y - x))"
         then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (y - x) \<le> e"
           using \<open>y \<noteq> x\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (y - x)"]
           by simp_all
         define z where "z = y - e1 *\<^sub>R (y - x)"
         {
           fix S
           assume "S \<in> I"
           then have "z \<in> rel_interior S"
             using rel_interior_closure_convex_shrink[of S x y e1] assms x y e1 z_def
             by auto
         }
         then have *: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
           by auto
         have "\<exists>z. z \<in> \<Inter>{rel_interior S |S. S \<in> I} \<and> z \<noteq> y \<and> dist z y \<le> e"
           apply (rule_tac x="z" in exI)
           using \<open>y \<noteq> x\<close> z_def * e1 e dist_norm[of z y]
           apply simp
           done
       }
       then have "y islimpt \<Inter>{rel_interior S |S. S \<in> I}"
         unfolding islimpt_approachable_le by blast
       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
         unfolding closure_def by auto
     }
     ultimately have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
       by auto
   }
   then show ?thesis by auto
 qed
 
 lemma convex_closure_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "closure (\<Inter>I) = \<Inter>{closure S |S. S \<in> I}"
 proof -
   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
     using convex_closure_rel_interior_inter assms by auto
   moreover
   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by auto
   ultimately show ?thesis
     using closure_Int[of I] by auto
 qed
 
 lemma convex_inter_rel_interior_same_closure:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "closure (\<Inter>{rel_interior S |S. S \<in> I}) = closure (\<Inter>I)"
 proof -
   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
     using convex_closure_rel_interior_inter assms by auto
   moreover
   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by auto
   ultimately show ?thesis
     using closure_Int[of I] by auto
 qed
 
 lemma convex_rel_interior_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "rel_interior (\<Inter>I) \<subseteq> \<Inter>{rel_interior S |S. S \<in> I}"
 proof -
   have "convex (\<Inter>I)"
     using assms convex_Inter by auto
   moreover
   have "convex (\<Inter>{rel_interior S |S. S \<in> I})"
     apply (rule convex_Inter)
     using assms convex_rel_interior
     apply auto
     done
   ultimately
   have "rel_interior (\<Inter>{rel_interior S |S. S \<in> I}) = rel_interior (\<Inter>I)"
     using convex_inter_rel_interior_same_closure assms
       closure_eq_rel_interior_eq[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by blast
   then show ?thesis
     using rel_interior_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
 qed
 
 lemma convex_rel_interior_finite_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
     and "finite I"
   shows "rel_interior (\<Inter>I) = \<Inter>{rel_interior S |S. S \<in> I}"
 proof -
   have "\<Inter>I \<noteq> {}"
     using assms rel_interior_inter_aux[of I] by auto
   have "convex (\<Inter>I)"
     using convex_Inter assms by auto
   show ?thesis
   proof (cases "I = {}")
     case True
     then show ?thesis
       using Inter_empty rel_interior_UNIV by auto
   next
     case False
     {
       fix z
       assume z: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
       {
         fix x
         assume x: "x \<in> \<Inter>I"
         {
           fix S
           assume S: "S \<in> I"
           then have "z \<in> rel_interior S" "x \<in> S"
             using z x by auto
           then have "\<exists>m. m > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> m \<longrightarrow> (1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S)"
             using convex_rel_interior_if[of S z] S assms hull_subset[of S] by auto
         }
         then obtain mS where
           mS: "\<forall>S\<in>I. mS S > 1 \<and> (\<forall>e. e > 1 \<and> e \<le> mS S \<longrightarrow> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S)" by metis
         define e where "e = Min (mS ` I)"
         then have "e \<in> mS ` I" using assms \<open>I \<noteq> {}\<close> by simp
         then have "e > 1" using mS by auto
         moreover have "\<forall>S\<in>I. e \<le> mS S"
           using e_def assms by auto
         ultimately have "\<exists>e > 1. (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> \<Inter>I"
           using mS by auto
       }
       then have "z \<in> rel_interior (\<Inter>I)"
         using convex_rel_interior_iff[of "\<Inter>I" z] \<open>\<Inter>I \<noteq> {}\<close> \<open>convex (\<Inter>I)\<close> by auto
     }
     then show ?thesis
       using convex_rel_interior_inter[of I] assms by auto
   qed
 qed
 
 lemma convex_closure_inter_two:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
   assumes "rel_interior S \<inter> rel_interior T \<noteq> {}"
   shows "closure (S \<inter> T) = closure S \<inter> closure T"
   using convex_closure_inter[of "{S,T}"] assms by auto
 
 lemma convex_rel_interior_inter_two:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "rel_interior S \<inter> rel_interior T \<noteq> {}"
   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> rel_interior T"
   using convex_rel_interior_finite_inter[of "{S,T}"] assms by auto
 
 lemma convex_affine_closure_Int:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "rel_interior S \<inter> T \<noteq> {}"
   shows "closure (S \<inter> T) = closure S \<inter> T"
 proof -
   have "affine hull T = T"
     using assms by auto
   then have "rel_interior T = T"
     using rel_interior_affine_hull[of T] by metis
   moreover have "closure T = T"
     using assms affine_closed[of T] by auto
   ultimately show ?thesis
     using convex_closure_inter_two[of S T] assms affine_imp_convex by auto
 qed
 
 lemma connected_component_1_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "DIM('a) = 1"
   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
 unfolding connected_component_def
 by (metis (no_types, lifting) assms subsetD subsetI convex_contains_segment convex_segment(1)
             ends_in_segment connected_convex_1_gen)
 
 lemma connected_component_1:
   fixes S :: "real set"
   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
 by (simp add: connected_component_1_gen)
 
 lemma convex_affine_rel_interior_Int:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "rel_interior S \<inter> T \<noteq> {}"
   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> T"
 proof -
   have "affine hull T = T"
     using assms by auto
   then have "rel_interior T = T"
     using rel_interior_affine_hull[of T] by metis
   moreover have "closure T = T"
     using assms affine_closed[of T] by auto
   ultimately show ?thesis
     using convex_rel_interior_inter_two[of S T] assms affine_imp_convex by auto
 qed
 
 lemma convex_affine_rel_frontier_Int:
    fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "interior S \<inter> T \<noteq> {}"
   shows "rel_frontier(S \<inter> T) = frontier S \<inter> T"
 using assms
 apply (simp add: rel_frontier_def convex_affine_closure_Int frontier_def)
 by (metis Diff_Int_distrib2 Int_emptyI convex_affine_closure_Int convex_affine_rel_interior_Int empty_iff interior_rel_interior_gen)
 
 lemma rel_interior_convex_Int_affine:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "affine T" "interior S \<inter> T \<noteq> {}"
     shows "rel_interior(S \<inter> T) = interior S \<inter> T"
 proof -
   obtain a where aS: "a \<in> interior S" and aT:"a \<in> T"
     using assms by force
   have "rel_interior S = interior S"
     by (metis (no_types) aS affine_hull_nonempty_interior equals0D rel_interior_interior)
   then show ?thesis
     by (metis (no_types) affine_imp_convex assms convex_rel_interior_inter_two hull_same rel_interior_affine_hull)
 qed
 
 lemma closure_convex_Int_affine:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "affine T" "rel_interior S \<inter> T \<noteq> {}"
   shows "closure(S \<inter> T) = closure S \<inter> T"
 proof
   have "closure (S \<inter> T) \<subseteq> closure T"
     by (simp add: closure_mono)
   also have "... \<subseteq> T"
     by (simp add: affine_closed assms)
   finally show "closure(S \<inter> T) \<subseteq> closure S \<inter> T"
     by (simp add: closure_mono)
 next
   obtain a where "a \<in> rel_interior S" "a \<in> T"
     using assms by auto
   then have ssT: "subspace ((\<lambda>x. (-a)+x) ` T)" and "a \<in> S"
     using affine_diffs_subspace rel_interior_subset assms by blast+
   show "closure S \<inter> T \<subseteq> closure (S \<inter> T)"
   proof
     fix x  assume "x \<in> closure S \<inter> T"
     show "x \<in> closure (S \<inter> T)"
     proof (cases "x = a")
       case True
       then show ?thesis
         using \<open>a \<in> S\<close> \<open>a \<in> T\<close> closure_subset by fastforce
     next
       case False
       then have "x \<in> closure(open_segment a x)"
         by auto
       then show ?thesis
         using \<open>x \<in> closure S \<inter> T\<close> assms convex_affine_closure_Int by blast
     qed
   qed
 qed
 
 lemma subset_rel_interior_convex:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "S \<le> closure T"
     and "\<not> S \<subseteq> rel_frontier T"
   shows "rel_interior S \<subseteq> rel_interior T"
 proof -
   have *: "S \<inter> closure T = S"
     using assms by auto
   have "\<not> rel_interior S \<subseteq> rel_frontier T"
     using closure_mono[of "rel_interior S" "rel_frontier T"] closed_rel_frontier[of T]
       closure_closed[of S] convex_closure_rel_interior[of S] closure_subset[of S] assms
     by auto
   then have "rel_interior S \<inter> rel_interior (closure T) \<noteq> {}"
     using assms rel_frontier_def[of T] rel_interior_subset convex_rel_interior_closure[of T]
     by auto
   then have "rel_interior S \<inter> rel_interior T = rel_interior (S \<inter> closure T)"
     using assms convex_closure convex_rel_interior_inter_two[of S "closure T"]
       convex_rel_interior_closure[of T]
     by auto
   also have "\<dots> = rel_interior S"
     using * by auto
   finally show ?thesis
     by auto
 qed
 
 lemma rel_interior_convex_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
   shows "f ` (rel_interior S) = rel_interior (f ` S)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using assms rel_interior_empty rel_interior_eq_empty by auto
 next
   case False
   interpret linear f by fact
   have *: "f ` (rel_interior S) \<subseteq> f ` S"
     unfolding image_mono using rel_interior_subset by auto
   have "f ` S \<subseteq> f ` (closure S)"
     unfolding image_mono using closure_subset by auto
   also have "\<dots> = f ` (closure (rel_interior S))"
     using convex_closure_rel_interior assms by auto
   also have "\<dots> \<subseteq> closure (f ` (rel_interior S))"
     using closure_linear_image_subset assms by auto
   finally have "closure (f ` S) = closure (f ` rel_interior S)"
     using closure_mono[of "f ` S" "closure (f ` rel_interior S)"] closure_closure
       closure_mono[of "f ` rel_interior S" "f ` S"] *
     by auto
   then have "rel_interior (f ` S) = rel_interior (f ` rel_interior S)"
     using assms convex_rel_interior
       linear_conv_bounded_linear[of f] convex_linear_image[of _ S]
       convex_linear_image[of _ "rel_interior S"]
       closure_eq_rel_interior_eq[of "f ` S" "f ` rel_interior S"]
     by auto
   then have "rel_interior (f ` S) \<subseteq> f ` rel_interior S"
     using rel_interior_subset by auto
   moreover
   {
     fix z
     assume "z \<in> f ` rel_interior S"
     then obtain z1 where z1: "z1 \<in> rel_interior S" "f z1 = z" by auto
     {
       fix x
       assume "x \<in> f ` S"
       then obtain x1 where x1: "x1 \<in> S" "f x1 = x" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1 \<in> S"
         using convex_rel_interior_iff[of S z1] \<open>convex S\<close> x1 z1 by auto
       moreover have "f ((1 - e) *\<^sub>R x1 + e *\<^sub>R z1) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
         using x1 z1 by (simp add: linear_add linear_scale \<open>linear f\<close>)
       ultimately have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
         using imageI[of "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1" S f] by auto
       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
         using e by auto
     }
     then have "z \<in> rel_interior (f ` S)"
       using convex_rel_interior_iff[of "f ` S" z] \<open>convex S\<close> \<open>linear f\<close>
         \<open>S \<noteq> {}\<close> convex_linear_image[of f S]  linear_conv_bounded_linear[of f]
       by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_convex_linear_preimage:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "f -` (rel_interior S) \<noteq> {}"
   shows "rel_interior (f -` S) = f -` (rel_interior S)"
 proof -
   interpret linear f by fact
   have "S \<noteq> {}"
     using assms rel_interior_empty by auto
   have nonemp: "f -` S \<noteq> {}"
     by (metis assms(3) rel_interior_subset subset_empty vimage_mono)
   then have "S \<inter> (range f) \<noteq> {}"
     by auto
   have conv: "convex (f -` S)"
     using convex_linear_vimage assms by auto
   then have "convex (S \<inter> range f)"
     by (simp add: assms(2) convex_Int convex_linear_image linear_axioms)
   {
     fix z
     assume "z \<in> f -` (rel_interior S)"
     then have z: "f z \<in> rel_interior S"
       by auto
     {
       fix x
       assume "x \<in> f -` S"
       then have "f x \<in> S" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R f x + e *\<^sub>R f z \<in> S"
         using convex_rel_interior_iff[of S "f z"] z assms \<open>S \<noteq> {}\<close> by auto
       moreover have "(1 - e) *\<^sub>R f x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R x + e *\<^sub>R z)"
         using \<open>linear f\<close> by (simp add: linear_iff)
       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f -` S"
         using e by auto
     }
     then have "z \<in> rel_interior (f -` S)"
       using convex_rel_interior_iff[of "f -` S" z] conv nonemp by auto
   }
   moreover
   {
     fix z
     assume z: "z \<in> rel_interior (f -` S)"
     {
       fix x
       assume "x \<in> S \<inter> range f"
       then obtain y where y: "f y = x" "y \<in> f -` S" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R y + e *\<^sub>R z \<in> f -` S"
         using convex_rel_interior_iff[of "f -` S" z] z conv by auto
       moreover have "(1 - e) *\<^sub>R x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R y + e *\<^sub>R z)"
         using \<open>linear f\<close> y by (simp add: linear_iff)
       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R f z \<in> S \<inter> range f"
         using e by auto
     }
     then have "f z \<in> rel_interior (S \<inter> range f)"
       using \<open>convex (S \<inter> (range f))\<close> \<open>S \<inter> range f \<noteq> {}\<close>
         convex_rel_interior_iff[of "S \<inter> (range f)" "f z"]
       by auto
     moreover have "affine (range f)"
       by (simp add: linear_axioms linear_subspace_image subspace_imp_affine)
     ultimately have "f z \<in> rel_interior S"
       using convex_affine_rel_interior_Int[of S "range f"] assms by auto
     then have "z \<in> f -` (rel_interior S)"
       by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_Times:
   fixes S :: "'n::euclidean_space set"
     and T :: "'m::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_interior (S \<times> T) = rel_interior S \<times> rel_interior T"
 proof -
   { assume "S = {}"
     then have ?thesis
       by auto
   }
   moreover
   { assume "T = {}"
     then have ?thesis
        by auto
   }
   moreover
   {
     assume "S \<noteq> {}" "T \<noteq> {}"
     then have ri: "rel_interior S \<noteq> {}" "rel_interior T \<noteq> {}"
       using rel_interior_eq_empty assms by auto
     then have "fst -` rel_interior S \<noteq> {}"
       using fst_vimage_eq_Times[of "rel_interior S"] by auto
     then have "rel_interior ((fst :: 'n * 'm \<Rightarrow> 'n) -` S) = fst -` rel_interior S"
       using fst_linear \<open>convex S\<close> rel_interior_convex_linear_preimage[of fst S] by auto
     then have s: "rel_interior (S \<times> (UNIV :: 'm set)) = rel_interior S \<times> UNIV"
       by (simp add: fst_vimage_eq_Times)
     from ri have "snd -` rel_interior T \<noteq> {}"
       using snd_vimage_eq_Times[of "rel_interior T"] by auto
     then have "rel_interior ((snd :: 'n * 'm \<Rightarrow> 'm) -` T) = snd -` rel_interior T"
       using snd_linear \<open>convex T\<close> rel_interior_convex_linear_preimage[of snd T] by auto
     then have t: "rel_interior ((UNIV :: 'n set) \<times> T) = UNIV \<times> rel_interior T"
       by (simp add: snd_vimage_eq_Times)
     from s t have *: "rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T) =
       rel_interior S \<times> rel_interior T" by auto
     have "S \<times> T = S \<times> (UNIV :: 'm set) \<inter> (UNIV :: 'n set) \<times> T"
       by auto
     then have "rel_interior (S \<times> T) = rel_interior ((S \<times> (UNIV :: 'm set)) \<inter> ((UNIV :: 'n set) \<times> T))"
       by auto
     also have "\<dots> = rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T)"
        apply (subst convex_rel_interior_inter_two[of "S \<times> (UNIV :: 'm set)" "(UNIV :: 'n set) \<times> T"])
        using * ri assms convex_Times
        apply auto
        done
     finally have ?thesis using * by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma rel_interior_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "c \<noteq> 0"
   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
   using rel_interior_injective_linear_image[of "((*\<^sub>R) c)" S]
     linear_conv_bounded_linear[of "(*\<^sub>R) c"] linear_scaleR injective_scaleR[of c] assms
   by auto
 
 lemma rel_interior_convex_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
   by (metis assms linear_scaleR rel_interior_convex_linear_image)
 
 lemma convex_rel_open_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
   shows "convex (((*\<^sub>R) c) ` S) \<and> rel_open (((*\<^sub>R) c) ` S)"
   by (metis assms convex_scaling rel_interior_convex_scaleR rel_open_def)
 
 lemma convex_rel_open_finite_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set) \<and> rel_open S"
     and "finite I"
   shows "convex (\<Inter>I) \<and> rel_open (\<Inter>I)"
 proof (cases "\<Inter>{rel_interior S |S. S \<in> I} = {}")
   case True
   then have "\<Inter>I = {}"
     using assms unfolding rel_open_def by auto
   then show ?thesis
     unfolding rel_open_def using rel_interior_empty by auto
 next
   case False
   then have "rel_open (\<Inter>I)"
     using assms unfolding rel_open_def
     using convex_rel_interior_finite_inter[of I]
     by auto
   then show ?thesis
     using convex_Inter assms by auto
 qed
 
 lemma convex_rel_open_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "rel_open S"
   shows "convex (f ` S) \<and> rel_open (f ` S)"
   by (metis assms convex_linear_image rel_interior_convex_linear_image rel_open_def)
 
 lemma convex_rel_open_linear_preimage:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "rel_open S"
   shows "convex (f -` S) \<and> rel_open (f -` S)"
 proof (cases "f -` (rel_interior S) = {}")
   case True
   then have "f -` S = {}"
     using assms unfolding rel_open_def by auto
   then show ?thesis
     unfolding rel_open_def using rel_interior_empty by auto
 next
   case False
   then have "rel_open (f -` S)"
     using assms unfolding rel_open_def
     using rel_interior_convex_linear_preimage[of f S]
     by auto
   then show ?thesis
     using convex_linear_vimage assms
     by auto
 qed
 
 lemma rel_interior_projection:
   fixes S :: "('m::euclidean_space \<times> 'n::euclidean_space) set"
     and f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space set"
   assumes "convex S"
     and "f = (\<lambda>y. {z. (y, z) \<in> S})"
   shows "(y, z) \<in> rel_interior S \<longleftrightarrow> (y \<in> rel_interior {y. (f y \<noteq> {})} \<and> z \<in> rel_interior (f y))"
 proof -
   {
     fix y
     assume "y \<in> {y. f y \<noteq> {}}"
     then obtain z where "(y, z) \<in> S"
       using assms by auto
     then have "\<exists>x. x \<in> S \<and> y = fst x"
       apply (rule_tac x="(y, z)" in exI)
       apply auto
       done
     then obtain x where "x \<in> S" "y = fst x"
       by blast
     then have "y \<in> fst ` S"
       unfolding image_def by auto
   }
   then have "fst ` S = {y. f y \<noteq> {}}"
     unfolding fst_def using assms by auto
   then have h1: "fst ` rel_interior S = rel_interior {y. f y \<noteq> {}}"
     using rel_interior_convex_linear_image[of fst S] assms fst_linear by auto
   {
     fix y
     assume "y \<in> rel_interior {y. f y \<noteq> {}}"
     then have "y \<in> fst ` rel_interior S"
       using h1 by auto
     then have *: "rel_interior S \<inter> fst -` {y} \<noteq> {}"
       by auto
     moreover have aff: "affine (fst -` {y})"
       unfolding affine_alt by (simp add: algebra_simps)
     ultimately have **: "rel_interior (S \<inter> fst -` {y}) = rel_interior S \<inter> fst -` {y}"
       using convex_affine_rel_interior_Int[of S "fst -` {y}"] assms by auto
     have conv: "convex (S \<inter> fst -` {y})"
       using convex_Int assms aff affine_imp_convex by auto
     {
       fix x
       assume "x \<in> f y"
       then have "(y, x) \<in> S \<inter> (fst -` {y})"
         using assms by auto
       moreover have "x = snd (y, x)" by auto
       ultimately have "x \<in> snd ` (S \<inter> fst -` {y})"
         by blast
     }
     then have "snd ` (S \<inter> fst -` {y}) = f y"
       using assms by auto
     then have ***: "rel_interior (f y) = snd ` rel_interior (S \<inter> fst -` {y})"
       using rel_interior_convex_linear_image[of snd "S \<inter> fst -` {y}"] snd_linear conv
       by auto
     {
       fix z
       assume "z \<in> rel_interior (f y)"
       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
         using *** by auto
       moreover have "{y} = fst ` rel_interior (S \<inter> fst -` {y})"
         using * ** rel_interior_subset by auto
       ultimately have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
         by force
       then have "(y,z) \<in> rel_interior S"
         using ** by auto
     }
     moreover
     {
       fix z
       assume "(y, z) \<in> rel_interior S"
       then have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
         using ** by auto
       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
         by (metis Range_iff snd_eq_Range)
       then have "z \<in> rel_interior (f y)"
         using *** by auto
     }
     ultimately have "\<And>z. (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
       by auto
   }
   then have h2: "\<And>y z. y \<in> rel_interior {t. f t \<noteq> {}} \<Longrightarrow>
     (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
     by auto
   {
     fix y z
     assume asm: "(y, z) \<in> rel_interior S"
     then have "y \<in> fst ` rel_interior S"
       by (metis Domain_iff fst_eq_Domain)
     then have "y \<in> rel_interior {t. f t \<noteq> {}}"
       using h1 by auto
     then have "y \<in> rel_interior {t. f t \<noteq> {}}" and "(z \<in> rel_interior (f y))"
       using h2 asm by auto
   }
   then show ?thesis using h2 by blast
 qed
 
 lemma rel_frontier_Times:
   fixes S :: "'n::euclidean_space set"
     and T :: "'m::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_frontier S \<times> rel_frontier T \<subseteq> rel_frontier (S \<times> T)"
     by (force simp: rel_frontier_def rel_interior_Times assms closure_Times)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex cone\<close>
 
 lemma cone_rel_interior:
   fixes S :: "'m::euclidean_space set"
   assumes "cone S"
   shows "cone ({0} \<union> rel_interior S)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: rel_interior_empty cone_0)
 next
   case False
   then have *: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
     using cone_iff[of S] assms by auto
   then have *: "0 \<in> ({0} \<union> rel_interior S)"
     and "\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` ({0} \<union> rel_interior S) = ({0} \<union> rel_interior S)"
     by (auto simp add: rel_interior_scaleR)
   then show ?thesis
     using cone_iff[of "{0} \<union> rel_interior S"] by auto
 qed
 
 lemma rel_interior_convex_cone_aux:
   fixes S :: "'m::euclidean_space set"
   assumes "convex S"
   shows "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) \<longleftrightarrow>
     c > 0 \<and> x \<in> (((*\<^sub>R) c) ` (rel_interior S))"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: rel_interior_empty cone_hull_empty)
 next
   case False
   then obtain s where "s \<in> S" by auto
   have conv: "convex ({(1 :: real)} \<times> S)"
     using convex_Times[of "{(1 :: real)}" S] assms convex_singleton[of "1 :: real"]
     by auto
   define f where "f y = {z. (y, z) \<in> cone hull ({1 :: real} \<times> S)}" for y
   then have *: "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) =
     (c \<in> rel_interior {y. f y \<noteq> {}} \<and> x \<in> rel_interior (f c))"
     apply (subst rel_interior_projection[of "cone hull ({(1 :: real)} \<times> S)" f c x])
     using convex_cone_hull[of "{(1 :: real)} \<times> S"] conv
     apply auto
     done
   {
     fix y :: real
     assume "y \<ge> 0"
     then have "y *\<^sub>R (1,s) \<in> cone hull ({1 :: real} \<times> S)"
       using cone_hull_expl[of "{(1 :: real)} \<times> S"] \<open>s \<in> S\<close> by auto
     then have "f y \<noteq> {}"
       using f_def by auto
   }
   then have "{y. f y \<noteq> {}} = {0..}"
     using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
   then have **: "rel_interior {y. f y \<noteq> {}} = {0<..}"
     using rel_interior_real_semiline by auto
   {
     fix c :: real
     assume "c > 0"
     then have "f c = ((*\<^sub>R) c ` S)"
       using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
     then have "rel_interior (f c) = (*\<^sub>R) c ` rel_interior S"
       using rel_interior_convex_scaleR[of S c] assms by auto
   }
   then show ?thesis using * ** by auto
 qed
 
 lemma rel_interior_convex_cone:
   fixes S :: "'m::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (cone hull ({1 :: real} \<times> S)) =
     {(c, c *\<^sub>R x) | c x. c > 0 \<and> x \<in> rel_interior S}"
   (is "?lhs = ?rhs")
 proof -
   {
     fix z
     assume "z \<in> ?lhs"
     have *: "z = (fst z, snd z)"
       by auto
     then have "z \<in> ?rhs"
       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms \<open>z \<in> ?lhs\<close> by fastforce
   }
   moreover
   {
     fix z
     assume "z \<in> ?rhs"
     then have "z \<in> ?lhs"
       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms
       by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma convex_hull_finite_union:
   assumes "finite I"
   assumes "\<forall>i\<in>I. convex (S i) \<and> (S i) \<noteq> {}"
   shows "convex hull (\<Union>(S ` I)) =
     {sum (\<lambda>i. c i *\<^sub>R s i) I | c s. (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> S i)}"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs \<supseteq> ?rhs"
   proof
     fix x
     assume "x \<in> ?rhs"
     then obtain c s where *: "sum (\<lambda>i. c i *\<^sub>R s i) I = x" "sum c I = 1"
       "(\<forall>i\<in>I. c i \<ge> 0) \<and> (\<forall>i\<in>I. s i \<in> S i)" by auto
     then have "\<forall>i\<in>I. s i \<in> convex hull (\<Union>(S ` I))"
       using hull_subset[of "\<Union>(S ` I)" convex] by auto
     then show "x \<in> ?lhs"
       unfolding *(1)[symmetric]
       apply (subst convex_sum[of I "convex hull \<Union>(S ` I)" c s])
       using * assms convex_convex_hull
       apply auto
       done
   qed
 
   {
     fix i
     assume "i \<in> I"
     with assms have "\<exists>p. p \<in> S i" by auto
   }
   then obtain p where p: "\<forall>i\<in>I. p i \<in> S i" by metis
 
   {
     fix i
     assume "i \<in> I"
     {
       fix x
       assume "x \<in> S i"
       define c where "c j = (if j = i then 1::real else 0)" for j
       then have *: "sum c I = 1"
         using \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. 1::real"]
         by auto
       define s where "s j = (if j = i then x else p j)" for j
       then have "\<forall>j. c j *\<^sub>R s j = (if j = i then x else 0)"
         using c_def by (auto simp add: algebra_simps)
       then have "x = sum (\<lambda>i. c i *\<^sub>R s i) I"
         using s_def c_def \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. x"]
         by auto
       then have "x \<in> ?rhs"
         apply auto
         apply (rule_tac x = c in exI)
         apply (rule_tac x = s in exI)
         using * c_def s_def p \<open>x \<in> S i\<close>
         apply auto
         done
     }
     then have "?rhs \<supseteq> S i" by auto
   }
   then have *: "?rhs \<supseteq> \<Union>(S ` I)" by auto
 
   {
     fix u v :: real
     assume uv: "u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1"
     fix x y
     assume xy: "x \<in> ?rhs \<and> y \<in> ?rhs"
     from xy obtain c s where
       xc: "x = sum (\<lambda>i. c i *\<^sub>R s i) I \<and> (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> S i)"
       by auto
     from xy obtain d t where
       yc: "y = sum (\<lambda>i. d i *\<^sub>R t i) I \<and> (\<forall>i\<in>I. d i \<ge> 0) \<and> sum d I = 1 \<and> (\<forall>i\<in>I. t i \<in> S i)"
       by auto
     define e where "e i = u * c i + v * d i" for i
     have ge0: "\<forall>i\<in>I. e i \<ge> 0"
       using e_def xc yc uv by simp
     have "sum (\<lambda>i. u * c i) I = u * sum c I"
       by (simp add: sum_distrib_left)
     moreover have "sum (\<lambda>i. v * d i) I = v * sum d I"
       by (simp add: sum_distrib_left)
     ultimately have sum1: "sum e I = 1"
       using e_def xc yc uv by (simp add: sum.distrib)
     define q where "q i = (if e i = 0 then p i else (u * c i / e i) *\<^sub>R s i + (v * d i / e i) *\<^sub>R t i)"
       for i
     {
       fix i
       assume i: "i \<in> I"
       have "q i \<in> S i"
       proof (cases "e i = 0")
         case True
         then show ?thesis using i p q_def by auto
       next
         case False
         then show ?thesis
           using mem_convex_alt[of "S i" "s i" "t i" "u * (c i)" "v * (d i)"]
             mult_nonneg_nonneg[of u "c i"] mult_nonneg_nonneg[of v "d i"]
             assms q_def e_def i False xc yc uv
           by (auto simp del: mult_nonneg_nonneg)
       qed
     }
     then have qs: "\<forall>i\<in>I. q i \<in> S i" by auto
     {
       fix i
       assume i: "i \<in> I"
       have "(u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i = e i *\<^sub>R q i"
       proof (cases "e i = 0")
         case True
         have ge: "u * (c i) \<ge> 0 \<and> v * d i \<ge> 0"
           using xc yc uv i by simp
         moreover from ge have "u * c i \<le> 0 \<and> v * d i \<le> 0"
           using True e_def i by simp
         ultimately have "u * c i = 0 \<and> v * d i = 0" by auto
         with True show ?thesis by auto
       next
         case False
         then have "(u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i) = q i"
           using q_def by auto
         then have "e i *\<^sub>R ((u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i))
                = (e i) *\<^sub>R (q i)" by auto
         with False show ?thesis by (simp add: algebra_simps)
       qed
     }
     then have *: "\<forall>i\<in>I. (u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i = e i *\<^sub>R q i"
       by auto
     have "u *\<^sub>R x + v *\<^sub>R y = sum (\<lambda>i. (u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i) I"
       using xc yc by (simp add: algebra_simps scaleR_right.sum sum.distrib)
     also have "\<dots> = sum (\<lambda>i. e i *\<^sub>R q i) I"
       using * by auto
     finally have "u *\<^sub>R x + v *\<^sub>R y = sum (\<lambda>i. (e i) *\<^sub>R (q i)) I"
       by auto
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> ?rhs"
       using ge0 sum1 qs by auto
   }
   then have "convex ?rhs" unfolding convex_def by auto
   then show ?thesis
     using \<open>?lhs \<supseteq> ?rhs\<close> * hull_minimal[of "\<Union>(S ` I)" ?rhs convex]
     by blast
 qed
 
 lemma convex_hull_union_two:
   fixes S T :: "'m::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
     and "convex T"
     and "T \<noteq> {}"
   shows "convex hull (S \<union> T) =
     {u *\<^sub>R s + v *\<^sub>R t | u v s t. u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1 \<and> s \<in> S \<and> t \<in> T}"
   (is "?lhs = ?rhs")
 proof
   define I :: "nat set" where "I = {1, 2}"
   define s where "s i = (if i = (1::nat) then S else T)" for i
   have "\<Union>(s ` I) = S \<union> T"
     using s_def I_def by auto
   then have "convex hull (\<Union>(s ` I)) = convex hull (S \<union> T)"
     by auto
   moreover have "convex hull \<Union>(s ` I) =
     {\<Sum> i\<in>I. c i *\<^sub>R sa i | c sa. (\<forall>i\<in>I. 0 \<le> c i) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. sa i \<in> s i)}"
       apply (subst convex_hull_finite_union[of I s])
       using assms s_def I_def
       apply auto
       done
   moreover have
     "{\<Sum>i\<in>I. c i *\<^sub>R sa i | c sa. (\<forall>i\<in>I. 0 \<le> c i) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. sa i \<in> s i)} \<le> ?rhs"
     using s_def I_def by auto
   ultimately show "?lhs \<subseteq> ?rhs" by auto
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain u v s t where *: "x = u *\<^sub>R s + v *\<^sub>R t \<and> u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1 \<and> s \<in> S \<and> t \<in> T"
       by auto
     then have "x \<in> convex hull {s, t}"
       using convex_hull_2[of s t] by auto
     then have "x \<in> convex hull (S \<union> T)"
       using * hull_mono[of "{s, t}" "S \<union> T"] by auto
   }
   then show "?lhs \<supseteq> ?rhs" by blast
 qed
 
 proposition ray_to_rel_frontier:
   fixes a :: "'a::real_inner"
   assumes "bounded S"
       and a: "a \<in> rel_interior S"
       and aff: "(a + l) \<in> affine hull S"
       and "l \<noteq> 0"
   obtains d where "0 < d" "(a + d *\<^sub>R l) \<in> rel_frontier S"
            "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S"
 proof -
   have aaff: "a \<in> affine hull S"
     by (meson a hull_subset rel_interior_subset rev_subsetD)
   let ?D = "{d. 0 < d \<and> a + d *\<^sub>R l \<notin> rel_interior S}"
   obtain B where "B > 0" and B: "S \<subseteq> ball a B"
     using bounded_subset_ballD [OF \<open>bounded S\<close>] by blast
   have "a + (B / norm l) *\<^sub>R l \<notin> ball a B"
     by (simp add: dist_norm \<open>l \<noteq> 0\<close>)
   with B have "a + (B / norm l) *\<^sub>R l \<notin> rel_interior S"
     using rel_interior_subset subsetCE by blast
   with \<open>B > 0\<close> \<open>l \<noteq> 0\<close> have nonMT: "?D \<noteq> {}"
     using divide_pos_pos zero_less_norm_iff by fastforce
   have bdd: "bdd_below ?D"
     by (metis (no_types, lifting) bdd_belowI le_less mem_Collect_eq)
   have relin_Ex: "\<And>x. x \<in> rel_interior S \<Longrightarrow>
                     \<exists>e>0. \<forall>x'\<in>affine hull S. dist x' x < e \<longrightarrow> x' \<in> rel_interior S"
     using openin_rel_interior [of S] by (simp add: openin_euclidean_subtopology_iff)
   define d where "d = Inf ?D"
   obtain \<epsilon> where "0 < \<epsilon>" and \<epsilon>: "\<And>\<eta>. \<lbrakk>0 \<le> \<eta>; \<eta> < \<epsilon>\<rbrakk> \<Longrightarrow> (a + \<eta> *\<^sub>R l) \<in> rel_interior S"
   proof -
     obtain e where "e>0"
             and e: "\<And>x'. x' \<in> affine hull S \<Longrightarrow> dist x' a < e \<Longrightarrow> x' \<in> rel_interior S"
       using relin_Ex a by blast
     show thesis
     proof (rule_tac \<epsilon> = "e / norm l" in that)
       show "0 < e / norm l" by (simp add: \<open>0 < e\<close> \<open>l \<noteq> 0\<close>)
     next
       show "a + \<eta> *\<^sub>R l \<in> rel_interior S" if "0 \<le> \<eta>" "\<eta> < e / norm l" for \<eta>
       proof (rule e)
         show "a + \<eta> *\<^sub>R l \<in> affine hull S"
           by (metis (no_types) add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff)
         show "dist (a + \<eta> *\<^sub>R l) a < e"
           using that by (simp add: \<open>l \<noteq> 0\<close> dist_norm pos_less_divide_eq)
       qed
     qed
   qed
   have inint: "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> a + e *\<^sub>R l \<in> rel_interior S"
     unfolding d_def using cInf_lower [OF _ bdd]
     by (metis (no_types, lifting) a add.right_neutral le_less mem_Collect_eq not_less real_vector.scale_zero_left)
   have "\<epsilon> \<le> d"
     unfolding d_def
     apply (rule cInf_greatest [OF nonMT])
     using \<epsilon> dual_order.strict_implies_order le_less_linear by blast
   with \<open>0 < \<epsilon>\<close> have "0 < d" by simp
   have "a + d *\<^sub>R l \<notin> rel_interior S"
   proof
     assume adl: "a + d *\<^sub>R l \<in> rel_interior S"
     obtain e where "e > 0"
              and e: "\<And>x'. x' \<in> affine hull S \<Longrightarrow> dist x' (a + d *\<^sub>R l) < e \<Longrightarrow> x' \<in> rel_interior S"
       using relin_Ex adl by blast
     have "d + e / norm l \<le> Inf {d. 0 < d \<and> a + d *\<^sub>R l \<notin> rel_interior S}"
     proof (rule cInf_greatest [OF nonMT], clarsimp)
       fix x::real
       assume "0 < x" and nonrel: "a + x *\<^sub>R l \<notin> rel_interior S"
       show "d + e / norm l \<le> x"
       proof (cases "x < d")
         case True with inint nonrel \<open>0 < x\<close>
           show ?thesis by auto
       next
         case False
           then have dle: "x < d + e / norm l \<Longrightarrow> dist (a + x *\<^sub>R l) (a + d *\<^sub>R l) < e"
             by (simp add: field_simps \<open>l \<noteq> 0\<close>)
           have ain: "a + x *\<^sub>R l \<in> affine hull S"
             by (metis add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff)
           show ?thesis
             using e [OF ain] nonrel dle by force
       qed
     qed
     then show False
       using \<open>0 < e\<close> \<open>l \<noteq> 0\<close> by (simp add: d_def [symmetric] field_simps)
   qed
   moreover have "a + d *\<^sub>R l \<in> closure S"
   proof (clarsimp simp: closure_approachable)
     fix \<eta>::real assume "0 < \<eta>"
     have 1: "a + (d - min d (\<eta> / 2 / norm l)) *\<^sub>R l \<in> S"
       apply (rule subsetD [OF rel_interior_subset inint])
       using \<open>l \<noteq> 0\<close> \<open>0 < d\<close> \<open>0 < \<eta>\<close> by auto
     have "norm l * min d (\<eta> / (norm l * 2)) \<le> norm l * (\<eta> / (norm l * 2))"
       by (metis min_def mult_left_mono norm_ge_zero order_refl)
     also have "... < \<eta>"
       using \<open>l \<noteq> 0\<close> \<open>0 < \<eta>\<close> by (simp add: field_simps)
     finally have 2: "norm l * min d (\<eta> / (norm l * 2)) < \<eta>" .
     show "\<exists>y\<in>S. dist y (a + d *\<^sub>R l) < \<eta>"
       apply (rule_tac x="a + (d - min d (\<eta> / 2 / norm l)) *\<^sub>R l" in bexI)
       using 1 2 \<open>0 < d\<close> \<open>0 < \<eta>\<close> apply (auto simp: algebra_simps)
       done
   qed
   ultimately have infront: "a + d *\<^sub>R l \<in> rel_frontier S"
     by (simp add: rel_frontier_def)
   show ?thesis
     by (rule that [OF \<open>0 < d\<close> infront inint])
 qed
 
 corollary ray_to_frontier:
   fixes a :: "'a::euclidean_space"
   assumes "bounded S"
       and a: "a \<in> interior S"
       and "l \<noteq> 0"
   obtains d where "0 < d" "(a + d *\<^sub>R l) \<in> frontier S"
            "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (a + e *\<^sub>R l) \<in> interior S"
 proof -
   have "interior S = rel_interior S"
     using a rel_interior_nonempty_interior by auto
   then have "a \<in> rel_interior S"
     using a by simp
   then show ?thesis
     apply (rule ray_to_rel_frontier [OF \<open>bounded S\<close> _ _ \<open>l \<noteq> 0\<close>])
      using a affine_hull_nonempty_interior apply blast
     by (simp add: \<open>interior S = rel_interior S\<close> frontier_def rel_frontier_def that)
 qed
 
 
 lemma segment_to_rel_frontier_aux:
   fixes x :: "'a::euclidean_space"
   assumes "convex S" "bounded S" and x: "x \<in> rel_interior S" and y: "y \<in> S" and xy: "x \<noteq> y"
   obtains z where "z \<in> rel_frontier S" "y \<in> closed_segment x z"
                    "open_segment x z \<subseteq> rel_interior S"
 proof -
   have "x + (y - x) \<in> affine hull S"
     using hull_inc [OF y] by auto
   then obtain d where "0 < d" and df: "(x + d *\<^sub>R (y-x)) \<in> rel_frontier S"
                   and di: "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (x + e *\<^sub>R (y-x)) \<in> rel_interior S"
     by (rule ray_to_rel_frontier [OF \<open>bounded S\<close> x]) (use xy in auto)
   show ?thesis
   proof
     show "x + d *\<^sub>R (y - x) \<in> rel_frontier S"
       by (simp add: df)
   next
     have "open_segment x y \<subseteq> rel_interior S"
       using rel_interior_closure_convex_segment [OF \<open>convex S\<close> x] closure_subset y by blast
     moreover have "x + d *\<^sub>R (y - x) \<in> open_segment x y" if "d < 1"
       using xy
       apply (auto simp: in_segment)
       apply (rule_tac x="d" in exI)
       using \<open>0 < d\<close> that apply (auto simp: algebra_simps)
       done
     ultimately have "1 \<le> d"
       using df rel_frontier_def by fastforce
     moreover have "x = (1 / d) *\<^sub>R x + ((d - 1) / d) *\<^sub>R x"
       by (metis \<open>0 < d\<close> add.commute add_divide_distrib diff_add_cancel divide_self_if less_irrefl scaleR_add_left scaleR_one)
     ultimately show "y \<in> closed_segment x (x + d *\<^sub>R (y - x))"
       apply (auto simp: in_segment)
       apply (rule_tac x="1/d" in exI)
       apply (auto simp: algebra_simps)
       done
   next
     show "open_segment x (x + d *\<^sub>R (y - x)) \<subseteq> rel_interior S"
       apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> x])
       using df rel_frontier_def by auto
   qed
 qed
 
 lemma segment_to_rel_frontier:
   fixes x :: "'a::euclidean_space"
   assumes S: "convex S" "bounded S" and x: "x \<in> rel_interior S"
       and y: "y \<in> S" and xy: "\<not>(x = y \<and> S = {x})"
   obtains z where "z \<in> rel_frontier S" "y \<in> closed_segment x z"
                   "open_segment x z \<subseteq> rel_interior S"
 proof (cases "x=y")
   case True
   with xy have "S \<noteq> {x}"
     by blast
   with True show ?thesis
     by (metis Set.set_insert all_not_in_conv ends_in_segment(1) insert_iff segment_to_rel_frontier_aux[OF S x] that y)
 next
   case False
   then show ?thesis
     using segment_to_rel_frontier_aux [OF S x y] that by blast
 qed
 
 proposition rel_frontier_not_sing:
   fixes a :: "'a::euclidean_space"
   assumes "bounded S"
     shows "rel_frontier S \<noteq> {a}"
 proof (cases "S = {}")
   case True  then show ?thesis  by simp
 next
   case False
   then obtain z where "z \<in> S"
     by blast
   then show ?thesis
   proof (cases "S = {z}")
     case True then show ?thesis  by simp
   next
     case False
     then obtain w where "w \<in> S" "w \<noteq> z"
       using \<open>z \<in> S\<close> by blast
     show ?thesis
     proof
       assume "rel_frontier S = {a}"
       then consider "w \<notin> rel_frontier S" | "z \<notin> rel_frontier S"
         using \<open>w \<noteq> z\<close> by auto
       then show False
       proof cases
         case 1
         then have w: "w \<in> rel_interior S"
           using \<open>w \<in> S\<close> closure_subset rel_frontier_def by fastforce
         have "w + (w - z) \<in> affine hull S"
           by (metis \<open>w \<in> S\<close> \<open>z \<in> S\<close> affine_affine_hull hull_inc mem_affine_3_minus scaleR_one)
         then obtain e where "0 < e" "(w + e *\<^sub>R (w - z)) \<in> rel_frontier S"
           using \<open>w \<noteq> z\<close>  \<open>z \<in> S\<close> by (metis assms ray_to_rel_frontier right_minus_eq w)
         moreover obtain d where "0 < d" "(w + d *\<^sub>R (z - w)) \<in> rel_frontier S"
           using ray_to_rel_frontier [OF \<open>bounded S\<close> w, of "1 *\<^sub>R (z - w)"]  \<open>w \<noteq> z\<close>  \<open>z \<in> S\<close>
           by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one)
         ultimately have "d *\<^sub>R (z - w) = e *\<^sub>R (w - z)"
           using \<open>rel_frontier S = {a}\<close> by force
         moreover have "e \<noteq> -d "
           using \<open>0 < e\<close> \<open>0 < d\<close> by force
         ultimately show False
           by (metis (no_types, lifting) \<open>w \<noteq> z\<close> eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus)
       next
         case 2
         then have z: "z \<in> rel_interior S"
           using \<open>z \<in> S\<close> closure_subset rel_frontier_def by fastforce
         have "z + (z - w) \<in> affine hull S"
           by (metis \<open>z \<in> S\<close> \<open>w \<in> S\<close> affine_affine_hull hull_inc mem_affine_3_minus scaleR_one)
         then obtain e where "0 < e" "(z + e *\<^sub>R (z - w)) \<in> rel_frontier S"
           using \<open>w \<noteq> z\<close>  \<open>w \<in> S\<close> by (metis assms ray_to_rel_frontier right_minus_eq z)
         moreover obtain d where "0 < d" "(z + d *\<^sub>R (w - z)) \<in> rel_frontier S"
           using ray_to_rel_frontier [OF \<open>bounded S\<close> z, of "1 *\<^sub>R (w - z)"]  \<open>w \<noteq> z\<close>  \<open>w \<in> S\<close>
           by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one)
         ultimately have "d *\<^sub>R (w - z) = e *\<^sub>R (z - w)"
           using \<open>rel_frontier S = {a}\<close> by force
         moreover have "e \<noteq> -d "
           using \<open>0 < e\<close> \<open>0 < d\<close> by force
         ultimately show False
           by (metis (no_types, lifting) \<open>w \<noteq> z\<close> eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus)
       qed
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity on direct sums\<close>
 
 lemma closure_sum:
   fixes S T :: "'a::real_normed_vector set"
   shows "closure S + closure T \<subseteq> closure (S + T)"
   unfolding set_plus_image closure_Times [symmetric] split_def
   by (intro closure_bounded_linear_image_subset bounded_linear_add
     bounded_linear_fst bounded_linear_snd)
 
 lemma rel_interior_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_interior (S + T) = rel_interior S + rel_interior T"
 proof -
   have "rel_interior S + rel_interior T = (\<lambda>(x,y). x + y) ` (rel_interior S \<times> rel_interior T)"
     by (simp add: set_plus_image)
   also have "\<dots> = (\<lambda>(x,y). x + y) ` rel_interior (S \<times> T)"
     using rel_interior_Times assms by auto
   also have "\<dots> = rel_interior (S + T)"
     using fst_snd_linear convex_Times assms
       rel_interior_convex_linear_image[of "(\<lambda>(x,y). x + y)" "S \<times> T"]
     by (auto simp add: set_plus_image)
   finally show ?thesis ..
 qed
 
 lemma rel_interior_sum_gen:
   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
   assumes "\<forall>i\<in>I. convex (S i)"
   shows "rel_interior (sum S I) = sum (\<lambda>i. rel_interior (S i)) I"
   apply (subst sum_set_cond_linear[of convex])
   using rel_interior_sum rel_interior_sing[of "0"] assms
   apply (auto simp add: convex_set_plus)
   done
 
 lemma convex_rel_open_direct_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
     and "convex T"
     and "rel_open T"
   shows "convex (S \<times> T) \<and> rel_open (S \<times> T)"
   by (metis assms convex_Times rel_interior_Times rel_open_def)
 
 lemma convex_rel_open_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
     and "convex T"
     and "rel_open T"
   shows "convex (S + T) \<and> rel_open (S + T)"
   by (metis assms convex_set_plus rel_interior_sum rel_open_def)
 
 lemma convex_hull_finite_union_cones:
   assumes "finite I"
     and "I \<noteq> {}"
   assumes "\<forall>i\<in>I. convex (S i) \<and> cone (S i) \<and> S i \<noteq> {}"
   shows "convex hull (\<Union>(S ` I)) = sum S I"
   (is "?lhs = ?rhs")
 proof -
   {
     fix x
     assume "x \<in> ?lhs"
     then obtain c xs where
       x: "x = sum (\<lambda>i. c i *\<^sub>R xs i) I \<and> (\<forall>i\<in>I. c i \<ge> 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. xs i \<in> S i)"
       using convex_hull_finite_union[of I S] assms by auto
     define s where "s i = c i *\<^sub>R xs i" for i
     {
       fix i
       assume "i \<in> I"
       then have "s i \<in> S i"
         using s_def x assms mem_cone[of "S i" "xs i" "c i"] by auto
     }
     then have "\<forall>i\<in>I. s i \<in> S i" by auto
     moreover have "x = sum s I" using x s_def by auto
     ultimately have "x \<in> ?rhs"
       using set_sum_alt[of I S] assms by auto
   }
   moreover
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain s where x: "x = sum s I \<and> (\<forall>i\<in>I. s i \<in> S i)"
       using set_sum_alt[of I S] assms by auto
     define xs where "xs i = of_nat(card I) *\<^sub>R s i" for i
     then have "x = sum (\<lambda>i. ((1 :: real) / of_nat(card I)) *\<^sub>R xs i) I"
       using x assms by auto
     moreover have "\<forall>i\<in>I. xs i \<in> S i"
       using x xs_def assms by (simp add: cone_def)
     moreover have "\<forall>i\<in>I. (1 :: real) / of_nat (card I) \<ge> 0"
       by auto
     moreover have "sum (\<lambda>i. (1 :: real) / of_nat (card I)) I = 1"
       using assms by auto
     ultimately have "x \<in> ?lhs"
       apply (subst convex_hull_finite_union[of I S])
       using assms
       apply blast
       using assms
       apply blast
       apply rule
       apply (rule_tac x = "(\<lambda>i. (1 :: real) / of_nat (card I))" in exI)
       apply auto
       done
   }
   ultimately show ?thesis by auto
 qed
 
 lemma convex_hull_union_cones_two:
   fixes S T :: "'m::euclidean_space set"
   assumes "convex S"
     and "cone S"
     and "S \<noteq> {}"
   assumes "convex T"
     and "cone T"
     and "T \<noteq> {}"
   shows "convex hull (S \<union> T) = S + T"
 proof -
   define I :: "nat set" where "I = {1, 2}"
   define A where "A i = (if i = (1::nat) then S else T)" for i
   have "\<Union>(A ` I) = S \<union> T"
     using A_def I_def by auto
   then have "convex hull (\<Union>(A ` I)) = convex hull (S \<union> T)"
     by auto
   moreover have "convex hull \<Union>(A ` I) = sum A I"
     apply (subst convex_hull_finite_union_cones[of I A])
     using assms A_def I_def
     apply auto
     done
   moreover have "sum A I = S + T"
     using A_def I_def
     unfolding set_plus_def
     apply auto
     unfolding set_plus_def
     apply auto
     done
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_convex_hull_union:
   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
   assumes "finite I"
     and "\<forall>i\<in>I. convex (S i) \<and> S i \<noteq> {}"
   shows "rel_interior (convex hull (\<Union>(S ` I))) =
     {sum (\<lambda>i. c i *\<^sub>R s i) I | c s. (\<forall>i\<in>I. c i > 0) \<and> sum c I = 1 \<and>
       (\<forall>i\<in>I. s i \<in> rel_interior(S i))}"
   (is "?lhs = ?rhs")
 proof (cases "I = {}")
   case True
   then show ?thesis
     using convex_hull_empty rel_interior_empty by auto
 next
   case False
   define C0 where "C0 = convex hull (\<Union>(S ` I))"
   have "\<forall>i\<in>I. C0 \<ge> S i"
     unfolding C0_def using hull_subset[of "\<Union>(S ` I)"] by auto
   define K0 where "K0 = cone hull ({1 :: real} \<times> C0)"
   define K where "K i = cone hull ({1 :: real} \<times> S i)" for i
   have "\<forall>i\<in>I. K i \<noteq> {}"
     unfolding K_def using assms
     by (simp add: cone_hull_empty_iff[symmetric])
   {
     fix i
     assume "i \<in> I"
     then have "convex (K i)"
       unfolding K_def
       apply (subst convex_cone_hull)
       apply (subst convex_Times)
       using assms
       apply auto
       done
   }
   then have convK: "\<forall>i\<in>I. convex (K i)"
     by auto
   {
     fix i
     assume "i \<in> I"
     then have "K0 \<supseteq> K i"
       unfolding K0_def K_def
       apply (subst hull_mono)
       using \<open>\<forall>i\<in>I. C0 \<ge> S i\<close>
       apply auto
       done
   }
   then have "K0 \<supseteq> \<Union>(K ` I)" by auto
   moreover have "convex K0"
     unfolding K0_def
     apply (subst convex_cone_hull)
     apply (subst convex_Times)
     unfolding C0_def
     using convex_convex_hull
     apply auto
     done
   ultimately have geq: "K0 \<supseteq> convex hull (\<Union>(K ` I))"
     using hull_minimal[of _ "K0" "convex"] by blast
   have "\<forall>i\<in>I. K i \<supseteq> {1 :: real} \<times> S i"
     using K_def by (simp add: hull_subset)
   then have "\<Union>(K ` I) \<supseteq> {1 :: real} \<times> \<Union>(S ` I)"
     by auto
   then have "convex hull \<Union>(K ` I) \<supseteq> convex hull ({1 :: real} \<times> \<Union>(S ` I))"
     by (simp add: hull_mono)
   then have "convex hull \<Union>(K ` I) \<supseteq> {1 :: real} \<times> C0"
     unfolding C0_def
     using convex_hull_Times[of "{(1 :: real)}" "\<Union>(S ` I)"] convex_hull_singleton
     by auto
   moreover have "cone (convex hull (\<Union>(K ` I)))"
     apply (subst cone_convex_hull)
     using cone_Union[of "K ` I"]
     apply auto
     unfolding K_def
     using cone_cone_hull
     apply auto
     done
   ultimately have "convex hull (\<Union>(K ` I)) \<supseteq> K0"
     unfolding K0_def
     using hull_minimal[of _ "convex hull (\<Union>(K ` I))" "cone"]
     by blast
   then have "K0 = convex hull (\<Union>(K ` I))"
     using geq by auto
   also have "\<dots> = sum K I"
     apply (subst convex_hull_finite_union_cones[of I K])
     using assms
     apply blast
     using False
     apply blast
     unfolding K_def
     apply rule
     apply (subst convex_cone_hull)
     apply (subst convex_Times)
     using assms cone_cone_hull \<open>\<forall>i\<in>I. K i \<noteq> {}\<close> K_def
     apply auto
     done
   finally have "K0 = sum K I" by auto
   then have *: "rel_interior K0 = sum (\<lambda>i. (rel_interior (K i))) I"
     using rel_interior_sum_gen[of I K] convK by auto
   {
     fix x
     assume "x \<in> ?lhs"
     then have "(1::real, x) \<in> rel_interior K0"
       using K0_def C0_def rel_interior_convex_cone_aux[of C0 "1::real" x] convex_convex_hull
       by auto
     then obtain k where k: "(1::real, x) = sum k I \<and> (\<forall>i\<in>I. k i \<in> rel_interior (K i))"
       using \<open>finite I\<close> * set_sum_alt[of I "\<lambda>i. rel_interior (K i)"] by auto
     {
       fix i
       assume "i \<in> I"
       then have "convex (S i) \<and> k i \<in> rel_interior (cone hull {1} \<times> S i)"
         using k K_def assms by auto
       then have "\<exists>ci si. k i = (ci, ci *\<^sub>R si) \<and> 0 < ci \<and> si \<in> rel_interior (S i)"
         using rel_interior_convex_cone[of "S i"] by auto
     }
     then obtain c s where
       cs: "\<forall>i\<in>I. k i = (c i, c i *\<^sub>R s i) \<and> 0 < c i \<and> s i \<in> rel_interior (S i)"
       by metis
     then have "x = (\<Sum>i\<in>I. c i *\<^sub>R s i) \<and> sum c I = 1"
       using k by (simp add: sum_prod)
     then have "x \<in> ?rhs"
       using k cs by auto
   }
   moreover
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain c s where cs: "x = sum (\<lambda>i. c i *\<^sub>R s i) I \<and>
         (\<forall>i\<in>I. c i > 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> rel_interior (S i))"
       by auto
     define k where "k i = (c i, c i *\<^sub>R s i)" for i
     {
       fix i assume "i \<in> I"
       then have "k i \<in> rel_interior (K i)"
         using k_def K_def assms cs rel_interior_convex_cone[of "S i"]
         by auto
     }
     then have "(1::real, x) \<in> rel_interior K0"
       using K0_def * set_sum_alt[of I "(\<lambda>i. rel_interior (K i))"] assms k_def cs
       apply auto
       apply (rule_tac x = k in exI)
       apply (simp add: sum_prod)
       done
     then have "x \<in> ?lhs"
       using K0_def C0_def rel_interior_convex_cone_aux[of C0 1 x]
       by auto
   }
   ultimately show ?thesis by blast
 qed
 
 
 lemma convex_le_Inf_differential:
   fixes f :: "real \<Rightarrow> real"
   assumes "convex_on I f"
     and "x \<in> interior I"
     and "y \<in> I"
   shows "f y \<ge> f x + Inf ((\<lambda>t. (f x - f t) / (x - t)) ` ({x<..} \<inter> I)) * (y - x)"
   (is "_ \<ge> _ + Inf (?F x) * (y - x)")
 proof (cases rule: linorder_cases)
   assume "x < y"
   moreover
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
   moreover define t where "t = min (x + e / 2) ((x + y) / 2)"
   ultimately have "x < t" "t < y" "t \<in> ball x e"
     by (auto simp: dist_real_def field_simps split: split_min)
   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
 
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where "0 < e" "ball x e \<subseteq> interior I" .
   moreover define K where "K = x - e / 2"
   with \<open>0 < e\<close> have "K \<in> ball x e" "K < x"
     by (auto simp: dist_real_def)
   ultimately have "K \<in> I" "K < x" "x \<in> I"
     using interior_subset[of I] \<open>x \<in> interior I\<close> by auto
 
   have "Inf (?F x) \<le> (f x - f y) / (x - y)"
   proof (intro bdd_belowI cInf_lower2)
     show "(f x - f t) / (x - t) \<in> ?F x"
       using \<open>t \<in> I\<close> \<open>x < t\<close> by auto
     show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
       using \<open>convex_on I f\<close> \<open>x \<in> I\<close> \<open>y \<in> I\<close> \<open>x < t\<close> \<open>t < y\<close>
       by (rule convex_on_diff)
   next
     fix y
     assume "y \<in> ?F x"
     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>K \<in> I\<close> _ \<open>K < x\<close> _]]
     show "(f K - f x) / (K - x) \<le> y" by auto
   qed
   then show ?thesis
     using \<open>x < y\<close> by (simp add: field_simps)
 next
   assume "y < x"
   moreover
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
   moreover define t where "t = x + e / 2"
   ultimately have "x < t" "t \<in> ball x e"
     by (auto simp: dist_real_def field_simps)
   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
 
   have "(f x - f y) / (x - y) \<le> Inf (?F x)"
   proof (rule cInf_greatest)
     have "(f x - f y) / (x - y) = (f y - f x) / (y - x)"
       using \<open>y < x\<close> by (auto simp: field_simps)
     also
     fix z
     assume "z \<in> ?F x"
     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>y \<in> I\<close> _ \<open>y < x\<close>]]
     have "(f y - f x) / (y - x) \<le> z"
       by auto
     finally show "(f x - f y) / (x - y) \<le> z" .
   next
     have "open (interior I)" by auto
     from openE[OF this \<open>x \<in> interior I\<close>]
     obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
     then have "x + e / 2 \<in> ball x e"
       by (auto simp: dist_real_def)
     with e interior_subset[of I] have "x + e / 2 \<in> {x<..} \<inter> I"
       by auto
     then show "?F x \<noteq> {}"
       by blast
   qed
   then show ?thesis
     using \<open>y < x\<close> by (simp add: field_simps)
 qed simp
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Explicit formulas for interior and relative interior of convex hull\<close>
 
 lemma at_within_cbox_finite:
   assumes "x \<in> box a b" "x \<notin> S" "finite S"
   shows "(at x within cbox a b - S) = at x"
 proof -
   have "interior (cbox a b - S) = box a b - S"
     using \<open>finite S\<close> by (simp add: interior_diff finite_imp_closed)
   then show ?thesis
     using at_within_interior assms by fastforce
 qed
 
 lemma affine_independent_convex_affine_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s" "t \<subseteq> s"
     shows "convex hull t = affine hull t \<inter> convex hull s"
 proof -
   have fin: "finite s" "finite t" using assms aff_independent_finite finite_subset by auto
     { fix u v x
       assume uv: "sum u t = 1" "\<forall>x\<in>s. 0 \<le> v x" "sum v s = 1"
                  "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>v\<in>t. u v *\<^sub>R v)" "x \<in> t"
       then have s: "s = (s - t) \<union> t" \<comment> \<open>split into separate cases\<close>
         using assms by auto
       have [simp]: "(\<Sum>x\<in>t. v x *\<^sub>R x) + (\<Sum>x\<in>s - t. v x *\<^sub>R x) = (\<Sum>x\<in>t. u x *\<^sub>R x)"
                    "sum v t + sum v (s - t) = 1"
         using uv fin s
         by (auto simp: sum.union_disjoint [symmetric] Un_commute)
       have "(\<Sum>x\<in>s. if x \<in> t then v x - u x else v x) = 0"
            "(\<Sum>x\<in>s. (if x \<in> t then v x - u x else v x) *\<^sub>R x) = 0"
         using uv fin
         by (subst s, subst sum.union_disjoint, auto simp: algebra_simps sum_subtractf)+
     } note [simp] = this
   have "convex hull t \<subseteq> affine hull t"
     using convex_hull_subset_affine_hull by blast
   moreover have "convex hull t \<subseteq> convex hull s"
     using assms hull_mono by blast
   moreover have "affine hull t \<inter> convex hull s \<subseteq> convex hull t"
     using assms
     apply (simp add: convex_hull_finite affine_hull_finite fin affine_dependent_explicit)
     apply (drule_tac x=s in spec)
     apply (auto simp: fin)
     apply (rule_tac x=u in exI)
     apply (rename_tac v)
     apply (drule_tac x="\<lambda>x. if x \<in> t then v x - u x else v x" in spec)
     apply (force)+
     done
   ultimately show ?thesis
     by blast
 qed
 
 lemma affine_independent_span_eq:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s" "card s = Suc (DIM ('a))"
     shows "affine hull s = UNIV"
 proof (cases "s = {}")
   case True then show ?thesis
     using assms by simp
 next
   case False
     then obtain a t where t: "a \<notin> t" "s = insert a t"
       by blast
     then have fin: "finite t" using assms
       by (metis finite_insert aff_independent_finite)
     show ?thesis
     using assms t fin
       apply (simp add: affine_dependent_iff_dependent affine_hull_insert_span_gen)
       apply (rule subset_antisym)
       apply force
       apply (rule Fun.vimage_subsetD)
       apply (metis add.commute diff_add_cancel surj_def)
       apply (rule card_ge_dim_independent)
       apply (auto simp: card_image inj_on_def dim_subset_UNIV)
       done
 qed
 
 lemma affine_independent_span_gt:
   fixes s :: "'a::euclidean_space set"
   assumes ind: "\<not> affine_dependent s" and dim: "DIM ('a) < card s"
     shows "affine hull s = UNIV"
   apply (rule affine_independent_span_eq [OF ind])
   apply (rule antisym)
   using assms
   apply auto
   apply (metis add_2_eq_Suc' not_less_eq_eq affine_dependent_biggerset aff_independent_finite)
   done
 
 lemma empty_interior_affine_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" and dim: "card s \<le> DIM ('a)"
     shows "interior(affine hull s) = {}"
   using assms
   apply (induct s rule: finite_induct)
   apply (simp_all add:  affine_dependent_iff_dependent affine_hull_insert_span_gen interior_translation)
   apply (rule empty_interior_lowdim)
   by (auto simp: Suc_le_lessD card_image_le dual_order.trans intro!: dim_le_card'[THEN le_less_trans])
 
 lemma empty_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" and dim: "card s \<le> DIM ('a)"
     shows "interior(convex hull s) = {}"
   by (metis Diff_empty Diff_eq_empty_iff convex_hull_subset_affine_hull
             interior_mono empty_interior_affine_hull [OF assms])
 
 lemma explicit_subset_rel_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   shows "finite s
          \<Longrightarrow> {y. \<exists>u. (\<forall>x \<in> s. 0 < u x \<and> u x < 1) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}
              \<subseteq> rel_interior (convex hull s)"
   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
 
 lemma explicit_subset_rel_interior_convex_hull_minimal:
   fixes s :: "'a::euclidean_space set"
   shows "finite s
          \<Longrightarrow> {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}
              \<subseteq> rel_interior (convex hull s)"
   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
 
 lemma rel_interior_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_interior(convex hull s) =
          {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
          (is "?lhs = ?rhs")
 proof
   show "?rhs \<le> ?lhs"
     by (simp add: aff_independent_finite explicit_subset_rel_interior_convex_hull_minimal assms)
 next
   show "?lhs \<le> ?rhs"
   proof (cases "\<exists>a. s = {a}")
     case True then show "?lhs \<le> ?rhs"
       by force
   next
     case False
     have fs: "finite s"
       using assms by (simp add: aff_independent_finite)
     { fix a b and d::real
       assume ab: "a \<in> s" "b \<in> s" "a \<noteq> b"
       then have s: "s = (s - {a,b}) \<union> {a,b}" \<comment> \<open>split into separate cases\<close>
         by auto
       have "(\<Sum>x\<in>s. if x = a then - d else if x = b then d else 0) = 0"
            "(\<Sum>x\<in>s. (if x = a then - d else if x = b then d else 0) *\<^sub>R x) = d *\<^sub>R b - d *\<^sub>R a"
         using ab fs
         by (subst s, subst sum.union_disjoint, auto)+
     } note [simp] = this
     { fix y
       assume y: "y \<in> convex hull s" "y \<notin> ?rhs"
       { fix u T a
         assume ua: "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "\<not> 0 < u a" "a \<in> s"
            and yT: "y = (\<Sum>x\<in>s. u x *\<^sub>R x)" "y \<in> T" "open T"
            and sb: "T \<inter> affine hull s \<subseteq> {w. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = w}"
         have ua0: "u a = 0"
           using ua by auto
         obtain b where b: "b\<in>s" "a \<noteq> b"
           using ua False by auto
         obtain e where e: "0 < e" "ball (\<Sum>x\<in>s. u x *\<^sub>R x) e \<subseteq> T"
           using yT by (auto elim: openE)
         with b obtain d where d: "0 < d" "norm(d *\<^sub>R (a-b)) < e"
           by (auto intro: that [of "e / 2 / norm(a-b)"])
         have "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> affine hull s"
           using yT y by (metis affine_hull_convex_hull hull_redundant_eq)
         then have "(\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b) \<in> affine hull s"
           using ua b by (auto simp: hull_inc intro: mem_affine_3_minus2)
         then have "y - d *\<^sub>R (a - b) \<in> T \<inter> affine hull s"
           using d e yT by auto
         then obtain v where "\<forall>x\<in>s. 0 \<le> v x"
                             "sum v s = 1"
                             "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b)"
           using subsetD [OF sb] yT
           by auto
         then have False
           using assms
           apply (simp add: affine_dependent_explicit_finite fs)
           apply (drule_tac x="\<lambda>x. (v x - u x) - (if x = a then -d else if x = b then d else 0)" in spec)
           using ua b d
           apply (auto simp: algebra_simps sum_subtractf sum.distrib)
           done
       } note * = this
       have "y \<notin> rel_interior (convex hull s)"
         using y
         apply (simp add: mem_rel_interior affine_hull_convex_hull)
         apply (auto simp: convex_hull_finite [OF fs])
         apply (drule_tac x=u in spec)
         apply (auto intro: *)
         done
     } with rel_interior_subset show "?lhs \<le> ?rhs"
       by blast
   qed
 qed
 
 lemma interior_convex_hull_explicit_minimal:
   fixes s :: "'a::euclidean_space set"
   shows
    "\<not> affine_dependent s
         ==> interior(convex hull s) =
              (if card(s) \<le> DIM('a) then {}
               else {y. \<exists>u. (\<forall>x \<in> s. 0 < u x) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = y})"
   apply (simp add: aff_independent_finite empty_interior_convex_hull, clarify)
   apply (rule trans [of _ "rel_interior(convex hull s)"])
   apply (simp add: affine_independent_span_gt rel_interior_interior)
   by (simp add: rel_interior_convex_hull_explicit)
 
 lemma interior_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows
    "interior(convex hull s) =
              (if card(s) \<le> DIM('a) then {}
               else {y. \<exists>u. (\<forall>x \<in> s. 0 < u x \<and> u x < 1) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = y})"
 proof -
   { fix u :: "'a \<Rightarrow> real" and a
     assume "card Basis < card s" and u: "\<And>x. x\<in>s \<Longrightarrow> 0 < u x" "sum u s = 1" and a: "a \<in> s"
     then have cs: "Suc 0 < card s"
       by (metis DIM_positive less_trans_Suc)
     obtain b where b: "b \<in> s" "a \<noteq> b"
     proof (cases "s \<le> {a}")
       case True
       then show thesis
         using cs subset_singletonD by fastforce
     next
       case False
       then show thesis
       by (blast intro: that)
     qed
     have "u a + u b \<le> sum u {a,b}"
       using a b by simp
     also have "... \<le> sum u s"
       apply (rule Groups_Big.sum_mono2)
       using a b u
       apply (auto simp: less_imp_le aff_independent_finite assms)
       done
     finally have "u a < 1"
       using \<open>b \<in> s\<close> u by fastforce
   } note [simp] = this
   show ?thesis
     using assms
     apply (auto simp: interior_convex_hull_explicit_minimal)
     apply (rule_tac x=u in exI)
     apply (auto simp: not_le)
     done
 qed
 
 lemma interior_closed_segment_ge2:
   fixes a :: "'a::euclidean_space"
   assumes "2 \<le> DIM('a)"
     shows  "interior(closed_segment a b) = {}"
 using assms unfolding segment_convex_hull
 proof -
   have "card {a, b} \<le> DIM('a)"
     using assms
     by (simp add: card_insert_if linear not_less_eq_eq numeral_2_eq_2)
   then show "interior (convex hull {a, b}) = {}"
     by (metis empty_interior_convex_hull finite.insertI finite.emptyI)
 qed
 
 lemma interior_open_segment:
   fixes a :: "'a::euclidean_space"
   shows  "interior(open_segment a b) =
                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
 proof (simp add: not_le, intro conjI impI)
   assume "2 \<le> DIM('a)"
   then show "interior (open_segment a b) = {}"
     apply (simp add: segment_convex_hull open_segment_def)
     apply (metis Diff_subset interior_mono segment_convex_hull subset_empty interior_closed_segment_ge2)
     done
 next
   assume le2: "DIM('a) < 2"
   show "interior (open_segment a b) = open_segment a b"
   proof (cases "a = b")
     case True then show ?thesis by auto
   next
     case False
     with le2 have "affine hull (open_segment a b) = UNIV"
       apply simp
       apply (rule affine_independent_span_gt)
       apply (simp_all add: affine_dependent_def insert_Diff_if)
       done
     then show "interior (open_segment a b) = open_segment a b"
       using rel_interior_interior rel_interior_open_segment by blast
   qed
 qed
 
 lemma interior_closed_segment:
   fixes a :: "'a::euclidean_space"
   shows "interior(closed_segment a b) =
                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
 proof (cases "a = b")
   case True then show ?thesis by simp
 next
   case False
   then have "closure (open_segment a b) = closed_segment a b"
     by simp
   then show ?thesis
     by (metis (no_types) convex_interior_closure convex_open_segment interior_open_segment)
 qed
 
 lemmas interior_segment = interior_closed_segment interior_open_segment
 
 lemma closed_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "closed_segment a b = closed_segment c d \<longleftrightarrow> {a,b} = {c,d}"
 proof
   assume abcd: "closed_segment a b = closed_segment c d"
   show "{a,b} = {c,d}"
   proof (cases "a=b \<or> c=d")
     case True with abcd show ?thesis by force
   next
     case False
     then have neq: "a \<noteq> b \<and> c \<noteq> d" by force
     have *: "closed_segment c d - {a, b} = rel_interior (closed_segment c d)"
       using neq abcd by (metis (no_types) open_segment_def rel_interior_closed_segment)
     have "b \<in> {c, d}"
     proof -
       have "insert b (closed_segment c d) = closed_segment c d"
         using abcd by blast
       then show ?thesis
         by (metis DiffD2 Diff_insert2 False * insertI1 insert_Diff_if open_segment_def rel_interior_closed_segment)
     qed
     moreover have "a \<in> {c, d}"
       by (metis Diff_iff False * abcd ends_in_segment(1) insertI1 open_segment_def rel_interior_closed_segment)
     ultimately show "{a, b} = {c, d}"
       using neq by fastforce
   qed
 next
   assume "{a,b} = {c,d}"
   then show "closed_segment a b = closed_segment c d"
     by (simp add: segment_convex_hull)
 qed
 
 lemma closed_open_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "closed_segment a b \<noteq> open_segment c d"
 by (metis DiffE closed_segment_neq_empty closure_closed_segment closure_open_segment ends_in_segment(1) insertI1 open_segment_def)
 
 lemma open_closed_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<noteq> closed_segment c d"
 using closed_open_segment_eq by blast
 
 lemma open_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b = open_segment c d \<longleftrightarrow> a = b \<and> c = d \<or> {a,b} = {c,d}"
         (is "?lhs = ?rhs")
 proof
   assume abcd: ?lhs
   show ?rhs
   proof (cases "a=b \<or> c=d")
     case True with abcd show ?thesis
       using finite_open_segment by fastforce
   next
     case False
     then have a2: "a \<noteq> b \<and> c \<noteq> d" by force
     with abcd show ?rhs
       unfolding open_segment_def
       by (metis (no_types) abcd closed_segment_eq closure_open_segment)
   qed
 next
   assume ?rhs
   then show ?lhs
     by (metis Diff_cancel convex_hull_singleton insert_absorb2 open_segment_def segment_convex_hull)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Similar results for closure and (relative or absolute) frontier\<close>
 
 lemma closure_convex_hull [simp]:
   fixes s :: "'a::euclidean_space set"
   shows "compact s ==> closure(convex hull s) = convex hull s"
   by (simp add: compact_imp_closed compact_convex_hull)
 
 lemma rel_frontier_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_frontier(convex hull s) =
          {y. \<exists>u. (\<forall>x \<in> s. 0 \<le> u x) \<and> (\<exists>x \<in> s. u x = 0) \<and> sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   show ?thesis
     apply (simp add: rel_frontier_def finite_imp_compact rel_interior_convex_hull_explicit assms fs)
     apply (auto simp: convex_hull_finite fs)
     apply (drule_tac x=u in spec)
     apply (rule_tac x=u in exI)
     apply force
     apply (rename_tac v)
     apply (rule notE [OF assms])
     apply (simp add: affine_dependent_explicit)
     apply (rule_tac x=s in exI)
     apply (auto simp: fs)
     apply (rule_tac x = "\<lambda>x. u x - v x" in exI)
     apply (force simp: sum_subtractf scaleR_diff_left)
     done
 qed
 
 lemma frontier_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
          {y. \<exists>u. (\<forall>x \<in> s. 0 \<le> u x) \<and> (DIM ('a) < card s \<longrightarrow> (\<exists>x \<in> s. u x = 0)) \<and>
              sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   show ?thesis
   proof (cases "DIM ('a) < card s")
     case True
     with assms fs show ?thesis
       by (simp add: rel_frontier_def frontier_def rel_frontier_convex_hull_explicit [symmetric]
                     interior_convex_hull_explicit_minimal rel_interior_convex_hull_explicit)
   next
     case False
     then have "card s \<le> DIM ('a)"
       by linarith
     then show ?thesis
       using assms fs
       apply (simp add: frontier_def interior_convex_hull_explicit finite_imp_compact)
       apply (simp add: convex_hull_finite)
       done
   qed
 qed
 
 lemma rel_frontier_convex_hull_cases:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_frontier(convex hull s) = \<Union>{convex hull (s - {x}) |x. x \<in> s}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   { fix u a
   have "\<forall>x\<in>s. 0 \<le> u x \<Longrightarrow> a \<in> s \<Longrightarrow> u a = 0 \<Longrightarrow> sum u s = 1 \<Longrightarrow>
             \<exists>x v. x \<in> s \<and>
                   (\<forall>x\<in>s - {x}. 0 \<le> v x) \<and>
                       sum v (s - {x}) = 1 \<and> (\<Sum>x\<in>s - {x}. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)"
     apply (rule_tac x=a in exI)
     apply (rule_tac x=u in exI)
     apply (simp add: Groups_Big.sum_diff1 fs)
     done }
   moreover
   { fix a u
     have "a \<in> s \<Longrightarrow> \<forall>x\<in>s - {a}. 0 \<le> u x \<Longrightarrow> sum u (s - {a}) = 1 \<Longrightarrow>
             \<exists>v. (\<forall>x\<in>s. 0 \<le> v x) \<and>
                  (\<exists>x\<in>s. v x = 0) \<and> sum v s = 1 \<and> (\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>x\<in>s - {a}. u x *\<^sub>R x)"
     apply (rule_tac x="\<lambda>x. if x = a then 0 else u x" in exI)
     apply (auto simp: sum.If_cases Diff_eq if_smult fs)
     done }
   ultimately show ?thesis
     using assms
     apply (simp add: rel_frontier_convex_hull_explicit)
     apply (simp add: convex_hull_finite fs Union_SetCompr_eq, auto)
     done
 qed
 
 lemma frontier_convex_hull_eq_rel_frontier:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
            (if card s \<le> DIM ('a) then convex hull s else rel_frontier(convex hull s))"
   using assms
   unfolding rel_frontier_def frontier_def
   by (simp add: affine_independent_span_gt rel_interior_interior
                 finite_imp_compact empty_interior_convex_hull aff_independent_finite)
 
 lemma frontier_convex_hull_cases:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
            (if card s \<le> DIM ('a) then convex hull s else \<Union>{convex hull (s - {x}) |x. x \<in> s})"
 by (simp add: assms frontier_convex_hull_eq_rel_frontier rel_frontier_convex_hull_cases)
 
 lemma in_frontier_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
   shows   "x \<in> frontier(convex hull s)"
 proof (cases "affine_dependent s")
   case True
   with assms show ?thesis
     apply (auto simp: affine_dependent_def frontier_def finite_imp_compact hull_inc)
     by (metis card.insert_remove convex_hull_subset_affine_hull empty_interior_affine_hull finite_Diff hull_redundant insert_Diff insert_Diff_single insert_not_empty interior_mono not_less_eq_eq subset_empty)
 next
   case False
   { assume "card s = Suc (card Basis)"
     then have cs: "Suc 0 < card s"
-      by (simp add: DIM_positive)
+      by (simp)
     with subset_singletonD have "\<exists>y \<in> s. y \<noteq> x"
       by (cases "s \<le> {x}") fastforce+
   } note [dest!] = this
   show ?thesis using assms
     unfolding frontier_convex_hull_cases [OF False] Union_SetCompr_eq
     by (auto simp: le_Suc_eq hull_inc)
 qed
 
 lemma not_in_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
   shows   "x \<notin> interior(convex hull s)"
 using in_frontier_convex_hull [OF assms]
 by (metis Diff_iff frontier_def)
 
 lemma interior_convex_hull_eq_empty:
   fixes s :: "'a::euclidean_space set"
   assumes "card s = Suc (DIM ('a))"
   shows   "interior(convex hull s) = {} \<longleftrightarrow> affine_dependent s"
 proof -
   { fix a b
     assume ab: "a \<in> interior (convex hull s)" "b \<in> s" "b \<in> affine hull (s - {b})"
     then have "interior(affine hull s) = {}" using assms
       by (metis DIM_positive One_nat_def Suc_mono card.remove card_infinite empty_interior_affine_hull eq_iff hull_redundant insert_Diff not_less zero_le_one)
     then have False using ab
       by (metis convex_hull_subset_affine_hull equals0D interior_mono subset_eq)
   } then
   show ?thesis
     using assms
     apply auto
     apply (metis UNIV_I affine_hull_convex_hull affine_hull_empty affine_independent_span_eq convex_convex_hull empty_iff rel_interior_interior rel_interior_same_affine_hull)
     apply (auto simp: affine_dependent_def)
     done
 qed
 
 
 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
 
 definition\<^marker>\<open>tag important\<close> coplanar  where
    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
 
 lemma collinear_affine_hull:
   "collinear s \<longleftrightarrow> (\<exists>u v. s \<subseteq> affine hull {u,v})"
 proof (cases "s={}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain x where x: "x \<in> s" by auto
   { fix u
     assume *: "\<And>x y. \<lbrakk>x\<in>s; y\<in>s\<rbrakk> \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R u"
     have "\<exists>u v. s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
       apply (rule_tac x=x in exI)
       apply (rule_tac x="x+u" in exI, clarify)
       apply (erule exE [OF * [OF x]])
       apply (rename_tac c)
       apply (rule_tac x="1+c" in exI)
       apply (rule_tac x="-c" in exI)
       apply (simp add: algebra_simps)
       done
   } moreover
   { fix u v x y
     assume *: "s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
     have "x\<in>s \<Longrightarrow> y\<in>s \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R (v-u)"
       apply (drule subsetD [OF *])+
       apply simp
       apply clarify
       apply (rename_tac r1 r2)
       apply (rule_tac x="r1-r2" in exI)
       apply (simp add: algebra_simps)
       apply (metis scaleR_left.add)
       done
   } ultimately
   show ?thesis
   unfolding collinear_def affine_hull_2
     by blast
 qed
 
 lemma collinear_closed_segment [simp]: "collinear (closed_segment a b)"
 by (metis affine_hull_convex_hull collinear_affine_hull hull_subset segment_convex_hull)
 
 lemma collinear_open_segment [simp]: "collinear (open_segment a b)"
   unfolding open_segment_def
   by (metis convex_hull_subset_affine_hull segment_convex_hull dual_order.trans
     convex_hull_subset_affine_hull Diff_subset collinear_affine_hull)
 
 lemma collinear_between_cases:
   fixes c :: "'a::euclidean_space"
   shows "collinear {a,b,c} \<longleftrightarrow> between (b,c) a \<or> between (c,a) b \<or> between (a,b) c"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain u v where uv: "\<And>x. x \<in> {a, b, c} \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
     by (auto simp: collinear_alt)
   show ?rhs
     using uv [of a] uv [of b] uv [of c] by (auto simp: between_1)
 next
   assume ?rhs
   then show ?lhs
     unfolding between_mem_convex_hull
     by (metis (no_types, hide_lams) collinear_closed_segment collinear_subset hull_redundant hull_subset insert_commute segment_convex_hull)
 qed
 
 
 lemma subset_continuous_image_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "continuous_on (closed_segment a b) f"
   shows "closed_segment (f a) (f b) \<subseteq> image f (closed_segment a b)"
 by (metis connected_segment convex_contains_segment ends_in_segment imageI
            is_interval_connected_1 is_interval_convex connected_continuous_image [OF assms])
 
 lemma continuous_injective_image_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and injf: "inj_on f (closed_segment a b)"
   shows "f ` (closed_segment a b) = closed_segment (f a) (f b)"
 proof
   show "closed_segment (f a) (f b) \<subseteq> f ` closed_segment a b"
     by (metis subset_continuous_image_segment_1 contf)
   show "f ` closed_segment a b \<subseteq> closed_segment (f a) (f b)"
   proof (cases "a = b")
     case True
     then show ?thesis by auto
   next
     case False
     then have fnot: "f a \<noteq> f b"
       using inj_onD injf by fastforce
     moreover
     have "f a \<notin> open_segment (f c) (f b)" if c: "c \<in> closed_segment a b" for c
     proof (clarsimp simp add: open_segment_def)
       assume fa: "f a \<in> closed_segment (f c) (f b)"
       moreover have "closed_segment (f c) (f b) \<subseteq> f ` closed_segment c b"
         by (meson closed_segment_subset contf continuous_on_subset convex_closed_segment ends_in_segment(2) subset_continuous_image_segment_1 that)
       ultimately have "f a \<in> f ` closed_segment c b"
         by blast
       then have a: "a \<in> closed_segment c b"
         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
       have cb: "closed_segment c b \<subseteq> closed_segment a b"
         by (simp add: closed_segment_subset that)
       show "f a = f c"
       proof (rule between_antisym)
         show "between (f c, f b) (f a)"
           by (simp add: between_mem_segment fa)
         show "between (f a, f b) (f c)"
           by (metis a cb between_antisym between_mem_segment between_triv1 subset_iff)
       qed
     qed
     moreover
     have "f b \<notin> open_segment (f a) (f c)" if c: "c \<in> closed_segment a b" for c
     proof (clarsimp simp add: open_segment_def fnot eq_commute)
       assume fb: "f b \<in> closed_segment (f a) (f c)"
       moreover have "closed_segment (f a) (f c) \<subseteq> f ` closed_segment a c"
         by (meson contf continuous_on_subset ends_in_segment(1) subset_closed_segment subset_continuous_image_segment_1 that)
       ultimately have "f b \<in> f ` closed_segment a c"
         by blast
       then have b: "b \<in> closed_segment a c"
         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
       have ca: "closed_segment a c \<subseteq> closed_segment a b"
         by (simp add: closed_segment_subset that)
       show "f b = f c"
       proof (rule between_antisym)
         show "between (f c, f a) (f b)"
           by (simp add: between_commute between_mem_segment fb)
         show "between (f b, f a) (f c)"
           by (metis b between_antisym between_commute between_mem_segment between_triv2 that)
       qed
     qed
     ultimately show ?thesis
       by (force simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl split: if_split_asm)
   qed
 qed
 
 lemma continuous_injective_image_open_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and injf: "inj_on f (closed_segment a b)"
     shows "f ` (open_segment a b) = open_segment (f a) (f b)"
 proof -
   have "f ` (open_segment a b) = f ` (closed_segment a b) - {f a, f b}"
     by (metis (no_types, hide_lams) empty_subsetI ends_in_segment image_insert image_is_empty inj_on_image_set_diff injf insert_subset open_segment_def segment_open_subset_closed)
   also have "... = open_segment (f a) (f b)"
     using continuous_injective_image_segment_1 [OF assms]
     by (simp add: open_segment_def inj_on_image_set_diff [OF injf])
   finally show ?thesis .
 qed
 
 lemma collinear_imp_coplanar:
   "collinear s ==> coplanar s"
 by (metis collinear_affine_hull coplanar_def insert_absorb2)
 
 lemma collinear_small:
   assumes "finite s" "card s \<le> 2"
     shows "collinear s"
 proof -
   have "card s = 0 \<or> card s = 1 \<or> card s = 2"
     using assms by linarith
   then show ?thesis using assms
     using card_eq_SucD
     by auto (metis collinear_2 numeral_2_eq_2)
 qed
 
 lemma coplanar_small:
   assumes "finite s" "card s \<le> 3"
     shows "coplanar s"
 proof -
   have "card s \<le> 2 \<or> card s = Suc (Suc (Suc 0))"
     using assms by linarith
   then show ?thesis using assms
     apply safe
     apply (simp add: collinear_small collinear_imp_coplanar)
     apply (safe dest!: card_eq_SucD)
     apply (auto simp: coplanar_def)
     apply (metis hull_subset insert_subset)
     done
 qed
 
 lemma coplanar_empty: "coplanar {}"
   by (simp add: coplanar_small)
 
 lemma coplanar_sing: "coplanar {a}"
   by (simp add: coplanar_small)
 
 lemma coplanar_2: "coplanar {a,b}"
   by (auto simp: card_insert_if coplanar_small)
 
 lemma coplanar_3: "coplanar {a,b,c}"
   by (auto simp: card_insert_if coplanar_small)
 
 lemma collinear_affine_hull_collinear: "collinear(affine hull s) \<longleftrightarrow> collinear s"
   unfolding collinear_affine_hull
   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
 
 lemma coplanar_affine_hull_coplanar: "coplanar(affine hull s) \<longleftrightarrow> coplanar s"
   unfolding coplanar_def
   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
 
 lemma coplanar_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "coplanar s" "linear f" shows "coplanar(f ` s)"
 proof -
   { fix u v w
     assume "s \<subseteq> affine hull {u, v, w}"
     then have "f ` s \<subseteq> f ` (affine hull {u, v, w})"
       by (simp add: image_mono)
     then have "f ` s \<subseteq> affine hull (f ` {u, v, w})"
       by (metis assms(2) linear_conv_bounded_linear affine_hull_linear_image)
   } then
   show ?thesis
     by auto (meson assms(1) coplanar_def)
 qed
 
 lemma coplanar_translation_imp: "coplanar s \<Longrightarrow> coplanar ((\<lambda>x. a + x) ` s)"
   unfolding coplanar_def
   apply clarify
   apply (rule_tac x="u+a" in exI)
   apply (rule_tac x="v+a" in exI)
   apply (rule_tac x="w+a" in exI)
   using affine_hull_translation [of a "{u,v,w}" for u v w]
   apply (force simp: add.commute)
   done
 
 lemma coplanar_translation_eq: "coplanar((\<lambda>x. a + x) ` s) \<longleftrightarrow> coplanar s"
     by (metis (no_types) coplanar_translation_imp translation_galois)
 
 lemma coplanar_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f" shows "coplanar(f ` s) = coplanar s"
 proof
   assume "coplanar s"
   then show "coplanar (f ` s)"
     unfolding coplanar_def
     using affine_hull_linear_image [of f "{u,v,w}" for u v w]  assms
     by (meson coplanar_def coplanar_linear_image)
 next
   obtain g where g: "linear g" "g \<circ> f = id"
     using linear_injective_left_inverse [OF assms]
     by blast
   assume "coplanar (f ` s)"
   then obtain u v w where "f ` s \<subseteq> affine hull {u, v, w}"
     by (auto simp: coplanar_def)
   then have "g ` f ` s \<subseteq> g ` (affine hull {u, v, w})"
     by blast
   then have "s \<subseteq> g ` (affine hull {u, v, w})"
     using g by (simp add: Fun.image_comp)
   then show "coplanar s"
     unfolding coplanar_def
     using affine_hull_linear_image [of g "{u,v,w}" for u v w]  \<open>linear g\<close> linear_conv_bounded_linear
     by fastforce
 qed
 (*The HOL Light proof is simply
     MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COPLANAR_LINEAR_IMAGE));;
 *)
 
 lemma coplanar_subset: "\<lbrakk>coplanar t; s \<subseteq> t\<rbrakk> \<Longrightarrow> coplanar s"
   by (meson coplanar_def order_trans)
 
 lemma affine_hull_3_imp_collinear: "c \<in> affine hull {a,b} \<Longrightarrow> collinear {a,b,c}"
   by (metis collinear_2 collinear_affine_hull_collinear hull_redundant insert_commute)
 
 lemma collinear_3_imp_in_affine_hull: "\<lbrakk>collinear {a,b,c}; a \<noteq> b\<rbrakk> \<Longrightarrow> c \<in> affine hull {a,b}"
   unfolding collinear_def
   apply clarify
   apply (frule_tac x=b in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
   apply (drule_tac x=c in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
   apply (rename_tac y x)
   apply (simp add: affine_hull_2)
   apply (rule_tac x="1 - x/y" in exI)
   apply (simp add: algebra_simps)
   done
 
 lemma collinear_3_affine_hull:
   assumes "a \<noteq> b"
     shows "collinear {a,b,c} \<longleftrightarrow> c \<in> affine hull {a,b}"
 using affine_hull_3_imp_collinear assms collinear_3_imp_in_affine_hull by blast
 
 lemma collinear_3_eq_affine_dependent:
   "collinear{a,b,c} \<longleftrightarrow> a = b \<or> a = c \<or> b = c \<or> affine_dependent {a,b,c}"
 apply (case_tac "a=b", simp)
 apply (case_tac "a=c")
 apply (simp add: insert_commute)
 apply (case_tac "b=c")
 apply (simp add: insert_commute)
 apply (auto simp: affine_dependent_def collinear_3_affine_hull insert_Diff_if)
 apply (metis collinear_3_affine_hull insert_commute)+
 done
 
 lemma affine_dependent_imp_collinear_3:
   "affine_dependent {a,b,c} \<Longrightarrow> collinear{a,b,c}"
 by (simp add: collinear_3_eq_affine_dependent)
 
 lemma collinear_3: "NO_MATCH 0 x \<Longrightarrow> collinear {x,y,z} \<longleftrightarrow> collinear {0, x-y, z-y}"
   by (auto simp add: collinear_def)
 
 lemma collinear_3_expand:
    "collinear{a,b,c} \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
 proof -
   have "collinear{a,b,c} = collinear{a,c,b}"
     by (simp add: insert_commute)
   also have "... = collinear {0, a - c, b - c}"
     by (simp add: collinear_3)
   also have "... \<longleftrightarrow> (a = c \<or> b = c \<or> (\<exists>ca. b - c = ca *\<^sub>R (a - c)))"
     by (simp add: collinear_lemma)
   also have "... \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
     by (cases "a = c \<or> b = c") (auto simp: algebra_simps)
   finally show ?thesis .
 qed
 
 lemma collinear_aff_dim: "collinear S \<longleftrightarrow> aff_dim S \<le> 1"
 proof
   assume "collinear S"
   then obtain u and v :: "'a" where "aff_dim S \<le> aff_dim {u,v}"
     by (metis \<open>collinear S\<close> aff_dim_affine_hull aff_dim_subset collinear_affine_hull)
   then show "aff_dim S \<le> 1"
     using order_trans by fastforce
 next
   assume "aff_dim S \<le> 1"
   then have le1: "aff_dim (affine hull S) \<le> 1"
     by simp
   obtain B where "B \<subseteq> S" and B: "\<not> affine_dependent B" "affine hull S = affine hull B"
     using affine_basis_exists [of S] by auto
   then have "finite B" "card B \<le> 2"
     using B le1 by (auto simp: affine_independent_iff_card)
   then have "collinear B"
     by (rule collinear_small)
   then show "collinear S"
     by (metis \<open>affine hull S = affine hull B\<close> collinear_affine_hull_collinear)
 qed
 
 lemma collinear_midpoint: "collinear{a,midpoint a b,b}"
   apply (auto simp: collinear_3 collinear_lemma)
   apply (drule_tac x="-1" in spec)
   apply (simp add: algebra_simps)
   done
 
 lemma midpoint_collinear:
   fixes a b c :: "'a::real_normed_vector"
   assumes "a \<noteq> c"
     shows "b = midpoint a c \<longleftrightarrow> collinear{a,b,c} \<and> dist a b = dist b c"
 proof -
   have *: "a - (u *\<^sub>R a + (1 - u) *\<^sub>R c) = (1 - u) *\<^sub>R (a - c)"
           "u *\<^sub>R a + (1 - u) *\<^sub>R c - c = u *\<^sub>R (a - c)"
           "\<bar>1 - u\<bar> = \<bar>u\<bar> \<longleftrightarrow> u = 1/2" for u::real
     by (auto simp: algebra_simps)
   have "b = midpoint a c \<Longrightarrow> collinear{a,b,c} "
     using collinear_midpoint by blast
   moreover have "collinear{a,b,c} \<Longrightarrow> b = midpoint a c \<longleftrightarrow> dist a b = dist b c"
     apply (auto simp: collinear_3_expand assms dist_midpoint)
     apply (simp add: dist_norm * assms midpoint_def del: divide_const_simps)
     apply (simp add: algebra_simps)
     done
   ultimately show ?thesis by blast
 qed
 
 lemma between_imp_collinear:
   fixes x :: "'a :: euclidean_space"
   assumes "between (a,b) x"
     shows "collinear {a,x,b}"
 proof (cases "x = a \<or> x = b \<or> a = b")
   case True with assms show ?thesis
     by (auto simp: dist_commute)
 next
   case False with assms show ?thesis
     apply (auto simp: collinear_3 collinear_lemma between_norm)
     apply (drule_tac x="-(norm(b - x) / norm(x - a))" in spec)
     apply (simp add: vector_add_divide_simps eq_vector_fraction_iff real_vector.scale_minus_right [symmetric])
     done
 qed
 
 lemma midpoint_between:
   fixes a b :: "'a::euclidean_space"
   shows "b = midpoint a c \<longleftrightarrow> between (a,c) b \<and> dist a b = dist b c"
 proof (cases "a = c")
   case True then show ?thesis
     by (auto simp: dist_commute)
 next
   case False
   show ?thesis
     apply (rule iffI)
     apply (simp add: between_midpoint(1) dist_midpoint)
     using False between_imp_collinear midpoint_collinear by blast
 qed
 
 lemma collinear_triples:
   assumes "a \<noteq> b"
     shows "collinear(insert a (insert b S)) \<longleftrightarrow> (\<forall>x \<in> S. collinear{a,b,x})"
           (is "?lhs = ?rhs")
 proof safe
   fix x
   assume ?lhs and "x \<in> S"
   then show "collinear {a, b, x}"
     using collinear_subset by force
 next
   assume ?rhs
   then have "\<forall>x \<in> S. collinear{a,x,b}"
     by (simp add: insert_commute)
   then have *: "\<exists>u. x = u *\<^sub>R a + (1 - u) *\<^sub>R b" if "x \<in> (insert a (insert b S))" for x
     using that assms collinear_3_expand by fastforce+
   show ?lhs
     unfolding collinear_def
     apply (rule_tac x="b-a" in exI)
     apply (clarify dest!: *)
     by (metis (no_types, hide_lams) add.commute diff_add_cancel diff_diff_eq2 real_vector.scale_right_diff_distrib scaleR_left.diff)
 qed
 
 lemma collinear_4_3:
   assumes "a \<noteq> b"
     shows "collinear {a,b,c,d} \<longleftrightarrow> collinear{a,b,c} \<and> collinear{a,b,d}"
   using collinear_triples [OF assms, of "{c,d}"] by (force simp:)
 
 lemma collinear_3_trans:
   assumes "collinear{a,b,c}" "collinear{b,c,d}" "b \<noteq> c"
     shows "collinear{a,b,d}"
 proof -
   have "collinear{b,c,a,d}"
     by (metis (full_types) assms collinear_4_3 insert_commute)
   then show ?thesis
     by (simp add: collinear_subset)
 qed
 
 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
   using affine_hull_nonempty by blast
 
 lemma affine_hull_2_alt:
   fixes a b :: "'a::real_vector"
   shows "affine hull {a,b} = range (\<lambda>u. a + u *\<^sub>R (b - a))"
 apply (simp add: affine_hull_2, safe)
 apply (rule_tac x=v in image_eqI)
 apply (simp add: algebra_simps)
 apply (metis scaleR_add_left scaleR_one, simp)
 apply (rule_tac x="1-u" in exI)
 apply (simp add: algebra_simps)
 done
 
 lemma interior_convex_hull_3_minimal:
   fixes a :: "'a::euclidean_space"
   shows "\<lbrakk>\<not> collinear{a,b,c}; DIM('a) = 2\<rbrakk>
          \<Longrightarrow> interior(convex hull {a,b,c}) =
                 {v. \<exists>x y z. 0 < x \<and> 0 < y \<and> 0 < z \<and> x + y + z = 1 \<and>
                             x *\<^sub>R a + y *\<^sub>R b + z *\<^sub>R c = v}"
 apply (simp add: collinear_3_eq_affine_dependent interior_convex_hull_explicit_minimal, safe)
 apply (rule_tac x="u a" in exI, simp)
 apply (rule_tac x="u b" in exI, simp)
 apply (rule_tac x="u c" in exI, simp)
 apply (rename_tac uu x y z)
 apply (rule_tac x="\<lambda>r. (if r=a then x else if r=b then y else if r=c then z else 0)" in exI)
 apply simp
 done
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic lemmas about hyperplanes and halfspaces\<close>
 
 lemma halfspace_Int_eq:
      "{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
      "{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
   by auto
 
 lemma hyperplane_eq_Ex:
   assumes "a \<noteq> 0" obtains x where "a \<bullet> x = b"
   by (rule_tac x = "(b / (a \<bullet> a)) *\<^sub>R a" in that) (simp add: assms)
 
 lemma hyperplane_eq_empty:
      "{x. a \<bullet> x = b} = {} \<longleftrightarrow> a = 0 \<and> b \<noteq> 0"
   using hyperplane_eq_Ex apply auto[1]
   using inner_zero_right by blast
 
 lemma hyperplane_eq_UNIV:
    "{x. a \<bullet> x = b} = UNIV \<longleftrightarrow> a = 0 \<and> b = 0"
 proof -
   have "UNIV \<subseteq> {x. a \<bullet> x = b} \<Longrightarrow> a = 0 \<and> b = 0"
     apply (drule_tac c = "((b+1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply simp_all
     by (metis add_cancel_right_right zero_neq_one)
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_lt:
    "{x. a \<bullet> x < b} = {} \<longleftrightarrow> a = 0 \<and> b \<le> 0"
 proof -
   have "{x. a \<bullet> x < b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b \<le> 0"
     apply (rule ccontr)
     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply force+
     done
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_gt:
    "{x. a \<bullet> x > b} = {} \<longleftrightarrow> a = 0 \<and> b \<ge> 0"
 using halfspace_eq_empty_lt [of "-a" "-b"]
 by simp
 
 lemma halfspace_eq_empty_le:
    "{x. a \<bullet> x \<le> b} = {} \<longleftrightarrow> a = 0 \<and> b < 0"
 proof -
   have "{x. a \<bullet> x \<le> b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b < 0"
     apply (rule ccontr)
     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply force+
     done
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_ge:
    "{x. a \<bullet> x \<ge> b} = {} \<longleftrightarrow> a = 0 \<and> b > 0"
 using halfspace_eq_empty_le [of "-a" "-b"]
 by simp
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Use set distance for an easy proof of separation properties\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> separation_closures:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<inter> closure T = {}" "T \<inter> closure S = {}"
   obtains U V where "U \<inter> V = {}" "open U" "open V" "S \<subseteq> U" "T \<subseteq> V"
 proof (cases "S = {} \<or> T = {}")
   case True with that show ?thesis by auto
 next
   case False
   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
   have contf: "continuous_on UNIV f"
     unfolding f_def by (intro continuous_intros continuous_on_setdist)
   show ?thesis
   proof (rule_tac U = "{x. f x > 0}" and V = "{x. f x < 0}" in that)
     show "{x. 0 < f x} \<inter> {x. f x < 0} = {}"
       by auto
     show "open {x. 0 < f x}"
-      by (simp add: open_Collect_less contf continuous_on_const)
+      by (simp add: open_Collect_less contf)
     show "open {x. f x < 0}"
-      by (simp add: open_Collect_less contf continuous_on_const)
+      by (simp add: open_Collect_less contf)
     show "S \<subseteq> {x. 0 < f x}"
       apply (clarsimp simp add: f_def setdist_sing_in_set)
       using assms
       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
     show "T \<subseteq> {x. f x < 0}"
       apply (clarsimp simp add: f_def setdist_sing_in_set)
       using assms
       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
   qed
 qed
 
 lemma separation_normal:
   fixes S :: "'a::euclidean_space set"
   assumes "closed S" "closed T" "S \<inter> T = {}"
   obtains U V where "open U" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
 using separation_closures [of S T]
 by (metis assms closure_closed disjnt_def inf_commute)
 
 lemma separation_normal_local:
   fixes S :: "'a::euclidean_space set"
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "S \<inter> T = {}"
   obtains S' T' where "openin (top_of_set U) S'"
                       "openin (top_of_set U) T'"
                       "S \<subseteq> S'"  "T \<subseteq> T'"  "S' \<inter> T' = {}"
 proof (cases "S = {} \<or> T = {}")
   case True with that show ?thesis
     using UT US by (blast dest: closedin_subset)
 next
   case False
   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
   have contf: "continuous_on U f"
     unfolding f_def by (intro continuous_intros)
   show ?thesis
   proof (rule_tac S' = "(U \<inter> f -` {0<..})" and T' = "(U \<inter> f -` {..<0})" in that)
     show "(U \<inter> f -` {0<..}) \<inter> (U \<inter> f -` {..<0}) = {}"
       by auto
     show "openin (top_of_set U) (U \<inter> f -` {0<..})"
       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
   next
     show "openin (top_of_set U) (U \<inter> f -` {..<0})"
       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
   next
     have "S \<subseteq> U" "T \<subseteq> U"
       using closedin_imp_subset assms by blast+
     then show "S \<subseteq> U \<inter> f -` {0<..}" "T \<subseteq> U \<inter> f -` {..<0}"
       using assms False by (force simp add: f_def setdist_sing_in_set intro!: setdist_gt_0_closedin)+
   qed
 qed
 
 lemma separation_normal_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "closed T" "S \<inter> T = {}"
   obtains U V where "open U" "compact(closure U)" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
 proof -
   have "closed S" "bounded S"
     using assms by (auto simp: compact_eq_bounded_closed)
   then obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
     by (auto dest!: bounded_subset_ballD)
   have **: "closed (T \<union> - ball 0 r)" "S \<inter> (T \<union> - ball 0 r) = {}"
     using assms r by blast+
   then show ?thesis
     apply (rule separation_normal [OF \<open>closed S\<close>])
     apply (rule_tac U=U and V=V in that)
     by auto (meson bounded_ball bounded_subset compl_le_swap2 disjoint_eq_subset_Compl)
 qed
 
 subsection\<open>Connectedness of the intersection of a chain\<close>
 
 proposition connected_chain:
   fixes \<F> :: "'a :: euclidean_space set set"
   assumes cc: "\<And>S. S \<in> \<F> \<Longrightarrow> compact S \<and> connected S"
       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
   shows "connected(\<Inter>\<F>)"
 proof (cases "\<F> = {}")
   case True then show ?thesis
     by auto
 next
   case False
   then have cf: "compact(\<Inter>\<F>)"
     by (simp add: cc compact_Inter)
   have False if AB: "closed A" "closed B" "A \<inter> B = {}"
                 and ABeq: "A \<union> B = \<Inter>\<F>" and "A \<noteq> {}" "B \<noteq> {}" for A B
   proof -
     obtain U V where "open U" "open V" "A \<subseteq> U" "B \<subseteq> V" "U \<inter> V = {}"
       using separation_normal [OF AB] by metis
     obtain K where "K \<in> \<F>" "compact K"
       using cc False by blast
     then obtain N where "open N" and "K \<subseteq> N"
       by blast
     let ?\<C> = "insert (U \<union> V) ((\<lambda>S. N - S) ` \<F>)"
     obtain \<D> where "\<D> \<subseteq> ?\<C>" "finite \<D>" "K \<subseteq> \<Union>\<D>"
     proof (rule compactE [OF \<open>compact K\<close>])
       show "K \<subseteq> \<Union>(insert (U \<union> V) ((-) N ` \<F>))"
         using \<open>K \<subseteq> N\<close> ABeq \<open>A \<subseteq> U\<close> \<open>B \<subseteq> V\<close> by auto
       show "\<And>B. B \<in> insert (U \<union> V) ((-) N ` \<F>) \<Longrightarrow> open B"
         by (auto simp:  \<open>open U\<close> \<open>open V\<close> open_Un \<open>open N\<close> cc compact_imp_closed open_Diff)
     qed
     then have "finite(\<D> - {U \<union> V})"
       by blast
     moreover have "\<D> - {U \<union> V} \<subseteq> (\<lambda>S. N - S) ` \<F>"
       using \<open>\<D> \<subseteq> ?\<C>\<close> by blast
     ultimately obtain \<G> where "\<G> \<subseteq> \<F>" "finite \<G>" and Deq: "\<D> - {U \<union> V} = (\<lambda>S. N-S) ` \<G>"
       using finite_subset_image by metis
     obtain J where "J \<in> \<F>" and J: "(\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
     proof (cases "\<G> = {}")
       case True
       with \<open>\<F> \<noteq> {}\<close> that show ?thesis
         by auto
     next
       case False
       have "\<And>S T. \<lbrakk>S \<in> \<G>; T \<in> \<G>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
         by (meson \<open>\<G> \<subseteq> \<F>\<close> in_mono local.linear)
       with \<open>finite \<G>\<close> \<open>\<G> \<noteq> {}\<close>
       have "\<exists>J \<in> \<G>. (\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
       proof induction
         case (insert X \<H>)
         show ?case
         proof (cases "\<H> = {}")
           case True then show ?thesis by auto
         next
           case False
           then have "\<And>S T. \<lbrakk>S \<in> \<H>; T \<in> \<H>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
             by (simp add: insert.prems)
           with insert.IH False obtain J where "J \<in> \<H>" and J: "(\<Union>Y\<in>\<H>. N - Y) \<subseteq> N - J"
             by metis
           have "N - J \<subseteq> N - X \<or> N - X \<subseteq> N - J"
             by (meson Diff_mono \<open>J \<in> \<H>\<close> insert.prems(2) insert_iff order_refl)
           then show ?thesis
           proof
             assume "N - J \<subseteq> N - X" with J show ?thesis
               by auto
           next
             assume "N - X \<subseteq> N - J"
             with J have "N - X \<union> \<Union> ((-) N ` \<H>) \<subseteq> N - J"
               by auto
             with \<open>J \<in> \<H>\<close> show ?thesis
               by blast
           qed
         qed
       qed simp
       with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis by (blast intro: that)
     qed
     have "K \<subseteq> \<Union>(insert (U \<union> V) (\<D> - {U \<union> V}))"
       using \<open>K \<subseteq> \<Union>\<D>\<close> by auto
     also have "... \<subseteq> (U \<union> V) \<union> (N - J)"
       by (metis (no_types, hide_lams) Deq Un_subset_iff Un_upper2 J Union_insert order_trans sup_ge1)
     finally have "J \<inter> K \<subseteq> U \<union> V"
       by blast
     moreover have "connected(J \<inter> K)"
       by (metis Int_absorb1 \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> cc inf.orderE local.linear)
     moreover have "U \<inter> (J \<inter> K) \<noteq> {}"
       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>A \<noteq> {}\<close> \<open>A \<subseteq> U\<close> by blast
     moreover have "V \<inter> (J \<inter> K) \<noteq> {}"
       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>B \<noteq> {}\<close> \<open>B \<subseteq> V\<close> by blast
     ultimately show False
         using connectedD [of "J \<inter> K" U V] \<open>open U\<close> \<open>open V\<close> \<open>U \<inter> V = {}\<close>  by auto
   qed
   with cf show ?thesis
     by (auto simp: connected_closed_set compact_imp_closed)
 qed
 
 lemma connected_chain_gen:
   fixes \<F> :: "'a :: euclidean_space set set"
   assumes X: "X \<in> \<F>" "compact X"
       and cc: "\<And>T. T \<in> \<F> \<Longrightarrow> closed T \<and> connected T"
       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
   shows "connected(\<Inter>\<F>)"
 proof -
   have "\<Inter>\<F> = (\<Inter>T\<in>\<F>. X \<inter> T)"
     using X by blast
   moreover have "connected (\<Inter>T\<in>\<F>. X \<inter> T)"
   proof (rule connected_chain)
     show "\<And>T. T \<in> (\<inter>) X ` \<F> \<Longrightarrow> compact T \<and> connected T"
       using cc X by auto (metis inf.absorb2 inf.orderE local.linear)
     show "\<And>S T. S \<in> (\<inter>) X ` \<F> \<and> T \<in> (\<inter>) X ` \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
       using local.linear by blast
   qed
   ultimately show ?thesis
     by metis
 qed
 
 lemma connected_nest:
   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
   assumes S: "\<And>n. compact(S n)" "\<And>n. connected(S n)"
     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
   shows "connected(\<Inter> (range S))"
   apply (rule connected_chain)
   using S apply blast
   by (metis image_iff le_cases nest)
 
 lemma connected_nest_gen:
   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
   assumes S: "\<And>n. closed(S n)" "\<And>n. connected(S n)" "compact(S k)"
     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
   shows "connected(\<Inter> (range S))"
   apply (rule connected_chain_gen [of "S k"])
   using S apply auto
   by (meson le_cases nest subsetCE)
 
 subsection\<open>Proper maps, including projections out of compact sets\<close>
 
 lemma finite_indexed_bound:
   assumes A: "finite A" "\<And>x. x \<in> A \<Longrightarrow> \<exists>n::'a::linorder. P x n"
     shows "\<exists>m. \<forall>x \<in> A. \<exists>k\<le>m. P x k"
 using A
 proof (induction A)
   case empty then show ?case by force
 next
   case (insert a A)
     then obtain m n where "\<forall>x \<in> A. \<exists>k\<le>m. P x k" "P a n"
       by force
     then show ?case
       apply (rule_tac x="max m n" in exI, safe)
       using max.cobounded2 apply blast
       by (meson le_max_iff_disj)
 qed
 
 proposition proper_map:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
   assumes "closedin (top_of_set S) K"
       and com: "\<And>U. \<lbrakk>U \<subseteq> T; compact U\<rbrakk> \<Longrightarrow> compact (S \<inter> f -` U)"
       and "f ` S \<subseteq> T"
     shows "closedin (top_of_set T) (f ` K)"
 proof -
   have "K \<subseteq> S"
     using assms closedin_imp_subset by metis
   obtain C where "closed C" and Keq: "K = S \<inter> C"
     using assms by (auto simp: closedin_closed)
   have *: "y \<in> f ` K" if "y \<in> T" and y: "y islimpt f ` K" for y
   proof -
     obtain h where "\<forall>n. (\<exists>x\<in>K. h n = f x) \<and> h n \<noteq> y" "inj h" and hlim: "(h \<longlongrightarrow> y) sequentially"
       using \<open>y \<in> T\<close> y by (force simp: limpt_sequential_inj)
     then obtain X where X: "\<And>n. X n \<in> K \<and> h n = f (X n) \<and> h n \<noteq> y"
       by metis
     then have fX: "\<And>n. f (X n) = h n"
       by metis
     have "compact (C \<inter> (S \<inter> f -` insert y (range (\<lambda>i. f(X(n + i))))))" for n
       apply (rule closed_Int_compact [OF \<open>closed C\<close>])
       apply (rule com)
        using X \<open>K \<subseteq> S\<close> \<open>f ` S \<subseteq> T\<close> \<open>y \<in> T\<close> apply blast
       apply (rule compact_sequence_with_limit)
       apply (simp add: fX add.commute [of n] LIMSEQ_ignore_initial_segment [OF hlim])
       done
     then have comf: "compact {a \<in> K. f a \<in> insert y (range (\<lambda>i. f(X(n + i))))}" for n
       by (simp add: Keq Int_def conj_commute)
     have ne: "\<Inter>\<F> \<noteq> {}"
              if "finite \<F>"
                 and \<F>: "\<And>t. t \<in> \<F> \<Longrightarrow>
                            (\<exists>n. t = {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
              for \<F>
     proof -
       obtain m where m: "\<And>t. t \<in> \<F> \<Longrightarrow> \<exists>k\<le>m. t = {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (k + i))))}"
         apply (rule exE)
         apply (rule finite_indexed_bound [OF \<open>finite \<F>\<close> \<F>], assumption, force)
         done
       have "X m \<in> \<Inter>\<F>"
         using X le_Suc_ex by (fastforce dest: m)
       then show ?thesis by blast
     qed
     have "\<Inter>{{a. a \<in> K \<and> f a \<in> insert y (range (\<lambda>i. f(X(n + i))))} |n. n \<in> UNIV}
                \<noteq> {}"
       apply (rule compact_fip_Heine_Borel)
        using comf apply force
       using ne  apply (simp add: subset_iff del: insert_iff)
       done
     then have "\<exists>x. x \<in> (\<Inter>n. {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
       by blast
     then show ?thesis
       apply (simp add: image_iff fX)
       by (metis \<open>inj h\<close> le_add1 not_less_eq_eq rangeI range_ex1_eq)
   qed
   with assms closedin_subset show ?thesis
     by (force simp: closedin_limpt)
 qed
 
 
 lemma compact_continuous_image_eq:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
   assumes f: "inj_on f S"
   shows "continuous_on S f \<longleftrightarrow> (\<forall>T. compact T \<and> T \<subseteq> S \<longrightarrow> compact(f ` T))"
            (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis continuous_on_subset compact_continuous_image)
 next
   assume RHS: ?rhs
   obtain g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     by (metis inv_into_f_f f)
   then have *: "(S \<inter> f -` U) = g ` U" if "U \<subseteq> f ` S" for U
     using that by fastforce
   have gfim: "g ` f ` S \<subseteq> S" using gf by auto
   have **: "compact (f ` S \<inter> g -` C)" if C: "C \<subseteq> S" "compact C" for C
   proof -
     obtain h where "h C \<in> C \<and> h C \<notin> S \<or> compact (f ` C)"
       by (force simp: C RHS)
     moreover have "f ` C = (f ` S \<inter> g -` C)"
       using C gf by auto
     ultimately show ?thesis
       using C by auto
   qed
   show ?lhs
     using proper_map [OF _ _ gfim] **
     by (simp add: continuous_on_closed * closedin_imp_subset)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
 
 lemma convex_connected_collinear:
   fixes S :: "'a::euclidean_space set"
   assumes "collinear S"
     shows "convex S \<longleftrightarrow> connected S"
 proof
   assume "convex S"
   then show "connected S"
     using convex_connected by blast
 next
   assume S: "connected S"
   show "convex S"
   proof (cases "S = {}")
     case True
     then show ?thesis by simp
   next
     case False
     then obtain a where "a \<in> S" by auto
     have "collinear (affine hull S)"
       by (simp add: assms collinear_affine_hull_collinear)
     then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - a = c *\<^sub>R z"
       by (meson \<open>a \<in> S\<close> collinear hull_inc)
     then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - a = f x *\<^sub>R z"
       by metis
     then have inj_f: "inj_on f (affine hull S)"
       by (metis diff_add_cancel inj_onI)
     have diff: "x - y = (f x - f y) *\<^sub>R z" if x: "x \<in> affine hull S" and y: "y \<in> affine hull S" for x y
     proof -
       have "f x *\<^sub>R z = x - a"
         by (simp add: f hull_inc x)
       moreover have "f y *\<^sub>R z = y - a"
         by (simp add: f hull_inc y)
       ultimately show ?thesis
         by (simp add: scaleR_left.diff)
     qed
     have cont_f: "continuous_on (affine hull S) f"
       apply (clarsimp simp: dist_norm continuous_on_iff diff)
       by (metis \<open>z \<noteq> 0\<close> mult.commute mult_less_cancel_left_pos norm_minus_commute real_norm_def zero_less_mult_iff zero_less_norm_iff)
     then have conn_fS: "connected (f ` S)"
       by (meson S connected_continuous_image continuous_on_subset hull_subset)
     show ?thesis
     proof (clarsimp simp: convex_contains_segment)
       fix x y z
       assume "x \<in> S" "y \<in> S" "z \<in> closed_segment x y"
       have False if "z \<notin> S"
       proof -
         have "f ` (closed_segment x y) = closed_segment (f x) (f y)"
           apply (rule continuous_injective_image_segment_1)
           apply (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc continuous_on_subset [OF cont_f])
           by (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc inj_on_subset [OF inj_f])
         then have fz: "f z \<in> closed_segment (f x) (f y)"
           using \<open>z \<in> closed_segment x y\<close> by blast
         have "z \<in> affine hull S"
           by (meson \<open>x \<in> S\<close> \<open>y \<in> S\<close> \<open>z \<in> closed_segment x y\<close> convex_affine_hull convex_contains_segment hull_inc subset_eq)
         then have fz_notin: "f z \<notin> f ` S"
           using hull_subset inj_f inj_onD that by fastforce
         moreover have "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
         proof -
           have "{..<f z} \<inter> f ` {x,y} \<noteq> {}"  "{f z<..} \<inter> f ` {x,y} \<noteq> {}"
             using fz fz_notin \<open>x \<in> S\<close> \<open>y \<in> S\<close>
              apply (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
              apply (metis image_eqI less_eq_real_def)+
             done
           then show "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
             using \<open>x \<in> S\<close> \<open>y \<in> S\<close> by blast+
         qed
         ultimately show False
           using connectedD [OF conn_fS, of "{..<f z}" "{f z<..}"] by force
       qed
       then show "z \<in> S" by meson
     qed
   qed
 qed
 
 lemma compact_convex_collinear_segment_alt:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<noteq> {}" "compact S" "connected S" "collinear S"
   obtains a b where "S = closed_segment a b"
 proof -
   obtain \<xi> where "\<xi> \<in> S" using \<open>S \<noteq> {}\<close> by auto
   have "collinear (affine hull S)"
     by (simp add: assms collinear_affine_hull_collinear)
   then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - \<xi> = c *\<^sub>R z"
     by (meson \<open>\<xi> \<in> S\<close> collinear hull_inc)
   then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - \<xi> = f x *\<^sub>R z"
     by metis
   let ?g = "\<lambda>r. r *\<^sub>R z + \<xi>"
   have gf: "?g (f x) = x" if "x \<in> affine hull S" for x
     by (metis diff_add_cancel f that)
   then have inj_f: "inj_on f (affine hull S)"
     by (metis inj_onI)
   have diff: "x - y = (f x - f y) *\<^sub>R z" if x: "x \<in> affine hull S" and y: "y \<in> affine hull S" for x y
   proof -
     have "f x *\<^sub>R z = x - \<xi>"
       by (simp add: f hull_inc x)
     moreover have "f y *\<^sub>R z = y - \<xi>"
       by (simp add: f hull_inc y)
     ultimately show ?thesis
       by (simp add: scaleR_left.diff)
   qed
   have cont_f: "continuous_on (affine hull S) f"
     apply (clarsimp simp: dist_norm continuous_on_iff diff)
     by (metis \<open>z \<noteq> 0\<close> mult.commute mult_less_cancel_left_pos norm_minus_commute real_norm_def zero_less_mult_iff zero_less_norm_iff)
   then have "connected (f ` S)"
     by (meson \<open>connected S\<close> connected_continuous_image continuous_on_subset hull_subset)
   moreover have "compact (f ` S)"
     by (meson \<open>compact S\<close> compact_continuous_image_eq cont_f hull_subset inj_f)
   ultimately obtain x y where "f ` S = {x..y}"
     by (meson connected_compact_interval_1)
   then have fS_eq: "f ` S = closed_segment x y"
     using \<open>S \<noteq> {}\<close> closed_segment_eq_real_ivl by auto
   obtain a b where "a \<in> S" "f a = x" "b \<in> S" "f b = y"
     by (metis (full_types) ends_in_segment fS_eq imageE)
   have "f ` (closed_segment a b) = closed_segment (f a) (f b)"
     apply (rule continuous_injective_image_segment_1)
      apply (meson \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc continuous_on_subset [OF cont_f])
     by (meson \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment hull_inc inj_on_subset [OF inj_f])
   then have "f ` (closed_segment a b) = f ` S"
     by (simp add: \<open>f a = x\<close> \<open>f b = y\<close> fS_eq)
   then have "?g ` f ` (closed_segment a b) = ?g ` f ` S"
     by simp
   moreover have "(\<lambda>x. f x *\<^sub>R z + \<xi>) ` closed_segment a b = closed_segment a b"
     apply safe
      apply (metis (mono_tags, hide_lams) \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment gf hull_inc subsetCE)
     by (metis (mono_tags, lifting) \<open>a \<in> S\<close> \<open>b \<in> S\<close> convex_affine_hull convex_contains_segment gf hull_subset image_iff subsetCE)
   ultimately have "closed_segment a b = S"
     using gf by (simp add: image_comp o_def hull_inc cong: image_cong)
   then show ?thesis
     using that by blast
 qed
 
 lemma compact_convex_collinear_segment:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<noteq> {}" "compact S" "convex S" "collinear S"
   obtains a b where "S = closed_segment a b"
   using assms convex_connected_collinear compact_convex_collinear_segment_alt by blast
 
 
 lemma proper_map_from_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T" and "compact S"
           "closedin (top_of_set T) K"
   shows "compact (S \<inter> f -` K)"
 by (rule closedin_compact [OF \<open>compact S\<close>] continuous_closedin_preimage_gen assms)+
 
 lemma proper_map_fst:
   assumes "compact T" "K \<subseteq> S" "compact K"
     shows "compact (S \<times> T \<inter> fst -` K)"
 proof -
   have "(S \<times> T \<inter> fst -` K) = K \<times> T"
     using assms by auto
   then show ?thesis by (simp add: assms compact_Times)
 qed
 
 lemma closed_map_fst:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact T" "closedin (top_of_set (S \<times> T)) c"
    shows "closedin (top_of_set S) (fst ` c)"
 proof -
   have *: "fst ` (S \<times> T) \<subseteq> S"
     by auto
   show ?thesis
     using proper_map [OF _ _ *] by (simp add: proper_map_fst assms)
 qed
 
 lemma proper_map_snd:
   assumes "compact S" "K \<subseteq> T" "compact K"
     shows "compact (S \<times> T \<inter> snd -` K)"
 proof -
   have "(S \<times> T \<inter> snd -` K) = S \<times> K"
     using assms by auto
   then show ?thesis by (simp add: assms compact_Times)
 qed
 
 lemma closed_map_snd:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" "closedin (top_of_set (S \<times> T)) c"
    shows "closedin (top_of_set T) (snd ` c)"
 proof -
   have *: "snd ` (S \<times> T) \<subseteq> T"
     by auto
   show ?thesis
     using proper_map [OF _ _ *] by (simp add: proper_map_snd assms)
 qed
 
 lemma closedin_compact_projection:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" and clo: "closedin (top_of_set (S \<times> T)) U"
     shows "closedin (top_of_set T) {y. \<exists>x. x \<in> S \<and> (x, y) \<in> U}"
 proof -
   have "U \<subseteq> S \<times> T"
     by (metis clo closedin_imp_subset)
   then have "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> U} = snd ` U"
     by force
   moreover have "closedin (top_of_set T) (snd ` U)"
     by (rule closed_map_snd [OF assms])
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma closed_compact_projection:
   fixes S :: "'a::euclidean_space set"
     and T :: "('a * 'b::euclidean_space) set"
   assumes "compact S" and clo: "closed T"
     shows "closed {y. \<exists>x. x \<in> S \<and> (x, y) \<in> T}"
 proof -
   have *: "{y. \<exists>x. x \<in> S \<and> Pair x y \<in> T} =
         {y. \<exists>x. x \<in> S \<and> Pair x y \<in> ((S \<times> UNIV) \<inter> T)}"
     by auto
   show ?thesis
     apply (subst *)
     apply (rule closedin_closed_trans [OF _ closed_UNIV])
     apply (rule closedin_compact_projection [OF \<open>compact S\<close>])
     by (simp add: clo closedin_closed_Int)
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_convex_Int_nonempty_interior:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "S \<inter> interior T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 proof
   show "affine hull (S \<inter> T) \<subseteq> affine hull S"
     by (simp add: hull_mono)
 next
   obtain a where "a \<in> S" "a \<in> T" and at: "a \<in> interior T"
     using assms interior_subset by blast
   then obtain e where "e > 0" and e: "cball a e \<subseteq> T"
     using mem_interior_cball by blast
   have *: "x \<in> (+) a ` span ((\<lambda>x. x - a) ` (S \<inter> T))" if "x \<in> S" for x
   proof (cases "x = a")
     case True with that span_0 eq_add_iff image_def mem_Collect_eq show ?thesis
       by blast
   next
     case False
     define k where "k = min (1/2) (e / norm (x-a))"
     have k: "0 < k" "k < 1"
       using \<open>e > 0\<close> False by (auto simp: k_def)
     then have xa: "(x-a) = inverse k *\<^sub>R k *\<^sub>R (x-a)"
       by simp
     have "e / norm (x - a) \<ge> k"
       using k_def by linarith
     then have "a + k *\<^sub>R (x - a) \<in> cball a e"
       using \<open>0 < k\<close> False
       by (simp add: dist_norm) (simp add: field_simps)
     then have T: "a + k *\<^sub>R (x - a) \<in> T"
       using e by blast
     have S: "a + k *\<^sub>R (x - a) \<in> S"
       using k \<open>a \<in> S\<close> convexD [OF \<open>convex S\<close> \<open>a \<in> S\<close> \<open>x \<in> S\<close>, of "1-k" k]
       by (simp add: algebra_simps)
     have "inverse k *\<^sub>R k *\<^sub>R (x-a) \<in> span ((\<lambda>x. x - a) ` (S \<inter> T))"
       apply (rule span_mul)
       apply (rule span_base)
       apply (rule image_eqI [where x = "a + k *\<^sub>R (x - a)"])
       apply (auto simp: S T)
       done
     with xa image_iff show ?thesis  by fastforce
   qed
   show "affine hull S \<subseteq> affine hull (S \<inter> T)"
     apply (simp add: subset_hull)
     apply (simp add: \<open>a \<in> S\<close> \<open>a \<in> T\<close> hull_inc affine_hull_span_gen [of a])
     apply (force simp: *)
     done
 qed
 
 corollary affine_hull_convex_Int_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "open T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 using affine_hull_convex_Int_nonempty_interior assms interior_eq by blast
 
 corollary affine_hull_affine_Int_nonempty_interior:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S" "S \<inter> interior T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 by (simp add: affine_hull_convex_Int_nonempty_interior affine_imp_convex assms)
 
 corollary affine_hull_affine_Int_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S" "open T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 by (simp add: affine_hull_convex_Int_open affine_imp_convex assms)
 
 corollary affine_hull_convex_Int_openin:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "openin (top_of_set (affine hull S)) T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 using assms unfolding openin_open
 by (metis affine_hull_convex_Int_open hull_subset inf.orderE inf_assoc)
 
 corollary affine_hull_openin:
   fixes S :: "'a::real_normed_vector set"
   assumes "openin (top_of_set (affine hull T)) S" "S \<noteq> {}"
     shows "affine hull S = affine hull T"
 using assms unfolding openin_open
 by (metis affine_affine_hull affine_hull_affine_Int_open hull_hull)
 
 corollary affine_hull_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S" "S \<noteq> {}"
     shows "affine hull S = UNIV"
 by (metis affine_hull_convex_Int_nonempty_interior assms convex_UNIV hull_UNIV inf_top.left_neutral interior_open)
 
 lemma aff_dim_convex_Int_nonempty_interior:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>convex S; S \<inter> interior T \<noteq> {}\<rbrakk> \<Longrightarrow> aff_dim(S \<inter> T) = aff_dim S"
 using aff_dim_affine_hull2 affine_hull_convex_Int_nonempty_interior by blast
 
 lemma aff_dim_convex_Int_open:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>convex S; open T; S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow>  aff_dim(S \<inter> T) = aff_dim S"
 using aff_dim_convex_Int_nonempty_interior interior_eq by blast
 
 lemma affine_hull_Diff:
   fixes S:: "'a::real_normed_vector set"
   assumes ope: "openin (top_of_set (affine hull S)) S" and "finite F" "F \<subset> S"
     shows "affine hull (S - F) = affine hull S"
 proof -
   have clo: "closedin (top_of_set S) F"
     using assms finite_imp_closedin by auto
   moreover have "S - F \<noteq> {}"
     using assms by auto
   ultimately show ?thesis
     by (metis ope closedin_def topspace_euclidean_subtopology affine_hull_openin openin_trans)
 qed
 
 lemma affine_hull_halfspace_lt:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x < r} = (if a = 0 \<and> r \<le> 0 then {} else UNIV)"
 using halfspace_eq_empty_lt [of a r]
 by (simp add: open_halfspace_lt affine_hull_open)
 
 lemma affine_hull_halfspace_le:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x \<le> r} = (if a = 0 \<and> r < 0 then {} else UNIV)"
 proof (cases "a = 0")
   case True then show ?thesis by simp
 next
   case False
   then have "affine hull closure {x. a \<bullet> x < r} = UNIV"
     using affine_hull_halfspace_lt closure_same_affine_hull by fastforce
   moreover have "{x. a \<bullet> x < r} \<subseteq> {x. a \<bullet> x \<le> r}"
     by (simp add: Collect_mono)
   ultimately show ?thesis using False antisym_conv hull_mono top_greatest
     by (metis affine_hull_halfspace_lt)
 qed
 
 lemma affine_hull_halfspace_gt:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x > r} = (if a = 0 \<and> r \<ge> 0 then {} else UNIV)"
 using halfspace_eq_empty_gt [of r a]
 by (simp add: open_halfspace_gt affine_hull_open)
 
 lemma affine_hull_halfspace_ge:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x \<ge> r} = (if a = 0 \<and> r > 0 then {} else UNIV)"
 using affine_hull_halfspace_le [of "-a" "-r"] by simp
 
 lemma aff_dim_halfspace_lt:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x < r} =
         (if a = 0 \<and> r \<le> 0 then -1 else DIM('a))"
 by simp (metis aff_dim_open halfspace_eq_empty_lt open_halfspace_lt)
 
 lemma aff_dim_halfspace_le:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x \<le> r} =
         (if a = 0 \<and> r < 0 then -1 else DIM('a))"
 proof -
   have "int (DIM('a)) = aff_dim (UNIV::'a set)"
     by (simp add: aff_dim_UNIV)
   then have "aff_dim (affine hull {x. a \<bullet> x \<le> r}) = DIM('a)" if "(a = 0 \<longrightarrow> r \<ge> 0)"
     using that by (simp add: affine_hull_halfspace_le not_less)
   then show ?thesis
     by (force simp: aff_dim_affine_hull)
 qed
 
 lemma aff_dim_halfspace_gt:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x > r} =
         (if a = 0 \<and> r \<ge> 0 then -1 else DIM('a))"
 by simp (metis aff_dim_open halfspace_eq_empty_gt open_halfspace_gt)
 
 lemma aff_dim_halfspace_ge:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x \<ge> r} =
         (if a = 0 \<and> r > 0 then -1 else DIM('a))"
 using aff_dim_halfspace_le [of "-a" "-r"] by simp
 
 proposition aff_dim_eq_hyperplane:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S = DIM('a) - 1 \<longleftrightarrow> (\<exists>a b. a \<noteq> 0 \<and> affine hull S = {x. a \<bullet> x = b})"
 proof (cases "S = {}")
   case True then show ?thesis
     by (auto simp: dest: hyperplane_eq_Ex)
 next
   case False
   then obtain c where "c \<in> S" by blast
   show ?thesis
   proof (cases "c = 0")
     case True show ?thesis
       using span_zero [of S]
         apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
           del: One_nat_def)
         apply (auto simp add: \<open>c = 0\<close>)
         done
   next
     case False
     have xc_im: "x \<in> (+) c ` {y. a \<bullet> y = 0}" if "a \<bullet> x = a \<bullet> c" for a x
     proof -
       have "\<exists>y. a \<bullet> y = 0 \<and> c + y = x"
         by (metis that add.commute diff_add_cancel inner_commute inner_diff_left right_minus_eq)
       then show "x \<in> (+) c ` {y. a \<bullet> y = 0}"
         by blast
     qed
     have 2: "span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = 0}"
          if "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = b}" for a b
     proof -
       have "b = a \<bullet> c"
         using span_0 that by fastforce
       with that have "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = a \<bullet> c}"
         by simp
       then have "span ((\<lambda>x. x - c) ` S) = (\<lambda>x. x - c) ` {x. a \<bullet> x = a \<bullet> c}"
         by (metis (no_types) image_cong translation_galois uminus_add_conv_diff)
       also have "... = {x. a \<bullet> x = 0}"
         by (force simp: inner_distrib inner_diff_right
              intro: image_eqI [where x="x+c" for x])
       finally show ?thesis .
     qed
     show ?thesis
       apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \<open>c \<in> S\<close> hull_inc dim_eq_hyperplane
                   del: One_nat_def cong: image_cong_simp, safe)
       apply (fastforce simp add: inner_distrib intro: xc_im)
       apply (force simp: intro!: 2)
       done
   qed
 qed
 
 corollary aff_dim_hyperplane [simp]:
   fixes a :: "'a::euclidean_space"
   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some stepping theorems\<close>
 
 lemma aff_dim_insert:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain x s' where S: "S = insert x s'" "x \<notin> s'"
     by (meson Set.set_insert all_not_in_conv)
   show ?thesis using S
     apply (simp add: hull_redundant cong: aff_dim_affine_hull2)
     apply (simp add: affine_hull_insert_span_gen hull_inc)
     by (force simp add: span_zero insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert
       cong: image_cong_simp)
 qed
 
 lemma affine_dependent_choose:
   fixes a :: "'a :: euclidean_space"
   assumes "\<not>(affine_dependent S)"
   shows "affine_dependent(insert a S) \<longleftrightarrow> a \<notin> S \<and> a \<in> affine hull S"
         (is "?lhs = ?rhs")
 proof safe
   assume "affine_dependent (insert a S)" and "a \<in> S"
   then show "False"
     using \<open>a \<in> S\<close> assms insert_absorb by fastforce
 next
   assume lhs: "affine_dependent (insert a S)"
   then have "a \<notin> S"
     by (metis (no_types) assms insert_absorb)
   moreover have "finite S"
     using affine_independent_iff_card assms by blast
   moreover have "aff_dim (insert a S) \<noteq> int (card S)"
     using \<open>finite S\<close> affine_independent_iff_card \<open>a \<notin> S\<close> lhs by fastforce
   ultimately show "a \<in> affine hull S"
     by (metis aff_dim_affine_independent aff_dim_insert assms)
 next
   assume "a \<notin> S" and "a \<in> affine hull S"
   show "affine_dependent (insert a S)"
     by (simp add: \<open>a \<in> affine hull S\<close> \<open>a \<notin> S\<close> affine_dependent_def)
 qed
 
 lemma affine_independent_insert:
   fixes a :: "'a :: euclidean_space"
   shows "\<lbrakk>\<not> affine_dependent S; a \<notin> affine hull S\<rbrakk> \<Longrightarrow> \<not> affine_dependent(insert a S)"
   by (simp add: affine_dependent_choose)
 
 lemma subspace_bounded_eq_trivial:
   fixes S :: "'a::real_normed_vector set"
   assumes "subspace S"
     shows "bounded S \<longleftrightarrow> S = {0}"
 proof -
   have "False" if "bounded S" "x \<in> S" "x \<noteq> 0" for x
   proof -
     obtain B where B: "\<And>y. y \<in> S \<Longrightarrow> norm y < B" "B > 0"
       using \<open>bounded S\<close> by (force simp: bounded_pos_less)
     have "(B / norm x) *\<^sub>R x \<in> S"
       using assms subspace_mul \<open>x \<in> S\<close> by auto
     moreover have "norm ((B / norm x) *\<^sub>R x) = B"
       using that B by (simp add: algebra_simps)
     ultimately show False using B by force
   qed
   then have "bounded S \<Longrightarrow> S = {0}"
     using assms subspace_0 by fastforce
   then show ?thesis
     by blast
 qed
 
 lemma affine_bounded_eq_trivial:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S"
     shows "bounded S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain b where "b \<in> S" by blast
   with False assms show ?thesis
     apply safe
     using affine_diffs_subspace [OF assms \<open>b \<in> S\<close>]
     apply (metis (no_types, lifting) subspace_bounded_eq_trivial ab_left_minus bounded_translation
                 image_empty image_insert translation_invert)
     apply force
     done
 qed
 
 lemma affine_bounded_eq_lowdim:
   fixes S :: "'a::euclidean_space set"
   assumes "affine S"
     shows "bounded S \<longleftrightarrow> aff_dim S \<le> 0"
 apply safe
 using affine_bounded_eq_trivial assms apply fastforce
 by (metis aff_dim_sing aff_dim_subset affine_dim_equal affine_sing all_not_in_conv assms bounded_empty bounded_insert dual_order.antisym empty_subsetI insert_subset)
 
 
 lemma bounded_hyperplane_eq_trivial_0:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
   shows "bounded {x. a \<bullet> x = 0} \<longleftrightarrow> DIM('a) = 1"
 proof
   assume "bounded {x. a \<bullet> x = 0}"
   then have "aff_dim {x. a \<bullet> x = 0} \<le> 0"
     by (simp add: affine_bounded_eq_lowdim affine_hyperplane)
   with assms show "DIM('a) = 1"
     by (simp add: le_Suc_eq aff_dim_hyperplane)
 next
   assume "DIM('a) = 1"
   then show "bounded {x. a \<bullet> x = 0}"
     by (simp add: aff_dim_hyperplane affine_bounded_eq_lowdim affine_hyperplane assms)
 qed
 
 lemma bounded_hyperplane_eq_trivial:
   fixes a :: "'a::euclidean_space"
   shows "bounded {x. a \<bullet> x = r} \<longleftrightarrow> (if a = 0 then r \<noteq> 0 else DIM('a) = 1)"
 proof (simp add: bounded_hyperplane_eq_trivial_0, clarify)
   assume "r \<noteq> 0" "a \<noteq> 0"
   have "aff_dim {x. y \<bullet> x = 0} = aff_dim {x. a \<bullet> x = r}" if "y \<noteq> 0" for y::'a
     by (metis that \<open>a \<noteq> 0\<close> aff_dim_hyperplane)
   then show "bounded {x. a \<bullet> x = r} = (DIM('a) = Suc 0)"
     by (metis One_nat_def \<open>a \<noteq> 0\<close> affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>General case without assuming closure and getting non-strict separation\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_closed_point_inset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "closed S" "S \<noteq> {}" "z \<notin> S"
   obtains a b where "a \<in> S" "(a - z) \<bullet> z < b" "\<And>x. x \<in> S \<Longrightarrow> b < (a - z) \<bullet> x"
 proof -
   obtain y where "y \<in> S" and y: "\<And>u. u \<in> S \<Longrightarrow> dist z y \<le> dist z u"
     using distance_attains_inf [of S z] assms by auto
   then have *: "(y - z) \<bullet> z < (y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2"
     using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
   show ?thesis
   proof (rule that [OF \<open>y \<in> S\<close> *])
     fix x
     assume "x \<in> S"
     have yz: "0 < (y - z) \<bullet> (y - z)"
       using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
     { assume 0: "0 < ((z - y) \<bullet> (x - y))"
       with any_closest_point_dot [OF \<open>convex S\<close> \<open>closed S\<close>]
       have False
         using y \<open>x \<in> S\<close> \<open>y \<in> S\<close> not_less by blast
     }
     then have "0 \<le> ((y - z) \<bullet> (x - y))"
       by (force simp: not_less inner_diff_left)
     with yz have "0 < 2 * ((y - z) \<bullet> (x - y)) + (y - z) \<bullet> (y - z)"
       by (simp add: algebra_simps)
     then show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
       by (simp add: field_simps inner_diff_left inner_diff_right dot_square_norm [symmetric])
   qed
 qed
 
 lemma separating_hyperplane_closed_0_inset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "closed S" "S \<noteq> {}" "0 \<notin> S"
   obtains a b where "a \<in> S" "a \<noteq> 0" "0 < b" "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x > b"
 using separating_hyperplane_closed_point_inset [OF assms]
 by simp (metis \<open>0 \<notin> S\<close>)
 
 
 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_set_0_inspan:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" "0 \<notin> S"
   obtains a where "a \<in> span S" "a \<noteq> 0" "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> a \<bullet> x"
 proof -
   define k where [abs_def]: "k c = {x. 0 \<le> c \<bullet> x}" for c :: 'a
   have *: "span S \<inter> frontier (cball 0 1) \<inter> \<Inter>f' \<noteq> {}"
           if f': "finite f'" "f' \<subseteq> k ` S" for f'
   proof -
     obtain C where "C \<subseteq> S" "finite C" and C: "f' = k ` C"
       using finite_subset_image [OF f'] by blast
     obtain a where "a \<in> S" "a \<noteq> 0"
       using \<open>S \<noteq> {}\<close> \<open>0 \<notin> S\<close> ex_in_conv by blast
     then have "norm (a /\<^sub>R (norm a)) = 1"
       by simp
     moreover have "a /\<^sub>R (norm a) \<in> span S"
       by (simp add: \<open>a \<in> S\<close> span_scale span_base)
     ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
       by simp
     show ?thesis
     proof (cases "C = {}")
       case True with C ass show ?thesis
         by auto
     next
       case False
       have "closed (convex hull C)"
         using \<open>finite C\<close> compact_eq_bounded_closed finite_imp_compact_convex_hull by auto
       moreover have "convex hull C \<noteq> {}"
         by (simp add: False)
       moreover have "0 \<notin> convex hull C"
         by (metis \<open>C \<subseteq> S\<close> \<open>convex S\<close> \<open>0 \<notin> S\<close> convex_hull_subset hull_same insert_absorb insert_subset)
       ultimately obtain a b
             where "a \<in> convex hull C" "a \<noteq> 0" "0 < b"
                   and ab: "\<And>x. x \<in> convex hull C \<Longrightarrow> a \<bullet> x > b"
         using separating_hyperplane_closed_0_inset by blast
       then have "a \<in> S"
         by (metis \<open>C \<subseteq> S\<close> assms(1) subsetCE subset_hull)
       moreover have "norm (a /\<^sub>R (norm a)) = 1"
         using \<open>a \<noteq> 0\<close> by simp
       moreover have "a /\<^sub>R (norm a) \<in> span S"
         by (simp add: \<open>a \<in> S\<close> span_scale span_base)
       ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
         by simp
       have aa: "a /\<^sub>R (norm a) \<in> (\<Inter>c\<in>C. {x. 0 \<le> c \<bullet> x})"
         apply (clarsimp simp add: field_split_simps)
         using ab \<open>0 < b\<close>
         by (metis hull_inc inner_commute less_eq_real_def less_trans)
       show ?thesis
         apply (simp add: C k_def)
         using ass aa Int_iff empty_iff by blast
     qed
   qed
   have "(span S \<inter> frontier(cball 0 1)) \<inter> (\<Inter> (k ` S)) \<noteq> {}"
     apply (rule compact_imp_fip)
     apply (blast intro: compact_cball)
     using closed_halfspace_ge k_def apply blast
     apply (metis *)
     done
   then show ?thesis
     unfolding set_eq_iff k_def
     by simp (metis inner_commute norm_eq_zero that zero_neq_one)
 qed
 
 
 lemma separating_hyperplane_set_point_inaff:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and zno: "z \<notin> S"
   obtains a b where "(z + a) \<in> affine hull (insert z S)"
                 and "a \<noteq> 0" and "a \<bullet> z \<le> b"
                 and "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b"
 proof -
   from separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
   have "convex ((+) (- z) ` S)"
     using \<open>convex S\<close> by simp
   moreover have "(+) (- z) ` S \<noteq> {}"
     by (simp add: \<open>S \<noteq> {}\<close>)
   moreover have "0 \<notin> (+) (- z) ` S"
     using zno by auto
   ultimately obtain a where "a \<in> span ((+) (- z) ` S)" "a \<noteq> 0"
                   and a:  "\<And>x. x \<in> ((+) (- z) ` S) \<Longrightarrow> 0 \<le> a \<bullet> x"
     using separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
     by blast
   then have szx: "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> z \<le> a \<bullet> x"
     by (metis (no_types, lifting) imageI inner_minus_right inner_right_distrib minus_add neg_le_0_iff_le neg_le_iff_le real_add_le_0_iff)
   show ?thesis
     apply (rule_tac a=a and b = "a  \<bullet> z" in that, simp_all)
     using \<open>a \<in> span ((+) (- z) ` S)\<close> affine_hull_insert_span_gen apply blast
     apply (simp_all add: \<open>a \<noteq> 0\<close> szx)
     done
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> supporting_hyperplane_rel_boundary:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "x \<in> S" and xno: "x \<notin> rel_interior S"
   obtains a where "a \<noteq> 0"
               and "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
 proof -
   obtain a b where aff: "(x + a) \<in> affine hull (insert x (rel_interior S))"
                   and "a \<noteq> 0" and "a \<bullet> x \<le> b"
                   and ageb: "\<And>u. u \<in> (rel_interior S) \<Longrightarrow> a \<bullet> u \<ge> b"
     using separating_hyperplane_set_point_inaff [of "rel_interior S" x] assms
     by (auto simp: rel_interior_eq_empty convex_rel_interior)
   have le_ay: "a \<bullet> x \<le> a \<bullet> y" if "y \<in> S" for y
   proof -
     have con: "continuous_on (closure (rel_interior S)) ((\<bullet>) a)"
       by (rule continuous_intros continuous_on_subset | blast)+
     have y: "y \<in> closure (rel_interior S)"
       using \<open>convex S\<close> closure_def convex_closure_rel_interior \<open>y \<in> S\<close>
       by fastforce
     show ?thesis
       using continuous_ge_on_closure [OF con y] ageb \<open>a \<bullet> x \<le> b\<close>
       by fastforce
   qed
   have 3: "a \<bullet> x < a \<bullet> y" if "y \<in> rel_interior S" for y
   proof -
     obtain e where "0 < e" "y \<in> S" and e: "cball y e \<inter> affine hull S \<subseteq> S"
       using \<open>y \<in> rel_interior S\<close> by (force simp: rel_interior_cball)
     define y' where "y' = y - (e / norm a) *\<^sub>R ((x + a) - x)"
     have "y' \<in> cball y e"
       unfolding y'_def using \<open>0 < e\<close> by force
     moreover have "y' \<in> affine hull S"
       unfolding y'_def
       by (metis \<open>x \<in> S\<close> \<open>y \<in> S\<close> \<open>convex S\<close> aff affine_affine_hull hull_redundant
                 rel_interior_same_affine_hull hull_inc mem_affine_3_minus2)
     ultimately have "y' \<in> S"
       using e by auto
     have "a \<bullet> x \<le> a \<bullet> y"
       using le_ay \<open>a \<noteq> 0\<close> \<open>y \<in> S\<close> by blast
     moreover have "a \<bullet> x \<noteq> a \<bullet> y"
       using le_ay [OF \<open>y' \<in> S\<close>] \<open>a \<noteq> 0\<close>
       apply (simp add: y'_def inner_diff dot_square_norm power2_eq_square)
       by (metis \<open>0 < e\<close> add_le_same_cancel1 inner_commute inner_real_def inner_zero_left le_diff_eq norm_le_zero_iff real_mult_le_cancel_iff2)
     ultimately show ?thesis by force
   qed
   show ?thesis
     by (rule that [OF \<open>a \<noteq> 0\<close> le_ay 3])
 qed
 
 lemma supporting_hyperplane_relative_frontier:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "x \<in> closure S" "x \<notin> rel_interior S"
   obtains a where "a \<noteq> 0"
               and "\<And>y. y \<in> closure S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
 using supporting_hyperplane_rel_boundary [of "closure S" x]
 by (metis assms convex_closure convex_rel_interior_closure)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
 
 lemma
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
       and affine_hull_Int_subset: "affine hull s \<inter> affine hull t \<subseteq> affine hull (s \<inter> t)" (is ?A)
 proof -
   have [simp]: "finite s" "finite t"
     using aff_independent_finite assms by blast+
     have "sum u (s \<inter> t) = 1 \<and>
           (\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
       if [simp]:  "sum u s = 1"
                  "sum v t = 1"
          and eq: "(\<Sum>x\<in>t. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)" for u v
     proof -
     define f where "f x = (if x \<in> s then u x else 0) - (if x \<in> t then v x else 0)" for x
     have "sum f (s \<union> t) = 0"
       apply (simp add: f_def sum_Un sum_subtractf)
       apply (simp add: sum.inter_restrict [symmetric] Int_commute)
       done
     moreover have "(\<Sum>x\<in>(s \<union> t). f x *\<^sub>R x) = 0"
       apply (simp add: f_def sum_Un scaleR_left_diff_distrib sum_subtractf)
       apply (simp add: if_smult sum.inter_restrict [symmetric] Int_commute eq
           cong del: if_weak_cong)
       done
     ultimately have "\<And>v. v \<in> s \<union> t \<Longrightarrow> f v = 0"
       using aff_independent_finite assms unfolding affine_dependent_explicit
       by blast
     then have u [simp]: "\<And>x. x \<in> s \<Longrightarrow> u x = (if x \<in> t then v x else 0)"
       by (simp add: f_def) presburger
     have "sum u (s \<inter> t) = sum u s"
       by (simp add: sum.inter_restrict)
     then have "sum u (s \<inter> t) = 1"
       using that by linarith
     moreover have "(\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
       by (auto simp: if_smult sum.inter_restrict intro: sum.cong)
     ultimately show ?thesis
       by force
     qed
     then show ?A ?C
       by (auto simp: convex_hull_finite affine_hull_finite)
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_Int:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
 apply (rule subset_antisym)
 apply (simp add: hull_mono)
 by (simp add: affine_hull_Int_subset assms)
 
 proposition\<^marker>\<open>tag unimportant\<close> convex_hull_Int:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
 apply (rule subset_antisym)
 apply (simp add: hull_mono)
 by (simp add: convex_hull_Int_subset assms)
 
 proposition\<^marker>\<open>tag unimportant\<close>
   fixes s :: "'a::euclidean_space set set"
   assumes "\<not> affine_dependent (\<Union>s)"
     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
 proof -
   have "finite s"
     using aff_independent_finite assms finite_UnionD by blast
   then have "?A \<and> ?C" using assms
   proof (induction s rule: finite_induct)
     case empty then show ?case by auto
   next
     case (insert t F)
     then show ?case
     proof (cases "F={}")
       case True then show ?thesis by simp
     next
       case False
       with "insert.prems" have [simp]: "\<not> affine_dependent (t \<union> \<Inter>F)"
         by (auto intro: affine_dependent_subset)
       have [simp]: "\<not> affine_dependent (\<Union>F)"
         using affine_independent_subset insert.prems by fastforce
       show ?thesis
         by (simp add: affine_hull_Int convex_hull_Int insert.IH)
     qed
   qed
   then show "?A" "?C"
     by auto
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange_unique:
   fixes S :: "'a::euclidean_space set"
   assumes naff: "\<not> affine_dependent S" and a: "a \<in> convex hull S"
       and S: "T \<subseteq> S" "T' \<subseteq> S"
       and x:  "x \<in> convex hull (insert a T)"
       and x': "x \<in> convex hull (insert a T')"
     shows "x \<in> convex hull (insert a (T \<inter> T'))"
 proof (cases "a \<in> S")
   case True
   then have "\<not> affine_dependent (insert a T \<union> insert a T')"
     using affine_dependent_subset assms by auto
   then have "x \<in> convex hull (insert a T \<inter> insert a T')"
     by (metis IntI convex_hull_Int x x')
   then show ?thesis
     by simp
 next
   case False
   then have anot: "a \<notin> T" "a \<notin> T'"
     using assms by auto
   have [simp]: "finite S"
     by (simp add: aff_independent_finite assms)
   then obtain b where b0: "\<And>s. s \<in> S \<Longrightarrow> 0 \<le> b s"
                   and b1: "sum b S = 1" and aeq: "a = (\<Sum>s\<in>S. b s *\<^sub>R s)"
     using a by (auto simp: convex_hull_finite)
   have fin [simp]: "finite T" "finite T'"
     using assms infinite_super \<open>finite S\<close> by blast+
   then obtain c c' where c0: "\<And>t. t \<in> insert a T \<Longrightarrow> 0 \<le> c t"
                      and c1: "sum c (insert a T) = 1"
                      and xeq: "x = (\<Sum>t \<in> insert a T. c t *\<^sub>R t)"
                      and c'0: "\<And>t. t \<in> insert a T' \<Longrightarrow> 0 \<le> c' t"
                      and c'1: "sum c' (insert a T') = 1"
                      and x'eq: "x = (\<Sum>t \<in> insert a T'. c' t *\<^sub>R t)"
     using x x' by (auto simp: convex_hull_finite)
   with fin anot
   have sumTT': "sum c T = 1 - c a" "sum c' T' = 1 - c' a"
    and wsumT: "(\<Sum>t \<in> T. c t *\<^sub>R t) = x - c a *\<^sub>R a"
     by simp_all
   have wsumT': "(\<Sum>t \<in> T'. c' t *\<^sub>R t) = x - c' a *\<^sub>R a"
     using x'eq fin anot by simp
   define cc  where "cc \<equiv> \<lambda>x. if x \<in> T then c x else 0"
   define cc' where "cc' \<equiv> \<lambda>x. if x \<in> T' then c' x else 0"
   define dd  where "dd \<equiv> \<lambda>x. cc x - cc' x + (c a - c' a) * b x"
   have sumSS': "sum cc S = 1 - c a" "sum cc' S = 1 - c' a"
     unfolding cc_def cc'_def  using S
     by (simp_all add: Int_absorb1 Int_absorb2 sum_subtractf sum.inter_restrict [symmetric] sumTT')
   have wsumSS: "(\<Sum>t \<in> S. cc t *\<^sub>R t) = x - c a *\<^sub>R a" "(\<Sum>t \<in> S. cc' t *\<^sub>R t) = x - c' a *\<^sub>R a"
     unfolding cc_def cc'_def  using S
     by (simp_all add: Int_absorb1 Int_absorb2 if_smult sum.inter_restrict [symmetric] wsumT wsumT' cong: if_cong)
   have sum_dd0: "sum dd S = 0"
     unfolding dd_def  using S
     by (simp add: sumSS' comm_monoid_add_class.sum.distrib sum_subtractf
                   algebra_simps sum_distrib_right [symmetric] b1)
   have "(\<Sum>v\<in>S. (b v * x) *\<^sub>R v) = x *\<^sub>R (\<Sum>v\<in>S. b v *\<^sub>R v)" for x
     by (simp add: pth_5 real_vector.scale_sum_right mult.commute)
   then have *: "(\<Sum>v\<in>S. (b v * x) *\<^sub>R v) = x *\<^sub>R a" for x
     using aeq by blast
   have "(\<Sum>v \<in> S. dd v *\<^sub>R v) = 0"
     unfolding dd_def using S
     by (simp add: * wsumSS sum.distrib sum_subtractf algebra_simps)
   then have dd0: "dd v = 0" if "v \<in> S" for v
     using naff that \<open>finite S\<close> sum_dd0 unfolding affine_dependent_explicit
     apply (simp only: not_ex)
     apply (drule_tac x=S in spec)
     apply (drule_tac x=dd in spec, simp)
     done
   consider "c' a \<le> c a" | "c a \<le> c' a" by linarith
   then show ?thesis
   proof cases
     case 1
     then have "sum cc S \<le> sum cc' S"
       by (simp add: sumSS')
     then have le: "cc x \<le> cc' x" if "x \<in> S" for x
       using dd0 [OF that] 1 b0 mult_left_mono that
       by (fastforce simp add: dd_def algebra_simps)
     have cc0: "cc x = 0" if "x \<in> S" "x \<notin> T \<inter> T'" for x
       using le [OF \<open>x \<in> S\<close>] that c0
       by (force simp: cc_def cc'_def split: if_split_asm)
     show ?thesis
     proof (simp add: convex_hull_finite, intro exI conjI)
       show "\<forall>x\<in>T \<inter> T'. 0 \<le> (cc(a := c a)) x"
         by (simp add: c0 cc_def)
       show "0 \<le> (cc(a := c a)) a"
         by (simp add: c0)
       have "sum (cc(a := c a)) (insert a (T \<inter> T')) = c a + sum (cc(a := c a)) (T \<inter> T')"
         by (simp add: anot)
       also have "... = c a + sum (cc(a := c a)) S"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a + (1 - c a)"
         by (metis \<open>a \<notin> S\<close> fun_upd_other sum.cong sumSS')
       finally show "sum (cc(a := c a)) (insert a (T \<inter> T')) = 1"
         by simp
       have "(\<Sum>x\<in>insert a (T \<inter> T'). (cc(a := c a)) x *\<^sub>R x) = c a *\<^sub>R a + (\<Sum>x \<in> T \<inter> T'. (cc(a := c a)) x *\<^sub>R x)"
         by (simp add: anot)
       also have "... = c a *\<^sub>R a + (\<Sum>x \<in> S. (cc(a := c a)) x *\<^sub>R x)"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a *\<^sub>R a + x - c a *\<^sub>R a"
         by (simp add: wsumSS \<open>a \<notin> S\<close> if_smult sum_delta_notmem)
       finally show "(\<Sum>x\<in>insert a (T \<inter> T'). (cc(a := c a)) x *\<^sub>R x) = x"
         by simp
     qed
   next
     case 2
     then have "sum cc' S \<le> sum cc S"
       by (simp add: sumSS')
     then have le: "cc' x \<le> cc x" if "x \<in> S" for x
       using dd0 [OF that] 2 b0 mult_left_mono that
       by (fastforce simp add: dd_def algebra_simps)
     have cc0: "cc' x = 0" if "x \<in> S" "x \<notin> T \<inter> T'" for x
       using le [OF \<open>x \<in> S\<close>] that c'0
       by (force simp: cc_def cc'_def split: if_split_asm)
     show ?thesis
     proof (simp add: convex_hull_finite, intro exI conjI)
       show "\<forall>x\<in>T \<inter> T'. 0 \<le> (cc'(a := c' a)) x"
         by (simp add: c'0 cc'_def)
       show "0 \<le> (cc'(a := c' a)) a"
         by (simp add: c'0)
       have "sum (cc'(a := c' a)) (insert a (T \<inter> T')) = c' a + sum (cc'(a := c' a)) (T \<inter> T')"
         by (simp add: anot)
       also have "... = c' a + sum (cc'(a := c' a)) S"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c' a + (1 - c' a)"
         by (metis \<open>a \<notin> S\<close> fun_upd_other sum.cong sumSS')
       finally show "sum (cc'(a := c' a)) (insert a (T \<inter> T')) = 1"
         by simp
       have "(\<Sum>x\<in>insert a (T \<inter> T'). (cc'(a := c' a)) x *\<^sub>R x) = c' a *\<^sub>R a + (\<Sum>x \<in> T \<inter> T'. (cc'(a := c' a)) x *\<^sub>R x)"
         by (simp add: anot)
       also have "... = c' a *\<^sub>R a + (\<Sum>x \<in> S. (cc'(a := c' a)) x *\<^sub>R x)"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a *\<^sub>R a + x - c a *\<^sub>R a"
         by (simp add: wsumSS \<open>a \<notin> S\<close> if_smult sum_delta_notmem)
       finally show "(\<Sum>x\<in>insert a (T \<inter> T'). (cc'(a := c' a)) x *\<^sub>R x) = x"
         by simp
     qed
   qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> convex_hull_exchange_Int:
   fixes a  :: "'a::euclidean_space"
   assumes "\<not> affine_dependent S" "a \<in> convex hull S" "T \<subseteq> S" "T' \<subseteq> S"
   shows "(convex hull (insert a T)) \<inter> (convex hull (insert a T')) =
          convex hull (insert a (T \<inter> T'))"
 apply (rule subset_antisym)
   using in_convex_hull_exchange_unique assms apply blast
   by (metis hull_mono inf_le1 inf_le2 insert_inter_insert le_inf_iff)
 
 lemma Int_closed_segment:
   fixes b :: "'a::euclidean_space"
   assumes "b \<in> closed_segment a c \<or> \<not> collinear{a,b,c}"
     shows "closed_segment a b \<inter> closed_segment b c = {b}"
 proof (cases "c = a")
   case True
   then show ?thesis
     using assms collinear_3_eq_affine_dependent by fastforce
 next
   case False
   from assms show ?thesis
   proof
     assume "b \<in> closed_segment a c"
     moreover have "\<not> affine_dependent {a, c}"
       by (simp add: affine_independent_2)
     ultimately show ?thesis
       using False convex_hull_exchange_Int [of "{a,c}" b "{a}" "{c}"]
       by (simp add: segment_convex_hull insert_commute)
   next
     assume ncoll: "\<not> collinear {a, b, c}"
     have False if "closed_segment a b \<inter> closed_segment b c \<noteq> {b}"
     proof -
       have "b \<in> closed_segment a b" and "b \<in> closed_segment b c"
         by auto
       with that obtain d where "b \<noteq> d" "d \<in> closed_segment a b" "d \<in> closed_segment b c"
         by force
       then have d: "collinear {a, d, b}"  "collinear {b, d, c}"
         by (auto simp:  between_mem_segment between_imp_collinear)
       have "collinear {a, b, c}"
         apply (rule collinear_3_trans [OF _ _ \<open>b \<noteq> d\<close>])
         using d  by (auto simp: insert_commute)
       with ncoll show False ..
     qed
     then show ?thesis
       by blast
   qed
 qed
 
 lemma affine_hull_finite_intersection_hyperplanes:
   fixes s :: "'a::euclidean_space set"
   obtains f where
      "finite f"
      "of_nat (card f) + aff_dim s = DIM('a)"
      "affine hull s = \<Inter>f"
      "\<And>h. h \<in> f \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x = b}"
 proof -
   obtain b where "b \<subseteq> s"
              and indb: "\<not> affine_dependent b"
              and eq: "affine hull s = affine hull b"
     using affine_basis_exists by blast
   obtain c where indc: "\<not> affine_dependent c" and "b \<subseteq> c"
              and affc: "affine hull c = UNIV"
     by (metis extend_to_affine_basis affine_UNIV hull_same indb subset_UNIV)
   then have "finite c"
     by (simp add: aff_independent_finite)
   then have fbc: "finite b" "card b \<le> card c"
     using \<open>b \<subseteq> c\<close> infinite_super by (auto simp: card_mono)
   have imeq: "(\<lambda>x. affine hull x) ` ((\<lambda>a. c - {a}) ` (c - b)) = ((\<lambda>a. affine hull (c - {a})) ` (c - b))"
     by blast
   have card1: "card ((\<lambda>a. affine hull (c - {a})) ` (c - b)) = card (c - b)"
     apply (rule card_image [OF inj_onI])
     by (metis Diff_eq_empty_iff Diff_iff indc affine_dependent_def hull_subset insert_iff)
   have card2: "(card (c - b)) + aff_dim s = DIM('a)"
   proof -
     have aff: "aff_dim (UNIV::'a set) = aff_dim c"
       by (metis aff_dim_affine_hull affc)
     have "aff_dim b = aff_dim s"
       by (metis (no_types) aff_dim_affine_hull eq)
     then have "int (card b) = 1 + aff_dim s"
       by (simp add: aff_dim_affine_independent indb)
     then show ?thesis
       using fbc aff
       by (simp add: \<open>\<not> affine_dependent c\<close> \<open>b \<subseteq> c\<close> aff_dim_affine_independent aff_dim_UNIV card_Diff_subset of_nat_diff)
   qed
   show ?thesis
   proof (cases "c = b")
     case True show ?thesis
       apply (rule_tac f="{}" in that)
       using True affc
       apply (simp_all add: eq [symmetric])
       by (metis aff_dim_UNIV aff_dim_affine_hull)
   next
     case False
     have ind: "\<not> affine_dependent (\<Union>a\<in>c - b. c - {a})"
       by (rule affine_independent_subset [OF indc]) auto
     have affeq: "affine hull s = (\<Inter>x\<in>(\<lambda>a. c - {a}) ` (c - b). affine hull x)"
       using \<open>b \<subseteq> c\<close> False
       apply (subst affine_hull_Inter [OF ind, symmetric])
       apply (simp add: eq double_diff)
       done
     have *: "1 + aff_dim (c - {t}) = int (DIM('a))"
             if t: "t \<in> c" for t
     proof -
       have "insert t c = c"
         using t by blast
       then show ?thesis
         by (metis (full_types) add.commute aff_dim_affine_hull aff_dim_insert aff_dim_UNIV affc affine_dependent_def indc insert_Diff_single t)
     qed
     show ?thesis
       apply (rule_tac f = "(\<lambda>x. affine hull x) ` ((\<lambda>a. c - {a}) ` (c - b))" in that)
          using \<open>finite c\<close> apply blast
         apply (simp add: imeq card1 card2)
       apply (simp add: affeq, clarify)
       apply (metis DIM_positive One_nat_def Suc_leI add_diff_cancel_left' of_nat_1 aff_dim_eq_hyperplane of_nat_diff *)
       done
   qed
 qed
 
 lemma affine_hyperplane_sums_eq_UNIV_0:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
      and "0 \<in> S" and "w \<in> S"
      and "a \<bullet> w \<noteq> 0"
    shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV"
 proof -
   have "subspace S"
     by (simp add: assms subspace_affine)
   have span1: "span {y. a \<bullet> y = 0} \<subseteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     apply (rule span_mono)
     using \<open>0 \<in> S\<close> add.left_neutral by force
   have "w \<notin> span {y. a \<bullet> y = 0}"
     using \<open>a \<bullet> w \<noteq> 0\<close> span_induct subspace_hyperplane by auto
   moreover have "w \<in> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     using \<open>w \<in> S\<close>
     by (metis (mono_tags, lifting) inner_zero_right mem_Collect_eq pth_d span_base)
   ultimately have span2: "span {y. a \<bullet> y = 0} \<noteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     by blast
   have "a \<noteq> 0" using assms inner_zero_left by blast
   then have "DIM('a) - 1 = dim {y. a \<bullet> y = 0}"
     by (simp add: dim_hyperplane)
   also have "... < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     using span1 span2 by (blast intro: dim_psubset)
   finally have DIM_lt: "DIM('a) - 1 < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" .
   have subs: "subspace {x + y| x y. x \<in> S \<and> a \<bullet> y = 0}"
     using subspace_sums [OF \<open>subspace S\<close> subspace_hyperplane] by simp
   moreover have "span {x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV"
     apply (rule dim_eq_full [THEN iffD1])
     apply (rule antisym [OF dim_subset_UNIV])
     using DIM_lt apply simp
     done
   ultimately show ?thesis
     by (simp add: subs) (metis (lifting) span_eq_iff subs)
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hyperplane_sums_eq_UNIV:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
       and "S \<inter> {v. a \<bullet> v = b} \<noteq> {}"
       and "S - {v. a \<bullet> v = b} \<noteq> {}"
     shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
 proof (cases "a = 0")
   case True with assms show ?thesis
     by (auto simp: if_splits)
 next
   case False
   obtain c where "c \<in> S" and c: "a \<bullet> c = b"
     using assms by force
   with affine_diffs_subspace [OF \<open>affine S\<close>]
   have "subspace ((+) (- c) ` S)" by blast
   then have aff: "affine ((+) (- c) ` S)"
     by (simp add: subspace_imp_affine)
   have 0: "0 \<in> (+) (- c) ` S"
     by (simp add: \<open>c \<in> S\<close>)
   obtain d where "d \<in> S" and "a \<bullet> d \<noteq> b" and dc: "d-c \<in> (+) (- c) ` S"
     using assms by auto
   then have adc: "a \<bullet> (d - c) \<noteq> 0"
     by (simp add: c inner_diff_right)
   let ?U = "(+) (c+c) ` {x + y |x y. x \<in> (+) (- c) ` S \<and> a \<bullet> y = 0}"
   have "u + v \<in> (+) (c + c) ` {x + v |x v. x \<in> (+) (- c) ` S \<and> a \<bullet> v = 0}"
               if "u \<in> S" "b = a \<bullet> v" for u v
     apply (rule_tac x="u+v-c-c" in image_eqI)
     apply (simp_all add: algebra_simps)
     apply (rule_tac x="u-c" in exI)
     apply (rule_tac x="v-c" in exI)
     apply (simp add: algebra_simps that c)
     done
   moreover have "\<lbrakk>a \<bullet> v = 0; u \<in> S\<rbrakk>
        \<Longrightarrow> \<exists>x ya. v + (u + c) = x + ya \<and> x \<in> S \<and> a \<bullet> ya = b" for v u
     by (metis add.left_commute c inner_right_distrib pth_d)
   ultimately have "{x + y |x y. x \<in> S \<and> a \<bullet> y = b} = ?U"
     by (fastforce simp: algebra_simps)
   also have "... = range ((+) (c + c))"
     by (simp only: affine_hyperplane_sums_eq_UNIV_0 [OF aff 0 dc adc])
   also have "... = UNIV"
     by simp
   finally show ?thesis .
 qed
 
 lemma aff_dim_sums_Int_0:
   assumes "affine S"
       and "affine T"
       and "0 \<in> S" "0 \<in> T"
     shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)"
 proof -
   have "0 \<in> {x + y |x y. x \<in> S \<and> y \<in> T}"
     using assms by force
   then have 0: "0 \<in> affine hull {x + y |x y. x \<in> S \<and> y \<in> T}"
     by (metis (lifting) hull_inc)
   have sub: "subspace S"  "subspace T"
     using assms by (auto simp: subspace_affine)
   show ?thesis
     using dim_sums_Int [OF sub] by (simp add: aff_dim_zero assms 0 hull_inc)
 qed
 
 proposition aff_dim_sums_Int:
   assumes "affine S"
       and "affine T"
       and "S \<inter> T \<noteq> {}"
     shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)"
 proof -
   obtain a where a: "a \<in> S" "a \<in> T" using assms by force
   have aff: "affine ((+) (-a) ` S)"  "affine ((+) (-a) ` T)"
     using affine_translation [symmetric, of "- a"] assms by (simp_all cong: image_cong_simp)
   have zero: "0 \<in> ((+) (-a) ` S)"  "0 \<in> ((+) (-a) ` T)"
     using a assms by auto
   have "{x + y |x y. x \<in> (+) (- a) ` S \<and> y \<in> (+) (- a) ` T} =
       (+) (- 2 *\<^sub>R a) ` {x + y| x y. x \<in> S \<and> y \<in> T}"
     by (force simp: algebra_simps scaleR_2)
   moreover have "(+) (- a) ` S \<inter> (+) (- a) ` T = (+) (- a) ` (S \<inter> T)"
     by auto
   ultimately show ?thesis
     using aff_dim_sums_Int_0 [OF aff zero] aff_dim_translation_eq
     by (metis (lifting))
 qed
 
 lemma aff_dim_affine_Int_hyperplane:
   fixes a :: "'a::euclidean_space"
   assumes "affine S"
     shows "aff_dim(S \<inter> {x. a \<bullet> x = b}) =
              (if S \<inter> {v. a \<bullet> v = b} = {} then - 1
               else if S \<subseteq> {v. a \<bullet> v = b} then aff_dim S
               else aff_dim S - 1)"
 proof (cases "a = 0")
   case True with assms show ?thesis
     by auto
 next
   case False
   then have "aff_dim (S \<inter> {x. a \<bullet> x = b}) = aff_dim S - 1"
             if "x \<in> S" "a \<bullet> x \<noteq> b" and non: "S \<inter> {v. a \<bullet> v = b} \<noteq> {}" for x
   proof -
     have [simp]: "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
       using affine_hyperplane_sums_eq_UNIV [OF assms non] that  by blast
     show ?thesis
       using aff_dim_sums_Int [OF assms affine_hyperplane non]
       by (simp add: of_nat_diff False)
   qed
   then show ?thesis
     by (metis (mono_tags, lifting) inf.orderE aff_dim_empty_eq mem_Collect_eq subsetI)
 qed
 
 lemma aff_dim_lt_full:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S < DIM('a) \<longleftrightarrow> (affine hull S \<noteq> UNIV)"
 by (metis (no_types) aff_dim_affine_hull aff_dim_le_DIM aff_dim_UNIV affine_hull_UNIV less_le)
 
 lemma aff_dim_openin:
   fixes S :: "'a::euclidean_space set"
   assumes ope: "openin (top_of_set T) S" and "affine T" "S \<noteq> {}"
   shows "aff_dim S = aff_dim T"
 proof -
   show ?thesis
   proof (rule order_antisym)
     show "aff_dim S \<le> aff_dim T"
       by (blast intro: aff_dim_subset [OF openin_imp_subset] ope)
   next
     obtain a where "a \<in> S"
       using \<open>S \<noteq> {}\<close> by blast
     have "S \<subseteq> T"
       using ope openin_imp_subset by auto
     then have "a \<in> T"
       using \<open>a \<in> S\<close> by auto
     then have subT': "subspace ((\<lambda>x. - a + x) ` T)"
       using affine_diffs_subspace \<open>affine T\<close> by auto
     then obtain B where Bsub: "B \<subseteq> ((\<lambda>x. - a + x) ` T)" and po: "pairwise orthogonal B"
                     and eq1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1" and "independent B"
                     and cardB: "card B = dim ((\<lambda>x. - a + x) ` T)"
                     and spanB: "span B = ((\<lambda>x. - a + x) ` T)"
       by (rule orthonormal_basis_subspace) auto
     obtain e where "0 < e" and e: "cball a e \<inter> T \<subseteq> S"
       by (meson \<open>a \<in> S\<close> openin_contains_cball ope)
     have "aff_dim T = aff_dim ((\<lambda>x. - a + x) ` T)"
       by (metis aff_dim_translation_eq)
     also have "... = dim ((\<lambda>x. - a + x) ` T)"
       using aff_dim_subspace subT' by blast
     also have "... = card B"
       by (simp add: cardB)
     also have "... = card ((\<lambda>x. e *\<^sub>R x) ` B)"
       using \<open>0 < e\<close>  by (force simp: inj_on_def card_image)
     also have "... \<le> dim ((\<lambda>x. - a + x) ` S)"
     proof (simp, rule independent_card_le_dim)
       have e': "cball 0 e \<inter> (\<lambda>x. x - a) ` T \<subseteq> (\<lambda>x. x - a) ` S"
         using e by (auto simp: dist_norm norm_minus_commute subset_eq)
       have "(\<lambda>x. e *\<^sub>R x) ` B \<subseteq> cball 0 e \<inter> (\<lambda>x. x - a) ` T"
         using Bsub \<open>0 < e\<close> eq1 subT' \<open>a \<in> T\<close> by (auto simp: subspace_def)
       then show "(\<lambda>x. e *\<^sub>R x) ` B \<subseteq> (\<lambda>x. x - a) ` S"
         using e' by blast
       show "independent ((\<lambda>x. e *\<^sub>R x) ` B)"
         using linear_scale_self \<open>independent B\<close>
         apply (rule linear_independent_injective_image)
         using \<open>0 < e\<close> inj_on_def by fastforce
     qed
     also have "... = aff_dim S"
       using \<open>a \<in> S\<close> aff_dim_eq_dim hull_inc by (force cong: image_cong_simp)
     finally show "aff_dim T \<le> aff_dim S" .
   qed
 qed
 
 lemma dim_openin:
   fixes S :: "'a::euclidean_space set"
   assumes ope: "openin (top_of_set T) S" and "subspace T" "S \<noteq> {}"
   shows "dim S = dim T"
 proof (rule order_antisym)
   show "dim S \<le> dim T"
     by (metis ope dim_subset openin_subset topspace_euclidean_subtopology)
 next
   have "dim T = aff_dim S"
     using aff_dim_openin
     by (metis aff_dim_subspace \<open>subspace T\<close> \<open>S \<noteq> {}\<close> ope subspace_affine)
   also have "... \<le> dim S"
     by (metis aff_dim_subset aff_dim_subspace dim_span span_superset
         subspace_span)
   finally show "dim T \<le> dim S" by simp
 qed
 
 subsection\<open>Lower-dimensional affine subsets are nowhere dense\<close>
 
 proposition dense_complement_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes dim_less: "dim T < dim S" and "subspace S" shows "closure(S - T) = S"
 proof -
   have "closure(S - U) = S" if "dim U < dim S" "U \<subseteq> S" for U
   proof -
     have "span U \<subset> span S"
       by (metis neq_iff psubsetI span_eq_dim span_mono that)
     then obtain a where "a \<noteq> 0" "a \<in> span S" and a: "\<And>y. y \<in> span U \<Longrightarrow> orthogonal a y"
       using orthogonal_to_subspace_exists_gen by metis
     show ?thesis
     proof
       have "closed S"
         by (simp add: \<open>subspace S\<close> closed_subspace)
       then show "closure (S - U) \<subseteq> S"
         by (simp add: closure_minimal)
       show "S \<subseteq> closure (S - U)"
       proof (clarsimp simp: closure_approachable)
         fix x and e::real
         assume "x \<in> S" "0 < e"
         show "\<exists>y\<in>S - U. dist y x < e"
         proof (cases "x \<in> U")
           case True
           let ?y = "x + (e/2 / norm a) *\<^sub>R a"
           show ?thesis
           proof
             show "dist ?y x < e"
               using \<open>0 < e\<close> by (simp add: dist_norm)
           next
             have "?y \<in> S"
               by (metis \<open>a \<in> span S\<close> \<open>x \<in> S\<close> assms(2) span_eq_iff subspace_add subspace_scale)
             moreover have "?y \<notin> U"
             proof -
               have "e/2 / norm a \<noteq> 0"
                 using \<open>0 < e\<close> \<open>a \<noteq> 0\<close> by auto
               then show ?thesis
                 by (metis True \<open>a \<noteq> 0\<close> a orthogonal_scaleR orthogonal_self real_vector.scale_eq_0_iff span_add_eq span_base)
             qed
             ultimately show "?y \<in> S - U" by blast
           qed
         next
           case False
           with \<open>0 < e\<close> \<open>x \<in> S\<close> show ?thesis by force
         qed
       qed
     qed
   qed
   moreover have "S - S \<inter> T = S-T"
     by blast
   moreover have "dim (S \<inter> T) < dim S"
     by (metis dim_less dim_subset inf.cobounded2 inf.orderE inf.strict_boundedE not_le)
   ultimately show ?thesis
     by force
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_affine:
   fixes S :: "'a :: euclidean_space set"
   assumes less: "aff_dim T < aff_dim S" and "affine S" shows "closure(S - T) = S"
 proof (cases "S \<inter> T = {}")
   case True
   then show ?thesis
     by (metis Diff_triv affine_hull_eq \<open>affine S\<close> closure_same_affine_hull closure_subset hull_subset subset_antisym)
 next
   case False
   then obtain z where z: "z \<in> S \<inter> T" by blast
   then have "subspace ((+) (- z) ` S)"
     by (meson IntD1 affine_diffs_subspace \<open>affine S\<close>)
   moreover have "int (dim ((+) (- z) ` T)) < int (dim ((+) (- z) ` S))"
 thm aff_dim_eq_dim
     using z less by (simp add: aff_dim_eq_dim_subtract [of z] hull_inc cong: image_cong_simp)
   ultimately have "closure(((+) (- z) ` S) - ((+) (- z) ` T)) = ((+) (- z) ` S)"
     by (simp add: dense_complement_subspace)
   then show ?thesis
     by (metis closure_translation translation_diff translation_invert)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_openin_affine_hull:
   fixes S :: "'a :: euclidean_space set"
   assumes less: "aff_dim T < aff_dim S"
       and ope: "openin (top_of_set (affine hull S)) S"
     shows "closure(S - T) = closure S"
 proof -
   have "affine hull S - T \<subseteq> affine hull S"
     by blast
   then have "closure (S \<inter> closure (affine hull S - T)) = closure (S \<inter> (affine hull S - T))"
     by (rule closure_openin_Int_closure [OF ope])
   then show ?thesis
     by (metis Int_Diff aff_dim_affine_hull affine_affine_hull dense_complement_affine hull_subset inf.orderE less)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex:
   fixes S :: "'a :: euclidean_space set"
   assumes "aff_dim T < aff_dim S" "convex S"
     shows "closure(S - T) = closure S"
 proof
   show "closure (S - T) \<subseteq> closure S"
     by (simp add: closure_mono)
   have "closure (rel_interior S - T) = closure (rel_interior S)"
     apply (rule dense_complement_openin_affine_hull)
     apply (simp add: assms rel_interior_aff_dim)
     using \<open>convex S\<close> rel_interior_rel_open rel_open by blast
   then show "closure S \<subseteq> closure (S - T)"
     by (metis Diff_mono \<open>convex S\<close> closure_mono convex_closure_rel_interior order_refl rel_interior_subset)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes "aff_dim T < aff_dim S" "convex S" "closed S"
     shows "closure(S - T) = S"
   by (simp add: assms dense_complement_convex)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Parallel slices, etc\<close>
 
 text\<open> If we take a slice out of a set, we can do it perpendicularly,
   with the normal vector to the slice parallel to the affine hull.\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_parallel_slice:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
       and "S \<inter> {x. a \<bullet> x \<le> b} \<noteq> {}"
       and "\<not> (S \<subseteq> {x. a \<bullet> x \<le> b})"
   obtains a' b' where "a' \<noteq> 0"
                    "S \<inter> {x. a' \<bullet> x \<le> b'} = S \<inter> {x. a \<bullet> x \<le> b}"
                    "S \<inter> {x. a' \<bullet> x = b'} = S \<inter> {x. a \<bullet> x = b}"
                    "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S"
 proof (cases "S \<inter> {x. a \<bullet> x = b} = {}")
   case True
   then obtain u v where "u \<in> S" "v \<in> S" "a \<bullet> u \<le> b" "a \<bullet> v > b"
     using assms by (auto simp: not_le)
   define \<eta> where "\<eta> = u + ((b - a \<bullet> u) / (a \<bullet> v - a \<bullet> u)) *\<^sub>R (v - u)"
   have "\<eta> \<in> S"
     by (simp add: \<eta>_def \<open>u \<in> S\<close> \<open>v \<in> S\<close> \<open>affine S\<close> mem_affine_3_minus)
   moreover have "a \<bullet> \<eta> = b"
     using \<open>a \<bullet> u \<le> b\<close> \<open>b < a \<bullet> v\<close>
     by (simp add: \<eta>_def algebra_simps) (simp add: field_simps)
   ultimately have False
     using True by force
   then show ?thesis ..
 next
   case False
   then obtain z where "z \<in> S" and z: "a \<bullet> z = b"
     using assms by auto
   with affine_diffs_subspace [OF \<open>affine S\<close>]
   have sub: "subspace ((+) (- z) ` S)" by blast
   then have aff: "affine ((+) (- z) ` S)" and span: "span ((+) (- z) ` S) = ((+) (- z) ` S)"
     by (auto simp: subspace_imp_affine)
   obtain a' a'' where a': "a' \<in> span ((+) (- z) ` S)" and a: "a = a' + a''"
                   and "\<And>w. w \<in> span ((+) (- z) ` S) \<Longrightarrow> orthogonal a'' w"
     using orthogonal_subspace_decomp_exists [of "(+) (- z) ` S" "a"] by metis
   then have "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> (w-z) = 0"
     by (simp add: span_base orthogonal_def)
   then have a'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = (a - a') \<bullet> z"
     by (simp add: a inner_diff_right)
   then have ba'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = b - a' \<bullet> z"
     by (simp add: inner_diff_left z)
   have "\<And>w. w \<in> (+) (- z) ` S \<Longrightarrow> (w + a') \<in> (+) (- z) ` S"
     by (metis subspace_add a' span_eq_iff sub)
   then have Sclo: "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S"
     by fastforce
   show ?thesis
   proof (cases "a' = 0")
     case True
     with a assms True a'' diff_zero less_irrefl show ?thesis
       by auto
   next
     case False
     show ?thesis
       apply (rule_tac a' = "a'" and b' = "a' \<bullet> z" in that)
       apply (auto simp: a ba'' inner_left_distrib False Sclo)
       done
   qed
 qed
 
 lemma diffs_affine_hull_span:
   assumes "a \<in> S"
     shows "{x - a |x. x \<in> affine hull S} = span {x - a |x. x \<in> S}"
 proof -
   have *: "((\<lambda>x. x - a) ` (S - {a})) = {x. x + a \<in> S} - {0}"
     by (auto simp: algebra_simps)
   show ?thesis
     apply (simp add: affine_hull_span2 [OF assms] *)
     apply (auto simp: algebra_simps)
     done
 qed
 
 lemma aff_dim_dim_affine_diffs:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S" "a \<in> S"
     shows "aff_dim S = dim {x - a |x. x \<in> S}"
 proof -
   obtain B where aff: "affine hull B = affine hull S"
              and ind: "\<not> affine_dependent B"
              and card: "of_nat (card B) = aff_dim S + 1"
     using aff_dim_basis_exists by blast
   then have "B \<noteq> {}" using assms
     by (metis affine_hull_eq_empty ex_in_conv)
   then obtain c where "c \<in> B" by auto
   then have "c \<in> S"
     by (metis aff affine_hull_eq \<open>affine S\<close> hull_inc)
   have xy: "x - c = y - a \<longleftrightarrow> y = x + 1 *\<^sub>R (a - c)" for x y c and a::'a
     by (auto simp: algebra_simps)
   have *: "{x - c |x. x \<in> S} = {x - a |x. x \<in> S}"
     apply safe
     apply (simp_all only: xy)
     using mem_affine_3_minus [OF \<open>affine S\<close>] \<open>a \<in> S\<close> \<open>c \<in> S\<close> apply blast+
     done
   have affS: "affine hull S = S"
     by (simp add: \<open>affine S\<close>)
   have "aff_dim S = of_nat (card B) - 1"
     using card by simp
   also have "... = dim {x - c |x. x \<in> B}"
     by (simp add: affine_independent_card_dim_diffs [OF ind \<open>c \<in> B\<close>])
   also have "... = dim {x - c | x. x \<in> affine hull B}"
      by (simp add: diffs_affine_hull_span \<open>c \<in> B\<close> dim_span)
   also have "... = dim {x - a |x. x \<in> S}"
      by (simp add: affS aff *)
    finally show ?thesis .
 qed
 
 lemma aff_dim_linear_image_le:
   assumes "linear f"
     shows "aff_dim(f ` S) \<le> aff_dim S"
 proof -
   have "aff_dim (f ` T) \<le> aff_dim T" if "affine T" for T
   proof (cases "T = {}")
     case True then show ?thesis by (simp add: aff_dim_geq)
   next
     case False
     then obtain a where "a \<in> T" by auto
     have 1: "((\<lambda>x. x - f a) ` f ` T) = {x - f a |x. x \<in> f ` T}"
       by auto
     have 2: "{x - f a| x. x \<in> f ` T} = f ` {x - a| x. x \<in> T}"
       by (force simp: linear_diff [OF assms])
     have "aff_dim (f ` T) = int (dim {x - f a |x. x \<in> f ` T})"
       by (simp add: \<open>a \<in> T\<close> hull_inc aff_dim_eq_dim [of "f a"] 1 cong: image_cong_simp)
     also have "... = int (dim (f ` {x - a| x. x \<in> T}))"
       by (force simp: linear_diff [OF assms] 2)
     also have "... \<le> int (dim {x - a| x. x \<in> T})"
       by (simp add: dim_image_le [OF assms])
     also have "... \<le> aff_dim T"
       by (simp add: aff_dim_dim_affine_diffs [symmetric] \<open>a \<in> T\<close> \<open>affine T\<close>)
     finally show ?thesis .
   qed
   then
   have "aff_dim (f ` (affine hull S)) \<le> aff_dim (affine hull S)"
     using affine_affine_hull [of S] by blast
   then show ?thesis
     using affine_hull_linear_image assms linear_conv_bounded_linear by fastforce
 qed
 
 lemma aff_dim_injective_linear_image [simp]:
   assumes "linear f" "inj f"
     shows "aff_dim (f ` S) = aff_dim S"
 proof (rule antisym)
   show "aff_dim (f ` S) \<le> aff_dim S"
     by (simp add: aff_dim_linear_image_le assms(1))
 next
   obtain g where "linear g" "g \<circ> f = id"
     using assms(1) assms(2) linear_injective_left_inverse by blast
   then have "aff_dim S \<le> aff_dim(g ` f ` S)"
     by (simp add: image_comp)
   also have "... \<le> aff_dim (f ` S)"
     by (simp add: \<open>linear g\<close> aff_dim_linear_image_le)
   finally show "aff_dim S \<le> aff_dim (f ` S)" .
 qed
 
 
 lemma choose_affine_subset:
   assumes "affine S" "-1 \<le> d" and dle: "d \<le> aff_dim S"
   obtains T where "affine T" "T \<subseteq> S" "aff_dim T = d"
 proof (cases "d = -1 \<or> S={}")
   case True with assms show ?thesis
     by (metis aff_dim_empty affine_empty bot.extremum that eq_iff)
 next
   case False
   with assms obtain a where "a \<in> S" "0 \<le> d" by auto
   with assms have ss: "subspace ((+) (- a) ` S)"
     by (simp add: affine_diffs_subspace_subtract cong: image_cong_simp)
   have "nat d \<le> dim ((+) (- a) ` S)"
     by (metis aff_dim_subspace aff_dim_translation_eq dle nat_int nat_mono ss)
   then obtain T where "subspace T" and Tsb: "T \<subseteq> span ((+) (- a) ` S)"
                   and Tdim: "dim T = nat d"
     using choose_subspace_of_subspace [of "nat d" "(+) (- a) ` S"] by blast
   then have "affine T"
     using subspace_affine by blast
   then have "affine ((+) a ` T)"
     by (metis affine_hull_eq affine_hull_translation)
   moreover have "(+) a ` T \<subseteq> S"
   proof -
     have "T \<subseteq> (+) (- a) ` S"
       by (metis (no_types) span_eq_iff Tsb ss)
     then show "(+) a ` T \<subseteq> S"
       using add_ac by auto
   qed
   moreover have "aff_dim ((+) a ` T) = d"
     by (simp add: aff_dim_subspace Tdim \<open>0 \<le> d\<close> \<open>subspace T\<close> aff_dim_translation_eq)
   ultimately show ?thesis
     by (rule that)
 qed
 
 subsection\<open>Paracompactness\<close>
 
 proposition paracompact:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes "S \<subseteq> \<Union>\<C>" and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
   obtains \<C>' where "S \<subseteq> \<Union> \<C>'"
                and "\<And>U. U \<in> \<C>' \<Longrightarrow> open U \<and> (\<exists>T. T \<in> \<C> \<and> U \<subseteq> T)"
                and "\<And>x. x \<in> S
                        \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
 proof (cases "S = {}")
   case True with that show ?thesis by blast
 next
   case False
   have "\<exists>T U. x \<in> U \<and> open U \<and> closure U \<subseteq> T \<and> T \<in> \<C>" if "x \<in> S" for x
   proof -
     obtain T where "x \<in> T" "T \<in> \<C>" "open T"
       using assms \<open>x \<in> S\<close> by blast
     then obtain e where "e > 0" "cball x e \<subseteq> T"
       by (force simp: open_contains_cball)
     then show ?thesis
       apply (rule_tac x = T in exI)
       apply (rule_tac x = "ball x e" in exI)
       using  \<open>T \<in> \<C>\<close>
       apply (simp add: closure_minimal)
       using closed_cball closure_minimal by blast
   qed
   then obtain F G where Gin: "x \<in> G x" and oG: "open (G x)"
                     and clos: "closure (G x) \<subseteq> F x" and Fin: "F x \<in> \<C>"
          if "x \<in> S" for x
     by metis
   then obtain \<F> where "\<F> \<subseteq> G ` S" "countable \<F>" "\<Union>\<F> = \<Union>(G ` S)"
     using Lindelof [of "G ` S"] by (metis image_iff)
   then obtain K where K: "K \<subseteq> S" "countable K" and eq: "\<Union>(G ` K) = \<Union>(G ` S)"
     by (metis countable_subset_image)
   with False Gin have "K \<noteq> {}" by force
   then obtain a :: "nat \<Rightarrow> 'a" where "range a = K"
     by (metis range_from_nat_into \<open>countable K\<close>)
   then have odif: "\<And>n. open (F (a n) - \<Union>{closure (G (a m)) |m. m < n})"
     using \<open>K \<subseteq> S\<close> Fin opC by (fastforce simp add:)
   let ?C = "range (\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n})"
   have enum_S: "\<exists>n. x \<in> F(a n) \<and> x \<in> G(a n)" if "x \<in> S" for x
   proof -
     have "\<exists>y \<in> K. x \<in> G y" using eq that Gin by fastforce
     then show ?thesis
       using clos K \<open>range a = K\<close> closure_subset by blast
   qed
   have 1: "S \<subseteq> Union ?C"
   proof
     fix x assume "x \<in> S"
     define n where "n \<equiv> LEAST n. x \<in> F(a n)"
     have n: "x \<in> F(a n)"
       using enum_S [OF \<open>x \<in> S\<close>] by (force simp: n_def intro: LeastI)
     have notn: "x \<notin> F(a m)" if "m < n" for m
       using that not_less_Least by (force simp: n_def)
     then have "x \<notin> \<Union>{closure (G (a m)) |m. m < n}"
       using n \<open>K \<subseteq> S\<close> \<open>range a = K\<close> clos notn by fastforce
     with n show "x \<in> Union ?C"
       by blast
   qed
   have 3: "\<exists>V. open V \<and> x \<in> V \<and> finite {U. U \<in> ?C \<and> (U \<inter> V \<noteq> {})}" if "x \<in> S" for x
   proof -
     obtain n where n: "x \<in> F(a n)" "x \<in> G(a n)"
       using \<open>x \<in> S\<close> enum_S by auto
     have "{U \<in> ?C. U \<inter> G (a n) \<noteq> {}} \<subseteq> (\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n}) ` atMost n"
     proof clarsimp
       fix k  assume "(F (a k) - \<Union>{closure (G (a m)) |m. m < k}) \<inter> G (a n) \<noteq> {}"
       then have "k \<le> n"
         by auto (metis closure_subset not_le subsetCE)
       then show "F (a k) - \<Union>{closure (G (a m)) |m. m < k}
                  \<in> (\<lambda>n. F (a n) - \<Union>{closure (G (a m)) |m. m < n}) ` {..n}"
         by force
     qed
     moreover have "finite ((\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n}) ` atMost n)"
       by force
     ultimately have *: "finite {U \<in> ?C. U \<inter> G (a n) \<noteq> {}}"
       using finite_subset by blast
     show ?thesis
       apply (rule_tac x="G (a n)" in exI)
       apply (intro conjI oG n *)
       using \<open>K \<subseteq> S\<close> \<open>range a = K\<close> apply blast
       done
   qed
   show ?thesis
     apply (rule that [OF 1 _ 3])
     using Fin \<open>K \<subseteq> S\<close> \<open>range a = K\<close>  apply (auto simp: odif)
     done
 qed
 
 corollary paracompact_closedin:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes cin: "closedin (top_of_set U) S"
       and oin: "\<And>T. T \<in> \<C> \<Longrightarrow> openin (top_of_set U) T"
       and "S \<subseteq> \<Union>\<C>"
   obtains \<C>' where "S \<subseteq> \<Union> \<C>'"
                and "\<And>V. V \<in> \<C>' \<Longrightarrow> openin (top_of_set U) V \<and> (\<exists>T. T \<in> \<C> \<and> V \<subseteq> T)"
                and "\<And>x. x \<in> U
                        \<Longrightarrow> \<exists>V. openin (top_of_set U) V \<and> x \<in> V \<and>
                                finite {X. X \<in> \<C>' \<and> (X \<inter> V \<noteq> {})}"
 proof -
   have "\<exists>Z. open Z \<and> (T = U \<inter> Z)" if "T \<in> \<C>" for T
     using oin [OF that] by (auto simp: openin_open)
   then obtain F where opF: "open (F T)" and intF: "U \<inter> F T = T" if "T \<in> \<C>" for T
     by metis
   obtain K where K: "closed K" "U \<inter> K = S"
     using cin by (auto simp: closedin_closed)
   have 1: "U \<subseteq> \<Union>(insert (- K) (F ` \<C>))"
     by clarsimp (metis Int_iff Union_iff \<open>U \<inter> K = S\<close> \<open>S \<subseteq> \<Union>\<C>\<close> subsetD intF)
   have 2: "\<And>T. T \<in> insert (- K) (F ` \<C>) \<Longrightarrow> open T"
     using \<open>closed K\<close> by (auto simp: opF)
   obtain \<D> where "U \<subseteq> \<Union>\<D>"
              and D1: "\<And>U. U \<in> \<D> \<Longrightarrow> open U \<and> (\<exists>T. T \<in> insert (- K) (F ` \<C>) \<and> U \<subseteq> T)"
              and D2: "\<And>x. x \<in> U \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<D>. U \<inter> V \<noteq> {}}"
     by (blast intro: paracompact [OF 1 2])
   let ?C = "{U \<inter> V |V. V \<in> \<D> \<and> (V \<inter> K \<noteq> {})}"
   show ?thesis
   proof (rule_tac \<C>' = "{U \<inter> V |V. V \<in> \<D> \<and> (V \<inter> K \<noteq> {})}" in that)
     show "S \<subseteq> \<Union>?C"
       using \<open>U \<inter> K = S\<close> \<open>U \<subseteq> \<Union>\<D>\<close> K by (blast dest!: subsetD)
     show "\<And>V. V \<in> ?C \<Longrightarrow> openin (top_of_set U) V \<and> (\<exists>T. T \<in> \<C> \<and> V \<subseteq> T)"
       using D1 intF by fastforce
     have *: "{X. (\<exists>V. X = U \<inter> V \<and> V \<in> \<D> \<and> V \<inter> K \<noteq> {}) \<and> X \<inter> (U \<inter> V) \<noteq> {}} \<subseteq>
              (\<lambda>x. U \<inter> x) ` {U \<in> \<D>. U \<inter> V \<noteq> {}}" for V
       by blast
     show "\<exists>V. openin (top_of_set U) V \<and> x \<in> V \<and> finite {X \<in> ?C. X \<inter> V \<noteq> {}}"
          if "x \<in> U" for x
       using D2 [OF that]
       apply clarify
       apply (rule_tac x="U \<inter> V" in exI)
       apply (auto intro: that finite_subset [OF *])
       done
     qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> paracompact_closed:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes "closed S"
       and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
       and "S \<subseteq> \<Union>\<C>"
   obtains \<C>' where "S \<subseteq> \<Union>\<C>'"
                and "\<And>U. U \<in> \<C>' \<Longrightarrow> open U \<and> (\<exists>T. T \<in> \<C> \<and> U \<subseteq> T)"
                and "\<And>x. \<exists>V. open V \<and> x \<in> V \<and>
                                finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
   by (rule paracompact_closedin [of UNIV S \<C>]) (auto simp: assms)
 
   
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed-graph characterization of continuity\<close>
 
 lemma continuous_closed_graph_gen:
   fixes T :: "'b::real_normed_vector set"
   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
     shows "closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
 proof -
   have eq: "((\<lambda>x. Pair x (f x)) ` S) =(S \<times> T \<inter> (\<lambda>z. (f \<circ> fst)z - snd z) -` {0})"
     using fim by auto
   show ?thesis
     apply (subst eq)
     apply (intro continuous_intros continuous_closedin_preimage continuous_on_subset [OF contf])
     by auto
 qed
 
 lemma continuous_closed_graph_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact T" and fim: "f ` S \<subseteq> T"
   shows "continuous_on S f \<longleftrightarrow>
          closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
          (is "?lhs = ?rhs")
 proof -
   have "?lhs" if ?rhs
   proof (clarsimp simp add: continuous_on_closed_gen [OF fim])
     fix U
     assume U: "closedin (top_of_set T) U"
     have eq: "(S \<inter> f -` U) = fst ` (((\<lambda>x. Pair x (f x)) ` S) \<inter> (S \<times> U))"
       by (force simp: image_iff)
     show "closedin (top_of_set S) (S \<inter> f -` U)"
       by (simp add: U closedin_Int closedin_Times closed_map_fst [OF \<open>compact T\<close>] that eq)
   qed
   with continuous_closed_graph_gen assms show ?thesis by blast
 qed
 
 lemma continuous_closed_graph:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "closed S" and contf: "continuous_on S f"
   shows "closed ((\<lambda>x. Pair x (f x)) ` S)"
   apply (rule closedin_closed_trans)
    apply (rule continuous_closed_graph_gen [OF contf subset_UNIV])
   by (simp add: \<open>closed S\<close> closed_Times)
 
 lemma continuous_from_closed_graph:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact T" and fim: "f ` S \<subseteq> T" and clo: "closed ((\<lambda>x. Pair x (f x)) ` S)"
   shows "continuous_on S f"
     using fim clo
     by (auto intro: closed_subset simp: continuous_closed_graph_eq [OF \<open>compact T\<close> fim])
 
 lemma continuous_on_Un_local_open:
   assumes opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
       and contf: "continuous_on S f" and contg: "continuous_on T f"
     shows "continuous_on (S \<union> T) f"
   using pasting_lemma [of "{S,T}" "top_of_set (S \<union> T)" id euclidean "\<lambda>i. f" f] contf contg opS opT
   by (simp add: subtopology_subtopology) (metis inf.absorb2 openin_imp_subset)  
 
 lemma continuous_on_cases_local_open:
   assumes opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
       and contf: "continuous_on S f" and contg: "continuous_on T g"
       and fg: "\<And>x. x \<in> S \<and> \<not>P x \<or> x \<in> T \<and> P x \<Longrightarrow> f x = g x"
     shows "continuous_on (S \<union> T) (\<lambda>x. if P x then f x else g x)"
 proof -
   have "\<And>x. x \<in> S \<Longrightarrow> (if P x then f x else g x) = f x"  "\<And>x. x \<in> T \<Longrightarrow> (if P x then f x else g x) = g x"
     by (simp_all add: fg)
   then have "continuous_on S (\<lambda>x. if P x then f x else g x)" "continuous_on T (\<lambda>x. if P x then f x else g x)"
     by (simp_all add: contf contg cong: continuous_on_cong)
   then show ?thesis
     by (rule continuous_on_Un_local_open [OF opS opT])
 qed
 
 lemma continuous_map_cases_le:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<le> q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 lemma continuous_map_cases_lt:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x < q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0<..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0<..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0<..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The union of two collinear segments is another segment\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange:
   fixes a :: "'a::euclidean_space"
   assumes a: "a \<in> convex hull S" and xS: "x \<in> convex hull S"
   obtains b where "b \<in> S" "x \<in> convex hull (insert a (S - {b}))"
 proof (cases "a \<in> S")
   case True
   with xS insert_Diff that  show ?thesis by fastforce
 next
   case False
   show ?thesis
   proof (cases "finite S \<and> card S \<le> Suc (DIM('a))")
     case True
     then obtain u where u0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> u i" and u1: "sum u S = 1"
                     and ua: "(\<Sum>i\<in>S. u i *\<^sub>R i) = a"
         using a by (auto simp: convex_hull_finite)
     obtain v where v0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> v i" and v1: "sum v S = 1"
                and vx: "(\<Sum>i\<in>S. v i *\<^sub>R i) = x"
       using True xS by (auto simp: convex_hull_finite)
     show ?thesis
     proof (cases "\<exists>b. b \<in> S \<and> v b = 0")
       case True
       then obtain b where b: "b \<in> S" "v b = 0"
         by blast
       show ?thesis
       proof
         have fin: "finite (insert a (S - {b}))"
           using sum.infinite v1 by fastforce
         show "x \<in> convex hull insert a (S - {b})"
           unfolding convex_hull_finite [OF fin] mem_Collect_eq
         proof (intro conjI exI ballI)
           have "(\<Sum>x \<in> insert a (S - {b}). if x = a then 0 else v x) =
                 (\<Sum>x \<in> S - {b}. if x = a then 0 else v x)"
             apply (rule sum.mono_neutral_right)
             using fin by auto
           also have "... = (\<Sum>x \<in> S - {b}. v x)"
             using b False by (auto intro!: sum.cong split: if_split_asm)
           also have "... = (\<Sum>x\<in>S. v x)"
             by (metis \<open>v b = 0\<close> diff_zero sum.infinite sum_diff1 u1 zero_neq_one)
           finally show "(\<Sum>x\<in>insert a (S - {b}). if x = a then 0 else v x) = 1"
             by (simp add: v1)
           show "\<And>x. x \<in> insert a (S - {b}) \<Longrightarrow> 0 \<le> (if x = a then 0 else v x)"
             by (auto simp: v0)
           have "(\<Sum>x \<in> insert a (S - {b}). (if x = a then 0 else v x) *\<^sub>R x) =
                 (\<Sum>x \<in> S - {b}. (if x = a then 0 else v x) *\<^sub>R x)"
             apply (rule sum.mono_neutral_right)
             using fin by auto
           also have "... = (\<Sum>x \<in> S - {b}. v x *\<^sub>R x)"
             using b False by (auto intro!: sum.cong split: if_split_asm)
           also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
             by (metis (no_types, lifting) b(2) diff_zero fin finite.emptyI finite_Diff2 finite_insert scale_eq_0_iff sum_diff1)
           finally show "(\<Sum>x\<in>insert a (S - {b}). (if x = a then 0 else v x) *\<^sub>R x) = x"
             by (simp add: vx)
         qed
       qed (rule \<open>b \<in> S\<close>)
     next
       case False
       have le_Max: "u i / v i \<le> Max ((\<lambda>i. u i / v i) ` S)" if "i \<in> S" for i
         by (simp add: True that)
       have "Max ((\<lambda>i. u i / v i) ` S) \<in> (\<lambda>i. u i / v i) ` S"
         using True v1 by (auto intro: Max_in)
       then obtain b where "b \<in> S" and beq: "Max ((\<lambda>b. u b / v b) ` S) = u b / v b"
         by blast
       then have "0 \<noteq> u b / v b"
         using le_Max beq divide_le_0_iff le_numeral_extra(2) sum_nonpos u1
         by (metis False eq_iff v0)
       then have  "0 < u b" "0 < v b"
         using False \<open>b \<in> S\<close> u0 v0 by force+
       have fin: "finite (insert a (S - {b}))"
         using sum.infinite v1 by fastforce
       show ?thesis
       proof
         show "x \<in> convex hull insert a (S - {b})"
           unfolding convex_hull_finite [OF fin] mem_Collect_eq
         proof (intro conjI exI ballI)
           have "(\<Sum>x \<in> insert a (S - {b}). if x=a then v b / u b else v x - (v b / u b) * u x) =
                 v b / u b + (\<Sum>x \<in> S - {b}. v x - (v b / u b) * u x)"
             using \<open>a \<notin> S\<close> \<open>b \<in> S\<close> True  apply simp
             apply (rule sum.cong, auto)
             done
           also have "... = v b / u b + (\<Sum>x \<in> S - {b}. v x) - (v b / u b) * (\<Sum>x \<in> S - {b}. u x)"
             by (simp add: Groups_Big.sum_subtractf sum_distrib_left)
           also have "... = (\<Sum>x\<in>S. v x)"
             using \<open>0 < u b\<close> True  by (simp add: Groups_Big.sum_diff1 u1 field_simps)
           finally show "sum (\<lambda>x. if x=a then v b / u b else v x - (v b / u b) * u x) (insert a (S - {b})) = 1"
             by (simp add: v1)
           show "0 \<le> (if i = a then v b / u b else v i - v b / u b * u i)"
             if "i \<in> insert a (S - {b})" for i
             using \<open>0 < u b\<close> \<open>0 < v b\<close> v0 [of i] le_Max [of i] beq that False
             by (auto simp: field_simps split: if_split_asm)
           have "(\<Sum>x\<in>insert a (S - {b}). (if x=a then v b / u b else v x - v b / u b * u x) *\<^sub>R x) =
                 (v b / u b) *\<^sub>R a + (\<Sum>x\<in>S - {b}. (v x - v b / u b * u x) *\<^sub>R x)"
             using \<open>a \<notin> S\<close> \<open>b \<in> S\<close> True  apply simp
             apply (rule sum.cong, auto)
             done
           also have "... = (v b / u b) *\<^sub>R a + (\<Sum>x \<in> S - {b}. v x *\<^sub>R x) - (v b / u b) *\<^sub>R (\<Sum>x \<in> S - {b}. u x *\<^sub>R x)"
             by (simp add: Groups_Big.sum_subtractf scaleR_left_diff_distrib sum_distrib_left scale_sum_right)
           also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
             using \<open>0 < u b\<close> True  by (simp add: ua vx Groups_Big.sum_diff1 algebra_simps)
           finally
           show "(\<Sum>x\<in>insert a (S - {b}). (if x=a then v b / u b else v x - v b / u b * u x) *\<^sub>R x) = x"
             by (simp add: vx)
         qed
       qed (rule \<open>b \<in> S\<close>)
     qed
   next
     case False
     obtain T where "finite T" "T \<subseteq> S" and caT: "card T \<le> Suc (DIM('a))" and xT: "x \<in> convex hull T"
       using xS by (auto simp: caratheodory [of S])
     with False obtain b where b: "b \<in> S" "b \<notin> T"
       by (metis antisym subsetI)
     show ?thesis
     proof
       show "x \<in> convex hull insert a (S - {b})"
         using  \<open>T \<subseteq> S\<close> b by (blast intro: subsetD [OF hull_mono xT])
     qed (rule \<open>b \<in> S\<close>)
   qed
 qed
 
 lemma convex_hull_exchange_Union:
   fixes a :: "'a::euclidean_space"
   assumes "a \<in> convex hull S"
   shows "convex hull S = (\<Union>b \<in> S. convex hull (insert a (S - {b})))" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (blast intro: in_convex_hull_exchange [OF assms])
   show "?rhs \<subseteq> ?lhs"
   proof clarify
     fix x b
     assume"b \<in> S" "x \<in> convex hull insert a (S - {b})"
     then show "x \<in> convex hull S" if "b \<in> S"
       by (metis (no_types) that assms order_refl hull_mono hull_redundant insert_Diff_single insert_subset subsetCE)
   qed
 qed
 
 lemma Un_closed_segment:
   fixes a :: "'a::euclidean_space"
   assumes "b \<in> closed_segment a c"
     shows "closed_segment a b \<union> closed_segment b c = closed_segment a c"
 proof (cases "c = a")
   case True
   with assms show ?thesis by simp
 next
   case False
   with assms have "convex hull {a, b} \<union> convex hull {b, c} = (\<Union>ba\<in>{a, c}. convex hull insert b ({a, c} - {ba}))"
     by (auto simp: insert_Diff_if insert_commute)
   then show ?thesis
     using convex_hull_exchange_Union
     by (metis assms segment_convex_hull)
 qed
 
 lemma Un_open_segment:
   fixes a :: "'a::euclidean_space"
   assumes "b \<in> open_segment a c"
   shows "open_segment a b \<union> {b} \<union> open_segment b c = open_segment a c"
 proof -
   have b: "b \<in> closed_segment a c"
     by (simp add: assms open_closed_segment)
   have *: "open_segment a c \<subseteq> insert b (open_segment a b \<union> open_segment b c)"
           if "{b,c,a} \<union> open_segment a b \<union> open_segment b c = {c,a} \<union> open_segment a c"
   proof -
     have "insert a (insert c (insert b (open_segment a b \<union> open_segment b c))) = insert a (insert c (open_segment a c))"
       using that by (simp add: insert_commute)
     then show ?thesis
       by (metis (no_types) Diff_cancel Diff_eq_empty_iff Diff_insert2 open_segment_def)
   qed
   show ?thesis
     using Un_closed_segment [OF b]
     apply (simp add: closed_segment_eq_open)
       apply (rule equalityI)
     using assms
      apply (simp add: b subset_open_segment)
       using * by (simp add: insert_commute)
 qed
 
 subsection\<open>Covering an open set by a countable chain of compact sets\<close>
   
 proposition open_Union_compact_subsets:
   fixes S :: "'a::euclidean_space set"
   assumes "open S"
   obtains C where "\<And>n. compact(C n)" "\<And>n. C n \<subseteq> S"
                   "\<And>n. C n \<subseteq> interior(C(Suc n))"
                   "\<Union>(range C) = S"
                   "\<And>K. \<lbrakk>compact K; K \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. K \<subseteq> (C n)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (rule_tac C = "\<lambda>n. {}" in that) auto
 next
   case False
   then obtain a where "a \<in> S"
     by auto
   let ?C = "\<lambda>n. cball a (real n) - (\<Union>x \<in> -S. \<Union>e \<in> ball 0 (1 / real(Suc n)). {x + e})"
   have "\<exists>N. \<forall>n\<ge>N. K \<subseteq> (f n)"
         if "\<And>n. compact(f n)" and sub_int: "\<And>n. f n \<subseteq> interior (f(Suc n))"
             and eq: "\<Union>(range f) = S" and "compact K" "K \<subseteq> S" for f K
   proof -
     have *: "\<forall>n. f n \<subseteq> (\<Union>n. interior (f n))"
       by (meson Sup_upper2 UNIV_I \<open>\<And>n. f n \<subseteq> interior (f (Suc n))\<close> image_iff)
     have mono: "\<And>m n. m \<le> n \<Longrightarrow>f m \<subseteq> f n"
       by (meson dual_order.trans interior_subset lift_Suc_mono_le sub_int)
     obtain I where "finite I" and I: "K \<subseteq> (\<Union>i\<in>I. interior (f i))"
     proof (rule compactE_image [OF \<open>compact K\<close>])
       show "K \<subseteq> (\<Union>n. interior (f n))"
         using \<open>K \<subseteq> S\<close> \<open>\<Union>(f ` UNIV) = S\<close> * by blast
     qed auto
     { fix n
       assume n: "Max I \<le> n"
       have "(\<Union>i\<in>I. interior (f i)) \<subseteq> f n"
         by (rule UN_least) (meson dual_order.trans interior_subset mono I Max_ge [OF \<open>finite I\<close>] n)
       then have "K \<subseteq> f n"
         using I by auto
     }
     then show ?thesis
       by blast
   qed
   moreover have "\<exists>f. (\<forall>n. compact(f n)) \<and> (\<forall>n. (f n) \<subseteq> S) \<and> (\<forall>n. (f n) \<subseteq> interior(f(Suc n))) \<and>
                      ((\<Union>(range f) = S))"
   proof (intro exI conjI allI)
     show "\<And>n. compact (?C n)"
       by (auto simp: compact_diff open_sums)
     show "\<And>n. ?C n \<subseteq> S"
       by auto
     show "?C n \<subseteq> interior (?C (Suc n))" for n
     proof (simp add: interior_diff, rule Diff_mono)
       show "cball a (real n) \<subseteq> ball a (1 + real n)"
         by (simp add: cball_subset_ball_iff)
       have cl: "closed (\<Union>x\<in>- S. \<Union>e\<in>cball 0 (1 / (2 + real n)). {x + e})"
         using assms by (auto intro: closed_compact_sums)
       have "closure (\<Union>x\<in>- S. \<Union>y\<in>ball 0 (1 / (2 + real n)). {x + y})
             \<subseteq> (\<Union>x \<in> -S. \<Union>e \<in> cball 0 (1 / (2 + real n)). {x + e})"
         by (intro closure_minimal UN_mono ball_subset_cball order_refl cl)
       also have "... \<subseteq> (\<Union>x \<in> -S. \<Union>y\<in>ball 0 (1 / (1 + real n)). {x + y})"
         apply (intro UN_mono order_refl)
         apply (simp add: cball_subset_ball_iff field_split_simps)
         done
       finally show "closure (\<Union>x\<in>- S. \<Union>y\<in>ball 0 (1 / (2 + real n)). {x + y})
                     \<subseteq> (\<Union>x \<in> -S. \<Union>y\<in>ball 0 (1 / (1 + real n)). {x + y})" .
     qed
     have "S \<subseteq> \<Union> (range ?C)"
     proof
       fix x
       assume x: "x \<in> S"
       then obtain e where "e > 0" and e: "ball x e \<subseteq> S"
         using assms open_contains_ball by blast
       then obtain N1 where "N1 > 0" and N1: "real N1 > 1/e"
         using reals_Archimedean2
         by (metis divide_less_0_iff less_eq_real_def neq0_conv not_le of_nat_0 of_nat_1 of_nat_less_0_iff)
       obtain N2 where N2: "norm(x - a) \<le> real N2"
         by (meson real_arch_simple)
       have N12: "inverse((N1 + N2) + 1) \<le> inverse(N1)"
         using \<open>N1 > 0\<close> by (auto simp: field_split_simps)
       have "x \<noteq> y + z" if "y \<notin> S" "norm z < 1 / (1 + (real N1 + real N2))" for y z
       proof -
         have "e * real N1 < e * (1 + (real N1 + real N2))"
           by (simp add: \<open>0 < e\<close>)
         then have "1 / (1 + (real N1 + real N2)) < e"
           using N1 \<open>e > 0\<close>
           by (metis divide_less_eq less_trans mult.commute of_nat_add of_nat_less_0_iff of_nat_Suc)
         then have "x - z \<in> ball x e"
           using that by simp
         then have "x - z \<in> S"
           using e by blast
         with that show ?thesis
           by auto
       qed
       with N2 show "x \<in> \<Union> (range ?C)"
         by (rule_tac a = "N1+N2" in UN_I) (auto simp: dist_norm norm_minus_commute)
     qed
     then show "\<Union> (range ?C) = S" by auto
   qed
   ultimately show ?thesis
     using that by metis
 qed
 
 
 subsection\<open>Orthogonal complement\<close>
 
 definition\<^marker>\<open>tag important\<close> orthogonal_comp ("_\<^sup>\<bottom>" [80] 80)
   where "orthogonal_comp W \<equiv> {x. \<forall>y \<in> W. orthogonal y x}"
 
 proposition subspace_orthogonal_comp: "subspace (W\<^sup>\<bottom>)"
   unfolding subspace_def orthogonal_comp_def orthogonal_def
   by (auto simp: inner_right_distrib)
 
 lemma orthogonal_comp_anti_mono:
   assumes "A \<subseteq> B"
   shows "B\<^sup>\<bottom> \<subseteq> A\<^sup>\<bottom>"
 proof
   fix x assume x: "x \<in> B\<^sup>\<bottom>"
   show "x \<in> orthogonal_comp A" using x unfolding orthogonal_comp_def
     by (simp add: orthogonal_def, metis assms in_mono)
 qed
 
 lemma orthogonal_comp_null [simp]: "{0}\<^sup>\<bottom> = UNIV"
   by (auto simp: orthogonal_comp_def orthogonal_def)
 
 lemma orthogonal_comp_UNIV [simp]: "UNIV\<^sup>\<bottom> = {0}"
   unfolding orthogonal_comp_def orthogonal_def
   by auto (use inner_eq_zero_iff in blast)
 
 lemma orthogonal_comp_subset: "U \<subseteq> U\<^sup>\<bottom>\<^sup>\<bottom>"
   by (auto simp: orthogonal_comp_def orthogonal_def inner_commute)
 
 lemma subspace_sum_minimal:
   assumes "S \<subseteq> U" "T \<subseteq> U" "subspace U"
   shows "S + T \<subseteq> U"
 proof
   fix x
   assume "x \<in> S + T"
   then obtain xs xt where "xs \<in> S" "xt \<in> T" "x = xs+xt"
     by (meson set_plus_elim)
   then show "x \<in> U"
     by (meson assms subsetCE subspace_add)
 qed
 
 proposition subspace_sum_orthogonal_comp:
   fixes U :: "'a :: euclidean_space set"
   assumes "subspace U"
   shows "U + U\<^sup>\<bottom> = UNIV"
 proof -
   obtain B where "B \<subseteq> U"
     and ortho: "pairwise orthogonal B" "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
     and "independent B" "card B = dim U" "span B = U"
     using orthonormal_basis_subspace [OF assms] by metis
   then have "finite B"
     by (simp add: indep_card_eq_dim_span)
   have *: "\<forall>x\<in>B. \<forall>y\<in>B. x \<bullet> y = (if x=y then 1 else 0)"
     using ortho norm_eq_1 by (auto simp: orthogonal_def pairwise_def)
   { fix v
     let ?u = "\<Sum>b\<in>B. (v \<bullet> b) *\<^sub>R b"
     have "v = ?u + (v - ?u)"
       by simp
     moreover have "?u \<in> U"
       by (metis (no_types, lifting) \<open>span B = U\<close> assms subspace_sum span_base span_mul)
     moreover have "(v - ?u) \<in> U\<^sup>\<bottom>"
     proof (clarsimp simp: orthogonal_comp_def orthogonal_def)
       fix y
       assume "y \<in> U"
       with \<open>span B = U\<close> span_finite [OF \<open>finite B\<close>]
       obtain u where u: "y = (\<Sum>b\<in>B. u b *\<^sub>R b)"
         by auto
       have "b \<bullet> (v - ?u) = 0" if "b \<in> B" for b
         using that \<open>finite B\<close>
         by (simp add: * algebra_simps inner_sum_right if_distrib [of "(*)v" for v] inner_commute cong: if_cong)
       then show "y \<bullet> (v - ?u) = 0"
         by (simp add: u inner_sum_left)
     qed
     ultimately have "v \<in> U + U\<^sup>\<bottom>"
       using set_plus_intro by fastforce
   } then show ?thesis
     by auto
 qed
 
 lemma orthogonal_Int_0:
   assumes "subspace U"
   shows "U \<inter> U\<^sup>\<bottom> = {0}"
   using orthogonal_comp_def orthogonal_self
   by (force simp: assms subspace_0 subspace_orthogonal_comp)
 
 lemma orthogonal_comp_self:
   fixes U :: "'a :: euclidean_space set"
   assumes "subspace U"
   shows "U\<^sup>\<bottom>\<^sup>\<bottom> = U"
 proof
   have ssU': "subspace (U\<^sup>\<bottom>)"
     by (simp add: subspace_orthogonal_comp)
   have "u \<in> U" if "u \<in> U\<^sup>\<bottom>\<^sup>\<bottom>" for u
   proof -
     obtain v w where "u = v+w" "v \<in> U" "w \<in> U\<^sup>\<bottom>"
       using subspace_sum_orthogonal_comp [OF assms] set_plus_elim by blast
     then have "u-v \<in> U\<^sup>\<bottom>"
       by simp
     moreover have "v \<in> U\<^sup>\<bottom>\<^sup>\<bottom>"
       using \<open>v \<in> U\<close> orthogonal_comp_subset by blast
     then have "u-v \<in> U\<^sup>\<bottom>\<^sup>\<bottom>"
       by (simp add: subspace_diff subspace_orthogonal_comp that)
     ultimately have "u-v = 0"
       using orthogonal_Int_0 ssU' by blast
     with \<open>v \<in> U\<close> show ?thesis
       by auto
   qed
   then show "U\<^sup>\<bottom>\<^sup>\<bottom> \<subseteq> U"
     by auto
 qed (use orthogonal_comp_subset in auto)
 
 lemma ker_orthogonal_comp_adjoint:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows "f -` {0} =  (range (adjoint f))\<^sup>\<bottom>"
   apply (auto simp: orthogonal_comp_def orthogonal_def)
   apply (simp add: adjoint_works assms(1) inner_commute)
   by (metis adjoint_works all_zero_iff assms(1) inner_commute)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A non-injective linear function maps into a hyperplane.\<close>
 
 lemma linear_surj_adj_imp_inj:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f" "surj (adjoint f)"
   shows "inj f"
 proof -
   have "\<exists>x. y = adjoint f x" for y
     using assms by (simp add: surjD)
   then show "inj f"
     using assms unfolding inj_on_def image_def
     by (metis (no_types) adjoint_works euclidean_eqI)
 qed
 
 \<comment> \<open>\<^url>\<open>https://mathonline.wikidot.com/injectivity-and-surjectivity-of-the-adjoint-of-a-linear-map\<close>\<close>
 lemma surj_adjoint_iff_inj [simp]:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows  "surj (adjoint f) \<longleftrightarrow> inj f"
 proof
   assume "surj (adjoint f)"
   then show "inj f"
     by (simp add: assms linear_surj_adj_imp_inj)
 next
   assume "inj f"
   have "f -` {0} = {0}"
     using assms \<open>inj f\<close> linear_0 linear_injective_0 by fastforce
   moreover have "f -` {0} = range (adjoint f)\<^sup>\<bottom>"
     by (intro ker_orthogonal_comp_adjoint assms)
   ultimately have "range (adjoint f)\<^sup>\<bottom>\<^sup>\<bottom> = UNIV"
     by (metis orthogonal_comp_null)
   then show "surj (adjoint f)"
     using adjoint_linear \<open>linear f\<close>
     by (subst (asm) orthogonal_comp_self)
       (simp add: adjoint_linear linear_subspace_image)
 qed
 
 lemma inj_adjoint_iff_surj [simp]:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows  "inj (adjoint f) \<longleftrightarrow> surj f"
 proof
   assume "inj (adjoint f)"
   have "(adjoint f) -` {0} = {0}"
     by (metis \<open>inj (adjoint f)\<close> adjoint_linear assms surj_adjoint_iff_inj ker_orthogonal_comp_adjoint orthogonal_comp_UNIV)
   then have "(range(f))\<^sup>\<bottom> = {0}"
     by (metis (no_types, hide_lams) adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint set_zero)
   then show "surj f"
     by (metis \<open>inj (adjoint f)\<close> adjoint_adjoint adjoint_linear assms surj_adjoint_iff_inj)
 next
   assume "surj f"
   then have "range f = (adjoint f -` {0})\<^sup>\<bottom>"
     by (simp add: adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint)
   then have "{0} = adjoint f -` {0}"
     using \<open>surj f\<close> adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint by force
   then show "inj (adjoint f)"
     by (simp add: \<open>surj f\<close> adjoint_adjoint adjoint_linear assms linear_surj_adj_imp_inj)
 qed
 
 lemma linear_singular_into_hyperplane:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "linear f"
   shows "\<not> inj f \<longleftrightarrow> (\<exists>a. a \<noteq> 0 \<and> (\<forall>x. a \<bullet> f x = 0))" (is "_ = ?rhs")
 proof
   assume "\<not>inj f"
   then show ?rhs
     using all_zero_iff
     by (metis (no_types, hide_lams) adjoint_clauses(2) adjoint_linear assms
         linear_injective_0 linear_injective_imp_surjective linear_surj_adj_imp_inj)
 next
   assume ?rhs
   then show "\<not>inj f"
     by (metis assms linear_injective_isomorphism all_zero_iff)
 qed
 
 lemma linear_singular_image_hyperplane:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "linear f" "\<not>inj f"
   obtains a where "a \<noteq> 0" "\<And>S. f ` S \<subseteq> {x. a \<bullet> x = 0}"
   using assms by (fastforce simp add: linear_singular_into_hyperplane)
 
 end
diff --git a/src/HOL/Analysis/Topology_Euclidean_Space.thy b/src/HOL/Analysis/Topology_Euclidean_Space.thy
--- a/src/HOL/Analysis/Topology_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Topology_Euclidean_Space.thy
@@ -1,2509 +1,2508 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 chapter \<open>Vector Analysis\<close>
 
 theory Topology_Euclidean_Space
   imports
     Elementary_Normed_Spaces
     Linear_Algebra
     Norm_Arith
 begin
 
 section \<open>Elementary Topology in Euclidean Space\<close>
 
 lemma euclidean_dist_l2:
   fixes x y :: "'a :: euclidean_space"
   shows "dist x y = L2_set (\<lambda>i. dist (x \<bullet> i) (y \<bullet> i)) Basis"
   unfolding dist_norm norm_eq_sqrt_inner L2_set_def
   by (subst euclidean_inner) (simp add: power2_eq_square inner_diff_left)
 
 lemma norm_nth_le: "norm (x \<bullet> i) \<le> norm x" if "i \<in> Basis"
 proof -
   have "(x \<bullet> i)\<^sup>2 = (\<Sum>i\<in>{i}. (x \<bullet> i)\<^sup>2)"
     by simp
   also have "\<dots> \<le> (\<Sum>i\<in>Basis. (x \<bullet> i)\<^sup>2)"
     by (intro sum_mono2) (auto simp: that)
   finally show ?thesis
     unfolding norm_conv_dist euclidean_dist_l2[of x] L2_set_def
     by (auto intro!: real_le_rsqrt)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Continuity of the representation WRT an orthogonal basis\<close>
 
 lemma orthogonal_Basis: "pairwise orthogonal Basis"
   by (simp add: inner_not_same_Basis orthogonal_def pairwise_def)
 
 lemma representation_bound:
   fixes B :: "'N::real_inner set"
   assumes "finite B" "independent B" "b \<in> B" and orth: "pairwise orthogonal B"
   obtains m where "m > 0" "\<And>x. x \<in> span B \<Longrightarrow> \<bar>representation B x b\<bar> \<le> m * norm x"
 proof 
   fix x
   assume x: "x \<in> span B"
   have "b \<noteq> 0"
     using \<open>independent B\<close> \<open>b \<in> B\<close> dependent_zero by blast
   have [simp]: "b \<bullet> b' = (if b' = b then (norm b)\<^sup>2 else 0)"
     if "b \<in> B" "b' \<in> B" for b b'
     using orth by (simp add: orthogonal_def pairwise_def norm_eq_sqrt_inner that)
   have "norm x = norm (\<Sum>b\<in>B. representation B x b *\<^sub>R b)"
     using real_vector.sum_representation_eq [OF \<open>independent B\<close> x \<open>finite B\<close> order_refl]
     by simp
   also have "\<dots> = sqrt ((\<Sum>b\<in>B. representation B x b *\<^sub>R b) \<bullet> (\<Sum>b\<in>B. representation B x b *\<^sub>R b))"
     by (simp add: norm_eq_sqrt_inner)
   also have "\<dots> = sqrt (\<Sum>b\<in>B. (representation B x b *\<^sub>R b) \<bullet> (representation B x b *\<^sub>R b))"
     using \<open>finite B\<close>
     by (simp add: inner_sum_left inner_sum_right if_distrib [of "\<lambda>x. _ * x"] cong: if_cong sum.cong_simp)
   also have "\<dots> = sqrt (\<Sum>b\<in>B. (norm (representation B x b *\<^sub>R b))\<^sup>2)"
     by (simp add: mult.commute mult.left_commute power2_eq_square)
   also have "\<dots> = sqrt (\<Sum>b\<in>B. (representation B x b)\<^sup>2 * (norm b)\<^sup>2)"
     by (simp add: norm_mult power_mult_distrib)
   finally have "norm x = sqrt (\<Sum>b\<in>B. (representation B x b)\<^sup>2 * (norm b)\<^sup>2)" .
   moreover
   have "sqrt ((representation B x b)\<^sup>2 * (norm b)\<^sup>2) \<le> sqrt (\<Sum>b\<in>B. (representation B x b)\<^sup>2 * (norm b)\<^sup>2)"
     using \<open>b \<in> B\<close> \<open>finite B\<close> by (auto intro: member_le_sum)
   then have "\<bar>representation B x b\<bar> \<le> (1 / norm b) * sqrt (\<Sum>b\<in>B. (representation B x b)\<^sup>2 * (norm b)\<^sup>2)"
     using \<open>b \<noteq> 0\<close> by (simp add: field_split_simps real_sqrt_mult del: real_sqrt_le_iff)
   ultimately show "\<bar>representation B x b\<bar> \<le> (1 / norm b) * norm x"
     by simp
 next
   show "0 < 1 / norm b"
     using \<open>independent B\<close> \<open>b \<in> B\<close> dependent_zero by auto
 qed 
 
 lemma continuous_on_representation:
   fixes B :: "'N::euclidean_space set"
   assumes "finite B" "independent B" "b \<in> B" "pairwise orthogonal B" 
   shows "continuous_on (span B) (\<lambda>x. representation B x b)"
 proof
   show "\<exists>d>0. \<forall>x'\<in>span B. dist x' x < d \<longrightarrow> dist (representation B x' b) (representation B x b) \<le> e"
     if "e > 0" "x \<in> span B" for x e
   proof -
     obtain m where "m > 0" and m: "\<And>x. x \<in> span B \<Longrightarrow> \<bar>representation B x b\<bar> \<le> m * norm x"
       using assms representation_bound by blast
     show ?thesis
       unfolding dist_norm
     proof (intro exI conjI ballI impI)
       show "e/m > 0"
         by (simp add: \<open>e > 0\<close> \<open>m > 0\<close>)
       show "norm (representation B x' b - representation B x b) \<le> e"
         if x': "x' \<in> span B" and less: "norm (x'-x) < e/m" for x' 
       proof -
         have "\<bar>representation B (x'-x) b\<bar> \<le> m * norm (x'-x)"
           using m [of "x'-x"] \<open>x \<in> span B\<close> span_diff x' by blast
         also have "\<dots> < e"
           by (metis \<open>m > 0\<close> less mult.commute pos_less_divide_eq)
         finally have "\<bar>representation B (x'-x) b\<bar> \<le> e" by simp
         then show ?thesis
           by (simp add: \<open>x \<in> span B\<close> \<open>independent B\<close> representation_diff x')
       qed
     qed
   qed
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Balls in Euclidean Space\<close>
 
 lemma cball_subset_cball_iff:
   fixes a :: "'a :: euclidean_space"
   shows "cball a r \<subseteq> cball a' r' \<longleftrightarrow> dist a a' + r \<le> r' \<or> r < 0"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then show ?rhs
   proof (cases "r < 0")
     case True
     then show ?rhs by simp
   next
     case False
     then have [simp]: "r \<ge> 0" by simp
     have "norm (a - a') + r \<le> r'"
     proof (cases "a = a'")
       case True
       then show ?thesis
         using subsetD [where c = "a + r *\<^sub>R (SOME i. i \<in> Basis)", OF \<open>?lhs\<close>] subsetD [where c = a, OF \<open>?lhs\<close>]
         by (force simp: SOME_Basis dist_norm)
     next
       case False
       have "norm (a' - (a + (r / norm (a - a')) *\<^sub>R (a - a'))) = norm (a' - a - (r / norm (a - a')) *\<^sub>R (a - a'))"
         by (simp add: algebra_simps)
       also have "... = norm ((-1 - (r / norm (a - a'))) *\<^sub>R (a - a'))"
         by (simp add: algebra_simps)
       also from \<open>a \<noteq> a'\<close> have "... = \<bar>- norm (a - a') - r\<bar>"
         by simp (simp add: field_simps)
       finally have [simp]: "norm (a' - (a + (r / norm (a - a')) *\<^sub>R (a - a'))) = \<bar>norm (a - a') + r\<bar>"
         by linarith
       from \<open>a \<noteq> a'\<close> show ?thesis
         using subsetD [where c = "a' + (1 + r / norm(a - a')) *\<^sub>R (a - a')", OF \<open>?lhs\<close>]
         by (simp add: dist_norm scaleR_add_left)
     qed
     then show ?rhs
       by (simp add: dist_norm)
   qed
 qed metric
 
 lemma cball_subset_ball_iff: "cball a r \<subseteq> ball a' r' \<longleftrightarrow> dist a a' + r < r' \<or> r < 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
   for a :: "'a::euclidean_space"
 proof
   assume ?lhs
   then show ?rhs
   proof (cases "r < 0")
     case True then
     show ?rhs by simp
   next
     case False
     then have [simp]: "r \<ge> 0" by simp
     have "norm (a - a') + r < r'"
     proof (cases "a = a'")
       case True
       then show ?thesis
         using subsetD [where c = "a + r *\<^sub>R (SOME i. i \<in> Basis)", OF \<open>?lhs\<close>] subsetD [where c = a, OF \<open>?lhs\<close>]
         by (force simp: SOME_Basis dist_norm)
     next
       case False
       have False if "norm (a - a') + r \<ge> r'"
       proof -
         from that have "\<bar>r' - norm (a - a')\<bar> \<le> r"
           by (simp split: abs_split)
             (metis \<open>0 \<le> r\<close> \<open>?lhs\<close> centre_in_cball dist_commute dist_norm less_asym mem_ball subset_eq)
         then show ?thesis
           using subsetD [where c = "a + (r' / norm(a - a') - 1) *\<^sub>R (a - a')", OF \<open>?lhs\<close>] \<open>a \<noteq> a'\<close>
           apply (simp add: dist_norm)
           apply (simp add: scaleR_left_diff_distrib)
           apply (simp add: field_simps)
           done
       qed
       then show ?thesis by force
     qed
     then show ?rhs by (simp add: dist_norm)
   qed
 next
   assume ?rhs
   then show ?lhs
     by metric
 qed
 
 lemma ball_subset_cball_iff: "ball a r \<subseteq> cball a' r' \<longleftrightarrow> dist a a' + r \<le> r' \<or> r \<le> 0"
   (is "?lhs = ?rhs")
   for a :: "'a::euclidean_space"
 proof (cases "r \<le> 0")
   case True
   then show ?thesis
     by metric
 next
   case False
   show ?thesis
   proof
     assume ?lhs
     then have "(cball a r \<subseteq> cball a' r')"
       by (metis False closed_cball closure_ball closure_closed closure_mono not_less)
     with False show ?rhs
       by (fastforce iff: cball_subset_cball_iff)
   next
     assume ?rhs
     with False show ?lhs
       by metric
   qed
 qed
 
 lemma ball_subset_ball_iff:
   fixes a :: "'a :: euclidean_space"
   shows "ball a r \<subseteq> ball a' r' \<longleftrightarrow> dist a a' + r \<le> r' \<or> r \<le> 0"
         (is "?lhs = ?rhs")
 proof (cases "r \<le> 0")
   case True then show ?thesis
     by metric
 next
   case False show ?thesis
   proof
     assume ?lhs
     then have "0 < r'"
       using False by metric
     then have "(cball a r \<subseteq> cball a' r')"
       by (metis False\<open>?lhs\<close> closure_ball closure_mono not_less)
     then show ?rhs
       using False cball_subset_cball_iff by fastforce
   qed metric
 qed
 
 
 lemma ball_eq_ball_iff:
   fixes x :: "'a :: euclidean_space"
   shows "ball x d = ball y e \<longleftrightarrow> d \<le> 0 \<and> e \<le> 0 \<or> x=y \<and> d=e"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
   proof (cases "d \<le> 0 \<or> e \<le> 0")
     case True
       with \<open>?lhs\<close> show ?rhs
         by safe (simp_all only: ball_eq_empty [of y e, symmetric] ball_eq_empty [of x d, symmetric])
   next
     case False
     with \<open>?lhs\<close> show ?rhs
       apply (auto simp: set_eq_subset ball_subset_ball_iff dist_norm norm_minus_commute algebra_simps)
       apply (metis add_le_same_cancel1 le_add_same_cancel1 norm_ge_zero norm_pths(2) order_trans)
       apply (metis add_increasing2 add_le_imp_le_right eq_iff norm_ge_zero)
       done
   qed
 next
   assume ?rhs then show ?lhs
     by (auto simp: set_eq_subset ball_subset_ball_iff)
 qed
 
 lemma cball_eq_cball_iff:
   fixes x :: "'a :: euclidean_space"
   shows "cball x d = cball y e \<longleftrightarrow> d < 0 \<and> e < 0 \<or> x=y \<and> d=e"
         (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
   proof (cases "d < 0 \<or> e < 0")
     case True
       with \<open>?lhs\<close> show ?rhs
         by safe (simp_all only: cball_eq_empty [of y e, symmetric] cball_eq_empty [of x d, symmetric])
   next
     case False
     with \<open>?lhs\<close> show ?rhs
       apply (auto simp: set_eq_subset cball_subset_cball_iff dist_norm norm_minus_commute algebra_simps)
       apply (metis add_le_same_cancel1 le_add_same_cancel1 norm_ge_zero norm_pths(2) order_trans)
       apply (metis add_increasing2 add_le_imp_le_right eq_iff norm_ge_zero)
       done
   qed
 next
   assume ?rhs then show ?lhs
     by (auto simp: set_eq_subset cball_subset_cball_iff)
 qed
 
 lemma ball_eq_cball_iff:
   fixes x :: "'a :: euclidean_space"
   shows "ball x d = cball y e \<longleftrightarrow> d \<le> 0 \<and> e < 0" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     apply (auto simp: set_eq_subset ball_subset_cball_iff cball_subset_ball_iff algebra_simps)
     apply (metis add_increasing2 add_le_cancel_right add_less_same_cancel1 dist_not_less_zero less_le_trans zero_le_dist)
     apply (metis add_less_same_cancel1 dist_not_less_zero less_le_trans not_le)
     using \<open>?lhs\<close> ball_eq_empty cball_eq_empty apply blast+
     done
 next
   assume ?rhs then show ?lhs by auto
 qed
 
 lemma cball_eq_ball_iff:
   fixes x :: "'a :: euclidean_space"
   shows "cball x d = ball y e \<longleftrightarrow> d < 0 \<and> e \<le> 0"
   using ball_eq_cball_iff by blast
 
 lemma finite_ball_avoid:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "finite X" "p \<in> S"
   shows "\<exists>e>0. \<forall>w\<in>ball p e. w\<in>S \<and> (w\<noteq>p \<longrightarrow> w\<notin>X)"
 proof -
   obtain e1 where "0 < e1" and e1_b:"ball p e1 \<subseteq> S"
     using open_contains_ball_eq[OF \<open>open S\<close>] assms by auto
   obtain e2 where "0 < e2" and "\<forall>x\<in>X. x \<noteq> p \<longrightarrow> e2 \<le> dist p x"
     using finite_set_avoid[OF \<open>finite X\<close>,of p] by auto
   hence "\<forall>w\<in>ball p (min e1 e2). w\<in>S \<and> (w\<noteq>p \<longrightarrow> w\<notin>X)" using e1_b by auto
   thus "\<exists>e>0. \<forall>w\<in>ball p e. w \<in> S \<and> (w \<noteq> p \<longrightarrow> w \<notin> X)" using \<open>e2>0\<close> \<open>e1>0\<close>
     apply (rule_tac x="min e1 e2" in exI)
     by auto
 qed
 
 lemma finite_cball_avoid:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S" "finite X" "p \<in> S"
   shows "\<exists>e>0. \<forall>w\<in>cball p e. w\<in>S \<and> (w\<noteq>p \<longrightarrow> w\<notin>X)"
 proof -
   obtain e1 where "e1>0" and e1: "\<forall>w\<in>ball p e1. w\<in>S \<and> (w\<noteq>p \<longrightarrow> w\<notin>X)"
     using finite_ball_avoid[OF assms] by auto
   define e2 where "e2 \<equiv> e1/2"
   have "e2>0" and "e2 < e1" unfolding e2_def using \<open>e1>0\<close> by auto
   then have "cball p e2 \<subseteq> ball p e1" by (subst cball_subset_ball_iff,auto)
   then show "\<exists>e>0. \<forall>w\<in>cball p e. w \<in> S \<and> (w \<noteq> p \<longrightarrow> w \<notin> X)" using \<open>e2>0\<close> e1 by auto
 qed
 
 lemma dim_cball:
   assumes "e > 0"
   shows "dim (cball (0 :: 'n::euclidean_space) e) = DIM('n)"
 proof -
   {
     fix x :: "'n::euclidean_space"
     define y where "y = (e / norm x) *\<^sub>R x"
     then have "y \<in> cball 0 e"
       using assms by auto
     moreover have *: "x = (norm x / e) *\<^sub>R y"
       using y_def assms by simp
     moreover from * have "x = (norm x/e) *\<^sub>R y"
       by auto
     ultimately have "x \<in> span (cball 0 e)"
       using span_scale[of y "cball 0 e" "norm x/e"]
         span_superset[of "cball 0 e"]
       by (simp add: span_base)
   }
   then have "span (cball 0 e) = (UNIV :: 'n::euclidean_space set)"
     by auto
   then show ?thesis
-    using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto simp: dim_UNIV)
+    using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto)
 qed
 
 
 subsection \<open>Boxes\<close>
 
 abbreviation\<^marker>\<open>tag important\<close> One :: "'a::euclidean_space" where
 "One \<equiv> \<Sum>Basis"
 
 lemma One_non_0: assumes "One = (0::'a::euclidean_space)" shows False
 proof -
   have "dependent (Basis :: 'a set)"
     apply (simp add: dependent_finite)
     apply (rule_tac x="\<lambda>i. 1" in exI)
     using SOME_Basis apply (auto simp: assms)
     done
   with independent_Basis show False by force
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> One_neq_0[iff]: "One \<noteq> 0"
   by (metis One_non_0)
 
 corollary\<^marker>\<open>tag unimportant\<close> Zero_neq_One[iff]: "0 \<noteq> One"
   by (metis One_non_0)
 
 definition\<^marker>\<open>tag important\<close> (in euclidean_space) eucl_less (infix "<e" 50) where 
 "eucl_less a b \<longleftrightarrow> (\<forall>i\<in>Basis. a \<bullet> i < b \<bullet> i)"
 
 definition\<^marker>\<open>tag important\<close> box_eucl_less: "box a b = {x. a <e x \<and> x <e b}"
 definition\<^marker>\<open>tag important\<close> "cbox a b = {x. \<forall>i\<in>Basis. a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i}"
 
 lemma box_def: "box a b = {x. \<forall>i\<in>Basis. a \<bullet> i < x \<bullet> i \<and> x \<bullet> i < b \<bullet> i}"
   and in_box_eucl_less: "x \<in> box a b \<longleftrightarrow> a <e x \<and> x <e b"
   and mem_box: "x \<in> box a b \<longleftrightarrow> (\<forall>i\<in>Basis. a \<bullet> i < x \<bullet> i \<and> x \<bullet> i < b \<bullet> i)"
     "x \<in> cbox a b \<longleftrightarrow> (\<forall>i\<in>Basis. a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i)"
   by (auto simp: box_eucl_less eucl_less_def cbox_def)
 
 lemma cbox_Pair_eq: "cbox (a, c) (b, d) = cbox a b \<times> cbox c d"
   by (force simp: cbox_def Basis_prod_def)
 
 lemma cbox_Pair_iff [iff]: "(x, y) \<in> cbox (a, c) (b, d) \<longleftrightarrow> x \<in> cbox a b \<and> y \<in> cbox c d"
   by (force simp: cbox_Pair_eq)
 
 lemma cbox_Complex_eq: "cbox (Complex a c) (Complex b d) = (\<lambda>(x,y). Complex x y) ` (cbox a b \<times> cbox c d)"
   apply (auto simp: cbox_def Basis_complex_def)
   apply (rule_tac x = "(Re x, Im x)" in image_eqI)
   using complex_eq by auto
 
 lemma cbox_Pair_eq_0: "cbox (a, c) (b, d) = {} \<longleftrightarrow> cbox a b = {} \<or> cbox c d = {}"
   by (force simp: cbox_Pair_eq)
 
 lemma swap_cbox_Pair [simp]: "prod.swap ` cbox (c, a) (d, b) = cbox (a,c) (b,d)"
   by auto
 
 lemma mem_box_real[simp]:
   "(x::real) \<in> box a b \<longleftrightarrow> a < x \<and> x < b"
   "(x::real) \<in> cbox a b \<longleftrightarrow> a \<le> x \<and> x \<le> b"
   by (auto simp: mem_box)
 
 lemma box_real[simp]:
   fixes a b:: real
   shows "box a b = {a <..< b}" "cbox a b = {a .. b}"
   by auto
 
 lemma box_Int_box:
   fixes a :: "'a::euclidean_space"
   shows "box a b \<inter> box c d =
     box (\<Sum>i\<in>Basis. max (a\<bullet>i) (c\<bullet>i) *\<^sub>R i) (\<Sum>i\<in>Basis. min (b\<bullet>i) (d\<bullet>i) *\<^sub>R i)"
   unfolding set_eq_iff and Int_iff and mem_box by auto
 
 lemma rational_boxes:
   fixes x :: "'a::euclidean_space"
   assumes "e > 0"
   shows "\<exists>a b. (\<forall>i\<in>Basis. a \<bullet> i \<in> \<rat> \<and> b \<bullet> i \<in> \<rat>) \<and> x \<in> box a b \<and> box a b \<subseteq> ball x e"
 proof -
   define e' where "e' = e / (2 * sqrt (real (DIM ('a))))"
   then have e: "e' > 0"
-    using assms by (auto simp: DIM_positive)
+    using assms by (auto)
   have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> y < x \<bullet> i \<and> x \<bullet> i - y < e'" (is "\<forall>i. ?th i")
   proof
     fix i
     from Rats_dense_in_real[of "x \<bullet> i - e'" "x \<bullet> i"] e
     show "?th i" by auto
   qed
   from choice[OF this] obtain a where
     a: "\<forall>xa. a xa \<in> \<rat> \<and> a xa < x \<bullet> xa \<and> x \<bullet> xa - a xa < e'" ..
   have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> x \<bullet> i < y \<and> y - x \<bullet> i < e'" (is "\<forall>i. ?th i")
   proof
     fix i
     from Rats_dense_in_real[of "x \<bullet> i" "x \<bullet> i + e'"] e
     show "?th i" by auto
   qed
   from choice[OF this] obtain b where
     b: "\<forall>xa. b xa \<in> \<rat> \<and> x \<bullet> xa < b xa \<and> b xa - x \<bullet> xa < e'" ..
   let ?a = "\<Sum>i\<in>Basis. a i *\<^sub>R i" and ?b = "\<Sum>i\<in>Basis. b i *\<^sub>R i"
   show ?thesis
   proof (rule exI[of _ ?a], rule exI[of _ ?b], safe)
     fix y :: 'a
     assume *: "y \<in> box ?a ?b"
     have "dist x y = sqrt (\<Sum>i\<in>Basis. (dist (x \<bullet> i) (y \<bullet> i))\<^sup>2)"
       unfolding L2_set_def[symmetric] by (rule euclidean_dist_l2)
     also have "\<dots> < sqrt (\<Sum>(i::'a)\<in>Basis. e^2 / real (DIM('a)))"
     proof (rule real_sqrt_less_mono, rule sum_strict_mono)
       fix i :: "'a"
       assume i: "i \<in> Basis"
       have "a i < y\<bullet>i \<and> y\<bullet>i < b i"
         using * i by (auto simp: box_def)
       moreover have "a i < x\<bullet>i" "x\<bullet>i - a i < e'"
         using a by auto
       moreover have "x\<bullet>i < b i" "b i - x\<bullet>i < e'"
         using b by auto
       ultimately have "\<bar>x\<bullet>i - y\<bullet>i\<bar> < 2 * e'"
         by auto
       then have "dist (x \<bullet> i) (y \<bullet> i) < e/sqrt (real (DIM('a)))"
         unfolding e'_def by (auto simp: dist_real_def)
       then have "(dist (x \<bullet> i) (y \<bullet> i))\<^sup>2 < (e/sqrt (real (DIM('a))))\<^sup>2"
         by (rule power_strict_mono) auto
       then show "(dist (x \<bullet> i) (y \<bullet> i))\<^sup>2 < e\<^sup>2 / real DIM('a)"
         by (simp add: power_divide)
     qed auto
     also have "\<dots> = e"
       using \<open>0 < e\<close> by simp
     finally show "y \<in> ball x e"
       by (auto simp: ball_def)
   qed (insert a b, auto simp: box_def)
 qed
 
 lemma open_UNION_box:
   fixes M :: "'a::euclidean_space set"
   assumes "open M"
   defines "a' \<equiv> \<lambda>f :: 'a \<Rightarrow> real \<times> real. (\<Sum>(i::'a)\<in>Basis. fst (f i) *\<^sub>R i)"
   defines "b' \<equiv> \<lambda>f :: 'a \<Rightarrow> real \<times> real. (\<Sum>(i::'a)\<in>Basis. snd (f i) *\<^sub>R i)"
   defines "I \<equiv> {f\<in>Basis \<rightarrow>\<^sub>E \<rat> \<times> \<rat>. box (a' f) (b' f) \<subseteq> M}"
   shows "M = (\<Union>f\<in>I. box (a' f) (b' f))"
 proof -
   have "x \<in> (\<Union>f\<in>I. box (a' f) (b' f))" if "x \<in> M" for x
   proof -
     obtain e where e: "e > 0" "ball x e \<subseteq> M"
       using openE[OF \<open>open M\<close> \<open>x \<in> M\<close>] by auto
     moreover obtain a b where ab:
       "x \<in> box a b"
       "\<forall>i \<in> Basis. a \<bullet> i \<in> \<rat>"
       "\<forall>i\<in>Basis. b \<bullet> i \<in> \<rat>"
       "box a b \<subseteq> ball x e"
       using rational_boxes[OF e(1)] by metis
     ultimately show ?thesis
        by (intro UN_I[of "\<lambda>i\<in>Basis. (a \<bullet> i, b \<bullet> i)"])
           (auto simp: euclidean_representation I_def a'_def b'_def)
   qed
   then show ?thesis by (auto simp: I_def)
 qed
 
 corollary open_countable_Union_open_box:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S"
   obtains \<D> where "countable \<D>" "\<D> \<subseteq> Pow S" "\<And>X. X \<in> \<D> \<Longrightarrow> \<exists>a b. X = box a b" "\<Union>\<D> = S"
 proof -
   let ?a = "\<lambda>f. (\<Sum>(i::'a)\<in>Basis. fst (f i) *\<^sub>R i)"
   let ?b = "\<lambda>f. (\<Sum>(i::'a)\<in>Basis. snd (f i) *\<^sub>R i)"
   let ?I = "{f\<in>Basis \<rightarrow>\<^sub>E \<rat> \<times> \<rat>. box (?a f) (?b f) \<subseteq> S}"
   let ?\<D> = "(\<lambda>f. box (?a f) (?b f)) ` ?I"
   show ?thesis
   proof
     have "countable ?I"
       by (simp add: countable_PiE countable_rat)
     then show "countable ?\<D>"
       by blast
     show "\<Union>?\<D> = S"
       using open_UNION_box [OF assms] by metis
   qed auto
 qed
 
 lemma rational_cboxes:
   fixes x :: "'a::euclidean_space"
   assumes "e > 0"
   shows "\<exists>a b. (\<forall>i\<in>Basis. a \<bullet> i \<in> \<rat> \<and> b \<bullet> i \<in> \<rat>) \<and> x \<in> cbox a b \<and> cbox a b \<subseteq> ball x e"
 proof -
   define e' where "e' = e / (2 * sqrt (real (DIM ('a))))"
   then have e: "e' > 0"
     using assms by auto
   have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> y < x \<bullet> i \<and> x \<bullet> i - y < e'" (is "\<forall>i. ?th i")
   proof
     fix i
     from Rats_dense_in_real[of "x \<bullet> i - e'" "x \<bullet> i"] e
     show "?th i" by auto
   qed
   from choice[OF this] obtain a where
     a: "\<forall>u. a u \<in> \<rat> \<and> a u < x \<bullet> u \<and> x \<bullet> u - a u < e'" ..
   have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> x \<bullet> i < y \<and> y - x \<bullet> i < e'" (is "\<forall>i. ?th i")
   proof
     fix i
     from Rats_dense_in_real[of "x \<bullet> i" "x \<bullet> i + e'"] e
     show "?th i" by auto
   qed
   from choice[OF this] obtain b where
     b: "\<forall>u. b u \<in> \<rat> \<and> x \<bullet> u < b u \<and> b u - x \<bullet> u < e'" ..
   let ?a = "\<Sum>i\<in>Basis. a i *\<^sub>R i" and ?b = "\<Sum>i\<in>Basis. b i *\<^sub>R i"
   show ?thesis
   proof (rule exI[of _ ?a], rule exI[of _ ?b], safe)
     fix y :: 'a
     assume *: "y \<in> cbox ?a ?b"
     have "dist x y = sqrt (\<Sum>i\<in>Basis. (dist (x \<bullet> i) (y \<bullet> i))\<^sup>2)"
       unfolding L2_set_def[symmetric] by (rule euclidean_dist_l2)
     also have "\<dots> < sqrt (\<Sum>(i::'a)\<in>Basis. e^2 / real (DIM('a)))"
     proof (rule real_sqrt_less_mono, rule sum_strict_mono)
       fix i :: "'a"
       assume i: "i \<in> Basis"
       have "a i \<le> y\<bullet>i \<and> y\<bullet>i \<le> b i"
         using * i by (auto simp: cbox_def)
       moreover have "a i < x\<bullet>i" "x\<bullet>i - a i < e'"
         using a by auto
       moreover have "x\<bullet>i < b i" "b i - x\<bullet>i < e'"
         using b by auto
       ultimately have "\<bar>x\<bullet>i - y\<bullet>i\<bar> < 2 * e'"
         by auto
       then have "dist (x \<bullet> i) (y \<bullet> i) < e/sqrt (real (DIM('a)))"
         unfolding e'_def by (auto simp: dist_real_def)
       then have "(dist (x \<bullet> i) (y \<bullet> i))\<^sup>2 < (e/sqrt (real (DIM('a))))\<^sup>2"
         by (rule power_strict_mono) auto
       then show "(dist (x \<bullet> i) (y \<bullet> i))\<^sup>2 < e\<^sup>2 / real DIM('a)"
         by (simp add: power_divide)
     qed auto
     also have "\<dots> = e"
       using \<open>0 < e\<close> by simp
     finally show "y \<in> ball x e"
       by (auto simp: ball_def)
   next
     show "x \<in> cbox (\<Sum>i\<in>Basis. a i *\<^sub>R i) (\<Sum>i\<in>Basis. b i *\<^sub>R i)"
       using a b less_imp_le by (auto simp: cbox_def)
   qed (use a b cbox_def in auto)
 qed
 
 lemma open_UNION_cbox:
   fixes M :: "'a::euclidean_space set"
   assumes "open M"
   defines "a' \<equiv> \<lambda>f. (\<Sum>(i::'a)\<in>Basis. fst (f i) *\<^sub>R i)"
   defines "b' \<equiv> \<lambda>f. (\<Sum>(i::'a)\<in>Basis. snd (f i) *\<^sub>R i)"
   defines "I \<equiv> {f\<in>Basis \<rightarrow>\<^sub>E \<rat> \<times> \<rat>. cbox (a' f) (b' f) \<subseteq> M}"
   shows "M = (\<Union>f\<in>I. cbox (a' f) (b' f))"
 proof -
   have "x \<in> (\<Union>f\<in>I. cbox (a' f) (b' f))" if "x \<in> M" for x
   proof -
     obtain e where e: "e > 0" "ball x e \<subseteq> M"
       using openE[OF \<open>open M\<close> \<open>x \<in> M\<close>] by auto
     moreover obtain a b where ab: "x \<in> cbox a b" "\<forall>i \<in> Basis. a \<bullet> i \<in> \<rat>"
                                   "\<forall>i \<in> Basis. b \<bullet> i \<in> \<rat>" "cbox a b \<subseteq> ball x e"
       using rational_cboxes[OF e(1)] by metis
     ultimately show ?thesis
        by (intro UN_I[of "\<lambda>i\<in>Basis. (a \<bullet> i, b \<bullet> i)"])
           (auto simp: euclidean_representation I_def a'_def b'_def)
   qed
   then show ?thesis by (auto simp: I_def)
 qed
 
 corollary open_countable_Union_open_cbox:
   fixes S :: "'a :: euclidean_space set"
   assumes "open S"
   obtains \<D> where "countable \<D>" "\<D> \<subseteq> Pow S" "\<And>X. X \<in> \<D> \<Longrightarrow> \<exists>a b. X = cbox a b" "\<Union>\<D> = S"
 proof -
   let ?a = "\<lambda>f. (\<Sum>(i::'a)\<in>Basis. fst (f i) *\<^sub>R i)"
   let ?b = "\<lambda>f. (\<Sum>(i::'a)\<in>Basis. snd (f i) *\<^sub>R i)"
   let ?I = "{f\<in>Basis \<rightarrow>\<^sub>E \<rat> \<times> \<rat>. cbox (?a f) (?b f) \<subseteq> S}"
   let ?\<D> = "(\<lambda>f. cbox (?a f) (?b f)) ` ?I"
   show ?thesis
   proof
     have "countable ?I"
       by (simp add: countable_PiE countable_rat)
     then show "countable ?\<D>"
       by blast
     show "\<Union>?\<D> = S"
       using open_UNION_cbox [OF assms] by metis
   qed auto
 qed
 
 lemma box_eq_empty:
   fixes a :: "'a::euclidean_space"
   shows "(box a b = {} \<longleftrightarrow> (\<exists>i\<in>Basis. b\<bullet>i \<le> a\<bullet>i))" (is ?th1)
     and "(cbox a b = {} \<longleftrightarrow> (\<exists>i\<in>Basis. b\<bullet>i < a\<bullet>i))" (is ?th2)
 proof -
   {
     fix i x
     assume i: "i\<in>Basis" and as:"b\<bullet>i \<le> a\<bullet>i" and x:"x\<in>box a b"
     then have "a \<bullet> i < x \<bullet> i \<and> x \<bullet> i < b \<bullet> i"
       unfolding mem_box by (auto simp: box_def)
     then have "a\<bullet>i < b\<bullet>i" by auto
     then have False using as by auto
   }
   moreover
   {
     assume as: "\<forall>i\<in>Basis. \<not> (b\<bullet>i \<le> a\<bullet>i)"
     let ?x = "(1/2) *\<^sub>R (a + b)"
     {
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "a\<bullet>i < b\<bullet>i"
         using as[THEN bspec[where x=i]] i by auto
       then have "a\<bullet>i < ((1/2) *\<^sub>R (a+b)) \<bullet> i" "((1/2) *\<^sub>R (a+b)) \<bullet> i < b\<bullet>i"
         by (auto simp: inner_add_left)
     }
     then have "box a b \<noteq> {}"
       using mem_box(1)[of "?x" a b] by auto
   }
   ultimately show ?th1 by blast
 
   {
     fix i x
     assume i: "i \<in> Basis" and as:"b\<bullet>i < a\<bullet>i" and x:"x\<in>cbox a b"
     then have "a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i"
       unfolding mem_box by auto
     then have "a\<bullet>i \<le> b\<bullet>i" by auto
     then have False using as by auto
   }
   moreover
   {
     assume as:"\<forall>i\<in>Basis. \<not> (b\<bullet>i < a\<bullet>i)"
     let ?x = "(1/2) *\<^sub>R (a + b)"
     {
       fix i :: 'a
       assume i:"i \<in> Basis"
       have "a\<bullet>i \<le> b\<bullet>i"
         using as[THEN bspec[where x=i]] i by auto
       then have "a\<bullet>i \<le> ((1/2) *\<^sub>R (a+b)) \<bullet> i" "((1/2) *\<^sub>R (a+b)) \<bullet> i \<le> b\<bullet>i"
         by (auto simp: inner_add_left)
     }
     then have "cbox a b \<noteq> {}"
       using mem_box(2)[of "?x" a b] by auto
   }
   ultimately show ?th2 by blast
 qed
 
 lemma box_ne_empty:
   fixes a :: "'a::euclidean_space"
   shows "cbox a b \<noteq> {} \<longleftrightarrow> (\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i)"
   and "box a b \<noteq> {} \<longleftrightarrow> (\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i)"
   unfolding box_eq_empty[of a b] by fastforce+
 
 lemma
   fixes a :: "'a::euclidean_space"
   shows cbox_sing [simp]: "cbox a a = {a}"
     and box_sing [simp]: "box a a = {}"
   unfolding set_eq_iff mem_box eq_iff [symmetric]
   by (auto intro!: euclidean_eqI[where 'a='a])
      (metis all_not_in_conv nonempty_Basis)
 
 lemma subset_box_imp:
   fixes a :: "'a::euclidean_space"
   shows "(\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i) \<Longrightarrow> cbox c d \<subseteq> cbox a b"
     and "(\<forall>i\<in>Basis. a\<bullet>i < c\<bullet>i \<and> d\<bullet>i < b\<bullet>i) \<Longrightarrow> cbox c d \<subseteq> box a b"
     and "(\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i) \<Longrightarrow> box c d \<subseteq> cbox a b"
      and "(\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i) \<Longrightarrow> box c d \<subseteq> box a b"
   unfolding subset_eq[unfolded Ball_def] unfolding mem_box
   by (best intro: order_trans less_le_trans le_less_trans less_imp_le)+
 
 lemma box_subset_cbox:
   fixes a :: "'a::euclidean_space"
   shows "box a b \<subseteq> cbox a b"
   unfolding subset_eq [unfolded Ball_def] mem_box
   by (fast intro: less_imp_le)
 
 lemma subset_box:
   fixes a :: "'a::euclidean_space"
   shows "cbox c d \<subseteq> cbox a b \<longleftrightarrow> (\<forall>i\<in>Basis. c\<bullet>i \<le> d\<bullet>i) \<longrightarrow> (\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i)" (is ?th1)
     and "cbox c d \<subseteq> box a b \<longleftrightarrow> (\<forall>i\<in>Basis. c\<bullet>i \<le> d\<bullet>i) \<longrightarrow> (\<forall>i\<in>Basis. a\<bullet>i < c\<bullet>i \<and> d\<bullet>i < b\<bullet>i)" (is ?th2)
     and "box c d \<subseteq> cbox a b \<longleftrightarrow> (\<forall>i\<in>Basis. c\<bullet>i < d\<bullet>i) \<longrightarrow> (\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i)" (is ?th3)
     and "box c d \<subseteq> box a b \<longleftrightarrow> (\<forall>i\<in>Basis. c\<bullet>i < d\<bullet>i) \<longrightarrow> (\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i)" (is ?th4)
 proof -
   let ?lesscd = "\<forall>i\<in>Basis. c\<bullet>i < d\<bullet>i"
   let ?lerhs = "\<forall>i\<in>Basis. a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i"
   show ?th1 ?th2
     by (fastforce simp: mem_box)+
   have acdb: "a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i"
     if i: "i \<in> Basis" and box: "box c d \<subseteq> cbox a b" and cd: "\<And>i. i \<in> Basis \<Longrightarrow> c\<bullet>i < d\<bullet>i" for i
   proof -
     have "box c d \<noteq> {}"
       using that
       unfolding box_eq_empty by force
     { let ?x = "(\<Sum>j\<in>Basis. (if j=i then ((min (a\<bullet>j) (d\<bullet>j))+c\<bullet>j)/2 else (c\<bullet>j+d\<bullet>j)/2) *\<^sub>R j)::'a"
       assume *: "a\<bullet>i > c\<bullet>i"
       then have "c \<bullet> j < ?x \<bullet> j \<and> ?x \<bullet> j < d \<bullet> j" if "j \<in> Basis" for j
         using cd that by (fastforce simp add: i *)
       then have "?x \<in> box c d"
         unfolding mem_box by auto
       moreover have "?x \<notin> cbox a b"
         using i cd * by (force simp: mem_box)
       ultimately have False using box by auto
     }
     then have "a\<bullet>i \<le> c\<bullet>i" by force
     moreover
     { let ?x = "(\<Sum>j\<in>Basis. (if j=i then ((max (b\<bullet>j) (c\<bullet>j))+d\<bullet>j)/2 else (c\<bullet>j+d\<bullet>j)/2) *\<^sub>R j)::'a"
       assume *: "b\<bullet>i < d\<bullet>i"
       then have "d \<bullet> j > ?x \<bullet> j \<and> ?x \<bullet> j > c \<bullet> j" if "j \<in> Basis" for j
         using cd that by (fastforce simp add: i *)
       then have "?x \<in> box c d"
         unfolding mem_box by auto
       moreover have "?x \<notin> cbox a b"
         using i cd * by (force simp: mem_box)
       ultimately have False using box by auto
     }
     then have "b\<bullet>i \<ge> d\<bullet>i" by (rule ccontr) auto
     ultimately show ?thesis by auto
   qed
   show ?th3
     using acdb by (fastforce simp add: mem_box)
   have acdb': "a\<bullet>i \<le> c\<bullet>i \<and> d\<bullet>i \<le> b\<bullet>i"
     if "i \<in> Basis" "box c d \<subseteq> box a b" "\<And>i. i \<in> Basis \<Longrightarrow> c\<bullet>i < d\<bullet>i" for i
       using box_subset_cbox[of a b] that acdb by auto
   show ?th4
     using acdb' by (fastforce simp add: mem_box)
 qed
 
 lemma eq_cbox: "cbox a b = cbox c d \<longleftrightarrow> cbox a b = {} \<and> cbox c d = {} \<or> a = c \<and> b = d"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "cbox a b \<subseteq> cbox c d" "cbox c d \<subseteq> cbox a b"
     by auto
   then show ?rhs
     by (force simp: subset_box box_eq_empty intro: antisym euclidean_eqI)
 next
   assume ?rhs
   then show ?lhs
     by force
 qed
 
 lemma eq_cbox_box [simp]: "cbox a b = box c d \<longleftrightarrow> cbox a b = {} \<and> box c d = {}"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume L: ?lhs
   then have "cbox a b \<subseteq> box c d" "box c d \<subseteq> cbox a b"
     by auto
   then show ?rhs
     apply (simp add: subset_box)
     using L box_ne_empty box_sing apply (fastforce simp add:)
     done
 qed force
 
 lemma eq_box_cbox [simp]: "box a b = cbox c d \<longleftrightarrow> box a b = {} \<and> cbox c d = {}"
   by (metis eq_cbox_box)
 
 lemma eq_box: "box a b = box c d \<longleftrightarrow> box a b = {} \<and> box c d = {} \<or> a = c \<and> b = d"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume L: ?lhs
   then have "box a b \<subseteq> box c d" "box c d \<subseteq> box a b"
     by auto
   then show ?rhs
     apply (simp add: subset_box)
     using box_ne_empty(2) L
     apply auto
      apply (meson euclidean_eqI less_eq_real_def not_less)+
     done
 qed force
 
 lemma subset_box_complex:
    "cbox a b \<subseteq> cbox c d \<longleftrightarrow>
       (Re a \<le> Re b \<and> Im a \<le> Im b) \<longrightarrow> Re a \<ge> Re c \<and> Im a \<ge> Im c \<and> Re b \<le> Re d \<and> Im b \<le> Im d"
    "cbox a b \<subseteq> box c d \<longleftrightarrow>
       (Re a \<le> Re b \<and> Im a \<le> Im b) \<longrightarrow> Re a > Re c \<and> Im a > Im c \<and> Re b < Re d \<and> Im b < Im d"
    "box a b \<subseteq> cbox c d \<longleftrightarrow>
       (Re a < Re b \<and> Im a < Im b) \<longrightarrow> Re a \<ge> Re c \<and> Im a \<ge> Im c \<and> Re b \<le> Re d \<and> Im b \<le> Im d"
    "box a b \<subseteq> box c d \<longleftrightarrow>
       (Re a < Re b \<and> Im a < Im b) \<longrightarrow> Re a \<ge> Re c \<and> Im a \<ge> Im c \<and> Re b \<le> Re d \<and> Im b \<le> Im d"
   by (subst subset_box; force simp: Basis_complex_def)+
 
 lemma in_cbox_complex_iff:
   "x \<in> cbox a b \<longleftrightarrow> Re x \<in> {Re a..Re b} \<and> Im x \<in> {Im a..Im b}"
   by (cases x; cases a; cases b) (auto simp: cbox_Complex_eq)
 
 lemma box_Complex_eq:
   "box (Complex a c) (Complex b d) = (\<lambda>(x,y). Complex x y) ` (box a b \<times> box c d)"
   by (auto simp: box_def Basis_complex_def image_iff complex_eq_iff)
 
 lemma in_box_complex_iff:
   "x \<in> box a b \<longleftrightarrow> Re x \<in> {Re a<..<Re b} \<and> Im x \<in> {Im a<..<Im b}"
   by (cases x; cases a; cases b) (auto simp: box_Complex_eq)
 
 lemma Int_interval:
   fixes a :: "'a::euclidean_space"
   shows "cbox a b \<inter> cbox c d =
     cbox (\<Sum>i\<in>Basis. max (a\<bullet>i) (c\<bullet>i) *\<^sub>R i) (\<Sum>i\<in>Basis. min (b\<bullet>i) (d\<bullet>i) *\<^sub>R i)"
   unfolding set_eq_iff and Int_iff and mem_box
   by auto
 
 lemma disjoint_interval:
   fixes a::"'a::euclidean_space"
   shows "cbox a b \<inter> cbox c d = {} \<longleftrightarrow> (\<exists>i\<in>Basis. (b\<bullet>i < a\<bullet>i \<or> d\<bullet>i < c\<bullet>i \<or> b\<bullet>i < c\<bullet>i \<or> d\<bullet>i < a\<bullet>i))" (is ?th1)
     and "cbox a b \<inter> box c d = {} \<longleftrightarrow> (\<exists>i\<in>Basis. (b\<bullet>i < a\<bullet>i \<or> d\<bullet>i \<le> c\<bullet>i \<or> b\<bullet>i \<le> c\<bullet>i \<or> d\<bullet>i \<le> a\<bullet>i))" (is ?th2)
     and "box a b \<inter> cbox c d = {} \<longleftrightarrow> (\<exists>i\<in>Basis. (b\<bullet>i \<le> a\<bullet>i \<or> d\<bullet>i < c\<bullet>i \<or> b\<bullet>i \<le> c\<bullet>i \<or> d\<bullet>i \<le> a\<bullet>i))" (is ?th3)
     and "box a b \<inter> box c d = {} \<longleftrightarrow> (\<exists>i\<in>Basis. (b\<bullet>i \<le> a\<bullet>i \<or> d\<bullet>i \<le> c\<bullet>i \<or> b\<bullet>i \<le> c\<bullet>i \<or> d\<bullet>i \<le> a\<bullet>i))" (is ?th4)
 proof -
   let ?z = "(\<Sum>i\<in>Basis. (((max (a\<bullet>i) (c\<bullet>i)) + (min (b\<bullet>i) (d\<bullet>i))) / 2) *\<^sub>R i)::'a"
   have **: "\<And>P Q. (\<And>i :: 'a. i \<in> Basis \<Longrightarrow> Q ?z i \<Longrightarrow> P i) \<Longrightarrow>
       (\<And>i x :: 'a. i \<in> Basis \<Longrightarrow> P i \<Longrightarrow> Q x i) \<Longrightarrow> (\<forall>x. \<exists>i\<in>Basis. Q x i) \<longleftrightarrow> (\<exists>i\<in>Basis. P i)"
     by blast
   note * = set_eq_iff Int_iff empty_iff mem_box ball_conj_distrib[symmetric] eq_False ball_simps(10)
   show ?th1 unfolding * by (intro **) auto
   show ?th2 unfolding * by (intro **) auto
   show ?th3 unfolding * by (intro **) auto
   show ?th4 unfolding * by (intro **) auto
 qed
 
 lemma UN_box_eq_UNIV: "(\<Union>i::nat. box (- (real i *\<^sub>R One)) (real i *\<^sub>R One)) = UNIV"
 proof -
   have "\<bar>x \<bullet> b\<bar> < real_of_int (\<lceil>Max ((\<lambda>b. \<bar>x \<bullet> b\<bar>)`Basis)\<rceil> + 1)"
     if [simp]: "b \<in> Basis" for x b :: 'a
   proof -
     have "\<bar>x \<bullet> b\<bar> \<le> real_of_int \<lceil>\<bar>x \<bullet> b\<bar>\<rceil>"
       by (rule le_of_int_ceiling)
     also have "\<dots> \<le> real_of_int \<lceil>Max ((\<lambda>b. \<bar>x \<bullet> b\<bar>)`Basis)\<rceil>"
       by (auto intro!: ceiling_mono)
     also have "\<dots> < real_of_int (\<lceil>Max ((\<lambda>b. \<bar>x \<bullet> b\<bar>)`Basis)\<rceil> + 1)"
       by simp
     finally show ?thesis .
   qed
   then have "\<exists>n::nat. \<forall>b\<in>Basis. \<bar>x \<bullet> b\<bar> < real n" for x :: 'a
     by (metis order.strict_trans reals_Archimedean2)
   moreover have "\<And>x b::'a. \<And>n::nat.  \<bar>x \<bullet> b\<bar> < real n \<longleftrightarrow> - real n < x \<bullet> b \<and> x \<bullet> b < real n"
     by auto
   ultimately show ?thesis
     by (auto simp: box_def inner_sum_left inner_Basis sum.If_cases)
 qed
 
 lemma image_affinity_cbox: fixes m::real
   fixes a b c :: "'a::euclidean_space"
   shows "(\<lambda>x. m *\<^sub>R x + c) ` cbox a b =
     (if cbox a b = {} then {}
      else (if 0 \<le> m then cbox (m *\<^sub>R a + c) (m *\<^sub>R b + c)
      else cbox (m *\<^sub>R b + c) (m *\<^sub>R a + c)))"
 proof (cases "m = 0")
   case True
   {
     fix x
     assume "\<forall>i\<in>Basis. x \<bullet> i \<le> c \<bullet> i" "\<forall>i\<in>Basis. c \<bullet> i \<le> x \<bullet> i"
     then have "x = c"
       by (simp add: dual_order.antisym euclidean_eqI)
   }
   moreover have "c \<in> cbox (m *\<^sub>R a + c) (m *\<^sub>R b + c)"
-    unfolding True by (auto simp: cbox_sing)
+    unfolding True by (auto)
   ultimately show ?thesis using True by (auto simp: cbox_def)
 next
   case False
   {
     fix y
     assume "\<forall>i\<in>Basis. a \<bullet> i \<le> y \<bullet> i" "\<forall>i\<in>Basis. y \<bullet> i \<le> b \<bullet> i" "m > 0"
     then have "\<forall>i\<in>Basis. (m *\<^sub>R a + c) \<bullet> i \<le> (m *\<^sub>R y + c) \<bullet> i" and "\<forall>i\<in>Basis. (m *\<^sub>R y + c) \<bullet> i \<le> (m *\<^sub>R b + c) \<bullet> i"
       by (auto simp: inner_distrib)
   }
   moreover
   {
     fix y
     assume "\<forall>i\<in>Basis. a \<bullet> i \<le> y \<bullet> i" "\<forall>i\<in>Basis. y \<bullet> i \<le> b \<bullet> i" "m < 0"
     then have "\<forall>i\<in>Basis. (m *\<^sub>R b + c) \<bullet> i \<le> (m *\<^sub>R y + c) \<bullet> i" and "\<forall>i\<in>Basis. (m *\<^sub>R y + c) \<bullet> i \<le> (m *\<^sub>R a + c) \<bullet> i"
       by (auto simp: mult_left_mono_neg inner_distrib)
   }
   moreover
   {
     fix y
     assume "m > 0" and "\<forall>i\<in>Basis. (m *\<^sub>R a + c) \<bullet> i \<le> y \<bullet> i" and "\<forall>i\<in>Basis. y \<bullet> i \<le> (m *\<^sub>R b + c) \<bullet> i"
     then have "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` cbox a b"
       unfolding image_iff Bex_def mem_box
       apply (intro exI[where x="(1 / m) *\<^sub>R (y - c)"])
       apply (auto simp: pos_le_divide_eq pos_divide_le_eq mult.commute inner_distrib inner_diff_left)
       done
   }
   moreover
   {
     fix y
     assume "\<forall>i\<in>Basis. (m *\<^sub>R b + c) \<bullet> i \<le> y \<bullet> i" "\<forall>i\<in>Basis. y \<bullet> i \<le> (m *\<^sub>R a + c) \<bullet> i" "m < 0"
     then have "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` cbox a b"
       unfolding image_iff Bex_def mem_box
       apply (intro exI[where x="(1 / m) *\<^sub>R (y - c)"])
       apply (auto simp: neg_le_divide_eq neg_divide_le_eq mult.commute inner_distrib inner_diff_left)
       done
   }
   ultimately show ?thesis using False by (auto simp: cbox_def)
 qed
 
 lemma image_smult_cbox:"(\<lambda>x. m *\<^sub>R (x::_::euclidean_space)) ` cbox a b =
   (if cbox a b = {} then {} else if 0 \<le> m then cbox (m *\<^sub>R a) (m *\<^sub>R b) else cbox (m *\<^sub>R b) (m *\<^sub>R a))"
   using image_affinity_cbox[of m 0 a b] by auto
 
 lemma swap_continuous:
   assumes "continuous_on (cbox (a,c) (b,d)) (\<lambda>(x,y). f x y)"
     shows "continuous_on (cbox (c,a) (d,b)) (\<lambda>(x, y). f y x)"
 proof -
   have "(\<lambda>(x, y). f y x) = (\<lambda>(x, y). f x y) \<circ> prod.swap"
     by auto
   then show ?thesis
     apply (rule ssubst)
     apply (rule continuous_on_compose)
     apply (simp add: split_def)
     apply (rule continuous_intros | simp add: assms)+
     done
 qed
 
 
 subsection \<open>General Intervals\<close>
 
 definition\<^marker>\<open>tag important\<close> "is_interval (s::('a::euclidean_space) set) \<longleftrightarrow>
   (\<forall>a\<in>s. \<forall>b\<in>s. \<forall>x. (\<forall>i\<in>Basis. ((a\<bullet>i \<le> x\<bullet>i \<and> x\<bullet>i \<le> b\<bullet>i) \<or> (b\<bullet>i \<le> x\<bullet>i \<and> x\<bullet>i \<le> a\<bullet>i))) \<longrightarrow> x \<in> s)"
 
 lemma is_interval_1:
   "is_interval (s::real set) \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. \<forall> x. a \<le> x \<and> x \<le> b \<longrightarrow> x \<in> s)"
   unfolding is_interval_def by auto
 
 lemma is_interval_Int: "is_interval X \<Longrightarrow> is_interval Y \<Longrightarrow> is_interval (X \<inter> Y)"
   unfolding is_interval_def
   by blast
 
 lemma is_interval_cbox [simp]: "is_interval (cbox a (b::'a::euclidean_space))" (is ?th1)
   and is_interval_box [simp]: "is_interval (box a b)" (is ?th2)
   unfolding is_interval_def mem_box Ball_def atLeastAtMost_iff
   by (meson order_trans le_less_trans less_le_trans less_trans)+
 
 lemma is_interval_empty [iff]: "is_interval {}"
   unfolding is_interval_def  by simp
 
 lemma is_interval_univ [iff]: "is_interval UNIV"
   unfolding is_interval_def  by simp
 
 lemma mem_is_intervalI:
   assumes "is_interval s"
     and "a \<in> s" "b \<in> s"
     and "\<And>i. i \<in> Basis \<Longrightarrow> a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i \<or> b \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> a \<bullet> i"
   shows "x \<in> s"
   by (rule assms(1)[simplified is_interval_def, rule_format, OF assms(2,3,4)])
 
 lemma interval_subst:
   fixes S::"'a::euclidean_space set"
   assumes "is_interval S"
     and "x \<in> S" "y j \<in> S"
     and "j \<in> Basis"
   shows "(\<Sum>i\<in>Basis. (if i = j then y i \<bullet> i else x \<bullet> i) *\<^sub>R i) \<in> S"
   by (rule mem_is_intervalI[OF assms(1,2)]) (auto simp: assms)
 
 lemma mem_box_componentwiseI:
   fixes S::"'a::euclidean_space set"
   assumes "is_interval S"
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> x \<bullet> i \<in> ((\<lambda>x. x \<bullet> i) ` S)"
   shows "x \<in> S"
 proof -
   from assms have "\<forall>i \<in> Basis. \<exists>s \<in> S. x \<bullet> i = s \<bullet> i"
     by auto
   with finite_Basis obtain s and bs::"'a list"
     where s: "\<And>i. i \<in> Basis \<Longrightarrow> x \<bullet> i = s i \<bullet> i" "\<And>i. i \<in> Basis \<Longrightarrow> s i \<in> S"
       and bs: "set bs = Basis" "distinct bs"
     by (metis finite_distinct_list)
   from nonempty_Basis s obtain j where j: "j \<in> Basis" "s j \<in> S"
     by blast
   define y where
     "y = rec_list (s j) (\<lambda>j _ Y. (\<Sum>i\<in>Basis. (if i = j then s i \<bullet> i else Y \<bullet> i) *\<^sub>R i))"
   have "x = (\<Sum>i\<in>Basis. (if i \<in> set bs then s i \<bullet> i else s j \<bullet> i) *\<^sub>R i)"
     using bs by (auto simp: s(1)[symmetric] euclidean_representation)
   also have [symmetric]: "y bs = \<dots>"
     using bs(2) bs(1)[THEN equalityD1]
     by (induct bs) (auto simp: y_def euclidean_representation intro!: euclidean_eqI[where 'a='a])
   also have "y bs \<in> S"
     using bs(1)[THEN equalityD1]
     apply (induct bs)
      apply (auto simp: y_def j)
     apply (rule interval_subst[OF assms(1)])
       apply (auto simp: s)
     done
   finally show ?thesis .
 qed
 
 lemma cbox01_nonempty [simp]: "cbox 0 One \<noteq> {}"
   by (simp add: box_ne_empty inner_Basis inner_sum_left sum_nonneg)
 
 lemma box01_nonempty [simp]: "box 0 One \<noteq> {}"
   by (simp add: box_ne_empty inner_Basis inner_sum_left)
 
 lemma empty_as_interval: "{} = cbox One (0::'a::euclidean_space)"
   using nonempty_Basis box01_nonempty box_eq_empty(1) box_ne_empty(1) by blast
 
 lemma interval_subset_is_interval:
   assumes "is_interval S"
   shows "cbox a b \<subseteq> S \<longleftrightarrow> cbox a b = {} \<or> a \<in> S \<and> b \<in> S" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs  using box_ne_empty(1) mem_box(2) by fastforce
 next
   assume ?rhs
   have "cbox a b \<subseteq> S" if "a \<in> S" "b \<in> S"
     using assms unfolding is_interval_def
     apply (clarsimp simp add: mem_box)
     using that by blast
   with \<open>?rhs\<close> show ?lhs
     by blast
 qed
 
 lemma is_real_interval_union:
   "is_interval (X \<union> Y)"
   if X: "is_interval X" and Y: "is_interval Y" and I: "(X \<noteq> {} \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> X \<inter> Y \<noteq> {})"
   for X Y::"real set"
 proof -
   consider "X \<noteq> {}" "Y \<noteq> {}" | "X = {}" | "Y = {}" by blast
   then show ?thesis
   proof cases
     case 1
     then obtain r where "r \<in> X \<or> X \<inter> Y = {}" "r \<in> Y \<or> X \<inter> Y = {}"
       by blast
     then show ?thesis
       using I 1 X Y unfolding is_interval_1
       by (metis (full_types) Un_iff le_cases)
   qed (use that in auto)
 qed
 
 lemma is_interval_translationI:
   assumes "is_interval X"
   shows "is_interval ((+) x ` X)"
   unfolding is_interval_def
 proof safe
   fix b d e
   assume "b \<in> X" "d \<in> X"
     "\<forall>i\<in>Basis. (x + b) \<bullet> i \<le> e \<bullet> i \<and> e \<bullet> i \<le> (x + d) \<bullet> i \<or>
        (x + d) \<bullet> i \<le> e \<bullet> i \<and> e \<bullet> i \<le> (x + b) \<bullet> i"
   hence "e - x \<in> X"
     by (intro mem_is_intervalI[OF assms \<open>b \<in> X\<close> \<open>d \<in> X\<close>, of "e - x"])
       (auto simp: algebra_simps)
   thus "e \<in> (+) x ` X" by force
 qed
 
 lemma is_interval_uminusI:
   assumes "is_interval X"
   shows "is_interval (uminus ` X)"
   unfolding is_interval_def
 proof safe
   fix b d e
   assume "b \<in> X" "d \<in> X"
     "\<forall>i\<in>Basis. (- b) \<bullet> i \<le> e \<bullet> i \<and> e \<bullet> i \<le> (- d) \<bullet> i \<or>
        (- d) \<bullet> i \<le> e \<bullet> i \<and> e \<bullet> i \<le> (- b) \<bullet> i"
   hence "- e \<in> X"
     by (intro mem_is_intervalI[OF assms \<open>b \<in> X\<close> \<open>d \<in> X\<close>, of "- e"])
       (auto simp: algebra_simps)
   thus "e \<in> uminus ` X" by force
 qed
 
 lemma is_interval_uminus[simp]: "is_interval (uminus ` x) = is_interval x"
   using is_interval_uminusI[of x] is_interval_uminusI[of "uminus ` x"]
   by (auto simp: image_image)
 
 lemma is_interval_neg_translationI:
   assumes "is_interval X"
   shows "is_interval ((-) x ` X)"
 proof -
   have "(-) x ` X = (+) x ` uminus ` X"
     by (force simp: algebra_simps)
   also have "is_interval \<dots>"
     by (metis is_interval_uminusI is_interval_translationI assms)
   finally show ?thesis .
 qed
 
 lemma is_interval_translation[simp]:
   "is_interval ((+) x ` X) = is_interval X"
   using is_interval_neg_translationI[of "(+) x ` X" x]
   by (auto intro!: is_interval_translationI simp: image_image)
 
 lemma is_interval_minus_translation[simp]:
   shows "is_interval ((-) x ` X) = is_interval X"
 proof -
   have "(-) x ` X = (+) x ` uminus ` X"
     by (force simp: algebra_simps)
   also have "is_interval \<dots> = is_interval X"
     by simp
   finally show ?thesis .
 qed
 
 lemma is_interval_minus_translation'[simp]:
   shows "is_interval ((\<lambda>x. x - c) ` X) = is_interval X"
   using is_interval_translation[of "-c" X]
   by (metis image_cong uminus_add_conv_diff)
 
 lemma is_interval_cball_1[intro, simp]: "is_interval (cball a b)" for a b::real
   by (simp add: cball_eq_atLeastAtMost is_interval_def)
 
 lemma is_interval_ball_real: "is_interval (ball a b)" for a b::real
   by (simp add: ball_eq_greaterThanLessThan is_interval_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounded Projections\<close>
 
 lemma bounded_inner_imp_bdd_above:
   assumes "bounded s"
     shows "bdd_above ((\<lambda>x. x \<bullet> a) ` s)"
 by (simp add: assms bounded_imp_bdd_above bounded_linear_image bounded_linear_inner_left)
 
 lemma bounded_inner_imp_bdd_below:
   assumes "bounded s"
     shows "bdd_below ((\<lambda>x. x \<bullet> a) ` s)"
 by (simp add: assms bounded_imp_bdd_below bounded_linear_image bounded_linear_inner_left)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Structural rules for pointwise continuity\<close>
 
 lemma continuous_infnorm[continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. infnorm (f x))"
   unfolding continuous_def by (rule tendsto_infnorm)
 
 lemma continuous_inner[continuous_intros]:
   assumes "continuous F f"
     and "continuous F g"
   shows "continuous F (\<lambda>x. inner (f x) (g x))"
   using assms unfolding continuous_def by (rule tendsto_inner)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Structural rules for setwise continuity\<close>
 
 lemma continuous_on_infnorm[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. infnorm (f x))"
   unfolding continuous_on by (fast intro: tendsto_infnorm)
 
 lemma continuous_on_inner[continuous_intros]:
   fixes g :: "'a::topological_space \<Rightarrow> 'b::real_inner"
   assumes "continuous_on s f"
     and "continuous_on s g"
   shows "continuous_on s (\<lambda>x. inner (f x) (g x))"
   using bounded_bilinear_inner assms
   by (rule bounded_bilinear.continuous_on)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Openness of halfspaces.\<close>
 
 lemma open_halfspace_lt: "open {x. inner a x < b}"
-  by (simp add: open_Collect_less continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: open_Collect_less continuous_on_inner)
 
 lemma open_halfspace_gt: "open {x. inner a x > b}"
-  by (simp add: open_Collect_less continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: open_Collect_less continuous_on_inner)
 
 lemma open_halfspace_component_lt: "open {x::'a::euclidean_space. x\<bullet>i < a}"
-  by (simp add: open_Collect_less continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: open_Collect_less continuous_on_inner)
 
 lemma open_halfspace_component_gt: "open {x::'a::euclidean_space. x\<bullet>i > a}"
-  by (simp add: open_Collect_less continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: open_Collect_less continuous_on_inner)
 
 lemma eucl_less_eq_halfspaces:
   fixes a :: "'a::euclidean_space"
   shows "{x. x <e a} = (\<Inter>i\<in>Basis. {x. x \<bullet> i < a \<bullet> i})"
         "{x. a <e x} = (\<Inter>i\<in>Basis. {x. a \<bullet> i < x \<bullet> i})"
   by (auto simp: eucl_less_def)
 
 lemma open_Collect_eucl_less[simp, intro]:
   fixes a :: "'a::euclidean_space"
   shows "open {x. x <e a}" "open {x. a <e x}"
   by (auto simp: eucl_less_eq_halfspaces open_halfspace_component_lt open_halfspace_component_gt)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Closure and Interior of halfspaces and hyperplanes\<close>
 
 lemma continuous_at_inner: "continuous (at x) (inner a)"
   unfolding continuous_at by (intro tendsto_intros)
 
 lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
-  by (simp add: closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: closed_Collect_le continuous_on_inner)
 
 lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
-  by (simp add: closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: closed_Collect_le continuous_on_inner)
 
 lemma closed_hyperplane: "closed {x. inner a x = b}"
-  by (simp add: closed_Collect_eq continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: closed_Collect_eq continuous_on_inner)
 
 lemma closed_halfspace_component_le: "closed {x::'a::euclidean_space. x\<bullet>i \<le> a}"
-  by (simp add: closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: closed_Collect_le continuous_on_inner)
 
 lemma closed_halfspace_component_ge: "closed {x::'a::euclidean_space. x\<bullet>i \<ge> a}"
-  by (simp add: closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: closed_Collect_le continuous_on_inner)
 
 lemma closed_interval_left:
   fixes b :: "'a::euclidean_space"
   shows "closed {x::'a. \<forall>i\<in>Basis. x\<bullet>i \<le> b\<bullet>i}"
-  by (simp add: Collect_ball_eq closed_INT closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: Collect_ball_eq closed_INT closed_Collect_le continuous_on_inner)
 
 lemma closed_interval_right:
   fixes a :: "'a::euclidean_space"
   shows "closed {x::'a. \<forall>i\<in>Basis. a\<bullet>i \<le> x\<bullet>i}"
-  by (simp add: Collect_ball_eq closed_INT closed_Collect_le continuous_on_inner continuous_on_const continuous_on_id)
+  by (simp add: Collect_ball_eq closed_INT closed_Collect_le continuous_on_inner)
 
 lemma interior_halfspace_le [simp]:
   assumes "a \<noteq> 0"
     shows "interior {x. a \<bullet> x \<le> b} = {x. a \<bullet> x < b}"
 proof -
   have *: "a \<bullet> x < b" if x: "x \<in> S" and S: "S \<subseteq> {x. a \<bullet> x \<le> b}" and "open S" for S x
   proof -
     obtain e where "e>0" and e: "cball x e \<subseteq> S"
       using \<open>open S\<close> open_contains_cball x by blast
     then have "x + (e / norm a) *\<^sub>R a \<in> cball x e"
       by (simp add: dist_norm)
     then have "x + (e / norm a) *\<^sub>R a \<in> S"
       using e by blast
     then have "x + (e / norm a) *\<^sub>R a \<in> {x. a \<bullet> x \<le> b}"
       using S by blast
     moreover have "e * (a \<bullet> a) / norm a > 0"
       by (simp add: \<open>0 < e\<close> assms)
     ultimately show ?thesis
       by (simp add: algebra_simps)
   qed
   show ?thesis
     by (rule interior_unique) (auto simp: open_halfspace_lt *)
 qed
 
 lemma interior_halfspace_ge [simp]:
    "a \<noteq> 0 \<Longrightarrow> interior {x. a \<bullet> x \<ge> b} = {x. a \<bullet> x > b}"
 using interior_halfspace_le [of "-a" "-b"] by simp
 
 lemma closure_halfspace_lt [simp]:
   assumes "a \<noteq> 0"
     shows "closure {x. a \<bullet> x < b} = {x. a \<bullet> x \<le> b}"
 proof -
   have [simp]: "-{x. a \<bullet> x < b} = {x. a \<bullet> x \<ge> b}"
     by (force simp:)
   then show ?thesis
     using interior_halfspace_ge [of a b] assms
     by (force simp: closure_interior)
 qed
 
 lemma closure_halfspace_gt [simp]:
    "a \<noteq> 0 \<Longrightarrow> closure {x. a \<bullet> x > b} = {x. a \<bullet> x \<ge> b}"
 using closure_halfspace_lt [of "-a" "-b"] by simp
 
 lemma interior_hyperplane [simp]:
   assumes "a \<noteq> 0"
     shows "interior {x. a \<bullet> x = b} = {}"
 proof -
   have [simp]: "{x. a \<bullet> x = b} = {x. a \<bullet> x \<le> b} \<inter> {x. a \<bullet> x \<ge> b}"
     by (force simp:)
   then show ?thesis
     by (auto simp: assms)
 qed
 
 lemma frontier_halfspace_le:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
     shows "frontier {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
 proof (cases "a = 0")
   case True with assms show ?thesis by simp
 next
   case False then show ?thesis
     by (force simp: frontier_def closed_halfspace_le)
 qed
 
 lemma frontier_halfspace_ge:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
     shows "frontier {x. a \<bullet> x \<ge> b} = {x. a \<bullet> x = b}"
 proof (cases "a = 0")
   case True with assms show ?thesis by simp
 next
   case False then show ?thesis
     by (force simp: frontier_def closed_halfspace_ge)
 qed
 
 lemma frontier_halfspace_lt:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
     shows "frontier {x. a \<bullet> x < b} = {x. a \<bullet> x = b}"
 proof (cases "a = 0")
   case True with assms show ?thesis by simp
 next
   case False then show ?thesis
     by (force simp: frontier_def interior_open open_halfspace_lt)
 qed
 
 lemma frontier_halfspace_gt:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
     shows "frontier {x. a \<bullet> x > b} = {x. a \<bullet> x = b}"
 proof (cases "a = 0")
   case True with assms show ?thesis by simp
 next
   case False then show ?thesis
     by (force simp: frontier_def interior_open open_halfspace_gt)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some more convenient intermediate-value theorem formulations\<close>
 
 lemma connected_ivt_hyperplane:
   assumes "connected S" and xy: "x \<in> S" "y \<in> S" and b: "inner a x \<le> b" "b \<le> inner a y"
   shows "\<exists>z \<in> S. inner a z = b"
 proof (rule ccontr)
   assume as:"\<not> (\<exists>z\<in>S. inner a z = b)"
   let ?A = "{x. inner a x < b}"
   let ?B = "{x. inner a x > b}"
   have "open ?A" "open ?B"
     using open_halfspace_lt and open_halfspace_gt by auto
   moreover have "?A \<inter> ?B = {}" by auto
   moreover have "S \<subseteq> ?A \<union> ?B" using as by auto
   ultimately show False
     using \<open>connected S\<close>[unfolded connected_def not_ex,
       THEN spec[where x="?A"], THEN spec[where x="?B"]]
     using xy b by auto
 qed
 
 lemma connected_ivt_component:
   fixes x::"'a::euclidean_space"
   shows "connected S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x\<bullet>k \<le> a \<Longrightarrow> a \<le> y\<bullet>k \<Longrightarrow> (\<exists>z\<in>S.  z\<bullet>k = a)"
   using connected_ivt_hyperplane[of S x y "k::'a" a]
   by (auto simp: inner_commute)
 
 
 subsection \<open>Limit Component Bounds\<close>
 
 lemma Lim_component_le:
   fixes f :: "'a \<Rightarrow> 'b::euclidean_space"
   assumes "(f \<longlongrightarrow> l) net"
     and "\<not> (trivial_limit net)"
     and "eventually (\<lambda>x. f(x)\<bullet>i \<le> b) net"
   shows "l\<bullet>i \<le> b"
   by (rule tendsto_le[OF assms(2) tendsto_const tendsto_inner[OF assms(1) tendsto_const] assms(3)])
 
 lemma Lim_component_ge:
   fixes f :: "'a \<Rightarrow> 'b::euclidean_space"
   assumes "(f \<longlongrightarrow> l) net"
     and "\<not> (trivial_limit net)"
     and "eventually (\<lambda>x. b \<le> (f x)\<bullet>i) net"
   shows "b \<le> l\<bullet>i"
   by (rule tendsto_le[OF assms(2) tendsto_inner[OF assms(1) tendsto_const] tendsto_const assms(3)])
 
 lemma Lim_component_eq:
   fixes f :: "'a \<Rightarrow> 'b::euclidean_space"
   assumes net: "(f \<longlongrightarrow> l) net" "\<not> trivial_limit net"
     and ev:"eventually (\<lambda>x. f(x)\<bullet>i = b) net"
   shows "l\<bullet>i = b"
   using ev[unfolded order_eq_iff eventually_conj_iff]
   using Lim_component_ge[OF net, of b i]
   using Lim_component_le[OF net, of i b]
   by auto
 
 lemma open_box[intro]: "open (box a b)"
 proof -
   have "open (\<Inter>i\<in>Basis. ((\<bullet>) i) -` {a \<bullet> i <..< b \<bullet> i})"
     by (auto intro!: continuous_open_vimage continuous_inner continuous_ident continuous_const)
   also have "(\<Inter>i\<in>Basis. ((\<bullet>) i) -` {a \<bullet> i <..< b \<bullet> i}) = box a b"
     by (auto simp: box_def inner_commute)
   finally show ?thesis .
 qed
 
 lemma closed_cbox[intro]:
   fixes a b :: "'a::euclidean_space"
   shows "closed (cbox a b)"
 proof -
   have "closed (\<Inter>i\<in>Basis. (\<lambda>x. x\<bullet>i) -` {a\<bullet>i .. b\<bullet>i})"
     by (intro closed_INT ballI continuous_closed_vimage allI
       linear_continuous_at closed_real_atLeastAtMost finite_Basis bounded_linear_inner_left)
   also have "(\<Inter>i\<in>Basis. (\<lambda>x. x\<bullet>i) -` {a\<bullet>i .. b\<bullet>i}) = cbox a b"
     by (auto simp: cbox_def)
   finally show "closed (cbox a b)" .
 qed
 
 lemma interior_cbox [simp]:
   fixes a b :: "'a::euclidean_space"
   shows "interior (cbox a b) = box a b" (is "?L = ?R")
 proof(rule subset_antisym)
   show "?R \<subseteq> ?L"
     using box_subset_cbox open_box
     by (rule interior_maximal)
   {
     fix x
     assume "x \<in> interior (cbox a b)"
     then obtain s where s: "open s" "x \<in> s" "s \<subseteq> cbox a b" ..
     then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> cbox a b"
       unfolding open_dist and subset_eq by auto
     {
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "dist (x - (e / 2) *\<^sub>R i) x < e"
         and "dist (x + (e / 2) *\<^sub>R i) x < e"
         unfolding dist_norm
         apply auto
         unfolding norm_minus_cancel
         using norm_Basis[OF i] \<open>e>0\<close>
         apply auto
         done
       then have "a \<bullet> i \<le> (x - (e / 2) *\<^sub>R i) \<bullet> i" and "(x + (e / 2) *\<^sub>R i) \<bullet> i \<le> b \<bullet> i"
         using e[THEN spec[where x="x - (e/2) *\<^sub>R i"]]
           and e[THEN spec[where x="x + (e/2) *\<^sub>R i"]]
         unfolding mem_box
         using i
         by blast+
       then have "a \<bullet> i < x \<bullet> i" and "x \<bullet> i < b \<bullet> i"
         using \<open>e>0\<close> i
         by (auto simp: inner_diff_left inner_Basis inner_add_left)
     }
     then have "x \<in> box a b"
       unfolding mem_box by auto
   }
   then show "?L \<subseteq> ?R" ..
 qed
 
 lemma bounded_cbox [simp]:
   fixes a :: "'a::euclidean_space"
   shows "bounded (cbox a b)"
 proof -
   let ?b = "\<Sum>i\<in>Basis. \<bar>a\<bullet>i\<bar> + \<bar>b\<bullet>i\<bar>"
   {
     fix x :: "'a"
     assume "\<And>i. i\<in>Basis \<Longrightarrow> a \<bullet> i \<le> x \<bullet> i \<and> x \<bullet> i \<le> b \<bullet> i"
     then have "(\<Sum>i\<in>Basis. \<bar>x \<bullet> i\<bar>) \<le> ?b"
       by (force simp: intro!: sum_mono)
     then have "norm x \<le> ?b"
       using norm_le_l1[of x] by auto
   }
   then show ?thesis
     unfolding cbox_def bounded_iff by force
 qed
 
 lemma bounded_box [simp]:
   fixes a :: "'a::euclidean_space"
   shows "bounded (box a b)"
   using bounded_cbox[of a b] box_subset_cbox[of a b] bounded_subset[of "cbox a b" "box a b"]
   by simp
 
 lemma not_interval_UNIV [simp]:
   fixes a :: "'a::euclidean_space"
   shows "cbox a b \<noteq> UNIV" "box a b \<noteq> UNIV"
   using bounded_box[of a b] bounded_cbox[of a b] by force+
 
 lemma not_interval_UNIV2 [simp]:
   fixes a :: "'a::euclidean_space"
   shows "UNIV \<noteq> cbox a b" "UNIV \<noteq> box a b"
   using bounded_box[of a b] bounded_cbox[of a b] by force+
 
 lemma box_midpoint:
   fixes a :: "'a::euclidean_space"
   assumes "box a b \<noteq> {}"
   shows "((1/2) *\<^sub>R (a + b)) \<in> box a b"
 proof -
   have "a \<bullet> i < ((1 / 2) *\<^sub>R (a + b)) \<bullet> i \<and> ((1 / 2) *\<^sub>R (a + b)) \<bullet> i < b \<bullet> i" if "i \<in> Basis" for i
     using assms that by (auto simp: inner_add_left box_ne_empty)
   then show ?thesis unfolding mem_box by auto
 qed
 
 lemma open_cbox_convex:
   fixes x :: "'a::euclidean_space"
   assumes x: "x \<in> box a b"
     and y: "y \<in> cbox a b"
     and e: "0 < e" "e \<le> 1"
   shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> box a b"
 proof -
   {
     fix i :: 'a
     assume i: "i \<in> Basis"
     have "a \<bullet> i = e * (a \<bullet> i) + (1 - e) * (a \<bullet> i)"
       unfolding left_diff_distrib by simp
     also have "\<dots> < e * (x \<bullet> i) + (1 - e) * (y \<bullet> i)"
     proof (rule add_less_le_mono)
       show "e * (a \<bullet> i) < e * (x \<bullet> i)"
         using \<open>0 < e\<close> i mem_box(1) x by auto
       show "(1 - e) * (a \<bullet> i) \<le> (1 - e) * (y \<bullet> i)"
         by (meson diff_ge_0_iff_ge \<open>e \<le> 1\<close> i mem_box(2) mult_left_mono y)
     qed
     finally have "a \<bullet> i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) \<bullet> i"
       unfolding inner_simps by auto
     moreover
     {
       have "b \<bullet> i = e * (b\<bullet>i) + (1 - e) * (b\<bullet>i)"
         unfolding left_diff_distrib by simp
       also have "\<dots> > e * (x \<bullet> i) + (1 - e) * (y \<bullet> i)"
       proof (rule add_less_le_mono)
         show "e * (x \<bullet> i) < e * (b \<bullet> i)"
           using \<open>0 < e\<close> i mem_box(1) x by auto
         show "(1 - e) * (y \<bullet> i) \<le> (1 - e) * (b \<bullet> i)"
           by (meson diff_ge_0_iff_ge \<open>e \<le> 1\<close> i mem_box(2) mult_left_mono y)
       qed
       finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<bullet> i < b \<bullet> i"
         unfolding inner_simps by auto
     }
     ultimately have "a \<bullet> i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) \<bullet> i \<and> (e *\<^sub>R x + (1 - e) *\<^sub>R y) \<bullet> i < b \<bullet> i"
       by auto
   }
   then show ?thesis
     unfolding mem_box by auto
 qed
 
 lemma closure_cbox [simp]: "closure (cbox a b) = cbox a b"
   by (simp add: closed_cbox)
 
 lemma closure_box [simp]:
   fixes a :: "'a::euclidean_space"
    assumes "box a b \<noteq> {}"
   shows "closure (box a b) = cbox a b"
 proof -
   have ab: "a <e b"
     using assms by (simp add: eucl_less_def box_ne_empty)
   let ?c = "(1 / 2) *\<^sub>R (a + b)"
   {
     fix x
     assume as:"x \<in> cbox a b"
     define f where [abs_def]: "f n = x + (inverse (real n + 1)) *\<^sub>R (?c - x)" for n
     {
       fix n
       assume fn: "f n <e b \<longrightarrow> a <e f n \<longrightarrow> f n = x" and xc: "x \<noteq> ?c"
       have *: "0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1"
         unfolding inverse_le_1_iff by auto
       have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
         x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
         by (auto simp: algebra_simps)
       then have "f n <e b" and "a <e f n"
         using open_cbox_convex[OF box_midpoint[OF assms] as *]
         unfolding f_def by (auto simp: box_def eucl_less_def)
       then have False
         using fn unfolding f_def using xc by auto
     }
     moreover
     {
       assume "\<not> (f \<longlongrightarrow> x) sequentially"
       {
         fix e :: real
         assume "e > 0"
         then obtain N :: nat where N: "inverse (real (N + 1)) < e"
           using reals_Archimedean by auto
         have "inverse (real n + 1) < e" if "N \<le> n" for n
           by (auto intro!: that le_less_trans [OF _ N])
         then have "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto
       }
       then have "((\<lambda>n. inverse (real n + 1)) \<longlongrightarrow> 0) sequentially"
         unfolding lim_sequentially by(auto simp: dist_norm)
       then have "(f \<longlongrightarrow> x) sequentially"
         unfolding f_def
         using tendsto_add[OF tendsto_const, of "\<lambda>n::nat. (inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x)" 0 sequentially x]
         using tendsto_scaleR [OF _ tendsto_const, of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"]
         by auto
     }
     ultimately have "x \<in> closure (box a b)"
       using as box_midpoint[OF assms]
       unfolding closure_def islimpt_sequential
       by (cases "x=?c") (auto simp: in_box_eucl_less)
   }
   then show ?thesis
     using closure_minimal[OF box_subset_cbox, of a b] by blast
 qed
 
 lemma bounded_subset_box_symmetric:
   fixes S :: "('a::euclidean_space) set"
   assumes "bounded S"
   obtains a where "S \<subseteq> box (-a) a"
 proof -
   obtain b where "b>0" and b: "\<forall>x\<in>S. norm x \<le> b"
     using assms[unfolded bounded_pos] by auto
   define a :: 'a where "a = (\<Sum>i\<in>Basis. (b + 1) *\<^sub>R i)"
   have "(-a)\<bullet>i < x\<bullet>i" and "x\<bullet>i < a\<bullet>i" if "x \<in> S" and i: "i \<in> Basis" for x i
     using b Basis_le_norm[OF i, of x] that by (auto simp: a_def)
   then have "S \<subseteq> box (-a) a"
     by (auto simp: simp add: box_def)
   then show ?thesis ..
 qed
 
 lemma bounded_subset_cbox_symmetric:
   fixes S :: "('a::euclidean_space) set"
   assumes "bounded S"
   obtains a where "S \<subseteq> cbox (-a) a"
 proof -
   obtain a where "S \<subseteq> box (-a) a"
     using bounded_subset_box_symmetric[OF assms] by auto
   then show ?thesis
     by (meson box_subset_cbox dual_order.trans that)
 qed
 
 lemma frontier_cbox:
   fixes a b :: "'a::euclidean_space"
   shows "frontier (cbox a b) = cbox a b - box a b"
   unfolding frontier_def unfolding interior_cbox and closure_closed[OF closed_cbox] ..
 
 lemma frontier_box:
   fixes a b :: "'a::euclidean_space"
   shows "frontier (box a b) = (if box a b = {} then {} else cbox a b - box a b)"
 proof (cases "box a b = {}")
   case True
   then show ?thesis
     using frontier_empty by auto
 next
   case False
   then show ?thesis
     unfolding frontier_def and closure_box[OF False] and interior_open[OF open_box]
     by auto
 qed
 
 lemma Int_interval_mixed_eq_empty:
   fixes a :: "'a::euclidean_space"
    assumes "box c d \<noteq> {}"
   shows "box a b \<inter> cbox c d = {} \<longleftrightarrow> box a b \<inter> box c d = {}"
   unfolding closure_box[OF assms, symmetric]
   unfolding open_Int_closure_eq_empty[OF open_box] ..
 
 subsection \<open>Class Instances\<close>
 
 lemma compact_lemma:
   fixes f :: "nat \<Rightarrow> 'a::euclidean_space"
   assumes "bounded (range f)"
   shows "\<forall>d\<subseteq>Basis. \<exists>l::'a. \<exists> r.
     strict_mono r \<and> (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) \<bullet> i) (l \<bullet> i) < e) sequentially)"
   by (rule compact_lemma_general[where unproj="\<lambda>e. \<Sum>i\<in>Basis. e i *\<^sub>R i"])
      (auto intro!: assms bounded_linear_inner_left bounded_linear_image
        simp: euclidean_representation)
 
 instance\<^marker>\<open>tag important\<close> euclidean_space \<subseteq> heine_borel
 proof
   fix f :: "nat \<Rightarrow> 'a"
   assume f: "bounded (range f)"
   then obtain l::'a and r where r: "strict_mono r"
     and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>Basis. dist (f (r n) \<bullet> i) (l \<bullet> i) < e) sequentially"
     using compact_lemma [OF f] by blast
   {
     fix e::real
     assume "e > 0"
-    hence "e / real_of_nat DIM('a) > 0" by (simp add: DIM_positive)
+    hence "e / real_of_nat DIM('a) > 0" by (simp)
     with l have "eventually (\<lambda>n. \<forall>i\<in>Basis. dist (f (r n) \<bullet> i) (l \<bullet> i) < e / (real_of_nat DIM('a))) sequentially"
       by simp
     moreover
     {
       fix n
       assume n: "\<forall>i\<in>Basis. dist (f (r n) \<bullet> i) (l \<bullet> i) < e / (real_of_nat DIM('a))"
       have "dist (f (r n)) l \<le> (\<Sum>i\<in>Basis. dist (f (r n) \<bullet> i) (l \<bullet> i))"
         apply (subst euclidean_dist_l2)
         using zero_le_dist
         apply (rule L2_set_le_sum)
         done
       also have "\<dots> < (\<Sum>i\<in>(Basis::'a set). e / (real_of_nat DIM('a)))"
         apply (rule sum_strict_mono)
         using n
         apply auto
         done
       finally have "dist (f (r n)) l < e"
         by auto
     }
     ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
       by (rule eventually_mono)
   }
   then have *: "((f \<circ> r) \<longlongrightarrow> l) sequentially"
     unfolding o_def tendsto_iff by simp
   with r show "\<exists>l r. strict_mono r \<and> ((f \<circ> r) \<longlongrightarrow> l) sequentially"
     by auto
 qed
 
 instance\<^marker>\<open>tag important\<close> euclidean_space \<subseteq> banach ..
 
 instance euclidean_space \<subseteq> second_countable_topology
 proof
   define a where "a f = (\<Sum>i\<in>Basis. fst (f i) *\<^sub>R i)" for f :: "'a \<Rightarrow> real \<times> real"
   then have a: "\<And>f. (\<Sum>i\<in>Basis. fst (f i) *\<^sub>R i) = a f"
     by simp
   define b where "b f = (\<Sum>i\<in>Basis. snd (f i) *\<^sub>R i)" for f :: "'a \<Rightarrow> real \<times> real"
   then have b: "\<And>f. (\<Sum>i\<in>Basis. snd (f i) *\<^sub>R i) = b f"
     by simp
   define B where "B = (\<lambda>f. box (a f) (b f)) ` (Basis \<rightarrow>\<^sub>E (\<rat> \<times> \<rat>))"
 
   have "Ball B open" by (simp add: B_def open_box)
   moreover have "(\<forall>A. open A \<longrightarrow> (\<exists>B'\<subseteq>B. \<Union>B' = A))"
   proof safe
     fix A::"'a set"
     assume "open A"
     show "\<exists>B'\<subseteq>B. \<Union>B' = A"
       apply (rule exI[of _ "{b\<in>B. b \<subseteq> A}"])
       apply (subst (3) open_UNION_box[OF \<open>open A\<close>])
       apply (auto simp: a b B_def)
       done
   qed
   ultimately
   have "topological_basis B"
     unfolding topological_basis_def by blast
   moreover
   have "countable B"
     unfolding B_def
     by (intro countable_image countable_PiE finite_Basis countable_SIGMA countable_rat)
   ultimately show "\<exists>B::'a set set. countable B \<and> open = generate_topology B"
     by (blast intro: topological_basis_imp_subbasis)
 qed
 
 instance euclidean_space \<subseteq> polish_space ..
 
 
 subsection \<open>Compact Boxes\<close>
 
 lemma compact_cbox [simp]:
   fixes a :: "'a::euclidean_space"
   shows "compact (cbox a b)"
   using bounded_closed_imp_seq_compact[of "cbox a b"] using bounded_cbox[of a b]
   by (auto simp: compact_eq_seq_compact_metric)
 
 proposition is_interval_compact:
    "is_interval S \<and> compact S \<longleftrightarrow> (\<exists>a b. S = cbox a b)"   (is "?lhs = ?rhs")
 proof (cases "S = {}")
   case True
   with empty_as_interval show ?thesis by auto
 next
   case False
   show ?thesis
   proof
     assume L: ?lhs
     then have "is_interval S" "compact S" by auto
     define a where "a \<equiv> \<Sum>i\<in>Basis. (INF x\<in>S. x \<bullet> i) *\<^sub>R i"
     define b where "b \<equiv> \<Sum>i\<in>Basis. (SUP x\<in>S. x \<bullet> i) *\<^sub>R i"
     have 1: "\<And>x i. \<lbrakk>x \<in> S; i \<in> Basis\<rbrakk> \<Longrightarrow> (INF x\<in>S. x \<bullet> i) \<le> x \<bullet> i"
       by (simp add: cInf_lower bounded_inner_imp_bdd_below compact_imp_bounded L)
     have 2: "\<And>x i. \<lbrakk>x \<in> S; i \<in> Basis\<rbrakk> \<Longrightarrow> x \<bullet> i \<le> (SUP x\<in>S. x \<bullet> i)"
       by (simp add: cSup_upper bounded_inner_imp_bdd_above compact_imp_bounded L)
     have 3: "x \<in> S" if inf: "\<And>i. i \<in> Basis \<Longrightarrow> (INF x\<in>S. x \<bullet> i) \<le> x \<bullet> i"
                    and sup: "\<And>i. i \<in> Basis \<Longrightarrow> x \<bullet> i \<le> (SUP x\<in>S. x \<bullet> i)" for x
     proof (rule mem_box_componentwiseI [OF \<open>is_interval S\<close>])
       fix i::'a
       assume i: "i \<in> Basis"
       have cont: "continuous_on S (\<lambda>x. x \<bullet> i)"
         by (intro continuous_intros)
       obtain a where "a \<in> S" and a: "\<And>y. y\<in>S \<Longrightarrow> a \<bullet> i \<le> y \<bullet> i"
         using continuous_attains_inf [OF \<open>compact S\<close> False cont] by blast
       obtain b where "b \<in> S" and b: "\<And>y. y\<in>S \<Longrightarrow> y \<bullet> i \<le> b \<bullet> i"
         using continuous_attains_sup [OF \<open>compact S\<close> False cont] by blast
       have "a \<bullet> i \<le> (INF x\<in>S. x \<bullet> i)"
         by (simp add: False a cINF_greatest)
       also have "\<dots> \<le> x \<bullet> i"
         by (simp add: i inf)
       finally have ai: "a \<bullet> i \<le> x \<bullet> i" .
       have "x \<bullet> i \<le> (SUP x\<in>S. x \<bullet> i)"
         by (simp add: i sup)
       also have "(SUP x\<in>S. x \<bullet> i) \<le> b \<bullet> i"
         by (simp add: False b cSUP_least)
       finally have bi: "x \<bullet> i \<le> b \<bullet> i" .
       show "x \<bullet> i \<in> (\<lambda>x. x \<bullet> i) ` S"
         apply (rule_tac x="\<Sum>j\<in>Basis. (if j = i then x \<bullet> i else a \<bullet> j) *\<^sub>R j" in image_eqI)
         apply (simp add: i)
         apply (rule mem_is_intervalI [OF \<open>is_interval S\<close> \<open>a \<in> S\<close> \<open>b \<in> S\<close>])
         using i ai bi apply force
         done
     qed
     have "S = cbox a b"
       by (auto simp: a_def b_def mem_box intro: 1 2 3)
     then show ?rhs
       by blast
   next
     assume R: ?rhs
     then show ?lhs
       using compact_cbox is_interval_cbox by blast
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Componentwise limits and continuity\<close>
 
 text\<open>But is the premise really necessary? Need to generalise @{thm euclidean_dist_l2}\<close>
 lemma Euclidean_dist_upper: "i \<in> Basis \<Longrightarrow> dist (x \<bullet> i) (y \<bullet> i) \<le> dist x y"
   by (metis (no_types) member_le_L2_set euclidean_dist_l2 finite_Basis)
 
 text\<open>But is the premise \<^term>\<open>i \<in> Basis\<close> really necessary?\<close>
 lemma open_preimage_inner:
   assumes "open S" "i \<in> Basis"
     shows "open {x. x \<bullet> i \<in> S}"
 proof (rule openI, simp)
   fix x
   assume x: "x \<bullet> i \<in> S"
   with assms obtain e where "0 < e" and e: "ball (x \<bullet> i) e \<subseteq> S"
     by (auto simp: open_contains_ball_eq)
   have "\<exists>e>0. ball (y \<bullet> i) e \<subseteq> S" if dxy: "dist x y < e / 2" for y
   proof (intro exI conjI)
     have "dist (x \<bullet> i) (y \<bullet> i) < e / 2"
       by (meson \<open>i \<in> Basis\<close> dual_order.trans Euclidean_dist_upper not_le that)
     then have "dist (x \<bullet> i) z < e" if "dist (y \<bullet> i) z < e / 2" for z
       by (metis dist_commute dist_triangle_half_l that)
     then have "ball (y \<bullet> i) (e / 2) \<subseteq> ball (x \<bullet> i) e"
       using mem_ball by blast
       with e show "ball (y \<bullet> i) (e / 2) \<subseteq> S"
         by (metis order_trans)
   qed (simp add: \<open>0 < e\<close>)
   then show "\<exists>e>0. ball x e \<subseteq> {s. s \<bullet> i \<in> S}"
     by (metis (no_types, lifting) \<open>0 < e\<close> \<open>open S\<close> half_gt_zero_iff mem_Collect_eq mem_ball open_contains_ball_eq subsetI)
 qed
 
 proposition tendsto_componentwise_iff:
   fixes f :: "_ \<Rightarrow> 'b::euclidean_space"
   shows "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>i \<in> Basis. ((\<lambda>x. (f x \<bullet> i)) \<longlongrightarrow> (l \<bullet> i)) F)"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then show ?rhs
     unfolding tendsto_def
     apply clarify
     apply (drule_tac x="{s. s \<bullet> i \<in> S}" in spec)
     apply (auto simp: open_preimage_inner)
     done
 next
   assume R: ?rhs
   then have "\<And>e. e > 0 \<Longrightarrow> \<forall>i\<in>Basis. \<forall>\<^sub>F x in F. dist (f x \<bullet> i) (l \<bullet> i) < e"
     unfolding tendsto_iff by blast
   then have R': "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F x in F. \<forall>i\<in>Basis. dist (f x \<bullet> i) (l \<bullet> i) < e"
       by (simp add: eventually_ball_finite_distrib [symmetric])
   show ?lhs
   unfolding tendsto_iff
   proof clarify
     fix e::real
     assume "0 < e"
     have *: "L2_set (\<lambda>i. dist (f x \<bullet> i) (l \<bullet> i)) Basis < e"
              if "\<forall>i\<in>Basis. dist (f x \<bullet> i) (l \<bullet> i) < e / real DIM('b)" for x
     proof -
       have "L2_set (\<lambda>i. dist (f x \<bullet> i) (l \<bullet> i)) Basis \<le> sum (\<lambda>i. dist (f x \<bullet> i) (l \<bullet> i)) Basis"
         by (simp add: L2_set_le_sum)
       also have "... < DIM('b) * (e / real DIM('b))"
         apply (rule sum_bounded_above_strict)
         using that by auto
       also have "... = e"
         by (simp add: field_simps)
       finally show "L2_set (\<lambda>i. dist (f x \<bullet> i) (l \<bullet> i)) Basis < e" .
     qed
     have "\<forall>\<^sub>F x in F. \<forall>i\<in>Basis. dist (f x \<bullet> i) (l \<bullet> i) < e / DIM('b)"
       apply (rule R')
       using \<open>0 < e\<close> by simp
     then show "\<forall>\<^sub>F x in F. dist (f x) l < e"
       apply (rule eventually_mono)
       apply (subst euclidean_dist_l2)
       using * by blast
   qed
 qed
 
 
 corollary continuous_componentwise:
    "continuous F f \<longleftrightarrow> (\<forall>i \<in> Basis. continuous F (\<lambda>x. (f x \<bullet> i)))"
 by (simp add: continuous_def tendsto_componentwise_iff [symmetric])
 
 corollary continuous_on_componentwise:
   fixes S :: "'a :: t2_space set"
   shows "continuous_on S f \<longleftrightarrow> (\<forall>i \<in> Basis. continuous_on S (\<lambda>x. (f x \<bullet> i)))"
   apply (simp add: continuous_on_eq_continuous_within)
   using continuous_componentwise by blast
 
 lemma linear_componentwise_iff:
      "(linear f') \<longleftrightarrow> (\<forall>i\<in>Basis. linear (\<lambda>x. f' x \<bullet> i))"
   apply (auto simp: linear_iff inner_left_distrib)
    apply (metis inner_left_distrib euclidean_eq_iff)
   by (metis euclidean_eqI inner_scaleR_left)
 
 lemma bounded_linear_componentwise_iff:
      "(bounded_linear f') \<longleftrightarrow> (\<forall>i\<in>Basis. bounded_linear (\<lambda>x. f' x \<bullet> i))"
      (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (simp add: bounded_linear_inner_left_comp)
 next
   assume ?rhs
   then have "(\<forall>i\<in>Basis. \<exists>K. \<forall>x. \<bar>f' x \<bullet> i\<bar> \<le> norm x * K)" "linear f'"
     by (auto simp: bounded_linear_def bounded_linear_axioms_def linear_componentwise_iff [symmetric] ball_conj_distrib)
   then obtain F where F: "\<And>i x. i \<in> Basis \<Longrightarrow> \<bar>f' x \<bullet> i\<bar> \<le> norm x * F i"
     by metis
   have "norm (f' x) \<le> norm x * sum F Basis" for x
   proof -
     have "norm (f' x) \<le> (\<Sum>i\<in>Basis. \<bar>f' x \<bullet> i\<bar>)"
       by (rule norm_le_l1)
     also have "... \<le> (\<Sum>i\<in>Basis. norm x * F i)"
       by (metis F sum_mono)
     also have "... = norm x * sum F Basis"
       by (simp add: sum_distrib_left)
     finally show ?thesis .
   qed
   then show ?lhs
     by (force simp: bounded_linear_def bounded_linear_axioms_def \<open>linear f'\<close>)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Continuous Extension\<close>
 
 definition clamp :: "'a::euclidean_space \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" where
   "clamp a b x = (if (\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i)
     then (\<Sum>i\<in>Basis. (if x\<bullet>i < a\<bullet>i then a\<bullet>i else if x\<bullet>i \<le> b\<bullet>i then x\<bullet>i else b\<bullet>i) *\<^sub>R i)
     else a)"
 
 lemma clamp_in_interval[simp]:
   assumes "\<And>i. i \<in> Basis \<Longrightarrow> a \<bullet> i \<le> b \<bullet> i"
   shows "clamp a b x \<in> cbox a b"
   unfolding clamp_def
   using box_ne_empty(1)[of a b] assms by (auto simp: cbox_def)
 
 lemma clamp_cancel_cbox[simp]:
   fixes x a b :: "'a::euclidean_space"
   assumes x: "x \<in> cbox a b"
   shows "clamp a b x = x"
   using assms
   by (auto simp: clamp_def mem_box intro!: euclidean_eqI[where 'a='a])
 
 lemma clamp_empty_interval:
   assumes "i \<in> Basis" "a \<bullet> i > b \<bullet> i"
   shows "clamp a b = (\<lambda>_. a)"
   using assms
   by (force simp: clamp_def[abs_def] split: if_splits intro!: ext)
 
 lemma dist_clamps_le_dist_args:
   fixes x :: "'a::euclidean_space"
   shows "dist (clamp a b y) (clamp a b x) \<le> dist y x"
 proof cases
   assume le: "(\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i)"
   then have "(\<Sum>i\<in>Basis. (dist (clamp a b y \<bullet> i) (clamp a b x \<bullet> i))\<^sup>2) \<le>
     (\<Sum>i\<in>Basis. (dist (y \<bullet> i) (x \<bullet> i))\<^sup>2)"
     by (auto intro!: sum_mono simp: clamp_def dist_real_def abs_le_square_iff[symmetric])
   then show ?thesis
     by (auto intro: real_sqrt_le_mono
       simp: euclidean_dist_l2[where y=x] euclidean_dist_l2[where y="clamp a b x"] L2_set_def)
 qed (auto simp: clamp_def)
 
 lemma clamp_continuous_at:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::metric_space"
     and x :: 'a
   assumes f_cont: "continuous_on (cbox a b) f"
   shows "continuous (at x) (\<lambda>x. f (clamp a b x))"
 proof cases
   assume le: "(\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i)"
   show ?thesis
     unfolding continuous_at_eps_delta
   proof safe
     fix x :: 'a
     fix e :: real
     assume "e > 0"
     moreover have "clamp a b x \<in> cbox a b"
-      by (simp add: clamp_in_interval le)
+      by (simp add: le)
     moreover note f_cont[simplified continuous_on_iff]
     ultimately
     obtain d where d: "0 < d"
       "\<And>x'. x' \<in> cbox a b \<Longrightarrow> dist x' (clamp a b x) < d \<Longrightarrow> dist (f x') (f (clamp a b x)) < e"
       by force
     show "\<exists>d>0. \<forall>x'. dist x' x < d \<longrightarrow>
       dist (f (clamp a b x')) (f (clamp a b x)) < e"
       using le
       by (auto intro!: d clamp_in_interval dist_clamps_le_dist_args[THEN le_less_trans])
   qed
 qed (auto simp: clamp_empty_interval)
 
 lemma clamp_continuous_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::metric_space"
   assumes f_cont: "continuous_on (cbox a b) f"
   shows "continuous_on S (\<lambda>x. f (clamp a b x))"
   using assms
   by (auto intro: continuous_at_imp_continuous_on clamp_continuous_at)
 
 lemma clamp_bounded:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::metric_space"
   assumes bounded: "bounded (f ` (cbox a b))"
   shows "bounded (range (\<lambda>x. f (clamp a b x)))"
 proof cases
   assume le: "(\<forall>i\<in>Basis. a \<bullet> i \<le> b \<bullet> i)"
   from bounded obtain c where f_bound: "\<forall>x\<in>f ` cbox a b. dist undefined x \<le> c"
     by (auto simp: bounded_any_center[where a=undefined])
   then show ?thesis
     by (auto intro!: exI[where x=c] clamp_in_interval[OF le[rule_format]]
         simp: bounded_any_center[where a=undefined])
 qed (auto simp: clamp_empty_interval image_def)
 
 
 definition ext_cont :: "('a::euclidean_space \<Rightarrow> 'b::metric_space) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b"
   where "ext_cont f a b = (\<lambda>x. f (clamp a b x))"
 
 lemma ext_cont_cancel_cbox[simp]:
   fixes x a b :: "'a::euclidean_space"
   assumes x: "x \<in> cbox a b"
   shows "ext_cont f a b x = f x"
   using assms
   unfolding ext_cont_def
   by (auto simp: clamp_def mem_box intro!: euclidean_eqI[where 'a='a] arg_cong[where f=f])
 
 lemma continuous_on_ext_cont[continuous_intros]:
   "continuous_on (cbox a b) f \<Longrightarrow> continuous_on S (ext_cont f a b)"
   by (auto intro!: clamp_continuous_on simp: ext_cont_def)
 
 
 subsection \<open>Separability\<close>
 
 lemma univ_second_countable_sequence:
   obtains B :: "nat \<Rightarrow> 'a::euclidean_space set"
     where "inj B" "\<And>n. open(B n)" "\<And>S. open S \<Longrightarrow> \<exists>k. S = \<Union>{B n |n. n \<in> k}"
 proof -
   obtain \<B> :: "'a set set"
   where "countable \<B>"
     and opn: "\<And>C. C \<in> \<B> \<Longrightarrow> open C"
     and Un: "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<B> \<and> S = \<Union>U"
     using univ_second_countable by blast
   have *: "infinite (range (\<lambda>n. ball (0::'a) (inverse(Suc n))))"
     apply (rule Infinite_Set.range_inj_infinite)
     apply (simp add: inj_on_def ball_eq_ball_iff)
     done
   have "infinite \<B>"
   proof
     assume "finite \<B>"
     then have "finite (Union ` (Pow \<B>))"
       by simp
     then have "finite (range (\<lambda>n. ball (0::'a) (inverse(Suc n))))"
       apply (rule rev_finite_subset)
       by (metis (no_types, lifting) PowI image_eqI image_subset_iff Un [OF open_ball])
     with * show False by simp
   qed
   obtain f :: "nat \<Rightarrow> 'a set" where "\<B> = range f" "inj f"
     by (blast intro: countable_as_injective_image [OF \<open>countable \<B>\<close> \<open>infinite \<B>\<close>])
   have *: "\<exists>k. S = \<Union>{f n |n. n \<in> k}" if "open S" for S
     using Un [OF that]
     apply clarify
     apply (rule_tac x="f-`U" in exI)
     using \<open>inj f\<close> \<open>\<B> = range f\<close> apply force
     done
   show ?thesis
     apply (rule that [OF \<open>inj f\<close> _ *])
     apply (auto simp: \<open>\<B> = range f\<close> opn)
     done
 qed
 
 proposition separable:
   fixes S :: "'a::{metric_space, second_countable_topology} set"
   obtains T where "countable T" "T \<subseteq> S" "S \<subseteq> closure T"
 proof -
   obtain \<B> :: "'a set set"
     where "countable \<B>"
       and "{} \<notin> \<B>"
       and ope: "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
       and if_ope: "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
     by (meson subset_second_countable)
   then obtain f where f: "\<And>C. C \<in> \<B> \<Longrightarrow> f C \<in> C"
     by (metis equals0I)
   show ?thesis
   proof
     show "countable (f ` \<B>)"
       by (simp add: \<open>countable \<B>\<close>)
     show "f ` \<B> \<subseteq> S"
       using ope f openin_imp_subset by blast
     show "S \<subseteq> closure (f ` \<B>)"
     proof (clarsimp simp: closure_approachable)
       fix x and e::real
       assume "x \<in> S" "0 < e"
       have "openin (top_of_set S) (S \<inter> ball x e)"
         by (simp add: openin_Int_open)
       with if_ope obtain \<U> where  \<U>: "\<U> \<subseteq> \<B>" "S \<inter> ball x e = \<Union>\<U>"
         by meson
       show "\<exists>C \<in> \<B>. dist (f C) x < e"
       proof (cases "\<U> = {}")
         case True
         then show ?thesis
           using \<open>0 < e\<close>  \<U> \<open>x \<in> S\<close> by auto
       next
         case False
         then obtain C where "C \<in> \<U>" by blast
         show ?thesis
         proof
           show "dist (f C) x < e"
             by (metis Int_iff Union_iff \<U> \<open>C \<in> \<U>\<close> dist_commute f mem_ball subsetCE)
           show "C \<in> \<B>"
             using \<open>\<U> \<subseteq> \<B>\<close> \<open>C \<in> \<U>\<close> by blast
         qed
       qed
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Diameter\<close>
 
 lemma diameter_cball [simp]:
   fixes a :: "'a::euclidean_space"
   shows "diameter(cball a r) = (if r < 0 then 0 else 2*r)"
 proof -
   have "diameter(cball a r) = 2*r" if "r \<ge> 0"
   proof (rule order_antisym)
     show "diameter (cball a r) \<le> 2*r"
     proof (rule diameter_le)
       fix x y assume "x \<in> cball a r" "y \<in> cball a r"
       then have "norm (x - a) \<le> r" "norm (a - y) \<le> r"
         by (auto simp: dist_norm norm_minus_commute)
       then have "norm (x - y) \<le> r+r"
         using norm_diff_triangle_le by blast
       then show "norm (x - y) \<le> 2*r" by simp
     qed (simp add: that)
     have "2*r = dist (a + r *\<^sub>R (SOME i. i \<in> Basis)) (a - r *\<^sub>R (SOME i. i \<in> Basis))"
       apply (simp add: dist_norm)
       by (metis abs_of_nonneg mult.right_neutral norm_numeral norm_scaleR norm_some_Basis real_norm_def scaleR_2 that)
     also have "... \<le> diameter (cball a r)"
       apply (rule diameter_bounded_bound)
       using that by (auto simp: dist_norm)
     finally show "2*r \<le> diameter (cball a r)" .
   qed
   then show ?thesis by simp
 qed
 
 lemma diameter_ball [simp]:
   fixes a :: "'a::euclidean_space"
   shows "diameter(ball a r) = (if r < 0 then 0 else 2*r)"
 proof -
   have "diameter(ball a r) = 2*r" if "r > 0"
     by (metis bounded_ball diameter_closure closure_ball diameter_cball less_eq_real_def linorder_not_less that)
   then show ?thesis
     by (simp add: diameter_def)
 qed
 
 lemma diameter_closed_interval [simp]: "diameter {a..b} = (if b < a then 0 else b-a)"
 proof -
   have "{a .. b} = cball ((a+b)/2) ((b-a)/2)"
     by (auto simp: dist_norm abs_if field_split_simps split: if_split_asm)
   then show ?thesis
     by simp
 qed
 
 lemma diameter_open_interval [simp]: "diameter {a<..<b} = (if b < a then 0 else b-a)"
 proof -
   have "{a <..< b} = ball ((a+b)/2) ((b-a)/2)"
     by (auto simp: dist_norm abs_if field_split_simps split: if_split_asm)
   then show ?thesis
     by simp
 qed
 
 lemma diameter_cbox:
   fixes a b::"'a::euclidean_space"
   shows "(\<forall>i \<in> Basis. a \<bullet> i \<le> b \<bullet> i) \<Longrightarrow> diameter (cbox a b) = dist a b"
   by (force simp: diameter_def intro!: cSup_eq_maximum L2_set_mono
      simp: euclidean_dist_l2[where 'a='a] cbox_def dist_norm)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Relating linear images to open/closed/interior/closure/connected\<close>
 
 proposition open_surjective_linear_image:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "open A" "linear f" "surj f"
     shows "open(f ` A)"
 unfolding open_dist
 proof clarify
   fix x
   assume "x \<in> A"
   have "bounded (inv f ` Basis)"
     by (simp add: finite_imp_bounded)
   with bounded_pos obtain B where "B > 0" and B: "\<And>x. x \<in> inv f ` Basis \<Longrightarrow> norm x \<le> B"
     by metis
   obtain e where "e > 0" and e: "\<And>z. dist z x < e \<Longrightarrow> z \<in> A"
     by (metis open_dist \<open>x \<in> A\<close> \<open>open A\<close>)
   define \<delta> where "\<delta> \<equiv> e / B / DIM('b)"
   show "\<exists>e>0. \<forall>y. dist y (f x) < e \<longrightarrow> y \<in> f ` A"
   proof (intro exI conjI)
     show "\<delta> > 0"
       using \<open>e > 0\<close> \<open>B > 0\<close>  by (simp add: \<delta>_def field_split_simps)
     have "y \<in> f ` A" if "dist y (f x) * (B * real DIM('b)) < e" for y
     proof -
       define u where "u \<equiv> y - f x"
       show ?thesis
       proof (rule image_eqI)
         show "y = f (x + (\<Sum>i\<in>Basis. (u \<bullet> i) *\<^sub>R inv f i))"
           apply (simp add: linear_add linear_sum linear.scaleR \<open>linear f\<close> surj_f_inv_f \<open>surj f\<close>)
           apply (simp add: euclidean_representation u_def)
           done
         have "dist (x + (\<Sum>i\<in>Basis. (u \<bullet> i) *\<^sub>R inv f i)) x \<le> (\<Sum>i\<in>Basis. norm ((u \<bullet> i) *\<^sub>R inv f i))"
           by (simp add: dist_norm sum_norm_le)
         also have "... = (\<Sum>i\<in>Basis. \<bar>u \<bullet> i\<bar> * norm (inv f i))"
           by simp
         also have "... \<le> (\<Sum>i\<in>Basis. \<bar>u \<bullet> i\<bar>) * B"
           by (simp add: B sum_distrib_right sum_mono mult_left_mono)
         also have "... \<le> DIM('b) * dist y (f x) * B"
           apply (rule mult_right_mono [OF sum_bounded_above])
           using \<open>0 < B\<close> by (auto simp: Basis_le_norm dist_norm u_def)
         also have "... < e"
           by (metis mult.commute mult.left_commute that)
         finally show "x + (\<Sum>i\<in>Basis. (u \<bullet> i) *\<^sub>R inv f i) \<in> A"
           by (rule e)
       qed
     qed
     then show "\<forall>y. dist y (f x) < \<delta> \<longrightarrow> y \<in> f ` A"
       using \<open>e > 0\<close> \<open>B > 0\<close>
-      by (auto simp: \<delta>_def field_split_simps mult_less_0_iff)
+      by (auto simp: \<delta>_def field_split_simps)
   qed
 qed
 
 corollary open_bijective_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "bij f"
     shows "open(f ` A) \<longleftrightarrow> open A"
 proof
   assume "open(f ` A)"
   then have "open(f -` (f ` A))"
     using assms by (force simp: linear_continuous_at linear_conv_bounded_linear continuous_open_vimage)
   then show "open A"
     by (simp add: assms bij_is_inj inj_vimage_image_eq)
 next
   assume "open A"
   then show "open(f ` A)"
     by (simp add: assms bij_is_surj open_surjective_linear_image)
 qed
 
 corollary interior_bijective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "bij f"
   shows "interior (f ` S) = f ` interior S"  (is "?lhs = ?rhs")
 proof safe
   fix x
   assume x: "x \<in> ?lhs"
   then obtain T where "open T" and "x \<in> T" and "T \<subseteq> f ` S"
     by (metis interiorE)
   then show "x \<in> ?rhs"
     by (metis (no_types, hide_lams) assms subsetD interior_maximal open_bijective_linear_image_eq subset_image_iff)
 next
   fix x
   assume x: "x \<in> interior S"
   then show "f x \<in> interior (f ` S)"
     by (meson assms imageI image_mono interiorI interior_subset open_bijective_linear_image_eq open_interior)
 qed
 
 lemma interior_injective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "linear f" "inj f"
    shows "interior(f ` S) = f ` (interior S)"
   by (simp add: linear_injective_imp_surjective assms bijI interior_bijective_linear_image)
 
 lemma interior_surjective_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a::euclidean_space"
   assumes "linear f" "surj f"
    shows "interior(f ` S) = f ` (interior S)"
   by (simp add: assms interior_injective_linear_image linear_surjective_imp_injective)
 
 lemma interior_negations:
   fixes S :: "'a::euclidean_space set"
   shows "interior(uminus ` S) = image uminus (interior S)"
   by (simp add: bij_uminus interior_bijective_linear_image linear_uminus)
 
 lemma connected_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "linear f" and "connected s"
   shows "connected (f ` s)"
 using connected_continuous_image assms linear_continuous_on linear_conv_bounded_linear by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>"Isometry" (up to constant bounds) of Injective Linear Map\<close>
 
 proposition injective_imp_isometric:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes s: "closed s" "subspace s"
     and f: "bounded_linear f" "\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0"
   shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm x"
 proof (cases "s \<subseteq> {0::'a}")
   case True
   have "norm x \<le> norm (f x)" if "x \<in> s" for x
   proof -
     from True that have "x = 0" by auto
     then show ?thesis by simp
   qed
   then show ?thesis
     by (auto intro!: exI[where x=1])
 next
   case False
   interpret f: bounded_linear f by fact
   from False obtain a where a: "a \<noteq> 0" "a \<in> s"
     by auto
   from False have "s \<noteq> {}"
     by auto
   let ?S = "{f x| x. x \<in> s \<and> norm x = norm a}"
   let ?S' = "{x::'a. x\<in>s \<and> norm x = norm a}"
   let ?S'' = "{x::'a. norm x = norm a}"
 
   have "?S'' = frontier (cball 0 (norm a))"
     by (simp add: sphere_def dist_norm)
   then have "compact ?S''" by (metis compact_cball compact_frontier)
   moreover have "?S' = s \<inter> ?S''" by auto
   ultimately have "compact ?S'"
     using closed_Int_compact[of s ?S''] using s(1) by auto
   moreover have *:"f ` ?S' = ?S" by auto
   ultimately have "compact ?S"
     using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
   then have "closed ?S"
     using compact_imp_closed by auto
   moreover from a have "?S \<noteq> {}" by auto
   ultimately obtain b' where "b'\<in>?S" "\<forall>y\<in>?S. norm b' \<le> norm y"
     using distance_attains_inf[of ?S 0] unfolding dist_0_norm by auto
   then obtain b where "b\<in>s"
     and ba: "norm b = norm a"
     and b: "\<forall>x\<in>{x \<in> s. norm x = norm a}. norm (f b) \<le> norm (f x)"
     unfolding *[symmetric] unfolding image_iff by auto
 
   let ?e = "norm (f b) / norm b"
   have "norm b > 0"
     using ba and a and norm_ge_zero by auto
   moreover have "norm (f b) > 0"
     using f(2)[THEN bspec[where x=b], OF \<open>b\<in>s\<close>]
     using \<open>norm b >0\<close> by simp
   ultimately have "0 < norm (f b) / norm b" by simp
   moreover
   have "norm (f b) / norm b * norm x \<le> norm (f x)" if "x\<in>s" for x
   proof (cases "x = 0")
     case True
     then show "norm (f b) / norm b * norm x \<le> norm (f x)"
       by auto
   next
     case False
     with \<open>a \<noteq> 0\<close> have *: "0 < norm a / norm x"
       unfolding zero_less_norm_iff[symmetric] by simp
     have "\<forall>x\<in>s. c *\<^sub>R x \<in> s" for c
       using s[unfolded subspace_def] by simp
     with \<open>x \<in> s\<close> \<open>x \<noteq> 0\<close> have "(norm a / norm x) *\<^sub>R x \<in> {x \<in> s. norm x = norm a}"
       by simp
     with \<open>x \<noteq> 0\<close> \<open>a \<noteq> 0\<close> show "norm (f b) / norm b * norm x \<le> norm (f x)"
       using b[THEN bspec[where x="(norm a / norm x) *\<^sub>R x"]]
       unfolding f.scaleR and ba
       by (auto simp: mult.commute pos_le_divide_eq pos_divide_le_eq)
   qed
   ultimately show ?thesis by auto
 qed
 
 proposition closed_injective_image_subspace:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 \<longrightarrow> x = 0" "closed s"
   shows "closed(f ` s)"
 proof -
   obtain e where "e > 0" and e: "\<forall>x\<in>s. e * norm x \<le> norm (f x)"
     using injective_imp_isometric[OF assms(4,1,2,3)] by auto
   show ?thesis
     using complete_isometric_image[OF \<open>e>0\<close> assms(1,2) e] and assms(4)
     unfolding complete_eq_closed[symmetric] by auto
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some properties of a canonical subspace\<close>
 
 lemma closed_substandard: "closed {x::'a::euclidean_space. \<forall>i\<in>Basis. P i \<longrightarrow> x\<bullet>i = 0}"
   (is "closed ?A")
 proof -
   let ?D = "{i\<in>Basis. P i}"
   have "closed (\<Inter>i\<in>?D. {x::'a. x\<bullet>i = 0})"
-    by (simp add: closed_INT closed_Collect_eq continuous_on_inner
-        continuous_on_const continuous_on_id)
+    by (simp add: closed_INT closed_Collect_eq continuous_on_inner)
   also have "(\<Inter>i\<in>?D. {x::'a. x\<bullet>i = 0}) = ?A"
     by auto
   finally show "closed ?A" .
 qed
 
 lemma closed_subspace:
   fixes s :: "'a::euclidean_space set"
   assumes "subspace s"
   shows "closed s"
 proof -
   have "dim s \<le> card (Basis :: 'a set)"
     using dim_subset_UNIV by auto
   with ex_card[OF this] obtain d :: "'a set" where t: "card d = dim s" and d: "d \<subseteq> Basis"
     by auto
   let ?t = "{x::'a. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
   have "\<exists>f. linear f \<and> f ` {x::'a. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} = s \<and>
       inj_on f {x::'a. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
     using dim_substandard[of d] t d assms
     by (intro subspace_isomorphism[OF subspace_substandard[of "\<lambda>i. i \<notin> d"]]) (auto simp: inner_Basis)
   then obtain f where f:
       "linear f"
       "f ` {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} = s"
       "inj_on f {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
     by blast
   interpret f: bounded_linear f
     using f by (simp add: linear_conv_bounded_linear)
   have "x \<in> ?t \<Longrightarrow> f x = 0 \<Longrightarrow> x = 0" for x
     using f.zero d f(3)[THEN inj_onD, of x 0] by auto
   moreover have "closed ?t" by (rule closed_substandard)
   moreover have "subspace ?t" by (rule subspace_substandard)
   ultimately show ?thesis
     using closed_injective_image_subspace[of ?t f]
     unfolding f(2) using f(1) unfolding linear_conv_bounded_linear by auto
 qed
 
 lemma complete_subspace: "subspace s \<Longrightarrow> complete s"
   for s :: "'a::euclidean_space set"
   using complete_eq_closed closed_subspace by auto
 
 lemma closed_span [iff]: "closed (span s)"
   for s :: "'a::euclidean_space set"
-  by (simp add: closed_subspace subspace_span)
+  by (simp add: closed_subspace)
 
 lemma dim_closure [simp]: "dim (closure s) = dim s" (is "?dc = ?d")
   for s :: "'a::euclidean_space set"
 proof -
   have "?dc \<le> ?d"
     using closure_minimal[OF span_superset, of s]
     using closed_subspace[OF subspace_span, of s]
     using dim_subset[of "closure s" "span s"]
     by simp
   then show ?thesis
     using dim_subset[OF closure_subset, of s]
     by simp
 qed
 
 
 subsection \<open>Set Distance\<close>
 
 lemma setdist_compact_closed:
   fixes A :: "'a::heine_borel set"
   assumes A: "compact A" and B: "closed B"
     and "A \<noteq> {}" "B \<noteq> {}"
   shows "\<exists>x \<in> A. \<exists>y \<in> B. dist x y = setdist A B"
 proof -
   obtain x where "x \<in> A" "setdist A B = infdist x B"
     by (metis A assms(3) setdist_attains_inf setdist_sym)
   moreover
   obtain y where"y \<in> B" "infdist x B = dist x y"
     using B \<open>B \<noteq> {}\<close> infdist_attains_inf by blast
   ultimately show ?thesis
     using \<open>x \<in> A\<close> \<open>y \<in> B\<close> by auto
 qed
 
 lemma setdist_closed_compact:
   fixes S :: "'a::heine_borel set"
   assumes S: "closed S" and T: "compact T"
       and "S \<noteq> {}" "T \<noteq> {}"
     shows "\<exists>x \<in> S. \<exists>y \<in> T. dist x y = setdist S T"
   using setdist_compact_closed [OF T S \<open>T \<noteq> {}\<close> \<open>S \<noteq> {}\<close>]
   by (metis dist_commute setdist_sym)
 
 lemma setdist_eq_0_compact_closed:
   assumes S: "compact S" and T: "closed T"
     shows "setdist S T = 0 \<longleftrightarrow> S = {} \<or> T = {} \<or> S \<inter> T \<noteq> {}"
 proof (cases "S = {} \<or> T = {}")
   case True
   then show ?thesis
     by force
 next
   case False
   then show ?thesis
     by (metis S T disjoint_iff_not_equal in_closed_iff_infdist_zero setdist_attains_inf setdist_eq_0I setdist_sym)
 qed
 
 corollary setdist_gt_0_compact_closed:
   assumes S: "compact S" and T: "closed T"
     shows "setdist S T > 0 \<longleftrightarrow> (S \<noteq> {} \<and> T \<noteq> {} \<and> S \<inter> T = {})"
   using setdist_pos_le [of S T] setdist_eq_0_compact_closed [OF assms] by linarith
 
 lemma setdist_eq_0_closed_compact:
   assumes S: "closed S" and T: "compact T"
     shows "setdist S T = 0 \<longleftrightarrow> S = {} \<or> T = {} \<or> S \<inter> T \<noteq> {}"
   using setdist_eq_0_compact_closed [OF T S]
   by (metis Int_commute setdist_sym)
 
 lemma setdist_eq_0_bounded:
   fixes S :: "'a::heine_borel set"
   assumes "bounded S \<or> bounded T"
   shows "setdist S T = 0 \<longleftrightarrow> S = {} \<or> T = {} \<or> closure S \<inter> closure T \<noteq> {}"
 proof (cases "S = {} \<or> T = {}")
   case False
   then show ?thesis
     using setdist_eq_0_compact_closed [of "closure S" "closure T"]
           setdist_eq_0_closed_compact [of "closure S" "closure T"] assms
     by (force simp:  bounded_closure compact_eq_bounded_closed)
 qed force
 
 lemma setdist_eq_0_sing_1:
   "setdist {x} S = 0 \<longleftrightarrow> S = {} \<or> x \<in> closure S"
   by (metis in_closure_iff_infdist_zero infdist_def infdist_eq_setdist)
 
 lemma setdist_eq_0_sing_2:
   "setdist S {x} = 0 \<longleftrightarrow> S = {} \<or> x \<in> closure S"
   by (metis setdist_eq_0_sing_1 setdist_sym)
 
 lemma setdist_neq_0_sing_1:
   "\<lbrakk>setdist {x} S = a; a \<noteq> 0\<rbrakk> \<Longrightarrow> S \<noteq> {} \<and> x \<notin> closure S"
   by (metis setdist_closure_2 setdist_empty2 setdist_eq_0I singletonI)
 
 lemma setdist_neq_0_sing_2:
   "\<lbrakk>setdist S {x} = a; a \<noteq> 0\<rbrakk> \<Longrightarrow> S \<noteq> {} \<and> x \<notin> closure S"
   by (simp add: setdist_neq_0_sing_1 setdist_sym)
 
 lemma setdist_sing_in_set:
    "x \<in> S \<Longrightarrow> setdist {x} S = 0"
   by (simp add: setdist_eq_0I)
 
 lemma setdist_eq_0_closed:
    "closed S \<Longrightarrow> (setdist {x} S = 0 \<longleftrightarrow> S = {} \<or> x \<in> S)"
 by (simp add: setdist_eq_0_sing_1)
 
 lemma setdist_eq_0_closedin:
   shows "\<lbrakk>closedin (top_of_set U) S; x \<in> U\<rbrakk>
          \<Longrightarrow> (setdist {x} S = 0 \<longleftrightarrow> S = {} \<or> x \<in> S)"
   by (auto simp: closedin_limpt setdist_eq_0_sing_1 closure_def)
 
 lemma setdist_gt_0_closedin:
   shows "\<lbrakk>closedin (top_of_set U) S; x \<in> U; S \<noteq> {}; x \<notin> S\<rbrakk>
          \<Longrightarrow> setdist {x} S > 0"
   using less_eq_real_def setdist_eq_0_closedin by fastforce
 
 no_notation
   eucl_less (infix "<e" 50)
 
 end
diff --git a/src/HOL/Analysis/Weierstrass_Theorems.thy b/src/HOL/Analysis/Weierstrass_Theorems.thy
--- a/src/HOL/Analysis/Weierstrass_Theorems.thy
+++ b/src/HOL/Analysis/Weierstrass_Theorems.thy
@@ -1,1417 +1,1417 @@
 section \<open>Bernstein-Weierstrass and Stone-Weierstrass\<close>
 
 text\<open>By L C Paulson (2015)\<close>
 
 theory Weierstrass_Theorems
 imports Uniform_Limit Path_Connected Derivative
 begin
 
 subsection \<open>Bernstein polynomials\<close>
 
 definition\<^marker>\<open>tag important\<close> Bernstein :: "[nat,nat,real] \<Rightarrow> real" where
   "Bernstein n k x \<equiv> of_nat (n choose k) * x ^ k * (1 - x) ^ (n - k)"
 
 lemma Bernstein_nonneg: "\<lbrakk>0 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> Bernstein n k x"
   by (simp add: Bernstein_def)
 
 lemma Bernstein_pos: "\<lbrakk>0 < x; x < 1; k \<le> n\<rbrakk> \<Longrightarrow> 0 < Bernstein n k x"
   by (simp add: Bernstein_def)
 
 lemma sum_Bernstein [simp]: "(\<Sum>k\<le>n. Bernstein n k x) = 1"
   using binomial_ring [of x "1-x" n]
   by (simp add: Bernstein_def)
 
 lemma binomial_deriv1:
     "(\<Sum>k\<le>n. (of_nat k * of_nat (n choose k)) * a^(k-1) * b^(n-k)) = real_of_nat n * (a+b) ^ (n-1)"
   apply (rule DERIV_unique [where f = "\<lambda>a. (a+b)^n" and x=a])
   apply (subst binomial_ring)
   apply (rule derivative_eq_intros sum.cong | simp add: atMost_atLeast0)+
   done
 
 lemma binomial_deriv2:
     "(\<Sum>k\<le>n. (of_nat k * of_nat (k-1) * of_nat (n choose k)) * a^(k-2) * b^(n-k)) =
      of_nat n * of_nat (n-1) * (a+b::real) ^ (n-2)"
   apply (rule DERIV_unique [where f = "\<lambda>a. of_nat n * (a+b::real) ^ (n-1)" and x=a])
   apply (subst binomial_deriv1 [symmetric])
   apply (rule derivative_eq_intros sum.cong | simp add: Num.numeral_2_eq_2)+
   done
 
 lemma sum_k_Bernstein [simp]: "(\<Sum>k\<le>n. real k * Bernstein n k x) = of_nat n * x"
   apply (subst binomial_deriv1 [of n x "1-x", simplified, symmetric])
   apply (simp add: sum_distrib_right)
   apply (auto simp: Bernstein_def algebra_simps power_eq_if intro!: sum.cong)
   done
 
 lemma sum_kk_Bernstein [simp]: "(\<Sum>k\<le>n. real k * (real k - 1) * Bernstein n k x) = real n * (real n - 1) * x\<^sup>2"
 proof -
   have "(\<Sum>k\<le>n. real k * (real k - 1) * Bernstein n k x) =
         (\<Sum>k\<le>n. real k * real (k - Suc 0) * real (n choose k) * x ^ (k - 2) * (1 - x) ^ (n - k) * x\<^sup>2)"
   proof (rule sum.cong [OF refl], simp)
     fix k
     assume "k \<le> n"
     then consider "k = 0" | "k = 1" | k' where "k = Suc (Suc k')"
       by (metis One_nat_def not0_implies_Suc)
     then show "k = 0 \<or>
           (real k - 1) * Bernstein n k x =
           real (k - Suc 0) *
           (real (n choose k) * (x ^ (k - 2) * ((1 - x) ^ (n - k) * x\<^sup>2)))"
       by cases (auto simp add: Bernstein_def power2_eq_square algebra_simps)
   qed
   also have "... = real_of_nat n * real_of_nat (n - Suc 0) * x\<^sup>2"
     by (subst binomial_deriv2 [of n x "1-x", simplified, symmetric]) (simp add: sum_distrib_right)
   also have "... = n * (n - 1) * x\<^sup>2"
     by auto
   finally show ?thesis
     by auto
 qed
 
 subsection \<open>Explicit Bernstein version of the 1D Weierstrass approximation theorem\<close>
 
 theorem Bernstein_Weierstrass:
   fixes f :: "real \<Rightarrow> real"
   assumes contf: "continuous_on {0..1} f" and e: "0 < e"
     shows "\<exists>N. \<forall>n x. N \<le> n \<and> x \<in> {0..1}
                     \<longrightarrow> \<bar>f x - (\<Sum>k\<le>n. f(k/n) * Bernstein n k x)\<bar> < e"
 proof -
   have "bounded (f ` {0..1})"
     using compact_continuous_image compact_imp_bounded contf by blast
   then obtain M where M: "\<And>x. 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> \<bar>f x\<bar> \<le> M"
     by (force simp add: bounded_iff)
   then have Mge0: "0 \<le> M" by force
   have ucontf: "uniformly_continuous_on {0..1} f"
     using compact_uniformly_continuous contf by blast
   then obtain d where d: "d>0" "\<And>x x'. \<lbrakk> x \<in> {0..1}; x' \<in> {0..1}; \<bar>x' - x\<bar> < d\<rbrakk> \<Longrightarrow> \<bar>f x' - f x\<bar> < e/2"
      apply (rule uniformly_continuous_onE [where e = "e/2"])
      using e by (auto simp: dist_norm)
   { fix n::nat and x::real
     assume n: "Suc (nat\<lceil>4*M/(e*d\<^sup>2)\<rceil>) \<le> n" and x: "0 \<le> x" "x \<le> 1"
     have "0 < n" using n by simp
     have ed0: "- (e * d\<^sup>2) < 0"
       using e \<open>0<d\<close> by simp
     also have "... \<le> M * 4"
       using \<open>0\<le>M\<close> by simp
     finally have [simp]: "real_of_int (nat \<lceil>4 * M / (e * d\<^sup>2)\<rceil>) = real_of_int \<lceil>4 * M / (e * d\<^sup>2)\<rceil>"
       using \<open>0\<le>M\<close> e \<open>0<d\<close>
       by (simp add: field_simps)
     have "4*M/(e*d\<^sup>2) + 1 \<le> real (Suc (nat\<lceil>4*M/(e*d\<^sup>2)\<rceil>))"
       by (simp add: real_nat_ceiling_ge)
     also have "... \<le> real n"
       using n by (simp add: field_simps)
     finally have nbig: "4*M/(e*d\<^sup>2) + 1 \<le> real n" .
     have sum_bern: "(\<Sum>k\<le>n. (x - k/n)\<^sup>2 * Bernstein n k x) = x * (1 - x) / n"
     proof -
       have *: "\<And>a b x::real. (a - b)\<^sup>2 * x = a * (a - 1) * x + (1 - 2 * b) * a * x + b * b * x"
         by (simp add: algebra_simps power2_eq_square)
       have "(\<Sum>k\<le>n. (k - n * x)\<^sup>2 * Bernstein n k x) = n * x * (1 - x)"
         apply (simp add: * sum.distrib)
         apply (simp flip: sum_distrib_left add: mult.assoc)
         apply (simp add: algebra_simps power2_eq_square)
         done
       then have "(\<Sum>k\<le>n. (k - n * x)\<^sup>2 * Bernstein n k x)/n^2 = x * (1 - x) / n"
         by (simp add: power2_eq_square)
       then show ?thesis
         using n by (simp add: sum_divide_distrib field_split_simps mult.commute power2_commute)
     qed
     { fix k
       assume k: "k \<le> n"
       then have kn: "0 \<le> k / n" "k / n \<le> 1"
         by (auto simp: field_split_simps)
       consider (lessd) "\<bar>x - k / n\<bar> < d" | (ged) "d \<le> \<bar>x - k / n\<bar>"
         by linarith
       then have "\<bar>(f x - f (k/n))\<bar> \<le> e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2"
       proof cases
         case lessd
         then have "\<bar>(f x - f (k/n))\<bar> < e/2"
           using d x kn by (simp add: abs_minus_commute)
         also have "... \<le> (e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2)"
           using Mge0 d by simp
         finally show ?thesis by simp
       next
         case ged
         then have dle: "d\<^sup>2 \<le> (x - k/n)\<^sup>2"
           by (metis d(1) less_eq_real_def power2_abs power_mono)
         have "\<bar>(f x - f (k/n))\<bar> \<le> \<bar>f x\<bar> + \<bar>f (k/n)\<bar>"
           by (rule abs_triangle_ineq4)
         also have "... \<le> M+M"
           by (meson M add_mono_thms_linordered_semiring(1) kn x)
         also have "... \<le> 2 * M * ((x - k/n)\<^sup>2 / d\<^sup>2)"
           apply simp
           apply (rule Rings.ordered_semiring_class.mult_left_mono [of 1 "((x - k/n)\<^sup>2 / d\<^sup>2)", simplified])
           using dle \<open>d>0\<close> \<open>M\<ge>0\<close> by auto
         also have "... \<le> e/2 + 2 * M / d\<^sup>2 * (x - k/n)\<^sup>2"
           using e  by simp
         finally show ?thesis .
         qed
     } note * = this
     have "\<bar>f x - (\<Sum>k\<le>n. f(k / n) * Bernstein n k x)\<bar> \<le> \<bar>\<Sum>k\<le>n. (f x - f(k / n)) * Bernstein n k x\<bar>"
       by (simp add: sum_subtractf sum_distrib_left [symmetric] algebra_simps)
     also have "... \<le> (\<Sum>k\<le>n. (e/2 + (2 * M / d\<^sup>2) * (x - k / n)\<^sup>2) * Bernstein n k x)"
       apply (rule order_trans [OF sum_abs sum_mono])
       using *
       apply (simp add: abs_mult Bernstein_nonneg x mult_right_mono)
       done
     also have "... \<le> e/2 + (2 * M) / (d\<^sup>2 * n)"
       apply (simp only: sum.distrib Rings.semiring_class.distrib_right sum_distrib_left [symmetric] mult.assoc sum_bern)
       using \<open>d>0\<close> x
       apply (simp add: divide_simps Mge0 mult_le_one mult_left_le)
       done
     also have "... < e"
       apply (simp add: field_simps)
       using \<open>d>0\<close> nbig e \<open>n>0\<close>
       apply (simp add: field_split_simps algebra_simps)
       using ed0 by linarith
     finally have "\<bar>f x - (\<Sum>k\<le>n. f (real k / real n) * Bernstein n k x)\<bar> < e" .
   }
   then show ?thesis
     by auto
 qed
 
 
 subsection \<open>General Stone-Weierstrass theorem\<close>
 
 text\<open>Source:
 Bruno Brosowski and Frank Deutsch.
 An Elementary Proof of the Stone-Weierstrass Theorem.
 Proceedings of the American Mathematical Society
 Volume 81, Number 1, January 1981.
 DOI: 10.2307/2043993  \<^url>\<open>https://www.jstor.org/stable/2043993\<close>\<close>
 
 locale function_ring_on =
   fixes R :: "('a::t2_space \<Rightarrow> real) set" and S :: "'a set"
   assumes compact: "compact S"
   assumes continuous: "f \<in> R \<Longrightarrow> continuous_on S f"
   assumes add: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x + g x) \<in> R"
   assumes mult: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x * g x) \<in> R"
   assumes const: "(\<lambda>_. c) \<in> R"
   assumes separable: "x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>f\<in>R. f x \<noteq> f y"
 
 begin
   lemma minus: "f \<in> R \<Longrightarrow> (\<lambda>x. - f x) \<in> R"
     by (frule mult [OF const [of "-1"]]) simp
 
   lemma diff: "f \<in> R \<Longrightarrow> g \<in> R \<Longrightarrow> (\<lambda>x. f x - g x) \<in> R"
     unfolding diff_conv_add_uminus by (metis add minus)
 
   lemma power: "f \<in> R \<Longrightarrow> (\<lambda>x. f x ^ n) \<in> R"
     by (induct n) (auto simp: const mult)
 
   lemma sum: "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> f i \<in> R\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Sum>i \<in> I. f i x) \<in> R"
     by (induct I rule: finite_induct; simp add: const add)
 
   lemma prod: "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> f i \<in> R\<rbrakk> \<Longrightarrow> (\<lambda>x. \<Prod>i \<in> I. f i x) \<in> R"
     by (induct I rule: finite_induct; simp add: const mult)
 
   definition\<^marker>\<open>tag important\<close> normf :: "('a::t2_space \<Rightarrow> real) \<Rightarrow> real"
     where "normf f \<equiv> SUP x\<in>S. \<bar>f x\<bar>"
 
   lemma normf_upper: "\<lbrakk>continuous_on S f; x \<in> S\<rbrakk> \<Longrightarrow> \<bar>f x\<bar> \<le> normf f"
     apply (simp add: normf_def)
     apply (rule cSUP_upper, assumption)
     by (simp add: bounded_imp_bdd_above compact compact_continuous_image compact_imp_bounded continuous_on_rabs)
 
   lemma normf_least: "S \<noteq> {} \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> \<bar>f x\<bar> \<le> M) \<Longrightarrow> normf f \<le> M"
     by (simp add: normf_def cSUP_least)
 
 end
 
 lemma (in function_ring_on) one:
   assumes U: "open U" and t0: "t0 \<in> S" "t0 \<in> U" and t1: "t1 \<in> S-U"
     shows "\<exists>V. open V \<and> t0 \<in> V \<and> S \<inter> V \<subseteq> U \<and>
                (\<forall>e>0. \<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>t \<in> S \<inter> V. f t < e) \<and> (\<forall>t \<in> S - U. f t > 1 - e))"
 proof -
   have "\<exists>pt \<in> R. pt t0 = 0 \<and> pt t > 0 \<and> pt ` S \<subseteq> {0..1}" if t: "t \<in> S - U" for t
   proof -
     have "t \<noteq> t0" using t t0 by auto
     then obtain g where g: "g \<in> R" "g t \<noteq> g t0"
       using separable t0  by (metis Diff_subset subset_eq t)
     define h where [abs_def]: "h x = g x - g t0" for x
     have "h \<in> R"
       unfolding h_def by (fast intro: g const diff)
     then have hsq: "(\<lambda>w. (h w)\<^sup>2) \<in> R"
       by (simp add: power2_eq_square mult)
     have "h t \<noteq> h t0"
       by (simp add: h_def g)
     then have "h t \<noteq> 0"
       by (simp add: h_def)
     then have ht2: "0 < (h t)^2"
       by simp
     also have "... \<le> normf (\<lambda>w. (h w)\<^sup>2)"
       using t normf_upper [where x=t] continuous [OF hsq] by force
     finally have nfp: "0 < normf (\<lambda>w. (h w)\<^sup>2)" .
     define p where [abs_def]: "p x = (1 / normf (\<lambda>w. (h w)\<^sup>2)) * (h x)^2" for x
     have "p \<in> R"
       unfolding p_def by (fast intro: hsq const mult)
     moreover have "p t0 = 0"
       by (simp add: p_def h_def)
     moreover have "p t > 0"
       using nfp ht2 by (simp add: p_def)
     moreover have "\<And>x. x \<in> S \<Longrightarrow> p x \<in> {0..1}"
       using nfp normf_upper [OF continuous [OF hsq] ] by (auto simp: p_def)
     ultimately show "\<exists>pt \<in> R. pt t0 = 0 \<and> pt t > 0 \<and> pt ` S \<subseteq> {0..1}"
       by auto
   qed
   then obtain pf where pf: "\<And>t. t \<in> S-U \<Longrightarrow> pf t \<in> R \<and> pf t t0 = 0 \<and> pf t t > 0"
                    and pf01: "\<And>t. t \<in> S-U \<Longrightarrow> pf t ` S \<subseteq> {0..1}"
     by metis
   have com_sU: "compact (S-U)"
     using compact closed_Int_compact U by (simp add: Diff_eq compact_Int_closed open_closed)
   have "\<And>t. t \<in> S-U \<Longrightarrow> \<exists>A. open A \<and> A \<inter> S = {x\<in>S. 0 < pf t x}"
     apply (rule open_Collect_positive)
     by (metis pf continuous)
   then obtain Uf where Uf: "\<And>t. t \<in> S-U \<Longrightarrow> open (Uf t) \<and> (Uf t) \<inter> S = {x\<in>S. 0 < pf t x}"
     by metis
   then have open_Uf: "\<And>t. t \<in> S-U \<Longrightarrow> open (Uf t)"
     by blast
   have tUft: "\<And>t. t \<in> S-U \<Longrightarrow> t \<in> Uf t"
     using pf Uf by blast
   then have *: "S-U \<subseteq> (\<Union>x \<in> S-U. Uf x)"
     by blast
   obtain subU where subU: "subU \<subseteq> S - U" "finite subU" "S - U \<subseteq> (\<Union>x \<in> subU. Uf x)"
     by (blast intro: that compactE_image [OF com_sU open_Uf *])
   then have [simp]: "subU \<noteq> {}"
     using t1 by auto
   then have cardp: "card subU > 0" using subU
     by (simp add: card_gt_0_iff)
   define p where [abs_def]: "p x = (1 / card subU) * (\<Sum>t \<in> subU. pf t x)" for x
   have pR: "p \<in> R"
     unfolding p_def using subU pf by (fast intro: pf const mult sum)
   have pt0 [simp]: "p t0 = 0"
     using subU pf by (auto simp: p_def intro: sum.neutral)
   have pt_pos: "p t > 0" if t: "t \<in> S-U" for t
   proof -
     obtain i where i: "i \<in> subU" "t \<in> Uf i" using subU t by blast
     show ?thesis
       using subU i t
       apply (clarsimp simp: p_def field_split_simps)
       apply (rule sum_pos2 [OF \<open>finite subU\<close>])
       using Uf t pf01 apply auto
       apply (force elim!: subsetCE)
       done
   qed
   have p01: "p x \<in> {0..1}" if t: "x \<in> S" for x
   proof -
     have "0 \<le> p x"
       using subU cardp t
       apply (simp add: p_def field_split_simps sum_nonneg)
       apply (rule sum_nonneg)
       using pf01 by force
     moreover have "p x \<le> 1"
       using subU cardp t
       apply (simp add: p_def field_split_simps sum_nonneg)
       apply (rule sum_bounded_above [where 'a=real and K=1, simplified])
       using pf01 by force
     ultimately show ?thesis
       by auto
   qed
   have "compact (p ` (S-U))"
     by (meson Diff_subset com_sU compact_continuous_image continuous continuous_on_subset pR)
   then have "open (- (p ` (S-U)))"
     by (simp add: compact_imp_closed open_Compl)
   moreover have "0 \<in> - (p ` (S-U))"
     by (metis (no_types) ComplI image_iff not_less_iff_gr_or_eq pt_pos)
   ultimately obtain delta0 where delta0: "delta0 > 0" "ball 0 delta0 \<subseteq> - (p ` (S-U))"
     by (auto simp: elim!: openE)
   then have pt_delta: "\<And>x. x \<in> S-U \<Longrightarrow> p x \<ge> delta0"
     by (force simp: ball_def dist_norm dest: p01)
   define \<delta> where "\<delta> = delta0/2"
   have "delta0 \<le> 1" using delta0 p01 [of t1] t1
       by (force simp: ball_def dist_norm dest: p01)
   with delta0 have \<delta>01: "0 < \<delta>" "\<delta> < 1"
     by (auto simp: \<delta>_def)
   have pt_\<delta>: "\<And>x. x \<in> S-U \<Longrightarrow> p x \<ge> \<delta>"
     using pt_delta delta0 by (force simp: \<delta>_def)
   have "\<exists>A. open A \<and> A \<inter> S = {x\<in>S. p x < \<delta>/2}"
     by (rule open_Collect_less_Int [OF continuous [OF pR] continuous_on_const])
   then obtain V where V: "open V" "V \<inter> S = {x\<in>S. p x < \<delta>/2}"
     by blast
   define k where "k = nat\<lfloor>1/\<delta>\<rfloor> + 1"
   have "k>0"  by (simp add: k_def)
   have "k-1 \<le> 1/\<delta>"
     using \<delta>01 by (simp add: k_def)
   with \<delta>01 have "k \<le> (1+\<delta>)/\<delta>"
     by (auto simp: algebra_simps add_divide_distrib)
   also have "... < 2/\<delta>"
     using \<delta>01 by (auto simp: field_split_simps)
   finally have k2\<delta>: "k < 2/\<delta>" .
   have "1/\<delta> < k"
     using \<delta>01 unfolding k_def by linarith
   with \<delta>01 k2\<delta> have k\<delta>: "1 < k*\<delta>" "k*\<delta> < 2"
     by (auto simp: field_split_simps)
   define q where [abs_def]: "q n t = (1 - p t ^ n) ^ (k^n)" for n t
   have qR: "q n \<in> R" for n
     by (simp add: q_def const diff power pR)
   have q01: "\<And>n t. t \<in> S \<Longrightarrow> q n t \<in> {0..1}"
     using p01 by (simp add: q_def power_le_one algebra_simps)
   have qt0 [simp]: "\<And>n. n>0 \<Longrightarrow> q n t0 = 1"
     using t0 pf by (simp add: q_def power_0_left)
   { fix t and n::nat
     assume t: "t \<in> S \<inter> V"
     with \<open>k>0\<close> V have "k * p t < k * \<delta> / 2"
        by force
     then have "1 - (k * \<delta> / 2)^n \<le> 1 - (k * p t)^n"
       using  \<open>k>0\<close> p01 t by (simp add: power_mono)
     also have "... \<le> q n t"
       using Bernoulli_inequality [of "- ((p t)^n)" "k^n"]
       apply (simp add: q_def)
       by (metis IntE atLeastAtMost_iff p01 power_le_one power_mult_distrib t)
     finally have "1 - (k * \<delta> / 2) ^ n \<le> q n t" .
   } note limitV = this
   { fix t and n::nat
     assume t: "t \<in> S - U"
     with \<open>k>0\<close> U have "k * \<delta> \<le> k * p t"
       by (simp add: pt_\<delta>)
     with k\<delta> have kpt: "1 < k * p t"
       by (blast intro: less_le_trans)
     have ptn_pos: "0 < p t ^ n"
       using pt_pos [OF t] by simp
     have ptn_le: "p t ^ n \<le> 1"
       by (meson DiffE atLeastAtMost_iff p01 power_le_one t)
     have "q n t = (1/(k^n * (p t)^n)) * (1 - p t ^ n) ^ (k^n) * k^n * (p t)^n"
       using pt_pos [OF t] \<open>k>0\<close> by (simp add: q_def)
     also have "... \<le> (1/(k * (p t))^n) * (1 - p t ^ n) ^ (k^n) * (1 + k^n * (p t)^n)"
       using pt_pos [OF t] \<open>k>0\<close>
       apply simp
       apply (simp only: times_divide_eq_right [symmetric])
       apply (rule mult_left_mono [of "1::real", simplified])
       apply (simp_all add: power_mult_distrib)
       apply (rule zero_le_power)
       using ptn_le by linarith
     also have "... \<le> (1/(k * (p t))^n) * (1 - p t ^ n) ^ (k^n) * (1 + (p t)^n) ^ (k^n)"
       apply (rule mult_left_mono [OF Bernoulli_inequality [of "p t ^ n" "k^n"]])
       using \<open>k>0\<close> ptn_pos ptn_le
       apply (auto simp: power_mult_distrib)
       done
     also have "... = (1/(k * (p t))^n) * (1 - p t ^ (2*n)) ^ (k^n)"
       using pt_pos [OF t] \<open>k>0\<close>
       by (simp add: algebra_simps power_mult power2_eq_square flip: power_mult_distrib)
     also have "... \<le> (1/(k * (p t))^n) * 1"
       apply (rule mult_left_mono [OF power_le_one])
       using pt_pos \<open>k>0\<close> p01 power_le_one t apply auto
       done
     also have "... \<le> (1 / (k*\<delta>))^n"
       using \<open>k>0\<close> \<delta>01  power_mono pt_\<delta> t
       by (fastforce simp: field_simps)
     finally have "q n t \<le> (1 / (real k * \<delta>)) ^ n " .
   } note limitNonU = this
   define NN
     where "NN e = 1 + nat \<lceil>max (ln e / ln (real k * \<delta> / 2)) (- ln e / ln (real k * \<delta>))\<rceil>" for e
   have NN: "of_nat (NN e) > ln e / ln (real k * \<delta> / 2)"  "of_nat (NN e) > - ln e / ln (real k * \<delta>)"
               if "0<e" for e
       unfolding NN_def  by linarith+
   have NN1: "\<And>e. e>0 \<Longrightarrow> (k * \<delta> / 2)^NN e < e"
     apply (subst Transcendental.ln_less_cancel_iff [symmetric])
       prefer 3 apply (subst ln_realpow)
     using \<open>k>0\<close> \<open>\<delta>>0\<close> NN  k\<delta>
     apply (force simp add: field_simps)+
     done
   have NN0: "(1/(k*\<delta>)) ^ (NN e) < e" if "e>0" for e
   proof -
     have "0 < ln (real k) + ln \<delta>"
       using \<delta>01(1) \<open>0 < k\<close> k\<delta>(1) ln_gt_zero ln_mult by fastforce 
     then have "real (NN e) * ln (1 / (real k * \<delta>)) < ln e"
       using k\<delta>(1) NN(2) [of e] that by (simp add: ln_div divide_simps)
     then have "exp (real (NN e) * ln (1 / (real k * \<delta>))) < e"
       by (metis exp_less_mono exp_ln that)
     then show ?thesis
       by (simp add: \<delta>01(1) \<open>0 < k\<close> exp_of_nat_mult)
   qed
   { fix t and e::real
     assume "e>0"
     have "t \<in> S \<inter> V \<Longrightarrow> 1 - q (NN e) t < e" "t \<in> S - U \<Longrightarrow> q (NN e) t < e"
     proof -
       assume t: "t \<in> S \<inter> V"
       show "1 - q (NN e) t < e"
         by (metis add.commute diff_le_eq not_le limitV [OF t] less_le_trans [OF NN1 [OF \<open>e>0\<close>]])
     next
       assume t: "t \<in> S - U"
       show "q (NN e) t < e"
       using  limitNonU [OF t] less_le_trans [OF NN0 [OF \<open>e>0\<close>]] not_le by blast
     qed
   } then have "\<And>e. e > 0 \<Longrightarrow> \<exists>f\<in>R. f ` S \<subseteq> {0..1} \<and> (\<forall>t \<in> S \<inter> V. f t < e) \<and> (\<forall>t \<in> S - U. 1 - e < f t)"
     using q01
     by (rule_tac x="\<lambda>x. 1 - q (NN e) x" in bexI) (auto simp: algebra_simps intro: diff const qR)
   moreover have t0V: "t0 \<in> V"  "S \<inter> V \<subseteq> U"
     using pt_\<delta> t0 U V \<delta>01  by fastforce+
   ultimately show ?thesis using V t0V
     by blast
 qed
 
 text\<open>Non-trivial case, with \<^term>\<open>A\<close> and \<^term>\<open>B\<close> both non-empty\<close>
 lemma (in function_ring_on) two_special:
   assumes A: "closed A" "A \<subseteq> S" "a \<in> A"
       and B: "closed B" "B \<subseteq> S" "b \<in> B"
       and disj: "A \<inter> B = {}"
       and e: "0 < e" "e < 1"
     shows "\<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> A. f x < e) \<and> (\<forall>x \<in> B. f x > 1 - e)"
 proof -
   { fix w
     assume "w \<in> A"
     then have "open ( - B)" "b \<in> S" "w \<notin> B" "w \<in> S"
       using assms by auto
     then have "\<exists>V. open V \<and> w \<in> V \<and> S \<inter> V \<subseteq> -B \<and>
                (\<forall>e>0. \<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> S \<inter> V. f x < e) \<and> (\<forall>x \<in> S \<inter> B. f x > 1 - e))"
       using one [of "-B" w b] assms \<open>w \<in> A\<close> by simp
   }
   then obtain Vf where Vf:
          "\<And>w. w \<in> A \<Longrightarrow> open (Vf w) \<and> w \<in> Vf w \<and> S \<inter> Vf w \<subseteq> -B \<and>
                          (\<forall>e>0. \<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> S \<inter> Vf w. f x < e) \<and> (\<forall>x \<in> S \<inter> B. f x > 1 - e))"
     by metis
   then have open_Vf: "\<And>w. w \<in> A \<Longrightarrow> open (Vf w)"
     by blast
   have tVft: "\<And>w. w \<in> A \<Longrightarrow> w \<in> Vf w"
     using Vf by blast
   then have sum_max_0: "A \<subseteq> (\<Union>x \<in> A. Vf x)"
     by blast
   have com_A: "compact A" using A
     by (metis compact compact_Int_closed inf.absorb_iff2)
   obtain subA where subA: "subA \<subseteq> A" "finite subA" "A \<subseteq> (\<Union>x \<in> subA. Vf x)"
     by (blast intro: that compactE_image [OF com_A open_Vf sum_max_0])
   then have [simp]: "subA \<noteq> {}"
     using \<open>a \<in> A\<close> by auto
   then have cardp: "card subA > 0" using subA
     by (simp add: card_gt_0_iff)
   have "\<And>w. w \<in> A \<Longrightarrow> \<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> S \<inter> Vf w. f x < e / card subA) \<and> (\<forall>x \<in> S \<inter> B. f x > 1 - e / card subA)"
     using Vf e cardp by simp
   then obtain ff where ff:
          "\<And>w. w \<in> A \<Longrightarrow> ff w \<in> R \<and> ff w ` S \<subseteq> {0..1} \<and>
                          (\<forall>x \<in> S \<inter> Vf w. ff w x < e / card subA) \<and> (\<forall>x \<in> S \<inter> B. ff w x > 1 - e / card subA)"
     by metis
   define pff where [abs_def]: "pff x = (\<Prod>w \<in> subA. ff w x)" for x
   have pffR: "pff \<in> R"
     unfolding pff_def using subA ff by (auto simp: intro: prod)
   moreover
   have pff01: "pff x \<in> {0..1}" if t: "x \<in> S" for x
   proof -
     have "0 \<le> pff x"
       using subA cardp t
       apply (simp add: pff_def field_split_simps sum_nonneg)
       apply (rule Groups_Big.linordered_semidom_class.prod_nonneg)
       using ff by fastforce
     moreover have "pff x \<le> 1"
       using subA cardp t
       apply (simp add: pff_def field_split_simps sum_nonneg)
       apply (rule prod_mono [where g = "\<lambda>x. 1", simplified])
       using ff by fastforce
     ultimately show ?thesis
       by auto
   qed
   moreover
   { fix v x
     assume v: "v \<in> subA" and x: "x \<in> Vf v" "x \<in> S"
     from subA v have "pff x = ff v x * (\<Prod>w \<in> subA - {v}. ff w x)"
       unfolding pff_def  by (metis prod.remove)
     also have "... \<le> ff v x * 1"
       apply (rule Rings.ordered_semiring_class.mult_left_mono)
       apply (rule prod_mono [where g = "\<lambda>x. 1", simplified])
       using ff [THEN conjunct2, THEN conjunct1] v subA x
       apply auto
       apply (meson atLeastAtMost_iff contra_subsetD imageI)
       apply (meson atLeastAtMost_iff contra_subsetD image_eqI)
       using atLeastAtMost_iff by blast
     also have "... < e / card subA"
       using ff [THEN conjunct2, THEN conjunct2, THEN conjunct1] v subA x
       by auto
     also have "... \<le> e"
       using cardp e by (simp add: field_split_simps)
     finally have "pff x < e" .
   }
   then have "\<And>x. x \<in> A \<Longrightarrow> pff x < e"
     using A Vf subA by (metis UN_E contra_subsetD)
   moreover
   { fix x
     assume x: "x \<in> B"
     then have "x \<in> S"
       using B by auto
     have "1 - e \<le> (1 - e / card subA) ^ card subA"
       using Bernoulli_inequality [of "-e / card subA" "card subA"] e cardp
       by (auto simp: field_simps)
     also have "... = (\<Prod>w \<in> subA. 1 - e / card subA)"
-      by (simp add: prod_constant subA(2))
+      by (simp add: subA(2))
     also have "... < pff x"
       apply (simp add: pff_def)
       apply (rule prod_mono_strict [where f = "\<lambda>x. 1 - e / card subA", simplified])
       apply (simp_all add: subA(2))
       apply (intro ballI conjI)
       using e apply (force simp: field_split_simps)
       using ff [THEN conjunct2, THEN conjunct2, THEN conjunct2] subA B x
       apply blast
       done
     finally have "1 - e < pff x" .
   }
   ultimately
   show ?thesis by blast
 qed
 
 lemma (in function_ring_on) two:
   assumes A: "closed A" "A \<subseteq> S"
       and B: "closed B" "B \<subseteq> S"
       and disj: "A \<inter> B = {}"
       and e: "0 < e" "e < 1"
     shows "\<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> A. f x < e) \<and> (\<forall>x \<in> B. f x > 1 - e)"
 proof (cases "A \<noteq> {} \<and> B \<noteq> {}")
   case True then show ?thesis
     apply (simp flip: ex_in_conv)
     using assms
     apply safe
     apply (force simp add: intro!: two_special)
     done
 next
   case False with e show ?thesis
     apply simp
     apply (erule disjE)
     apply (rule_tac [2] x="\<lambda>x. 0" in bexI)
     apply (rule_tac x="\<lambda>x. 1" in bexI)
     apply (auto simp: const)
     done
 qed
 
 text\<open>The special case where \<^term>\<open>f\<close> is non-negative and \<^term>\<open>e<1/3\<close>\<close>
 lemma (in function_ring_on) Stone_Weierstrass_special:
   assumes f: "continuous_on S f" and fpos: "\<And>x. x \<in> S \<Longrightarrow> f x \<ge> 0"
       and e: "0 < e" "e < 1/3"
   shows "\<exists>g \<in> R. \<forall>x\<in>S. \<bar>f x - g x\<bar> < 2*e"
 proof -
   define n where "n = 1 + nat \<lceil>normf f / e\<rceil>"
   define A where "A j = {x \<in> S. f x \<le> (j - 1/3)*e}" for j :: nat
   define B where "B j = {x \<in> S. f x \<ge> (j + 1/3)*e}" for j :: nat
   have ngt: "(n-1) * e \<ge> normf f" "n\<ge>1"
     using e
     apply (simp_all add: n_def field_simps of_nat_Suc)
     by (metis real_nat_ceiling_ge mult.commute not_less pos_less_divide_eq)
   then have ge_fx: "(n-1) * e \<ge> f x" if "x \<in> S" for x
     using f normf_upper that by fastforce
   { fix j
     have A: "closed (A j)" "A j \<subseteq> S"
       apply (simp_all add: A_def Collect_restrict)
       apply (rule continuous_on_closed_Collect_le [OF f continuous_on_const])
       apply (simp add: compact compact_imp_closed)
       done
     have B: "closed (B j)" "B j \<subseteq> S"
       apply (simp_all add: B_def Collect_restrict)
       apply (rule continuous_on_closed_Collect_le [OF continuous_on_const f])
       apply (simp add: compact compact_imp_closed)
       done
     have disj: "(A j) \<inter> (B j) = {}"
       using e by (auto simp: A_def B_def field_simps)
     have "\<exists>f \<in> R. f ` S \<subseteq> {0..1} \<and> (\<forall>x \<in> A j. f x < e/n) \<and> (\<forall>x \<in> B j. f x > 1 - e/n)"
       apply (rule two)
       using e A B disj ngt
       apply simp_all
       done
   }
   then obtain xf where xfR: "\<And>j. xf j \<in> R" and xf01: "\<And>j. xf j ` S \<subseteq> {0..1}"
                    and xfA: "\<And>x j. x \<in> A j \<Longrightarrow> xf j x < e/n"
                    and xfB: "\<And>x j. x \<in> B j \<Longrightarrow> xf j x > 1 - e/n"
     by metis
   define g where [abs_def]: "g x = e * (\<Sum>i\<le>n. xf i x)" for x
   have gR: "g \<in> R"
     unfolding g_def by (fast intro: mult const sum xfR)
   have gge0: "\<And>x. x \<in> S \<Longrightarrow> g x \<ge> 0"
     using e xf01 by (simp add: g_def zero_le_mult_iff image_subset_iff sum_nonneg)
   have A0: "A 0 = {}"
     using fpos e by (fastforce simp: A_def)
   have An: "A n = S"
     using e ngt f normf_upper by (fastforce simp: A_def field_simps of_nat_diff)
   have Asub: "A j \<subseteq> A i" if "i\<ge>j" for i j
     using e that apply (clarsimp simp: A_def)
     apply (erule order_trans, simp)
     done
   { fix t
     assume t: "t \<in> S"
     define j where "j = (LEAST j. t \<in> A j)"
     have jn: "j \<le> n"
       using t An by (simp add: Least_le j_def)
     have Aj: "t \<in> A j"
       using t An by (fastforce simp add: j_def intro: LeastI)
     then have Ai: "t \<in> A i" if "i\<ge>j" for i
       using Asub [OF that] by blast
     then have fj1: "f t \<le> (j - 1/3)*e"
       by (simp add: A_def)
     then have Anj: "t \<notin> A i" if "i<j" for i
       using  Aj  \<open>i<j\<close>
       apply (simp add: j_def)
       using not_less_Least by blast
     have j1: "1 \<le> j"
       using A0 Aj j_def not_less_eq_eq by (fastforce simp add: j_def)
     then have Anj: "t \<notin> A (j-1)"
       using Least_le by (fastforce simp add: j_def)
     then have fj2: "(j - 4/3)*e < f t"
       using j1 t  by (simp add: A_def of_nat_diff)
     have ***: "xf i t \<le> e/n" if "i\<ge>j" for i
       using xfA [OF Ai] that by (simp add: less_eq_real_def)
     { fix i
       assume "i+2 \<le> j"
       then obtain d where "i+2+d = j"
         using le_Suc_ex that by blast
       then have "t \<in> B i"
         using Anj e ge_fx [OF t] \<open>1 \<le> n\<close> fpos [OF t] t
         apply (simp add: A_def B_def)
         apply (clarsimp simp add: field_simps of_nat_diff not_le of_nat_Suc)
         apply (rule order_trans [of _ "e * 2 + (e * (real d * 3) + e * (real i * 3))"])
         apply auto
         done
       then have "xf i t > 1 - e/n"
         by (rule xfB)
     } note **** = this
     have xf_le1: "\<And>i. xf i t \<le> 1"
       using xf01 t by force
     have "g t = e * (\<Sum>i<j. xf i t) + e * (\<Sum>i=j..n. xf i t)"
       using j1 jn e
       apply (simp add: g_def flip: distrib_left)
       apply (subst sum.union_disjoint [symmetric])
       apply (auto simp: ivl_disj_un)
       done
     also have "... \<le> e*j + e * ((Suc n - j)*e/n)"
       apply (rule add_mono)
       apply (simp_all only: mult_le_cancel_left_pos e)
       apply (rule sum_bounded_above [OF xf_le1, where A = "lessThan j", simplified])
       using sum_bounded_above [of "{j..n}" "\<lambda>i. xf i t", OF ***]
       apply simp
       done
     also have "... \<le> j*e + e*(n - j + 1)*e/n "
       using \<open>1 \<le> n\<close> e  by (simp add: field_simps del: of_nat_Suc)
     also have "... \<le> j*e + e*e"
       using \<open>1 \<le> n\<close> e j1 by (simp add: field_simps del: of_nat_Suc)
     also have "... < (j + 1/3)*e"
       using e by (auto simp: field_simps)
     finally have gj1: "g t < (j + 1 / 3) * e" .
     have gj2: "(j - 4/3)*e < g t"
     proof (cases "2 \<le> j")
       case False
       then have "j=1" using j1 by simp
       with t gge0 e show ?thesis by force
     next
       case True
       then have "(j - 4/3)*e < (j-1)*e - e^2"
         using e by (auto simp: of_nat_diff algebra_simps power2_eq_square)
       also have "... < (j-1)*e - ((j - 1)/n) * e^2"
         using e True jn by (simp add: power2_eq_square field_simps)
       also have "... = e * (j-1) * (1 - e/n)"
         by (simp add: power2_eq_square field_simps)
       also have "... \<le> e * (\<Sum>i\<le>j-2. xf i t)"
         using e
         apply simp
         apply (rule order_trans [OF _ sum_bounded_below [OF less_imp_le [OF ****]]])
         using True
         apply (simp_all add: of_nat_Suc of_nat_diff)
         done
       also have "... \<le> g t"
         using jn e
         using e xf01 t
         apply (simp add: g_def zero_le_mult_iff image_subset_iff sum_nonneg)
         apply (rule Groups_Big.sum_mono2, auto)
         done
       finally show ?thesis .
     qed
     have "\<bar>f t - g t\<bar> < 2 * e"
       using fj1 fj2 gj1 gj2 by (simp add: abs_less_iff field_simps)
   }
   then show ?thesis
     by (rule_tac x=g in bexI) (auto intro: gR)
 qed
 
 text\<open>The ``unpretentious'' formulation\<close>
 proposition (in function_ring_on) Stone_Weierstrass_basic:
   assumes f: "continuous_on S f" and e: "e > 0"
   shows "\<exists>g \<in> R. \<forall>x\<in>S. \<bar>f x - g x\<bar> < e"
 proof -
   have "\<exists>g \<in> R. \<forall>x\<in>S. \<bar>(f x + normf f) - g x\<bar> < 2 * min (e/2) (1/4)"
     apply (rule Stone_Weierstrass_special)
     apply (rule Limits.continuous_on_add [OF f Topological_Spaces.continuous_on_const])
     using normf_upper [OF f] apply force
     apply (simp add: e, linarith)
     done
   then obtain g where "g \<in> R" "\<forall>x\<in>S. \<bar>g x - (f x + normf f)\<bar> < e"
     by force
   then show ?thesis
     apply (rule_tac x="\<lambda>x. g x - normf f" in bexI)
     apply (auto simp: algebra_simps intro: diff const)
     done
 qed
 
 
 theorem (in function_ring_on) Stone_Weierstrass:
   assumes f: "continuous_on S f"
   shows "\<exists>F\<in>UNIV \<rightarrow> R. LIM n sequentially. F n :> uniformly_on S f"
 proof -
   { fix e::real
     assume e: "0 < e"
     then obtain N::nat where N: "0 < N" "0 < inverse N" "inverse N < e"
       by (auto simp: real_arch_inverse [of e])
     { fix n :: nat and x :: 'a and g :: "'a \<Rightarrow> real"
       assume n: "N \<le> n"  "\<forall>x\<in>S. \<bar>f x - g x\<bar> < 1 / (1 + real n)"
       assume x: "x \<in> S"
       have "\<not> real (Suc n) < inverse e"
         using \<open>N \<le> n\<close> N using less_imp_inverse_less by force
       then have "1 / (1 + real n) \<le> e"
         using e by (simp add: field_simps of_nat_Suc)
       then have "\<bar>f x - g x\<bar> < e"
         using n(2) x by auto
     } note * = this
     have "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<bar>f x - (SOME g. g \<in> R \<and> (\<forall>x\<in>S. \<bar>f x - g x\<bar> < 1 / (1 + real n))) x\<bar> < e"
       apply (rule eventually_sequentiallyI [of N])
       apply (auto intro: someI2_bex [OF Stone_Weierstrass_basic [OF f]] *)
       done
   } then
   show ?thesis
     apply (rule_tac x="\<lambda>n::nat. SOME g. g \<in> R \<and> (\<forall>x\<in>S. \<bar>f x - g x\<bar> < 1 / (1 + n))" in bexI)
     prefer 2  apply (force intro: someI2_bex [OF Stone_Weierstrass_basic [OF f]])
     unfolding uniform_limit_iff
     apply (auto simp: dist_norm abs_minus_commute)
     done
 qed
 
 text\<open>A HOL Light formulation\<close>
 corollary Stone_Weierstrass_HOL:
   fixes R :: "('a::t2_space \<Rightarrow> real) set" and S :: "'a set"
   assumes "compact S"  "\<And>c. P(\<lambda>x. c::real)"
           "\<And>f. P f \<Longrightarrow> continuous_on S f"
           "\<And>f g. P(f) \<and> P(g) \<Longrightarrow> P(\<lambda>x. f x + g x)"  "\<And>f g. P(f) \<and> P(g) \<Longrightarrow> P(\<lambda>x. f x * g x)"
           "\<And>x y. x \<in> S \<and> y \<in> S \<and> x \<noteq> y \<Longrightarrow> \<exists>f. P(f) \<and> f x \<noteq> f y"
           "continuous_on S f"
        "0 < e"
     shows "\<exists>g. P(g) \<and> (\<forall>x \<in> S. \<bar>f x - g x\<bar> < e)"
 proof -
   interpret PR: function_ring_on "Collect P"
     apply unfold_locales
     using assms
     by auto
   show ?thesis
     using PR.Stone_Weierstrass_basic [OF \<open>continuous_on S f\<close> \<open>0 < e\<close>]
     by blast
 qed
 
 
 subsection \<open>Polynomial functions\<close>
 
 inductive real_polynomial_function :: "('a::real_normed_vector \<Rightarrow> real) \<Rightarrow> bool" where
     linear: "bounded_linear f \<Longrightarrow> real_polynomial_function f"
   | const: "real_polynomial_function (\<lambda>x. c)"
   | add:   "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x + g x)"
   | mult:  "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x * g x)"
 
 declare real_polynomial_function.intros [intro]
 
 definition\<^marker>\<open>tag important\<close> polynomial_function :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> bool"
   where
    "polynomial_function p \<equiv> (\<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f o p))"
 
 lemma real_polynomial_function_eq: "real_polynomial_function p = polynomial_function p"
 unfolding polynomial_function_def
 proof
   assume "real_polynomial_function p"
   then show " \<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f \<circ> p)"
   proof (induction p rule: real_polynomial_function.induct)
     case (linear h) then show ?case
       by (auto simp: bounded_linear_compose real_polynomial_function.linear)
   next
     case (const h) then show ?case
       by (simp add: real_polynomial_function.const)
   next
     case (add h) then show ?case
       by (force simp add: bounded_linear_def linear_add real_polynomial_function.add)
   next
     case (mult h) then show ?case
       by (force simp add: real_bounded_linear const real_polynomial_function.mult)
   qed
 next
   assume [rule_format, OF bounded_linear_ident]: "\<forall>f. bounded_linear f \<longrightarrow> real_polynomial_function (f \<circ> p)"
   then show "real_polynomial_function p"
     by (simp add: o_def)
 qed
 
 lemma polynomial_function_const [iff]: "polynomial_function (\<lambda>x. c)"
   by (simp add: polynomial_function_def o_def const)
 
 lemma polynomial_function_bounded_linear:
   "bounded_linear f \<Longrightarrow> polynomial_function f"
   by (simp add: polynomial_function_def o_def bounded_linear_compose real_polynomial_function.linear)
 
 lemma polynomial_function_id [iff]: "polynomial_function(\<lambda>x. x)"
   by (simp add: polynomial_function_bounded_linear)
 
 lemma polynomial_function_add [intro]:
     "\<lbrakk>polynomial_function f; polynomial_function g\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. f x + g x)"
   by (auto simp: polynomial_function_def bounded_linear_def linear_add real_polynomial_function.add o_def)
 
 lemma polynomial_function_mult [intro]:
   assumes f: "polynomial_function f" and g: "polynomial_function g"
     shows "polynomial_function (\<lambda>x. f x *\<^sub>R g x)"
   using g
   apply (auto simp: polynomial_function_def bounded_linear_def Real_Vector_Spaces.linear.scaleR  const real_polynomial_function.mult o_def)
   apply (rule mult)
   using f
   apply (auto simp: real_polynomial_function_eq)
   done
 
 lemma polynomial_function_cmul [intro]:
   assumes f: "polynomial_function f"
     shows "polynomial_function (\<lambda>x. c *\<^sub>R f x)"
   by (rule polynomial_function_mult [OF polynomial_function_const f])
 
 lemma polynomial_function_minus [intro]:
   assumes f: "polynomial_function f"
     shows "polynomial_function (\<lambda>x. - f x)"
   using polynomial_function_cmul [OF f, of "-1"] by simp
 
 lemma polynomial_function_diff [intro]:
     "\<lbrakk>polynomial_function f; polynomial_function g\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. f x - g x)"
   unfolding add_uminus_conv_diff [symmetric]
   by (metis polynomial_function_add polynomial_function_minus)
 
 lemma polynomial_function_sum [intro]:
     "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> polynomial_function (\<lambda>x. f x i)\<rbrakk> \<Longrightarrow> polynomial_function (\<lambda>x. sum (f x) I)"
 by (induct I rule: finite_induct) auto
 
 lemma real_polynomial_function_minus [intro]:
     "real_polynomial_function f \<Longrightarrow> real_polynomial_function (\<lambda>x. - f x)"
   using polynomial_function_minus [of f]
   by (simp add: real_polynomial_function_eq)
 
 lemma real_polynomial_function_diff [intro]:
     "\<lbrakk>real_polynomial_function f; real_polynomial_function g\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. f x - g x)"
   using polynomial_function_diff [of f]
   by (simp add: real_polynomial_function_eq)
 
 lemma real_polynomial_function_sum [intro]:
     "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> real_polynomial_function (\<lambda>x. f x i)\<rbrakk> \<Longrightarrow> real_polynomial_function (\<lambda>x. sum (f x) I)"
   using polynomial_function_sum [of I f]
   by (simp add: real_polynomial_function_eq)
 
 lemma real_polynomial_function_power [intro]:
     "real_polynomial_function f \<Longrightarrow> real_polynomial_function (\<lambda>x. f x ^ n)"
   by (induct n) (simp_all add: const mult)
 
 lemma real_polynomial_function_compose [intro]:
   assumes f: "polynomial_function f" and g: "real_polynomial_function g"
     shows "real_polynomial_function (g o f)"
   using g
   apply (induction g rule: real_polynomial_function.induct)
   using f
   apply (simp_all add: polynomial_function_def o_def const add mult)
   done
 
 lemma polynomial_function_compose [intro]:
   assumes f: "polynomial_function f" and g: "polynomial_function g"
     shows "polynomial_function (g o f)"
   using g real_polynomial_function_compose [OF f]
   by (auto simp: polynomial_function_def o_def)
 
 lemma sum_max_0:
   fixes x::real (*in fact "'a::comm_ring_1"*)
   shows "(\<Sum>i\<le>max m n. x^i * (if i \<le> m then a i else 0)) = (\<Sum>i\<le>m. x^i * a i)"
 proof -
   have "(\<Sum>i\<le>max m n. x^i * (if i \<le> m then a i else 0)) = (\<Sum>i\<le>max m n. (if i \<le> m then x^i * a i else 0))"
     by (auto simp: algebra_simps intro: sum.cong)
   also have "... = (\<Sum>i\<le>m. (if i \<le> m then x^i * a i else 0))"
     by (rule sum.mono_neutral_right) auto
   also have "... = (\<Sum>i\<le>m. x^i * a i)"
     by (auto simp: algebra_simps intro: sum.cong)
   finally show ?thesis .
 qed
 
 lemma real_polynomial_function_imp_sum:
   assumes "real_polynomial_function f"
     shows "\<exists>a n::nat. f = (\<lambda>x. \<Sum>i\<le>n. a i * x ^ i)"
 using assms
 proof (induct f)
   case (linear f)
   then show ?case
     apply (clarsimp simp add: real_bounded_linear)
     apply (rule_tac x="\<lambda>i. if i=0 then 0 else c" in exI)
     apply (rule_tac x=1 in exI)
     apply (simp add: mult_ac)
     done
 next
   case (const c)
   show ?case
     apply (rule_tac x="\<lambda>i. c" in exI)
     apply (rule_tac x=0 in exI)
     apply (auto simp: mult_ac of_nat_Suc)
     done
   case (add f1 f2)
   then obtain a1 n1 a2 n2 where
     "f1 = (\<lambda>x. \<Sum>i\<le>n1. a1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i\<le>n2. a2 i * x ^ i)"
     by auto
   then show ?case
     apply (rule_tac x="\<lambda>i. (if i \<le> n1 then a1 i else 0) + (if i \<le> n2 then a2 i else 0)" in exI)
     apply (rule_tac x="max n1 n2" in exI)
     using sum_max_0 [where m=n1 and n=n2] sum_max_0 [where m=n2 and n=n1]
     apply (simp add: sum.distrib algebra_simps max.commute)
     done
   case (mult f1 f2)
   then obtain a1 n1 a2 n2 where
     "f1 = (\<lambda>x. \<Sum>i\<le>n1. a1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i\<le>n2. a2 i * x ^ i)"
     by auto
   then obtain b1 b2 where
     "f1 = (\<lambda>x. \<Sum>i\<le>n1. b1 i * x ^ i)" "f2 = (\<lambda>x. \<Sum>i\<le>n2. b2 i * x ^ i)"
     "b1 = (\<lambda>i. if i\<le>n1 then a1 i else 0)" "b2 = (\<lambda>i. if i\<le>n2 then a2 i else 0)"
     by auto
   then show ?case
     apply (rule_tac x="\<lambda>i. \<Sum>k\<le>i. b1 k * b2 (i - k)" in exI)
     apply (rule_tac x="n1+n2" in exI)
     using polynomial_product [of n1 b1 n2 b2]
     apply (simp add: Set_Interval.atLeast0AtMost)
     done
 qed
 
 lemma real_polynomial_function_iff_sum:
      "real_polynomial_function f \<longleftrightarrow> (\<exists>a n::nat. f = (\<lambda>x. \<Sum>i\<le>n. a i * x ^ i))"
   apply (rule iffI)
   apply (erule real_polynomial_function_imp_sum)
   apply (auto simp: linear mult const real_polynomial_function_power real_polynomial_function_sum)
   done
 
 lemma polynomial_function_iff_Basis_inner:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   shows "polynomial_function f \<longleftrightarrow> (\<forall>b\<in>Basis. real_polynomial_function (\<lambda>x. inner (f x) b))"
         (is "?lhs = ?rhs")
 unfolding polynomial_function_def
 proof (intro iffI allI impI)
   assume "\<forall>h. bounded_linear h \<longrightarrow> real_polynomial_function (h \<circ> f)"
   then show ?rhs
     by (force simp add: bounded_linear_inner_left o_def)
 next
   fix h :: "'b \<Rightarrow> real"
   assume rp: "\<forall>b\<in>Basis. real_polynomial_function (\<lambda>x. f x \<bullet> b)" and h: "bounded_linear h"
   have "real_polynomial_function (h \<circ> (\<lambda>x. \<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b))"
     apply (rule real_polynomial_function_compose [OF _  linear [OF h]])
     using rp
     apply (auto simp: real_polynomial_function_eq polynomial_function_mult)
     done
   then show "real_polynomial_function (h \<circ> f)"
     by (simp add: euclidean_representation_sum_fun)
 qed
 
 subsection \<open>Stone-Weierstrass theorem for polynomial functions\<close>
 
 text\<open>First, we need to show that they are continuous, differentiable and separable.\<close>
 
 lemma continuous_real_polymonial_function:
   assumes "real_polynomial_function f"
     shows "continuous (at x) f"
 using assms
 by (induct f) (auto simp: linear_continuous_at)
 
 lemma continuous_polymonial_function:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "polynomial_function f"
     shows "continuous (at x) f"
   apply (rule euclidean_isCont)
   using assms apply (simp add: polynomial_function_iff_Basis_inner)
   apply (force dest: continuous_real_polymonial_function intro: isCont_scaleR)
   done
 
 lemma continuous_on_polymonial_function:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::euclidean_space"
   assumes "polynomial_function f"
     shows "continuous_on S f"
   using continuous_polymonial_function [OF assms] continuous_at_imp_continuous_on
   by blast
 
 lemma has_real_derivative_polynomial_function:
   assumes "real_polynomial_function p"
     shows "\<exists>p'. real_polynomial_function p' \<and>
                  (\<forall>x. (p has_real_derivative (p' x)) (at x))"
 using assms
 proof (induct p)
   case (linear p)
   then show ?case
     by (force simp: real_bounded_linear const intro!: derivative_eq_intros)
 next
   case (const c)
   show ?case
     by (rule_tac x="\<lambda>x. 0" in exI) auto
   case (add f1 f2)
   then obtain p1 p2 where
     "real_polynomial_function p1" "\<And>x. (f1 has_real_derivative p1 x) (at x)"
     "real_polynomial_function p2" "\<And>x. (f2 has_real_derivative p2 x) (at x)"
     by auto
   then show ?case
     apply (rule_tac x="\<lambda>x. p1 x + p2 x" in exI)
     apply (auto intro!: derivative_eq_intros)
     done
   case (mult f1 f2)
   then obtain p1 p2 where
     "real_polynomial_function p1" "\<And>x. (f1 has_real_derivative p1 x) (at x)"
     "real_polynomial_function p2" "\<And>x. (f2 has_real_derivative p2 x) (at x)"
     by auto
   then show ?case
     using mult
     apply (rule_tac x="\<lambda>x. f1 x * p2 x + f2 x * p1 x" in exI)
     apply (auto intro!: derivative_eq_intros)
     done
 qed
 
 lemma has_vector_derivative_polynomial_function:
   fixes p :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "polynomial_function p"
   obtains p' where "polynomial_function p'" "\<And>x. (p has_vector_derivative (p' x)) (at x)"
 proof -
   { fix b :: 'a
     assume "b \<in> Basis"
     then
     obtain p' where p': "real_polynomial_function p'" and pd: "\<And>x. ((\<lambda>x. p x \<bullet> b) has_real_derivative p' x) (at x)"
       using assms [unfolded polynomial_function_iff_Basis_inner, rule_format]  \<open>b \<in> Basis\<close>
       has_real_derivative_polynomial_function
       by blast
     have "\<exists>q. polynomial_function q \<and> (\<forall>x. ((\<lambda>u. (p u \<bullet> b) *\<^sub>R b) has_vector_derivative q x) (at x))"
       apply (rule_tac x="\<lambda>x. p' x *\<^sub>R b" in exI)
       using \<open>b \<in> Basis\<close> p'
       apply (simp add: polynomial_function_iff_Basis_inner inner_Basis)
       apply (auto intro: derivative_eq_intros pd)
       done
   }
   then obtain qf where qf:
       "\<And>b. b \<in> Basis \<Longrightarrow> polynomial_function (qf b)"
       "\<And>b x. b \<in> Basis \<Longrightarrow> ((\<lambda>u. (p u \<bullet> b) *\<^sub>R b) has_vector_derivative qf b x) (at x)"
     by metis
   show ?thesis
     apply (rule_tac p'="\<lambda>x. \<Sum>b\<in>Basis. qf b x" in that)
      apply (force intro: qf)
     apply (subst euclidean_representation_sum_fun [of p, symmetric])
      apply (auto intro: has_vector_derivative_sum qf)
     done
 qed
 
 lemma real_polynomial_function_separable:
   fixes x :: "'a::euclidean_space"
   assumes "x \<noteq> y" shows "\<exists>f. real_polynomial_function f \<and> f x \<noteq> f y"
 proof -
   have "real_polynomial_function (\<lambda>u. \<Sum>b\<in>Basis. (inner (x-u) b)^2)"
     apply (rule real_polynomial_function_sum)
     apply (auto simp: algebra_simps real_polynomial_function_power real_polynomial_function_diff
                  const linear bounded_linear_inner_left)
     done
   then show ?thesis
     apply (intro exI conjI, assumption)
     using assms
     apply (force simp add: euclidean_eq_iff [of x y] sum_nonneg_eq_0_iff algebra_simps)
     done
 qed
 
 lemma Stone_Weierstrass_real_polynomial_function:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "compact S" "continuous_on S f" "0 < e"
   obtains g where "real_polynomial_function g" "\<And>x. x \<in> S \<Longrightarrow> \<bar>f x - g x\<bar> < e"
 proof -
   interpret PR: function_ring_on "Collect real_polynomial_function"
     apply unfold_locales
     using assms continuous_on_polymonial_function real_polynomial_function_eq
     apply (auto intro: real_polynomial_function_separable)
     done
   show ?thesis
     using PR.Stone_Weierstrass_basic [OF \<open>continuous_on S f\<close> \<open>0 < e\<close>] that
     by blast
 qed
 
 theorem Stone_Weierstrass_polynomial_function:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes S: "compact S"
       and f: "continuous_on S f"
       and e: "0 < e"
     shows "\<exists>g. polynomial_function g \<and> (\<forall>x \<in> S. norm(f x - g x) < e)"
 proof -
   { fix b :: 'b
     assume "b \<in> Basis"
     have "\<exists>p. real_polynomial_function p \<and> (\<forall>x \<in> S. \<bar>f x \<bullet> b - p x\<bar> < e / DIM('b))"
       apply (rule exE [OF Stone_Weierstrass_real_polynomial_function [OF S _, of "\<lambda>x. f x \<bullet> b" "e / card Basis"]])
       using e f
-      apply (auto simp: Euclidean_Space.DIM_positive intro: continuous_intros)
+      apply (auto intro: continuous_intros)
       done
   }
   then obtain pf where pf:
       "\<And>b. b \<in> Basis \<Longrightarrow> real_polynomial_function (pf b) \<and> (\<forall>x \<in> S. \<bar>f x \<bullet> b - pf b x\<bar> < e / DIM('b))"
       apply (rule bchoice [rule_format, THEN exE])
       apply assumption
       apply (force simp add: intro: that)
       done
   have "polynomial_function (\<lambda>x. \<Sum>b\<in>Basis. pf b x *\<^sub>R b)"
     using pf
     by (simp add: polynomial_function_sum polynomial_function_mult real_polynomial_function_eq)
   moreover
   { fix x
     assume "x \<in> S"
     have "norm (\<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b) \<le> (\<Sum>b\<in>Basis. norm ((f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b))"
       by (rule norm_sum)
     also have "... < of_nat DIM('b) * (e / DIM('b))"
       apply (rule sum_bounded_above_strict)
       apply (simp add: Real_Vector_Spaces.scaleR_diff_left [symmetric] pf \<open>x \<in> S\<close>)
       apply (rule DIM_positive)
       done
     also have "... = e"
-      using DIM_positive by (simp add: field_simps)
+      by (simp add: field_simps)
     finally have "norm (\<Sum>b\<in>Basis. (f x \<bullet> b) *\<^sub>R b - pf b x *\<^sub>R b) < e" .
   }
   ultimately
   show ?thesis
     apply (subst euclidean_representation_sum_fun [of f, symmetric])
     apply (rule_tac x="\<lambda>x. \<Sum>b\<in>Basis. pf b x *\<^sub>R b" in exI)
     apply (auto simp flip: sum_subtractf)
     done
 qed
 
 proposition Stone_Weierstrass_uniform_limit:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes S: "compact S"
     and f: "continuous_on S f"
   obtains g where "uniform_limit S g f sequentially" "\<And>n. polynomial_function (g n)"
 proof -
   have pos: "inverse (Suc n) > 0" for n by auto
   obtain g where g: "\<And>n. polynomial_function (g n)" "\<And>x n. x \<in> S \<Longrightarrow> norm(f x - g n x) < inverse (Suc n)"
     using Stone_Weierstrass_polynomial_function[OF S f pos]
     by metis
   have "uniform_limit S g f sequentially"
   proof (rule uniform_limitI)
     fix e::real assume "0 < e"
     with LIMSEQ_inverse_real_of_nat have "\<forall>\<^sub>F n in sequentially. inverse (Suc n) < e"
       by (rule order_tendstoD)
     moreover have "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. dist (g n x) (f x) < inverse (Suc n)"
       using g by (simp add: dist_norm norm_minus_commute)
     ultimately show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. dist (g n x) (f x) < e"
       by (eventually_elim) auto
   qed
   then show ?thesis using g(1) ..
 qed
 
 
 subsection\<open>Polynomial functions as paths\<close>
 
 text\<open>One application is to pick a smooth approximation to a path,
 or just pick a smooth path anyway in an open connected set\<close>
 
 lemma path_polynomial_function:
     fixes g  :: "real \<Rightarrow> 'b::euclidean_space"
     shows "polynomial_function g \<Longrightarrow> path g"
   by (simp add: path_def continuous_on_polymonial_function)
 
 lemma path_approx_polynomial_function:
     fixes g :: "real \<Rightarrow> 'b::euclidean_space"
     assumes "path g" "0 < e"
     shows "\<exists>p. polynomial_function p \<and>
                 pathstart p = pathstart g \<and>
                 pathfinish p = pathfinish g \<and>
                 (\<forall>t \<in> {0..1}. norm(p t - g t) < e)"
 proof -
   obtain q where poq: "polynomial_function q" and noq: "\<And>x. x \<in> {0..1} \<Longrightarrow> norm (g x - q x) < e/4"
     using Stone_Weierstrass_polynomial_function [of "{0..1}" g "e/4"] assms
     by (auto simp: path_def)
   have pf: "polynomial_function (\<lambda>t. q t + (g 0 - q 0) + t *\<^sub>R (g 1 - q 1 - (g 0 - q 0)))"
     by (force simp add: poq)
   have *: "\<And>t. t \<in> {0..1} \<Longrightarrow> norm (((q t - g t) + (g 0 - q 0)) + (t *\<^sub>R (g 1 - q 1) + t *\<^sub>R (q 0 - g 0))) < (e/4 + e/4) + (e/4+e/4)"
     apply (intro Real_Vector_Spaces.norm_add_less)
     using noq
     apply (auto simp: norm_minus_commute intro: le_less_trans [OF mult_left_le_one_le noq] simp del: less_divide_eq_numeral1)
     done
   show ?thesis
     apply (intro exI conjI)
     apply (rule pf)
     using *
     apply (auto simp add: pathstart_def pathfinish_def algebra_simps)
     done
 qed
 
 proposition connected_open_polynomial_connected:
   fixes S :: "'a::euclidean_space set"
   assumes S: "open S" "connected S"
       and "x \<in> S" "y \<in> S"
     shows "\<exists>g. polynomial_function g \<and> path_image g \<subseteq> S \<and>
                pathstart g = x \<and> pathfinish g = y"
 proof -
   have "path_connected S" using assms
     by (simp add: connected_open_path_connected)
   with \<open>x \<in> S\<close> \<open>y \<in> S\<close> obtain p where p: "path p" "path_image p \<subseteq> S" "pathstart p = x" "pathfinish p = y"
     by (force simp: path_connected_def)
   have "\<exists>e. 0 < e \<and> (\<forall>x \<in> path_image p. ball x e \<subseteq> S)"
   proof (cases "S = UNIV")
     case True then show ?thesis
       by (simp add: gt_ex)
   next
     case False
     then have "- S \<noteq> {}" by blast
     then show ?thesis
       apply (rule_tac x="setdist (path_image p) (-S)" in exI)
       using S p
       apply (simp add: setdist_gt_0_compact_closed compact_path_image open_closed)
       using setdist_le_dist [of _ "path_image p" _ "-S"]
       by fastforce
   qed
   then obtain e where "0 < e"and eb: "\<And>x. x \<in> path_image p \<Longrightarrow> ball x e \<subseteq> S"
     by auto
   show ?thesis
     using path_approx_polynomial_function [OF \<open>path p\<close> \<open>0 < e\<close>]
     apply clarify
     apply (intro exI conjI, assumption)
     using p
     apply (fastforce simp add: dist_norm path_image_def norm_minus_commute intro: eb [THEN subsetD])+
     done
 qed
 
 lemma differentiable_componentwise_within:
    "f differentiable (at a within S) \<longleftrightarrow>
     (\<forall>i \<in> Basis. (\<lambda>x. f x \<bullet> i) differentiable at a within S)"
 proof -
   { assume "\<forall>i\<in>Basis. \<exists>D. ((\<lambda>x. f x \<bullet> i) has_derivative D) (at a within S)"
     then obtain f' where f':
            "\<And>i. i \<in> Basis \<Longrightarrow> ((\<lambda>x. f x \<bullet> i) has_derivative f' i) (at a within S)"
       by metis
     have eq: "(\<lambda>x. (\<Sum>j\<in>Basis. f' j x *\<^sub>R j) \<bullet> i) = f' i" if "i \<in> Basis" for i
       using that by (simp add: inner_add_left inner_add_right)
     have "\<exists>D. \<forall>i\<in>Basis. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>x. D x \<bullet> i)) (at a within S)"
       apply (rule_tac x="\<lambda>x::'a. (\<Sum>j\<in>Basis. f' j x *\<^sub>R j) :: 'b" in exI)
       apply (simp add: eq f')
       done
   }
   then show ?thesis
     apply (simp add: differentiable_def)
     using has_derivative_componentwise_within
     by blast
 qed
 
 lemma polynomial_function_inner [intro]:
   fixes i :: "'a::euclidean_space"
   shows "polynomial_function g \<Longrightarrow> polynomial_function (\<lambda>x. g x \<bullet> i)"
   apply (subst euclidean_representation [where x=i, symmetric])
   apply (force simp: inner_sum_right polynomial_function_iff_Basis_inner polynomial_function_sum)
   done
 
 text\<open> Differentiability of real and vector polynomial functions.\<close>
 
 lemma differentiable_at_real_polynomial_function:
    "real_polynomial_function f \<Longrightarrow> f differentiable (at a within S)"
   by (induction f rule: real_polynomial_function.induct)
      (simp_all add: bounded_linear_imp_differentiable)
 
 lemma differentiable_on_real_polynomial_function:
    "real_polynomial_function p \<Longrightarrow> p differentiable_on S"
 by (simp add: differentiable_at_imp_differentiable_on differentiable_at_real_polynomial_function)
 
 lemma differentiable_at_polynomial_function:
   fixes f :: "_ \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function f \<Longrightarrow> f differentiable (at a within S)"
   by (metis differentiable_at_real_polynomial_function polynomial_function_iff_Basis_inner differentiable_componentwise_within)
 
 lemma differentiable_on_polynomial_function:
   fixes f :: "_ \<Rightarrow> 'a::euclidean_space"
   shows "polynomial_function f \<Longrightarrow> f differentiable_on S"
 by (simp add: differentiable_at_polynomial_function differentiable_on_def)
 
 lemma vector_eq_dot_span:
   assumes "x \<in> span B" "y \<in> span B" and i: "\<And>i. i \<in> B \<Longrightarrow> i \<bullet> x = i \<bullet> y"
   shows "x = y"
 proof -
   have "\<And>i. i \<in> B \<Longrightarrow> orthogonal (x - y) i"
     by (simp add: i inner_commute inner_diff_right orthogonal_def)
   moreover have "x - y \<in> span B"
     by (simp add: assms span_diff)
   ultimately have "x - y = 0"
     using orthogonal_to_span orthogonal_self by blast
     then show ?thesis by simp
 qed
 
 lemma orthonormal_basis_expand:
   assumes B: "pairwise orthogonal B"
       and 1: "\<And>i. i \<in> B \<Longrightarrow> norm i = 1"
       and "x \<in> span B"
       and "finite B"
     shows "(\<Sum>i\<in>B. (x \<bullet> i) *\<^sub>R i) = x"
 proof (rule vector_eq_dot_span [OF _ \<open>x \<in> span B\<close>])
   show "(\<Sum>i\<in>B. (x \<bullet> i) *\<^sub>R i) \<in> span B"
     by (simp add: span_clauses span_sum)
   show "i \<bullet> (\<Sum>i\<in>B. (x \<bullet> i) *\<^sub>R i) = i \<bullet> x" if "i \<in> B" for i
   proof -
     have [simp]: "i \<bullet> j = (if j = i then 1 else 0)" if "j \<in> B" for j
       using B 1 that \<open>i \<in> B\<close>
       by (force simp: norm_eq_1 orthogonal_def pairwise_def)
     have "i \<bullet> (\<Sum>i\<in>B. (x \<bullet> i) *\<^sub>R i) = (\<Sum>j\<in>B. x \<bullet> j * (i \<bullet> j))"
       by (simp add: inner_sum_right)
     also have "... = (\<Sum>j\<in>B. if j = i then x \<bullet> i else 0)"
       by (rule sum.cong; simp)
     also have "... = i \<bullet> x"
       by (simp add: \<open>finite B\<close> that inner_commute sum.delta)
     finally show ?thesis .
   qed
 qed
 
 
 theorem Stone_Weierstrass_polynomial_function_subspace:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact S"
       and contf: "continuous_on S f"
       and "0 < e"
       and "subspace T" "f ` S \<subseteq> T"
     obtains g where "polynomial_function g" "g ` S \<subseteq> T"
                     "\<And>x. x \<in> S \<Longrightarrow> norm(f x - g x) < e"
 proof -
   obtain B where "B \<subseteq> T" and orthB: "pairwise orthogonal B"
              and B1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
              and "independent B" and cardB: "card B = dim T"
              and spanB: "span B = T"
     using orthonormal_basis_subspace \<open>subspace T\<close> by metis
   then have "finite B"
     by (simp add: independent_imp_finite)
   then obtain n::nat and b where "B = b ` {i. i < n}" "inj_on b {i. i < n}"
     using finite_imp_nat_seg_image_inj_on by metis
   with cardB have "n = card B" "dim T = n"
     by (auto simp: card_image)
   have fx: "(\<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i) = f x" if "x \<in> S" for x
     apply (rule orthonormal_basis_expand [OF orthB B1 _ \<open>finite B\<close>])
     using \<open>f ` S \<subseteq> T\<close> spanB that by auto
   have cont: "continuous_on S (\<lambda>x. \<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i)"
     by (intro continuous_intros contf)
   obtain g where "polynomial_function g"
              and g: "\<And>x. x \<in> S \<Longrightarrow> norm ((\<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i) - g x) < e / (n+2)"
     using Stone_Weierstrass_polynomial_function [OF \<open>compact S\<close> cont, of "e / real (n + 2)"] \<open>0 < e\<close>
     by auto
   with fx have g: "\<And>x. x \<in> S \<Longrightarrow> norm (f x - g x) < e / (n+2)"
     by auto
   show ?thesis
   proof
     show "polynomial_function (\<lambda>x. \<Sum>i\<in>B. (g x \<bullet> i) *\<^sub>R i)"
       apply (rule polynomial_function_sum)
        apply (simp add: \<open>finite B\<close>)
       using \<open>polynomial_function g\<close>  by auto
     show "(\<lambda>x. \<Sum>i\<in>B. (g x \<bullet> i) *\<^sub>R i) ` S \<subseteq> T"
       using \<open>B \<subseteq> T\<close>
       by (blast intro: subspace_sum subspace_mul \<open>subspace T\<close>)
     show "norm (f x - (\<Sum>i\<in>B. (g x \<bullet> i) *\<^sub>R i)) < e" if "x \<in> S" for x
     proof -
       have orth': "pairwise (\<lambda>i j. orthogonal ((f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i)
                                               ((f x \<bullet> j) *\<^sub>R j - (g x \<bullet> j) *\<^sub>R j)) B"
         apply (rule pairwise_mono [OF orthB])
         apply (auto simp: orthogonal_def inner_diff_right inner_diff_left)
         done
       then have "(norm (\<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i))\<^sup>2 =
                  (\<Sum>i\<in>B. (norm ((f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i))\<^sup>2)"
         by (simp add:  norm_sum_Pythagorean [OF \<open>finite B\<close> orth'])
       also have "... = (\<Sum>i\<in>B. (norm (((f x - g x) \<bullet> i) *\<^sub>R i))\<^sup>2)"
         by (simp add: algebra_simps)
       also have "... \<le> (\<Sum>i\<in>B. (norm (f x - g x))\<^sup>2)"
         apply (rule sum_mono)
         apply (simp add: B1)
         apply (rule order_trans [OF Cauchy_Schwarz_ineq])
         by (simp add: B1 dot_square_norm)
       also have "... = n * norm (f x - g x)^2"
         by (simp add: \<open>n = card B\<close>)
       also have "... \<le> n * (e / (n+2))^2"
         apply (rule mult_left_mono)
          apply (meson dual_order.order_iff_strict g norm_ge_zero power_mono that, simp)
         done
       also have "... \<le> e^2 / (n+2)"
         using \<open>0 < e\<close> by (simp add: divide_simps power2_eq_square)
       also have "... < e^2"
         using \<open>0 < e\<close> by (simp add: divide_simps)
       finally have "(norm (\<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i))\<^sup>2 < e^2" .
       then have "(norm (\<Sum>i\<in>B. (f x \<bullet> i) *\<^sub>R i - (g x \<bullet> i) *\<^sub>R i)) < e"
         apply (rule power2_less_imp_less)
         using  \<open>0 < e\<close> by auto
       then show ?thesis
         using fx that by (simp add: sum_subtractf)
     qed
   qed
 qed
 
 
 hide_fact linear add mult const
 
 end