diff -r 5e82015fa879 -r f2d327275065 src/HOL/Analysis/Brouwer_Fixpoint.thy --- a/src/HOL/Analysis/Brouwer_Fixpoint.thy Sun Mar 24 20:31:53 2019 +0100 +++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy Tue Mar 26 17:01:36 2019 +0000 @@ -49,10 +49,10 @@ assumes ts: "T retract_of S" and hom: "\f g. \continuous_on U f; f ` U \ S; continuous_on U g; g ` U \ S\ - \ homotopic_with (\x. True) U S f g" + \ homotopic_with_canon (\x. True) U S f g" and "continuous_on U f" "f ` U \ T" and "continuous_on U g" "g ` U \ T" - shows "homotopic_with (\x. True) U T f g" + shows "homotopic_with_canon (\x. True) U T f g" proof - obtain r where "r ` S \ S" "continuous_on S r" "\x\S. r (r x) = r x" "T = r ` S" using ts by (auto simp: retract_of_def retraction) @@ -69,9 +69,9 @@ lemma retract_of_homotopically_trivial_null: assumes ts: "T retract_of S" and hom: "\f. \continuous_on U f; f ` U \ S\ - \ \c. homotopic_with (\x. True) U S f (\x. c)" + \ \c. homotopic_with_canon (\x. True) U S f (\x. c)" and "continuous_on U f" "f ` U \ T" - obtains c where "homotopic_with (\x. True) U T f (\x. c)" + obtains c where "homotopic_with_canon (\x. True) U T f (\x. c)" proof - obtain r where "r ` S \ S" "continuous_on S r" "\x\S. r (r x) = r x" "T = r ` S" using ts by (auto simp: retract_of_def retraction) @@ -98,8 +98,8 @@ by (metis locally_compact_closedin closedin_retract) lemma homotopic_into_retract: - "\f ` S \ T; g ` S \ T; T retract_of U; homotopic_with (\x. True) S U f g\ - \ homotopic_with (\x. True) S T f g" + "\f ` S \ T; g ` S \ T; T retract_of U; homotopic_with_canon (\x. True) S U f g\ + \ homotopic_with_canon (\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 \ h" in exI) @@ -122,24 +122,24 @@ lemma deformation_retract_imp_homotopy_eqv: fixes S :: "'a::euclidean_space set" - assumes "homotopic_with (\x. True) S S id r" and r: "retraction S T r" + assumes "homotopic_with_canon (\x. True) S S id r" and r: "retraction S T r" shows "S homotopy_eqv T" proof - - have "homotopic_with (\x. True) S S (id \ r) id" + have "homotopic_with_canon (\x. True) S S (id \ r) id" by (simp add: assms(1) homotopic_with_symD) - moreover have "homotopic_with (\x. True) T T (r \ id) id" + moreover have "homotopic_with_canon (\x. True) T T (r \ id) id" using r unfolding retraction_def - by (metis (no_types, lifting) comp_id continuous_on_id' homotopic_with_equal homotopic_with_symD id_def image_id order_refl) + by (metis eq_id_iff homotopic_with_id2 topspace_euclidean_subtopology) ultimately show ?thesis - unfolding homotopy_eqv_def - by (metis continuous_on_id' id_def image_id r retraction_def) + 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 "(\r. homotopic_with (\x. True) S S id r \ retraction S T r) \ - T retract_of S \ (\f. homotopic_with (\x. True) S S id f \ f ` S \ T)" + shows "(\r. homotopic_with_canon (\x. True) S S id r \ retraction S T r) \ + T retract_of S \ (\f. homotopic_with_canon (\x. True) S S id f \ f ` S \ T)" (is "?lhs = ?rhs") proof assume ?lhs @@ -160,11 +160,11 @@ lemma deformation_retract_of_contractible_sing: fixes S :: "'a::euclidean_space set" assumes "contractible S" "a \ S" - obtains r where "homotopic_with (\x. True) S S id r" "retraction S {a} r" + obtains r where "homotopic_with_canon (\x. True) S S id r" "retraction S {a} r" proof - have "{a} retract_of S" by (simp add: \a \ S\) - moreover have "homotopic_with (\x. True) S S id (\x. a)" + moreover have "homotopic_with_canon (\x. True) S S id (\x. a)" using assms by (auto simp: contractible_def homotopic_into_contractible image_subset_iff) moreover have "(\x. a) ` S \ {a}" @@ -3392,7 +3392,7 @@ and arelS: "a \ rel_interior S" and relS: "rel_frontier S \ T" and affS: "T \ affine hull S" - obtains r where "homotopic_with (\x. True) (T - {a}) (T - {a}) id r" + obtains r where "homotopic_with_canon (\x. True) (T - {a}) (T - {a}) id r" "retraction (T - {a}) (rel_frontier S) r" proof - have "\d. 0 < d \ (a + d *\<^sub>R l) \ rel_frontier S \ @@ -3466,7 +3466,7 @@ by (blast intro: continuous_on_subset) show ?thesis proof - show "homotopic_with (\x. True) (T - {a}) (T - {a}) id (\x. a + dd (x - a) *\<^sub>R (x - a))" + show "homotopic_with_canon (\x. True) (T - {a}) (T - {a}) id (\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) @@ -3560,8 +3560,7 @@ apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S T]) using assms apply auto - apply (subst homotopy_eqv_sym) - using deformation_retract_imp_homotopy_eqv by blast + 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" @@ -3600,7 +3599,7 @@ lemma Borsuk_maps_homotopic_in_path_component: assumes "path_component (- s) a b" - shows "homotopic_with (\x. True) s (sphere 0 1) + shows "homotopic_with_canon (\x. True) s (sphere 0 1) (\x. inverse(norm(x - a)) *\<^sub>R (x - a)) (\x. inverse(norm(x - b)) *\<^sub>R (x - b))" proof - @@ -4128,8 +4127,8 @@ and anr: "(ANR S \ ANR T) \ ANR U" and contf: "continuous_on T f" and "f ` T \ U" - and "homotopic_with (\x. True) S U f g" - obtains g' where "homotopic_with (\x. True) T U f g'" + and "homotopic_with_canon (\x. True) S U f g" + obtains g' where "homotopic_with_canon (\x. True) T U f g'" "continuous_on T g'" "image g' T \ U" "\x. x \ S \ g' x = g x" proof - @@ -4141,9 +4140,9 @@ define h' where "h' \ \z. if snd z \ S then h z else (f \ snd) z" define B where "B \ {0::real} \ T \ {0..1} \ S" have clo0T: "closedin (top_of_set ({0..1} \ T)) ({0::real} \ T)" - by (simp add: closedin_subtopology_refl closedin_Times) + by (simp add: Abstract_Topology.closedin_Times) moreover have cloT1S: "closedin (top_of_set ({0..1} \ T)) ({0..1} \ S)" - by (simp add: closedin_subtopology_refl closedin_Times assms) + by (simp add: Abstract_Topology.closedin_Times assms) ultimately have clo0TB:"closedin (top_of_set ({0..1} \ T)) B" by (auto simp: B_def) have cloBS: "closedin (top_of_set B) ({0..1} \ S)" @@ -4225,7 +4224,7 @@ qed show ?thesis proof - show hom: "homotopic_with (\x. True) T U f (\x. k (a x, x))" + show hom: "homotopic_with_canon (\x. True) T U f (\x. k (a x, x))" proof (simp add: homotopic_with, intro exI conjI) show "continuous_on ({0..1} \ T) (k \ (\z. (fst z *\<^sub>R (a \ snd) z, snd z)))" apply (intro continuous_on_compose continuous_intros) @@ -4241,7 +4240,7 @@ by auto qed show "continuous_on T (\x. k (a x, x))" - using hom homotopic_with_imp_continuous by blast + using homotopic_with_imp_continuous_maps [OF hom] by auto show "(\x. k (a x, x)) ` T \ U" proof clarify fix t @@ -4262,12 +4261,12 @@ and "ANR T" and fim: "f ` S \ T" and "S \ {}" - shows "(\c. homotopic_with (\x. True) S T f (\x. c)) \ + shows "(\c. homotopic_with_canon (\x. True) S T f (\x. c)) \ (\g. continuous_on UNIV g \ range g \ T \ (\x \ S. g x = f x))" (is "?lhs = ?rhs") proof assume ?lhs - then obtain c where c: "homotopic_with (\x. True) S T (\x. c) f" + then obtain c where c: "homotopic_with_canon (\x. True) S T (\x. c) f" by (blast intro: homotopic_with_symD) have "closedin (top_of_set UNIV) S" using \closed S\ closed_closedin by fastforce @@ -4281,14 +4280,12 @@ assume ?rhs then obtain g where "continuous_on UNIV g" "range g \ T" "\x. x\S \ g x = f x" by blast - then obtain c where "homotopic_with (\h. True) UNIV T g (\x. c)" + then obtain c where "homotopic_with_canon (\h. True) UNIV T g (\x. c)" using nullhomotopic_from_contractible [of UNIV g T] contractible_UNIV by blast + then have "homotopic_with_canon (\x. True) S T g (\x. c)" + by (simp add: homotopic_from_subtopology) then show ?lhs - apply (rule_tac x=c in exI) - apply (rule homotopic_with_eq [of _ _ _ g "\x. c"]) - apply (rule homotopic_with_subset_left) - apply (auto simp: \\x. x \ S \ g x = f x\) - done + by (force elim: homotopic_with_eq [of _ _ _ g "\x. c"] simp: \\x. x \ S \ g x = f x\) qed corollary%unimportant nullhomotopic_into_rel_frontier_extension: @@ -4298,7 +4295,7 @@ and "convex T" "bounded T" and fim: "f ` S \ rel_frontier T" and "S \ {}" - shows "(\c. homotopic_with (\x. True) S (rel_frontier T) f (\x. c)) \ + shows "(\c. homotopic_with_canon (\x. True) S (rel_frontier T) f (\x. c)) \ (\g. continuous_on UNIV g \ range g \ rel_frontier T \ (\x \ S. g x = f x))" by (simp add: nullhomotopic_into_ANR_extension assms ANR_rel_frontier_convex) @@ -4306,7 +4303,7 @@ fixes f :: "'a::euclidean_space \ 'b :: euclidean_space" assumes "closed S" and contf: "continuous_on S f" and "S \ {}" and fim: "f ` S \ sphere a r" - shows "((\c. homotopic_with (\x. True) S (sphere a r) f (\x. c)) \ + shows "((\c. homotopic_with_canon (\x. True) S (sphere a r) f (\x. c)) \ (\g. continuous_on UNIV g \ range g \ sphere a r \ (\x \ S. g x = f x)))" (is "?lhs = ?rhs") proof (cases "r = 0") @@ -4328,7 +4325,7 @@ fixes a :: "'a :: euclidean_space" assumes "compact S" and "a \ S" shows "bounded (connected_component_set (- S) a) \ - \(\c. homotopic_with (\x. True) S (sphere 0 1) + \(\c. homotopic_with_canon (\x. True) S (sphere 0 1) (\x. inverse(norm(x - a)) *\<^sub>R (x - a)) (\x. c))" (is "?lhs = ?rhs") proof (cases "S = {}") @@ -4368,13 +4365,13 @@ using bounded_iff linear by blast then have bnot: "b \ ball 0 r" by simp - have "homotopic_with (\x. True) S (sphere 0 1) (\x. (x - a) /\<^sub>R norm (x - a)) + have "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. (x - a) /\<^sub>R norm (x - a)) (\x. (x - b) /\<^sub>R norm (x - b))" apply (rule Borsuk_maps_homotopic_in_path_component) using \closed S\ b open_Compl open_path_connected_component apply fastforce done moreover - obtain c where "homotopic_with (\x. True) (ball 0 r) (sphere 0 1) + obtain c where "homotopic_with_canon (\x. True) (ball 0 r) (sphere 0 1) (\x. inverse (norm (x - b)) *\<^sub>R (x - b)) (\x. c)" proof (rule nullhomotopic_from_contractible) show "contractible (ball (0::'a) r)" @@ -4384,8 +4381,7 @@ show "(\x. (x - b) /\<^sub>R norm (x - b)) ` ball 0 r \ sphere 0 1" using bnot Borsuk_map_into_sphere by blast qed blast - ultimately have "homotopic_with (\x. True) S (sphere 0 1) - (\x. (x - a) /\<^sub>R norm (x - a)) (\x. c)" + ultimately have "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. (x - a) /\<^sub>R norm (x - a)) (\x. c)" by (meson homotopic_with_subset_left homotopic_with_trans r) then show "\ ?rhs" by blast @@ -4397,7 +4393,7 @@ fixes a :: "'a :: euclidean_space" assumes "compact S" and "a \ S"and "b \ S" and boc: "bounded (connected_component_set (- S) a)" - and hom: "homotopic_with (\x. True) S (sphere 0 1) + and hom: "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. (x - a) /\<^sub>R norm (x - a)) (\x. (x - b) /\<^sub>R norm (x - b))" shows "connected_component (- S) a b" @@ -4418,7 +4414,7 @@ by (simp add: \b \ S\ notcc continuous_on_Borsuk_map) show "(\x. (x - b) /\<^sub>R norm (x - b)) ` ?T \ sphere 0 1" by (simp add: \b \ S\ notcc Borsuk_map_into_sphere) - show "homotopic_with (\x. True) S (sphere 0 1) + show "homotopic_with_canon (\x. True) S (sphere 0 1) (\x. (x - b) /\<^sub>R norm (x - b)) (\x. (x - a) /\<^sub>R norm (x - a))" by (simp add: hom homotopic_with_symD) qed (auto simp: ANR_sphere intro: that) @@ -4429,7 +4425,7 @@ lemma Borsuk_maps_homotopic_in_connected_component_eq: fixes a :: "'a :: euclidean_space" assumes S: "compact S" "a \ S" "b \ S" and 2: "2 \ DIM('a)" - shows "(homotopic_with (\x. True) S (sphere 0 1) + shows "(homotopic_with_canon (\x. True) S (sphere 0 1) (\x. (x - a) /\<^sub>R norm (x - a)) (\x. (x - b) /\<^sub>R norm (x - b)) \ connected_component (- S) a b)" @@ -4587,9 +4583,9 @@ assumes contf: "continuous_on S f" and fim: "f ` S \ U" and contg: "continuous_on S g" and gim: "g ` S \ U" and clo: "closedin (top_of_set S) T" - and "ANR U" and hom: "homotopic_with (\x. True) T U f g" + and "ANR U" and hom: "homotopic_with_canon (\x. True) T U f g" obtains V where "T \ V" "openin (top_of_set S) V" - "homotopic_with (\x. True) V U f g" + "homotopic_with_canon (\x. True) V U f g" proof - have "T \ S" using clo closedin_imp_subset by blast @@ -4631,7 +4627,7 @@ obtain T' where opeT': "openin (top_of_set S) T'" and "T \ T'" and TW: "{0..1} \ T' \ W" using tube_lemma_gen [of "{0..1::real}" T S W] W \T \ S\ opeW by auto - moreover have "homotopic_with (\x. True) T' U f g" + moreover have "homotopic_with_canon (\x. True) T' U f g" proof (simp add: homotopic_with, intro exI conjI) show "continuous_on ({0..1} \ T') k" using TW continuous_on_subset contk by auto @@ -4651,8 +4647,8 @@ fixes \ :: "'a::euclidean_space set set" assumes "\S. S \ \ \ closedin (top_of_set (\\)) S" and "\S. S \ \ \ openin (top_of_set (\\)) S" - and "\S. S \ \ \ homotopic_with (\x. True) S T f g" - shows "homotopic_with (\x. True) (\\) T f g" + and "\S. S \ \ \ homotopic_with_canon (\x. True) S T f g" + shows "homotopic_with_canon (\x. True) (\\) T f g" proof - obtain \ where "\ \ \" "countable \" and eqU: "\\ = \\" using Lindelof_openin assms by blast @@ -4660,14 +4656,14 @@ proof (cases "\ = {}") case True then show ?thesis - by (metis Union_empty eqU homotopic_on_empty) + by (metis Union_empty eqU homotopic_with_canon_on_empty) next case False then obtain V :: "nat \ 'a set" where V: "range V = \" using range_from_nat_into \countable \\ by metis with \\ \ \\ have clo: "\n. closedin (top_of_set (\\)) (V n)" and ope: "\n. openin (top_of_set (\\)) (V n)" - and hom: "\n. homotopic_with (\x. True) (V n) T f g" + and hom: "\n. homotopic_with_canon (\x. True) (V n) T f g" using assms by auto then obtain h where conth: "\n. continuous_on ({0..1::real} \ V n) (h n)" and him: "\n. h n ` ({0..1} \ V n) \ T" @@ -4723,9 +4719,9 @@ lemma homotopic_on_components_eq: fixes S :: "'a :: euclidean_space set" and T :: "'b :: euclidean_space set" assumes S: "locally connected S \ compact S" and "ANR T" - shows "homotopic_with (\x. True) S T f g \ + shows "homotopic_with_canon (\x. True) S T f g \ (continuous_on S f \ f ` S \ T \ continuous_on S g \ g ` S \ T) \ - (\C \ components S. homotopic_with (\x. True) C T f g)" + (\C \ components S. homotopic_with_canon (\x. True) C T f g)" (is "?lhs \ ?C \ ?rhs") proof - have "continuous_on S f" "f ` S \ T" "continuous_on S g" "g ` S \ T" if ?lhs @@ -4740,7 +4736,7 @@ assume R: ?rhs have "\U. C \ U \ closedin (top_of_set S) U \ openin (top_of_set S) U \ - homotopic_with (\x. True) U T f g" if C: "C \ components S" for C + homotopic_with_canon (\x. True) U T f g" if C: "C \ components S" for C proof - have "C \ S" by (simp add: in_components_subset that) @@ -4754,15 +4750,15 @@ by (simp add: closedin_component that) show "openin (top_of_set S) C" by (simp add: \locally connected S\ openin_components_locally_connected that) - show "homotopic_with (\x. True) C T f g" + show "homotopic_with_canon (\x. True) C T f g" by (simp add: R that) qed auto next assume "compact S" - have hom: "homotopic_with (\x. True) C T f g" + have hom: "homotopic_with_canon (\x. True) C T f g" using R that by blast obtain U where "C \ U" and opeU: "openin (top_of_set S) U" - and hom: "homotopic_with (\x. True) U T f g" + and hom: "homotopic_with_canon (\x. True) U T f g" using homotopic_neighbourhood_extension [OF contf fim contg gim _ \ANR T\ hom] \C \ components S\ closedin_component by blast then obtain V where "open V" and V: "U = S \ V" @@ -4775,7 +4771,7 @@ proof (intro exI conjI) show "closedin (top_of_set S) K" by (meson \compact K\ \compact S\ closedin_compact_eq opeK openin_imp_subset) - show "homotopic_with (\x. True) K T f g" + show "homotopic_with_canon (\x. True) K T f g" using V \K \ V\ hom homotopic_with_subset_left opeK openin_imp_subset by fastforce qed (use opeK \C \ K\ in auto) qed @@ -4783,7 +4779,7 @@ then obtain \ where \: "\C. C \ components S \ C \ \ C" and clo\: "\C. C \ components S \ closedin (top_of_set S) (\ C)" and ope\: "\C. C \ components S \ openin (top_of_set S) (\ C)" - and hom\: "\C. C \ components S \ homotopic_with (\x. True) (\ C) T f g" + and hom\: "\C. C \ components S \ homotopic_with_canon (\x. True) (\ C) T f g" by metis have Seq: "S = \ (\ ` components S)" proof @@ -4806,11 +4802,11 @@ assumes S: "locally connected S \ compact S" and "ANR T" shows "(\f g. continuous_on S f \ f ` S \ T \ continuous_on S g \ g ` S \ T \ - homotopic_with (\x. True) S T f g) + homotopic_with_canon (\x. True) S T f g) \ (\C\components S. \f g. continuous_on C f \ f ` C \ T \ continuous_on C g \ g ` C \ T \ - homotopic_with (\x. True) C T f g)" + homotopic_with_canon (\x. True) C T f g)" (is "?lhs = ?rhs") proof assume L[rule_format]: ?lhs @@ -4823,9 +4819,9 @@ using extension_from_component [OF S \ANR T\ C contf fim] by metis obtain g' where contg': "continuous_on S g'" and g'im: "g' ` S \ T" and g'g: "\x. x \ C \ g' x = g x" using extension_from_component [OF S \ANR T\ C contg gim] by metis - have "homotopic_with (\x. True) C T f' g'" + have "homotopic_with_canon (\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 (\x. True) C T f g" + then show "homotopic_with_canon (\x. True) C T f g" using f'f g'g homotopic_with_eq by force qed next @@ -4835,10 +4831,10 @@ fix f g assume contf: "continuous_on S f" and fim: "f ` S \ T" and contg: "continuous_on S g" and gim: "g ` S \ T" - moreover have "homotopic_with (\x. True) C T f g" if "C \ components S" for C + moreover have "homotopic_with_canon (\x. True) C T f g" if "C \ 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 (\x. True) S T f g" + ultimately show "homotopic_with_canon (\x. True) S T f g" by (subst homotopic_on_components_eq [OF S \ANR T\]) auto qed qed