# HG changeset patch # User paulson # Date 1689626989 -3600 # Node ID e2a5c4117ff08cd9e36524eadad063e582219a76 # Parent 57f5127d2ff29e4fd5e85a148c8ce835a83c3956 tidying a few proofs a bit more diff -r 57f5127d2ff2 -r e2a5c4117ff0 src/HOL/Analysis/Brouwer_Fixpoint.thy --- a/src/HOL/Analysis/Brouwer_Fixpoint.thy Mon Jul 17 12:31:06 2023 +0100 +++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy Mon Jul 17 21:49:49 2023 +0100 @@ -22,40 +22,39 @@ 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 image_subset_iff_funcset) -apply (rule_tac x="r a" in exI) -apply (rule_tac x="r \ h" in exI) -apply (intro conjI continuous_intros continuous_on_compose) -apply (erule continuous_on_subset | force)+ -done + shows "contractible S" + using assms + apply (clarsimp simp add: retract_of_def contractible_def retraction_def homotopic_with image_subset_iff_funcset) + apply (rule_tac x="r a" in exI) + apply (rule_tac x="r \ h" in exI) + apply (intro conjI continuous_intros continuous_on_compose) + apply (erule continuous_on_subset | force)+ + done lemma retract_of_path_connected: "\path_connected T; S retract_of T\ \ path_connected S" by (metis path_connected_continuous_image retract_of_def retraction) lemma retract_of_simply_connected: - "\simply_connected T; S retract_of T\ \ 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 + "\simply_connected T; S retract_of T\ \ simply_connected S" + apply (simp add: retract_of_def retraction_def Pi_iff, 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: "\f g. \continuous_on U f; f ` U \ S; - continuous_on U g; g ` U \ S\ + and hom: "\f g. \continuous_on U f; f \ U \ S; + continuous_on U g; g \ U \ S\ \ 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" + and "continuous_on U f" "f \ U \ T" + and "continuous_on U g" "g \ U \ T" 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" + 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) then obtain k where "Retracts S r T k" - unfolding Retracts_def - by (metis continuous_on_subset dual_order.trans image_iff image_mono) + unfolding Retracts_def using continuous_on_id by blast then show ?thesis apply (rule Retracts.homotopically_trivial_retraction_gen) using assms @@ -65,16 +64,15 @@ lemma retract_of_homotopically_trivial_null: assumes ts: "T retract_of S" - and hom: "\f. \continuous_on U f; f ` U \ S\ + and hom: "\f. \continuous_on U f; f \ U \ S\ \ \c. homotopic_with_canon (\x. True) U S f (\x. c)" - and "continuous_on U f" "f ` U \ T" + and "continuous_on U f" "f \ U \ T" 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" + 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) then obtain k where "Retracts S r T k" - unfolding Retracts_def - by (metis continuous_on_subset dual_order.trans image_iff image_mono) + unfolding Retracts_def by fastforce then show ?thesis apply (rule Retracts.homotopically_trivial_retraction_null_gen) apply (rule TrueI refl assms that | assumption)+ @@ -92,25 +90,24 @@ by (metis locally_compact_closedin closedin_retract) lemma homotopic_into_retract: - "\f ` S \ T; g ` S \ T; T retract_of U; homotopic_with_canon (\x. True) S U 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) -apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+ -done + apply (subst (asm) homotopic_with_def) + apply (simp add: homotopic_with retract_of_def retraction_def Pi_iff, clarify) + apply (rule_tac x="r \ h" in exI) + by (smt (verit, ccfv_SIG) comp_def continuous_on_compose continuous_on_subset image_subset_iff) 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) + by (metis Abstract_Topology_2.retraction_openin_vimage_iff idempotent_imp_retraction 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) + by (metis Abstract_Topology_2.retraction_openin_vimage_iff idempotent_imp_retraction locally_path_connected_quotient_image retract_ofE) text \A few simple lemmas about deformation retracts\ @@ -133,7 +130,7 @@ lemma deformation_retract: fixes S :: "'a::euclidean_space set" 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)" + T retract_of S \ (\f. homotopic_with_canon (\x. True) S S id f \ f \ S \ T)" (is "?lhs = ?rhs") proof assume ?lhs @@ -147,7 +144,7 @@ apply (rule homotopic_with_trans, assumption) apply (rule_tac f = "r \ f" and g="r \ id" in homotopic_with_eq) apply (rule_tac Y=S in homotopic_with_compose_continuous_left) - apply (auto simp: homotopic_with_sym) + apply (auto simp: homotopic_with_sym Pi_iff) done qed @@ -161,10 +158,10 @@ 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}" + moreover have "(\x. a) \ S \ {a}" by (simp add: image_subsetI) ultimately show ?thesis - using that deformation_retract by metis + by (metis that deformation_retract) qed diff -r 57f5127d2ff2 -r e2a5c4117ff0 src/HOL/Analysis/Homotopy.thy --- a/src/HOL/Analysis/Homotopy.thy Mon Jul 17 12:31:06 2023 +0100 +++ b/src/HOL/Analysis/Homotopy.thy Mon Jul 17 21:49:49 2023 +0100 @@ -2971,7 +2971,7 @@ assumes S: "subspace S" and T: "subspace T" and d: "dim S \ dim T" - obtains f where "linear f" "f ` S \ T" "\x. x \ S \ norm(f x) = norm x" + obtains f where "linear f" "f \ S \ T" "\x. x \ S \ norm(f x) = norm x" proof - obtain B where "B \ S" and Borth: "pairwise orthogonal B" and B1: "\x. x \ B \ norm x = 1" @@ -3011,7 +3011,7 @@ by (simp add: norm_eq_sqrt_inner) qed then show ?thesis - by (rule that [OF \linear f\ \f ` S \ T\]) + by (meson \f ` S \ T\ \linear f\ image_subset_iff_funcset that) qed proposition isometries_subspaces: @@ -3190,36 +3190,36 @@ assumes conth: "continuous_on S h" and imh: "h ` S = t" and contk: "continuous_on t k" - and imk: "k ` t \ S" + and imk: "k \ t \ S" and idhk: "\y. y \ t \ h(k y) = y" begin lemma homotopically_trivial_retraction_gen: - assumes P: "\f. \continuous_on U f; f ` U \ t; Q f\ \ P(k \ f)" - and Q: "\f. \continuous_on U f; f ` U \ S; P f\ \ Q(h \ f)" + assumes P: "\f. \continuous_on U f; f \ U \ t; Q f\ \ P(k \ f)" + and Q: "\f. \continuous_on U f; f \ U \ S; P f\ \ Q(h \ f)" and Qeq: "\h k. (\x. x \ U \ h x = k x) \ Q h = Q k" - and hom: "\f g. \continuous_on U f; f ` U \ S; P f; - continuous_on U g; g ` U \ S; P g\ + and hom: "\f g. \continuous_on U f; f \ U \ S; P f; + continuous_on U g; g \ U \ S; P g\ \ homotopic_with_canon P U S f g" - and contf: "continuous_on U f" and imf: "f ` U \ t" and Qf: "Q f" - and contg: "continuous_on U g" and img: "g ` U \ t" and Qg: "Q g" + and contf: "continuous_on U f" and imf: "f \ U \ t" and Qf: "Q f" + and contg: "continuous_on U g" and img: "g \ U \ t" and Qg: "Q g" shows "homotopic_with_canon Q U t f g" proof - have "continuous_on U (k \ f)" - using contf continuous_on_compose continuous_on_subset contk imf by blast + by (meson contf continuous_on_compose continuous_on_subset contk funcset_image imf) moreover have "(k \ f) ` U \ S" using imf imk by fastforce moreover have "P (k \ f)" by (simp add: P Qf contf imf) moreover have "continuous_on U (k \ g)" - using contg continuous_on_compose continuous_on_subset contk img by blast + by (meson contg continuous_on_compose continuous_on_subset contk funcset_image img) moreover have "(k \ g) ` U \ S" using img imk by fastforce moreover have "P (k \ g)" by (simp add: P Qg contg img) ultimately have "homotopic_with_canon P U S (k \ f) (k \ g)" - by (rule hom) + by (simp add: hom image_subset_iff) then have "homotopic_with_canon Q U t (h \ (k \ f)) (h \ (k \ g))" apply (rule homotopic_with_compose_continuous_left [OF homotopic_with_mono]) using Q conth imh by force+ @@ -3228,23 +3228,23 @@ show "\h k. (\x. x \ U \ h x = k x) \ Q h = Q k" using Qeq topspace_euclidean_subtopology by blast show "\x. x \ U \ f x = h (k (f x))" "\x. x \ U \ g x = h (k (g x))" - using idhk imf img by auto + using idhk imf img by fastforce+ qed qed lemma homotopically_trivial_retraction_null_gen: - assumes P: "\f. \continuous_on U f; f ` U \ t; Q f\ \ P(k \ f)" - and Q: "\f. \continuous_on U f; f ` U \ S; P f\ \ Q(h \ f)" + assumes P: "\f. \continuous_on U f; f \ U \ t; Q f\ \ P(k \ f)" + and Q: "\f. \continuous_on U f; f \ U \ S; P f\ \ Q(h \ f)" and Qeq: "\h k. (\x. x \ U \ h x = k x) \ Q h = Q k" - and hom: "\f. \continuous_on U f; f ` U \ S; P f\ + and hom: "\f. \continuous_on U f; f \ U \ S; P f\ \ \c. homotopic_with_canon P U S f (\x. c)" - and contf: "continuous_on U f" and imf:"f ` U \ t" and Qf: "Q f" + and contf: "continuous_on U f" and imf:"f \ U \ t" and Qf: "Q f" obtains c where "homotopic_with_canon Q U t f (\x. c)" proof - have feq: "\x. x \ U \ (h \ (k \ f)) x = f x" using idhk imf by auto have "continuous_on U (k \ f)" - using contf continuous_on_compose continuous_on_subset contk imf by blast - moreover have "(k \ f) ` U \ S" + by (meson contf continuous_on_compose continuous_on_subset contk funcset_image imf) + moreover have "(k \ f) \ U \ S" using imf imk by fastforce moreover have "P (k \ f)" by (simp add: P Qf contf imf) @@ -3265,32 +3265,32 @@ qed lemma cohomotopically_trivial_retraction_gen: - assumes P: "\f. \continuous_on t f; f ` t \ U; Q f\ \ P(f \ h)" - and Q: "\f. \continuous_on S f; f ` S \ U; P f\ \ Q(f \ k)" + assumes P: "\f. \continuous_on t f; f \ t \ U; Q f\ \ P(f \ h)" + and Q: "\f. \continuous_on S f; f \ S \ U; P f\ \ Q(f \ k)" and Qeq: "\h k. (\x. x \ t \ h x = k x) \ Q h = Q k" - and hom: "\f g. \continuous_on S f; f ` S \ U; P f; - continuous_on S g; g ` S \ U; P g\ + and hom: "\f g. \continuous_on S f; f \ S \ U; P f; + continuous_on S g; g \ S \ U; P g\ \ homotopic_with_canon P S U f g" - and contf: "continuous_on t f" and imf: "f ` t \ U" and Qf: "Q f" - and contg: "continuous_on t g" and img: "g ` t \ U" and Qg: "Q g" + and contf: "continuous_on t f" and imf: "f \ t \ U" and Qf: "Q f" + and contg: "continuous_on t g" and img: "g \ t \ U" and Qg: "Q g" shows "homotopic_with_canon Q t U f g" proof - have feq: "\x. x \ t \ (f \ h \ k) x = f x" using idhk imf by auto have geq: "\x. x \ t \ (g \ h \ k) x = g x" using idhk img by auto have "continuous_on S (f \ h)" using contf conth continuous_on_compose imh by blast - moreover have "(f \ h) ` S \ U" + moreover have "(f \ h) \ S \ U" using imf imh by fastforce moreover have "P (f \ h)" by (simp add: P Qf contf imf) moreover have "continuous_on S (g \ h)" using contg continuous_on_compose continuous_on_subset conth imh by blast - moreover have "(g \ h) ` S \ U" + moreover have "(g \ h) \ S \ U" using img imh by fastforce moreover have "P (g \ h)" by (simp add: P Qg contg img) ultimately have "homotopic_with_canon P S U (f \ h) (g \ h)" - by (rule hom) + by (simp add: hom) then have "homotopic_with_canon Q t U (f \ h \ k) (g \ h \ k)" apply (rule homotopic_with_compose_continuous_right [OF homotopic_with_mono]) using Q contk imk by force+ @@ -3303,18 +3303,18 @@ qed lemma cohomotopically_trivial_retraction_null_gen: - assumes P: "\f. \continuous_on t f; f ` t \ U; Q f\ \ P(f \ h)" - and Q: "\f. \continuous_on S f; f ` S \ U; P f\ \ Q(f \ k)" + assumes P: "\f. \continuous_on t f; f \ t \ U; Q f\ \ P(f \ h)" + and Q: "\f. \continuous_on S f; f \ S \ U; P f\ \ Q(f \ k)" and Qeq: "\h k. (\x. x \ t \ h x = k x) \ Q h = Q k" - and hom: "\f g. \continuous_on S f; f ` S \ U; P f\ + and hom: "\f g. \continuous_on S f; f \ S \ U; P f\ \ \c. homotopic_with_canon P S U f (\x. c)" - and contf: "continuous_on t f" and imf: "f ` t \ U" and Qf: "Q f" + and contf: "continuous_on t f" and imf: "f \ t \ U" and Qf: "Q f" obtains c where "homotopic_with_canon Q t U f (\x. c)" proof - have feq: "\x. x \ t \ (f \ h \ k) x = f x" using idhk imf by auto have "continuous_on S (f \ h)" using contf conth continuous_on_compose imh by blast - moreover have "(f \ h) ` S \ U" + moreover have "(f \ h) \ S \ U" using imf imh by fastforce moreover have "P (f \ h)" by (simp add: P Qf contf imf) @@ -3335,12 +3335,12 @@ lemma simply_connected_retraction_gen: shows "\simply_connected S; continuous_on S h; h ` S = T; - continuous_on T k; k ` T \ S; \y. y \ T \ h(k y) = y\ + continuous_on T k; k \ T \ S; \y. y \ T \ h(k y) = y\ \ 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 _ "\p. pathfinish p = pathstart p" "\p. pathfinish p = pathstart p"]) -apply (simp_all add: Retracts_def pathfinish_def pathstart_def) +apply (simp_all add: Retracts_def pathfinish_def pathstart_def image_subset_iff_funcset) done lemma homeomorphic_simply_connected: