diff -r 67bf692cf1ab -r cc1058b83124 src/HOL/Analysis/Homotopy.thy --- a/src/HOL/Analysis/Homotopy.thy Wed Jul 26 20:28:35 2023 +0200 +++ b/src/HOL/Analysis/Homotopy.thy Thu Jul 27 23:05:25 2023 +0100 @@ -712,7 +712,7 @@ proposition homotopic_loops_subset: "\homotopic_loops S p q; S \ t\ \ homotopic_loops t p q" - by (fastforce simp add: homotopic_loops) + by (fastforce simp: homotopic_loops) proposition homotopic_loops_eq: "\path p; path_image p \ S; pathfinish p = pathstart p; \t. t \ {0..1} \ p(t) = q(t)\ @@ -1040,17 +1040,15 @@ have "homotopic_paths S (subpath u w g +++ subpath w v g) ((subpath u v g +++ subpath v w g) +++ subpath w v g)" by (simp add: hom homotopic_paths_join homotopic_paths_sym wvg) - 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)" + also have "homotopic_paths S \ (subpath u v g +++ subpath v w g +++ subpath w v g)" using wvg vug \path g\ by (metis homotopic_paths_assoc homotopic_paths_sym path_image_subpath_commute path_subpath pathfinish_subpath pathstart_subpath u v w) - 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)))" + also have "homotopic_paths S \ (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g)))" using wvg vug \path g\ by (metis homotopic_paths_join homotopic_paths_linv homotopic_paths_refl path_image_subpath_commute path_subpath pathfinish_subpath pathstart_join pathstart_subpath reversepath_subpath u v) - also have "homotopic_paths S (subpath u v g +++ linepath (pathfinish (subpath u v g)) (pathfinish (subpath u v g))) (subpath u v g)" + also have "homotopic_paths S \ (subpath u v g)" using vug \path g\ by (metis homotopic_paths_rid path_image_subpath_commute path_subpath u v) finally have "homotopic_paths S (subpath u w g +++ subpath w v g) (subpath u v g)" . then show ?thesis @@ -1077,11 +1075,11 @@ qed lemma homotopic_loops_imp_path_component_value: - "\homotopic_loops S p q; 0 \ t; t \ 1\ \ path_component S (p t) (q t)" -apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs) -apply (rule_tac x="h \ (\u. (u, t))" in exI) -apply (fastforce elim!: continuous_on_subset intro!: continuous_intros) -done + "\homotopic_loops S p q; 0 \ t; t \ 1\ \ path_component S (p t) (q t)" + apply (clarsimp simp: homotopic_loops_def homotopic_with_def path_defs) + apply (rule_tac x="h \ (\u. (u, t))" in exI) + apply (fastforce elim!: continuous_on_subset intro!: continuous_intros) + done lemma homotopic_points_eq_path_component: "homotopic_loops S (linepath a a) (linepath b b) \ path_component S a b" @@ -1109,12 +1107,12 @@ lemma simply_connected_imp_path_connected: fixes S :: "_::real_normed_vector set" shows "simply_connected S \ path_connected S" -by (simp add: simply_connected_def path_connected_eq_homotopic_points) + 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 \ connected S" -by (simp add: path_connected_imp_connected simply_connected_imp_path_connected) + 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" @@ -1123,13 +1121,10 @@ \ homotopic_loops S p (linepath a a))" (is "?lhs = ?rhs") proof - assume ?lhs then show ?rhs - unfolding simply_connected_def by force -next assume ?rhs then show ?lhs unfolding simply_connected_def by (metis pathfinish_in_path_image subsetD homotopic_loops_trans homotopic_loops_sym) -qed +qed (force simp: simply_connected_def) lemma simply_connected_eq_contractible_loop_some: fixes S :: "_::real_normed_vector set" @@ -1154,15 +1149,7 @@ S = {} \ (\a \ S. \p. path p \ path_image p \ S \ pathfinish p = pathstart p \ 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 \ S" by blast - then show ?thesis - by (meson False homotopic_loops_sym homotopic_loops_trans simply_connected_def simply_connected_eq_contractible_loop_any) -qed + by (meson ex_in_conv homotopic_loops_sym homotopic_loops_trans simply_connected_def simply_connected_eq_contractible_loop_any) lemma simply_connected_eq_contractible_path: fixes S :: "_::real_normed_vector set" @@ -1207,14 +1194,12 @@ using that by (smt (verit, best) homotopic_paths_join homotopic_paths_linv homotopic_paths_rid homotopic_paths_sym homotopic_paths_trans pathstart_linepath) - also have "homotopic_paths S (p +++ reversepath q +++ q) - ((p +++ reversepath q) +++ q)" + also have "homotopic_paths S \ ((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)" + also have "homotopic_paths S \ (linepath (pathstart q) (pathstart q) +++ q)" using * [of "p +++ reversepath q"] that by (simp add: homotopic_paths_assoc homotopic_paths_join path_image_join) - also have "homotopic_paths S (linepath (pathstart q) (pathstart q) +++ q) q" + also have "homotopic_paths S \ q" using that homotopic_paths_lid by blast finally show ?thesis . qed @@ -1238,7 +1223,7 @@ have "path (fst \ p)" by (simp add: continuous_on_fst Path_Connected.path_continuous_image [OF \path p\]) moreover have "path_image (fst \ p) \ S" - using that by (force simp add: path_image_def) + using that by (force simp: path_image_def) ultimately have p1: "homotopic_loops S (fst \ p) (linepath a a)" using S that by (simp add: simply_connected_eq_contractible_loop_any pathfinish_def pathstart_def) @@ -1291,12 +1276,12 @@ corollary contractible_imp_connected: fixes S :: "_::real_normed_vector set" shows "contractible S \ connected S" -by (simp add: contractible_imp_simply_connected simply_connected_imp_connected) + 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 \ path_connected S" -by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected) + by (simp add: contractible_imp_simply_connected simply_connected_imp_path_connected) lemma nullhomotopic_through_contractible: fixes S :: "_::topological_space set" @@ -1351,7 +1336,7 @@ with \path_connected U\ show ?thesis by blast qed then have "homotopic_with_canon (\h. True) S U (\x. c2) (\x. c1)" - by (auto simp add: path_component homotopic_constant_maps) + by (auto simp: path_component homotopic_constant_maps) then show ?thesis using c1 c2 homotopic_with_symD homotopic_with_trans by blast qed @@ -1419,7 +1404,7 @@ using \a \ S\ unfolding homotopic_with_def apply (rule_tac x="\y. (1 - (fst y)) *\<^sub>R snd y + (fst y) *\<^sub>R a" in exI) - apply (force simp add: P intro: continuous_intros) + apply (force simp: P intro: continuous_intros) done then show ?thesis using that by blast @@ -1516,18 +1501,17 @@ where "locally P S \ \w x. openin (top_of_set S) w \ x \ w - \ (\u v. openin (top_of_set S) u \ P v \ x \ u \ u \ v \ v \ w)" + \ (\U V. openin (top_of_set S) U \ P V \ x \ U \ U \ V \ V \ w)" lemma locallyI: assumes "\w x. \openin (top_of_set S) w; x \ w\ - \ \u v. openin (top_of_set S) u \ P v \ x \ u \ u \ v \ v \ w" + \ \U V. openin (top_of_set S) U \ P V \ x \ U \ U \ V \ V \ 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 \ w" - obtains u v where "openin (top_of_set S) u" - "P v" "x \ u" "u \ v" "v \ w" + obtains U V where "openin (top_of_set S) U" "P V" "x \ U" "U \ V" "V \ w" using assms unfolding locally_def by meson lemma locally_mono: @@ -1636,28 +1620,26 @@ using \f ` S = T\ f \V \ S\ by auto have contvf: "continuous_on V f" using \V \ S\ continuous_on_subset f(3) by blast - have "f ` V \ W" - using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto - then have contvg: "continuous_on (f ` V) g" - using \W \ T\ continuous_on_subset [OF g(3)] by blast - have "V \ g ` f ` V" - by (metis \V \ S\ hom homeomorphism_def homeomorphism_of_subsets order_refl) - then have homv: "homeomorphism V (f ` V) f g" - using \V \ S\ f by (auto simp: homeomorphism_def contvf contvg) have "openin (top_of_set (g ` T)) U" using \g ` T = S\ by (simp add: osu) then have "openin (top_of_set T) (T \ g -` U)" using \continuous_on T g\ continuous_on_open [THEN iffD1] by blast moreover have "\V. Q V \ y \ (T \ g -` U) \ (T \ g -` U) \ V \ V \ W" proof (intro exI conjI) + show "f ` V \ W" + using uv using Int_lower2 gw image_subsetI mem_Collect_eq subset_iff by auto + then have contvg: "continuous_on (f ` V) g" + using \W \ T\ continuous_on_subset [OF g(3)] by blast + have "V \ g ` f ` V" + by (metis \V \ S\ hom homeomorphism_def homeomorphism_of_subsets order_refl) + then have homv: "homeomorphism V (f ` V) f g" + using \V \ S\ f by (auto simp: homeomorphism_def contvf contvg) show "Q (f ` V)" using Q homv \P V\ by blast show "y \ T \ g -` U" using T(2) \y \ W\ \g y \ U\ by blast show "T \ g -` U \ f ` V" using g(1) image_iff uv(3) by fastforce - show "f ` V \ W" - using \f ` V \ W\ by blast qed ultimately show "\U. openin (top_of_set T) U \ (\v. Q v \ y \ U \ U \ v \ v \ W)" by meson @@ -1692,8 +1674,7 @@ fixes f :: "'a::euclidean_space \ 'b::euclidean_space" assumes f: "linear f" "inj f" and iff: "\S. P (f ` S) \ Q S" shows "locally P (f ` S) \ locally Q S" - using homeomorphism_locally [of "f`S" _ _ f] linear_homeomorphism_image [OF f] - by (metis (no_types, lifting) homeomorphism_image2 iff) + by (smt (verit) f homeomorphism_image2 homeomorphism_locally iff linear_homeomorphism_image) lemma locally_open_map_image: fixes f :: "'a::real_normed_vector \ 'b::real_normed_vector" @@ -1782,8 +1763,8 @@ shows "R a b" proof - have "\a b c. \a \ S; b \ S; c \ S; R a b\ \ R a c" - apply (rule connected_induction_simple [OF \connected S\], simp_all) - by (meson local.sym local.trans opI openin_imp_subset subsetCE) + by (smt (verit, ccfv_threshold) connected_induction_simple [OF \connected S\] + assms openin_imp_subset subset_eq) then show ?thesis by (metis etc opI) qed @@ -1833,13 +1814,13 @@ compact v \ x \ u \ u \ v \ v \ S \ T" if "open T" "x \ S" "x \ T" for x T proof - - obtain u v where uv: "x \ u" "u \ v" "v \ S" "compact v" "openin (top_of_set S) u" + obtain U V where uv: "x \ U" "U \ V" "V \ S" "compact V" "openin (top_of_set S) U" using r [OF \x \ S\] by auto obtain e where "e>0" and e: "cball x e \ T" using open_contains_cball \open T\ \x \ T\ by blast show ?thesis - apply (rule_tac x="(S \ ball x e) \ u" in exI) - apply (rule_tac x="cball x e \ v" in exI) + apply (rule_tac x="(S \ ball x e) \ U" in exI) + apply (rule_tac x="cball x e \ V" in exI) using that \e > 0\ e uv apply auto done @@ -1860,16 +1841,8 @@ shows "locally compact S \ (\x \ S. \U. x \ U \ openin (top_of_set S) U \ compact(closure U) \ closure U \ S)" - (is "?lhs = ?rhs") -proof - assume ?lhs - then show ?rhs - by (meson bounded_subset closure_minimal compact_closure compact_imp_bounded - compact_imp_closed dual_order.trans locally_compactE) -next - assume ?rhs then show ?lhs - by (meson closure_subset locally_compact) -qed + by (smt (verit, ccfv_threshold) bounded_subset closure_closed closure_mono closure_subset + compact_closure compact_imp_closed order.trans locally_compact) lemma locally_compact_Int_cball: fixes S :: "'a :: heine_borel set" @@ -2008,8 +1981,9 @@ then show ?rhs unfolding locally_def apply (elim all_forward imp_forward asm_rl exE) - apply (rule_tac x = "u \ ball x 1" in exI) - apply (rule_tac x = "v \ cball x 1" in exI) + apply (rename_tac U V) + apply (rule_tac x = "U \ ball x 1" in exI) + apply (rule_tac x = "V \ cball x 1" in exI) apply (force intro: openin_trans) done next @@ -2019,7 +1993,7 @@ lemma locally_compact_openin_Un: fixes S :: "'a::euclidean_space set" - assumes LCS: "locally compact S" and LCT:"locally compact T" + assumes LCS: "locally compact S" and LCT: "locally compact T" and opS: "openin (top_of_set (S \ T)) S" and opT: "openin (top_of_set (S \ T)) T" shows "locally compact (S \ T)" @@ -2453,7 +2427,7 @@ "\v x. \openin (top_of_set S) v; x \ v\ \ \u. openin (top_of_set S) u \ path_connected u \ x \ u \ u \ v" shows "locally path_connected S" - by (force simp add: locally_def dest: assms) + by (force simp: locally_def dest: assms) lemma locally_path_connected_2: assumes "locally path_connected S" @@ -2525,7 +2499,7 @@ proof assume ?lhs then show ?rhs - by (fastforce simp add: locally_connected) + by (fastforce simp: locally_connected) next assume ?rhs have *: "\T. openin (top_of_set S) T \ x \ T \ T \ c" @@ -3577,7 +3551,7 @@ show thesis using homotopic_with_compose_continuous_map_right [OF homotopic_with_compose_continuous_map_left [OF b g] f] - by (force simp add: that) + by (force simp: that) qed lemma nullhomotopic_into_contractible_space: @@ -3901,7 +3875,7 @@ by (rule homotopic_with_compose_continuous_left [where Y=T]) (use f in \auto simp: hom homotopic_with_symD\) ultimately show ?thesis - using that homotopic_with_trans by (fastforce simp add: o_def) + using that homotopic_with_trans by (fastforce simp: o_def) qed lemma homotopy_eqv_cohomotopic_triviality_null: @@ -3942,7 +3916,7 @@ by (rule homotopic_with_compose_continuous_right [where X=T]) (use f in \auto simp: hom homotopic_with_symD\) ultimately show ?thesis - using homotopic_with_trans by (fastforce simp add: o_def) + using homotopic_with_trans by (fastforce simp: o_def) qed lemma homotopy_eqv_homotopic_triviality_null: @@ -5002,7 +4976,7 @@ using \ by (auto simp: pairwise_def bij_betw_def inj_on_def) qed (use affine_hull_open assms that in auto) then show ?thesis - using \ \P \ U\ bij_betwE by (fastforce simp add: intro!: that) + using \ \P \ U\ bij_betwE by (fastforce simp: intro!: that) next case False with DIM_positive have "DIM('a) = 1" @@ -5089,7 +5063,7 @@ using \ by (auto simp: pairwise_def bij_betw_def inj_on_def) qed then show ?thesis - using \ \P \ U\ bij_betwE by (fastforce simp add: intro!: that) + using \ \P \ U\ bij_betwE by (fastforce simp: 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 @@ -5173,9 +5147,9 @@ using \T \ affine hull S\ h by auto qed show "\x. x \ T \ g' (f' x) = x" - using h j hom homeomorphism_apply1 by (fastforce simp add: f'_def g'_def) + using h j hom homeomorphism_apply1 by (fastforce simp: f'_def g'_def) show "\y. y \ T \ f' (g' y) = y" - using h j hom homeomorphism_apply2 by (fastforce simp add: f'_def g'_def) + using h j hom homeomorphism_apply2 by (fastforce simp: f'_def g'_def) qed next have \
: "\x y. \x \ affine hull S; h x = h y; y \ S\ \ x \ S" @@ -5241,7 +5215,7 @@ and d: "\x'. \dist x' a \ r; x' \ a; dist x' x < d\ \ dist (g x') (g x) < e" using contg False x \e>0\ - unfolding continuous_on_iff by (fastforce simp add: dist_commute intro: that) + unfolding continuous_on_iff by (fastforce simp: dist_commute intro: that) show ?thesis using \d > 0\ \x \ a\ by (rule_tac x="min d (norm(x - a))" in exI) @@ -5287,7 +5261,7 @@ next assume ?rhs then show ?lhs - using equal continuous_on_const by (force simp add: homotopic_with) + using equal continuous_on_const by (force simp: homotopic_with) qed next case greater