1.1 --- a/src/HOL/IsaMakefile Fri Oct 23 14:33:07 2009 +0200
1.2 +++ b/src/HOL/IsaMakefile Fri Oct 23 13:23:18 2009 +0200
1.3 @@ -323,15 +323,14 @@
1.4
1.5 $(LOG)/HOL-Library.gz: $(OUT)/HOL Library/SetsAndFunctions.thy \
1.6 Library/Abstract_Rat.thy Library/BigO.thy Library/ContNotDenum.thy \
1.7 - Library/Efficient_Nat.thy Library/Euclidean_Space.thy \
1.8 + Library/Efficient_Nat.thy \
1.9 Library/Sum_Of_Squares.thy Library/Sum_Of_Squares/sos_wrapper.ML \
1.10 Library/Sum_Of_Squares/sum_of_squares.ML Library/Fset.thy \
1.11 - Library/Convex_Euclidean_Space.thy Library/Glbs.thy \
1.12 + Library/Glbs.thy \
1.13 Library/normarith.ML Library/Executable_Set.thy \
1.14 Library/Infinite_Set.thy Library/FuncSet.thy \
1.15 - Library/Permutations.thy Library/Determinants.thy Library/Bit.thy \
1.16 - Library/Topology_Euclidean_Space.thy \
1.17 - Library/Finite_Cartesian_Product.thy Library/FrechetDeriv.thy \
1.18 + Library/Permutations.thy Library/Bit.thy \
1.19 + Library/FrechetDeriv.thy \
1.20 Library/Fraction_Field.thy Library/Fundamental_Theorem_Algebra.thy \
1.21 Library/Inner_Product.thy Library/Kleene_Algebra.thy \
1.22 Library/Lattice_Syntax.thy \
1.23 @@ -1005,6 +1004,19 @@
1.24 @cd TLA; $(ISABELLE_TOOL) usedir $(OUT)/TLA Memory
1.25
1.26
1.27 +## HOL-Multivariate_Analysis
1.28 +
1.29 +HOL-Multivariate_Analysis: HOL $(OUT)/HOL-Multivariate_Analysis
1.30 +
1.31 +$(OUT)/HOL-Multivariate_Analysis: $(OUT)/HOL Multivariate_Analysis/ROOT.ML \
1.32 + Multivariate_Analysis/Multivariate_Analysis.thy \
1.33 + Multivariate_Analysis/Determinants.thy \
1.34 + Multivariate_Analysis/Finite_Cartesian_Product.thy \
1.35 + Multivariate_Analysis/Euclidean_Space.thy \
1.36 + Multivariate_Analysis/Topology_Euclidean_Space.thy \
1.37 + Multivariate_Analysis/Convex_Euclidean_Space.thy
1.38 + @cd Multivariate_Analysis; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL HOL-Multivariate_Analysis
1.39 +
1.40 ## HOL-Nominal
1.41
1.42 HOL-Nominal: HOL $(OUT)/HOL-Nominal
2.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2 +++ b/src/HOL/Library/#Topology_Euclidean_Space.thy# Fri Oct 23 13:23:18 2009 +0200
2.3 @@ -0,0 +1,6029 @@
2.4 +(* Title: Topology
2.5 + Author: Amine Chaieb, University of Cambridge
2.6 + Author: Robert Himmelmann, TU Muenchen
2.7 +*)
2.8 +
2.9 +header {* Elementary topology in Euclidean space. *}
2.10 +
2.11 +theory Topology_Euclidean_Space
2.12 +imports SEQ Euclidean_Space Product_Vector
2.13 +begin
2.14 +
2.15 +declare fstcart_pastecart[simp] sndcart_pastecart[simp]
2.16 +
2.17 +subsection{* General notion of a topology *}
2.18 +
2.19 +definition "istopology L \<longleftrightarrow> {} \<in> L \<and> (\<forall>S \<in>L. \<forall>T \<in>L. S \<inter> T \<in> L) \<and> (\<forall>K. K \<subseteq>L \<longrightarrow> \<Union> K \<in> L)"
2.20 +typedef (open) 'a topology = "{L::('a set) set. istopology L}"
2.21 + morphisms "openin" "topology"
2.22 + unfolding istopology_def by blast
2.23 +
2.24 +lemma istopology_open_in[intro]: "istopology(openin U)"
2.25 + using openin[of U] by blast
2.26 +
2.27 +lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
2.28 + using topology_inverse[unfolded mem_def Collect_def] .
2.29 +
2.30 +lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
2.31 + using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
2.32 +
2.33 +lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
2.34 +proof-
2.35 + {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
2.36 + moreover
2.37 + {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
2.38 + hence "openin T1 = openin T2" by (metis mem_def set_ext)
2.39 + hence "topology (openin T1) = topology (openin T2)" by simp
2.40 + hence "T1 = T2" unfolding openin_inverse .}
2.41 + ultimately show ?thesis by blast
2.42 +qed
2.43 +
2.44 +text{* Infer the "universe" from union of all sets in the topology. *}
2.45 +
2.46 +definition "topspace T = \<Union>{S. openin T S}"
2.47 +
2.48 +subsection{* Main properties of open sets *}
2.49 +
2.50 +lemma openin_clauses:
2.51 + fixes U :: "'a topology"
2.52 + shows "openin U {}"
2.53 + "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
2.54 + "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
2.55 + using openin[of U] unfolding istopology_def Collect_def mem_def
2.56 + by (metis mem_def subset_eq)+
2.57 +
2.58 +lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
2.59 + unfolding topspace_def by blast
2.60 +lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
2.61 +
2.62 +lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
2.63 + by (simp add: openin_clauses)
2.64 +
2.65 +lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
2.66 +
2.67 +lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
2.68 + using openin_Union[of "{S,T}" U] by auto
2.69 +
2.70 +lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
2.71 +
2.72 +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")
2.73 +proof-
2.74 + {assume ?lhs then have ?rhs by auto }
2.75 + moreover
2.76 + {assume H: ?rhs
2.77 + then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
2.78 + unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
2.79 + from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
2.80 + have "\<Union> t`S = S" using t by auto
2.81 + with openin_Union[OF th0] have "openin U S" by simp }
2.82 + ultimately show ?thesis by blast
2.83 +qed
2.84 +
2.85 +subsection{* Closed sets *}
2.86 +
2.87 +definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
2.88 +
2.89 +lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
2.90 +lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
2.91 +lemma closedin_topspace[intro,simp]:
2.92 + "closedin U (topspace U)" by (simp add: closedin_def)
2.93 +lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
2.94 + by (auto simp add: Diff_Un closedin_def)
2.95 +
2.96 +lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
2.97 +lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
2.98 + shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
2.99 +
2.100 +lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
2.101 + using closedin_Inter[of "{S,T}" U] by auto
2.102 +
2.103 +lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
2.104 +lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
2.105 + apply (auto simp add: closedin_def)
2.106 + apply (metis openin_subset subset_eq)
2.107 + apply (auto simp add: Diff_Diff_Int)
2.108 + apply (subgoal_tac "topspace U \<inter> S = S")
2.109 + by auto
2.110 +
2.111 +lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
2.112 + by (simp add: openin_closedin_eq)
2.113 +
2.114 +lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
2.115 +proof-
2.116 + have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
2.117 + by (auto simp add: topspace_def openin_subset)
2.118 + then show ?thesis using oS cT by (auto simp add: closedin_def)
2.119 +qed
2.120 +
2.121 +lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
2.122 +proof-
2.123 + have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
2.124 + by (auto simp add: topspace_def )
2.125 + then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
2.126 +qed
2.127 +
2.128 +subsection{* Subspace topology. *}
2.129 +
2.130 +definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
2.131 +
2.132 +lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
2.133 +proof-
2.134 + have "{} \<in> ?L" by blast
2.135 + {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
2.136 + 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
2.137 + have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
2.138 + then have "A \<inter> B \<in> ?L" by blast}
2.139 + moreover
2.140 + {fix K assume K: "K \<subseteq> ?L"
2.141 + have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
2.142 + apply (rule set_ext)
2.143 + apply (simp add: Ball_def image_iff)
2.144 + by (metis mem_def)
2.145 + from K[unfolded th0 subset_image_iff]
2.146 + obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
2.147 + have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
2.148 + moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
2.149 + ultimately have "\<Union>K \<in> ?L" by blast}
2.150 + ultimately show ?thesis unfolding istopology_def by blast
2.151 +qed
2.152 +
2.153 +lemma openin_subtopology:
2.154 + "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
2.155 + unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
2.156 + by (auto simp add: Collect_def)
2.157 +
2.158 +lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
2.159 + by (auto simp add: topspace_def openin_subtopology)
2.160 +
2.161 +lemma closedin_subtopology:
2.162 + "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
2.163 + unfolding closedin_def topspace_subtopology
2.164 + apply (simp add: openin_subtopology)
2.165 + apply (rule iffI)
2.166 + apply clarify
2.167 + apply (rule_tac x="topspace U - T" in exI)
2.168 + by auto
2.169 +
2.170 +lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
2.171 + unfolding openin_subtopology
2.172 + apply (rule iffI, clarify)
2.173 + apply (frule openin_subset[of U]) apply blast
2.174 + apply (rule exI[where x="topspace U"])
2.175 + by auto
2.176 +
2.177 +lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
2.178 + shows "subtopology U V = U"
2.179 +proof-
2.180 + {fix S
2.181 + {fix T assume T: "openin U T" "S = T \<inter> V"
2.182 + from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
2.183 + have "openin U S" unfolding eq using T by blast}
2.184 + moreover
2.185 + {assume S: "openin U S"
2.186 + hence "\<exists>T. openin U T \<and> S = T \<inter> V"
2.187 + using openin_subset[OF S] UV by auto}
2.188 + ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
2.189 + then show ?thesis unfolding topology_eq openin_subtopology by blast
2.190 +qed
2.191 +
2.192 +
2.193 +lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
2.194 + by (simp add: subtopology_superset)
2.195 +
2.196 +lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
2.197 + by (simp add: subtopology_superset)
2.198 +
2.199 +subsection{* The universal Euclidean versions are what we use most of the time *}
2.200 +
2.201 +definition
2.202 + euclidean :: "'a::topological_space topology" where
2.203 + "euclidean = topology open"
2.204 +
2.205 +lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
2.206 + unfolding euclidean_def
2.207 + apply (rule cong[where x=S and y=S])
2.208 + apply (rule topology_inverse[symmetric])
2.209 + apply (auto simp add: istopology_def)
2.210 + by (auto simp add: mem_def subset_eq)
2.211 +
2.212 +lemma topspace_euclidean: "topspace euclidean = UNIV"
2.213 + apply (simp add: topspace_def)
2.214 + apply (rule set_ext)
2.215 + by (auto simp add: open_openin[symmetric])
2.216 +
2.217 +lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
2.218 + by (simp add: topspace_euclidean topspace_subtopology)
2.219 +
2.220 +lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
2.221 + by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
2.222 +
2.223 +lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
2.224 + by (simp add: open_openin openin_subopen[symmetric])
2.225 +
2.226 +subsection{* Open and closed balls. *}
2.227 +
2.228 +definition
2.229 + ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
2.230 + "ball x e = {y. dist x y < e}"
2.231 +
2.232 +definition
2.233 + cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
2.234 + "cball x e = {y. dist x y \<le> e}"
2.235 +
2.236 +lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
2.237 +lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
2.238 +
2.239 +lemma mem_ball_0 [simp]:
2.240 + fixes x :: "'a::real_normed_vecto"
2.241 + shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
2.242 + by (simp add: dist_norm)
2.243 +
2.244 +lemma mem_cball_0 [simp]:
2.245 + fixes x :: "'a::real_normed_vector"
2.246 + shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
2.247 + by (simp add: dist_norm)
2.248 +
2.249 +lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
2.250 +lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
2.251 +lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
2.252 +lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
2.253 +lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
2.254 + by (simp add: expand_set_eq) arith
2.255 +
2.256 +lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
2.257 + by (simp add: expand_set_eq)
2.258 +
2.259 +subsection{* Topological properties of open balls *}
2.260 +
2.261 +lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
2.262 + "(a::real) - b < 0 \<longleftrightarrow> a < b"
2.263 + "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
2.264 +lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
2.265 + "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
2.266 +
2.267 +lemma open_ball[intro, simp]: "open (ball x e)"
2.268 + unfolding open_dist ball_def Collect_def Ball_def mem_def
2.269 + unfolding dist_commute
2.270 + apply clarify
2.271 + apply (rule_tac x="e - dist xa x" in exI)
2.272 + using dist_triangle_alt[where z=x]
2.273 + apply (clarsimp simp add: diff_less_iff)
2.274 + apply atomize
2.275 + apply (erule_tac x="y" in allE)
2.276 + apply (erule_tac x="xa" in allE)
2.277 + by arith
2.278 +
2.279 +lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
2.280 +lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
2.281 + unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
2.282 +
2.283 +lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
2.284 + by (metis open_contains_ball subset_eq centre_in_ball)
2.285 +
2.286 +lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
2.287 + unfolding mem_ball expand_set_eq
2.288 + apply (simp add: not_less)
2.289 + by (metis zero_le_dist order_trans dist_self)
2.290 +
2.291 +lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
2.292 +
2.293 +subsection{* Basic "localization" results are handy for connectedness. *}
2.294 +
2.295 +lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
2.296 + by (auto simp add: openin_subtopology open_openin[symmetric])
2.297 +
2.298 +lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
2.299 + by (auto simp add: openin_open)
2.300 +
2.301 +lemma open_openin_trans[trans]:
2.302 + "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
2.303 + by (metis Int_absorb1 openin_open_Int)
2.304 +
2.305 +lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
2.306 + by (auto simp add: openin_open)
2.307 +
2.308 +lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
2.309 + by (simp add: closedin_subtopology closed_closedin Int_ac)
2.310 +
2.311 +lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
2.312 + by (metis closedin_closed)
2.313 +
2.314 +lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
2.315 + apply (subgoal_tac "S \<inter> T = T" )
2.316 + apply auto
2.317 + apply (frule closedin_closed_Int[of T S])
2.318 + by simp
2.319 +
2.320 +lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
2.321 + by (auto simp add: closedin_closed)
2.322 +
2.323 +lemma openin_euclidean_subtopology_iff:
2.324 + fixes S U :: "'a::metric_space set"
2.325 + shows "openin (subtopology euclidean U) S
2.326 + \<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")
2.327 +proof-
2.328 + {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
2.329 + by (simp add: open_dist) blast}
2.330 + moreover
2.331 + {assume SU: "S \<subseteq> U" and H: "\<And>x. x \<in> S \<Longrightarrow> \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x' \<in> S"
2.332 + from H obtain d where d: "\<And>x . x\<in> S \<Longrightarrow> d x > 0 \<and> (\<forall>x' \<in> U. dist x' x < d x \<longrightarrow> x' \<in> S)"
2.333 + by metis
2.334 + let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
2.335 + have oT: "open ?T" by auto
2.336 + { fix x assume "x\<in>S"
2.337 + hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
2.338 + apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
2.339 + by (rule d [THEN conjunct1])
2.340 + hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
2.341 + moreover
2.342 + { fix y assume "y\<in>?T"
2.343 + then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
2.344 + then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
2.345 + assume "y\<in>U"
2.346 + hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
2.347 + ultimately have "S = ?T \<inter> U" by blast
2.348 + with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
2.349 + ultimately show ?thesis by blast
2.350 +qed
2.351 +
2.352 +text{* These "transitivity" results are handy too. *}
2.353 +
2.354 +lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
2.355 + \<Longrightarrow> openin (subtopology euclidean U) S"
2.356 + unfolding open_openin openin_open by blast
2.357 +
2.358 +lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
2.359 + by (auto simp add: openin_open intro: openin_trans)
2.360 +
2.361 +lemma closedin_trans[trans]:
2.362 + "closedin (subtopology euclidean T) S \<Longrightarrow>
2.363 + closedin (subtopology euclidean U) T
2.364 + ==> closedin (subtopology euclidean U) S"
2.365 + by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
2.366 +
2.367 +lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
2.368 + by (auto simp add: closedin_closed intro: closedin_trans)
2.369 +
2.370 +subsection{* Connectedness *}
2.371 +
2.372 +definition "connected S \<longleftrightarrow>
2.373 + ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
2.374 + \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
2.375 +
2.376 +lemma connected_local:
2.377 + "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
2.378 + openin (subtopology euclidean S) e1 \<and>
2.379 + openin (subtopology euclidean S) e2 \<and>
2.380 + S \<subseteq> e1 \<union> e2 \<and>
2.381 + e1 \<inter> e2 = {} \<and>
2.382 + ~(e1 = {}) \<and>
2.383 + ~(e2 = {}))"
2.384 +unfolding connected_def openin_open by (safe, blast+)
2.385 +
2.386 +lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
2.387 +proof-
2.388 +
2.389 + {assume "?lhs" hence ?rhs by blast }
2.390 + moreover
2.391 + {fix S assume H: "P S"
2.392 + have "S = UNIV - (UNIV - S)" by auto
2.393 + with H have "P (UNIV - (UNIV - S))" by metis }
2.394 + ultimately show ?thesis by metis
2.395 +qed
2.396 +
2.397 +lemma connected_clopen: "connected S \<longleftrightarrow>
2.398 + (\<forall>T. openin (subtopology euclidean S) T \<and>
2.399 + closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
2.400 +proof-
2.401 + have " \<not> connected S \<longleftrightarrow> (\<exists>e1 e2. open e1 \<and> open (UNIV - e2) \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
2.402 + unfolding connected_def openin_open closedin_closed
2.403 + apply (subst exists_diff) by blast
2.404 + hence th0: "connected S \<longleftrightarrow> \<not> (\<exists>e2 e1. closed e2 \<and> open e1 \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
2.405 + (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
2.406 +
2.407 + 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'))"
2.408 + (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
2.409 + unfolding connected_def openin_open closedin_closed by auto
2.410 + {fix e2
2.411 + {fix e1 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)"
2.412 + by auto}
2.413 + then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
2.414 + then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
2.415 + then show ?thesis unfolding th0 th1 by simp
2.416 +qed
2.417 +
2.418 +lemma connected_empty[simp, intro]: "connected {}"
2.419 + by (simp add: connected_def)
2.420 +
2.421 +subsection{* Hausdorff and other separation properties *}
2.422 +
2.423 +class t0_space =
2.424 + assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
2.425 +
2.426 +class t1_space =
2.427 + assumes t1_space: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<notin> U \<and> x \<notin> V \<and> y \<in> V"
2.428 +begin
2.429 +
2.430 +subclass t0_space
2.431 +proof
2.432 +qed (fast dest: t1_space)
2.433 +
2.434 +end
2.435 +
2.436 +text {* T2 spaces are also known as Hausdorff spaces. *}
2.437 +
2.438 +class t2_space =
2.439 + assumes hausdorff: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
2.440 +begin
2.441 +
2.442 +subclass t1_space
2.443 +proof
2.444 +qed (fast dest: hausdorff)
2.445 +
2.446 +end
2.447 +
2.448 +instance metric_space \<subseteq> t2_space
2.449 +proof
2.450 + fix x y :: "'a::metric_space"
2.451 + assume xy: "x \<noteq> y"
2.452 + let ?U = "ball x (dist x y / 2)"
2.453 + let ?V = "ball y (dist x y / 2)"
2.454 + have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
2.455 + ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
2.456 + have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
2.457 + using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
2.458 + by (auto simp add: expand_set_eq)
2.459 + then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
2.460 + by blast
2.461 +qed
2.462 +
2.463 +lemma separation_t2:
2.464 + fixes x y :: "'a::t2_space"
2.465 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
2.466 + using hausdorff[of x y] by blast
2.467 +
2.468 +lemma separation_t1:
2.469 + fixes x y :: "'a::t1_space"
2.470 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in>U \<and> y\<notin> U \<and> x\<notin>V \<and> y\<in>V)"
2.471 + using t1_space[of x y] by blast
2.472 +
2.473 +lemma separation_t0:
2.474 + fixes x y :: "'a::t0_space"
2.475 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
2.476 + using t0_space[of x y] by blast
2.477 +
2.478 +subsection{* Limit points *}
2.479 +
2.480 +definition
2.481 + islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
2.482 + (infixr "islimpt" 60) where
2.483 + "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
2.484 +
2.485 +lemma islimptI:
2.486 + assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
2.487 + shows "x islimpt S"
2.488 + using assms unfolding islimpt_def by auto
2.489 +
2.490 +lemma islimptE:
2.491 + assumes "x islimpt S" and "x \<in> T" and "open T"
2.492 + obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
2.493 + using assms unfolding islimpt_def by auto
2.494 +
2.495 +lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
2.496 +
2.497 +lemma islimpt_approachable:
2.498 + fixes x :: "'a::metric_space"
2.499 + shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
2.500 + unfolding islimpt_def
2.501 + apply auto
2.502 + apply(erule_tac x="ball x e" in allE)
2.503 + apply auto
2.504 + apply(rule_tac x=y in bexI)
2.505 + apply (auto simp add: dist_commute)
2.506 + apply (simp add: open_dist, drule (1) bspec)
2.507 + apply (clarify, drule spec, drule (1) mp, auto)
2.508 + done
2.509 +
2.510 +lemma islimpt_approachable_le:
2.511 + fixes x :: "'a::metric_space"
2.512 + shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
2.513 + unfolding islimpt_approachable
2.514 + using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
2.515 + by metis (* FIXME: VERY slow! *)
2.516 +
2.517 +class perfect_space =
2.518 + (* FIXME: perfect_space should inherit from topological_space *)
2.519 + assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
2.520 +
2.521 +lemma perfect_choose_dist:
2.522 + fixes x :: "'a::perfect_space"
2.523 + shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
2.524 +using islimpt_UNIV [of x]
2.525 +by (simp add: islimpt_approachable)
2.526 +
2.527 +instance real :: perfect_space
2.528 +apply default
2.529 +apply (rule islimpt_approachable [THEN iffD2])
2.530 +apply (clarify, rule_tac x="x + e/2" in bexI)
2.531 +apply (auto simp add: dist_norm)
2.532 +done
2.533 +
2.534 +instance "^" :: (perfect_space, finite) perfect_space
2.535 +proof
2.536 + fix x :: "'a ^ 'b"
2.537 + {
2.538 + fix e :: real assume "0 < e"
2.539 + def a \<equiv> "x $ arbitrary"
2.540 + have "a islimpt UNIV" by (rule islimpt_UNIV)
2.541 + with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
2.542 + unfolding islimpt_approachable by auto
2.543 + def y \<equiv> "Cart_lambda ((Cart_nth x)(arbitrary := b))"
2.544 + from `b \<noteq> a` have "y \<noteq> x"
2.545 + unfolding a_def y_def by (simp add: Cart_eq)
2.546 + from `dist b a < e` have "dist y x < e"
2.547 + unfolding dist_vector_def a_def y_def
2.548 + apply simp
2.549 + apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
2.550 + apply (subst setsum_diff1' [where a=arbitrary], simp, simp, simp)
2.551 + done
2.552 + from `y \<noteq> x` and `dist y x < e`
2.553 + have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
2.554 + }
2.555 + then show "x islimpt UNIV" unfolding islimpt_approachable by blast
2.556 +qed
2.557 +
2.558 +lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
2.559 + unfolding closed_def
2.560 + apply (subst open_subopen)
2.561 + apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
2.562 + by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
2.563 +
2.564 +lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
2.565 + unfolding islimpt_def by auto
2.566 +
2.567 +lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
2.568 +proof-
2.569 + let ?U = "UNIV :: 'n set"
2.570 + let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
2.571 + {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
2.572 + and xi: "x$i < 0"
2.573 + from xi have th0: "-x$i > 0" by arith
2.574 + from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
2.575 + have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
2.576 + have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
2.577 + have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
2.578 + apply (simp only: vector_component)
2.579 + by (rule th') auto
2.580 + have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
2.581 + apply (simp add: dist_norm) by norm
2.582 + from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
2.583 + then show ?thesis unfolding closed_limpt islimpt_approachable
2.584 + unfolding not_le[symmetric] by blast
2.585 +qed
2.586 +
2.587 +lemma finite_set_avoid:
2.588 + fixes a :: "'a::metric_space"
2.589 + assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
2.590 +proof(induct rule: finite_induct[OF fS])
2.591 + case 1 thus ?case apply auto by ferrack
2.592 +next
2.593 + case (2 x F)
2.594 + from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
2.595 + {assume "x = a" hence ?case using d by auto }
2.596 + moreover
2.597 + {assume xa: "x\<noteq>a"
2.598 + let ?d = "min d (dist a x)"
2.599 + have dp: "?d > 0" using xa d(1) using dist_nz by auto
2.600 + from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
2.601 + with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
2.602 + ultimately show ?case by blast
2.603 +qed
2.604 +
2.605 +lemma islimpt_finite:
2.606 + fixes S :: "'a::metric_space set"
2.607 + assumes fS: "finite S" shows "\<not> a islimpt S"
2.608 + unfolding islimpt_approachable
2.609 + using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
2.610 +
2.611 +lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
2.612 + apply (rule iffI)
2.613 + defer
2.614 + apply (metis Un_upper1 Un_upper2 islimpt_subset)
2.615 + unfolding islimpt_def
2.616 + apply (rule ccontr, clarsimp, rename_tac A B)
2.617 + apply (drule_tac x="A \<inter> B" in spec)
2.618 + apply (auto simp add: open_Int)
2.619 + done
2.620 +
2.621 +lemma discrete_imp_closed:
2.622 + fixes S :: "'a::metric_space set"
2.623 + assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
2.624 + shows "closed S"
2.625 +proof-
2.626 + {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
2.627 + from e have e2: "e/2 > 0" by arith
2.628 + from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
2.629 + let ?m = "min (e/2) (dist x y) "
2.630 + from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
2.631 + from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
2.632 + have th: "dist z y < e" using z y
2.633 + by (intro dist_triangle_lt [where z=x], simp)
2.634 + from d[rule_format, OF y(1) z(1) th] y z
2.635 + have False by (auto simp add: dist_commute)}
2.636 + then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
2.637 +qed
2.638 +
2.639 +subsection{* Interior of a Set *}
2.640 +definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
2.641 +
2.642 +lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
2.643 + apply (simp add: expand_set_eq interior_def)
2.644 + apply (subst (2) open_subopen) by (safe, blast+)
2.645 +
2.646 +lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
2.647 +
2.648 +lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
2.649 +
2.650 +lemma open_interior[simp, intro]: "open(interior S)"
2.651 + apply (simp add: interior_def)
2.652 + apply (subst open_subopen) by blast
2.653 +
2.654 +lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
2.655 +lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
2.656 +lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
2.657 +lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
2.658 +lemma interior_unique: "T \<subseteq> S \<Longrightarrow> open T \<Longrightarrow> (\<forall>T'. T' \<subseteq> S \<and> open T' \<longrightarrow> T' \<subseteq> T) \<Longrightarrow> interior S = T"
2.659 + by (metis equalityI interior_maximal interior_subset open_interior)
2.660 +lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
2.661 + apply (simp add: interior_def)
2.662 + by (metis open_contains_ball centre_in_ball open_ball subset_trans)
2.663 +
2.664 +lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
2.665 + by (metis interior_maximal interior_subset subset_trans)
2.666 +
2.667 +lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
2.668 + apply (rule equalityI, simp)
2.669 + apply (metis Int_lower1 Int_lower2 subset_interior)
2.670 + by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
2.671 +
2.672 +lemma interior_limit_point [intro]:
2.673 + fixes x :: "'a::perfect_space"
2.674 + assumes x: "x \<in> interior S" shows "x islimpt S"
2.675 +proof-
2.676 + from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
2.677 + unfolding mem_interior subset_eq Ball_def mem_ball by blast
2.678 + {
2.679 + fix d::real assume d: "d>0"
2.680 + let ?m = "min d e"
2.681 + have mde2: "0 < ?m" using e(1) d(1) by simp
2.682 + from perfect_choose_dist [OF mde2, of x]
2.683 + obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
2.684 + then have "dist y x < e" "dist y x < d" by simp_all
2.685 + from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
2.686 + have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
2.687 + using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
2.688 + }
2.689 + then show ?thesis unfolding islimpt_approachable by blast
2.690 +qed
2.691 +
2.692 +lemma interior_closed_Un_empty_interior:
2.693 + assumes cS: "closed S" and iT: "interior T = {}"
2.694 + shows "interior(S \<union> T) = interior S"
2.695 +proof
2.696 + show "interior S \<subseteq> interior (S\<union>T)"
2.697 + by (rule subset_interior, blast)
2.698 +next
2.699 + show "interior (S \<union> T) \<subseteq> interior S"
2.700 + proof
2.701 + fix x assume "x \<in> interior (S \<union> T)"
2.702 + then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
2.703 + unfolding interior_def by fast
2.704 + show "x \<in> interior S"
2.705 + proof (rule ccontr)
2.706 + assume "x \<notin> interior S"
2.707 + with `x \<in> R` `open R` obtain y where "y \<in> R - S"
2.708 + unfolding interior_def expand_set_eq by fast
2.709 + from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
2.710 + from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
2.711 + from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
2.712 + show "False" unfolding interior_def by fast
2.713 + qed
2.714 + qed
2.715 +qed
2.716 +
2.717 +
2.718 +subsection{* Closure of a Set *}
2.719 +
2.720 +definition "closure S = S \<union> {x | x. x islimpt S}"
2.721 +
2.722 +lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
2.723 +proof-
2.724 + { fix x
2.725 + have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
2.726 + proof
2.727 + let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
2.728 + assume "?lhs"
2.729 + hence *:"\<not> ?exT x"
2.730 + unfolding interior_def
2.731 + by simp
2.732 + { assume "\<not> ?rhs"
2.733 + hence False using *
2.734 + unfolding closure_def islimpt_def
2.735 + by blast
2.736 + }
2.737 + thus "?rhs"
2.738 + by blast
2.739 + next
2.740 + assume "?rhs" thus "?lhs"
2.741 + unfolding closure_def interior_def islimpt_def
2.742 + by blast
2.743 + qed
2.744 + }
2.745 + thus ?thesis
2.746 + by blast
2.747 +qed
2.748 +
2.749 +lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
2.750 +proof-
2.751 + { fix x
2.752 + have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
2.753 + unfolding interior_def closure_def islimpt_def
2.754 + by blast (* FIXME: VERY slow! *)
2.755 + }
2.756 + thus ?thesis
2.757 + by blast
2.758 +qed
2.759 +
2.760 +lemma closed_closure[simp, intro]: "closed (closure S)"
2.761 +proof-
2.762 + have "closed (UNIV - interior (UNIV -S))" by blast
2.763 + thus ?thesis using closure_interior[of S] by simp
2.764 +qed
2.765 +
2.766 +lemma closure_hull: "closure S = closed hull S"
2.767 +proof-
2.768 + have "S \<subseteq> closure S"
2.769 + unfolding closure_def
2.770 + by blast
2.771 + moreover
2.772 + have "closed (closure S)"
2.773 + using closed_closure[of S]
2.774 + by assumption
2.775 + moreover
2.776 + { fix t
2.777 + assume *:"S \<subseteq> t" "closed t"
2.778 + { fix x
2.779 + assume "x islimpt S"
2.780 + hence "x islimpt t" using *(1)
2.781 + using islimpt_subset[of x, of S, of t]
2.782 + by blast
2.783 + }
2.784 + with * have "closure S \<subseteq> t"
2.785 + unfolding closure_def
2.786 + using closed_limpt[of t]
2.787 + by auto
2.788 + }
2.789 + ultimately show ?thesis
2.790 + using hull_unique[of S, of "closure S", of closed]
2.791 + unfolding mem_def
2.792 + by simp
2.793 +qed
2.794 +
2.795 +lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
2.796 + unfolding closure_hull
2.797 + using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
2.798 + by (metis mem_def subset_eq)
2.799 +
2.800 +lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
2.801 + using closure_eq[of S]
2.802 + by simp
2.803 +
2.804 +lemma closure_closure[simp]: "closure (closure S) = closure S"
2.805 + unfolding closure_hull
2.806 + using hull_hull[of closed S]
2.807 + by assumption
2.808 +
2.809 +lemma closure_subset: "S \<subseteq> closure S"
2.810 + unfolding closure_hull
2.811 + using hull_subset[of S closed]
2.812 + by assumption
2.813 +
2.814 +lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
2.815 + unfolding closure_hull
2.816 + using hull_mono[of S T closed]
2.817 + by assumption
2.818 +
2.819 +lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
2.820 + using hull_minimal[of S T closed]
2.821 + unfolding closure_hull mem_def
2.822 + by simp
2.823 +
2.824 +lemma closure_unique: "S \<subseteq> T \<and> closed T \<and> (\<forall> T'. S \<subseteq> T' \<and> closed T' \<longrightarrow> T \<subseteq> T') \<Longrightarrow> closure S = T"
2.825 + using hull_unique[of S T closed]
2.826 + unfolding closure_hull mem_def
2.827 + by simp
2.828 +
2.829 +lemma closure_empty[simp]: "closure {} = {}"
2.830 + using closed_empty closure_closed[of "{}"]
2.831 + by simp
2.832 +
2.833 +lemma closure_univ[simp]: "closure UNIV = UNIV"
2.834 + using closure_closed[of UNIV]
2.835 + by simp
2.836 +
2.837 +lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
2.838 + using closure_empty closure_subset[of S]
2.839 + by blast
2.840 +
2.841 +lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
2.842 + using closure_eq[of S] closure_subset[of S]
2.843 + by simp
2.844 +
2.845 +lemma open_inter_closure_eq_empty:
2.846 + "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
2.847 + using open_subset_interior[of S "UNIV - T"]
2.848 + using interior_subset[of "UNIV - T"]
2.849 + unfolding closure_interior
2.850 + by auto
2.851 +
2.852 +lemma open_inter_closure_subset:
2.853 + "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
2.854 +proof
2.855 + fix x
2.856 + assume as: "open S" "x \<in> S \<inter> closure T"
2.857 + { assume *:"x islimpt T"
2.858 + have "x islimpt (S \<inter> T)"
2.859 + proof (rule islimptI)
2.860 + fix A
2.861 + assume "x \<in> A" "open A"
2.862 + with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
2.863 + by (simp_all add: open_Int)
2.864 + with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
2.865 + by (rule islimptE)
2.866 + hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
2.867 + by simp_all
2.868 + thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
2.869 + qed
2.870 + }
2.871 + then show "x \<in> closure (S \<inter> T)" using as
2.872 + unfolding closure_def
2.873 + by blast
2.874 +qed
2.875 +
2.876 +lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
2.877 +proof-
2.878 + have "S = UNIV - (UNIV - S)"
2.879 + by auto
2.880 + thus ?thesis
2.881 + unfolding closure_interior
2.882 + by auto
2.883 +qed
2.884 +
2.885 +lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
2.886 + unfolding closure_interior
2.887 + by blast
2.888 +
2.889 +subsection{* Frontier (aka boundary) *}
2.890 +
2.891 +definition "frontier S = closure S - interior S"
2.892 +
2.893 +lemma frontier_closed: "closed(frontier S)"
2.894 + by (simp add: frontier_def closed_Diff)
2.895 +
2.896 +lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
2.897 + by (auto simp add: frontier_def interior_closure)
2.898 +
2.899 +lemma frontier_straddle:
2.900 + fixes a :: "'a::metric_space"
2.901 + shows "a \<in> frontier S \<longleftrightarrow> (\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e))" (is "?lhs \<longleftrightarrow> ?rhs")
2.902 +proof
2.903 + assume "?lhs"
2.904 + { fix e::real
2.905 + assume "e > 0"
2.906 + let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
2.907 + { assume "a\<in>S"
2.908 + have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
2.909 + moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
2.910 + unfolding frontier_closures closure_def islimpt_def using `e>0`
2.911 + by (auto, erule_tac x="ball a e" in allE, auto)
2.912 + ultimately have ?rhse by auto
2.913 + }
2.914 + moreover
2.915 + { assume "a\<notin>S"
2.916 + hence ?rhse using `?lhs`
2.917 + unfolding frontier_closures closure_def islimpt_def
2.918 + using open_ball[of a e] `e > 0`
2.919 + by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
2.920 + }
2.921 + ultimately have ?rhse by auto
2.922 + }
2.923 + thus ?rhs by auto
2.924 +next
2.925 + assume ?rhs
2.926 + moreover
2.927 + { fix T assume "a\<notin>S" and
2.928 + as:"\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)" "a \<notin> S" "a \<in> T" "open T"
2.929 + from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
2.930 + then obtain e where "e>0" "ball a e \<subseteq> T" by auto
2.931 + then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
2.932 + have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
2.933 + using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
2.934 + }
2.935 + hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
2.936 + moreover
2.937 + { fix T assume "a \<in> T" "open T" "a\<in>S"
2.938 + then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
2.939 + obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
2.940 + hence "\<exists>y\<in>UNIV - S. y \<in> T \<and> y \<noteq> a" using balle `a\<in>S` unfolding ball_def by (rule_tac x=x in bexI)auto
2.941 + }
2.942 + hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
2.943 + ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
2.944 +qed
2.945 +
2.946 +lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
2.947 + by (metis frontier_def closure_closed Diff_subset)
2.948 +
2.949 +lemma frontier_empty: "frontier {} = {}"
2.950 + by (simp add: frontier_def closure_empty)
2.951 +
2.952 +lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
2.953 +proof-
2.954 + { assume "frontier S \<subseteq> S"
2.955 + hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
2.956 + hence "closed S" using closure_subset_eq by auto
2.957 + }
2.958 + thus ?thesis using frontier_subset_closed[of S] by auto
2.959 +qed
2.960 +
2.961 +lemma frontier_complement: "frontier(UNIV - S) = frontier S"
2.962 + by (auto simp add: frontier_def closure_complement interior_complement)
2.963 +
2.964 +lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
2.965 + using frontier_complement frontier_subset_eq[of "UNIV - S"]
2.966 + unfolding open_closed Compl_eq_Diff_UNIV by auto
2.967 +
2.968 +subsection{* Common nets and The "within" modifier for nets. *}
2.969 +
2.970 +definition
2.971 + at_infinity :: "'a::real_normed_vector net" where
2.972 + "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
2.973 +
2.974 +definition
2.975 + indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
2.976 + "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
2.977 +
2.978 +text{* Prove That They are all nets. *}
2.979 +
2.980 +lemma Rep_net_at_infinity:
2.981 + "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
2.982 +unfolding at_infinity_def
2.983 +apply (rule Abs_net_inverse')
2.984 +apply (rule image_nonempty, simp)
2.985 +apply (clarsimp, rename_tac r s)
2.986 +apply (rule_tac x="max r s" in exI, auto)
2.987 +done
2.988 +
2.989 +lemma within_UNIV: "net within UNIV = net"
2.990 + by (simp add: Rep_net_inject [symmetric] Rep_net_within)
2.991 +
2.992 +subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
2.993 +
2.994 +definition
2.995 + trivial_limit :: "'a net \<Rightarrow> bool" where
2.996 + "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
2.997 +
2.998 +lemma trivial_limit_within:
2.999 + shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
2.1000 +proof
2.1001 + assume "trivial_limit (at a within S)"
2.1002 + thus "\<not> a islimpt S"
2.1003 + unfolding trivial_limit_def
2.1004 + unfolding Rep_net_within Rep_net_at
2.1005 + unfolding islimpt_def
2.1006 + apply (clarsimp simp add: expand_set_eq)
2.1007 + apply (rename_tac T, rule_tac x=T in exI)
2.1008 + apply (clarsimp, drule_tac x=y in spec, simp)
2.1009 + done
2.1010 +next
2.1011 + assume "\<not> a islimpt S"
2.1012 + thus "trivial_limit (at a within S)"
2.1013 + unfolding trivial_limit_def
2.1014 + unfolding Rep_net_within Rep_net_at
2.1015 + unfolding islimpt_def
2.1016 + apply (clarsimp simp add: image_image)
2.1017 + apply (rule_tac x=T in image_eqI)
2.1018 + apply (auto simp add: expand_set_eq)
2.1019 + done
2.1020 +qed
2.1021 +
2.1022 +lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
2.1023 + using trivial_limit_within [of a UNIV]
2.1024 + by (simp add: within_UNIV)
2.1025 +
2.1026 +lemma trivial_limit_at:
2.1027 + fixes a :: "'a::perfect_space"
2.1028 + shows "\<not> trivial_limit (at a)"
2.1029 + by (simp add: trivial_limit_at_iff)
2.1030 +
2.1031 +lemma trivial_limit_at_infinity:
2.1032 + "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
2.1033 + (* FIXME: find a more appropriate type class *)
2.1034 + unfolding trivial_limit_def Rep_net_at_infinity
2.1035 + apply (clarsimp simp add: expand_set_eq)
2.1036 + apply (drule_tac x="scaleR r (sgn 1)" in spec)
2.1037 + apply (simp add: norm_sgn)
2.1038 + done
2.1039 +
2.1040 +lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
2.1041 + by (auto simp add: trivial_limit_def Rep_net_sequentially)
2.1042 +
2.1043 +subsection{* Some property holds "sufficiently close" to the limit point. *}
2.1044 +
2.1045 +lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
2.1046 + "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
2.1047 +unfolding eventually_at dist_nz by auto
2.1048 +
2.1049 +lemma eventually_at_infinity:
2.1050 + "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
2.1051 +unfolding eventually_def Rep_net_at_infinity by auto
2.1052 +
2.1053 +lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
2.1054 + (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
2.1055 +unfolding eventually_within eventually_at dist_nz by auto
2.1056 +
2.1057 +lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
2.1058 + (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
2.1059 +unfolding eventually_within
2.1060 +apply safe
2.1061 +apply (rule_tac x="d/2" in exI, simp)
2.1062 +apply (rule_tac x="d" in exI, simp)
2.1063 +done
2.1064 +
2.1065 +lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
2.1066 + unfolding eventually_def trivial_limit_def
2.1067 + using Rep_net_nonempty [of net] by auto
2.1068 +
2.1069 +lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
2.1070 + unfolding eventually_def trivial_limit_def
2.1071 + using Rep_net_nonempty [of net] by auto
2.1072 +
2.1073 +lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
2.1074 + unfolding trivial_limit_def eventually_def by auto
2.1075 +
2.1076 +lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
2.1077 + unfolding trivial_limit_def eventually_def by auto
2.1078 +
2.1079 +lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
2.1080 + apply (safe elim!: trivial_limit_eventually)
2.1081 + apply (simp add: eventually_False [symmetric])
2.1082 + done
2.1083 +
2.1084 +text{* Combining theorems for "eventually" *}
2.1085 +
2.1086 +lemma eventually_conjI:
2.1087 + "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
2.1088 + \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
2.1089 +by (rule eventually_conj)
2.1090 +
2.1091 +lemma eventually_rev_mono:
2.1092 + "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
2.1093 +using eventually_mono [of P Q] by fast
2.1094 +
2.1095 +lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
2.1096 + by (auto intro!: eventually_conjI elim: eventually_rev_mono)
2.1097 +
2.1098 +lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
2.1099 + by (auto simp add: eventually_False)
2.1100 +
2.1101 +lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
2.1102 + by (simp add: eventually_False)
2.1103 +
2.1104 +subsection{* Limits, defined as vacuously true when the limit is trivial. *}
2.1105 +
2.1106 + text{* Notation Lim to avoid collition with lim defined in analysis *}
2.1107 +definition
2.1108 + Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
2.1109 + "Lim net f = (THE l. (f ---> l) net)"
2.1110 +
2.1111 +lemma Lim:
2.1112 + "(f ---> l) net \<longleftrightarrow>
2.1113 + trivial_limit net \<or>
2.1114 + (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
2.1115 + unfolding tendsto_iff trivial_limit_eq by auto
2.1116 +
2.1117 +
2.1118 +text{* Show that they yield usual definitions in the various cases. *}
2.1119 +
2.1120 +lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
2.1121 + (\<forall>e>0. \<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> dist (f x) l < e)"
2.1122 + by (auto simp add: tendsto_iff eventually_within_le)
2.1123 +
2.1124 +lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
2.1125 + (\<forall>e >0. \<exists>d>0. \<forall>x \<in> S. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
2.1126 + by (auto simp add: tendsto_iff eventually_within)
2.1127 +
2.1128 +lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
2.1129 + (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
2.1130 + by (auto simp add: tendsto_iff eventually_at)
2.1131 +
2.1132 +lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
2.1133 + unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
2.1134 +
2.1135 +lemma Lim_at_infinity:
2.1136 + "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
2.1137 + by (auto simp add: tendsto_iff eventually_at_infinity)
2.1138 +
2.1139 +lemma Lim_sequentially:
2.1140 + "(S ---> l) sequentially \<longleftrightarrow>
2.1141 + (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
2.1142 + by (auto simp add: tendsto_iff eventually_sequentially)
2.1143 +
2.1144 +lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
2.1145 + unfolding Lim_sequentially LIMSEQ_def ..
2.1146 +
2.1147 +lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
2.1148 + by (rule topological_tendstoI, auto elim: eventually_rev_mono)
2.1149 +
2.1150 +text{* The expected monotonicity property. *}
2.1151 +
2.1152 +lemma Lim_within_empty: "(f ---> l) (net within {})"
2.1153 + unfolding tendsto_def Limits.eventually_within by simp
2.1154 +
2.1155 +lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
2.1156 + unfolding tendsto_def Limits.eventually_within
2.1157 + by (auto elim!: eventually_elim1)
2.1158 +
2.1159 +lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
2.1160 + shows "(f ---> l) (net within (S \<union> T))"
2.1161 + using assms unfolding tendsto_def Limits.eventually_within
2.1162 + apply clarify
2.1163 + apply (drule spec, drule (1) mp, drule (1) mp)
2.1164 + apply (drule spec, drule (1) mp, drule (1) mp)
2.1165 + apply (auto elim: eventually_elim2)
2.1166 + done
2.1167 +
2.1168 +lemma Lim_Un_univ:
2.1169 + "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
2.1170 + ==> (f ---> l) net"
2.1171 + by (metis Lim_Un within_UNIV)
2.1172 +
2.1173 +text{* Interrelations between restricted and unrestricted limits. *}
2.1174 +
2.1175 +lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
2.1176 + (* FIXME: rename *)
2.1177 + unfolding tendsto_def Limits.eventually_within
2.1178 + apply (clarify, drule spec, drule (1) mp, drule (1) mp)
2.1179 + by (auto elim!: eventually_elim1)
2.1180 +
2.1181 +lemma Lim_within_open:
2.1182 + fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
2.1183 + assumes"a \<in> S" "open S"
2.1184 + shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
2.1185 +proof
2.1186 + assume ?lhs
2.1187 + { fix A assume "open A" "l \<in> A"
2.1188 + with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
2.1189 + by (rule topological_tendstoD)
2.1190 + hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
2.1191 + unfolding Limits.eventually_within .
2.1192 + then obtain T where "open T" "a \<in> T" "\<forall>x\<in>T. x \<noteq> a \<longrightarrow> x \<in> S \<longrightarrow> f x \<in> A"
2.1193 + unfolding eventually_at_topological by fast
2.1194 + hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
2.1195 + using assms by auto
2.1196 + hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
2.1197 + by fast
2.1198 + hence "eventually (\<lambda>x. f x \<in> A) (at a)"
2.1199 + unfolding eventually_at_topological .
2.1200 + }
2.1201 + thus ?rhs by (rule topological_tendstoI)
2.1202 +next
2.1203 + assume ?rhs
2.1204 + thus ?lhs by (rule Lim_at_within)
2.1205 +qed
2.1206 +
2.1207 +text{* Another limit point characterization. *}
2.1208 +
2.1209 +lemma islimpt_sequential:
2.1210 + fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
2.1211 + shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
2.1212 + (is "?lhs = ?rhs")
2.1213 +proof
2.1214 + assume ?lhs
2.1215 + then obtain f where f:"\<forall>y. y>0 \<longrightarrow> f y \<in> S \<and> f y \<noteq> x \<and> dist (f y) x < y"
2.1216 + unfolding islimpt_approachable using choice[of "\<lambda>e y. e>0 \<longrightarrow> y\<in>S \<and> y\<noteq>x \<and> dist y x < e"] by auto
2.1217 + { fix n::nat
2.1218 + have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
2.1219 + }
2.1220 + moreover
2.1221 + { fix e::real assume "e>0"
2.1222 + hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
2.1223 + then obtain N::nat where "inverse (real (N + 1)) < e" by auto
2.1224 + hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
2.1225 + moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
2.1226 + ultimately have "\<exists>N::nat. \<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < e" apply(rule_tac x=N in exI) apply auto apply(erule_tac x=n in allE)+ by auto
2.1227 + }
2.1228 + hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
2.1229 + unfolding Lim_sequentially using f by auto
2.1230 + ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
2.1231 +next
2.1232 + assume ?rhs
2.1233 + then obtain f::"nat\<Rightarrow>'a" where f:"(\<forall>n. f n \<in> S - {x})" "(\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f n) x < e)" unfolding Lim_sequentially by auto
2.1234 + { fix e::real assume "e>0"
2.1235 + then obtain N where "dist (f N) x < e" using f(2) by auto
2.1236 + moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
2.1237 + ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
2.1238 + }
2.1239 + thus ?lhs unfolding islimpt_approachable by auto
2.1240 +qed
2.1241 +
2.1242 +text{* Basic arithmetical combining theorems for limits. *}
2.1243 +
2.1244 +lemma Lim_linear:
2.1245 + assumes "(f ---> l) net" "bounded_linear h"
2.1246 + shows "((\<lambda>x. h (f x)) ---> h l) net"
2.1247 +using `bounded_linear h` `(f ---> l) net`
2.1248 +by (rule bounded_linear.tendsto)
2.1249 +
2.1250 +lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
2.1251 + unfolding tendsto_def Limits.eventually_at_topological by fast
2.1252 +
2.1253 +lemma Lim_const: "((\<lambda>x. a) ---> a) net"
2.1254 + by (rule tendsto_const)
2.1255 +
2.1256 +lemma Lim_cmul:
2.1257 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1258 + shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
2.1259 + by (intro tendsto_intros)
2.1260 +
2.1261 +lemma Lim_neg:
2.1262 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1263 + shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
2.1264 + by (rule tendsto_minus)
2.1265 +
2.1266 +lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
2.1267 + "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
2.1268 + by (rule tendsto_add)
2.1269 +
2.1270 +lemma Lim_sub:
2.1271 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1272 + shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
2.1273 + by (rule tendsto_diff)
2.1274 +
2.1275 +lemma Lim_null:
2.1276 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1277 + shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
2.1278 +
2.1279 +lemma Lim_null_norm:
2.1280 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1281 + shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
2.1282 + by (simp add: Lim dist_norm)
2.1283 +
2.1284 +lemma Lim_null_comparison:
2.1285 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1286 + assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
2.1287 + shows "(f ---> 0) net"
2.1288 +proof(simp add: tendsto_iff, rule+)
2.1289 + fix e::real assume "0<e"
2.1290 + { fix x
2.1291 + assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
2.1292 + hence "dist (f x) 0 < e" by (simp add: dist_norm)
2.1293 + }
2.1294 + thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
2.1295 + using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
2.1296 + using eventually_mono[of "(\<lambda>x. norm (f x) \<le> g x \<and> dist (g x) 0 < e)" "(\<lambda>x. dist (f x) 0 < e)" net]
2.1297 + using assms `e>0` unfolding tendsto_iff by auto
2.1298 +qed
2.1299 +
2.1300 +lemma Lim_component:
2.1301 + fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
2.1302 + shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
2.1303 + unfolding tendsto_iff
2.1304 + apply (clarify)
2.1305 + apply (drule spec, drule (1) mp)
2.1306 + apply (erule eventually_elim1)
2.1307 + apply (erule le_less_trans [OF dist_nth_le])
2.1308 + done
2.1309 +
2.1310 +lemma Lim_transform_bound:
2.1311 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1312 + fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
2.1313 + assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
2.1314 + shows "(f ---> 0) net"
2.1315 +proof (rule tendstoI)
2.1316 + fix e::real assume "e>0"
2.1317 + { fix x
2.1318 + assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
2.1319 + hence "dist (f x) 0 < e" by (simp add: dist_norm)}
2.1320 + thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
2.1321 + using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
2.1322 + using eventually_mono[of "\<lambda>x. norm (f x) \<le> norm (g x) \<and> dist (g x) 0 < e" "\<lambda>x. dist (f x) 0 < e" net]
2.1323 + using assms `e>0` unfolding tendsto_iff by blast
2.1324 +qed
2.1325 +
2.1326 +text{* Deducing things about the limit from the elements. *}
2.1327 +
2.1328 +lemma Lim_in_closed_set:
2.1329 + assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
2.1330 + shows "l \<in> S"
2.1331 +proof (rule ccontr)
2.1332 + assume "l \<notin> S"
2.1333 + with `closed S` have "open (- S)" "l \<in> - S"
2.1334 + by (simp_all add: open_Compl)
2.1335 + with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
2.1336 + by (rule topological_tendstoD)
2.1337 + with assms(2) have "eventually (\<lambda>x. False) net"
2.1338 + by (rule eventually_elim2) simp
2.1339 + with assms(3) show "False"
2.1340 + by (simp add: eventually_False)
2.1341 +qed
2.1342 +
2.1343 +text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
2.1344 +
2.1345 +lemma Lim_dist_ubound:
2.1346 + assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
2.1347 + shows "dist a l <= e"
2.1348 +proof (rule ccontr)
2.1349 + assume "\<not> dist a l \<le> e"
2.1350 + then have "0 < dist a l - e" by simp
2.1351 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
2.1352 + by (rule tendstoD)
2.1353 + with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
2.1354 + by (rule eventually_conjI)
2.1355 + then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
2.1356 + using assms(1) eventually_happens by auto
2.1357 + hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
2.1358 + by (rule add_le_less_mono)
2.1359 + hence "dist a (f w) + dist (f w) l < dist a l"
2.1360 + by simp
2.1361 + also have "\<dots> \<le> dist a (f w) + dist (f w) l"
2.1362 + by (rule dist_triangle)
2.1363 + finally show False by simp
2.1364 +qed
2.1365 +
2.1366 +lemma Lim_norm_ubound:
2.1367 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1368 + assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
2.1369 + shows "norm(l) <= e"
2.1370 +proof (rule ccontr)
2.1371 + assume "\<not> norm l \<le> e"
2.1372 + then have "0 < norm l - e" by simp
2.1373 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
2.1374 + by (rule tendstoD)
2.1375 + with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
2.1376 + by (rule eventually_conjI)
2.1377 + then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
2.1378 + using assms(1) eventually_happens by auto
2.1379 + hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
2.1380 + hence "norm (f w - l) + norm (f w) < norm l" by simp
2.1381 + hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
2.1382 + thus False using `\<not> norm l \<le> e` by simp
2.1383 +qed
2.1384 +
2.1385 +lemma Lim_norm_lbound:
2.1386 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.1387 + assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
2.1388 + shows "e \<le> norm l"
2.1389 +proof (rule ccontr)
2.1390 + assume "\<not> e \<le> norm l"
2.1391 + then have "0 < e - norm l" by simp
2.1392 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
2.1393 + by (rule tendstoD)
2.1394 + with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
2.1395 + by (rule eventually_conjI)
2.1396 + then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
2.1397 + using assms(1) eventually_happens by auto
2.1398 + hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
2.1399 + hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
2.1400 + hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
2.1401 + thus False by simp
2.1402 +qed
2.1403 +
2.1404 +text{* Uniqueness of the limit, when nontrivial. *}
2.1405 +
2.1406 +lemma Lim_unique:
2.1407 + fixes f :: "'a \<Rightarrow> 'b::t2_space"
2.1408 + assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
2.1409 + shows "l = l'"
2.1410 +proof (rule ccontr)
2.1411 + assume "l \<noteq> l'"
2.1412 + obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
2.1413 + using hausdorff [OF `l \<noteq> l'`] by fast
2.1414 + have "eventually (\<lambda>x. f x \<in> U) net"
2.1415 + using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
2.1416 + moreover
2.1417 + have "eventually (\<lambda>x. f x \<in> V) net"
2.1418 + using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
2.1419 + ultimately
2.1420 + have "eventually (\<lambda>x. False) net"
2.1421 + proof (rule eventually_elim2)
2.1422 + fix x
2.1423 + assume "f x \<in> U" "f x \<in> V"
2.1424 + hence "f x \<in> U \<inter> V" by simp
2.1425 + with `U \<inter> V = {}` show "False" by simp
2.1426 + qed
2.1427 + with `\<not> trivial_limit net` show "False"
2.1428 + by (simp add: eventually_False)
2.1429 +qed
2.1430 +
2.1431 +lemma tendsto_Lim:
2.1432 + fixes f :: "'a \<Rightarrow> 'b::t2_space"
2.1433 + shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
2.1434 + unfolding Lim_def using Lim_unique[of net f] by auto
2.1435 +
2.1436 +text{* Limit under bilinear function *}
2.1437 +
2.1438 +lemma Lim_bilinear:
2.1439 + assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
2.1440 + shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
2.1441 +using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
2.1442 +by (rule bounded_bilinear.tendsto)
2.1443 +
2.1444 +text{* These are special for limits out of the same vector space. *}
2.1445 +
2.1446 +lemma Lim_within_id: "(id ---> a) (at a within s)"
2.1447 + unfolding tendsto_def Limits.eventually_within eventually_at_topological
2.1448 + by auto
2.1449 +
2.1450 +lemma Lim_at_id: "(id ---> a) (at a)"
2.1451 +apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
2.1452 +
2.1453 +lemma Lim_at_zero:
2.1454 + fixes a :: "'a::real_normed_vector"
2.1455 + fixes l :: "'b::topological_space"
2.1456 + shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
2.1457 +proof
2.1458 + assume "?lhs"
2.1459 + { fix S assume "open S" "l \<in> S"
2.1460 + with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
2.1461 + by (rule topological_tendstoD)
2.1462 + then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
2.1463 + unfolding Limits.eventually_at by fast
2.1464 + { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
2.1465 + hence "f (a + x) \<in> S" using d
2.1466 + apply(erule_tac x="x+a" in allE)
2.1467 + by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
2.1468 + }
2.1469 + hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
2.1470 + using d(1) by auto
2.1471 + hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
2.1472 + unfolding Limits.eventually_at .
2.1473 + }
2.1474 + thus "?rhs" by (rule topological_tendstoI)
2.1475 +next
2.1476 + assume "?rhs"
2.1477 + { fix S assume "open S" "l \<in> S"
2.1478 + with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
2.1479 + by (rule topological_tendstoD)
2.1480 + then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
2.1481 + unfolding Limits.eventually_at by fast
2.1482 + { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
2.1483 + hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
2.1484 + by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
2.1485 + }
2.1486 + hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
2.1487 + hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
2.1488 + }
2.1489 + thus "?lhs" by (rule topological_tendstoI)
2.1490 +qed
2.1491 +
2.1492 +text{* It's also sometimes useful to extract the limit point from the net. *}
2.1493 +
2.1494 +definition
2.1495 + netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
2.1496 + "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
2.1497 +
2.1498 +lemma netlimit_within:
2.1499 + assumes "\<not> trivial_limit (at a within S)"
2.1500 + shows "netlimit (at a within S) = a"
2.1501 +unfolding netlimit_def
2.1502 +apply (rule some_equality)
2.1503 +apply (rule Lim_at_within)
2.1504 +apply (rule Lim_ident_at)
2.1505 +apply (erule Lim_unique [OF assms])
2.1506 +apply (rule Lim_at_within)
2.1507 +apply (rule Lim_ident_at)
2.1508 +done
2.1509 +
2.1510 +lemma netlimit_at:
2.1511 + fixes a :: "'a::perfect_space"
2.1512 + shows "netlimit (at a) = a"
2.1513 + apply (subst within_UNIV[symmetric])
2.1514 + using netlimit_within[of a UNIV]
2.1515 + by (simp add: trivial_limit_at within_UNIV)
2.1516 +
2.1517 +text{* Transformation of limit. *}
2.1518 +
2.1519 +lemma Lim_transform:
2.1520 + fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
2.1521 + assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
2.1522 + shows "(g ---> l) net"
2.1523 +proof-
2.1524 + from assms have "((\<lambda>x. f x - g x - f x) ---> 0 - l) net" using Lim_sub[of "\<lambda>x. f x - g x" 0 net f l] by auto
2.1525 + thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
2.1526 +qed
2.1527 +
2.1528 +lemma Lim_transform_eventually:
2.1529 + "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
2.1530 + apply (rule topological_tendstoI)
2.1531 + apply (drule (2) topological_tendstoD)
2.1532 + apply (erule (1) eventually_elim2, simp)
2.1533 + done
2.1534 +
2.1535 +lemma Lim_transform_within:
2.1536 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1537 + assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
2.1538 + "(f ---> l) (at x within S)"
2.1539 + shows "(g ---> l) (at x within S)"
2.1540 + using assms(1,3) unfolding Lim_within
2.1541 + apply -
2.1542 + apply (clarify, rename_tac e)
2.1543 + apply (drule_tac x=e in spec, clarsimp, rename_tac r)
2.1544 + apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
2.1545 + apply (drule_tac x=y in bspec, assumption, clarsimp)
2.1546 + apply (simp add: assms(2))
2.1547 + done
2.1548 +
2.1549 +lemma Lim_transform_at:
2.1550 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1551 + shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
2.1552 + (f ---> l) (at x) ==> (g ---> l) (at x)"
2.1553 + apply (subst within_UNIV[symmetric])
2.1554 + using Lim_transform_within[of d UNIV x f g l]
2.1555 + by (auto simp add: within_UNIV)
2.1556 +
2.1557 +text{* Common case assuming being away from some crucial point like 0. *}
2.1558 +
2.1559 +lemma Lim_transform_away_within:
2.1560 + fixes a b :: "'a::metric_space"
2.1561 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1562 + assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
2.1563 + and "(f ---> l) (at a within S)"
2.1564 + shows "(g ---> l) (at a within S)"
2.1565 +proof-
2.1566 + have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
2.1567 + apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
2.1568 + thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
2.1569 +qed
2.1570 +
2.1571 +lemma Lim_transform_away_at:
2.1572 + fixes a b :: "'a::metric_space"
2.1573 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1574 + assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
2.1575 + and fl: "(f ---> l) (at a)"
2.1576 + shows "(g ---> l) (at a)"
2.1577 + using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
2.1578 + by (auto simp add: within_UNIV)
2.1579 +
2.1580 +text{* Alternatively, within an open set. *}
2.1581 +
2.1582 +lemma Lim_transform_within_open:
2.1583 + fixes a :: "'a::metric_space"
2.1584 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1585 + assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
2.1586 + shows "(g ---> l) (at a)"
2.1587 +proof-
2.1588 + from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
2.1589 + hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
2.1590 + unfolding ball_def subset_eq apply auto apply(erule_tac x=x' in allE) apply(erule_tac x=x' in ballE) by(auto simp add: dist_commute)
2.1591 + thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
2.1592 +qed
2.1593 +
2.1594 +text{* A congruence rule allowing us to transform limits assuming not at point. *}
2.1595 +
2.1596 +(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
2.1597 +
2.1598 +lemma Lim_cong_within[cong add]:
2.1599 + fixes a :: "'a::metric_space"
2.1600 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1601 + shows "(\<And>x. x \<noteq> a \<Longrightarrow> f x = g x) ==> ((\<lambda>x. f x) ---> l) (at a within S) \<longleftrightarrow> ((g ---> l) (at a within S))"
2.1602 + by (simp add: Lim_within dist_nz[symmetric])
2.1603 +
2.1604 +lemma Lim_cong_at[cong add]:
2.1605 + fixes a :: "'a::metric_space"
2.1606 + fixes l :: "'b::metric_space" (* TODO: generalize *)
2.1607 + shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
2.1608 + by (simp add: Lim_at dist_nz[symmetric])
2.1609 +
2.1610 +text{* Useful lemmas on closure and set of possible sequential limits.*}
2.1611 +
2.1612 +lemma closure_sequential:
2.1613 + fixes l :: "'a::metric_space" (* TODO: generalize *)
2.1614 + shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
2.1615 +proof
2.1616 + assume "?lhs" moreover
2.1617 + { assume "l \<in> S"
2.1618 + hence "?rhs" using Lim_const[of l sequentially] by auto
2.1619 + } moreover
2.1620 + { assume "l islimpt S"
2.1621 + hence "?rhs" unfolding islimpt_sequential by auto
2.1622 + } ultimately
2.1623 + show "?rhs" unfolding closure_def by auto
2.1624 +next
2.1625 + assume "?rhs"
2.1626 + thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
2.1627 +qed
2.1628 +
2.1629 +lemma closed_sequential_limits:
2.1630 + fixes S :: "'a::metric_space set"
2.1631 + shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
2.1632 + unfolding closed_limpt
2.1633 + using closure_sequential [where 'a='a] closure_closed [where 'a='a] closed_limpt [where 'a='a] islimpt_sequential [where 'a='a] mem_delete [where 'a='a]
2.1634 + by metis
2.1635 +
2.1636 +lemma closure_approachable:
2.1637 + fixes S :: "'a::metric_space set"
2.1638 + shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
2.1639 + apply (auto simp add: closure_def islimpt_approachable)
2.1640 + by (metis dist_self)
2.1641 +
2.1642 +lemma closed_approachable:
2.1643 + fixes S :: "'a::metric_space set"
2.1644 + shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
2.1645 + by (metis closure_closed closure_approachable)
2.1646 +
2.1647 +text{* Some other lemmas about sequences. *}
2.1648 +
2.1649 +lemma seq_offset:
2.1650 + fixes l :: "'a::metric_space" (* TODO: generalize *)
2.1651 + shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
2.1652 + apply (auto simp add: Lim_sequentially)
2.1653 + by (metis trans_le_add1 )
2.1654 +
2.1655 +lemma seq_offset_neg:
2.1656 + "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
2.1657 + apply (rule topological_tendstoI)
2.1658 + apply (drule (2) topological_tendstoD)
2.1659 + apply (simp only: eventually_sequentially)
2.1660 + apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
2.1661 + apply metis
2.1662 + by arith
2.1663 +
2.1664 +lemma seq_offset_rev:
2.1665 + "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
2.1666 + apply (rule topological_tendstoI)
2.1667 + apply (drule (2) topological_tendstoD)
2.1668 + apply (simp only: eventually_sequentially)
2.1669 + apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
2.1670 + by metis arith
2.1671 +
2.1672 +lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
2.1673 +proof-
2.1674 + { fix e::real assume "e>0"
2.1675 + hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
2.1676 + using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
2.1677 + by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
2.1678 + }
2.1679 + thus ?thesis unfolding Lim_sequentially dist_norm by simp
2.1680 +qed
2.1681 +
2.1682 +text{* More properties of closed balls. *}
2.1683 +
2.1684 +lemma closed_cball: "closed (cball x e)"
2.1685 +unfolding cball_def closed_def
2.1686 +unfolding Collect_neg_eq [symmetric] not_le
2.1687 +apply (clarsimp simp add: open_dist, rename_tac y)
2.1688 +apply (rule_tac x="dist x y - e" in exI, clarsimp)
2.1689 +apply (rename_tac x')
2.1690 +apply (cut_tac x=x and y=x' and z=y in dist_triangle)
2.1691 +apply simp
2.1692 +done
2.1693 +
2.1694 +lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
2.1695 +proof-
2.1696 + { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
2.1697 + hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
2.1698 + } moreover
2.1699 + { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
2.1700 + hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
2.1701 + } ultimately
2.1702 + show ?thesis unfolding open_contains_ball by auto
2.1703 +qed
2.1704 +
2.1705 +lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
2.1706 + by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
2.1707 +
2.1708 +lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
2.1709 + apply (simp add: interior_def, safe)
2.1710 + apply (force simp add: open_contains_cball)
2.1711 + apply (rule_tac x="ball x e" in exI)
2.1712 + apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
2.1713 + done
2.1714 +
2.1715 +lemma islimpt_ball:
2.1716 + fixes x y :: "'a::{real_normed_vector,perfect_space}"
2.1717 + shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
2.1718 +proof
2.1719 + assume "?lhs"
2.1720 + { assume "e \<le> 0"
2.1721 + hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
2.1722 + have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
2.1723 + }
2.1724 + hence "e > 0" by (metis not_less)
2.1725 + moreover
2.1726 + have "y \<in> cball x e" using closed_cball[of x e] islimpt_subset[of y "ball x e" "cball x e"] ball_subset_cball[of x e] `?lhs` unfolding closed_limpt by auto
2.1727 + ultimately show "?rhs" by auto
2.1728 +next
2.1729 + assume "?rhs" hence "e>0" by auto
2.1730 + { fix d::real assume "d>0"
2.1731 + have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
2.1732 + proof(cases "d \<le> dist x y")
2.1733 + case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
2.1734 + proof(cases "x=y")
2.1735 + case True hence False using `d \<le> dist x y` `d>0` by auto
2.1736 + thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
2.1737 + next
2.1738 + case False
2.1739 +
2.1740 + have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
2.1741 + = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
2.1742 + unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
2.1743 + also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
2.1744 + using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
2.1745 + unfolding scaleR_minus_left scaleR_one
2.1746 + by (auto simp add: norm_minus_commute)
2.1747 + also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
2.1748 + unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
2.1749 + unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
2.1750 + also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
2.1751 + finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
2.1752 +
2.1753 + moreover
2.1754 +
2.1755 + have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
2.1756 + using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
2.1757 + moreover
2.1758 + have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
2.1759 + using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
2.1760 + unfolding dist_norm by auto
2.1761 + ultimately show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by (rule_tac x="y - (d / (2*dist y x)) *\<^sub>R (y - x)" in bexI) auto
2.1762 + qed
2.1763 + next
2.1764 + case False hence "d > dist x y" by auto
2.1765 + show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
2.1766 + proof(cases "x=y")
2.1767 + case True
2.1768 + obtain z where **: "z \<noteq> y" "dist z y < min e d"
2.1769 + using perfect_choose_dist[of "min e d" y]
2.1770 + using `d > 0` `e>0` by auto
2.1771 + show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
2.1772 + unfolding `x = y`
2.1773 + using `z \<noteq> y` **
2.1774 + by (rule_tac x=z in bexI, auto simp add: dist_commute)
2.1775 + next
2.1776 + case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
2.1777 + using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
2.1778 + qed
2.1779 + qed }
2.1780 + thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
2.1781 +qed
2.1782 +
2.1783 +lemma closure_ball_lemma:
2.1784 + fixes x y :: "'a::real_normed_vector"
2.1785 + assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
2.1786 +proof (rule islimptI)
2.1787 + fix T assume "y \<in> T" "open T"
2.1788 + then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
2.1789 + unfolding open_dist by fast
2.1790 + (* choose point between x and y, within distance r of y. *)
2.1791 + def k \<equiv> "min 1 (r / (2 * dist x y))"
2.1792 + def z \<equiv> "y + scaleR k (x - y)"
2.1793 + have z_def2: "z = x + scaleR (1 - k) (y - x)"
2.1794 + unfolding z_def by (simp add: algebra_simps)
2.1795 + have "dist z y < r"
2.1796 + unfolding z_def k_def using `0 < r`
2.1797 + by (simp add: dist_norm min_def)
2.1798 + hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
2.1799 + have "dist x z < dist x y"
2.1800 + unfolding z_def2 dist_norm
2.1801 + apply (simp add: norm_minus_commute)
2.1802 + apply (simp only: dist_norm [symmetric])
2.1803 + apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
2.1804 + apply (rule mult_strict_right_mono)
2.1805 + apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
2.1806 + apply (simp add: zero_less_dist_iff `x \<noteq> y`)
2.1807 + done
2.1808 + hence "z \<in> ball x (dist x y)" by simp
2.1809 + have "z \<noteq> y"
2.1810 + unfolding z_def k_def using `x \<noteq> y` `0 < r`
2.1811 + by (simp add: min_def)
2.1812 + show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
2.1813 + using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
2.1814 + by fast
2.1815 +qed
2.1816 +
2.1817 +lemma closure_ball:
2.1818 + fixes x :: "'a::real_normed_vector"
2.1819 + shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
2.1820 +apply (rule equalityI)
2.1821 +apply (rule closure_minimal)
2.1822 +apply (rule ball_subset_cball)
2.1823 +apply (rule closed_cball)
2.1824 +apply (rule subsetI, rename_tac y)
2.1825 +apply (simp add: le_less [where 'a=real])
2.1826 +apply (erule disjE)
2.1827 +apply (rule subsetD [OF closure_subset], simp)
2.1828 +apply (simp add: closure_def)
2.1829 +apply clarify
2.1830 +apply (rule closure_ball_lemma)
2.1831 +apply (simp add: zero_less_dist_iff)
2.1832 +done
2.1833 +
2.1834 +(* In a trivial vector space, this fails for e = 0. *)
2.1835 +lemma interior_cball:
2.1836 + fixes x :: "'a::{real_normed_vector, perfect_space}"
2.1837 + shows "interior (cball x e) = ball x e"
2.1838 +proof(cases "e\<ge>0")
2.1839 + case False note cs = this
2.1840 + from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
2.1841 + { fix y assume "y \<in> cball x e"
2.1842 + hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
2.1843 + hence "cball x e = {}" by auto
2.1844 + hence "interior (cball x e) = {}" using interior_empty by auto
2.1845 + ultimately show ?thesis by blast
2.1846 +next
2.1847 + case True note cs = this
2.1848 + have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
2.1849 + { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
2.1850 + then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
2.1851 +
2.1852 + then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
2.1853 + using perfect_choose_dist [of d] by auto
2.1854 + have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
2.1855 + hence xa_cball:"xa \<in> cball x e" using as(1) by auto
2.1856 +
2.1857 + hence "y \<in> ball x e" proof(cases "x = y")
2.1858 + case True
2.1859 + hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
2.1860 + thus "y \<in> ball x e" using `x = y ` by simp
2.1861 + next
2.1862 + case False
2.1863 + have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
2.1864 + using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
2.1865 + hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
2.1866 + have "y - x \<noteq> 0" using `x \<noteq> y` by auto
2.1867 + hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
2.1868 + using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
2.1869 +
2.1870 + have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) x = norm (y + (d / (2 * norm (y - x))) *\<^sub>R y - (d / (2 * norm (y - x))) *\<^sub>R x - x)"
2.1871 + by (auto simp add: dist_norm algebra_simps)
2.1872 + also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
2.1873 + by (auto simp add: algebra_simps)
2.1874 + also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
2.1875 + using ** by auto
2.1876 + also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
2.1877 + finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
2.1878 + thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
2.1879 + qed }
2.1880 + hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
2.1881 + ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
2.1882 +qed
2.1883 +
2.1884 +lemma frontier_ball:
2.1885 + fixes a :: "'a::real_normed_vector"
2.1886 + shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
2.1887 + apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
2.1888 + apply (simp add: expand_set_eq)
2.1889 + by arith
2.1890 +
2.1891 +lemma frontier_cball:
2.1892 + fixes a :: "'a::{real_normed_vector, perfect_space}"
2.1893 + shows "frontier(cball a e) = {x. dist a x = e}"
2.1894 + apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
2.1895 + apply (simp add: expand_set_eq)
2.1896 + by arith
2.1897 +
2.1898 +lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
2.1899 + apply (simp add: expand_set_eq not_le)
2.1900 + by (metis zero_le_dist dist_self order_less_le_trans)
2.1901 +lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
2.1902 +
2.1903 +lemma cball_eq_sing:
2.1904 + fixes x :: "'a::perfect_space"
2.1905 + shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
2.1906 +proof (rule linorder_cases)
2.1907 + assume e: "0 < e"
2.1908 + obtain a where "a \<noteq> x" "dist a x < e"
2.1909 + using perfect_choose_dist [OF e] by auto
2.1910 + hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
2.1911 + with e show ?thesis by (auto simp add: expand_set_eq)
2.1912 +qed auto
2.1913 +
2.1914 +lemma cball_sing:
2.1915 + fixes x :: "'a::metric_space"
2.1916 + shows "e = 0 ==> cball x e = {x}"
2.1917 + by (auto simp add: expand_set_eq)
2.1918 +
2.1919 +text{* For points in the interior, localization of limits makes no difference. *}
2.1920 +
2.1921 +lemma eventually_within_interior:
2.1922 + assumes "x \<in> interior S"
2.1923 + shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
2.1924 +proof-
2.1925 + from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
2.1926 + unfolding interior_def by fast
2.1927 + { assume "?lhs"
2.1928 + then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
2.1929 + unfolding Limits.eventually_within Limits.eventually_at_topological
2.1930 + by auto
2.1931 + with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
2.1932 + by auto
2.1933 + then have "?rhs"
2.1934 + unfolding Limits.eventually_at_topological by auto
2.1935 + } moreover
2.1936 + { assume "?rhs" hence "?lhs"
2.1937 + unfolding Limits.eventually_within
2.1938 + by (auto elim: eventually_elim1)
2.1939 + } ultimately
2.1940 + show "?thesis" ..
2.1941 +qed
2.1942 +
2.1943 +lemma lim_within_interior:
2.1944 + "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
2.1945 + unfolding tendsto_def by (simp add: eventually_within_interior)
2.1946 +
2.1947 +lemma netlimit_within_interior:
2.1948 + fixes x :: "'a::{perfect_space, real_normed_vector}"
2.1949 + (* FIXME: generalize to perfect_space *)
2.1950 + assumes "x \<in> interior S"
2.1951 + shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
2.1952 +proof-
2.1953 + from assms obtain e::real where e:"e>0" "ball x e \<subseteq> S" using open_interior[of S] unfolding open_contains_ball using interior_subset[of S] by auto
2.1954 + hence "\<not> trivial_limit (at x within S)" using islimpt_subset[of x "ball x e" S] unfolding trivial_limit_within islimpt_ball centre_in_cball by auto
2.1955 + thus ?thesis using netlimit_within by auto
2.1956 +qed
2.1957 +
2.1958 +subsection{* Boundedness. *}
2.1959 +
2.1960 + (* FIXME: This has to be unified with BSEQ!! *)
2.1961 +definition
2.1962 + bounded :: "'a::metric_space set \<Rightarrow> bool" where
2.1963 + "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
2.1964 +
2.1965 +lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
2.1966 +unfolding bounded_def
2.1967 +apply safe
2.1968 +apply (rule_tac x="dist a x + e" in exI, clarify)
2.1969 +apply (drule (1) bspec)
2.1970 +apply (erule order_trans [OF dist_triangle add_left_mono])
2.1971 +apply auto
2.1972 +done
2.1973 +
2.1974 +lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
2.1975 +unfolding bounded_any_center [where a=0]
2.1976 +by (simp add: dist_norm)
2.1977 +
2.1978 +lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
2.1979 +lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
2.1980 + by (metis bounded_def subset_eq)
2.1981 +
2.1982 +lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
2.1983 + by (metis bounded_subset interior_subset)
2.1984 +
2.1985 +lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
2.1986 +proof-
2.1987 + from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
2.1988 + { fix y assume "y \<in> closure S"
2.1989 + then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
2.1990 + unfolding closure_sequential by auto
2.1991 + have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
2.1992 + hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
2.1993 + by (rule eventually_mono, simp add: f(1))
2.1994 + have "dist x y \<le> a"
2.1995 + apply (rule Lim_dist_ubound [of sequentially f])
2.1996 + apply (rule trivial_limit_sequentially)
2.1997 + apply (rule f(2))
2.1998 + apply fact
2.1999 + done
2.2000 + }
2.2001 + thus ?thesis unfolding bounded_def by auto
2.2002 +qed
2.2003 +
2.2004 +lemma bounded_cball[simp,intro]: "bounded (cball x e)"
2.2005 + apply (simp add: bounded_def)
2.2006 + apply (rule_tac x=x in exI)
2.2007 + apply (rule_tac x=e in exI)
2.2008 + apply auto
2.2009 + done
2.2010 +
2.2011 +lemma bounded_ball[simp,intro]: "bounded(ball x e)"
2.2012 + by (metis ball_subset_cball bounded_cball bounded_subset)
2.2013 +
2.2014 +lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
2.2015 +proof-
2.2016 + { fix a F assume as:"bounded F"
2.2017 + then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
2.2018 + hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
2.2019 + hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
2.2020 + }
2.2021 + thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
2.2022 +qed
2.2023 +
2.2024 +lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
2.2025 + apply (auto simp add: bounded_def)
2.2026 + apply (rename_tac x y r s)
2.2027 + apply (rule_tac x=x in exI)
2.2028 + apply (rule_tac x="max r (dist x y + s)" in exI)
2.2029 + apply (rule ballI, rename_tac z, safe)
2.2030 + apply (drule (1) bspec, simp)
2.2031 + apply (drule (1) bspec)
2.2032 + apply (rule min_max.le_supI2)
2.2033 + apply (erule order_trans [OF dist_triangle add_left_mono])
2.2034 + done
2.2035 +
2.2036 +lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
2.2037 + by (induct rule: finite_induct[of F], auto)
2.2038 +
2.2039 +lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
2.2040 + apply (simp add: bounded_iff)
2.2041 + apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
2.2042 + by metis arith
2.2043 +
2.2044 +lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
2.2045 + by (metis Int_lower1 Int_lower2 bounded_subset)
2.2046 +
2.2047 +lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
2.2048 +apply (metis Diff_subset bounded_subset)
2.2049 +done
2.2050 +
2.2051 +lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
2.2052 + by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
2.2053 +
2.2054 +lemma not_bounded_UNIV[simp, intro]:
2.2055 + "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
2.2056 +proof(auto simp add: bounded_pos not_le)
2.2057 + obtain x :: 'a where "x \<noteq> 0"
2.2058 + using perfect_choose_dist [OF zero_less_one] by fast
2.2059 + fix b::real assume b: "b >0"
2.2060 + have b1: "b +1 \<ge> 0" using b by simp
2.2061 + with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
2.2062 + by (simp add: norm_sgn)
2.2063 + then show "\<exists>x::'a. b < norm x" ..
2.2064 +qed
2.2065 +
2.2066 +lemma bounded_linear_image:
2.2067 + assumes "bounded S" "bounded_linear f"
2.2068 + shows "bounded(f ` S)"
2.2069 +proof-
2.2070 + from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
2.2071 + from assms(2) obtain B where B:"B>0" "\<forall>x. norm (f x) \<le> B * norm x" using bounded_linear.pos_bounded by (auto simp add: mult_ac)
2.2072 + { fix x assume "x\<in>S"
2.2073 + hence "norm x \<le> b" using b by auto
2.2074 + hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
2.2075 + by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
2.2076 + }
2.2077 + thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
2.2078 + using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
2.2079 +qed
2.2080 +
2.2081 +lemma bounded_scaling:
2.2082 + fixes S :: "'a::real_normed_vector set"
2.2083 + shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
2.2084 + apply (rule bounded_linear_image, assumption)
2.2085 + apply (rule scaleR.bounded_linear_right)
2.2086 + done
2.2087 +
2.2088 +lemma bounded_translation:
2.2089 + fixes S :: "'a::real_normed_vector set"
2.2090 + assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
2.2091 +proof-
2.2092 + from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
2.2093 + { fix x assume "x\<in>S"
2.2094 + hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
2.2095 + }
2.2096 + thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
2.2097 + by (auto intro!: add exI[of _ "b + norm a"])
2.2098 +qed
2.2099 +
2.2100 +
2.2101 +text{* Some theorems on sups and infs using the notion "bounded". *}
2.2102 +
2.2103 +lemma bounded_real:
2.2104 + fixes S :: "real set"
2.2105 + shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
2.2106 + by (simp add: bounded_iff)
2.2107 +
2.2108 +lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
2.2109 + shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
2.2110 +proof
2.2111 + fix x assume "x\<in>S"
2.2112 + from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
2.2113 + hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
2.2114 + thus "x \<le> rsup S" using rsup[OF `S\<noteq>{}`] using assms(1)[unfolded bounded_real] using isLubD2[of UNIV S "rsup S" x] using `x\<in>S` by auto
2.2115 +next
2.2116 + show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
2.2117 + using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
2.2118 + apply (auto simp add: bounded_real)
2.2119 + by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
2.2120 +qed
2.2121 +
2.2122 +lemma rsup_insert: assumes "bounded S"
2.2123 + shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
2.2124 +proof(cases "S={}")
2.2125 + case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
2.2126 +next
2.2127 + let ?S = "insert x S"
2.2128 + case False
2.2129 + hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
2.2130 + hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
2.2131 + hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
2.2132 + moreover
2.2133 + have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
2.2134 + { fix y assume as:"isUb UNIV (insert x S) y"
2.2135 + hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
2.2136 + unfolding setle_def by auto }
2.2137 + hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
2.2138 + hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
2.2139 + ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
2.2140 +qed
2.2141 +
2.2142 +lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
2.2143 + apply (rule rsup_insert)
2.2144 + apply (rule finite_imp_bounded)
2.2145 + by simp
2.2146 +
2.2147 +lemma bounded_has_rinf:
2.2148 + assumes "bounded S" "S \<noteq> {}"
2.2149 + shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
2.2150 +proof
2.2151 + fix x assume "x\<in>S"
2.2152 + from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
2.2153 + hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
2.2154 + thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
2.2155 +next
2.2156 + show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
2.2157 + using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
2.2158 + apply (auto simp add: bounded_real)
2.2159 + by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
2.2160 +qed
2.2161 +
2.2162 +(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
2.2163 +lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
2.2164 + apply (frule isGlb_isLb)
2.2165 + apply (frule_tac x = y in isGlb_isLb)
2.2166 + apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
2.2167 + done
2.2168 +
2.2169 +lemma rinf_insert: assumes "bounded S"
2.2170 + shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
2.2171 +proof(cases "S={}")
2.2172 + case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
2.2173 +next
2.2174 + let ?S = "insert x S"
2.2175 + case False
2.2176 + hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
2.2177 + hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
2.2178 + hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
2.2179 + moreover
2.2180 + have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
2.2181 + { fix y assume as:"isLb UNIV (insert x S) y"
2.2182 + hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
2.2183 + unfolding setge_def by auto }
2.2184 + hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
2.2185 + hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
2.2186 + ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
2.2187 +qed
2.2188 +
2.2189 +lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
2.2190 + by (rule rinf_insert, rule finite_imp_bounded, simp)
2.2191 +
2.2192 +subsection{* Compactness (the definition is the one based on convegent subsequences). *}
2.2193 +
2.2194 +definition
2.2195 + compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
2.2196 + "compact S \<longleftrightarrow>
2.2197 + (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
2.2198 + (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
2.2199 +
2.2200 +text {*
2.2201 + A metric space (or topological vector space) is said to have the
2.2202 + Heine-Borel property if every closed and bounded subset is compact.
2.2203 +*}
2.2204 +
2.2205 +class heine_borel =
2.2206 + assumes bounded_imp_convergent_subsequence:
2.2207 + "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
2.2208 + \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
2.2209 +
2.2210 +lemma bounded_closed_imp_compact:
2.2211 + fixes s::"'a::heine_borel set"
2.2212 + assumes "bounded s" and "closed s" shows "compact s"
2.2213 +proof (unfold compact_def, clarify)
2.2214 + fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
2.2215 + obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
2.2216 + using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
2.2217 + from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
2.2218 + have "l \<in> s" using `closed s` fr l
2.2219 + unfolding closed_sequential_limits by blast
2.2220 + show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
2.2221 + using `l \<in> s` r l by blast
2.2222 +qed
2.2223 +
2.2224 +lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
2.2225 +proof(induct n)
2.2226 + show "0 \<le> r 0" by auto
2.2227 +next
2.2228 + fix n assume "n \<le> r n"
2.2229 + moreover have "r n < r (Suc n)"
2.2230 + using assms [unfolded subseq_def] by auto
2.2231 + ultimately show "Suc n \<le> r (Suc n)" by auto
2.2232 +qed
2.2233 +
2.2234 +lemma eventually_subseq:
2.2235 + assumes r: "subseq r"
2.2236 + shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
2.2237 +unfolding eventually_sequentially
2.2238 +by (metis subseq_bigger [OF r] le_trans)
2.2239 +
2.2240 +lemma lim_subseq:
2.2241 + "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
2.2242 +unfolding tendsto_def eventually_sequentially o_def
2.2243 +by (metis subseq_bigger le_trans)
2.2244 +
2.2245 +lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
2.2246 + unfolding Ex1_def
2.2247 + apply (rule_tac x="nat_rec e f" in exI)
2.2248 + apply (rule conjI)+
2.2249 +apply (rule def_nat_rec_0, simp)
2.2250 +apply (rule allI, rule def_nat_rec_Suc, simp)
2.2251 +apply (rule allI, rule impI, rule ext)
2.2252 +apply (erule conjE)
2.2253 +apply (induct_tac x)
2.2254 +apply (simp add: nat_rec_0)
2.2255 +apply (erule_tac x="n" in allE)
2.2256 +apply (simp)
2.2257 +done
2.2258 +
2.2259 +lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
2.2260 + assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
2.2261 + shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
2.2262 +proof-
2.2263 + have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
2.2264 + then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
2.2265 + { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
2.2266 + { fix n::nat
2.2267 + obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
2.2268 + have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
2.2269 + with n have "s N \<le> t - e" using `e>0` by auto
2.2270 + hence "s n \<le> t - e" using assms(1)[unfolded incseq_def, THEN spec[where x=n], THEN spec[where x=N]] using `n\<le>N` by auto }
2.2271 + hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
2.2272 + hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
2.2273 + thus ?thesis by blast
2.2274 +qed
2.2275 +
2.2276 +lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
2.2277 + assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
2.2278 + shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
2.2279 + using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
2.2280 + unfolding monoseq_def incseq_def
2.2281 + apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
2.2282 + unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
2.2283 +
2.2284 +lemma compact_real_lemma:
2.2285 + assumes "\<forall>n::nat. abs(s n) \<le> b"
2.2286 + shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
2.2287 +proof-
2.2288 + obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
2.2289 + using seq_monosub[of s] by auto
2.2290 + thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
2.2291 + unfolding tendsto_iff dist_norm eventually_sequentially by auto
2.2292 +qed
2.2293 +
2.2294 +instance real :: heine_borel
2.2295 +proof
2.2296 + fix s :: "real set" and f :: "nat \<Rightarrow> real"
2.2297 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
2.2298 + then obtain b where b: "\<forall>n. abs (f n) \<le> b"
2.2299 + unfolding bounded_iff by auto
2.2300 + obtain l :: real and r :: "nat \<Rightarrow> nat" where
2.2301 + r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
2.2302 + using compact_real_lemma [OF b] by auto
2.2303 + thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
2.2304 + by auto
2.2305 +qed
2.2306 +
2.2307 +lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
2.2308 +unfolding bounded_def
2.2309 +apply clarify
2.2310 +apply (rule_tac x="x $ i" in exI)
2.2311 +apply (rule_tac x="e" in exI)
2.2312 +apply clarify
2.2313 +apply (rule order_trans [OF dist_nth_le], simp)
2.2314 +done
2.2315 +
2.2316 +lemma compact_lemma:
2.2317 + fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
2.2318 + assumes "bounded s" and "\<forall>n. f n \<in> s"
2.2319 + shows "\<forall>d.
2.2320 + \<exists>l r. subseq r \<and>
2.2321 + (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
2.2322 +proof
2.2323 + fix d::"'n set" have "finite d" by simp
2.2324 + thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
2.2325 + (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
2.2326 + proof(induct d) case empty thus ?case unfolding subseq_def by auto
2.2327 + next case (insert k d)
2.2328 + have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
2.2329 + obtain l1::"'a^'n" and r1 where r1:"subseq r1" and lr1:"\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially"
2.2330 + using insert(3) by auto
2.2331 + have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
2.2332 + obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
2.2333 + using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
2.2334 + def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
2.2335 + using r1 and r2 unfolding r_def o_def subseq_def by auto
2.2336 + moreover
2.2337 + def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
2.2338 + { fix e::real assume "e>0"
2.2339 + from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
2.2340 + from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
2.2341 + from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
2.2342 + by (rule eventually_subseq)
2.2343 + have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
2.2344 + using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
2.2345 + }
2.2346 + ultimately show ?case by auto
2.2347 + qed
2.2348 +qed
2.2349 +
2.2350 +instance "^" :: (heine_borel, finite) heine_borel
2.2351 +proof
2.2352 + fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
2.2353 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
2.2354 + then obtain l r where r: "subseq r"
2.2355 + and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
2.2356 + using compact_lemma [OF s f] by blast
2.2357 + let ?d = "UNIV::'b set"
2.2358 + { fix e::real assume "e>0"
2.2359 + hence "0 < e / (real_of_nat (card ?d))"
2.2360 + using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
2.2361 + with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
2.2362 + by simp
2.2363 + moreover
2.2364 + { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
2.2365 + have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
2.2366 + unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
2.2367 + also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
2.2368 + by (rule setsum_strict_mono) (simp_all add: n)
2.2369 + finally have "dist (f (r n)) l < e" by simp
2.2370 + }
2.2371 + ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
2.2372 + by (rule eventually_elim1)
2.2373 + }
2.2374 + hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
2.2375 + with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
2.2376 +qed
2.2377 +
2.2378 +lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
2.2379 +unfolding bounded_def
2.2380 +apply clarify
2.2381 +apply (rule_tac x="a" in exI)
2.2382 +apply (rule_tac x="e" in exI)
2.2383 +apply clarsimp
2.2384 +apply (drule (1) bspec)
2.2385 +apply (simp add: dist_Pair_Pair)
2.2386 +apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
2.2387 +done
2.2388 +
2.2389 +lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
2.2390 +unfolding bounded_def
2.2391 +apply clarify
2.2392 +apply (rule_tac x="b" in exI)
2.2393 +apply (rule_tac x="e" in exI)
2.2394 +apply clarsimp
2.2395 +apply (drule (1) bspec)
2.2396 +apply (simp add: dist_Pair_Pair)
2.2397 +apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
2.2398 +done
2.2399 +
2.2400 +instance "*" :: (heine_borel, heine_borel) heine_borel
2.2401 +proof
2.2402 + fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
2.2403 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
2.2404 + from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
2.2405 + from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
2.2406 + obtain l1 r1 where r1: "subseq r1"
2.2407 + and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
2.2408 + using bounded_imp_convergent_subsequence [OF s1 f1]
2.2409 + unfolding o_def by fast
2.2410 + from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
2.2411 + from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
2.2412 + obtain l2 r2 where r2: "subseq r2"
2.2413 + and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
2.2414 + using bounded_imp_convergent_subsequence [OF s2 f2]
2.2415 + unfolding o_def by fast
2.2416 + have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
2.2417 + using lim_subseq [OF r2 l1] unfolding o_def .
2.2418 + have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
2.2419 + using tendsto_Pair [OF l1' l2] unfolding o_def by simp
2.2420 + have r: "subseq (r1 \<circ> r2)"
2.2421 + using r1 r2 unfolding subseq_def by simp
2.2422 + show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
2.2423 + using l r by fast
2.2424 +qed
2.2425 +
2.2426 +subsection{* Completeness. *}
2.2427 +
2.2428 +lemma cauchy_def:
2.2429 + "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
2.2430 +unfolding Cauchy_def by blast
2.2431 +
2.2432 +definition
2.2433 + complete :: "'a::metric_space set \<Rightarrow> bool" where
2.2434 + "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
2.2435 + --> (\<exists>l \<in> s. (f ---> l) sequentially))"
2.2436 +
2.2437 +lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
2.2438 +proof-
2.2439 + { assume ?rhs
2.2440 + { fix e::real
2.2441 + assume "e>0"
2.2442 + with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
2.2443 + by (erule_tac x="e/2" in allE) auto
2.2444 + { fix n m
2.2445 + assume nm:"N \<le> m \<and> N \<le> n"
2.2446 + hence "dist (s m) (s n) < e" using N
2.2447 + using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
2.2448 + by blast
2.2449 + }
2.2450 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
2.2451 + by blast
2.2452 + }
2.2453 + hence ?lhs
2.2454 + unfolding cauchy_def
2.2455 + by blast
2.2456 + }
2.2457 + thus ?thesis
2.2458 + unfolding cauchy_def
2.2459 + using dist_triangle_half_l
2.2460 + by blast
2.2461 +qed
2.2462 +
2.2463 +lemma convergent_imp_cauchy:
2.2464 + "(s ---> l) sequentially ==> Cauchy s"
2.2465 +proof(simp only: cauchy_def, rule, rule)
2.2466 + fix e::real assume "e>0" "(s ---> l) sequentially"
2.2467 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (s n) l < e/2" unfolding Lim_sequentially by(erule_tac x="e/2" in allE) auto
2.2468 + thus "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e" using dist_triangle_half_l[of _ l e _] by (rule_tac x=N in exI) auto
2.2469 +qed
2.2470 +
2.2471 +lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
2.2472 +proof-
2.2473 + from assms obtain N::nat where "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < 1" unfolding cauchy_def apply(erule_tac x= 1 in allE) by auto
2.2474 + hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
2.2475 + moreover
2.2476 + have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
2.2477 + then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
2.2478 + unfolding bounded_any_center [where a="s N"] by auto
2.2479 + ultimately show "?thesis"
2.2480 + unfolding bounded_any_center [where a="s N"]
2.2481 + apply(rule_tac x="max a 1" in exI) apply auto
2.2482 + apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
2.2483 +qed
2.2484 +
2.2485 +lemma compact_imp_complete: assumes "compact s" shows "complete s"
2.2486 +proof-
2.2487 + { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
2.2488 + from as(1) obtain l r where lr: "l\<in>s" "subseq r" "((f \<circ> r) ---> l) sequentially" using assms unfolding compact_def by blast
2.2489 +
2.2490 + note lr' = subseq_bigger [OF lr(2)]
2.2491 +
2.2492 + { fix e::real assume "e>0"
2.2493 + from as(2) obtain N where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (f m) (f n) < e/2" unfolding cauchy_def using `e>0` apply (erule_tac x="e/2" in allE) by auto
2.2494 + from lr(3)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] obtain M where M:"\<forall>n\<ge>M. dist ((f \<circ> r) n) l < e/2" using `e>0` by auto
2.2495 + { fix n::nat assume n:"n \<ge> max N M"
2.2496 + have "dist ((f \<circ> r) n) l < e/2" using n M by auto
2.2497 + moreover have "r n \<ge> N" using lr'[of n] n by auto
2.2498 + hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
2.2499 + ultimately have "dist (f n) l < e" using dist_triangle_half_r[of "f (r n)" "f n" e l] by (auto simp add: dist_commute) }
2.2500 + hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
2.2501 + hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
2.2502 + thus ?thesis unfolding complete_def by auto
2.2503 +qed
2.2504 +
2.2505 +instance heine_borel < complete_space
2.2506 +proof
2.2507 + fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
2.2508 + hence "bounded (range f)" unfolding image_def
2.2509 + using cauchy_imp_bounded [of f] by auto
2.2510 + hence "compact (closure (range f))"
2.2511 + using bounded_closed_imp_compact [of "closure (range f)"] by auto
2.2512 + hence "complete (closure (range f))"
2.2513 + using compact_imp_complete by auto
2.2514 + moreover have "\<forall>n. f n \<in> closure (range f)"
2.2515 + using closure_subset [of "range f"] by auto
2.2516 + ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
2.2517 + using `Cauchy f` unfolding complete_def by auto
2.2518 + then show "convergent f"
2.2519 + unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
2.2520 +qed
2.2521 +
2.2522 +lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
2.2523 +proof(simp add: complete_def, rule, rule)
2.2524 + fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
2.2525 + hence "convergent f" by (rule Cauchy_convergent)
2.2526 + hence "\<exists>l. f ----> l" unfolding convergent_def .
2.2527 + thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
2.2528 +qed
2.2529 +
2.2530 +lemma complete_imp_closed: assumes "complete s" shows "closed s"
2.2531 +proof -
2.2532 + { fix x assume "x islimpt s"
2.2533 + then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
2.2534 + unfolding islimpt_sequential by auto
2.2535 + then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
2.2536 + using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
2.2537 + hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
2.2538 + }
2.2539 + thus "closed s" unfolding closed_limpt by auto
2.2540 +qed
2.2541 +
2.2542 +lemma complete_eq_closed:
2.2543 + fixes s :: "'a::complete_space set"
2.2544 + shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
2.2545 +proof
2.2546 + assume ?lhs thus ?rhs by (rule complete_imp_closed)
2.2547 +next
2.2548 + assume ?rhs
2.2549 + { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
2.2550 + then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
2.2551 + hence "\<exists>l\<in>s. (f ---> l) sequentially" using `?rhs`[unfolded closed_sequential_limits, THEN spec[where x=f], THEN spec[where x=l]] using as(1) by auto }
2.2552 + thus ?lhs unfolding complete_def by auto
2.2553 +qed
2.2554 +
2.2555 +lemma convergent_eq_cauchy:
2.2556 + fixes s :: "nat \<Rightarrow> 'a::complete_space"
2.2557 + shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
2.2558 +proof
2.2559 + assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
2.2560 + thus ?rhs using convergent_imp_cauchy by auto
2.2561 +next
2.2562 + assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
2.2563 +qed
2.2564 +
2.2565 +lemma convergent_imp_bounded:
2.2566 + fixes s :: "nat \<Rightarrow> 'a::metric_space"
2.2567 + shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
2.2568 + using convergent_imp_cauchy[of s]
2.2569 + using cauchy_imp_bounded[of s]
2.2570 + unfolding image_def
2.2571 + by auto
2.2572 +
2.2573 +subsection{* Total boundedness. *}
2.2574 +
2.2575 +fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
2.2576 + "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
2.2577 +declare helper_1.simps[simp del]
2.2578 +
2.2579 +lemma compact_imp_totally_bounded:
2.2580 + assumes "compact s"
2.2581 + shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
2.2582 +proof(rule, rule, rule ccontr)
2.2583 + fix e::real assume "e>0" and assm:"\<not> (\<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k)"
2.2584 + def x \<equiv> "helper_1 s e"
2.2585 + { fix n
2.2586 + have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
2.2587 + proof(induct_tac rule:nat_less_induct)
2.2588 + fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
2.2589 + assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
2.2590 + have "\<not> s \<subseteq> (\<Union>x\<in>x ` {0..<n}. ball x e)" using assm apply simp apply(erule_tac x="x ` {0 ..< n}" in allE) using as by auto
2.2591 + then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
2.2592 + have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
2.2593 + apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
2.2594 + thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
2.2595 + qed }
2.2596 + hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
2.2597 + then obtain l r where "l\<in>s" and r:"subseq r" and "((x \<circ> r) ---> l) sequentially" using assms(1)[unfolded compact_def, THEN spec[where x=x]] by auto
2.2598 + from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
2.2599 + then obtain N::nat where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist ((x \<circ> r) m) ((x \<circ> r) n) < e" unfolding cauchy_def using `e>0` by auto
2.2600 + show False
2.2601 + using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
2.2602 + using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
2.2603 + using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
2.2604 +qed
2.2605 +
2.2606 +subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
2.2607 +
2.2608 +lemma heine_borel_lemma: fixes s::"'a::metric_space set"
2.2609 + assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
2.2610 + shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
2.2611 +proof(rule ccontr)
2.2612 + assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
2.2613 + hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
2.2614 + { fix n::nat
2.2615 + have "1 / real (n + 1) > 0" by auto
2.2616 + hence "\<exists>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> (ball x (inverse (real (n+1))) \<subseteq> xa))" using cont unfolding Bex_def by auto }
2.2617 + hence "\<forall>n::nat. \<exists>x. x \<in> s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)" by auto
2.2618 + then obtain f where f:"\<forall>n::nat. f n \<in> s \<and> (\<forall>xa\<in>t. \<not> ball (f n) (inverse (real (n + 1))) \<subseteq> xa)"
2.2619 + using choice[of "\<lambda>n::nat. \<lambda>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)"] by auto
2.2620 +
2.2621 + then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
2.2622 + using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
2.2623 +
2.2624 + obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
2.2625 + then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
2.2626 + using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
2.2627 +
2.2628 + then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
2.2629 + using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
2.2630 +
2.2631 + obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
2.2632 + have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
2.2633 + apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
2.2634 + using subseq_bigger[OF r, of "N1 + N2"] by auto
2.2635 +
2.2636 + def x \<equiv> "(f (r (N1 + N2)))"
2.2637 + have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
2.2638 + using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
2.2639 + have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
2.2640 + then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
2.2641 +
2.2642 + have "dist x l < e/2" using N1 unfolding x_def o_def by auto
2.2643 + hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
2.2644 +
2.2645 + thus False using e and `y\<notin>b` by auto
2.2646 +qed
2.2647 +
2.2648 +lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
2.2649 + \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
2.2650 +proof clarify
2.2651 + fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
2.2652 + then obtain e::real where "e>0" and "\<forall>x\<in>s. \<exists>b\<in>f. ball x e \<subseteq> b" using heine_borel_lemma[of s f] by auto
2.2653 + hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
2.2654 + hence "\<exists>bb. \<forall>x\<in>s. bb x \<in>f \<and> ball x e \<subseteq> bb x" using bchoice[of s "\<lambda>x b. b\<in>f \<and> ball x e \<subseteq> b"] by auto
2.2655 + then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
2.2656 +
2.2657 + from `compact s` have "\<exists> k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" using compact_imp_totally_bounded[of s] `e>0` by auto
2.2658 + then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
2.2659 +
2.2660 + have "finite (bb ` k)" using k(1) by auto
2.2661 + moreover
2.2662 + { fix x assume "x\<in>s"
2.2663 + hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
2.2664 + hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
2.2665 + hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
2.2666 + }
2.2667 + ultimately show "\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f'" using bb k(2) by (rule_tac x="bb ` k" in exI) auto
2.2668 +qed
2.2669 +
2.2670 +subsection{* Bolzano-Weierstrass property. *}
2.2671 +
2.2672 +lemma heine_borel_imp_bolzano_weierstrass:
2.2673 + assumes "\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f) --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f'))"
2.2674 + "infinite t" "t \<subseteq> s"
2.2675 + shows "\<exists>x \<in> s. x islimpt t"
2.2676 +proof(rule ccontr)
2.2677 + assume "\<not> (\<exists>x \<in> s. x islimpt t)"
2.2678 + then obtain f where f:"\<forall>x\<in>s. x \<in> f x \<and> open (f x) \<and> (\<forall>y\<in>t. y \<in> f x \<longrightarrow> y = x)" unfolding islimpt_def
2.2679 + using bchoice[of s "\<lambda> x T. x \<in> T \<and> open T \<and> (\<forall>y\<in>t. y \<in> T \<longrightarrow> y = x)"] by auto
2.2680 + obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
2.2681 + using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
2.2682 + from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
2.2683 + { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
2.2684 + hence "x \<in> f x" "y \<in> f x \<longrightarrow> y = x" using f[THEN bspec[where x=x]] and `t\<subseteq>s` by auto
2.2685 + hence "x = y" using `f x = f y` and f[THEN bspec[where x=y]] and `y\<in>t` and `t\<subseteq>s` by auto }
2.2686 + hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
2.2687 + moreover
2.2688 + { fix x assume "x\<in>t" "f x \<notin> g"
2.2689 + from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
2.2690 + then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
2.2691 + hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
2.2692 + hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
2.2693 + hence "f ` t \<subseteq> g" by auto
2.2694 + ultimately show False using g(2) using finite_subset by auto
2.2695 +qed
2.2696 +
2.2697 +subsection{* Complete the chain of compactness variants. *}
2.2698 +
2.2699 +primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
2.2700 + "helper_2 beyond 0 = beyond 0" |
2.2701 + "helper_2 beyond (Suc n) = beyond (dist arbitrary (helper_2 beyond n) + 1 )"
2.2702 +
2.2703 +lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
2.2704 + assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
2.2705 + shows "bounded s"
2.2706 +proof(rule ccontr)
2.2707 + assume "\<not> bounded s"
2.2708 + then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist arbitrary (beyond a) \<le> a"
2.2709 + unfolding bounded_any_center [where a=arbitrary]
2.2710 + apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist arbitrary x \<le> a"] by auto
2.2711 + hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist arbitrary (beyond a) > a"
2.2712 + unfolding linorder_not_le by auto
2.2713 + def x \<equiv> "helper_2 beyond"
2.2714 +
2.2715 + { fix m n ::nat assume "m<n"
2.2716 + hence "dist arbitrary (x m) + 1 < dist arbitrary (x n)"
2.2717 + proof(induct n)
2.2718 + case 0 thus ?case by auto
2.2719 + next
2.2720 + case (Suc n)
2.2721 + have *:"dist arbitrary (x n) + 1 < dist arbitrary (x (Suc n))"
2.2722 + unfolding x_def and helper_2.simps
2.2723 + using beyond(2)[of "dist arbitrary (helper_2 beyond n) + 1"] by auto
2.2724 + thus ?case proof(cases "m < n")
2.2725 + case True thus ?thesis using Suc and * by auto
2.2726 + next
2.2727 + case False hence "m = n" using Suc(2) by auto
2.2728 + thus ?thesis using * by auto
2.2729 + qed
2.2730 + qed } note * = this
2.2731 + { fix m n ::nat assume "m\<noteq>n"
2.2732 + have "1 < dist (x m) (x n)"
2.2733 + proof(cases "m<n")
2.2734 + case True
2.2735 + hence "1 < dist arbitrary (x n) - dist arbitrary (x m)" using *[of m n] by auto
2.2736 + thus ?thesis using dist_triangle [of arbitrary "x n" "x m"] by arith
2.2737 + next
2.2738 + case False hence "n<m" using `m\<noteq>n` by auto
2.2739 + hence "1 < dist arbitrary (x m) - dist arbitrary (x n)" using *[of n m] by auto
2.2740 + thus ?thesis using dist_triangle2 [of arbitrary "x m" "x n"] by arith
2.2741 + qed } note ** = this
2.2742 + { fix a b assume "x a = x b" "a \<noteq> b"
2.2743 + hence False using **[of a b] by auto }
2.2744 + hence "inj x" unfolding inj_on_def by auto
2.2745 + moreover
2.2746 + { fix n::nat
2.2747 + have "x n \<in> s"
2.2748 + proof(cases "n = 0")
2.2749 + case True thus ?thesis unfolding x_def using beyond by auto
2.2750 + next
2.2751 + case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
2.2752 + thus ?thesis unfolding x_def using beyond by auto
2.2753 + qed }
2.2754 + ultimately have "infinite (range x) \<and> range x \<subseteq> s" unfolding x_def using range_inj_infinite[of "helper_2 beyond"] using beyond(1) by auto
2.2755 +
2.2756 + then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
2.2757 + then obtain y where "x y \<noteq> l" and y:"dist (x y) l < 1/2" unfolding islimpt_approachable apply(erule_tac x="1/2" in allE) by auto
2.2758 + then obtain z where "x z \<noteq> l" and z:"dist (x z) l < dist (x y) l" using l[unfolded islimpt_approachable, THEN spec[where x="dist (x y) l"]]
2.2759 + unfolding dist_nz by auto
2.2760 + show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
2.2761 +qed
2.2762 +
2.2763 +lemma sequence_infinite_lemma:
2.2764 + fixes l :: "'a::metric_space" (* TODO: generalize *)
2.2765 + assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
2.2766 + shows "infinite {y. (\<exists> n. y = f n)}"
2.2767 +proof(rule ccontr)
2.2768 + let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
2.2769 + assume "\<not> infinite {y. \<exists>n. y = f n}"
2.2770 + hence **:"finite ?A" "?A \<noteq> {}" by auto
2.2771 + obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
2.2772 + have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
2.2773 + then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
2.2774 + moreover have "dist (f N) l \<in> ?A" by auto
2.2775 + ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
2.2776 +qed
2.2777 +
2.2778 +lemma sequence_unique_limpt:
2.2779 + fixes l :: "'a::metric_space" (* TODO: generalize *)
2.2780 + assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
2.2781 + shows "l' = l"
2.2782 +proof(rule ccontr)
2.2783 + def e \<equiv> "dist l' l"
2.2784 + assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
2.2785 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
2.2786 + using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
2.2787 + def d \<equiv> "Min (insert (e/2) ((\<lambda>n. if dist (f n) l' = 0 then e/2 else dist (f n) l') ` {0 .. N}))"
2.2788 + have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
2.2789 + obtain k where k:"f k \<noteq> l'" "dist (f k) l' < d" using `d>0` and assms(3)[unfolded islimpt_approachable, THEN spec[where x="d"]] by auto
2.2790 + have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
2.2791 + by force
2.2792 + hence "dist l' l < e" using N[THEN spec[where x=k]] using k(2)[unfolded d_def] and dist_triangle_half_r[of "f k" l' e l] by auto
2.2793 + thus False unfolding e_def by auto
2.2794 +qed
2.2795 +
2.2796 +lemma bolzano_weierstrass_imp_closed:
2.2797 + fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
2.2798 + assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
2.2799 + shows "closed s"
2.2800 +proof-
2.2801 + { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
2.2802 + hence "l \<in> s"
2.2803 + proof(cases "\<forall>n. x n \<noteq> l")
2.2804 + case False thus "l\<in>s" using as(1) by auto
2.2805 + next
2.2806 + case True note cas = this
2.2807 + with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
2.2808 + then obtain l' where "l'\<in>s" "l' islimpt {y. \<exists>n. y = x n}" using assms[THEN spec[where x="{y. \<exists>n. y = x n}"]] as(1) by auto
2.2809 + thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
2.2810 + qed }
2.2811 + thus ?thesis unfolding closed_sequential_limits by fast
2.2812 +qed
2.2813 +
2.2814 +text{* Hence express everything as an equivalence. *}
2.2815 +
2.2816 +lemma compact_eq_heine_borel:
2.2817 + fixes s :: "'a::heine_borel set"
2.2818 + shows "compact s \<longleftrightarrow>
2.2819 + (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
2.2820 + --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))" (is "?lhs = ?rhs")
2.2821 +proof
2.2822 + assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
2.2823 +next
2.2824 + assume ?rhs
2.2825 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
2.2826 + by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
2.2827 + thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
2.2828 +qed
2.2829 +
2.2830 +lemma compact_eq_bolzano_weierstrass:
2.2831 + fixes s :: "'a::heine_borel set"
2.2832 + shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
2.2833 +proof
2.2834 + assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
2.2835 +next
2.2836 + assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
2.2837 +qed
2.2838 +
2.2839 +lemma compact_eq_bounded_closed:
2.2840 + fixes s :: "'a::heine_borel set"
2.2841 + shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
2.2842 +proof
2.2843 + assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
2.2844 +next
2.2845 + assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
2.2846 +qed
2.2847 +
2.2848 +lemma compact_imp_bounded:
2.2849 + fixes s :: "'a::metric_space set"
2.2850 + shows "compact s ==> bounded s"
2.2851 +proof -
2.2852 + assume "compact s"
2.2853 + hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
2.2854 + by (rule compact_imp_heine_borel)
2.2855 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
2.2856 + using heine_borel_imp_bolzano_weierstrass[of s] by auto
2.2857 + thus "bounded s"
2.2858 + by (rule bolzano_weierstrass_imp_bounded)
2.2859 +qed
2.2860 +
2.2861 +lemma compact_imp_closed:
2.2862 + fixes s :: "'a::metric_space set"
2.2863 + shows "compact s ==> closed s"
2.2864 +proof -
2.2865 + assume "compact s"
2.2866 + hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
2.2867 + by (rule compact_imp_heine_borel)
2.2868 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
2.2869 + using heine_borel_imp_bolzano_weierstrass[of s] by auto
2.2870 + thus "closed s"
2.2871 + by (rule bolzano_weierstrass_imp_closed)
2.2872 +qed
2.2873 +
2.2874 +text{* In particular, some common special cases. *}
2.2875 +
2.2876 +lemma compact_empty[simp]:
2.2877 + "compact {}"
2.2878 + unfolding compact_def
2.2879 + by simp
2.2880 +
2.2881 +(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
2.2882 +
2.2883 + (* FIXME : Rename *)
2.2884 +lemma compact_union[intro]:
2.2885 + fixes s t :: "'a::heine_borel set"
2.2886 + shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
2.2887 + unfolding compact_eq_bounded_closed
2.2888 + using bounded_Un[of s t]
2.2889 + using closed_Un[of s t]
2.2890 + by simp
2.2891 +
2.2892 +lemma compact_inter[intro]:
2.2893 + fixes s t :: "'a::heine_borel set"
2.2894 + shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
2.2895 + unfolding compact_eq_bounded_closed
2.2896 + using bounded_Int[of s t]
2.2897 + using closed_Int[of s t]
2.2898 + by simp
2.2899 +
2.2900 +lemma compact_inter_closed[intro]:
2.2901 + fixes s t :: "'a::heine_borel set"
2.2902 + shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
2.2903 + unfolding compact_eq_bounded_closed
2.2904 + using closed_Int[of s t]
2.2905 + using bounded_subset[of "s \<inter> t" s]
2.2906 + by blast
2.2907 +
2.2908 +lemma closed_inter_compact[intro]:
2.2909 + fixes s t :: "'a::heine_borel set"
2.2910 + shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
2.2911 +proof-
2.2912 + assume "closed s" "compact t"
2.2913 + moreover
2.2914 + have "s \<inter> t = t \<inter> s" by auto ultimately
2.2915 + show ?thesis
2.2916 + using compact_inter_closed[of t s]
2.2917 + by auto
2.2918 +qed
2.2919 +
2.2920 +lemma closed_sing [simp]:
2.2921 + fixes a :: "'a::metric_space"
2.2922 + shows "closed {a}"
2.2923 + apply (clarsimp simp add: closed_def open_dist)
2.2924 + apply (rule ccontr)
2.2925 + apply (drule_tac x="dist x a" in spec)
2.2926 + apply (simp add: dist_nz dist_commute)
2.2927 + done
2.2928 +
2.2929 +lemma finite_imp_closed:
2.2930 + fixes s :: "'a::metric_space set"
2.2931 + shows "finite s ==> closed s"
2.2932 +proof (induct set: finite)
2.2933 + case empty show "closed {}" by simp
2.2934 +next
2.2935 + case (insert x F)
2.2936 + hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
2.2937 + thus "closed (insert x F)" by simp
2.2938 +qed
2.2939 +
2.2940 +lemma finite_imp_compact:
2.2941 + fixes s :: "'a::heine_borel set"
2.2942 + shows "finite s ==> compact s"
2.2943 + unfolding compact_eq_bounded_closed
2.2944 + using finite_imp_closed finite_imp_bounded
2.2945 + by blast
2.2946 +
2.2947 +lemma compact_sing [simp]: "compact {a}"
2.2948 + unfolding compact_def o_def subseq_def
2.2949 + by (auto simp add: tendsto_const)
2.2950 +
2.2951 +lemma compact_cball[simp]:
2.2952 + fixes x :: "'a::heine_borel"
2.2953 + shows "compact(cball x e)"
2.2954 + using compact_eq_bounded_closed bounded_cball closed_cball
2.2955 + by blast
2.2956 +
2.2957 +lemma compact_frontier_bounded[intro]:
2.2958 + fixes s :: "'a::heine_borel set"
2.2959 + shows "bounded s ==> compact(frontier s)"
2.2960 + unfolding frontier_def
2.2961 + using compact_eq_bounded_closed
2.2962 + by blast
2.2963 +
2.2964 +lemma compact_frontier[intro]:
2.2965 + fixes s :: "'a::heine_borel set"
2.2966 + shows "compact s ==> compact (frontier s)"
2.2967 + using compact_eq_bounded_closed compact_frontier_bounded
2.2968 + by blast
2.2969 +
2.2970 +lemma frontier_subset_compact:
2.2971 + fixes s :: "'a::heine_borel set"
2.2972 + shows "compact s ==> frontier s \<subseteq> s"
2.2973 + using frontier_subset_closed compact_eq_bounded_closed
2.2974 + by blast
2.2975 +
2.2976 +lemma open_delete:
2.2977 + fixes s :: "'a::metric_space set"
2.2978 + shows "open s ==> open(s - {x})"
2.2979 + using open_Diff[of s "{x}"] closed_sing
2.2980 + by blast
2.2981 +
2.2982 +text{* Finite intersection property. I could make it an equivalence in fact. *}
2.2983 +
2.2984 +lemma compact_imp_fip:
2.2985 + fixes s :: "'a::heine_borel set"
2.2986 + assumes "compact s" "\<forall>t \<in> f. closed t"
2.2987 + "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
2.2988 + shows "s \<inter> (\<Inter> f) \<noteq> {}"
2.2989 +proof
2.2990 + assume as:"s \<inter> (\<Inter> f) = {}"
2.2991 + hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
2.2992 + moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
2.2993 + ultimately obtain f' where f':"f' \<subseteq> op - UNIV ` f" "finite f'" "s \<subseteq> \<Union>f'" using assms(1)[unfolded compact_eq_heine_borel, THEN spec[where x="(\<lambda>t. UNIV - t) ` f"]] by auto
2.2994 + hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
2.2995 + hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
2.2996 + thus False using f'(3) unfolding subset_eq and Union_iff by blast
2.2997 +qed
2.2998 +
2.2999 +subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
2.3000 +
2.3001 +lemma bounded_closed_nest:
2.3002 + assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
2.3003 + "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
2.3004 + shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
2.3005 +proof-
2.3006 + from assms(2) obtain x where x:"\<forall>n::nat. x n \<in> s n" using choice[of "\<lambda>n x. x\<in> s n"] by auto
2.3007 + from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
2.3008 +
2.3009 + then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
2.3010 + unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
2.3011 +
2.3012 + { fix n::nat
2.3013 + { fix e::real assume "e>0"
2.3014 + with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
2.3015 + hence "dist ((x \<circ> r) (max N n)) l < e" by auto
2.3016 + moreover
2.3017 + have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
2.3018 + hence "(x \<circ> r) (max N n) \<in> s n"
2.3019 + using x apply(erule_tac x=n in allE)
2.3020 + using x apply(erule_tac x="r (max N n)" in allE)
2.3021 + using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
2.3022 + ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
2.3023 + }
2.3024 + hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
2.3025 + }
2.3026 + thus ?thesis by auto
2.3027 +qed
2.3028 +
2.3029 +text{* Decreasing case does not even need compactness, just completeness. *}
2.3030 +
2.3031 +lemma decreasing_closed_nest:
2.3032 + assumes "\<forall>n. closed(s n)"
2.3033 + "\<forall>n. (s n \<noteq> {})"
2.3034 + "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
2.3035 + "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
2.3036 + shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
2.3037 +proof-
2.3038 + have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
2.3039 + hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
2.3040 + then obtain t where t: "\<forall>n. t n \<in> s n" by auto
2.3041 + { fix e::real assume "e>0"
2.3042 + then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
2.3043 + { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
2.3044 + hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
2.3045 + hence "dist (t m) (t n) < e" using N by auto
2.3046 + }
2.3047 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
2.3048 + }
2.3049 + hence "Cauchy t" unfolding cauchy_def by auto
2.3050 + then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
2.3051 + { fix n::nat
2.3052 + { fix e::real assume "e>0"
2.3053 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
2.3054 + have "t (max n N) \<in> s n" using assms(3) unfolding subset_eq apply(erule_tac x=n in allE) apply (erule_tac x="max n N" in allE) using t by auto
2.3055 + hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
2.3056 + }
2.3057 + hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
2.3058 + }
2.3059 + then show ?thesis by auto
2.3060 +qed
2.3061 +
2.3062 +text{* Strengthen it to the intersection actually being a singleton. *}
2.3063 +
2.3064 +lemma decreasing_closed_nest_sing:
2.3065 + assumes "\<forall>n. closed(s n)"
2.3066 + "\<forall>n. s n \<noteq> {}"
2.3067 + "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
2.3068 + "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
2.3069 + shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
2.3070 +proof-
2.3071 + obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
2.3072 + { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
2.3073 + { fix e::real assume "e>0"
2.3074 + hence "dist a b < e" using assms(4 )using b using a by blast
2.3075 + }
2.3076 + hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
2.3077 + }
2.3078 + with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
2.3079 + thus ?thesis by auto
2.3080 +qed
2.3081 +
2.3082 +text{* Cauchy-type criteria for uniform convergence. *}
2.3083 +
2.3084 +lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
2.3085 + "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
2.3086 + (\<forall>e>0. \<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e)" (is "?lhs = ?rhs")
2.3087 +proof(rule)
2.3088 + assume ?lhs
2.3089 + then obtain l where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e" by auto
2.3090 + { fix e::real assume "e>0"
2.3091 + then obtain N::nat where N:"\<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e / 2" using l[THEN spec[where x="e/2"]] by auto
2.3092 + { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
2.3093 + hence "dist (s m x) (s n x) < e"
2.3094 + using N[THEN spec[where x=m], THEN spec[where x=x]]
2.3095 + using N[THEN spec[where x=n], THEN spec[where x=x]]
2.3096 + using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
2.3097 + hence "\<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e" by auto }
2.3098 + thus ?rhs by auto
2.3099 +next
2.3100 + assume ?rhs
2.3101 + hence "\<forall>x. P x \<longrightarrow> Cauchy (\<lambda>n. s n x)" unfolding cauchy_def apply auto by (erule_tac x=e in allE)auto
2.3102 + then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
2.3103 + using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
2.3104 + { fix e::real assume "e>0"
2.3105 + then obtain N where N:"\<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x \<longrightarrow> dist (s m x) (s n x) < e/2"
2.3106 + using `?rhs`[THEN spec[where x="e/2"]] by auto
2.3107 + { fix x assume "P x"
2.3108 + then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
2.3109 + using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
2.3110 + fix n::nat assume "n\<ge>N"
2.3111 + hence "dist(s n x)(l x) < e" using `P x`and N[THEN spec[where x=n], THEN spec[where x="N+M"], THEN spec[where x=x]]
2.3112 + using M[THEN spec[where x="N+M"]] and dist_triangle_half_l[of "s n x" "s (N+M) x" e "l x"] by (auto simp add: dist_commute) }
2.3113 + hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
2.3114 + thus ?lhs by auto
2.3115 +qed
2.3116 +
2.3117 +lemma uniformly_cauchy_imp_uniformly_convergent:
2.3118 + fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
2.3119 + assumes "\<forall>e>0.\<exists>N. \<forall>m (n::nat) x. N \<le> m \<and> N \<le> n \<and> P x --> dist(s m x)(s n x) < e"
2.3120 + "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
2.3121 + shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
2.3122 +proof-
2.3123 + obtain l' where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l' x) < e"
2.3124 + using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
2.3125 + moreover
2.3126 + { fix x assume "P x"
2.3127 + hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
2.3128 + using l and assms(2) unfolding Lim_sequentially by blast }
2.3129 + ultimately show ?thesis by auto
2.3130 +qed
2.3131 +
2.3132 +subsection{* Define continuity over a net to take in restrictions of the set. *}
2.3133 +
2.3134 +definition
2.3135 + continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
2.3136 + "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
2.3137 +
2.3138 +lemma continuous_trivial_limit:
2.3139 + "trivial_limit net ==> continuous net f"
2.3140 + unfolding continuous_def tendsto_def trivial_limit_eq by auto
2.3141 +
2.3142 +lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
2.3143 + unfolding continuous_def
2.3144 + unfolding tendsto_def
2.3145 + using netlimit_within[of x s]
2.3146 + by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
2.3147 +
2.3148 +lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
2.3149 + using continuous_within [of x UNIV f] by (simp add: within_UNIV)
2.3150 +
2.3151 +lemma continuous_at_within:
2.3152 + assumes "continuous (at x) f" shows "continuous (at x within s) f"
2.3153 + using assms unfolding continuous_at continuous_within
2.3154 + by (rule Lim_at_within)
2.3155 +
2.3156 +text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
2.3157 +
2.3158 +lemma continuous_within_eps_delta:
2.3159 + "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. \<forall>x'\<in> s. dist x' x < d --> dist (f x') (f x) < e)"
2.3160 + unfolding continuous_within and Lim_within
2.3161 + apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
2.3162 +
2.3163 +lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
2.3164 + \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
2.3165 + using continuous_within_eps_delta[of x UNIV f]
2.3166 + unfolding within_UNIV by blast
2.3167 +
2.3168 +text{* Versions in terms of open balls. *}
2.3169 +
2.3170 +lemma continuous_within_ball:
2.3171 + "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
2.3172 + f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
2.3173 +proof
2.3174 + assume ?lhs
2.3175 + { fix e::real assume "e>0"
2.3176 + then obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
2.3177 + using `?lhs`[unfolded continuous_within Lim_within] by auto
2.3178 + { fix y assume "y\<in>f ` (ball x d \<inter> s)"
2.3179 + hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
2.3180 + apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
2.3181 + }
2.3182 + hence "\<exists>d>0. f ` (ball x d \<inter> s) \<subseteq> ball (f x) e" using `d>0` unfolding subset_eq ball_def by (auto simp add: dist_commute) }
2.3183 + thus ?rhs by auto
2.3184 +next
2.3185 + assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
2.3186 + apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
2.3187 +qed
2.3188 +
2.3189 +lemma continuous_at_ball:
2.3190 + "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
2.3191 +proof
2.3192 + assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
2.3193 + apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x=xa in allE) apply (auto simp add: dist_commute dist_nz)
2.3194 + unfolding dist_nz[THEN sym] by auto
2.3195 +next
2.3196 + assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
2.3197 + apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x="f xa" in allE) by (auto simp add: dist_commute dist_nz)
2.3198 +qed
2.3199 +
2.3200 +text{* For setwise continuity, just start from the epsilon-delta definitions. *}
2.3201 +
2.3202 +definition
2.3203 + continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
2.3204 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d::real>0. \<forall>x' \<in> s. dist x' x < d --> dist (f x') (f x) < e)"
2.3205 +
2.3206 +
2.3207 +definition
2.3208 + uniformly_continuous_on ::
2.3209 + "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
2.3210 + "uniformly_continuous_on s f \<longleftrightarrow>
2.3211 + (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
2.3212 + --> dist (f x') (f x) < e)"
2.3213 +
2.3214 +text{* Some simple consequential lemmas. *}
2.3215 +
2.3216 +lemma uniformly_continuous_imp_continuous:
2.3217 + " uniformly_continuous_on s f ==> continuous_on s f"
2.3218 + unfolding uniformly_continuous_on_def continuous_on_def by blast
2.3219 +
2.3220 +lemma continuous_at_imp_continuous_within:
2.3221 + "continuous (at x) f ==> continuous (at x within s) f"
2.3222 + unfolding continuous_within continuous_at using Lim_at_within by auto
2.3223 +
2.3224 +lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
2.3225 + shows "continuous_on s f"
2.3226 +proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
2.3227 + fix x and e::real assume "x\<in>s" "e>0"
2.3228 + hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
2.3229 + then obtain d where d:"d>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" unfolding eventually_at by auto
2.3230 + { fix x' assume "\<not> 0 < dist x' x"
2.3231 + hence "x=x'"
2.3232 + using dist_nz[of x' x] by auto
2.3233 + hence "dist (f x') (f x) < e" using `e>0` by auto
2.3234 + }
2.3235 + thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
2.3236 +qed
2.3237 +
2.3238 +lemma continuous_on_eq_continuous_within:
2.3239 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
2.3240 +proof
2.3241 + assume ?rhs
2.3242 + { fix x assume "x\<in>s"
2.3243 + fix e::real assume "e>0"
2.3244 + assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
2.3245 + then obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" by auto
2.3246 + { fix x' assume as:"x'\<in>s" "dist x' x < d"
2.3247 + hence "dist (f x') (f x) < e" using `e>0` d `x'\<in>s` dist_eq_0_iff[of x' x] zero_le_dist[of x' x] as(2) by (metis dist_eq_0_iff dist_nz) }
2.3248 + hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
2.3249 + }
2.3250 + thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
2.3251 +next
2.3252 + assume ?lhs
2.3253 + thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
2.3254 +qed
2.3255 +
2.3256 +lemma continuous_on:
2.3257 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
2.3258 + by (auto simp add: continuous_on_eq_continuous_within continuous_within)
2.3259 +
2.3260 +lemma continuous_on_eq_continuous_at:
2.3261 + "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
2.3262 + by (auto simp add: continuous_on continuous_at Lim_within_open)
2.3263 +
2.3264 +lemma continuous_within_subset:
2.3265 + "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
2.3266 + ==> continuous (at x within t) f"
2.3267 + unfolding continuous_within by(metis Lim_within_subset)
2.3268 +
2.3269 +lemma continuous_on_subset:
2.3270 + "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
2.3271 + unfolding continuous_on by (metis subset_eq Lim_within_subset)
2.3272 +
2.3273 +lemma continuous_on_interior:
2.3274 + "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
2.3275 +unfolding interior_def
2.3276 +apply simp
2.3277 +by (meson continuous_on_eq_continuous_at continuous_on_subset)
2.3278 +
2.3279 +lemma continuous_on_eq:
2.3280 + "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
2.3281 + ==> continuous_on s g"
2.3282 + by (simp add: continuous_on_def)
2.3283 +
2.3284 +text{* Characterization of various kinds of continuity in terms of sequences. *}
2.3285 +
2.3286 +(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
2.3287 +lemma continuous_within_sequentially:
2.3288 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
2.3289 + shows "continuous (at a within s) f \<longleftrightarrow>
2.3290 + (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
2.3291 + --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
2.3292 +proof
2.3293 + assume ?lhs
2.3294 + { fix x::"nat \<Rightarrow> 'a" assume x:"\<forall>n. x n \<in> s" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (x n) a < e"
2.3295 + fix e::real assume "e>0"
2.3296 + from `?lhs` obtain d where "d>0" and d:"\<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e" unfolding continuous_within Lim_within using `e>0` by auto
2.3297 + from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
2.3298 + hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
2.3299 + apply(rule_tac x=N in exI) using N d apply auto using x(1)
2.3300 + apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
2.3301 + apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
2.3302 + }
2.3303 + thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
2.3304 +next
2.3305 + assume ?rhs
2.3306 + { fix e::real assume "e>0"
2.3307 + assume "\<not> (\<exists>d>0. \<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e)"
2.3308 + hence "\<forall>d. \<exists>x. d>0 \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)" by blast
2.3309 + then obtain x where x:"\<forall>d>0. x d \<in> s \<and> (0 < dist (x d) a \<and> dist (x d) a < d \<and> \<not> dist (f (x d)) (f a) < e)"
2.3310 + using choice[of "\<lambda>d x.0<d \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)"] by auto
2.3311 + { fix d::real assume "d>0"
2.3312 + hence "\<exists>N::nat. inverse (real (N + 1)) < d" using real_arch_inv[of d] by (auto, rule_tac x="n - 1" in exI)auto
2.3313 + then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
2.3314 + { fix n::nat assume n:"n\<ge>N"
2.3315 + hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
2.3316 + moreover have "inverse (real (n + 1)) < d" using N n by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
2.3317 + ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
2.3318 + }
2.3319 + hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
2.3320 + }
2.3321 + hence "(\<forall>n::nat. x (inverse (real (n + 1))) \<in> s) \<and> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < e)" using x by auto
2.3322 + hence "\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (f (x (inverse (real (n + 1))))) (f a) < e" using `?rhs`[THEN spec[where x="\<lambda>n::nat. x (inverse (real (n+1)))"], unfolded Lim_sequentially] by auto
2.3323 + hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
2.3324 + }
2.3325 + thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
2.3326 +qed
2.3327 +
2.3328 +lemma continuous_at_sequentially:
2.3329 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
2.3330 + shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
2.3331 + --> ((f o x) ---> f a) sequentially)"
2.3332 + using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
2.3333 +
2.3334 +lemma continuous_on_sequentially:
2.3335 + "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
2.3336 + --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
2.3337 +proof
2.3338 + assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
2.3339 +next
2.3340 + assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
2.3341 +qed
2.3342 +
2.3343 +lemma uniformly_continuous_on_sequentially:
2.3344 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
2.3345 + shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
2.3346 + ((\<lambda>n. x n - y n) ---> 0) sequentially
2.3347 + \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
2.3348 +proof
2.3349 + assume ?lhs
2.3350 + { fix x y assume x:"\<forall>n. x n \<in> s" and y:"\<forall>n. y n \<in> s" and xy:"((\<lambda>n. x n - y n) ---> 0) sequentially"
2.3351 + { fix e::real assume "e>0"
2.3352 + then obtain d where "d>0" and d:"\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
2.3353 + using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
2.3354 + obtain N where N:"\<forall>n\<ge>N. norm (x n - y n - 0) < d" using xy[unfolded Lim_sequentially dist_norm] and `d>0` by auto
2.3355 + { fix n assume "n\<ge>N"
2.3356 + hence "norm (f (x n) - f (y n) - 0) < e"
2.3357 + using N[THEN spec[where x=n]] using d[THEN bspec[where x="x n"], THEN bspec[where x="y n"]] using x and y
2.3358 + unfolding dist_commute and dist_norm by simp }
2.3359 + hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
2.3360 + hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
2.3361 + thus ?rhs by auto
2.3362 +next
2.3363 + assume ?rhs
2.3364 + { assume "\<not> ?lhs"
2.3365 + then obtain e where "e>0" "\<forall>d>0. \<exists>x\<in>s. \<exists>x'\<in>s. dist x' x < d \<and> \<not> dist (f x') (f x) < e" unfolding uniformly_continuous_on_def by auto
2.3366 + then obtain fa where fa:"\<forall>x. 0 < x \<longrightarrow> fst (fa x) \<in> s \<and> snd (fa x) \<in> s \<and> dist (fst (fa x)) (snd (fa x)) < x \<and> \<not> dist (f (fst (fa x))) (f (snd (fa x))) < e"
2.3367 + using choice[of "\<lambda>d x. d>0 \<longrightarrow> fst x \<in> s \<and> snd x \<in> s \<and> dist (snd x) (fst x) < d \<and> \<not> dist (f (snd x)) (f (fst x)) < e"] unfolding Bex_def
2.3368 + by (auto simp add: dist_commute)
2.3369 + def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
2.3370 + def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
2.3371 + have xyn:"\<forall>n. x n \<in> s \<and> y n \<in> s" and xy0:"\<forall>n. dist (x n) (y n) < inverse (real n + 1)" and fxy:"\<forall>n. \<not> dist (f (x n)) (f (y n)) < e"
2.3372 + unfolding x_def and y_def using fa by auto
2.3373 + have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
2.3374 + have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
2.3375 + { fix e::real assume "e>0"
2.3376 + then obtain N::nat where "N \<noteq> 0" and N:"0 < inverse (real N) \<and> inverse (real N) < e" unfolding real_arch_inv[of e] by auto
2.3377 + { fix n::nat assume "n\<ge>N"
2.3378 + hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
2.3379 + also have "\<dots> < e" using N by auto
2.3380 + finally have "inverse (real n + 1) < e" by auto
2.3381 + hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
2.3382 + hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
2.3383 + hence "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f (x n) - f (y n)) 0 < e" using `?rhs`[THEN spec[where x=x], THEN spec[where x=y]] and xyn unfolding Lim_sequentially by auto
2.3384 + hence False unfolding 2 using fxy and `e>0` by auto }
2.3385 + thus ?lhs unfolding uniformly_continuous_on_def by blast
2.3386 +qed
2.3387 +
2.3388 +text{* The usual transformation theorems. *}
2.3389 +
2.3390 +lemma continuous_transform_within:
2.3391 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
2.3392 + assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
2.3393 + "continuous (at x within s) f"
2.3394 + shows "continuous (at x within s) g"
2.3395 +proof-
2.3396 + { fix e::real assume "e>0"
2.3397 + then obtain d' where d':"d'>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(4) unfolding continuous_within Lim_within by auto
2.3398 + { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
2.3399 + hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
2.3400 + hence "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
2.3401 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto }
2.3402 + hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
2.3403 + thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
2.3404 +qed
2.3405 +
2.3406 +lemma continuous_transform_at:
2.3407 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
2.3408 + assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
2.3409 + "continuous (at x) f"
2.3410 + shows "continuous (at x) g"
2.3411 +proof-
2.3412 + { fix e::real assume "e>0"
2.3413 + then obtain d' where d':"d'>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(3) unfolding continuous_at Lim_at by auto
2.3414 + { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
2.3415 + hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
2.3416 + }
2.3417 + hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
2.3418 + hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto
2.3419 + }
2.3420 + hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
2.3421 + thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
2.3422 +qed
2.3423 +
2.3424 +text{* Combination results for pointwise continuity. *}
2.3425 +
2.3426 +lemma continuous_const: "continuous net (\<lambda>x. c)"
2.3427 + by (auto simp add: continuous_def Lim_const)
2.3428 +
2.3429 +lemma continuous_cmul:
2.3430 + fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
2.3431 + shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
2.3432 + by (auto simp add: continuous_def Lim_cmul)
2.3433 +
2.3434 +lemma continuous_neg:
2.3435 + fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
2.3436 + shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
2.3437 + by (auto simp add: continuous_def Lim_neg)
2.3438 +
2.3439 +lemma continuous_add:
2.3440 + fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
2.3441 + shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
2.3442 + by (auto simp add: continuous_def Lim_add)
2.3443 +
2.3444 +lemma continuous_sub:
2.3445 + fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
2.3446 + shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
2.3447 + by (auto simp add: continuous_def Lim_sub)
2.3448 +
2.3449 +text{* Same thing for setwise continuity. *}
2.3450 +
2.3451 +lemma continuous_on_const:
2.3452 + "continuous_on s (\<lambda>x. c)"
2.3453 + unfolding continuous_on_eq_continuous_within using continuous_const by blast
2.3454 +
2.3455 +lemma continuous_on_cmul:
2.3456 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3457 + shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
2.3458 + unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
2.3459 +
2.3460 +lemma continuous_on_neg:
2.3461 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3462 + shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
2.3463 + unfolding continuous_on_eq_continuous_within using continuous_neg by blast
2.3464 +
2.3465 +lemma continuous_on_add:
2.3466 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3467 + shows "continuous_on s f \<Longrightarrow> continuous_on s g
2.3468 + \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
2.3469 + unfolding continuous_on_eq_continuous_within using continuous_add by blast
2.3470 +
2.3471 +lemma continuous_on_sub:
2.3472 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3473 + shows "continuous_on s f \<Longrightarrow> continuous_on s g
2.3474 + \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
2.3475 + unfolding continuous_on_eq_continuous_within using continuous_sub by blast
2.3476 +
2.3477 +text{* Same thing for uniform continuity, using sequential formulations. *}
2.3478 +
2.3479 +lemma uniformly_continuous_on_const:
2.3480 + "uniformly_continuous_on s (\<lambda>x. c)"
2.3481 + unfolding uniformly_continuous_on_def by simp
2.3482 +
2.3483 +lemma uniformly_continuous_on_cmul:
2.3484 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
2.3485 + (* FIXME: generalize 'a to metric_space *)
2.3486 + assumes "uniformly_continuous_on s f"
2.3487 + shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
2.3488 +proof-
2.3489 + { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
2.3490 + hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
2.3491 + using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
2.3492 + unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
2.3493 + }
2.3494 + thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
2.3495 +qed
2.3496 +
2.3497 +lemma dist_minus:
2.3498 + fixes x y :: "'a::real_normed_vector"
2.3499 + shows "dist (- x) (- y) = dist x y"
2.3500 + unfolding dist_norm minus_diff_minus norm_minus_cancel ..
2.3501 +
2.3502 +lemma uniformly_continuous_on_neg:
2.3503 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3504 + shows "uniformly_continuous_on s f
2.3505 + ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
2.3506 + unfolding uniformly_continuous_on_def dist_minus .
2.3507 +
2.3508 +lemma uniformly_continuous_on_add:
2.3509 + fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
2.3510 + assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
2.3511 + shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
2.3512 +proof-
2.3513 + { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
2.3514 + "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
2.3515 + hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
2.3516 + using Lim_add[of "\<lambda> n. f (x n) - f (y n)" 0 sequentially "\<lambda> n. g (x n) - g (y n)" 0] by auto
2.3517 + hence "((\<lambda>n. f (x n) + g (x n) - (f (y n) + g (y n))) ---> 0) sequentially" unfolding Lim_sequentially and add_diff_add [symmetric] by auto }
2.3518 + thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
2.3519 +qed
2.3520 +
2.3521 +lemma uniformly_continuous_on_sub:
2.3522 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
2.3523 + shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
2.3524 + ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
2.3525 + unfolding ab_diff_minus
2.3526 + using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
2.3527 + using uniformly_continuous_on_neg[of s g] by auto
2.3528 +
2.3529 +text{* Identity function is continuous in every sense. *}
2.3530 +
2.3531 +lemma continuous_within_id:
2.3532 + "continuous (at a within s) (\<lambda>x. x)"
2.3533 + unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
2.3534 +
2.3535 +lemma continuous_at_id:
2.3536 + "continuous (at a) (\<lambda>x. x)"
2.3537 + unfolding continuous_at by (rule Lim_ident_at)
2.3538 +
2.3539 +lemma continuous_on_id:
2.3540 + "continuous_on s (\<lambda>x. x)"
2.3541 + unfolding continuous_on Lim_within by auto
2.3542 +
2.3543 +lemma uniformly_continuous_on_id:
2.3544 + "uniformly_continuous_on s (\<lambda>x. x)"
2.3545 + unfolding uniformly_continuous_on_def by auto
2.3546 +
2.3547 +text{* Continuity of all kinds is preserved under composition. *}
2.3548 +
2.3549 +lemma continuous_within_compose:
2.3550 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3551 + fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
2.3552 + assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
2.3553 + shows "continuous (at x within s) (g o f)"
2.3554 +proof-
2.3555 + { fix e::real assume "e>0"
2.3556 + with assms(2)[unfolded continuous_within Lim_within] obtain d where "d>0" and d:"\<forall>xa\<in>f ` s. 0 < dist xa (f x) \<and> dist xa (f x) < d \<longrightarrow> dist (g xa) (g (f x)) < e" by auto
2.3557 + from assms(1)[unfolded continuous_within Lim_within] obtain d' where "d'>0" and d':"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < d" using `d>0` by auto
2.3558 + { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
2.3559 + hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
2.3560 + hence "dist (g (f y)) (g (f x)) < e" using as(1) d[THEN bspec[where x="f y"]] unfolding dist_nz[THEN sym] using `e>0` by auto }
2.3561 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (g (f xa)) (g (f x)) < e" using `d'>0` by auto }
2.3562 + thus ?thesis unfolding continuous_within Lim_within by auto
2.3563 +qed
2.3564 +
2.3565 +lemma continuous_at_compose:
2.3566 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3567 + fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
2.3568 + assumes "continuous (at x) f" "continuous (at (f x)) g"
2.3569 + shows "continuous (at x) (g o f)"
2.3570 +proof-
2.3571 + have " continuous (at (f x) within range f) g" using assms(2) using continuous_within_subset[of "f x" UNIV g "range f", unfolded within_UNIV] by auto
2.3572 + thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
2.3573 +qed
2.3574 +
2.3575 +lemma continuous_on_compose:
2.3576 + "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
2.3577 + unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
2.3578 +
2.3579 +lemma uniformly_continuous_on_compose:
2.3580 + assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
2.3581 + shows "uniformly_continuous_on s (g o f)"
2.3582 +proof-
2.3583 + { fix e::real assume "e>0"
2.3584 + then obtain d where "d>0" and d:"\<forall>x\<in>f ` s. \<forall>x'\<in>f ` s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using assms(2) unfolding uniformly_continuous_on_def by auto
2.3585 + obtain d' where "d'>0" "\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d' \<longrightarrow> dist (f x') (f x) < d" using `d>0` using assms(1) unfolding uniformly_continuous_on_def by auto
2.3586 + hence "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist ((g \<circ> f) x') ((g \<circ> f) x) < e" using `d>0` using d by auto }
2.3587 + thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
2.3588 +qed
2.3589 +
2.3590 +text{* Continuity in terms of open preimages. *}
2.3591 +
2.3592 +lemma continuous_at_open:
2.3593 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3594 + shows "continuous (at x) f \<longleftrightarrow> (\<forall>t. open t \<and> f x \<in> t --> (\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x' \<in> s. (f x') \<in> t)))" (is "?lhs = ?rhs")
2.3595 +proof
2.3596 + assume ?lhs
2.3597 + { fix t assume as: "open t" "f x \<in> t"
2.3598 + then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
2.3599 +
2.3600 + obtain d where "d>0" and d:"\<forall>y. 0 < dist y x \<and> dist y x < d \<longrightarrow> dist (f y) (f x) < e" using `e>0` using `?lhs`[unfolded continuous_at Lim_at open_dist] by auto
2.3601 +
2.3602 + have "open (ball x d)" using open_ball by auto
2.3603 + moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
2.3604 + moreover
2.3605 + { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
2.3606 + using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
2.3607 + unfolding mem_ball apply (auto simp add: dist_commute)
2.3608 + unfolding dist_nz[THEN sym] using as(2) by auto }
2.3609 + hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
2.3610 + ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
2.3611 + apply(rule_tac x="ball x d" in exI) by simp }
2.3612 + thus ?rhs by auto
2.3613 +next
2.3614 + assume ?rhs
2.3615 + { fix e::real assume "e>0"
2.3616 + then obtain s where s: "open s" "x \<in> s" "\<forall>x'\<in>s. f x' \<in> ball (f x) e" using `?rhs`[unfolded continuous_at Lim_at, THEN spec[where x="ball (f x) e"]]
2.3617 + unfolding centre_in_ball[of "f x" e, THEN sym] by auto
2.3618 + then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
2.3619 + { fix y assume "0 < dist y x \<and> dist y x < d"
2.3620 + hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
2.3621 + using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
2.3622 + hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `d>0` by auto }
2.3623 + thus ?lhs unfolding continuous_at Lim_at by auto
2.3624 +qed
2.3625 +
2.3626 +lemma continuous_on_open:
2.3627 + "continuous_on s f \<longleftrightarrow>
2.3628 + (\<forall>t. openin (subtopology euclidean (f ` s)) t
2.3629 + --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
2.3630 +proof
2.3631 + assume ?lhs
2.3632 + { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
2.3633 + have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
2.3634 + moreover
2.3635 + { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
2.3636 + then obtain e where e: "e>0" "\<forall>x'\<in>f ` s. dist x' (f x) < e \<longrightarrow> x' \<in> t" using as[unfolded openin_euclidean_subtopology_iff, THEN conjunct2, THEN bspec[where x="f x"]] by auto
2.3637 + from this(1) obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `?lhs`[unfolded continuous_on Lim_within, THEN bspec[where x=x]] using as' by auto
2.3638 + have "\<exists>e>0. \<forall>x'\<in>s. dist x' x < e \<longrightarrow> x' \<in> {x \<in> s. f x \<in> t}" using d e unfolding dist_nz[THEN sym] by (rule_tac x=d in exI, auto) }
2.3639 + ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
2.3640 + thus ?rhs unfolding continuous_on Lim_within using openin by auto
2.3641 +next
2.3642 + assume ?rhs
2.3643 + { fix e::real and x assume "x\<in>s" "e>0"
2.3644 + { fix xa x' assume "dist (f xa) (f x) < e" "xa \<in> s" "x' \<in> s" "dist (f xa) (f x') < e - dist (f xa) (f x)"
2.3645 + hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
2.3646 + by (auto simp add: dist_commute) }
2.3647 + hence "ball (f x) e \<inter> f ` s \<subseteq> f ` s \<and> (\<forall>xa\<in>ball (f x) e \<inter> f ` s. \<exists>ea>0. \<forall>x'\<in>f ` s. dist x' xa < ea \<longrightarrow> x' \<in> ball (f x) e \<inter> f ` s)" apply auto
2.3648 + apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
2.3649 + hence "\<forall>xa\<in>{xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}. \<exists>ea>0. \<forall>x'\<in>s. dist x' xa < ea \<longrightarrow> x' \<in> {xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}"
2.3650 + using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
2.3651 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" apply(erule_tac x=x in ballE) apply auto using `e>0` `x\<in>s` by (auto simp add: dist_commute) }
2.3652 + thus ?lhs unfolding continuous_on Lim_within by auto
2.3653 +qed
2.3654 +
2.3655 +(* ------------------------------------------------------------------------- *)
2.3656 +(* Similarly in terms of closed sets. *)
2.3657 +(* ------------------------------------------------------------------------- *)
2.3658 +
2.3659 +lemma continuous_on_closed:
2.3660 + "continuous_on s f \<longleftrightarrow> (\<forall>t. closedin (subtopology euclidean (f ` s)) t --> closedin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
2.3661 +proof
2.3662 + assume ?lhs
2.3663 + { fix t
2.3664 + have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
2.3665 + have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
2.3666 + assume as:"closedin (subtopology euclidean (f ` s)) t"
2.3667 + hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
2.3668 + hence "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?lhs`[unfolded continuous_on_open, THEN spec[where x="(f ` s) - t"]]
2.3669 + unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
2.3670 + thus ?rhs by auto
2.3671 +next
2.3672 + assume ?rhs
2.3673 + { fix t
2.3674 + have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
2.3675 + assume as:"openin (subtopology euclidean (f ` s)) t"
2.3676 + hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
2.3677 + unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
2.3678 + thus ?lhs unfolding continuous_on_open by auto
2.3679 +qed
2.3680 +
2.3681 +text{* Half-global and completely global cases. *}
2.3682 +
2.3683 +lemma continuous_open_in_preimage:
2.3684 + assumes "continuous_on s f" "open t"
2.3685 + shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
2.3686 +proof-
2.3687 + have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
2.3688 + have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
2.3689 + using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
2.3690 + thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
2.3691 +qed
2.3692 +
2.3693 +lemma continuous_closed_in_preimage:
2.3694 + assumes "continuous_on s f" "closed t"
2.3695 + shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
2.3696 +proof-
2.3697 + have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
2.3698 + have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
2.3699 + using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
2.3700 + thus ?thesis
2.3701 + using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
2.3702 +qed
2.3703 +
2.3704 +lemma continuous_open_preimage:
2.3705 + assumes "continuous_on s f" "open s" "open t"
2.3706 + shows "open {x \<in> s. f x \<in> t}"
2.3707 +proof-
2.3708 + obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
2.3709 + using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
2.3710 + thus ?thesis using open_Int[of s T, OF assms(2)] by auto
2.3711 +qed
2.3712 +
2.3713 +lemma continuous_closed_preimage:
2.3714 + assumes "continuous_on s f" "closed s" "closed t"
2.3715 + shows "closed {x \<in> s. f x \<in> t}"
2.3716 +proof-
2.3717 + obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
2.3718 + using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
2.3719 + thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
2.3720 +qed
2.3721 +
2.3722 +lemma continuous_open_preimage_univ:
2.3723 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3724 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
2.3725 + using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
2.3726 +
2.3727 +lemma continuous_closed_preimage_univ:
2.3728 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3729 + shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
2.3730 + using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
2.3731 +
2.3732 +lemma continuous_open_vimage:
2.3733 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3734 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
2.3735 + unfolding vimage_def by (rule continuous_open_preimage_univ)
2.3736 +
2.3737 +lemma continuous_closed_vimage:
2.3738 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3739 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
2.3740 + unfolding vimage_def by (rule continuous_closed_preimage_univ)
2.3741 +
2.3742 +text{* Equality of continuous functions on closure and related results. *}
2.3743 +
2.3744 +lemma continuous_closed_in_preimage_constant:
2.3745 + "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
2.3746 + using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
2.3747 +
2.3748 +lemma continuous_closed_preimage_constant:
2.3749 + "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
2.3750 + using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
2.3751 +
2.3752 +lemma continuous_constant_on_closure:
2.3753 + assumes "continuous_on (closure s) f"
2.3754 + "\<forall>x \<in> s. f x = a"
2.3755 + shows "\<forall>x \<in> (closure s). f x = a"
2.3756 + using continuous_closed_preimage_constant[of "closure s" f a]
2.3757 + assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
2.3758 +
2.3759 +lemma image_closure_subset:
2.3760 + assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
2.3761 + shows "f ` (closure s) \<subseteq> t"
2.3762 +proof-
2.3763 + have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
2.3764 + moreover have "closed {x \<in> closure s. f x \<in> t}"
2.3765 + using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
2.3766 + ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
2.3767 + using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
2.3768 + thus ?thesis by auto
2.3769 +qed
2.3770 +
2.3771 +lemma continuous_on_closure_norm_le:
2.3772 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.3773 + assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
2.3774 + shows "norm(f x) \<le> b"
2.3775 +proof-
2.3776 + have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
2.3777 + show ?thesis
2.3778 + using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
2.3779 + unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
2.3780 +qed
2.3781 +
2.3782 +text{* Making a continuous function avoid some value in a neighbourhood. *}
2.3783 +
2.3784 +lemma continuous_within_avoid:
2.3785 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3786 + assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
2.3787 + shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
2.3788 +proof-
2.3789 + obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < dist (f x) a"
2.3790 + using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
2.3791 + { fix y assume " y\<in>s" "dist x y < d"
2.3792 + hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
2.3793 + apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
2.3794 + thus ?thesis using `d>0` by auto
2.3795 +qed
2.3796 +
2.3797 +lemma continuous_at_avoid:
2.3798 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
2.3799 + assumes "continuous (at x) f" "f x \<noteq> a"
2.3800 + shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
2.3801 +using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
2.3802 +
2.3803 +lemma continuous_on_avoid:
2.3804 + assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
2.3805 + shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
2.3806 +using assms(1)[unfolded continuous_on_eq_continuous_within, THEN bspec[where x=x], OF assms(2)] continuous_within_avoid[of x s f a] assms(2,3) by auto
2.3807 +
2.3808 +lemma continuous_on_open_avoid:
2.3809 + assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
2.3810 + shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
2.3811 +using assms(1)[unfolded continuous_on_eq_continuous_at[OF assms(2)], THEN bspec[where x=x], OF assms(3)] continuous_at_avoid[of x f a] assms(3,4) by auto
2.3812 +
2.3813 +text{* Proving a function is constant by proving open-ness of level set. *}
2.3814 +
2.3815 +lemma continuous_levelset_open_in_cases:
2.3816 + "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
2.3817 + openin (subtopology euclidean s) {x \<in> s. f x = a}
2.3818 + ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
2.3819 +unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
2.3820 +
2.3821 +lemma continuous_levelset_open_in:
2.3822 + "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
2.3823 + openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
2.3824 + (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
2.3825 +using continuous_levelset_open_in_cases[of s f ]
2.3826 +by meson
2.3827 +
2.3828 +lemma continuous_levelset_open:
2.3829 + assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
2.3830 + shows "\<forall>x \<in> s. f x = a"
2.3831 +using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
2.3832 +
2.3833 +text{* Some arithmetical combinations (more to prove). *}
2.3834 +
2.3835 +lemma open_scaling[intro]:
2.3836 + fixes s :: "'a::real_normed_vector set"
2.3837 + assumes "c \<noteq> 0" "open s"
2.3838 + shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
2.3839 +proof-
2.3840 + { fix x assume "x \<in> s"
2.3841 + then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> s" using assms(2)[unfolded open_dist, THEN bspec[where x=x]] by auto
2.3842 + have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
2.3843 + moreover
2.3844 + { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
2.3845 + hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
2.3846 + using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
2.3847 + assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
2.3848 + hence "y \<in> op *\<^sub>R c ` s" using rev_image_eqI[of "(1 / c) *\<^sub>R y" s y "op *\<^sub>R c"] e[THEN spec[where x="(1 / c) *\<^sub>R y"]] assms(1) unfolding dist_norm scaleR_scaleR by auto }
2.3849 + ultimately have "\<exists>e>0. \<forall>x'. dist x' (c *\<^sub>R x) < e \<longrightarrow> x' \<in> op *\<^sub>R c ` s" apply(rule_tac x="e * abs c" in exI) by auto }
2.3850 + thus ?thesis unfolding open_dist by auto
2.3851 +qed
2.3852 +
2.3853 +lemma minus_image_eq_vimage:
2.3854 + fixes A :: "'a::ab_group_add set"
2.3855 + shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
2.3856 + by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
2.3857 +
2.3858 +lemma open_negations:
2.3859 + fixes s :: "'a::real_normed_vector set"
2.3860 + shows "open s ==> open ((\<lambda> x. -x) ` s)"
2.3861 + unfolding scaleR_minus1_left [symmetric]
2.3862 + by (rule open_scaling, auto)
2.3863 +
2.3864 +lemma open_translation:
2.3865 + fixes s :: "'a::real_normed_vector set"
2.3866 + assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
2.3867 +proof-
2.3868 + { fix x have "continuous (at x) (\<lambda>x. x - a)" using continuous_sub[of "at x" "\<lambda>x. x" "\<lambda>x. a"] continuous_at_id[of x] continuous_const[of "at x" a] by auto }
2.3869 + moreover have "{x. x - a \<in> s} = op + a ` s" apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
2.3870 + ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
2.3871 +qed
2.3872 +
2.3873 +lemma open_affinity:
2.3874 + fixes s :: "'a::real_normed_vector set"
2.3875 + assumes "open s" "c \<noteq> 0"
2.3876 + shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
2.3877 +proof-
2.3878 + have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
2.3879 + have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
2.3880 + thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
2.3881 +qed
2.3882 +
2.3883 +lemma interior_translation:
2.3884 + fixes s :: "'a::real_normed_vector set"
2.3885 + shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
2.3886 +proof (rule set_ext, rule)
2.3887 + fix x assume "x \<in> interior (op + a ` s)"
2.3888 + then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
2.3889 + hence "ball (x - a) e \<subseteq> s" unfolding subset_eq Ball_def mem_ball dist_norm apply auto apply(erule_tac x="a + xa" in allE) unfolding ab_group_add_class.diff_diff_eq[THEN sym] by auto
2.3890 + thus "x \<in> op + a ` interior s" unfolding image_iff apply(rule_tac x="x - a" in bexI) unfolding mem_interior using `e > 0` by auto
2.3891 +next
2.3892 + fix x assume "x \<in> op + a ` interior s"
2.3893 + then obtain y e where "e>0" and e:"ball y e \<subseteq> s" and y:"x = a + y" unfolding image_iff Bex_def mem_interior by auto
2.3894 + { fix z have *:"a + y - z = y + a - z" by auto
2.3895 + assume "z\<in>ball x e"
2.3896 + hence "z - a \<in> s" using e[unfolded subset_eq, THEN bspec[where x="z - a"]] unfolding mem_ball dist_norm y ab_group_add_class.diff_diff_eq2 * by auto
2.3897 + hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
2.3898 + hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
2.3899 + thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
2.3900 +qed
2.3901 +
2.3902 +subsection {* Preservation of compactness and connectedness under continuous function. *}
2.3903 +
2.3904 +lemma compact_continuous_image:
2.3905 + assumes "continuous_on s f" "compact s"
2.3906 + shows "compact(f ` s)"
2.3907 +proof-
2.3908 + { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
2.3909 + then obtain y where y:"\<forall>n. y n \<in> s \<and> x n = f (y n)" unfolding image_iff Bex_def using choice[of "\<lambda>n xa. xa \<in> s \<and> x n = f xa"] by auto
2.3910 + then obtain l r where "l\<in>s" and r:"subseq r" and lr:"((y \<circ> r) ---> l) sequentially" using assms(2)[unfolded compact_def, THEN spec[where x=y]] by auto
2.3911 + { fix e::real assume "e>0"
2.3912 + then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' l < d \<longrightarrow> dist (f x') (f l) < e" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=l], OF `l\<in>s`] by auto
2.3913 + then obtain N::nat where N:"\<forall>n\<ge>N. dist ((y \<circ> r) n) l < d" using lr[unfolded Lim_sequentially, THEN spec[where x=d]] by auto
2.3914 + { fix n::nat assume "n\<ge>N" hence "dist ((x \<circ> r) n) (f l) < e" using N[THEN spec[where x=n]] d[THEN bspec[where x="y (r n)"]] y[THEN spec[where x="r n"]] by auto }
2.3915 + hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
2.3916 + hence "\<exists>l\<in>f ` s. \<exists>r. subseq r \<and> ((x \<circ> r) ---> l) sequentially" unfolding Lim_sequentially using r lr `l\<in>s` by auto }
2.3917 + thus ?thesis unfolding compact_def by auto
2.3918 +qed
2.3919 +
2.3920 +lemma connected_continuous_image:
2.3921 + assumes "continuous_on s f" "connected s"
2.3922 + shows "connected(f ` s)"
2.3923 +proof-
2.3924 + { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
2.3925 + have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
2.3926 + using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
2.3927 + using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
2.3928 + using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
2.3929 + hence False using as(1,2)
2.3930 + using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
2.3931 + thus ?thesis unfolding connected_clopen by auto
2.3932 +qed
2.3933 +
2.3934 +text{* Continuity implies uniform continuity on a compact domain. *}
2.3935 +
2.3936 +lemma compact_uniformly_continuous:
2.3937 + assumes "continuous_on s f" "compact s"
2.3938 + shows "uniformly_continuous_on s f"
2.3939 +proof-
2.3940 + { fix x assume x:"x\<in>s"
2.3941 + hence "\<forall>xa. \<exists>y. 0 < xa \<longrightarrow> (y > 0 \<and> (\<forall>x'\<in>s. dist x' x < y \<longrightarrow> dist (f x') (f x) < xa))" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=x]] by auto
2.3942 + hence "\<exists>fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)" using choice[of "\<lambda>e d. e>0 \<longrightarrow> d>0 \<and>(\<forall>x'\<in>s. (dist x' x < d \<longrightarrow> dist (f x') (f x) < e))"] by auto }
2.3943 + then have "\<forall>x\<in>s. \<exists>y. \<forall>xa. 0 < xa \<longrightarrow> (\<forall>x'\<in>s. y xa > 0 \<and> (dist x' x < y xa \<longrightarrow> dist (f x') (f x) < xa))" by auto
2.3944 + then obtain d where d:"\<forall>e>0. \<forall>x\<in>s. \<forall>x'\<in>s. d x e > 0 \<and> (dist x' x < d x e \<longrightarrow> dist (f x') (f x) < e)"
2.3945 + using bchoice[of s "\<lambda>x fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)"] by blast
2.3946 +
2.3947 + { fix e::real assume "e>0"
2.3948 +
2.3949 + { fix x assume "x\<in>s" hence "x \<in> ball x (d x (e / 2))" unfolding centre_in_ball using d[THEN spec[where x="e/2"]] using `e>0` by auto }
2.3950 + hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
2.3951 + moreover
2.3952 + { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
2.3953 + ultimately obtain ea where "ea>0" and ea:"\<forall>x\<in>s. \<exists>b\<in>{ball x (d x (e / 2)) |x. x \<in> s}. ball x ea \<subseteq> b" using heine_borel_lemma[OF assms(2), of "{ball x (d x (e / 2)) | x. x\<in>s }"] by auto
2.3954 +
2.3955 + { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
2.3956 + obtain z where "z\<in>s" and z:"ball x ea \<subseteq> ball z (d z (e / 2))" using ea[THEN bspec[where x=x]] and `x\<in>s` by auto
2.3957 + hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
2.3958 + hence "dist (f z) (f x) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `x\<in>s` and `z\<in>s`
2.3959 + by (auto simp add: dist_commute)
2.3960 + moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
2.3961 + by (auto simp add: dist_commute)
2.3962 + hence "dist (f z) (f y) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `y\<in>s` and `z\<in>s`
2.3963 + by (auto simp add: dist_commute)
2.3964 + ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
2.3965 + by (auto simp add: dist_commute) }
2.3966 + then have "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `ea>0` by auto }
2.3967 + thus ?thesis unfolding uniformly_continuous_on_def by auto
2.3968 +qed
2.3969 +
2.3970 +text{* Continuity of inverse function on compact domain. *}
2.3971 +
2.3972 +lemma continuous_on_inverse:
2.3973 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
2.3974 + (* TODO: can this be generalized more? *)
2.3975 + assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
2.3976 + shows "continuous_on (f ` s) g"
2.3977 +proof-
2.3978 + have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
2.3979 + { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
2.3980 + then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
2.3981 + have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
2.3982 + unfolding T(2) and Int_left_absorb by auto
2.3983 + moreover have "compact (s \<inter> T)"
2.3984 + using assms(2) unfolding compact_eq_bounded_closed
2.3985 + using bounded_subset[of s "s \<inter> T"] and T(1) by auto
2.3986 + ultimately have "closed (f ` t)" using T(1) unfolding T(2)
2.3987 + using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
2.3988 + moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
2.3989 + ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
2.3990 + unfolding closedin_closed by auto }
2.3991 + thus ?thesis unfolding continuous_on_closed by auto
2.3992 +qed
2.3993 +
2.3994 +subsection{* A uniformly convergent limit of continuous functions is continuous. *}
2.3995 +
2.3996 +lemma norm_triangle_lt:
2.3997 + fixes x y :: "'a::real_normed_vector"
2.3998 + shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
2.3999 +by (rule le_less_trans [OF norm_triangle_ineq])
2.4000 +
2.4001 +lemma continuous_uniform_limit:
2.4002 + fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
2.4003 + assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
2.4004 + "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
2.4005 + shows "continuous_on s g"
2.4006 +proof-
2.4007 + { fix x and e::real assume "x\<in>s" "e>0"
2.4008 + have "eventually (\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3) net" using `e>0` assms(3)[THEN spec[where x="e/3"]] by auto
2.4009 + then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
2.4010 + using eventually_and[of "(\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3)" "(\<lambda>n. continuous_on s (f n))" net] assms(1,2) eventually_happens by blast
2.4011 + have "e / 3 > 0" using `e>0` by auto
2.4012 + then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f n x') (f n x) < e / 3"
2.4013 + using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
2.4014 + { fix y assume "y\<in>s" "dist y x < d"
2.4015 + hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
2.4016 + hence "norm (f n y - g x) < 2 * e / 3" using norm_triangle_lt[of "f n y - f n x" "f n x - g x" "2*e/3"]
2.4017 + using n(1)[THEN bspec[where x=x], OF `x\<in>s`] unfolding dist_norm unfolding ab_group_add_class.ab_diff_minus by auto
2.4018 + hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
2.4019 + unfolding norm_minus_cancel[of "f n y - g y", THEN sym] using norm_triangle_lt[of "f n y - g x" "g y - f n y" e] by (auto simp add: uminus_add_conv_diff) }
2.4020 + hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
2.4021 + thus ?thesis unfolding continuous_on_def by auto
2.4022 +qed
2.4023 +
2.4024 +subsection{* Topological properties of linear functions. *}
2.4025 +
2.4026 +lemma linear_lim_0:
2.4027 + assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
2.4028 +proof-
2.4029 + interpret f: bounded_linear f by fact
2.4030 + have "(f ---> f 0) (at 0)"
2.4031 + using tendsto_ident_at by (rule f.tendsto)
2.4032 + thus ?thesis unfolding f.zero .
2.4033 +qed
2.4034 +
2.4035 +lemma linear_continuous_at:
2.4036 + assumes "bounded_linear f" shows "continuous (at a) f"
2.4037 + unfolding continuous_at using assms
2.4038 + apply (rule bounded_linear.tendsto)
2.4039 + apply (rule tendsto_ident_at)
2.4040 + done
2.4041 +
2.4042 +lemma linear_continuous_within:
2.4043 + shows "bounded_linear f ==> continuous (at x within s) f"
2.4044 + using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
2.4045 +
2.4046 +lemma linear_continuous_on:
2.4047 + shows "bounded_linear f ==> continuous_on s f"
2.4048 + using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
2.4049 +
2.4050 +text{* Also bilinear functions, in composition form. *}
2.4051 +
2.4052 +lemma bilinear_continuous_at_compose:
2.4053 + shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
2.4054 + ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
2.4055 + unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
2.4056 +
2.4057 +lemma bilinear_continuous_within_compose:
2.4058 + shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
2.4059 + ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
2.4060 + unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
2.4061 +
2.4062 +lemma bilinear_continuous_on_compose:
2.4063 + shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
2.4064 + ==> continuous_on s (\<lambda>x. h (f x) (g x))"
2.4065 + unfolding continuous_on_eq_continuous_within apply auto apply(erule_tac x=x in ballE) apply auto apply(erule_tac x=x in ballE) apply auto
2.4066 + using bilinear_continuous_within_compose[of _ s f g h] by auto
2.4067 +
2.4068 +subsection{* Topological stuff lifted from and dropped to R *}
2.4069 +
2.4070 +
2.4071 +lemma open_real:
2.4072 + fixes s :: "real set" shows
2.4073 + "open s \<longleftrightarrow>
2.4074 + (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
2.4075 + unfolding open_dist dist_norm by simp
2.4076 +
2.4077 +lemma islimpt_approachable_real:
2.4078 + fixes s :: "real set"
2.4079 + shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
2.4080 + unfolding islimpt_approachable dist_norm by simp
2.4081 +
2.4082 +lemma closed_real:
2.4083 + fixes s :: "real set"
2.4084 + shows "closed s \<longleftrightarrow>
2.4085 + (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
2.4086 + --> x \<in> s)"
2.4087 + unfolding closed_limpt islimpt_approachable dist_norm by simp
2.4088 +
2.4089 +lemma continuous_at_real_range:
2.4090 + fixes f :: "'a::real_normed_vector \<Rightarrow> real"
2.4091 + shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
2.4092 + \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
2.4093 + unfolding continuous_at unfolding Lim_at
2.4094 + unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
2.4095 + apply(erule_tac x=e in allE) apply auto apply (rule_tac x=d in exI) apply auto apply (erule_tac x=x' in allE) apply auto
2.4096 + apply(erule_tac x=e in allE) by auto
2.4097 +
2.4098 +lemma continuous_on_real_range:
2.4099 + fixes f :: "'a::real_normed_vector \<Rightarrow> real"
2.4100 + shows "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d>0. (\<forall>x' \<in> s. norm(x' - x) < d --> abs(f x' - f x) < e))"
2.4101 + unfolding continuous_on_def dist_norm by simp
2.4102 +
2.4103 +lemma continuous_at_norm: "continuous (at x) norm"
2.4104 + unfolding continuous_at by (intro tendsto_intros)
2.4105 +
2.4106 +lemma continuous_on_norm: "continuous_on s norm"
2.4107 +unfolding continuous_on by (intro ballI tendsto_intros)
2.4108 +
2.4109 +lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
2.4110 +unfolding continuous_at by (intro tendsto_intros)
2.4111 +
2.4112 +lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
2.4113 +unfolding continuous_on by (intro ballI tendsto_intros)
2.4114 +
2.4115 +lemma continuous_at_infnorm: "continuous (at x) infnorm"
2.4116 + unfolding continuous_at Lim_at o_def unfolding dist_norm
2.4117 + apply auto apply (rule_tac x=e in exI) apply auto
2.4118 + using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
2.4119 +
2.4120 +text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
2.4121 +
2.4122 +lemma compact_attains_sup:
2.4123 + fixes s :: "real set"
2.4124 + assumes "compact s" "s \<noteq> {}"
2.4125 + shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
2.4126 +proof-
2.4127 + from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
2.4128 + { fix e::real assume as: "\<forall>x\<in>s. x \<le> rsup s" "rsup s \<notin> s" "0 < e" "\<forall>x'\<in>s. x' = rsup s \<or> \<not> rsup s - x' < e"
2.4129 + have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
2.4130 + moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
2.4131 + ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
2.4132 + thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
2.4133 + apply(rule_tac x="rsup s" in bexI) by auto
2.4134 +qed
2.4135 +
2.4136 +lemma compact_attains_inf:
2.4137 + fixes s :: "real set"
2.4138 + assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
2.4139 +proof-
2.4140 + from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
2.4141 + { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
2.4142 + "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
2.4143 + have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
2.4144 + moreover
2.4145 + { fix x assume "x \<in> s"
2.4146 + hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
2.4147 + have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
2.4148 + hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
2.4149 + ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
2.4150 + thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
2.4151 + apply(rule_tac x="rinf s" in bexI) by auto
2.4152 +qed
2.4153 +
2.4154 +lemma continuous_attains_sup:
2.4155 + fixes f :: "'a::metric_space \<Rightarrow> real"
2.4156 + shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
2.4157 + ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
2.4158 + using compact_attains_sup[of "f ` s"]
2.4159 + using compact_continuous_image[of s f] by auto
2.4160 +
2.4161 +lemma continuous_attains_inf:
2.4162 + fixes f :: "'a::metric_space \<Rightarrow> real"
2.4163 + shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
2.4164 + \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
2.4165 + using compact_attains_inf[of "f ` s"]
2.4166 + using compact_continuous_image[of s f] by auto
2.4167 +
2.4168 +lemma distance_attains_sup:
2.4169 + assumes "compact s" "s \<noteq> {}"
2.4170 + shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
2.4171 +proof (rule continuous_attains_sup [OF assms])
2.4172 + { fix x assume "x\<in>s"
2.4173 + have "(dist a ---> dist a x) (at x within s)"
2.4174 + by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
2.4175 + }
2.4176 + thus "continuous_on s (dist a)"
2.4177 + unfolding continuous_on ..
2.4178 +qed
2.4179 +
2.4180 +text{* For *minimal* distance, we only need closure, not compactness. *}
2.4181 +
2.4182 +lemma distance_attains_inf:
2.4183 + fixes a :: "'a::heine_borel"
2.4184 + assumes "closed s" "s \<noteq> {}"
2.4185 + shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
2.4186 +proof-
2.4187 + from assms(2) obtain b where "b\<in>s" by auto
2.4188 + let ?B = "cball a (dist b a) \<inter> s"
2.4189 + have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
2.4190 + hence "?B \<noteq> {}" by auto
2.4191 + moreover
2.4192 + { fix x assume "x\<in>?B"
2.4193 + fix e::real assume "e>0"
2.4194 + { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
2.4195 + from as have "\<bar>dist a x' - dist a x\<bar> < e"
2.4196 + unfolding abs_less_iff minus_diff_eq
2.4197 + using dist_triangle2 [of a x' x]
2.4198 + using dist_triangle [of a x x']
2.4199 + by arith
2.4200 + }
2.4201 + hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
2.4202 + using `e>0` by auto
2.4203 + }
2.4204 + hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
2.4205 + unfolding continuous_on Lim_within dist_norm real_norm_def
2.4206 + by fast
2.4207 + moreover have "compact ?B"
2.4208 + using compact_cball[of a "dist b a"]
2.4209 + unfolding compact_eq_bounded_closed
2.4210 + using bounded_Int and closed_Int and assms(1) by auto
2.4211 + ultimately obtain x where "x\<in>cball a (dist b a) \<inter> s" "\<forall>y\<in>cball a (dist b a) \<inter> s. dist a x \<le> dist a y"
2.4212 + using continuous_attains_inf[of ?B "dist a"] by fastsimp
2.4213 + thus ?thesis by fastsimp
2.4214 +qed
2.4215 +
2.4216 +subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
2.4217 +
2.4218 +lemma Lim_mul:
2.4219 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
2.4220 + assumes "(c ---> d) net" "(f ---> l) net"
2.4221 + shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
2.4222 + using assms by (rule scaleR.tendsto)
2.4223 +
2.4224 +lemma Lim_vmul:
2.4225 + fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
2.4226 + shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
2.4227 + by (intro tendsto_intros)
2.4228 +
2.4229 +lemma continuous_vmul:
2.4230 + fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
2.4231 + shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
2.4232 + unfolding continuous_def using Lim_vmul[of c] by auto
2.4233 +
2.4234 +lemma continuous_mul:
2.4235 + fixes c :: "'a::metric_space \<Rightarrow> real"
2.4236 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.4237 + shows "continuous net c \<Longrightarrow> continuous net f
2.4238 + ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
2.4239 + unfolding continuous_def by (intro tendsto_intros)
2.4240 +
2.4241 +lemma continuous_on_vmul:
2.4242 + fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
2.4243 + shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
2.4244 + unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
2.4245 +
2.4246 +lemma continuous_on_mul:
2.4247 + fixes c :: "'a::metric_space \<Rightarrow> real"
2.4248 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
2.4249 + shows "continuous_on s c \<Longrightarrow> continuous_on s f
2.4250 + ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
2.4251 + unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
2.4252 +
2.4253 +text{* And so we have continuity of inverse. *}
2.4254 +
2.4255 +lemma Lim_inv:
2.4256 + fixes f :: "'a \<Rightarrow> real"
2.4257 + assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
2.4258 + shows "((inverse o f) ---> inverse l) net"
2.4259 + unfolding o_def using assms by (rule tendsto_inverse)
2.4260 +
2.4261 +lemma continuous_inv:
2.4262 + fixes f :: "'a::metric_space \<Rightarrow> real"
2.4263 + shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
2.4264 + ==> continuous net (inverse o f)"
2.4265 + unfolding continuous_def using Lim_inv by auto
2.4266 +
2.4267 +lemma continuous_at_within_inv:
2.4268 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
2.4269 + assumes "continuous (at a within s) f" "f a \<noteq> 0"
2.4270 + shows "continuous (at a within s) (inverse o f)"
2.4271 + using assms unfolding continuous_within o_def
2.4272 + by (intro tendsto_intros)
2.4273 +
2.4274 +lemma continuous_at_inv:
2.4275 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
2.4276 + shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
2.4277 + ==> continuous (at a) (inverse o f) "
2.4278 + using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
2.4279 +
2.4280 +subsection{* Preservation properties for pasted sets. *}
2.4281 +
2.4282 +lemma bounded_pastecart:
2.4283 + fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
2.4284 + assumes "bounded s" "bounded t"
2.4285 + shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
2.4286 +proof-
2.4287 + obtain a b where ab:"\<forall>x\<in>s. norm x \<le> a" "\<forall>x\<in>t. norm x \<le> b" using assms[unfolded bounded_iff] by auto
2.4288 + { fix x y assume "x\<in>s" "y\<in>t"
2.4289 + hence "norm x \<le> a" "norm y \<le> b" using ab by auto
2.4290 + hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
2.4291 + thus ?thesis unfolding bounded_iff by auto
2.4292 +qed
2.4293 +
2.4294 +lemma bounded_Times:
2.4295 + assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
2.4296 +proof-
2.4297 + obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
2.4298 + using assms [unfolded bounded_def] by auto
2.4299 + then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
2.4300 + by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
2.4301 + thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
2.4302 +qed
2.4303 +
2.4304 +lemma closed_pastecart:
2.4305 + fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
2.4306 + assumes "closed s" "closed t"
2.4307 + shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
2.4308 +proof-
2.4309 + { fix x l assume as:"\<forall>n::nat. x n \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" "(x ---> l) sequentially"
2.4310 + { fix n::nat have "fstcart (x n) \<in> s" "sndcart (x n) \<in> t" using as(1)[THEN spec[where x=n]] by auto } note * = this
2.4311 + moreover
2.4312 + { fix e::real assume "e>0"
2.4313 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (x n) l < e" using as(2)[unfolded Lim_sequentially, THEN spec[where x=e]] by auto
2.4314 + { fix n::nat assume "n\<ge>N"
2.4315 + hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
2.4316 + using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
2.4317 + hence "\<exists>N. \<forall>n\<ge>N. dist (fstcart (x n)) (fstcart l) < e" "\<exists>N. \<forall>n\<ge>N. dist (sndcart (x n)) (sndcart l) < e" by auto }
2.4318 + ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
2.4319 + using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
2.4320 + using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
2.4321 + unfolding Lim_sequentially by auto
2.4322 + hence "l \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" using pastecart_fst_snd[THEN sym, of l] by auto }
2.4323 + thus ?thesis unfolding closed_sequential_limits by auto
2.4324 +qed
2.4325 +
2.4326 +lemma compact_pastecart:
2.4327 + fixes s t :: "(real ^ _) set"
2.4328 + shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
2.4329 + unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
2.4330 +
2.4331 +lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
2.4332 +by (induct x) simp
2.4333 +
2.4334 +lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
2.4335 +unfolding compact_def
2.4336 +apply clarify
2.4337 +apply (drule_tac x="fst \<circ> f" in spec)
2.4338 +apply (drule mp, simp add: mem_Times_iff)
2.4339 +apply (clarify, rename_tac l1 r1)
2.4340 +apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
2.4341 +apply (drule mp, simp add: mem_Times_iff)
2.4342 +apply (clarify, rename_tac l2 r2)
2.4343 +apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
2.4344 +apply (rule_tac x="r1 \<circ> r2" in exI)
2.4345 +apply (rule conjI, simp add: subseq_def)
2.4346 +apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
2.4347 +apply (drule (1) tendsto_Pair) back
2.4348 +apply (simp add: o_def)
2.4349 +done
2.4350 +
2.4351 +text{* Hence some useful properties follow quite easily. *}
2.4352 +
2.4353 +lemma compact_scaling:
2.4354 + fixes s :: "'a::real_normed_vector set"
2.4355 + assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
2.4356 +proof-
2.4357 + let ?f = "\<lambda>x. scaleR c x"
2.4358 + have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
2.4359 + show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
2.4360 + using linear_continuous_at[OF *] assms by auto
2.4361 +qed
2.4362 +
2.4363 +lemma compact_negations:
2.4364 + fixes s :: "'a::real_normed_vector set"
2.4365 + assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
2.4366 + using compact_scaling [OF assms, of "- 1"] by auto
2.4367 +
2.4368 +lemma compact_sums:
2.4369 + fixes s t :: "'a::real_normed_vector set"
2.4370 + assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
2.4371 +proof-
2.4372 + have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
2.4373 + apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
2.4374 + have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
2.4375 + unfolding continuous_on by (rule ballI) (intro tendsto_intros)
2.4376 + thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
2.4377 +qed
2.4378 +
2.4379 +lemma compact_differences:
2.4380 + fixes s t :: "'a::real_normed_vector set"
2.4381 + assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
2.4382 +proof-
2.4383 + have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
2.4384 + apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
2.4385 + thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
2.4386 +qed
2.4387 +
2.4388 +lemma compact_translation:
2.4389 + fixes s :: "'a::real_normed_vector set"
2.4390 + assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
2.4391 +proof-
2.4392 + have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
2.4393 + thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
2.4394 +qed
2.4395 +
2.4396 +lemma compact_affinity:
2.4397 + fixes s :: "'a::real_normed_vector set"
2.4398 + assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
2.4399 +proof-
2.4400 + have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
2.4401 + thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
2.4402 +qed
2.4403 +
2.4404 +text{* Hence we get the following. *}
2.4405 +
2.4406 +lemma compact_sup_maxdistance:
2.4407 + fixes s :: "'a::real_normed_vector set"
2.4408 + assumes "compact s" "s \<noteq> {}"
2.4409 + shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
2.4410 +proof-
2.4411 + have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
2.4412 + then obtain x where x:"x\<in>{x - y |x y. x \<in> s \<and> y \<in> s}" "\<forall>y\<in>{x - y |x y. x \<in> s \<and> y \<in> s}. norm y \<le> norm x"
2.4413 + using compact_differences[OF assms(1) assms(1)]
2.4414 + using distance_attains_sup[where 'a="'a", unfolded dist_norm, of "{x - y | x y . x\<in>s \<and> y\<in>s}" 0] by(auto simp add: norm_minus_cancel)
2.4415 + from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
2.4416 + thus ?thesis using x(2)[unfolded `x = a - b`] by blast
2.4417 +qed
2.4418 +
2.4419 +text{* We can state this in terms of diameter of a set. *}
2.4420 +
2.4421 +definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
2.4422 + (* TODO: generalize to class metric_space *)
2.4423 +
2.4424 +lemma diameter_bounded:
2.4425 + assumes "bounded s"
2.4426 + shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
2.4427 + "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
2.4428 +proof-
2.4429 + let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
2.4430 + obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
2.4431 + { fix x y assume "x \<in> s" "y \<in> s"
2.4432 + hence "norm (x - y) \<le> 2 * a" using norm_triangle_ineq[of x "-y", unfolded norm_minus_cancel] a[THEN bspec[where x=x]] a[THEN bspec[where x=y]] by (auto simp add: ring_simps) }
2.4433 + note * = this
2.4434 + { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
2.4435 + have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
2.4436 + have "norm(x - y) \<le> diameter s" unfolding diameter_def using `s\<noteq>{}` *[OF `x\<in>s` `y\<in>s`] `x\<in>s` `y\<in>s` isLubD1[OF lub] unfolding setle_def by auto }
2.4437 + moreover
2.4438 + { fix d::real assume "d>0" "d < diameter s"
2.4439 + hence "s\<noteq>{}" unfolding diameter_def by auto
2.4440 + hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
2.4441 + have "\<exists>d' \<in> ?D. d' > d"
2.4442 + proof(rule ccontr)
2.4443 + assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
2.4444 + hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
2.4445 + hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
2.4446 + thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
2.4447 + qed
2.4448 + hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
2.4449 + ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
2.4450 + "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
2.4451 +qed
2.4452 +
2.4453 +lemma diameter_bounded_bound:
2.4454 + "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
2.4455 + using diameter_bounded by blast
2.4456 +
2.4457 +lemma diameter_compact_attained:
2.4458 + fixes s :: "'a::real_normed_vector set"
2.4459 + assumes "compact s" "s \<noteq> {}"
2.4460 + shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
2.4461 +proof-
2.4462 + have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
2.4463 + then obtain x y where xys:"x\<in>s" "y\<in>s" and xy:"\<forall>u\<in>s. \<forall>v\<in>s. norm (u - v) \<le> norm (x - y)" using compact_sup_maxdistance[OF assms] by auto
2.4464 + hence "diameter s \<le> norm (x - y)" using rsup_le[of "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}" "norm (x - y)"]
2.4465 + unfolding setle_def and diameter_def by auto
2.4466 + thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
2.4467 +qed
2.4468 +
2.4469 +text{* Related results with closure as the conclusion. *}
2.4470 +
2.4471 +lemma closed_scaling:
2.4472 + fixes s :: "'a::real_normed_vector set"
2.4473 + assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
2.4474 +proof(cases "s={}")
2.4475 + case True thus ?thesis by auto
2.4476 +next
2.4477 + case False
2.4478 + show ?thesis
2.4479 + proof(cases "c=0")
2.4480 + have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
2.4481 + case True thus ?thesis apply auto unfolding * using closed_sing by auto
2.4482 + next
2.4483 + case False
2.4484 + { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
2.4485 + { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
2.4486 + using as(1)[THEN spec[where x=n]]
2.4487 + using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
2.4488 + }
2.4489 + moreover
2.4490 + { fix e::real assume "e>0"
2.4491 + hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
2.4492 + then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
2.4493 + using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
2.4494 + hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
2.4495 + unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
2.4496 + using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
2.4497 + hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
2.4498 + ultimately have "l \<in> scaleR c ` s"
2.4499 + using assms[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. scaleR (1/c) (x n)"], THEN spec[where x="scaleR (1/c) l"]]
2.4500 + unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
2.4501 + thus ?thesis unfolding closed_sequential_limits by fast
2.4502 + qed
2.4503 +qed
2.4504 +
2.4505 +lemma closed_negations:
2.4506 + fixes s :: "'a::real_normed_vector set"
2.4507 + assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
2.4508 + using closed_scaling[OF assms, of "- 1"] by simp
2.4509 +
2.4510 +lemma compact_closed_sums:
2.4511 + fixes s :: "'a::real_normed_vector set"
2.4512 + assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
2.4513 +proof-
2.4514 + let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
2.4515 + { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
2.4516 + from as(1) obtain f where f:"\<forall>n. x n = fst (f n) + snd (f n)" "\<forall>n. fst (f n) \<in> s" "\<forall>n. snd (f n) \<in> t"
2.4517 + using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
2.4518 + obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
2.4519 + using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
2.4520 + have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
2.4521 + using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
2.4522 + hence "l - l' \<in> t"
2.4523 + using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
2.4524 + using f(3) by auto
2.4525 + hence "l \<in> ?S" using `l' \<in> s` apply auto apply(rule_tac x=l' in exI) apply(rule_tac x="l - l'" in exI) by auto
2.4526 + }
2.4527 + thus ?thesis unfolding closed_sequential_limits by fast
2.4528 +qed
2.4529 +
2.4530 +lemma closed_compact_sums:
2.4531 + fixes s t :: "'a::real_normed_vector set"
2.4532 + assumes "closed s" "compact t"
2.4533 + shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
2.4534 +proof-
2.4535 + have "{x + y |x y. x \<in> t \<and> y \<in> s} = {x + y |x y. x \<in> s \<and> y \<in> t}" apply auto
2.4536 + apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
2.4537 + thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
2.4538 +qed
2.4539 +
2.4540 +lemma compact_closed_differences:
2.4541 + fixes s t :: "'a::real_normed_vector set"
2.4542 + assumes "compact s" "closed t"
2.4543 + shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
2.4544 +proof-
2.4545 + have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
2.4546 + apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
2.4547 + thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
2.4548 +qed
2.4549 +
2.4550 +lemma closed_compact_differences:
2.4551 + fixes s t :: "'a::real_normed_vector set"
2.4552 + assumes "closed s" "compact t"
2.4553 + shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
2.4554 +proof-
2.4555 + have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
2.4556 + apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
2.4557 + thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
2.4558 +qed
2.4559 +
2.4560 +lemma closed_translation:
2.4561 + fixes a :: "'a::real_normed_vector"
2.4562 + assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
2.4563 +proof-
2.4564 + have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
2.4565 + thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
2.4566 +qed
2.4567 +
2.4568 +lemma translation_UNIV:
2.4569 + fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
2.4570 + apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
2.4571 +
2.4572 +lemma translation_diff:
2.4573 + fixes a :: "'a::ab_group_add"
2.4574 + shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
2.4575 + by auto
2.4576 +
2.4577 +lemma closure_translation:
2.4578 + fixes a :: "'a::real_normed_vector"
2.4579 + shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
2.4580 +proof-
2.4581 + have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
2.4582 + apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
2.4583 + show ?thesis unfolding closure_interior translation_diff translation_UNIV
2.4584 + using interior_translation[of a "UNIV - s"] unfolding * by auto
2.4585 +qed
2.4586 +
2.4587 +lemma frontier_translation:
2.4588 + fixes a :: "'a::real_normed_vector"
2.4589 + shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
2.4590 + unfolding frontier_def translation_diff interior_translation closure_translation by auto
2.4591 +
2.4592 +subsection{* Separation between points and sets. *}
2.4593 +
2.4594 +lemma separate_point_closed:
2.4595 + fixes s :: "'a::heine_borel set"
2.4596 + shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
2.4597 +proof(cases "s = {}")
2.4598 + case True
2.4599 + thus ?thesis by(auto intro!: exI[where x=1])
2.4600 +next
2.4601 + case False
2.4602 + assume "closed s" "a \<notin> s"
2.4603 + then obtain x where "x\<in>s" "\<forall>y\<in>s. dist a x \<le> dist a y" using `s \<noteq> {}` distance_attains_inf [of s a] by blast
2.4604 + with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
2.4605 +qed
2.4606 +
2.4607 +lemma separate_compact_closed:
2.4608 + fixes s t :: "'a::{heine_borel, real_normed_vector} set"
2.4609 + (* TODO: does this generalize to heine_borel? *)
2.4610 + assumes "compact s" and "closed t" and "s \<inter> t = {}"
2.4611 + shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
2.4612 +proof-
2.4613 + have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
2.4614 + then obtain d where "d>0" and d:"\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. d \<le> dist 0 x"
2.4615 + using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
2.4616 + { fix x y assume "x\<in>s" "y\<in>t"
2.4617 + hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
2.4618 + hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
2.4619 + by (auto simp add: dist_commute)
2.4620 + hence "d \<le> dist x y" unfolding dist_norm by auto }
2.4621 + thus ?thesis using `d>0` by auto
2.4622 +qed
2.4623 +
2.4624 +lemma separate_closed_compact:
2.4625 + fixes s t :: "'a::{heine_borel, real_normed_vector} set"
2.4626 + assumes "closed s" and "compact t" and "s \<inter> t = {}"
2.4627 + shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
2.4628 +proof-
2.4629 + have *:"t \<inter> s = {}" using assms(3) by auto
2.4630 + show ?thesis using separate_compact_closed[OF assms(2,1) *]
2.4631 + apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
2.4632 + by (auto simp add: dist_commute)
2.4633 +qed
2.4634 +
2.4635 +(* A cute way of denoting open and closed intervals using overloading. *)
2.4636 +
2.4637 +lemma interval: fixes a :: "'a::ord^'n::finite" shows
2.4638 + "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
2.4639 + "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
2.4640 + by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
2.4641 +
2.4642 +lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
2.4643 + "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
2.4644 + "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
2.4645 + using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
2.4646 +
2.4647 +lemma mem_interval_1: fixes x :: "real^1" shows
2.4648 + "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
2.4649 + "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
2.4650 +by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
2.4651 +
2.4652 +lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
2.4653 + "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
2.4654 + "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
2.4655 +proof-
2.4656 + { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
2.4657 + hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
2.4658 + hence "a$i < b$i" by auto
2.4659 + hence False using as by auto }
2.4660 + moreover
2.4661 + { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
2.4662 + let ?x = "(1/2) *\<^sub>R (a + b)"
2.4663 + { fix i
2.4664 + have "a$i < b$i" using as[THEN spec[where x=i]] by auto
2.4665 + hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
2.4666 + unfolding vector_smult_component and vector_add_component
2.4667 + by (auto simp add: less_divide_eq_number_of1) }
2.4668 + hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
2.4669 + ultimately show ?th1 by blast
2.4670 +
2.4671 + { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
2.4672 + hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
2.4673 + hence "a$i \<le> b$i" by auto
2.4674 + hence False using as by auto }
2.4675 + moreover
2.4676 + { assume as:"\<forall>i. \<not> (b$i < a$i)"
2.4677 + let ?x = "(1/2) *\<^sub>R (a + b)"
2.4678 + { fix i
2.4679 + have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
2.4680 + hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
2.4681 + unfolding vector_smult_component and vector_add_component
2.4682 + by (auto simp add: less_divide_eq_number_of1) }
2.4683 + hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
2.4684 + ultimately show ?th2 by blast
2.4685 +qed
2.4686 +
2.4687 +lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
2.4688 + "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
2.4689 + "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
2.4690 + unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
2.4691 +
2.4692 +lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
2.4693 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
2.4694 + "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
2.4695 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
2.4696 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
2.4697 + unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
2.4698 + by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
2.4699 +
2.4700 +lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
2.4701 + "{a .. a} = {a} \<and> {a<..<a} = {}"
2.4702 +apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
2.4703 +apply (simp add: order_eq_iff)
2.4704 +apply (auto simp add: not_less less_imp_le)
2.4705 +done
2.4706 +
2.4707 +lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
2.4708 + "{a<..<b} \<subseteq> {a .. b}"
2.4709 +proof(simp add: subset_eq, rule)
2.4710 + fix x
2.4711 + assume x:"x \<in>{a<..<b}"
2.4712 + { fix i
2.4713 + have "a $ i \<le> x $ i"
2.4714 + using x order_less_imp_le[of "a$i" "x$i"]
2.4715 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
2.4716 + }
2.4717 + moreover
2.4718 + { fix i
2.4719 + have "x $ i \<le> b $ i"
2.4720 + using x order_less_imp_le[of "x$i" "b$i"]
2.4721 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
2.4722 + }
2.4723 + ultimately
2.4724 + show "a \<le> x \<and> x \<le> b"
2.4725 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
2.4726 +qed
2.4727 +
2.4728 +lemma subset_interval: fixes a :: "real^'n::finite" shows
2.4729 + "{c .. d} \<subseteq> {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
2.4730 + "{c .. d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i \<le> d$i) --> (\<forall>i. a$i < c$i \<and> d$i < b$i)" (is ?th2) and
2.4731 + "{c<..<d} \<subseteq> {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
2.4732 + "{c<..<d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i < d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th4)
2.4733 +proof-
2.4734 + show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
2.4735 + show ?th2 unfolding subset_eq and Ball_def and mem_interval by (auto intro: le_less_trans less_le_trans order_trans less_imp_le)
2.4736 + { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
2.4737 + hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
2.4738 + fix i
2.4739 + (** TODO combine the following two parts as done in the HOL_light version. **)
2.4740 + { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
2.4741 + assume as2: "a$i > c$i"
2.4742 + { fix j
2.4743 + have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
2.4744 + apply(cases "j=i") using as(2)[THEN spec[where x=j]]
2.4745 + by (auto simp add: less_divide_eq_number_of1 as2) }
2.4746 + hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
2.4747 + moreover
2.4748 + have "?x\<notin>{a .. b}"
2.4749 + unfolding mem_interval apply auto apply(rule_tac x=i in exI)
2.4750 + using as(2)[THEN spec[where x=i]] and as2
2.4751 + by (auto simp add: less_divide_eq_number_of1)
2.4752 + ultimately have False using as by auto }
2.4753 + hence "a$i \<le> c$i" by(rule ccontr)auto
2.4754 + moreover
2.4755 + { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
2.4756 + assume as2: "b$i < d$i"
2.4757 + { fix j
2.4758 + have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
2.4759 + apply(cases "j=i") using as(2)[THEN spec[where x=j]]
2.4760 + by (auto simp add: less_divide_eq_number_of1 as2) }
2.4761 + hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
2.4762 + moreover
2.4763 + have "?x\<notin>{a .. b}"
2.4764 + unfolding mem_interval apply auto apply(rule_tac x=i in exI)
2.4765 + using as(2)[THEN spec[where x=i]] and as2
2.4766 + by (auto simp add: less_divide_eq_number_of1)
2.4767 + ultimately have False using as by auto }
2.4768 + hence "b$i \<ge> d$i" by(rule ccontr)auto
2.4769 + ultimately
2.4770 + have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
2.4771 + } note part1 = this
2.4772 + thus ?th3 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
2.4773 + { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
2.4774 + fix i
2.4775 + from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
2.4776 + hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
2.4777 + thus ?th4 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
2.4778 +qed
2.4779 +
2.4780 +lemma disjoint_interval: fixes a::"real^'n::finite" shows
2.4781 + "{a .. b} \<inter> {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
2.4782 + "{a .. b} \<inter> {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
2.4783 + "{a<..<b} \<inter> {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
2.4784 + "{a<..<b} \<inter> {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)
2.4785 +proof-
2.4786 + let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
2.4787 + show ?th1 ?th2 ?th3 ?th4
2.4788 + unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
2.4789 + apply (auto elim!: allE[where x="?z"])
2.4790 + apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
2.4791 + done
2.4792 +qed
2.4793 +
2.4794 +lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
2.4795 + "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
2.4796 + unfolding expand_set_eq and Int_iff and mem_interval
2.4797 + by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
2.4798 +
2.4799 +(* Moved interval_open_subset_closed a bit upwards *)
2.4800 +
2.4801 +lemma open_interval_lemma: fixes x :: "real" shows
2.4802 + "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
2.4803 + by(rule_tac x="min (x - a) (b - x)" in exI, auto)
2.4804 +
2.4805 +lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
2.4806 +proof-
2.4807 + { fix x assume x:"x\<in>{a<..<b}"
2.4808 + { fix i
2.4809 + have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
2.4810 + using x[unfolded mem_interval, THEN spec[where x=i]]
2.4811 + using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
2.4812 +
2.4813 + hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
2.4814 + then obtain d where d:"\<forall>i. 0 < d i \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d i \<longrightarrow> a $ i < x' \<and> x' < b $ i)"
2.4815 + using bchoice[of "UNIV" "\<lambda>i d. d>0 \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d \<longrightarrow> a $ i < x' \<and> x' < b $ i)"] by auto
2.4816 +
2.4817 + let ?d = "Min (range d)"
2.4818 + have **:"finite (range d)" "range d \<noteq> {}" by auto
2.4819 + have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
2.4820 + moreover
2.4821 + { fix x' assume as:"dist x' x < ?d"
2.4822 + { fix i
2.4823 + have "\<bar>x'$i - x $ i\<bar> < d i"
2.4824 + using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
2.4825 + unfolding vector_minus_component and Min_gr_iff[OF **] by auto
2.4826 + hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
2.4827 + hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
2.4828 + ultimately have "\<exists>e>0. \<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a<..<b}" by (auto, rule_tac x="?d" in exI, simp)
2.4829 + }
2.4830 + thus ?thesis unfolding open_dist using open_interval_lemma by auto
2.4831 +qed
2.4832 +
2.4833 +lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
2.4834 +proof-
2.4835 + { fix x i assume as:"\<forall>e>0. \<exists>x'\<in>{a..b}. x' \<noteq> x \<and> dist x' x < e"(* and xab:"a$i > x$i \<or> b$i < x$i"*)
2.4836 + { assume xa:"a$i > x$i"
2.4837 + with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < a$i - x$i" by(erule_tac x="a$i - x$i" in allE)auto
2.4838 + hence False unfolding mem_interval and dist_norm
2.4839 + using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
2.4840 + } hence "a$i \<le> x$i" by(rule ccontr)auto
2.4841 + moreover
2.4842 + { assume xb:"b$i < x$i"
2.4843 + with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < x$i - b$i" by(erule_tac x="x$i - b$i" in allE)auto
2.4844 + hence False unfolding mem_interval and dist_norm
2.4845 + using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
2.4846 + } hence "x$i \<le> b$i" by(rule ccontr)auto
2.4847 + ultimately
2.4848 + have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
2.4849 + thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
2.4850 +qed
2.4851 +
2.4852 +lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
2.4853 + "interior {a .. b} = {a<..<b}" (is "?L = ?R")
2.4854 +proof(rule subset_antisym)
2.4855 + show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
2.4856 +next
2.4857 + { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
2.4858 + then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
2.4859 + then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a..b}" unfolding open_dist and subset_eq by auto
2.4860 + { fix i
2.4861 + have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
2.4862 + "dist (x + (e / 2) *\<^sub>R basis i) x < e"
2.4863 + unfolding dist_norm apply auto
2.4864 + unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
2.4865 + hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
2.4866 + "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
2.4867 + using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
2.4868 + and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
2.4869 + unfolding mem_interval by (auto elim!: allE[where x=i])
2.4870 + hence "a $ i < x $ i" and "x $ i < b $ i"
2.4871 + unfolding vector_minus_component and vector_add_component
2.4872 + unfolding vector_smult_component and basis_component using `e>0` by auto }
2.4873 + hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
2.4874 + thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
2.4875 +qed
2.4876 +
2.4877 +lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
2.4878 + "bounded {a .. b}"
2.4879 +proof-
2.4880 + let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
2.4881 + { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
2.4882 + { fix i
2.4883 + have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
2.4884 + hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
2.4885 + hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
2.4886 + thus ?thesis unfolding interval and bounded_iff by auto
2.4887 +qed
2.4888 +
2.4889 +lemma bounded_interval: fixes a :: "real^'n::finite" shows
2.4890 + "bounded {a .. b} \<and> bounded {a<..<b}"
2.4891 + using bounded_closed_interval[of a b]
2.4892 + using interval_open_subset_closed[of a b]
2.4893 + using bounded_subset[of "{a..b}" "{a<..<b}"]
2.4894 + by simp
2.4895 +
2.4896 +lemma not_interval_univ: fixes a :: "real^'n::finite" shows
2.4897 + "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
2.4898 + using bounded_interval[of a b]
2.4899 + by auto
2.4900 +
2.4901 +lemma compact_interval: fixes a :: "real^'n::finite" shows
2.4902 + "compact {a .. b}"
2.4903 + using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
2.4904 +
2.4905 +lemma open_interval_midpoint: fixes a :: "real^'n::finite"
2.4906 + assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
2.4907 +proof-
2.4908 + { fix i
2.4909 + have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
2.4910 + using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
2.4911 + unfolding vector_smult_component and vector_add_component
2.4912 + by(auto simp add: less_divide_eq_number_of1) }
2.4913 + thus ?thesis unfolding mem_interval by auto
2.4914 +qed
2.4915 +
2.4916 +lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
2.4917 + assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
2.4918 + shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
2.4919 +proof-
2.4920 + { fix i
2.4921 + have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
2.4922 + also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
2.4923 + using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
2.4924 + using x unfolding mem_interval apply simp
2.4925 + using y unfolding mem_interval apply simp
2.4926 + done
2.4927 + finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
2.4928 + moreover {
2.4929 + have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
2.4930 + also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
2.4931 + using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
2.4932 + using x unfolding mem_interval apply simp
2.4933 + using y unfolding mem_interval apply simp
2.4934 + done
2.4935 + finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
2.4936 + } ultimately have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i \<and> (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto }
2.4937 + thus ?thesis unfolding mem_interval by auto
2.4938 +qed
2.4939 +
2.4940 +lemma closure_open_interval: fixes a :: "real^'n::finite"
2.4941 + assumes "{a<..<b} \<noteq> {}"
2.4942 + shows "closure {a<..<b} = {a .. b}"
2.4943 +proof-
2.4944 + have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
2.4945 + let ?c = "(1 / 2) *\<^sub>R (a + b)"
2.4946 + { fix x assume as:"x \<in> {a .. b}"
2.4947 + def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
2.4948 + { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
2.4949 + have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
2.4950 + have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
2.4951 + x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
2.4952 + by (auto simp add: algebra_simps)
2.4953 + hence "f n < b" and "a < f n" using open_closed_interval_convex[OF open_interval_midpoint[OF assms] as *] unfolding f_def by auto
2.4954 + hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
2.4955 + moreover
2.4956 + { assume "\<not> (f ---> x) sequentially"
2.4957 + { fix e::real assume "e>0"
2.4958 + hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
2.4959 + then obtain N::nat where "inverse (real (N + 1)) < e" by auto
2.4960 + hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
2.4961 + hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
2.4962 + hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
2.4963 + unfolding Lim_sequentially by(auto simp add: dist_norm)
2.4964 + hence "(f ---> x) sequentially" unfolding f_def
2.4965 + using Lim_add[OF Lim_const, of "\<lambda>n::nat. (inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x)" 0 sequentially x]
2.4966 + using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
2.4967 + ultimately have "x \<in> closure {a<..<b}"
2.4968 + using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
2.4969 + thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
2.4970 +qed
2.4971 +
2.4972 +lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
2.4973 + assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
2.4974 +proof-
2.4975 + obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
2.4976 + def a \<equiv> "(\<chi> i. b+1)::real^'n"
2.4977 + { fix x assume "x\<in>s"
2.4978 + fix i
2.4979 + have "(-a)$i < x$i" and "x$i < a$i" using b[THEN bspec[where x=x], OF `x\<in>s`] and component_le_norm[of x i]
2.4980 + unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
2.4981 + }
2.4982 + thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
2.4983 +qed
2.4984 +
2.4985 +lemma bounded_subset_open_interval:
2.4986 + fixes s :: "(real ^ 'n::finite) set"
2.4987 + shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
2.4988 + by (auto dest!: bounded_subset_open_interval_symmetric)
2.4989 +
2.4990 +lemma bounded_subset_closed_interval_symmetric:
2.4991 + fixes s :: "(real ^ 'n::finite) set"
2.4992 + assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
2.4993 +proof-
2.4994 + obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
2.4995 + thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
2.4996 +qed
2.4997 +
2.4998 +lemma bounded_subset_closed_interval:
2.4999 + fixes s :: "(real ^ 'n::finite) set"
2.5000 + shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
2.5001 + using bounded_subset_closed_interval_symmetric[of s] by auto
2.5002 +
2.5003 +lemma frontier_closed_interval:
2.5004 + fixes a b :: "real ^ _"
2.5005 + shows "frontier {a .. b} = {a .. b} - {a<..<b}"
2.5006 + unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
2.5007 +
2.5008 +lemma frontier_open_interval:
2.5009 + fixes a b :: "real ^ _"
2.5010 + shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
2.5011 +proof(cases "{a<..<b} = {}")
2.5012 + case True thus ?thesis using frontier_empty by auto
2.5013 +next
2.5014 + case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
2.5015 +qed
2.5016 +
2.5017 +lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
2.5018 + assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
2.5019 + unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
2.5020 +
2.5021 +
2.5022 +(* Some special cases for intervals in R^1. *)
2.5023 +
2.5024 +lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
2.5025 + by (metis num1_eq_iff)
2.5026 +
2.5027 +lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
2.5028 + by auto (metis num1_eq_iff)
2.5029 +
2.5030 +lemma interval_cases_1: fixes x :: "real^1" shows
2.5031 + "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
2.5032 + by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
2.5033 +
2.5034 +lemma in_interval_1: fixes x :: "real^1" shows
2.5035 + "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
2.5036 + (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
2.5037 +by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
2.5038 +
2.5039 +lemma interval_eq_empty_1: fixes a :: "real^1" shows
2.5040 + "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
2.5041 + "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
2.5042 + unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
2.5043 +
2.5044 +lemma subset_interval_1: fixes a :: "real^1" shows
2.5045 + "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
2.5046 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
2.5047 + "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
2.5048 + dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
2.5049 + "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
2.5050 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
2.5051 + "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
2.5052 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
2.5053 + unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
2.5054 +
2.5055 +lemma eq_interval_1: fixes a :: "real^1" shows
2.5056 + "{a .. b} = {c .. d} \<longleftrightarrow>
2.5057 + dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
2.5058 + dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
2.5059 +using set_eq_subset[of "{a .. b}" "{c .. d}"]
2.5060 +using subset_interval_1(1)[of a b c d]
2.5061 +using subset_interval_1(1)[of c d a b]
2.5062 +by auto (* FIXME: slow *)
2.5063 +
2.5064 +lemma disjoint_interval_1: fixes a :: "real^1" shows
2.5065 + "{a .. b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b < dest_vec1 c \<or> dest_vec1 d < dest_vec1 a"
2.5066 + "{a .. b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
2.5067 + "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
2.5068 + "{a<..<b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
2.5069 + unfolding disjoint_interval and dest_vec1_def ex_1 by auto
2.5070 +
2.5071 +lemma open_closed_interval_1: fixes a :: "real^1" shows
2.5072 + "{a<..<b} = {a .. b} - {a, b}"
2.5073 + unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
2.5074 +
2.5075 +lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
2.5076 + unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
2.5077 +
2.5078 +(* Some stuff for half-infinite intervals too; FIXME: notation? *)
2.5079 +
2.5080 +lemma closed_interval_left: fixes b::"real^'n::finite"
2.5081 + shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
2.5082 +proof-
2.5083 + { fix i
2.5084 + fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. x $ i \<le> b $ i}. x' \<noteq> x \<and> dist x' x < e"
2.5085 + { assume "x$i > b$i"
2.5086 + then obtain y where "y $ i \<le> b $ i" "y \<noteq> x" "dist y x < x$i - b$i" using x[THEN spec[where x="x$i - b$i"]] by auto
2.5087 + hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
2.5088 + hence "x$i \<le> b$i" by(rule ccontr)auto }
2.5089 + thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
2.5090 +qed
2.5091 +
2.5092 +lemma closed_interval_right: fixes a::"real^'n::finite"
2.5093 + shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
2.5094 +proof-
2.5095 + { fix i
2.5096 + fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. a $ i \<le> x $ i}. x' \<noteq> x \<and> dist x' x < e"
2.5097 + { assume "a$i > x$i"
2.5098 + then obtain y where "a $ i \<le> y $ i" "y \<noteq> x" "dist y x < a$i - x$i" using x[THEN spec[where x="a$i - x$i"]] by auto
2.5099 + hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
2.5100 + hence "a$i \<le> x$i" by(rule ccontr)auto }
2.5101 + thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
2.5102 +qed
2.5103 +
2.5104 +subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
2.5105 +
2.5106 +definition "is_interval s \<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)"
2.5107 +
2.5108 +lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
2.5109 + have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
2.5110 + show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
2.5111 + by(meson real_le_trans le_less_trans less_le_trans *)+ qed
2.5112 +
2.5113 +lemma is_interval_empty:
2.5114 + "is_interval {}"
2.5115 + unfolding is_interval_def
2.5116 + by simp
2.5117 +
2.5118 +lemma is_interval_univ:
2.5119 + "is_interval UNIV"
2.5120 + unfolding is_interval_def
2.5121 + by simp
2.5122 +
2.5123 +subsection{* Closure of halfspaces and hyperplanes. *}
2.5124 +
2.5125 +lemma Lim_inner:
2.5126 + assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
2.5127 + by (intro tendsto_intros assms)
2.5128 +
2.5129 +lemma continuous_at_inner: "continuous (at x) (inner a)"
2.5130 + unfolding continuous_at by (intro tendsto_intros)
2.5131 +
2.5132 +lemma continuous_on_inner:
2.5133 + fixes s :: "'a::real_inner set"
2.5134 + shows "continuous_on s (inner a)"
2.5135 + unfolding continuous_on by (rule ballI) (intro tendsto_intros)
2.5136 +
2.5137 +lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
2.5138 +proof-
2.5139 + have "\<forall>x. continuous (at x) (inner a)"
2.5140 + unfolding continuous_at by (rule allI) (intro tendsto_intros)
2.5141 + hence "closed (inner a -` {..b})"
2.5142 + using closed_real_atMost by (rule continuous_closed_vimage)
2.5143 + moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
2.5144 + ultimately show ?thesis by simp
2.5145 +qed
2.5146 +
2.5147 +lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
2.5148 + using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
2.5149 +
2.5150 +lemma closed_hyperplane: "closed {x. inner a x = b}"
2.5151 +proof-
2.5152 + have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
2.5153 + thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
2.5154 +qed
2.5155 +
2.5156 +lemma closed_halfspace_component_le:
2.5157 + shows "closed {x::real^'n::finite. x$i \<le> a}"
2.5158 + using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
2.5159 +
2.5160 +lemma closed_halfspace_component_ge:
2.5161 + shows "closed {x::real^'n::finite. x$i \<ge> a}"
2.5162 + using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
2.5163 +
2.5164 +text{* Openness of halfspaces. *}
2.5165 +
2.5166 +lemma open_halfspace_lt: "open {x. inner a x < b}"
2.5167 +proof-
2.5168 + have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
2.5169 + thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
2.5170 +qed
2.5171 +
2.5172 +lemma open_halfspace_gt: "open {x. inner a x > b}"
2.5173 +proof-
2.5174 + have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
2.5175 + thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
2.5176 +qed
2.5177 +
2.5178 +lemma open_halfspace_component_lt:
2.5179 + shows "open {x::real^'n::finite. x$i < a}"
2.5180 + using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
2.5181 +
2.5182 +lemma open_halfspace_component_gt:
2.5183 + shows "open {x::real^'n::finite. x$i > a}"
2.5184 + using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
2.5185 +
2.5186 +text{* This gives a simple derivation of limit component bounds. *}
2.5187 +
2.5188 +lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
2.5189 + assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
2.5190 + shows "l$i \<le> b"
2.5191 +proof-
2.5192 + { fix x have "x \<in> {x::real^'n. inner (basis i) x \<le> b} \<longleftrightarrow> x$i \<le> b" unfolding inner_basis by auto } note * = this
2.5193 + show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
2.5194 + using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
2.5195 +qed
2.5196 +
2.5197 +lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
2.5198 + assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
2.5199 + shows "b \<le> l$i"
2.5200 +proof-
2.5201 + { fix x have "x \<in> {x::real^'n. inner (basis i) x \<ge> b} \<longleftrightarrow> x$i \<ge> b" unfolding inner_basis by auto } note * = this
2.5202 + show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
2.5203 + using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
2.5204 +qed
2.5205 +
2.5206 +lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
2.5207 + assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
2.5208 + shows "l$i = b"
2.5209 + using ev[unfolded order_eq_iff eventually_and] using Lim_component_ge[OF net, of b i] and Lim_component_le[OF net, of i b] by auto
2.5210 +
2.5211 +lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
2.5212 + "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
2.5213 + using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
2.5214 +
2.5215 +lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
2.5216 + "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
2.5217 + using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
2.5218 +
2.5219 +text{* Limits relative to a union. *}
2.5220 +
2.5221 +lemma eventually_within_Un:
2.5222 + "eventually P (net within (s \<union> t)) \<longleftrightarrow>
2.5223 + eventually P (net within s) \<and> eventually P (net within t)"
2.5224 + unfolding Limits.eventually_within
2.5225 + by (auto elim!: eventually_rev_mp)
2.5226 +
2.5227 +lemma Lim_within_union:
2.5228 + "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
2.5229 + (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
2.5230 + unfolding tendsto_def
2.5231 + by (auto simp add: eventually_within_Un)
2.5232 +
2.5233 +lemma continuous_on_union:
2.5234 + assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
2.5235 + shows "continuous_on (s \<union> t) f"
2.5236 + using assms unfolding continuous_on unfolding Lim_within_union
2.5237 + unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
2.5238 +
2.5239 +lemma continuous_on_cases:
2.5240 + assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
2.5241 + "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
2.5242 + shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
2.5243 +proof-
2.5244 + let ?h = "(\<lambda>x. if P x then f x else g x)"
2.5245 + have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
2.5246 + hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
2.5247 + moreover
2.5248 + have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
2.5249 + hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
2.5250 + ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
2.5251 +qed
2.5252 +
2.5253 +
2.5254 +text{* Some more convenient intermediate-value theorem formulations. *}
2.5255 +
2.5256 +lemma connected_ivt_hyperplane:
2.5257 + assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
2.5258 + shows "\<exists>z \<in> s. inner a z = b"
2.5259 +proof(rule ccontr)
2.5260 + assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
2.5261 + let ?A = "{x. inner a x < b}"
2.5262 + let ?B = "{x. inner a x > b}"
2.5263 + have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
2.5264 + moreover have "?A \<inter> ?B = {}" by auto
2.5265 + moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
2.5266 + ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
2.5267 +qed
2.5268 +
2.5269 +lemma connected_ivt_component: fixes x::"real^'n::finite" shows
2.5270 + "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)"
2.5271 + using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
2.5272 +
2.5273 +text{* Also more convenient formulations of monotone convergence. *}
2.5274 +
2.5275 +lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
2.5276 + assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
2.5277 + shows "\<exists>l. (s ---> l) sequentially"
2.5278 +proof-
2.5279 + obtain a where a:"\<forall>n. \<bar>dest_vec1 (s n)\<bar> \<le> a" using assms(1)[unfolded bounded_iff abs_dest_vec1] by auto
2.5280 + { fix m::nat
2.5281 + have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
2.5282 + apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
2.5283 + hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
2.5284 + then obtain l where "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<bar>dest_vec1 (s n) - l\<bar> < e" using convergent_bounded_monotone[OF a] unfolding monoseq_def by auto
2.5285 + thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
2.5286 + unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
2.5287 +qed
2.5288 +
2.5289 +subsection{* Basic homeomorphism definitions. *}
2.5290 +
2.5291 +definition "homeomorphism s t f g \<equiv>
2.5292 + (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
2.5293 + (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
2.5294 +
2.5295 +definition
2.5296 + homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
2.5297 + (infixr "homeomorphic" 60) where
2.5298 + homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
2.5299 +
2.5300 +lemma homeomorphic_refl: "s homeomorphic s"
2.5301 + unfolding homeomorphic_def
2.5302 + unfolding homeomorphism_def
2.5303 + using continuous_on_id
2.5304 + apply(rule_tac x = "(\<lambda>x. x)" in exI)
2.5305 + apply(rule_tac x = "(\<lambda>x. x)" in exI)
2.5306 + by blast
2.5307 +
2.5308 +lemma homeomorphic_sym:
2.5309 + "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
2.5310 +unfolding homeomorphic_def
2.5311 +unfolding homeomorphism_def
2.5312 +by blast (* FIXME: slow *)
2.5313 +
2.5314 +lemma homeomorphic_trans:
2.5315 + assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
2.5316 +proof-
2.5317 + obtain f1 g1 where fg1:"\<forall>x\<in>s. g1 (f1 x) = x" "f1 ` s = t" "continuous_on s f1" "\<forall>y\<in>t. f1 (g1 y) = y" "g1 ` t = s" "continuous_on t g1"
2.5318 + using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
2.5319 + obtain f2 g2 where fg2:"\<forall>x\<in>t. g2 (f2 x) = x" "f2 ` t = u" "continuous_on t f2" "\<forall>y\<in>u. f2 (g2 y) = y" "g2 ` u = t" "continuous_on u g2"
2.5320 + using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
2.5321 +
2.5322 + { fix x assume "x\<in>s" hence "(g1 \<circ> g2) ((f2 \<circ> f1) x) = x" using fg1(1)[THEN bspec[where x=x]] and fg2(1)[THEN bspec[where x="f1 x"]] and fg1(2) by auto }
2.5323 + moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
2.5324 + moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
2.5325 + moreover { fix y assume "y\<in>u" hence "(f2 \<circ> f1) ((g1 \<circ> g2) y) = y" using fg2(4)[THEN bspec[where x=y]] and fg1(4)[THEN bspec[where x="g2 y"]] and fg2(5) by auto }
2.5326 + moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
2.5327 + moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
2.5328 + ultimately show ?thesis unfolding homeomorphic_def homeomorphism_def apply(rule_tac x="f2 \<circ> f1" in exI) apply(rule_tac x="g1 \<circ> g2" in exI) by auto
2.5329 +qed
2.5330 +
2.5331 +lemma homeomorphic_minimal:
2.5332 + "s homeomorphic t \<longleftrightarrow>
2.5333 + (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
2.5334 + (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
2.5335 + continuous_on s f \<and> continuous_on t g)"
2.5336 +unfolding homeomorphic_def homeomorphism_def
2.5337 +apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
2.5338 +apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
2.5339 +unfolding image_iff
2.5340 +apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
2.5341 +apply auto apply(rule_tac x="g x" in bexI) apply auto
2.5342 +apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
2.5343 +apply auto apply(rule_tac x="f x" in bexI) by auto
2.5344 +
2.5345 +subsection{* Relatively weak hypotheses if a set is compact. *}
2.5346 +
2.5347 +definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
2.5348 +
2.5349 +lemma assumes "inj_on f s" "x\<in>s"
2.5350 + shows "inv_on f s (f x) = x"
2.5351 + using assms unfolding inj_on_def inv_on_def by auto
2.5352 +
2.5353 +lemma homeomorphism_compact:
2.5354 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
2.5355 + (* class constraint due to continuous_on_inverse *)
2.5356 + assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
2.5357 + shows "\<exists>g. homeomorphism s t f g"
2.5358 +proof-
2.5359 + def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
2.5360 + have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
2.5361 + { fix y assume "y\<in>t"
2.5362 + then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
2.5363 + hence "g (f x) = x" using g by auto
2.5364 + hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
2.5365 + hence g':"\<forall>x\<in>t. f (g x) = x" by auto
2.5366 + moreover
2.5367 + { fix x
2.5368 + have "x\<in>s \<Longrightarrow> x \<in> g ` t" using g[THEN bspec[where x=x]] unfolding image_iff using assms(3) by(auto intro!: bexI[where x="f x"])
2.5369 + moreover
2.5370 + { assume "x\<in>g ` t"
2.5371 + then obtain y where y:"y\<in>t" "g y = x" by auto
2.5372 + then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
2.5373 + hence "x \<in> s" unfolding g_def using someI2[of "\<lambda>b. b\<in>s \<and> f b = y" x' "\<lambda>x. x\<in>s"] unfolding y(2)[THEN sym] and g_def by auto }
2.5374 + ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
2.5375 + hence "g ` t = s" by auto
2.5376 + ultimately
2.5377 + show ?thesis unfolding homeomorphism_def homeomorphic_def
2.5378 + apply(rule_tac x=g in exI) using g and assms(3) and continuous_on_inverse[OF assms(2,1), of g, unfolded assms(3)] and assms(2) by auto
2.5379 +qed
2.5380 +
2.5381 +lemma homeomorphic_compact:
2.5382 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
2.5383 + (* class constraint due to continuous_on_inverse *)
2.5384 + shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
2.5385 + \<Longrightarrow> s homeomorphic t"
2.5386 + unfolding homeomorphic_def by(metis homeomorphism_compact)
2.5387 +
2.5388 +text{* Preservation of topological properties. *}
2.5389 +
2.5390 +lemma homeomorphic_compactness:
2.5391 + "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
2.5392 +unfolding homeomorphic_def homeomorphism_def
2.5393 +by (metis compact_continuous_image)
2.5394 +
2.5395 +text{* Results on translation, scaling etc. *}
2.5396 +
2.5397 +lemma homeomorphic_scaling:
2.5398 + fixes s :: "'a::real_normed_vector set"
2.5399 + assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
2.5400 + unfolding homeomorphic_minimal
2.5401 + apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
2.5402 + apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
2.5403 + using assms apply auto
2.5404 + using continuous_on_cmul[OF continuous_on_id] by auto
2.5405 +
2.5406 +lemma homeomorphic_translation:
2.5407 + fixes s :: "'a::real_normed_vector set"
2.5408 + shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
2.5409 + unfolding homeomorphic_minimal
2.5410 + apply(rule_tac x="\<lambda>x. a + x" in exI)
2.5411 + apply(rule_tac x="\<lambda>x. -a + x" in exI)
2.5412 + using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
2.5413 +
2.5414 +lemma homeomorphic_affinity:
2.5415 + fixes s :: "'a::real_normed_vector set"
2.5416 + assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
2.5417 +proof-
2.5418 + have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
2.5419 + show ?thesis
2.5420 + using homeomorphic_trans
2.5421 + using homeomorphic_scaling[OF assms, of s]
2.5422 + using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
2.5423 +qed
2.5424 +
2.5425 +lemma homeomorphic_balls:
2.5426 + fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
2.5427 + assumes "0 < d" "0 < e"
2.5428 + shows "(ball a d) homeomorphic (ball b e)" (is ?th)
2.5429 + "(cball a d) homeomorphic (cball b e)" (is ?cth)
2.5430 +proof-
2.5431 + have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
2.5432 + show ?th unfolding homeomorphic_minimal
2.5433 + apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
2.5434 + apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
2.5435 + using assms apply (auto simp add: dist_commute)
2.5436 + unfolding dist_norm
2.5437 + apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
2.5438 + unfolding continuous_on
2.5439 + by (intro ballI tendsto_intros, simp, assumption)+
2.5440 +next
2.5441 + have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
2.5442 + show ?cth unfolding homeomorphic_minimal
2.5443 + apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
2.5444 + apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
2.5445 + using assms apply (auto simp add: dist_commute)
2.5446 + unfolding dist_norm
2.5447 + apply (auto simp add: pos_divide_le_eq)
2.5448 + unfolding continuous_on
2.5449 + by (intro ballI tendsto_intros, simp, assumption)+
2.5450 +qed
2.5451 +
2.5452 +text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
2.5453 +
2.5454 +lemma cauchy_isometric:
2.5455 + fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
2.5456 + assumes e:"0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and xs:"\<forall>n::nat. x n \<in> s" and cf:"Cauchy(f o x)"
2.5457 + shows "Cauchy x"
2.5458 +proof-
2.5459 + interpret f: bounded_linear f by fact
2.5460 + { fix d::real assume "d>0"
2.5461 + then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
2.5462 + using cf[unfolded cauchy o_def dist_norm, THEN spec[where x="e*d"]] and e and mult_pos_pos[of e d] by auto
2.5463 + { fix n assume "n\<ge>N"
2.5464 + hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
2.5465 + moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
2.5466 + using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
2.5467 + using normf[THEN bspec[where x="x n - x N"]] by auto
2.5468 + ultimately have "norm (x n - x N) < d" using `e>0`
2.5469 + using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
2.5470 + hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
2.5471 + thus ?thesis unfolding cauchy and dist_norm by auto
2.5472 +qed
2.5473 +
2.5474 +lemma complete_isometric_image:
2.5475 + fixes f :: "real ^ _ \<Rightarrow> real ^ _"
2.5476 + assumes "0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and cs:"complete s"
2.5477 + shows "complete(f ` s)"
2.5478 +proof-
2.5479 + { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
2.5480 + then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
2.5481 + using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
2.5482 + hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
2.5483 + hence "f \<circ> x = g" unfolding expand_fun_eq by auto
2.5484 + then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
2.5485 + using cs[unfolded complete_def, THEN spec[where x="x"]]
2.5486 + using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
2.5487 + hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
2.5488 + using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
2.5489 + unfolding `f \<circ> x = g` by auto }
2.5490 + thus ?thesis unfolding complete_def by auto
2.5491 +qed
2.5492 +
2.5493 +lemma dist_0_norm:
2.5494 + fixes x :: "'a::real_normed_vector"
2.5495 + shows "dist 0 x = norm x"
2.5496 +unfolding dist_norm by simp
2.5497 +
2.5498 +lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
2.5499 + assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
2.5500 + shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
2.5501 +proof(cases "s \<subseteq> {0::real^'m}")
2.5502 + case True
2.5503 + { fix x assume "x \<in> s"
2.5504 + hence "x = 0" using True by auto
2.5505 + hence "norm x \<le> norm (f x)" by auto }
2.5506 + thus ?thesis by(auto intro!: exI[where x=1])
2.5507 +next
2.5508 + interpret f: bounded_linear f by fact
2.5509 + case False
2.5510 + then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
2.5511 + from False have "s \<noteq> {}" by auto
2.5512 + let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
2.5513 + let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
2.5514 + let ?S'' = "{x::real^'m. norm x = norm a}"
2.5515 +
2.5516 + have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
2.5517 + hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
2.5518 + moreover have "?S' = s \<inter> ?S''" by auto
2.5519 + ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
2.5520 + moreover have *:"f ` ?S' = ?S" by auto
2.5521 + ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
2.5522 + hence "closed ?S" using compact_imp_closed by auto
2.5523 + moreover have "?S \<noteq> {}" using a by auto
2.5524 + 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
2.5525 + 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 *[THEN sym] unfolding image_iff by auto
2.5526 +
2.5527 + let ?e = "norm (f b) / norm b"
2.5528 + have "norm b > 0" using ba and a and norm_ge_zero by auto
2.5529 + moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
2.5530 + ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
2.5531 + moreover
2.5532 + { fix x assume "x\<in>s"
2.5533 + hence "norm (f b) / norm b * norm x \<le> norm (f x)"
2.5534 + proof(cases "x=0")
2.5535 + case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
2.5536 + next
2.5537 + case False
2.5538 + hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
2.5539 + have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
2.5540 + hence "(norm a / norm x) *\<^sub>R x \<in> {x \<in> s. norm x = norm a}" using `x\<in>s` and `x\<noteq>0` by auto
2.5541 + thus "norm (f b) / norm b * norm x \<le> norm (f x)" using b[THEN bspec[where x="(norm a / norm x) *\<^sub>R x"]]
2.5542 + unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
2.5543 + by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
2.5544 + qed }
2.5545 + ultimately
2.5546 + show ?thesis by auto
2.5547 +qed
2.5548 +
2.5549 +lemma closed_injective_image_subspace:
2.5550 + fixes f :: "real ^ _ \<Rightarrow> real ^ _"
2.5551 + assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
2.5552 + shows "closed(f ` s)"
2.5553 +proof-
2.5554 + 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
2.5555 + show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
2.5556 + unfolding complete_eq_closed[THEN sym] by auto
2.5557 +qed
2.5558 +
2.5559 +subsection{* Some properties of a canonical subspace. *}
2.5560 +
2.5561 +lemma subspace_substandard:
2.5562 + "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
2.5563 + unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
2.5564 +
2.5565 +lemma closed_substandard:
2.5566 + "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
2.5567 +proof-
2.5568 + let ?D = "{i. P i}"
2.5569 + let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
2.5570 + { fix x
2.5571 + { assume "x\<in>?A"
2.5572 + hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
2.5573 + hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
2.5574 + moreover
2.5575 + { assume x:"x\<in>\<Inter>?Bs"
2.5576 + { fix i assume i:"i \<in> ?D"
2.5577 + then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
2.5578 + hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
2.5579 + hence "x\<in>?A" by auto }
2.5580 + ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
2.5581 + hence "?A = \<Inter> ?Bs" by auto
2.5582 + thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
2.5583 +qed
2.5584 +
2.5585 +lemma dim_substandard:
2.5586 + shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
2.5587 +proof-
2.5588 + let ?D = "UNIV::'n set"
2.5589 + let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
2.5590 +
2.5591 + let ?bas = "basis::'n \<Rightarrow> real^'n"
2.5592 +
2.5593 + have "?B \<subseteq> ?A" by auto
2.5594 +
2.5595 + moreover
2.5596 + { fix x::"real^'n" assume "x\<in>?A"
2.5597 + with finite[of d]
2.5598 + have "x\<in> span ?B"
2.5599 + proof(induct d arbitrary: x)
2.5600 + case empty hence "x=0" unfolding Cart_eq by auto
2.5601 + thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
2.5602 + next
2.5603 + case (insert k F)
2.5604 + hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
2.5605 + have **:"F \<subseteq> insert k F" by auto
2.5606 + def y \<equiv> "x - x$k *\<^sub>R basis k"
2.5607 + have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
2.5608 + { fix i assume i':"i \<notin> F"
2.5609 + hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
2.5610 + and vector_smult_component and basis_component
2.5611 + using *[THEN spec[where x=i]] by auto }
2.5612 + hence "y \<in> span (basis ` (insert k F))" using insert(3)
2.5613 + using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
2.5614 + using image_mono[OF **, of basis] by auto
2.5615 + moreover
2.5616 + have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
2.5617 + hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
2.5618 + using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
2.5619 + ultimately
2.5620 + have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
2.5621 + using span_add by auto
2.5622 + thus ?case using y by auto
2.5623 + qed
2.5624 + }
2.5625 + hence "?A \<subseteq> span ?B" by auto
2.5626 +
2.5627 + moreover
2.5628 + { fix x assume "x \<in> ?B"
2.5629 + hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
2.5630 + hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
2.5631 +
2.5632 + moreover
2.5633 + have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
2.5634 + hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
2.5635 + have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
2.5636 +
2.5637 + ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
2.5638 +qed
2.5639 +
2.5640 +text{* Hence closure and completeness of all subspaces. *}
2.5641 +
2.5642 +lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
2.5643 +apply (induct n)
2.5644 +apply (rule_tac x="{}" in exI, simp)
2.5645 +apply clarsimp
2.5646 +apply (subgoal_tac "\<exists>x. x \<notin> A")
2.5647 +apply (erule exE)
2.5648 +apply (rule_tac x="insert x A" in exI, simp)
2.5649 +apply (subgoal_tac "A \<noteq> UNIV", auto)
2.5650 +done
2.5651 +
2.5652 +lemma closed_subspace: fixes s::"(real^'n::finite) set"
2.5653 + assumes "subspace s" shows "closed s"
2.5654 +proof-
2.5655 + have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
2.5656 + then obtain d::"'n set" where t: "card d = dim s"
2.5657 + using closed_subspace_lemma by auto
2.5658 + let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
2.5659 + obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
2.5660 + using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
2.5661 + using dim_substandard[of d] and t by auto
2.5662 + interpret f: bounded_linear f by fact
2.5663 + have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
2.5664 + by(erule_tac x=0 in ballE) auto
2.5665 + moreover have "closed ?t" using closed_substandard .
2.5666 + moreover have "subspace ?t" using subspace_substandard .
2.5667 + ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
2.5668 + unfolding f(2) using f(1) by auto
2.5669 +qed
2.5670 +
2.5671 +lemma complete_subspace:
2.5672 + fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
2.5673 + using complete_eq_closed closed_subspace
2.5674 + by auto
2.5675 +
2.5676 +lemma dim_closure:
2.5677 + fixes s :: "(real ^ _) set"
2.5678 + shows "dim(closure s) = dim s" (is "?dc = ?d")
2.5679 +proof-
2.5680 + have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
2.5681 + using closed_subspace[OF subspace_span, of s]
2.5682 + using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
2.5683 + thus ?thesis using dim_subset[OF closure_subset, of s] by auto
2.5684 +qed
2.5685 +
2.5686 +text{* Affine transformations of intervals. *}
2.5687 +
2.5688 +lemma affinity_inverses:
2.5689 + assumes m0: "m \<noteq> (0::'a::field)"
2.5690 + shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
2.5691 + "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
2.5692 + using m0
2.5693 +apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
2.5694 +by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
2.5695 +
2.5696 +lemma real_affinity_le:
2.5697 + "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
2.5698 + by (simp add: field_simps inverse_eq_divide)
2.5699 +
2.5700 +lemma real_le_affinity:
2.5701 + "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
2.5702 + by (simp add: field_simps inverse_eq_divide)
2.5703 +
2.5704 +lemma real_affinity_lt:
2.5705 + "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
2.5706 + by (simp add: field_simps inverse_eq_divide)
2.5707 +
2.5708 +lemma real_lt_affinity:
2.5709 + "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
2.5710 + by (simp add: field_simps inverse_eq_divide)
2.5711 +
2.5712 +lemma real_affinity_eq:
2.5713 + "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
2.5714 + by (simp add: field_simps inverse_eq_divide)
2.5715 +
2.5716 +lemma real_eq_affinity:
2.5717 + "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
2.5718 + by (simp add: field_simps inverse_eq_divide)
2.5719 +
2.5720 +lemma vector_affinity_eq:
2.5721 + assumes m0: "(m::'a::field) \<noteq> 0"
2.5722 + shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
2.5723 +proof
2.5724 + assume h: "m *s x + c = y"
2.5725 + hence "m *s x = y - c" by (simp add: ring_simps)
2.5726 + hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
2.5727 + then show "x = inverse m *s y + - (inverse m *s c)"
2.5728 + using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
2.5729 +next
2.5730 + assume h: "x = inverse m *s y + - (inverse m *s c)"
2.5731 + show "m *s x + c = y" unfolding h diff_minus[symmetric]
2.5732 + using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
2.5733 +qed
2.5734 +
2.5735 +lemma vector_eq_affinity:
2.5736 + "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
2.5737 + using vector_affinity_eq[where m=m and x=x and y=y and c=c]
2.5738 + by metis
2.5739 +
2.5740 +lemma image_affinity_interval: fixes m::real
2.5741 + fixes a b c :: "real^'n::finite"
2.5742 + shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
2.5743 + (if {a .. b} = {} then {}
2.5744 + else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
2.5745 + else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
2.5746 +proof(cases "m=0")
2.5747 + { fix x assume "x \<le> c" "c \<le> x"
2.5748 + hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
2.5749 + moreover case True
2.5750 + moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
2.5751 + ultimately show ?thesis by auto
2.5752 +next
2.5753 + case False
2.5754 + { fix y assume "a \<le> y" "y \<le> b" "m > 0"
2.5755 + hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
2.5756 + unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
2.5757 + } moreover
2.5758 + { fix y assume "a \<le> y" "y \<le> b" "m < 0"
2.5759 + hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
2.5760 + unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
2.5761 + } moreover
2.5762 + { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
2.5763 + hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
2.5764 + unfolding image_iff Bex_def mem_interval vector_less_eq_def
2.5765 + apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
2.5766 + intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
2.5767 + by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
2.5768 + } moreover
2.5769 + { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
2.5770 + hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
2.5771 + unfolding image_iff Bex_def mem_interval vector_less_eq_def
2.5772 + apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
2.5773 + intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
2.5774 + by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
2.5775 + }
2.5776 + ultimately show ?thesis using False by auto
2.5777 +qed
2.5778 +
2.5779 +lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
2.5780 + (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
2.5781 + using image_affinity_interval[of m 0 a b] by auto
2.5782 +
2.5783 +subsection{* Banach fixed point theorem (not really topological...) *}
2.5784 +
2.5785 +lemma banach_fix:
2.5786 + assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
2.5787 + lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
2.5788 + shows "\<exists>! x\<in>s. (f x = x)"
2.5789 +proof-
2.5790 + have "1 - c > 0" using c by auto
2.5791 +
2.5792 + from s(2) obtain z0 where "z0 \<in> s" by auto
2.5793 + def z \<equiv> "\<lambda>n. (f ^^ n) z0"
2.5794 + { fix n::nat
2.5795 + have "z n \<in> s" unfolding z_def
2.5796 + proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
2.5797 + next case Suc thus ?case using f by auto qed }
2.5798 + note z_in_s = this
2.5799 +
2.5800 + def d \<equiv> "dist (z 0) (z 1)"
2.5801 +
2.5802 + have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
2.5803 + { fix n::nat
2.5804 + have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
2.5805 + proof(induct n)
2.5806 + case 0 thus ?case unfolding d_def by auto
2.5807 + next
2.5808 + case (Suc m)
2.5809 + hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
2.5810 + using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
2.5811 + thus ?case using lipschitz[THEN bspec[where x="z m"], OF z_in_s, THEN bspec[where x="z (Suc m)"], OF z_in_s]
2.5812 + unfolding fzn and mult_le_cancel_left by auto
2.5813 + qed
2.5814 + } note cf_z = this
2.5815 +
2.5816 + { fix n m::nat
2.5817 + have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
2.5818 + proof(induct n)
2.5819 + case 0 show ?case by auto
2.5820 + next
2.5821 + case (Suc k)
2.5822 + have "(1 - c) * dist (z m) (z (m + Suc k)) \<le> (1 - c) * (dist (z m) (z (m + k)) + dist (z (m + k)) (z (Suc (m + k))))"
2.5823 + using dist_triangle and c by(auto simp add: dist_triangle)
2.5824 + also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
2.5825 + using cf_z[of "m + k"] and c by auto
2.5826 + also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
2.5827 + using Suc by (auto simp add: ring_simps)
2.5828 + also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
2.5829 + unfolding power_add by (auto simp add: ring_simps)
2.5830 + also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
2.5831 + using c by (auto simp add: ring_simps)
2.5832 + finally show ?case by auto
2.5833 + qed
2.5834 + } note cf_z2 = this
2.5835 + { fix e::real assume "e>0"
2.5836 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
2.5837 + proof(cases "d = 0")
2.5838 + case True
2.5839 + hence "\<And>n. z n = z0" using cf_z2[of 0] and c unfolding z_def by (auto simp add: pos_prod_le[OF `1 - c > 0`])
2.5840 + thus ?thesis using `e>0` by auto
2.5841 + next
2.5842 + case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
2.5843 + by (metis False d_def real_less_def)
2.5844 + hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
2.5845 + using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
2.5846 + then obtain N where N:"c ^ N < e * (1 - c) / d" using real_arch_pow_inv[of "e * (1 - c) / d" c] and c by auto
2.5847 + { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
2.5848 + have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
2.5849 + have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
2.5850 + hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
2.5851 + using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
2.5852 + using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
2.5853 + using `0 < 1 - c` by auto
2.5854 +
2.5855 + have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
2.5856 + using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
2.5857 + by (auto simp add: real_mult_commute dist_commute)
2.5858 + also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
2.5859 + using mult_right_mono[OF * order_less_imp_le[OF **]]
2.5860 + unfolding real_mult_assoc by auto
2.5861 + also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
2.5862 + using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
2.5863 + also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
2.5864 + also have "\<dots> \<le> e" using c and `1 - c ^ (m - n) > 0` and `e>0` using mult_right_le_one_le[of e "1 - c ^ (m - n)"] by auto
2.5865 + finally have "dist (z m) (z n) < e" by auto
2.5866 + } note * = this
2.5867 + { fix m n::nat assume as:"N\<le>m" "N\<le>n"
2.5868 + hence "dist (z n) (z m) < e"
2.5869 + proof(cases "n = m")
2.5870 + case True thus ?thesis using `e>0` by auto
2.5871 + next
2.5872 + case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
2.5873 + qed }
2.5874 + thus ?thesis by auto
2.5875 + qed
2.5876 + }
2.5877 + hence "Cauchy z" unfolding cauchy_def by auto
2.5878 + then obtain x where "x\<in>s" and x:"(z ---> x) sequentially" using s(1)[unfolded compact_def complete_def, THEN spec[where x=z]] and z_in_s by auto
2.5879 +
2.5880 + def e \<equiv> "dist (f x) x"
2.5881 + have "e = 0" proof(rule ccontr)
2.5882 + assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
2.5883 + by (metis dist_eq_0_iff dist_nz e_def)
2.5884 + then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
2.5885 + using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
2.5886 + hence N':"dist (z N) x < e / 2" by auto
2.5887 +
2.5888 + have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
2.5889 + using zero_le_dist[of "z N" x] and c
2.5890 + by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
2.5891 + have "dist (f (z N)) (f x) \<le> c * dist (z N) x" using lipschitz[THEN bspec[where x="z N"], THEN bspec[where x=x]]
2.5892 + using z_in_s[of N] `x\<in>s` using c by auto
2.5893 + also have "\<dots> < e / 2" using N' and c using * by auto
2.5894 + finally show False unfolding fzn
2.5895 + using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
2.5896 + unfolding e_def by auto
2.5897 + qed
2.5898 + hence "f x = x" unfolding e_def by auto
2.5899 + moreover
2.5900 + { fix y assume "f y = y" "y\<in>s"
2.5901 + hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
2.5902 + using `x\<in>s` and `f x = x` by auto
2.5903 + hence "dist x y = 0" unfolding mult_le_cancel_right1
2.5904 + using c and zero_le_dist[of x y] by auto
2.5905 + hence "y = x" by auto
2.5906 + }
2.5907 + ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
2.5908 +qed
2.5909 +
2.5910 +subsection{* Edelstein fixed point theorem. *}
2.5911 +
2.5912 +lemma edelstein_fix:
2.5913 + fixes s :: "'a::real_normed_vector set"
2.5914 + assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
2.5915 + and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
2.5916 + shows "\<exists>! x\<in>s. g x = x"
2.5917 +proof(cases "\<exists>x\<in>s. g x \<noteq> x")
2.5918 + obtain x where "x\<in>s" using s(2) by auto
2.5919 + case False hence g:"\<forall>x\<in>s. g x = x" by auto
2.5920 + { fix y assume "y\<in>s"
2.5921 + hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
2.5922 + unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
2.5923 + unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
2.5924 + thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
2.5925 +next
2.5926 + case True
2.5927 + then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
2.5928 + { fix x y assume "x \<in> s" "y \<in> s"
2.5929 + hence "dist (g x) (g y) \<le> dist x y"
2.5930 + using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
2.5931 + def y \<equiv> "g x"
2.5932 + have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
2.5933 + def f \<equiv> "\<lambda>n. g ^^ n"
2.5934 + have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
2.5935 + have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
2.5936 + { fix n::nat and z assume "z\<in>s"
2.5937 + have "f n z \<in> s" unfolding f_def
2.5938 + proof(induct n)
2.5939 + case 0 thus ?case using `z\<in>s` by simp
2.5940 + next
2.5941 + case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
2.5942 + qed } note fs = this
2.5943 + { fix m n ::nat assume "m\<le>n"
2.5944 + fix w z assume "w\<in>s" "z\<in>s"
2.5945 + have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
2.5946 + proof(induct n)
2.5947 + case 0 thus ?case by auto
2.5948 + next
2.5949 + case (Suc n)
2.5950 + thus ?case proof(cases "m\<le>n")
2.5951 + case True thus ?thesis using Suc(1)
2.5952 + using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
2.5953 + next
2.5954 + case False hence mn:"m = Suc n" using Suc(2) by simp
2.5955 + show ?thesis unfolding mn by auto
2.5956 + qed
2.5957 + qed } note distf = this
2.5958 +
2.5959 + def h \<equiv> "\<lambda>n. (f n x, f n y)"
2.5960 + let ?s2 = "s \<times> s"
2.5961 + obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
2.5962 + using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
2.5963 + using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
2.5964 + def a \<equiv> "fst l" def b \<equiv> "snd l"
2.5965 + have lab:"l = (a, b)" unfolding a_def b_def by simp
2.5966 + have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
2.5967 +
2.5968 + have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
2.5969 + and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
2.5970 + using lr
2.5971 + unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
2.5972 +
2.5973 + { fix n::nat
2.5974 + have *:"\<And>fx fy (x::'a) y. dist fx fy \<le> dist x y \<Longrightarrow> \<not> (dist (fx - fy) (a - b) < dist a b - dist x y)" unfolding dist_norm by norm
2.5975 + { fix x y :: 'a
2.5976 + have "dist (-x) (-y) = dist x y" unfolding dist_norm
2.5977 + using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
2.5978 +
2.5979 + { assume as:"dist a b > dist (f n x) (f n y)"
2.5980 + then obtain Na Nb where "\<forall>m\<ge>Na. dist (f (r m) x) a < (dist a b - dist (f n x) (f n y)) / 2"
2.5981 + and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
2.5982 + using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
2.5983 + hence "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) < dist a b - dist (f n x) (f n y)"
2.5984 + apply(erule_tac x="Na+Nb+n" in allE)
2.5985 + apply(erule_tac x="Na+Nb+n" in allE) apply simp
2.5986 + using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
2.5987 + "-b" "- f (r (Na + Nb + n)) y"]
2.5988 + unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
2.5989 + moreover
2.5990 + have "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) \<ge> dist a b - dist (f n x) (f n y)"
2.5991 + using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
2.5992 + using subseq_bigger[OF r, of "Na+Nb+n"]
2.5993 + using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
2.5994 + ultimately have False by simp
2.5995 + }
2.5996 + hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
2.5997 + note ab_fn = this
2.5998 +
2.5999 + have [simp]:"a = b" proof(rule ccontr)
2.6000 + def e \<equiv> "dist a b - dist (g a) (g b)"
2.6001 + assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
2.6002 + hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
2.6003 + using lima limb unfolding Lim_sequentially
2.6004 + apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
2.6005 + then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
2.6006 + have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
2.6007 + using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
2.6008 + moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
2.6009 + using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
2.6010 + ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
2.6011 + thus False unfolding e_def using ab_fn[of "Suc n"] by norm
2.6012 + qed
2.6013 +
2.6014 + have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
2.6015 + { fix x y assume "x\<in>s" "y\<in>s" moreover
2.6016 + fix e::real assume "e>0" ultimately
2.6017 + have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
2.6018 + hence "continuous_on s g" unfolding continuous_on_def by auto
2.6019 +
2.6020 + hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
2.6021 + apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
2.6022 + using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
2.6023 + hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
2.6024 + unfolding `a=b` and o_assoc by auto
2.6025 + moreover
2.6026 + { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
2.6027 + hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
2.6028 + using `g a = a` and `a\<in>s` by auto }
2.6029 + ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
2.6030 +qed
2.6031 +
2.6032 +end
3.1 --- a/src/HOL/Library/Convex_Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
3.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
3.3 @@ -1,3371 +0,0 @@
3.4 -(* Title: HOL/Library/Convex_Euclidean_Space.thy
3.5 - Author: Robert Himmelmann, TU Muenchen
3.6 -*)
3.7 -
3.8 -header {* Convex sets, functions and related things. *}
3.9 -
3.10 -theory Convex_Euclidean_Space
3.11 -imports Topology_Euclidean_Space
3.12 -begin
3.13 -
3.14 -
3.15 -(* ------------------------------------------------------------------------- *)
3.16 -(* To be moved elsewhere *)
3.17 -(* ------------------------------------------------------------------------- *)
3.18 -
3.19 -declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp]
3.20 -declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp]
3.21 -declare dot_ladd[simp] dot_radd[simp] dot_lsub[simp] dot_rsub[simp]
3.22 -declare dot_lmult[simp] dot_rmult[simp] dot_lneg[simp] dot_rneg[simp]
3.23 -declare UNIV_1[simp]
3.24 -
3.25 -term "(x::real^'n \<Rightarrow> real) 0"
3.26 -
3.27 -lemma dim1in[intro]:"Suc 0 \<in> {1::nat .. CARD(1)}" by auto
3.28 -
3.29 -lemmas vector_component_simps = vector_minus_component vector_smult_component vector_add_component vector_less_eq_def Cart_lambda_beta dest_vec1_def basis_component vector_uminus_component
3.30 -
3.31 -lemmas continuous_intros = continuous_add continuous_vmul continuous_cmul continuous_const continuous_sub continuous_at_id continuous_within_id
3.32 -
3.33 -lemmas continuous_on_intros = continuous_on_add continuous_on_const continuous_on_id continuous_on_compose continuous_on_cmul continuous_on_neg continuous_on_sub
3.34 - uniformly_continuous_on_add uniformly_continuous_on_const uniformly_continuous_on_id uniformly_continuous_on_compose uniformly_continuous_on_cmul uniformly_continuous_on_neg uniformly_continuous_on_sub
3.35 -
3.36 -lemma dest_vec1_simps[simp]: fixes a::"real^1"
3.37 - shows "a$1 = 0 \<longleftrightarrow> a = 0" (*"a \<le> 1 \<longleftrightarrow> dest_vec1 a \<le> 1" "0 \<le> a \<longleftrightarrow> 0 \<le> dest_vec1 a"*)
3.38 - "a \<le> b \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 b" "dest_vec1 (1::real^1) = 1"
3.39 - by(auto simp add:vector_component_simps all_1 Cart_eq)
3.40 -
3.41 -lemma nequals0I:"x\<in>A \<Longrightarrow> A \<noteq> {}" by auto
3.42 -
3.43 -lemma norm_not_0:"(x::real^'n::finite)\<noteq>0 \<Longrightarrow> norm x \<noteq> 0" by auto
3.44 -
3.45 -lemma setsum_delta_notmem: assumes "x\<notin>s"
3.46 - shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
3.47 - "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
3.48 - "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
3.49 - "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
3.50 - apply(rule_tac [!] setsum_cong2) using assms by auto
3.51 -
3.52 -lemma setsum_delta'':
3.53 - fixes s::"'a::real_vector set" assumes "finite s"
3.54 - shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
3.55 -proof-
3.56 - have *:"\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)" by auto
3.57 - show ?thesis unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
3.58 -qed
3.59 -
3.60 -lemma not_disjointI:"x\<in>A \<Longrightarrow> x\<in>B \<Longrightarrow> A \<inter> B \<noteq> {}" by blast
3.61 -
3.62 -lemma if_smult:"(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)" by auto
3.63 -
3.64 -lemma mem_interval_1: fixes x :: "real^1" shows
3.65 - "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
3.66 - "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
3.67 -by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def all_1)
3.68 -
3.69 -lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
3.70 - (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
3.71 - using image_affinity_interval[of m 0 a b] by auto
3.72 -
3.73 -lemma dest_vec1_inverval:
3.74 - "dest_vec1 ` {a .. b} = {dest_vec1 a .. dest_vec1 b}"
3.75 - "dest_vec1 ` {a<.. b} = {dest_vec1 a<.. dest_vec1 b}"
3.76 - "dest_vec1 ` {a ..<b} = {dest_vec1 a ..<dest_vec1 b}"
3.77 - "dest_vec1 ` {a<..<b} = {dest_vec1 a<..<dest_vec1 b}"
3.78 - apply(rule_tac [!] equalityI)
3.79 - unfolding subset_eq Ball_def Bex_def mem_interval_1 image_iff
3.80 - apply(rule_tac [!] allI)apply(rule_tac [!] impI)
3.81 - apply(rule_tac[2] x="vec1 x" in exI)apply(rule_tac[4] x="vec1 x" in exI)
3.82 - apply(rule_tac[6] x="vec1 x" in exI)apply(rule_tac[8] x="vec1 x" in exI)
3.83 - by (auto simp add: vector_less_def vector_less_eq_def all_1 dest_vec1_def
3.84 - vec1_dest_vec1[unfolded dest_vec1_def One_nat_def])
3.85 -
3.86 -lemma dest_vec1_setsum: assumes "finite S"
3.87 - shows " dest_vec1 (setsum f S) = setsum (\<lambda>x. dest_vec1 (f x)) S"
3.88 - using dest_vec1_sum[OF assms] by auto
3.89 -
3.90 -lemma dist_triangle_eq:
3.91 - fixes x y z :: "real ^ _"
3.92 - shows "dist x z = dist x y + dist y z \<longleftrightarrow> norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
3.93 -proof- have *:"x - y + (y - z) = x - z" by auto
3.94 - show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded smult_conv_scaleR *]
3.95 - by(auto simp add:norm_minus_commute) qed
3.96 -
3.97 -lemma norm_eqI:"x = y \<Longrightarrow> norm x = norm y" by auto
3.98 -lemma norm_minus_eqI:"(x::real^'n::finite) = - y \<Longrightarrow> norm x = norm y" by auto
3.99 -
3.100 -lemma Min_grI: assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a" shows "x < Min A"
3.101 - unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
3.102 -
3.103 -lemma dimindex_ge_1:"CARD(_::finite) \<ge> 1"
3.104 - using one_le_card_finite by auto
3.105 -
3.106 -lemma real_dimindex_ge_1:"real (CARD('n::finite)) \<ge> 1"
3.107 - by(metis dimindex_ge_1 linorder_not_less real_eq_of_nat real_le_trans real_of_nat_1 real_of_nat_le_iff)
3.108 -
3.109 -lemma real_dimindex_gt_0:"real (CARD('n::finite)) > 0" apply(rule less_le_trans[OF _ real_dimindex_ge_1]) by auto
3.110 -
3.111 -subsection {* Affine set and affine hull.*}
3.112 -
3.113 -definition
3.114 - affine :: "'a::real_vector set \<Rightarrow> bool" where
3.115 - "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
3.116 -
3.117 -lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
3.118 -proof- have *:"\<And>u v ::real. u + v = 1 \<longleftrightarrow> v = 1 - u" by auto
3.119 - { fix x y assume "x\<in>s" "y\<in>s"
3.120 - hence "(\<forall>u v::real. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s) \<longleftrightarrow> (\<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)" apply auto
3.121 - apply(erule_tac[!] x="1 - u" in allE) unfolding * by auto }
3.122 - thus ?thesis unfolding affine_def by auto qed
3.123 -
3.124 -lemma affine_empty[intro]: "affine {}"
3.125 - unfolding affine_def by auto
3.126 -
3.127 -lemma affine_sing[intro]: "affine {x}"
3.128 - unfolding affine_alt by (auto simp add: scaleR_left_distrib [symmetric])
3.129 -
3.130 -lemma affine_UNIV[intro]: "affine UNIV"
3.131 - unfolding affine_def by auto
3.132 -
3.133 -lemma affine_Inter: "(\<forall>s\<in>f. affine s) \<Longrightarrow> affine (\<Inter> f)"
3.134 - unfolding affine_def by auto
3.135 -
3.136 -lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
3.137 - unfolding affine_def by auto
3.138 -
3.139 -lemma affine_affine_hull: "affine(affine hull s)"
3.140 - unfolding hull_def using affine_Inter[of "{t \<in> affine. s \<subseteq> t}"]
3.141 - unfolding mem_def by auto
3.142 -
3.143 -lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
3.144 -proof-
3.145 - { fix f assume "f \<subseteq> affine"
3.146 - hence "affine (\<Inter>f)" using affine_Inter[of f] unfolding subset_eq mem_def by auto }
3.147 - thus ?thesis using hull_eq[unfolded mem_def, of affine s] by auto
3.148 -qed
3.149 -
3.150 -lemma setsum_restrict_set'': assumes "finite A"
3.151 - shows "setsum f {x \<in> A. P x} = (\<Sum>x\<in>A. if P x then f x else 0)"
3.152 - unfolding mem_def[of _ P, symmetric] unfolding setsum_restrict_set'[OF assms] ..
3.153 -
3.154 -subsection {* Some explicit formulations (from Lars Schewe). *}
3.155 -
3.156 -lemma affine: fixes V::"'a::real_vector set"
3.157 - shows "affine V \<longleftrightarrow> (\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (setsum (\<lambda>x. (u x) *\<^sub>R x)) s \<in> V)"
3.158 -unfolding affine_def apply rule apply(rule, rule, rule) apply(erule conjE)+
3.159 -defer apply(rule, rule, rule, rule, rule) proof-
3.160 - fix x y u v assume as:"x \<in> V" "y \<in> V" "u + v = (1::real)"
3.161 - "\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
3.162 - thus "u *\<^sub>R x + v *\<^sub>R y \<in> V" apply(cases "x=y")
3.163 - using as(4)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>w. if w = x then u else v"]] and as(1-3)
3.164 - by(auto simp add: scaleR_left_distrib[THEN sym])
3.165 -next
3.166 - fix s u assume as:"\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
3.167 - "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
3.168 - def n \<equiv> "card s"
3.169 - have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
3.170 - thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" proof(auto simp only: disjE)
3.171 - assume "card s = 2" hence "card s = Suc (Suc 0)" by auto
3.172 - then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
3.173 - thus ?thesis using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
3.174 - by(auto simp add: setsum_clauses(2))
3.175 - next assume "card s > 2" thus ?thesis using as and n_def proof(induct n arbitrary: u s)
3.176 - case (Suc n) fix s::"'a set" and u::"'a \<Rightarrow> real"
3.177 - assume IA:"\<And>u s. \<lbrakk>2 < card s; \<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V; finite s;
3.178 - s \<noteq> {}; s \<subseteq> V; setsum u s = 1; n \<equiv> card s \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" and
3.179 - as:"Suc n \<equiv> card s" "2 < card s" "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
3.180 - "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
3.181 - have "\<exists>x\<in>s. u x \<noteq> 1" proof(rule_tac ccontr)
3.182 - assume " \<not> (\<exists>x\<in>s. u x \<noteq> 1)" hence "setsum u s = real_of_nat (card s)" unfolding card_eq_setsum by auto
3.183 - thus False using as(7) and `card s > 2` by (metis Numeral1_eq1_nat less_0_number_of less_int_code(15)
3.184 - less_nat_number_of not_less_iff_gr_or_eq of_nat_1 of_nat_eq_iff pos2 rel_simps(4)) qed
3.185 - then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
3.186 -
3.187 - have c:"card (s - {x}) = card s - 1" apply(rule card_Diff_singleton) using `x\<in>s` as(4) by auto
3.188 - have *:"s = insert x (s - {x})" "finite (s - {x})" using `x\<in>s` and as(4) by auto
3.189 - have **:"setsum u (s - {x}) = 1 - u x"
3.190 - using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
3.191 - have ***:"inverse (1 - u x) * setsum u (s - {x}) = 1" unfolding ** using `u x \<noteq> 1` by auto
3.192 - have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V" proof(cases "card (s - {x}) > 2")
3.193 - case True hence "s - {x} \<noteq> {}" "card (s - {x}) = n" unfolding c and as(1)[symmetric] proof(rule_tac ccontr)
3.194 - assume "\<not> s - {x} \<noteq> {}" hence "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp
3.195 - thus False using True by auto qed auto
3.196 - thus ?thesis apply(rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
3.197 - unfolding setsum_right_distrib[THEN sym] using as and *** and True by auto
3.198 - next case False hence "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
3.199 - then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
3.200 - thus ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
3.201 - using *** *(2) and `s \<subseteq> V` unfolding setsum_right_distrib by(auto simp add: setsum_clauses(2)) qed
3.202 - thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
3.203 - apply(subst *) unfolding setsum_clauses(2)[OF *(2)]
3.204 - using as(3)[THEN bspec[where x=x], THEN bspec[where x="(inverse (1 - u x)) *\<^sub>R (\<Sum>xa\<in>s - {x}. u xa *\<^sub>R xa)"],
3.205 - THEN spec[where x="u x"], THEN spec[where x="1 - u x"]] and rev_subsetD[OF `x\<in>s` `s\<subseteq>V`] and `u x \<noteq> 1` by auto
3.206 - qed auto
3.207 - next assume "card s = 1" then obtain a where "s={a}" by(auto simp add: card_Suc_eq)
3.208 - thus ?thesis using as(4,5) by simp
3.209 - qed(insert `s\<noteq>{}` `finite s`, auto)
3.210 -qed
3.211 -
3.212 -lemma affine_hull_explicit:
3.213 - "affine hull p = {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> setsum (\<lambda>v. (u v) *\<^sub>R v) s = y}"
3.214 - apply(rule hull_unique) apply(subst subset_eq) prefer 3 apply rule unfolding mem_Collect_eq and mem_def[of _ affine]
3.215 - apply (erule exE)+ apply(erule conjE)+ prefer 2 apply rule proof-
3.216 - fix x assume "x\<in>p" thus "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.217 - apply(rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
3.218 -next
3.219 - fix t x s u assume as:"p \<subseteq> t" "affine t" "finite s" "s \<noteq> {}" "s \<subseteq> p" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.220 - thus "x \<in> t" using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
3.221 -next
3.222 - show "affine {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y}" unfolding affine_def
3.223 - apply(rule,rule,rule,rule,rule) unfolding mem_Collect_eq proof-
3.224 - fix u v ::real assume uv:"u + v = 1"
3.225 - fix x assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.226 - then obtain sx ux where x:"finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "setsum ux sx = 1" "(\<Sum>v\<in>sx. ux v *\<^sub>R v) = x" by auto
3.227 - fix y assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
3.228 - then obtain sy uy where y:"finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "setsum uy sy = 1" "(\<Sum>v\<in>sy. uy v *\<^sub>R v) = y" by auto
3.229 - have xy:"finite (sx \<union> sy)" using x(1) y(1) by auto
3.230 - have **:"(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
3.231 - show "\<exists>s ua. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum ua s = 1 \<and> (\<Sum>v\<in>s. ua v *\<^sub>R v) = u *\<^sub>R x + v *\<^sub>R y"
3.232 - apply(rule_tac x="sx \<union> sy" in exI)
3.233 - apply(rule_tac x="\<lambda>a. (if a\<in>sx then u * ux a else 0) + (if a\<in>sy then v * uy a else 0)" in exI)
3.234 - unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left ** setsum_restrict_set[OF xy, THEN sym]
3.235 - unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
3.236 - unfolding x y using x(1-3) y(1-3) uv by simp qed qed
3.237 -
3.238 -lemma affine_hull_finite:
3.239 - assumes "finite s"
3.240 - shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
3.241 - unfolding affine_hull_explicit and expand_set_eq and mem_Collect_eq apply (rule,rule)
3.242 - apply(erule exE)+ apply(erule conjE)+ defer apply(erule exE) apply(erule conjE) proof-
3.243 - fix x u assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.244 - thus "\<exists>sa u. finite sa \<and> \<not> (\<forall>x. (x \<in> sa) = (x \<in> {})) \<and> sa \<subseteq> s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = x"
3.245 - apply(rule_tac x=s in exI, rule_tac x=u in exI) using assms by auto
3.246 -next
3.247 - fix x t u assume "t \<subseteq> s" hence *:"s \<inter> t = t" by auto
3.248 - assume "finite t" "\<not> (\<forall>x. (x \<in> t) = (x \<in> {}))" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
3.249 - thus "\<exists>u. setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x" apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
3.250 - unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and * by auto qed
3.251 -
3.252 -subsection {* Stepping theorems and hence small special cases. *}
3.253 -
3.254 -lemma affine_hull_empty[simp]: "affine hull {} = {}"
3.255 - apply(rule hull_unique) unfolding mem_def by auto
3.256 -
3.257 -lemma affine_hull_finite_step:
3.258 - fixes y :: "'a::real_vector"
3.259 - shows "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
3.260 - "finite s \<Longrightarrow> (\<exists>u. setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y) \<longleftrightarrow>
3.261 - (\<exists>v u. setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?as \<Longrightarrow> (?lhs = ?rhs)")
3.262 -proof-
3.263 - show ?th1 by simp
3.264 - assume ?as
3.265 - { assume ?lhs
3.266 - then obtain u where u:"setsum u (insert a s) = w \<and> (\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
3.267 - have ?rhs proof(cases "a\<in>s")
3.268 - case True hence *:"insert a s = s" by auto
3.269 - show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
3.270 - next
3.271 - case False thus ?thesis apply(rule_tac x="u a" in exI) using u and `?as` by auto
3.272 - qed } moreover
3.273 - { assume ?rhs
3.274 - then obtain v u where vu:"setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
3.275 - have *:"\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)" by auto
3.276 - have ?lhs proof(cases "a\<in>s")
3.277 - case True thus ?thesis
3.278 - apply(rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
3.279 - unfolding setsum_clauses(2)[OF `?as`] apply simp
3.280 - unfolding scaleR_left_distrib and setsum_addf
3.281 - unfolding vu and * and scaleR_zero_left
3.282 - by (auto simp add: setsum_delta[OF `?as`])
3.283 - next
3.284 - case False
3.285 - hence **:"\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
3.286 - "\<And>x. x \<in> s \<Longrightarrow> u x *\<^sub>R x = (if x = a then v *\<^sub>R x else u x *\<^sub>R x)" by auto
3.287 - from False show ?thesis
3.288 - apply(rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
3.289 - unfolding setsum_clauses(2)[OF `?as`] and * using vu
3.290 - using setsum_cong2[of s "\<lambda>x. u x *\<^sub>R x" "\<lambda>x. if x = a then v *\<^sub>R x else u x *\<^sub>R x", OF **(2)]
3.291 - using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)] by auto
3.292 - qed }
3.293 - ultimately show "?lhs = ?rhs" by blast
3.294 -qed
3.295 -
3.296 -lemma affine_hull_2:
3.297 - fixes a b :: "'a::real_vector"
3.298 - shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
3.299 -proof-
3.300 - have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
3.301 - "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
3.302 - have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
3.303 - using affine_hull_finite[of "{a,b}"] by auto
3.304 - also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
3.305 - by(simp add: affine_hull_finite_step(2)[of "{b}" a])
3.306 - also have "\<dots> = ?rhs" unfolding * by auto
3.307 - finally show ?thesis by auto
3.308 -qed
3.309 -
3.310 -lemma affine_hull_3:
3.311 - fixes a b c :: "'a::real_vector"
3.312 - shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}" (is "?lhs = ?rhs")
3.313 -proof-
3.314 - have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
3.315 - "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
3.316 - show ?thesis apply(simp add: affine_hull_finite affine_hull_finite_step)
3.317 - unfolding * apply auto
3.318 - apply(rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
3.319 - apply(rule_tac x=u in exI) by(auto intro!: exI)
3.320 -qed
3.321 -
3.322 -subsection {* Some relations between affine hull and subspaces. *}
3.323 -
3.324 -lemma affine_hull_insert_subset_span:
3.325 - fixes a :: "real ^ _"
3.326 - shows "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
3.327 - unfolding subset_eq Ball_def unfolding affine_hull_explicit span_explicit mem_Collect_eq smult_conv_scaleR
3.328 - apply(rule,rule) apply(erule exE)+ apply(erule conjE)+ proof-
3.329 - fix x t u assume as:"finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
3.330 - have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
3.331 - thus "\<exists>v. x = a + v \<and> (\<exists>S u. finite S \<and> S \<subseteq> {x - a |x. x \<in> s} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = v)"
3.332 - apply(rule_tac x="x - a" in exI)
3.333 - apply (rule conjI, simp)
3.334 - apply(rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
3.335 - apply(rule_tac x="\<lambda>x. u (x + a)" in exI)
3.336 - apply (rule conjI) using as(1) apply simp
3.337 - apply (erule conjI)
3.338 - using as(1)
3.339 - apply (simp add: setsum_reindex[unfolded inj_on_def] scaleR_right_diff_distrib setsum_subtractf scaleR_left.setsum[THEN sym] setsum_diff1 scaleR_left_diff_distrib)
3.340 - unfolding as by simp qed
3.341 -
3.342 -lemma affine_hull_insert_span:
3.343 - fixes a :: "real ^ _"
3.344 - assumes "a \<notin> s"
3.345 - shows "affine hull (insert a s) =
3.346 - {a + v | v . v \<in> span {x - a | x. x \<in> s}}"
3.347 - apply(rule, rule affine_hull_insert_subset_span) unfolding subset_eq Ball_def
3.348 - unfolding affine_hull_explicit and mem_Collect_eq proof(rule,rule,erule exE,erule conjE)
3.349 - fix y v assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
3.350 - then obtain t u where obt:"finite t" "t \<subseteq> {x - a |x. x \<in> s}" "a + (\<Sum>v\<in>t. u v *\<^sub>R v) = y" unfolding span_explicit smult_conv_scaleR by auto
3.351 - def f \<equiv> "(\<lambda>x. x + a) ` t"
3.352 - have f:"finite f" "f \<subseteq> s" "(\<Sum>v\<in>f. u (v - a) *\<^sub>R (v - a)) = y - a" unfolding f_def using obt
3.353 - by(auto simp add: setsum_reindex[unfolded inj_on_def])
3.354 - have *:"f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
3.355 - show "\<exists>sa u. finite sa \<and> sa \<noteq> {} \<and> sa \<subseteq> insert a s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
3.356 - apply(rule_tac x="insert a f" in exI)
3.357 - apply(rule_tac x="\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
3.358 - using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
3.359 - unfolding setsum_cases[OF f(1), of "{a}", unfolded singleton_iff] and *
3.360 - by (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps) qed
3.361 -
3.362 -lemma affine_hull_span:
3.363 - fixes a :: "real ^ _"
3.364 - assumes "a \<in> s"
3.365 - shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
3.366 - using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
3.367 -
3.368 -subsection {* Convexity. *}
3.369 -
3.370 -definition
3.371 - convex :: "'a::real_vector set \<Rightarrow> bool" where
3.372 - "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
3.373 -
3.374 -lemma convex_alt: "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> ((1 - u) *\<^sub>R x + u *\<^sub>R y) \<in> s)"
3.375 -proof- have *:"\<And>u v::real. u + v = 1 \<longleftrightarrow> u = 1 - v" by auto
3.376 - show ?thesis unfolding convex_def apply auto
3.377 - apply(erule_tac x=x in ballE) apply(erule_tac x=y in ballE) apply(erule_tac x="1 - u" in allE)
3.378 - by (auto simp add: *) qed
3.379 -
3.380 -lemma mem_convex:
3.381 - assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
3.382 - shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
3.383 - using assms unfolding convex_alt by auto
3.384 -
3.385 -lemma convex_empty[intro]: "convex {}"
3.386 - unfolding convex_def by simp
3.387 -
3.388 -lemma convex_singleton[intro]: "convex {a}"
3.389 - unfolding convex_def by (auto simp add:scaleR_left_distrib[THEN sym])
3.390 -
3.391 -lemma convex_UNIV[intro]: "convex UNIV"
3.392 - unfolding convex_def by auto
3.393 -
3.394 -lemma convex_Inter: "(\<forall>s\<in>f. convex s) ==> convex(\<Inter> f)"
3.395 - unfolding convex_def by auto
3.396 -
3.397 -lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
3.398 - unfolding convex_def by auto
3.399 -
3.400 -lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
3.401 - unfolding convex_def apply auto
3.402 - unfolding inner_add inner_scaleR
3.403 - by (metis real_convex_bound_le)
3.404 -
3.405 -lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
3.406 -proof- have *:"{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}" by auto
3.407 - show ?thesis apply(unfold *) using convex_halfspace_le[of "-a" "-b"] by auto qed
3.408 -
3.409 -lemma convex_hyperplane: "convex {x. inner a x = b}"
3.410 -proof-
3.411 - have *:"{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}" by auto
3.412 - show ?thesis unfolding * apply(rule convex_Int)
3.413 - using convex_halfspace_le convex_halfspace_ge by auto
3.414 -qed
3.415 -
3.416 -lemma convex_halfspace_lt: "convex {x. inner a x < b}"
3.417 - unfolding convex_def
3.418 - by(auto simp add: real_convex_bound_lt inner_add)
3.419 -
3.420 -lemma convex_halfspace_gt: "convex {x. inner a x > b}"
3.421 - using convex_halfspace_lt[of "-a" "-b"] by auto
3.422 -
3.423 -lemma convex_positive_orthant: "convex {x::real^'n::finite. (\<forall>i. 0 \<le> x$i)}"
3.424 - unfolding convex_def apply auto apply(erule_tac x=i in allE)+
3.425 - apply(rule add_nonneg_nonneg) by(auto simp add: mult_nonneg_nonneg)
3.426 -
3.427 -subsection {* Explicit expressions for convexity in terms of arbitrary sums. *}
3.428 -
3.429 -lemma convex: "convex s \<longleftrightarrow>
3.430 - (\<forall>(k::nat) u x. (\<forall>i. 1\<le>i \<and> i\<le>k \<longrightarrow> 0 \<le> u i \<and> x i \<in>s) \<and> (setsum u {1..k} = 1)
3.431 - \<longrightarrow> setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
3.432 - unfolding convex_def apply rule apply(rule allI)+ defer apply(rule ballI)+ apply(rule allI)+ proof(rule,rule,rule,rule)
3.433 - fix x y u v assume as:"\<forall>(k::nat) u x. (\<forall>i. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R x i) \<in> s"
3.434 - "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
3.435 - show "u *\<^sub>R x + v *\<^sub>R y \<in> s" using as(1)[THEN spec[where x=2], THEN spec[where x="\<lambda>n. if n=1 then u else v"], THEN spec[where x="\<lambda>n. if n=1 then x else y"]] and as(2-)
3.436 - by (auto simp add: setsum_head_Suc)
3.437 -next
3.438 - fix k u x assume as:"\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s"
3.439 - show "(\<forall>i::nat. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R x i) \<in> s" apply(rule,erule conjE) proof(induct k arbitrary: u)
3.440 - case (Suc k) show ?case proof(cases "u (Suc k) = 1")
3.441 - case True hence "(\<Sum>i = Suc 0..k. u i *\<^sub>R x i) = 0" apply(rule_tac setsum_0') apply(rule ccontr) unfolding ball_simps apply(erule bexE) proof-
3.442 - fix i assume i:"i \<in> {Suc 0..k}" "u i *\<^sub>R x i \<noteq> 0"
3.443 - hence ui:"u i \<noteq> 0" by auto
3.444 - hence "setsum (\<lambda>k. if k=i then u i else 0) {1 .. k} \<le> setsum u {1 .. k}" apply(rule_tac setsum_mono) using Suc(2) by auto
3.445 - hence "setsum u {1 .. k} \<ge> u i" using i(1) by(auto simp add: setsum_delta)
3.446 - hence "setsum u {1 .. k} > 0" using ui apply(rule_tac less_le_trans[of _ "u i"]) using Suc(2)[THEN spec[where x=i]] and i(1) by auto
3.447 - thus False using Suc(3) unfolding setsum_cl_ivl_Suc and True by simp qed
3.448 - thus ?thesis unfolding setsum_cl_ivl_Suc using True and Suc(2) by auto
3.449 - next
3.450 - have *:"setsum u {1..k} = 1 - u (Suc k)" using Suc(3)[unfolded setsum_cl_ivl_Suc] by auto
3.451 - have **:"u (Suc k) \<le> 1" apply(rule ccontr) unfolding not_le using Suc(3) using setsum_nonneg[of "{1..k}" u] using Suc(2) by auto
3.452 - have ***:"\<And>i k. (u i / (1 - u (Suc k))) *\<^sub>R x i = (inverse (1 - u (Suc k))) *\<^sub>R (u i *\<^sub>R x i)" unfolding real_divide_def by (auto simp add: algebra_simps)
3.453 - case False hence nn:"1 - u (Suc k) \<noteq> 0" by auto
3.454 - have "(\<Sum>i = 1..k. (u i / (1 - u (Suc k))) *\<^sub>R x i) \<in> s" apply(rule Suc(1)) unfolding setsum_divide_distrib[THEN sym] and *
3.455 - apply(rule_tac allI) apply(rule,rule) apply(rule divide_nonneg_pos) using nn Suc(2) ** by auto
3.456 - hence "(1 - u (Suc k)) *\<^sub>R (\<Sum>i = 1..k. (u i / (1 - u (Suc k))) *\<^sub>R x i) + u (Suc k) *\<^sub>R x (Suc k) \<in> s"
3.457 - apply(rule as[THEN bspec, THEN bspec, THEN spec, THEN mp, THEN spec, THEN mp, THEN mp]) using Suc(2)[THEN spec[where x="Suc k"]] and ** by auto
3.458 - thus ?thesis unfolding setsum_cl_ivl_Suc and *** and scaleR_right.setsum [symmetric] using nn by auto qed qed auto qed
3.459 -
3.460 -
3.461 -lemma convex_explicit:
3.462 - fixes s :: "'a::real_vector set"
3.463 - shows "convex s \<longleftrightarrow>
3.464 - (\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) t \<in> s)"
3.465 - unfolding convex_def apply(rule,rule,rule) apply(subst imp_conjL,rule) defer apply(rule,rule,rule,rule,rule,rule,rule) proof-
3.466 - fix x y u v assume as:"\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
3.467 - show "u *\<^sub>R x + v *\<^sub>R y \<in> s" proof(cases "x=y")
3.468 - case True show ?thesis unfolding True and scaleR_left_distrib[THEN sym] using as(3,6) by auto next
3.469 - case False thus ?thesis using as(1)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>z. if z=x then u else v"]] and as(2-) by auto qed
3.470 -next
3.471 - fix t u assume asm:"\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s" "finite (t::'a set)"
3.472 - (*"finite t" "t \<subseteq> s" "\<forall>x\<in>t. (0::real) \<le> u x" "setsum u t = 1"*)
3.473 - from this(2) have "\<forall>u. t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" apply(induct_tac t rule:finite_induct)
3.474 - prefer 3 apply (rule,rule) apply(erule conjE)+ proof-
3.475 - fix x f u assume ind:"\<forall>u. f \<subseteq> s \<and> (\<forall>x\<in>f. 0 \<le> u x) \<and> setsum u f = 1 \<longrightarrow> (\<Sum>x\<in>f. u x *\<^sub>R x) \<in> s"
3.476 - assume as:"finite f" "x \<notin> f" "insert x f \<subseteq> s" "\<forall>x\<in>insert x f. 0 \<le> u x" "setsum u (insert x f) = (1::real)"
3.477 - show "(\<Sum>x\<in>insert x f. u x *\<^sub>R x) \<in> s" proof(cases "u x = 1")
3.478 - case True hence "setsum (\<lambda>x. u x *\<^sub>R x) f = 0" apply(rule_tac setsum_0') apply(rule ccontr) unfolding ball_simps apply(erule bexE) proof-
3.479 - fix y assume y:"y \<in> f" "u y *\<^sub>R y \<noteq> 0"
3.480 - hence uy:"u y \<noteq> 0" by auto
3.481 - hence "setsum (\<lambda>k. if k=y then u y else 0) f \<le> setsum u f" apply(rule_tac setsum_mono) using as(4) by auto
3.482 - hence "setsum u f \<ge> u y" using y(1) and as(1) by(auto simp add: setsum_delta)
3.483 - hence "setsum u f > 0" using uy apply(rule_tac less_le_trans[of _ "u y"]) using as(4) and y(1) by auto
3.484 - thus False using as(2,5) unfolding setsum_clauses(2)[OF as(1)] and True by auto qed
3.485 - thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2,3) unfolding True by auto
3.486 - next
3.487 - have *:"setsum u f = setsum u (insert x f) - u x" using as(2) unfolding setsum_clauses(2)[OF as(1)] by auto
3.488 - have **:"u x \<le> 1" apply(rule ccontr) unfolding not_le using as(5)[unfolded setsum_clauses(2)[OF as(1)]] and as(2)
3.489 - using setsum_nonneg[of f u] and as(4) by auto
3.490 - case False hence "inverse (1 - u x) *\<^sub>R (\<Sum>x\<in>f. u x *\<^sub>R x) \<in> s" unfolding scaleR_right.setsum and scaleR_scaleR
3.491 - apply(rule_tac ind[THEN spec, THEN mp]) apply rule defer apply rule apply rule apply(rule mult_nonneg_nonneg)
3.492 - unfolding setsum_right_distrib[THEN sym] and * using as and ** by auto
3.493 - hence "u x *\<^sub>R x + (1 - u x) *\<^sub>R ((inverse (1 - u x)) *\<^sub>R setsum (\<lambda>x. u x *\<^sub>R x) f) \<in>s"
3.494 - apply(rule_tac asm(1)[THEN bspec, THEN bspec, THEN spec, THEN mp, THEN spec, THEN mp, THEN mp]) using as and ** False by auto
3.495 - thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2) and False by auto qed
3.496 - qed auto thus "t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" by auto
3.497 -qed
3.498 -
3.499 -lemma convex_finite: assumes "finite s"
3.500 - shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1
3.501 - \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
3.502 - unfolding convex_explicit apply(rule, rule, rule) defer apply(rule,rule,rule)apply(erule conjE)+ proof-
3.503 - fix t u assume as:"\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> s" " finite t" "t \<subseteq> s" "\<forall>x\<in>t. 0 \<le> u x" "setsum u t = (1::real)"
3.504 - have *:"s \<inter> t = t" using as(3) by auto
3.505 - show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" using as(1)[THEN spec[where x="\<lambda>x. if x\<in>t then u x else 0"]]
3.506 - unfolding if_smult and setsum_cases[OF assms] and * using as(2-) by auto
3.507 -qed (erule_tac x=s in allE, erule_tac x=u in allE, auto)
3.508 -
3.509 -subsection {* Cones. *}
3.510 -
3.511 -definition
3.512 - cone :: "'a::real_vector set \<Rightarrow> bool" where
3.513 - "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
3.514 -
3.515 -lemma cone_empty[intro, simp]: "cone {}"
3.516 - unfolding cone_def by auto
3.517 -
3.518 -lemma cone_univ[intro, simp]: "cone UNIV"
3.519 - unfolding cone_def by auto
3.520 -
3.521 -lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
3.522 - unfolding cone_def by auto
3.523 -
3.524 -subsection {* Conic hull. *}
3.525 -
3.526 -lemma cone_cone_hull: "cone (cone hull s)"
3.527 - unfolding hull_def using cone_Inter[of "{t \<in> conic. s \<subseteq> t}"]
3.528 - by (auto simp add: mem_def)
3.529 -
3.530 -lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
3.531 - apply(rule hull_eq[unfolded mem_def])
3.532 - using cone_Inter unfolding subset_eq by (auto simp add: mem_def)
3.533 -
3.534 -subsection {* Affine dependence and consequential theorems (from Lars Schewe). *}
3.535 -
3.536 -definition
3.537 - affine_dependent :: "'a::real_vector set \<Rightarrow> bool" where
3.538 - "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
3.539 -
3.540 -lemma affine_dependent_explicit:
3.541 - "affine_dependent p \<longleftrightarrow>
3.542 - (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
3.543 - (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
3.544 - unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq apply(rule)
3.545 - apply(erule bexE,erule exE,erule exE) apply(erule conjE)+ defer apply(erule exE,erule exE) apply(erule conjE)+ apply(erule bexE)
3.546 -proof-
3.547 - fix x s u assume as:"x \<in> p" "finite s" "s \<noteq> {}" "s \<subseteq> p - {x}" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.548 - have "x\<notin>s" using as(1,4) by auto
3.549 - show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
3.550 - apply(rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
3.551 - unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as using as by auto
3.552 -next
3.553 - fix s u v assume as:"finite s" "s \<subseteq> p" "setsum u s = 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" "v \<in> s" "u v \<noteq> 0"
3.554 - have "s \<noteq> {v}" using as(3,6) by auto
3.555 - thus "\<exists>x\<in>p. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p - {x} \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.556 - apply(rule_tac x=v in bexI, rule_tac x="s - {v}" in exI, rule_tac x="\<lambda>x. - (1 / u v) * u x" in exI)
3.557 - unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] unfolding setsum_right_distrib[THEN sym] and setsum_diff1[OF as(1)] using as by auto
3.558 -qed
3.559 -
3.560 -lemma affine_dependent_explicit_finite:
3.561 - fixes s :: "'a::real_vector set" assumes "finite s"
3.562 - shows "affine_dependent s \<longleftrightarrow> (\<exists>u. setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
3.563 - (is "?lhs = ?rhs")
3.564 -proof
3.565 - have *:"\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else (0::'a))" by auto
3.566 - assume ?lhs
3.567 - then obtain t u v where "finite t" "t \<subseteq> s" "setsum u t = 0" "v\<in>t" "u v \<noteq> 0" "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
3.568 - unfolding affine_dependent_explicit by auto
3.569 - thus ?rhs apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
3.570 - apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
3.571 - unfolding Int_absorb1[OF `t\<subseteq>s`] by auto
3.572 -next
3.573 - assume ?rhs
3.574 - then obtain u v where "setsum u s = 0" "v\<in>s" "u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" by auto
3.575 - thus ?lhs unfolding affine_dependent_explicit using assms by auto
3.576 -qed
3.577 -
3.578 -subsection {* A general lemma. *}
3.579 -
3.580 -lemma convex_connected:
3.581 - fixes s :: "'a::real_normed_vector set"
3.582 - assumes "convex s" shows "connected s"
3.583 -proof-
3.584 - { fix e1 e2 assume as:"open e1" "open e2" "e1 \<inter> e2 \<inter> s = {}" "s \<subseteq> e1 \<union> e2"
3.585 - assume "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
3.586 - then obtain x1 x2 where x1:"x1\<in>e1" "x1\<in>s" and x2:"x2\<in>e2" "x2\<in>s" by auto
3.587 - hence n:"norm (x1 - x2) > 0" unfolding zero_less_norm_iff using as(3) by auto
3.588 -
3.589 - { fix x e::real assume as:"0 \<le> x" "x \<le> 1" "0 < e"
3.590 - { fix y have *:"(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2) = (y - x) *\<^sub>R x1 - (y - x) *\<^sub>R x2"
3.591 - by (simp add: algebra_simps)
3.592 - assume "\<bar>y - x\<bar> < e / norm (x1 - x2)"
3.593 - hence "norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
3.594 - unfolding * and scaleR_right_diff_distrib[THEN sym]
3.595 - unfolding less_divide_eq using n by auto }
3.596 - hence "\<exists>d>0. \<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
3.597 - apply(rule_tac x="e / norm (x1 - x2)" in exI) using as
3.598 - apply auto unfolding zero_less_divide_iff using n by simp } note * = this
3.599 -
3.600 - have "\<exists>x\<ge>0. x \<le> 1 \<and> (1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e1 \<and> (1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e2"
3.601 - apply(rule connected_real_lemma) apply (simp add: `x1\<in>e1` `x2\<in>e2` dist_commute)+
3.602 - using * apply(simp add: dist_norm)
3.603 - using as(1,2)[unfolded open_dist] apply simp
3.604 - using as(1,2)[unfolded open_dist] apply simp
3.605 - using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]] using x1 x2
3.606 - using as(3) by auto
3.607 - then obtain x where "x\<ge>0" "x\<le>1" "(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e1" "(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e2" by auto
3.608 - hence False using as(4)
3.609 - using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]]
3.610 - using x1(2) x2(2) by auto }
3.611 - thus ?thesis unfolding connected_def by auto
3.612 -qed
3.613 -
3.614 -subsection {* One rather trivial consequence. *}
3.615 -
3.616 -lemma connected_UNIV: "connected (UNIV :: 'a::real_normed_vector set)"
3.617 - by(simp add: convex_connected convex_UNIV)
3.618 -
3.619 -subsection {* Convex functions into the reals. *}
3.620 -
3.621 -definition
3.622 - convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool" where
3.623 - "convex_on s f \<longleftrightarrow>
3.624 - (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y)"
3.625 -
3.626 -lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
3.627 - unfolding convex_on_def by auto
3.628 -
3.629 -lemma convex_add:
3.630 - assumes "convex_on s f" "convex_on s g"
3.631 - shows "convex_on s (\<lambda>x. f x + g x)"
3.632 -proof-
3.633 - { fix x y assume "x\<in>s" "y\<in>s" moreover
3.634 - fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
3.635 - ultimately have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> (u * f x + v * f y) + (u * g x + v * g y)"
3.636 - using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
3.637 - using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
3.638 - apply - apply(rule add_mono) by auto
3.639 - hence "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> u * (f x + g x) + v * (f y + g y)" by (simp add: ring_simps) }
3.640 - thus ?thesis unfolding convex_on_def by auto
3.641 -qed
3.642 -
3.643 -lemma convex_cmul:
3.644 - assumes "0 \<le> (c::real)" "convex_on s f"
3.645 - shows "convex_on s (\<lambda>x. c * f x)"
3.646 -proof-
3.647 - have *:"\<And>u c fx v fy ::real. u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)" by (simp add: ring_simps)
3.648 - show ?thesis using assms(2) and mult_mono1[OF _ assms(1)] unfolding convex_on_def and * by auto
3.649 -qed
3.650 -
3.651 -lemma convex_lower:
3.652 - assumes "convex_on s f" "x\<in>s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = 1"
3.653 - shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
3.654 -proof-
3.655 - let ?m = "max (f x) (f y)"
3.656 - have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)" apply(rule add_mono)
3.657 - using assms(4,5) by(auto simp add: mult_mono1)
3.658 - also have "\<dots> = max (f x) (f y)" using assms(6) unfolding distrib[THEN sym] by auto
3.659 - finally show ?thesis using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
3.660 - using assms(2-6) by auto
3.661 -qed
3.662 -
3.663 -lemma convex_local_global_minimum:
3.664 - fixes s :: "'a::real_normed_vector set"
3.665 - assumes "0<e" "convex_on s f" "ball x e \<subseteq> s" "\<forall>y\<in>ball x e. f x \<le> f y"
3.666 - shows "\<forall>y\<in>s. f x \<le> f y"
3.667 -proof(rule ccontr)
3.668 - have "x\<in>s" using assms(1,3) by auto
3.669 - assume "\<not> (\<forall>y\<in>s. f x \<le> f y)"
3.670 - then obtain y where "y\<in>s" and y:"f x > f y" by auto
3.671 - hence xy:"0 < dist x y" by (auto simp add: dist_nz[THEN sym])
3.672 -
3.673 - then obtain u where "0 < u" "u \<le> 1" and u:"u < e / dist x y"
3.674 - using real_lbound_gt_zero[of 1 "e / dist x y"] using xy `e>0` and divide_pos_pos[of e "dist x y"] by auto
3.675 - hence "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \<le> (1-u) * f x + u * f y" using `x\<in>s` `y\<in>s`
3.676 - using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x="1-u"]] by auto
3.677 - moreover
3.678 - have *:"x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" by (simp add: algebra_simps)
3.679 - have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> ball x e" unfolding mem_ball dist_norm unfolding * and norm_scaleR and abs_of_pos[OF `0<u`] unfolding dist_norm[THEN sym]
3.680 - using u unfolding pos_less_divide_eq[OF xy] by auto
3.681 - hence "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" using assms(4) by auto
3.682 - ultimately show False using mult_strict_left_mono[OF y `u>0`] unfolding left_diff_distrib by auto
3.683 -qed
3.684 -
3.685 -lemma convex_distance:
3.686 - fixes s :: "'a::real_normed_vector set"
3.687 - shows "convex_on s (\<lambda>x. dist a x)"
3.688 -proof(auto simp add: convex_on_def dist_norm)
3.689 - fix x y assume "x\<in>s" "y\<in>s"
3.690 - fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
3.691 - have "a = u *\<^sub>R a + v *\<^sub>R a" unfolding scaleR_left_distrib[THEN sym] and `u+v=1` by simp
3.692 - hence *:"a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
3.693 - by (auto simp add: algebra_simps)
3.694 - show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
3.695 - unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
3.696 - using `0 \<le> u` `0 \<le> v` by auto
3.697 -qed
3.698 -
3.699 -subsection {* Arithmetic operations on sets preserve convexity. *}
3.700 -
3.701 -lemma convex_scaling: "convex s \<Longrightarrow> convex ((\<lambda>x. c *\<^sub>R x) ` s)"
3.702 - unfolding convex_def and image_iff apply auto
3.703 - apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by (auto simp add: algebra_simps)
3.704 -
3.705 -lemma convex_negations: "convex s \<Longrightarrow> convex ((\<lambda>x. -x)` s)"
3.706 - unfolding convex_def and image_iff apply auto
3.707 - apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by auto
3.708 -
3.709 -lemma convex_sums:
3.710 - assumes "convex s" "convex t"
3.711 - shows "convex {x + y| x y. x \<in> s \<and> y \<in> t}"
3.712 -proof(auto simp add: convex_def image_iff scaleR_right_distrib)
3.713 - fix xa xb ya yb assume xy:"xa\<in>s" "xb\<in>s" "ya\<in>t" "yb\<in>t"
3.714 - fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
3.715 - show "\<exists>x y. u *\<^sub>R xa + u *\<^sub>R ya + (v *\<^sub>R xb + v *\<^sub>R yb) = x + y \<and> x \<in> s \<and> y \<in> t"
3.716 - apply(rule_tac x="u *\<^sub>R xa + v *\<^sub>R xb" in exI) apply(rule_tac x="u *\<^sub>R ya + v *\<^sub>R yb" in exI)
3.717 - using assms(1)[unfolded convex_def, THEN bspec[where x=xa], THEN bspec[where x=xb]]
3.718 - using assms(2)[unfolded convex_def, THEN bspec[where x=ya], THEN bspec[where x=yb]]
3.719 - using uv xy by auto
3.720 -qed
3.721 -
3.722 -lemma convex_differences:
3.723 - assumes "convex s" "convex t"
3.724 - shows "convex {x - y| x y. x \<in> s \<and> y \<in> t}"
3.725 -proof-
3.726 - have "{x - y| x y. x \<in> s \<and> y \<in> t} = {x + y |x y. x \<in> s \<and> y \<in> uminus ` t}" unfolding image_iff apply auto
3.727 - apply(rule_tac x=xa in exI) apply(rule_tac x="-y" in exI) apply simp
3.728 - apply(rule_tac x=xa in exI) apply(rule_tac x=xb in exI) by simp
3.729 - thus ?thesis using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
3.730 -qed
3.731 -
3.732 -lemma convex_translation: assumes "convex s" shows "convex ((\<lambda>x. a + x) ` s)"
3.733 -proof- have "{a + y |y. y \<in> s} = (\<lambda>x. a + x) ` s" by auto
3.734 - thus ?thesis using convex_sums[OF convex_singleton[of a] assms] by auto qed
3.735 -
3.736 -lemma convex_affinity: assumes "convex s" shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` s)"
3.737 -proof- have "(\<lambda>x. a + c *\<^sub>R x) ` s = op + a ` op *\<^sub>R c ` s" by auto
3.738 - thus ?thesis using convex_translation[OF convex_scaling[OF assms], of a c] by auto qed
3.739 -
3.740 -lemma convex_linear_image:
3.741 - assumes c:"convex s" and l:"bounded_linear f"
3.742 - shows "convex(f ` s)"
3.743 -proof(auto simp add: convex_def)
3.744 - interpret f: bounded_linear f by fact
3.745 - fix x y assume xy:"x \<in> s" "y \<in> s"
3.746 - fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
3.747 - show "u *\<^sub>R f x + v *\<^sub>R f y \<in> f ` s" unfolding image_iff
3.748 - apply(rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in bexI)
3.749 - unfolding f.add f.scaleR
3.750 - using c[unfolded convex_def] xy uv by auto
3.751 -qed
3.752 -
3.753 -subsection {* Balls, being convex, are connected. *}
3.754 -
3.755 -lemma convex_ball:
3.756 - fixes x :: "'a::real_normed_vector"
3.757 - shows "convex (ball x e)"
3.758 -proof(auto simp add: convex_def)
3.759 - fix y z assume yz:"dist x y < e" "dist x z < e"
3.760 - fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
3.761 - have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
3.762 - using convex_distance[of "ball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
3.763 - thus "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" using real_convex_bound_lt[OF yz uv] by auto
3.764 -qed
3.765 -
3.766 -lemma convex_cball:
3.767 - fixes x :: "'a::real_normed_vector"
3.768 - shows "convex(cball x e)"
3.769 -proof(auto simp add: convex_def Ball_def mem_cball)
3.770 - fix y z assume yz:"dist x y \<le> e" "dist x z \<le> e"
3.771 - fix u v ::real assume uv:" 0 \<le> u" "0 \<le> v" "u + v = 1"
3.772 - have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
3.773 - using convex_distance[of "cball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
3.774 - thus "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e" using real_convex_bound_le[OF yz uv] by auto
3.775 -qed
3.776 -
3.777 -lemma connected_ball:
3.778 - fixes x :: "'a::real_normed_vector"
3.779 - shows "connected (ball x e)"
3.780 - using convex_connected convex_ball by auto
3.781 -
3.782 -lemma connected_cball:
3.783 - fixes x :: "'a::real_normed_vector"
3.784 - shows "connected(cball x e)"
3.785 - using convex_connected convex_cball by auto
3.786 -
3.787 -subsection {* Convex hull. *}
3.788 -
3.789 -lemma convex_convex_hull: "convex(convex hull s)"
3.790 - unfolding hull_def using convex_Inter[of "{t\<in>convex. s\<subseteq>t}"]
3.791 - unfolding mem_def by auto
3.792 -
3.793 -lemma convex_hull_eq: "(convex hull s = s) \<longleftrightarrow> convex s" apply(rule hull_eq[unfolded mem_def])
3.794 - using convex_Inter[unfolded Ball_def mem_def] by auto
3.795 -
3.796 -lemma bounded_convex_hull:
3.797 - fixes s :: "'a::real_normed_vector set"
3.798 - assumes "bounded s" shows "bounded(convex hull s)"
3.799 -proof- from assms obtain B where B:"\<forall>x\<in>s. norm x \<le> B" unfolding bounded_iff by auto
3.800 - show ?thesis apply(rule bounded_subset[OF bounded_cball, of _ 0 B])
3.801 - unfolding subset_hull[unfolded mem_def, of convex, OF convex_cball]
3.802 - unfolding subset_eq mem_cball dist_norm using B by auto qed
3.803 -
3.804 -lemma finite_imp_bounded_convex_hull:
3.805 - fixes s :: "'a::real_normed_vector set"
3.806 - shows "finite s \<Longrightarrow> bounded(convex hull s)"
3.807 - using bounded_convex_hull finite_imp_bounded by auto
3.808 -
3.809 -subsection {* Stepping theorems for convex hulls of finite sets. *}
3.810 -
3.811 -lemma convex_hull_empty[simp]: "convex hull {} = {}"
3.812 - apply(rule hull_unique) unfolding mem_def by auto
3.813 -
3.814 -lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
3.815 - apply(rule hull_unique) unfolding mem_def by auto
3.816 -
3.817 -lemma convex_hull_insert:
3.818 - fixes s :: "'a::real_vector set"
3.819 - assumes "s \<noteq> {}"
3.820 - shows "convex hull (insert a s) = {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and>
3.821 - b \<in> (convex hull s) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}" (is "?xyz = ?hull")
3.822 - apply(rule,rule hull_minimal,rule) unfolding mem_def[of _ convex] and insert_iff prefer 3 apply rule proof-
3.823 - fix x assume x:"x = a \<or> x \<in> s"
3.824 - thus "x\<in>?hull" apply rule unfolding mem_Collect_eq apply(rule_tac x=1 in exI) defer
3.825 - apply(rule_tac x=0 in exI) using assms hull_subset[of s convex] by auto
3.826 -next
3.827 - fix x assume "x\<in>?hull"
3.828 - then obtain u v b where obt:"u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "x = u *\<^sub>R a + v *\<^sub>R b" by auto
3.829 - have "a\<in>convex hull insert a s" "b\<in>convex hull insert a s"
3.830 - using hull_mono[of s "insert a s" convex] hull_mono[of "{a}" "insert a s" convex] and obt(4) by auto
3.831 - thus "x\<in> convex hull insert a s" unfolding obt(5) using convex_convex_hull[of "insert a s", unfolded convex_def]
3.832 - apply(erule_tac x=a in ballE) apply(erule_tac x=b in ballE) apply(erule_tac x=u in allE) using obt by auto
3.833 -next
3.834 - show "convex ?hull" unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
3.835 - fix x y u v assume as:"(0::real) \<le> u" "0 \<le> v" "u + v = 1" "x\<in>?hull" "y\<in>?hull"
3.836 - from as(4) obtain u1 v1 b1 where obt1:"u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull s" "x = u1 *\<^sub>R a + v1 *\<^sub>R b1" by auto
3.837 - from as(5) obtain u2 v2 b2 where obt2:"u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull s" "y = u2 *\<^sub>R a + v2 *\<^sub>R b2" by auto
3.838 - have *:"\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp add: algebra_simps)
3.839 - have "\<exists>b \<in> convex hull s. u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"
3.840 - proof(cases "u * v1 + v * v2 = 0")
3.841 - have *:"\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp add: algebra_simps)
3.842 - case True hence **:"u * v1 = 0" "v * v2 = 0" apply- apply(rule_tac [!] ccontr)
3.843 - using mult_nonneg_nonneg[OF `u\<ge>0` `v1\<ge>0`] mult_nonneg_nonneg[OF `v\<ge>0` `v2\<ge>0`] by auto
3.844 - hence "u * u1 + v * u2 = 1" using as(3) obt1(3) obt2(3) by auto
3.845 - thus ?thesis unfolding obt1(5) obt2(5) * using assms hull_subset[of s convex] by(auto simp add: ** scaleR_right_distrib)
3.846 - next
3.847 - have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
3.848 - also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
3.849 - also have "\<dots> = u * v1 + v * v2" by simp finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
3.850 - case False have "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2" apply -
3.851 - apply(rule add_nonneg_nonneg) prefer 4 apply(rule add_nonneg_nonneg) apply(rule_tac [!] mult_nonneg_nonneg)
3.852 - using as(1,2) obt1(1,2) obt2(1,2) by auto
3.853 - thus ?thesis unfolding obt1(5) obt2(5) unfolding * and ** using False
3.854 - apply(rule_tac x="((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2" in bexI) defer
3.855 - apply(rule convex_convex_hull[of s, unfolded convex_def, rule_format]) using obt1(4) obt2(4)
3.856 - unfolding add_divide_distrib[THEN sym] and real_0_le_divide_iff
3.857 - by (auto simp add: scaleR_left_distrib scaleR_right_distrib)
3.858 - qed note * = this
3.859 - have u1:"u1 \<le> 1" apply(rule ccontr) unfolding obt1(3)[THEN sym] and not_le using obt1(2) by auto
3.860 - have u2:"u2 \<le> 1" apply(rule ccontr) unfolding obt2(3)[THEN sym] and not_le using obt2(2) by auto
3.861 - have "u1 * u + u2 * v \<le> (max u1 u2) * u + (max u1 u2) * v" apply(rule add_mono)
3.862 - apply(rule_tac [!] mult_right_mono) using as(1,2) obt1(1,2) obt2(1,2) by auto
3.863 - also have "\<dots> \<le> 1" unfolding mult.add_right[THEN sym] and as(3) using u1 u2 by auto
3.864 - finally
3.865 - show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" unfolding mem_Collect_eq apply(rule_tac x="u * u1 + v * u2" in exI)
3.866 - apply(rule conjI) defer apply(rule_tac x="1 - u * u1 - v * u2" in exI) unfolding Bex_def
3.867 - using as(1,2) obt1(1,2) obt2(1,2) * by(auto intro!: mult_nonneg_nonneg add_nonneg_nonneg simp add: algebra_simps)
3.868 - qed
3.869 -qed
3.870 -
3.871 -
3.872 -subsection {* Explicit expression for convex hull. *}
3.873 -
3.874 -lemma convex_hull_indexed:
3.875 - fixes s :: "'a::real_vector set"
3.876 - shows "convex hull s = {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> s) \<and>
3.877 - (setsum u {1..k} = 1) \<and>
3.878 - (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} = y)}" (is "?xyz = ?hull")
3.879 - apply(rule hull_unique) unfolding mem_def[of _ convex] apply(rule) defer
3.880 - apply(subst convex_def) apply(rule,rule,rule,rule,rule,rule,rule)
3.881 -proof-
3.882 - fix x assume "x\<in>s"
3.883 - thus "x \<in> ?hull" unfolding mem_Collect_eq apply(rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
3.884 -next
3.885 - fix t assume as:"s \<subseteq> t" "convex t"
3.886 - show "?hull \<subseteq> t" apply(rule) unfolding mem_Collect_eq apply(erule exE | erule conjE)+ proof-
3.887 - fix x k u y assume assm:"\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> s" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
3.888 - show "x\<in>t" unfolding assm(3)[THEN sym] apply(rule as(2)[unfolded convex, rule_format])
3.889 - using assm(1,2) as(1) by auto qed
3.890 -next
3.891 - fix x y u v assume uv:"0\<le>u" "0\<le>v" "u+v=(1::real)" and xy:"x\<in>?hull" "y\<in>?hull"
3.892 - from xy obtain k1 u1 x1 where x:"\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> s" "setsum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x" by auto
3.893 - from xy obtain k2 u2 x2 where y:"\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> s" "setsum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y" by auto
3.894 - have *:"\<And>P (x1::'a) x2 s1 s2 i.(if P i then s1 else s2) *\<^sub>R (if P i then x1 else x2) = (if P i then s1 *\<^sub>R x1 else s2 *\<^sub>R x2)"
3.895 - "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
3.896 - prefer 3 apply(rule,rule) unfolding image_iff apply(rule_tac x="x - k1" in bexI) by(auto simp add: not_le)
3.897 - have inj:"inj_on (\<lambda>i. i + k1) {1..k2}" unfolding inj_on_def by auto
3.898 - show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" apply(rule)
3.899 - apply(rule_tac x="k1 + k2" in exI, rule_tac x="\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)" in exI)
3.900 - apply(rule_tac x="\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)" in exI) apply(rule,rule) defer apply(rule)
3.901 - unfolding * and setsum_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]] and setsum_reindex[OF inj] and o_def
3.902 - unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] setsum_right_distrib[THEN sym] proof-
3.903 - fix i assume i:"i \<in> {1..k1+k2}"
3.904 - show "0 \<le> (if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)) \<and> (if i \<in> {1..k1} then x1 i else x2 (i - k1)) \<in> s"
3.905 - proof(cases "i\<in>{1..k1}")
3.906 - case True thus ?thesis using mult_nonneg_nonneg[of u "u1 i"] and uv(1) x(1)[THEN bspec[where x=i]] by auto
3.907 - next def j \<equiv> "i - k1"
3.908 - case False with i have "j \<in> {1..k2}" unfolding j_def by auto
3.909 - thus ?thesis unfolding j_def[symmetric] using False
3.910 - using mult_nonneg_nonneg[of v "u2 j"] and uv(2) y(1)[THEN bspec[where x=j]] by auto qed
3.911 - qed(auto simp add: not_le x(2,3) y(2,3) uv(3))
3.912 -qed
3.913 -
3.914 -lemma convex_hull_finite:
3.915 - fixes s :: "'a::real_vector set"
3.916 - assumes "finite s"
3.917 - shows "convex hull s = {y. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and>
3.918 - setsum u s = 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y}" (is "?HULL = ?set")
3.919 -proof(rule hull_unique, auto simp add: mem_def[of _ convex] convex_def[of ?set])
3.920 - fix x assume "x\<in>s" thus " \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = x"
3.921 - apply(rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) apply auto
3.922 - unfolding setsum_delta'[OF assms] and setsum_delta''[OF assms] by auto
3.923 -next
3.924 - fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
3.925 - fix ux assume ux:"\<forall>x\<in>s. 0 \<le> ux x" "setsum ux s = (1::real)"
3.926 - fix uy assume uy:"\<forall>x\<in>s. 0 \<le> uy x" "setsum uy s = (1::real)"
3.927 - { fix x assume "x\<in>s"
3.928 - hence "0 \<le> u * ux x + v * uy x" using ux(1)[THEN bspec[where x=x]] uy(1)[THEN bspec[where x=x]] and uv(1,2)
3.929 - by (auto, metis add_nonneg_nonneg mult_nonneg_nonneg uv(1) uv(2)) }
3.930 - moreover have "(\<Sum>x\<in>s. u * ux x + v * uy x) = 1"
3.931 - unfolding setsum_addf and setsum_right_distrib[THEN sym] and ux(2) uy(2) using uv(3) by auto
3.932 - moreover have "(\<Sum>x\<in>s. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
3.933 - unfolding scaleR_left_distrib and setsum_addf and scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] by auto
3.934 - ultimately show "\<exists>uc. (\<forall>x\<in>s. 0 \<le> uc x) \<and> setsum uc s = 1 \<and> (\<Sum>x\<in>s. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
3.935 - apply(rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI) by auto
3.936 -next
3.937 - fix t assume t:"s \<subseteq> t" "convex t"
3.938 - fix u assume u:"\<forall>x\<in>s. 0 \<le> u x" "setsum u s = (1::real)"
3.939 - thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> t" using t(2)[unfolded convex_explicit, THEN spec[where x=s], THEN spec[where x=u]]
3.940 - using assms and t(1) by auto
3.941 -qed
3.942 -
3.943 -subsection {* Another formulation from Lars Schewe. *}
3.944 -
3.945 -lemma setsum_constant_scaleR:
3.946 - fixes y :: "'a::real_vector"
3.947 - shows "(\<Sum>x\<in>A. y) = of_nat (card A) *\<^sub>R y"
3.948 -apply (cases "finite A")
3.949 -apply (induct set: finite)
3.950 -apply (simp_all add: algebra_simps)
3.951 -done
3.952 -
3.953 -lemma convex_hull_explicit:
3.954 - fixes p :: "'a::real_vector set"
3.955 - shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and>
3.956 - (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}" (is "?lhs = ?rhs")
3.957 -proof-
3.958 - { fix x assume "x\<in>?lhs"
3.959 - then obtain k u y where obt:"\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> p" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
3.960 - unfolding convex_hull_indexed by auto
3.961 -
3.962 - have fin:"finite {1..k}" by auto
3.963 - have fin':"\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
3.964 - { fix j assume "j\<in>{1..k}"
3.965 - hence "y j \<in> p" "0 \<le> setsum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
3.966 - using obt(1)[THEN bspec[where x=j]] and obt(2) apply simp
3.967 - apply(rule setsum_nonneg) using obt(1) by auto }
3.968 - moreover
3.969 - have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v}) = 1"
3.970 - unfolding setsum_image_gen[OF fin, THEN sym] using obt(2) by auto
3.971 - moreover have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
3.972 - using setsum_image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, THEN sym]
3.973 - unfolding scaleR_left.setsum using obt(3) by auto
3.974 - ultimately have "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
3.975 - apply(rule_tac x="y ` {1..k}" in exI)
3.976 - apply(rule_tac x="\<lambda>v. setsum u {i\<in>{1..k}. y i = v}" in exI) by auto
3.977 - hence "x\<in>?rhs" by auto }
3.978 - moreover
3.979 - { fix y assume "y\<in>?rhs"
3.980 - then obtain s u where obt:"finite s" "s \<subseteq> p" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
3.981 -
3.982 - obtain f where f:"inj_on f {1..card s}" "f ` {1..card s} = s" using ex_bij_betw_nat_finite_1[OF obt(1)] unfolding bij_betw_def by auto
3.983 -
3.984 - { fix i::nat assume "i\<in>{1..card s}"
3.985 - hence "f i \<in> s" apply(subst f(2)[THEN sym]) by auto
3.986 - hence "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto }
3.987 - moreover have *:"finite {1..card s}" by auto
3.988 - { fix y assume "y\<in>s"
3.989 - then obtain i where "i\<in>{1..card s}" "f i = y" using f using image_iff[of y f "{1..card s}"] by auto
3.990 - hence "{x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = {i}" apply auto using f(1)[unfolded inj_on_def] apply(erule_tac x=x in ballE) by auto
3.991 - hence "card {x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = 1" by auto
3.992 - hence "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x)) = u y"
3.993 - "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
3.994 - by (auto simp add: setsum_constant_scaleR) }
3.995 -
3.996 - hence "(\<Sum>x = 1..card s. u (f x)) = 1" "(\<Sum>i = 1..card s. u (f i) *\<^sub>R f i) = y"
3.997 - unfolding setsum_image_gen[OF *(1), of "\<lambda>x. u (f x) *\<^sub>R f x" f] and setsum_image_gen[OF *(1), of "\<lambda>x. u (f x)" f]
3.998 - unfolding f using setsum_cong2[of s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
3.999 - using setsum_cong2 [of s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x))" u] unfolding obt(4,5) by auto
3.1000 -
3.1001 - ultimately have "\<exists>k u x. (\<forall>i\<in>{1..k}. 0 \<le> u i \<and> x i \<in> p) \<and> setsum u {1..k} = 1 \<and> (\<Sum>i::nat = 1..k. u i *\<^sub>R x i) = y"
3.1002 - apply(rule_tac x="card s" in exI) apply(rule_tac x="u \<circ> f" in exI) apply(rule_tac x=f in exI) by fastsimp
3.1003 - hence "y \<in> ?lhs" unfolding convex_hull_indexed by auto }
3.1004 - ultimately show ?thesis unfolding expand_set_eq by blast
3.1005 -qed
3.1006 -
3.1007 -subsection {* A stepping theorem for that expansion. *}
3.1008 -
3.1009 -lemma convex_hull_finite_step:
3.1010 - fixes s :: "'a::real_vector set" assumes "finite s"
3.1011 - shows "(\<exists>u. (\<forall>x\<in>insert a s. 0 \<le> u x) \<and> setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y)
3.1012 - \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?lhs = ?rhs")
3.1013 -proof(rule, case_tac[!] "a\<in>s")
3.1014 - assume "a\<in>s" hence *:"insert a s = s" by auto
3.1015 - assume ?lhs thus ?rhs unfolding * apply(rule_tac x=0 in exI) by auto
3.1016 -next
3.1017 - assume ?lhs then obtain u where u:"\<forall>x\<in>insert a s. 0 \<le> u x" "setsum u (insert a s) = w" "(\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
3.1018 - assume "a\<notin>s" thus ?rhs apply(rule_tac x="u a" in exI) using u(1)[THEN bspec[where x=a]] apply simp
3.1019 - apply(rule_tac x=u in exI) using u[unfolded setsum_clauses(2)[OF assms]] and `a\<notin>s` by auto
3.1020 -next
3.1021 - assume "a\<in>s" hence *:"insert a s = s" by auto
3.1022 - have fin:"finite (insert a s)" using assms by auto
3.1023 - assume ?rhs then obtain v u where uv:"v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
3.1024 - show ?lhs apply(rule_tac x="\<lambda>x. (if a = x then v else 0) + u x" in exI) unfolding scaleR_left_distrib and setsum_addf and setsum_delta''[OF fin] and setsum_delta'[OF fin]
3.1025 - unfolding setsum_clauses(2)[OF assms] using uv and uv(2)[THEN bspec[where x=a]] and `a\<in>s` by auto
3.1026 -next
3.1027 - assume ?rhs then obtain v u where uv:"v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
3.1028 - moreover assume "a\<notin>s" moreover have "(\<Sum>x\<in>s. if a = x then v else u x) = setsum u s" "(\<Sum>x\<in>s. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)"
3.1029 - apply(rule_tac setsum_cong2) defer apply(rule_tac setsum_cong2) using `a\<notin>s` by auto
3.1030 - ultimately show ?lhs apply(rule_tac x="\<lambda>x. if a = x then v else u x" in exI) unfolding setsum_clauses(2)[OF assms] by auto
3.1031 -qed
3.1032 -
3.1033 -subsection {* Hence some special cases. *}
3.1034 -
3.1035 -lemma convex_hull_2:
3.1036 - "convex hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1}"
3.1037 -proof- have *:"\<And>u. (\<forall>x\<in>{a, b}. 0 \<le> u x) \<longleftrightarrow> 0 \<le> u a \<and> 0 \<le> u b" by auto have **:"finite {b}" by auto
3.1038 -show ?thesis apply(simp add: convex_hull_finite) unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
3.1039 - apply auto apply(rule_tac x=v in exI) apply(rule_tac x="1 - v" in exI) apply simp
3.1040 - apply(rule_tac x=u in exI) apply simp apply(rule_tac x="\<lambda>x. v" in exI) by simp qed
3.1041 -
3.1042 -lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u. 0 \<le> u \<and> u \<le> 1}"
3.1043 - unfolding convex_hull_2 unfolding Collect_def
3.1044 -proof(rule ext) have *:"\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y" by auto
3.1045 - fix x show "(\<exists>v u. x = v *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> v \<and> 0 \<le> u \<and> v + u = 1) = (\<exists>u. x = a + u *\<^sub>R (b - a) \<and> 0 \<le> u \<and> u \<le> 1)"
3.1046 - unfolding * apply auto apply(rule_tac[!] x=u in exI) by (auto simp add: algebra_simps) qed
3.1047 -
3.1048 -lemma convex_hull_3:
3.1049 - "convex hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c | u v w. 0 \<le> u \<and> 0 \<le> v \<and> 0 \<le> w \<and> u + v + w = 1}"
3.1050 -proof-
3.1051 - have fin:"finite {a,b,c}" "finite {b,c}" "finite {c}" by auto
3.1052 - have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
3.1053 - "\<And>x y z ::real^'n. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by (auto simp add: ring_simps)
3.1054 - show ?thesis unfolding convex_hull_finite[OF fin(1)] and Collect_def and convex_hull_finite_step[OF fin(2)] and *
3.1055 - unfolding convex_hull_finite_step[OF fin(3)] apply(rule ext) apply simp apply auto
3.1056 - apply(rule_tac x=va in exI) apply (rule_tac x="u c" in exI) apply simp
3.1057 - apply(rule_tac x="1 - v - w" in exI) apply simp apply(rule_tac x=v in exI) apply simp apply(rule_tac x="\<lambda>x. w" in exI) by simp qed
3.1058 -
3.1059 -lemma convex_hull_3_alt:
3.1060 - "convex hull {a,b,c} = {a + u *\<^sub>R (b - a) + v *\<^sub>R (c - a) | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v \<le> 1}"
3.1061 -proof- have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by auto
3.1062 - show ?thesis unfolding convex_hull_3 apply (auto simp add: *) apply(rule_tac x=v in exI) apply(rule_tac x=w in exI) apply (simp add: algebra_simps)
3.1063 - apply(rule_tac x=u in exI) apply(rule_tac x=v in exI) by (simp add: algebra_simps) qed
3.1064 -
3.1065 -subsection {* Relations among closure notions and corresponding hulls. *}
3.1066 -
3.1067 -text {* TODO: Generalize linear algebra concepts defined in @{text
3.1068 -Euclidean_Space.thy} so that we can generalize these lemmas. *}
3.1069 -
3.1070 -lemma subspace_imp_affine:
3.1071 - fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> affine s"
3.1072 - unfolding subspace_def affine_def smult_conv_scaleR by auto
3.1073 -
3.1074 -lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
3.1075 - unfolding affine_def convex_def by auto
3.1076 -
3.1077 -lemma subspace_imp_convex:
3.1078 - fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> convex s"
3.1079 - using subspace_imp_affine affine_imp_convex by auto
3.1080 -
3.1081 -lemma affine_hull_subset_span:
3.1082 - fixes s :: "(real ^ _) set" shows "(affine hull s) \<subseteq> (span s)"
3.1083 - unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
3.1084 - using subspace_imp_affine by auto
3.1085 -
3.1086 -lemma convex_hull_subset_span:
3.1087 - fixes s :: "(real ^ _) set" shows "(convex hull s) \<subseteq> (span s)"
3.1088 - unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
3.1089 - using subspace_imp_convex by auto
3.1090 -
3.1091 -lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
3.1092 - unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
3.1093 - using affine_imp_convex by auto
3.1094 -
3.1095 -lemma affine_dependent_imp_dependent:
3.1096 - fixes s :: "(real ^ _) set" shows "affine_dependent s \<Longrightarrow> dependent s"
3.1097 - unfolding affine_dependent_def dependent_def
3.1098 - using affine_hull_subset_span by auto
3.1099 -
3.1100 -lemma dependent_imp_affine_dependent:
3.1101 - fixes s :: "(real ^ _) set"
3.1102 - assumes "dependent {x - a| x . x \<in> s}" "a \<notin> s"
3.1103 - shows "affine_dependent (insert a s)"
3.1104 -proof-
3.1105 - from assms(1)[unfolded dependent_explicit smult_conv_scaleR] obtain S u v
3.1106 - where obt:"finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" by auto
3.1107 - def t \<equiv> "(\<lambda>x. x + a) ` S"
3.1108 -
3.1109 - have inj:"inj_on (\<lambda>x. x + a) S" unfolding inj_on_def by auto
3.1110 - have "0\<notin>S" using obt(2) assms(2) unfolding subset_eq by auto
3.1111 - have fin:"finite t" and "t\<subseteq>s" unfolding t_def using obt(1,2) by auto
3.1112 -
3.1113 - hence "finite (insert a t)" and "insert a t \<subseteq> insert a s" by auto
3.1114 - moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
3.1115 - apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
3.1116 - have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
3.1117 - unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` apply auto unfolding * by auto
3.1118 - moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
3.1119 - apply(rule_tac x="v + a" in bexI) using obt(3,4) and `0\<notin>S` unfolding t_def by auto
3.1120 - moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
3.1121 - apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
3.1122 - have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
3.1123 - unfolding scaleR_left.setsum unfolding t_def and setsum_reindex[OF inj] and o_def
3.1124 - using obt(5) by (auto simp add: setsum_addf scaleR_right_distrib)
3.1125 - hence "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
3.1126 - unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` by (auto simp add: * vector_smult_lneg)
3.1127 - ultimately show ?thesis unfolding affine_dependent_explicit
3.1128 - apply(rule_tac x="insert a t" in exI) by auto
3.1129 -qed
3.1130 -
3.1131 -lemma convex_cone:
3.1132 - "convex s \<and> cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. (x + y) \<in> s) \<and> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)" (is "?lhs = ?rhs")
3.1133 -proof-
3.1134 - { fix x y assume "x\<in>s" "y\<in>s" and ?lhs
3.1135 - hence "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s" unfolding cone_def by auto
3.1136 - hence "x + y \<in> s" using `?lhs`[unfolded convex_def, THEN conjunct1]
3.1137 - apply(erule_tac x="2*\<^sub>R x" in ballE) apply(erule_tac x="2*\<^sub>R y" in ballE)
3.1138 - apply(erule_tac x="1/2" in allE) apply simp apply(erule_tac x="1/2" in allE) by auto }
3.1139 - thus ?thesis unfolding convex_def cone_def by blast
3.1140 -qed
3.1141 -
3.1142 -lemma affine_dependent_biggerset: fixes s::"(real^'n::finite) set"
3.1143 - assumes "finite s" "card s \<ge> CARD('n) + 2"
3.1144 - shows "affine_dependent s"
3.1145 -proof-
3.1146 - have "s\<noteq>{}" using assms by auto then obtain a where "a\<in>s" by auto
3.1147 - have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
3.1148 - have "card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
3.1149 - apply(rule card_image) unfolding inj_on_def by auto
3.1150 - also have "\<dots> > CARD('n)" using assms(2)
3.1151 - unfolding card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
3.1152 - finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
3.1153 - apply(rule dependent_imp_affine_dependent)
3.1154 - apply(rule dependent_biggerset) by auto qed
3.1155 -
3.1156 -lemma affine_dependent_biggerset_general:
3.1157 - assumes "finite (s::(real^'n::finite) set)" "card s \<ge> dim s + 2"
3.1158 - shows "affine_dependent s"
3.1159 -proof-
3.1160 - from assms(2) have "s \<noteq> {}" by auto
3.1161 - then obtain a where "a\<in>s" by auto
3.1162 - have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
3.1163 - have **:"card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
3.1164 - apply(rule card_image) unfolding inj_on_def by auto
3.1165 - have "dim {x - a |x. x \<in> s - {a}} \<le> dim s"
3.1166 - apply(rule subset_le_dim) unfolding subset_eq
3.1167 - using `a\<in>s` by (auto simp add:span_superset span_sub)
3.1168 - also have "\<dots> < dim s + 1" by auto
3.1169 - also have "\<dots> \<le> card (s - {a})" using assms
3.1170 - using card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
3.1171 - finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
3.1172 - apply(rule dependent_imp_affine_dependent) apply(rule dependent_biggerset_general) unfolding ** by auto qed
3.1173 -
3.1174 -subsection {* Caratheodory's theorem. *}
3.1175 -
3.1176 -lemma convex_hull_caratheodory: fixes p::"(real^'n::finite) set"
3.1177 - shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and>
3.1178 - (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
3.1179 - unfolding convex_hull_explicit expand_set_eq mem_Collect_eq
3.1180 -proof(rule,rule)
3.1181 - fix y let ?P = "\<lambda>n. \<exists>s u. finite s \<and> card s = n \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
3.1182 - assume "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
3.1183 - then obtain N where "?P N" by auto
3.1184 - hence "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n" apply(rule_tac ex_least_nat_le) by auto
3.1185 - then obtain n where "?P n" and smallest:"\<forall>k<n. \<not> ?P k" by blast
3.1186 - then obtain s u where obt:"finite s" "card s = n" "s\<subseteq>p" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
3.1187 -
3.1188 - have "card s \<le> CARD('n) + 1" proof(rule ccontr, simp only: not_le)
3.1189 - assume "CARD('n) + 1 < card s"
3.1190 - hence "affine_dependent s" using affine_dependent_biggerset[OF obt(1)] by auto
3.1191 - then obtain w v where wv:"setsum w s = 0" "v\<in>s" "w v \<noteq> 0" "(\<Sum>v\<in>s. w v *\<^sub>R v) = 0"
3.1192 - using affine_dependent_explicit_finite[OF obt(1)] by auto
3.1193 - def i \<equiv> "(\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}" def t \<equiv> "Min i"
3.1194 - have "\<exists>x\<in>s. w x < 0" proof(rule ccontr, simp add: not_less)
3.1195 - assume as:"\<forall>x\<in>s. 0 \<le> w x"
3.1196 - hence "setsum w (s - {v}) \<ge> 0" apply(rule_tac setsum_nonneg) by auto
3.1197 - hence "setsum w s > 0" unfolding setsum_diff1'[OF obt(1) `v\<in>s`]
3.1198 - using as[THEN bspec[where x=v]] and `v\<in>s` using `w v \<noteq> 0` by auto
3.1199 - thus False using wv(1) by auto
3.1200 - qed hence "i\<noteq>{}" unfolding i_def by auto
3.1201 -
3.1202 - hence "t \<ge> 0" using Min_ge_iff[of i 0 ] and obt(1) unfolding t_def i_def
3.1203 - using obt(4)[unfolded le_less] apply auto unfolding divide_le_0_iff by auto
3.1204 - have t:"\<forall>v\<in>s. u v + t * w v \<ge> 0" proof
3.1205 - fix v assume "v\<in>s" hence v:"0\<le>u v" using obt(4)[THEN bspec[where x=v]] by auto
3.1206 - show"0 \<le> u v + t * w v" proof(cases "w v < 0")
3.1207 - case False thus ?thesis apply(rule_tac add_nonneg_nonneg)
3.1208 - using v apply simp apply(rule mult_nonneg_nonneg) using `t\<ge>0` by auto next
3.1209 - case True hence "t \<le> u v / (- w v)" using `v\<in>s`
3.1210 - unfolding t_def i_def apply(rule_tac Min_le) using obt(1) by auto
3.1211 - thus ?thesis unfolding real_0_le_add_iff
3.1212 - using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[THEN sym]]] by auto
3.1213 - qed qed
3.1214 -
3.1215 - obtain a where "a\<in>s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
3.1216 - using Min_in[OF _ `i\<noteq>{}`] and obt(1) unfolding i_def t_def by auto
3.1217 - hence a:"a\<in>s" "u a + t * w a = 0" by auto
3.1218 - have *:"\<And>f. setsum f (s - {a}) = setsum f s - ((f a)::'a::ring)" unfolding setsum_diff1'[OF obt(1) `a\<in>s`] by auto
3.1219 - have "(\<Sum>v\<in>s. u v + t * w v) = 1"
3.1220 - unfolding setsum_addf wv(1) setsum_right_distrib[THEN sym] obt(5) by auto
3.1221 - moreover have "(\<Sum>v\<in>s. u v *\<^sub>R v + (t * w v) *\<^sub>R v) - (u a *\<^sub>R a + (t * w a) *\<^sub>R a) = y"
3.1222 - unfolding setsum_addf obt(6) scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] wv(4)
3.1223 - using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]]
3.1224 - by (simp add: vector_smult_lneg)
3.1225 - ultimately have "?P (n - 1)" apply(rule_tac x="(s - {a})" in exI)
3.1226 - apply(rule_tac x="\<lambda>v. u v + t * w v" in exI) using obt(1-3) and t and a by (auto simp add: * scaleR_left_distrib)
3.1227 - thus False using smallest[THEN spec[where x="n - 1"]] by auto qed
3.1228 - thus "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1
3.1229 - \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y" using obt by auto
3.1230 -qed auto
3.1231 -
3.1232 -lemma caratheodory:
3.1233 - "convex hull p = {x::real^'n::finite. \<exists>s. finite s \<and> s \<subseteq> p \<and>
3.1234 - card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s}"
3.1235 - unfolding expand_set_eq apply(rule, rule) unfolding mem_Collect_eq proof-
3.1236 - fix x assume "x \<in> convex hull p"
3.1237 - then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1"
3.1238 - "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"unfolding convex_hull_caratheodory by auto
3.1239 - thus "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
3.1240 - apply(rule_tac x=s in exI) using hull_subset[of s convex]
3.1241 - using convex_convex_hull[unfolded convex_explicit, of s, THEN spec[where x=s], THEN spec[where x=u]] by auto
3.1242 -next
3.1243 - fix x assume "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
3.1244 - then obtain s where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1" "x \<in> convex hull s" by auto
3.1245 - thus "x \<in> convex hull p" using hull_mono[OF `s\<subseteq>p`] by auto
3.1246 -qed
3.1247 -
3.1248 -subsection {* Openness and compactness are preserved by convex hull operation. *}
3.1249 -
3.1250 -lemma open_convex_hull:
3.1251 - fixes s :: "'a::real_normed_vector set"
3.1252 - assumes "open s"
3.1253 - shows "open(convex hull s)"
3.1254 - unfolding open_contains_cball convex_hull_explicit unfolding mem_Collect_eq ball_simps(10)
3.1255 -proof(rule, rule) fix a
3.1256 - assume "\<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = a"
3.1257 - then obtain t u where obt:"finite t" "t\<subseteq>s" "\<forall>x\<in>t. 0 \<le> u x" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = a" by auto
3.1258 -
3.1259 - from assms[unfolded open_contains_cball] obtain b where b:"\<forall>x\<in>s. 0 < b x \<and> cball x (b x) \<subseteq> s"
3.1260 - using bchoice[of s "\<lambda>x e. e>0 \<and> cball x e \<subseteq> s"] by auto
3.1261 - have "b ` t\<noteq>{}" unfolding i_def using obt by auto def i \<equiv> "b ` t"
3.1262 -
3.1263 - show "\<exists>e>0. cball a e \<subseteq> {y. \<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y}"
3.1264 - apply(rule_tac x="Min i" in exI) unfolding subset_eq apply rule defer apply rule unfolding mem_Collect_eq
3.1265 - proof-
3.1266 - show "0 < Min i" unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] `b \` t\<noteq>{}`]
3.1267 - using b apply simp apply rule apply(erule_tac x=x in ballE) using `t\<subseteq>s` by auto
3.1268 - next fix y assume "y \<in> cball a (Min i)"
3.1269 - hence y:"norm (a - y) \<le> Min i" unfolding dist_norm[THEN sym] by auto
3.1270 - { fix x assume "x\<in>t"
3.1271 - hence "Min i \<le> b x" unfolding i_def apply(rule_tac Min_le) using obt(1) by auto
3.1272 - hence "x + (y - a) \<in> cball x (b x)" using y unfolding mem_cball dist_norm by auto
3.1273 - moreover from `x\<in>t` have "x\<in>s" using obt(2) by auto
3.1274 - ultimately have "x + (y - a) \<in> s" using y and b[THEN bspec[where x=x]] unfolding subset_eq by auto }
3.1275 - moreover
3.1276 - have *:"inj_on (\<lambda>v. v + (y - a)) t" unfolding inj_on_def by auto
3.1277 - have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a))) = 1"
3.1278 - unfolding setsum_reindex[OF *] o_def using obt(4) by auto
3.1279 - moreover have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a)) *\<^sub>R v) = y"
3.1280 - unfolding setsum_reindex[OF *] o_def using obt(4,5)
3.1281 - by (simp add: setsum_addf setsum_subtractf scaleR_left.setsum[THEN sym] scaleR_right_distrib)
3.1282 - ultimately show "\<exists>sa u. finite sa \<and> (\<forall>x\<in>sa. x \<in> s) \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
3.1283 - apply(rule_tac x="(\<lambda>v. v + (y - a)) ` t" in exI) apply(rule_tac x="\<lambda>v. u (v - (y - a))" in exI)
3.1284 - using obt(1, 3) by auto
3.1285 - qed
3.1286 -qed
3.1287 -
3.1288 -lemma open_dest_vec1_vimage: "open S \<Longrightarrow> open (dest_vec1 -` S)"
3.1289 -unfolding open_vector_def all_1
3.1290 -by (auto simp add: dest_vec1_def)
3.1291 -
3.1292 -lemma tendsto_dest_vec1 [tendsto_intros]:
3.1293 - "(f ---> l) net \<Longrightarrow> ((\<lambda>x. dest_vec1 (f x)) ---> dest_vec1 l) net"
3.1294 - unfolding tendsto_def
3.1295 - apply clarify
3.1296 - apply (drule_tac x="dest_vec1 -` S" in spec)
3.1297 - apply (simp add: open_dest_vec1_vimage)
3.1298 - done
3.1299 -
3.1300 -lemma continuous_dest_vec1: "continuous net f \<Longrightarrow> continuous net (\<lambda>x. dest_vec1 (f x))"
3.1301 - unfolding continuous_def by (rule tendsto_dest_vec1)
3.1302 -
3.1303 -(* TODO: move *)
3.1304 -lemma compact_real_interval:
3.1305 - fixes a b :: real shows "compact {a..b}"
3.1306 -proof -
3.1307 - have "continuous_on {vec1 a .. vec1 b} dest_vec1"
3.1308 - unfolding continuous_on
3.1309 - by (simp add: tendsto_dest_vec1 Lim_at_within Lim_ident_at)
3.1310 - moreover have "compact {vec1 a .. vec1 b}" by (rule compact_interval)
3.1311 - ultimately have "compact (dest_vec1 ` {vec1 a .. vec1 b})"
3.1312 - by (rule compact_continuous_image)
3.1313 - also have "dest_vec1 ` {vec1 a .. vec1 b} = {a..b}"
3.1314 - by (auto simp add: image_def Bex_def exists_vec1)
3.1315 - finally show ?thesis .
3.1316 -qed
3.1317 -
3.1318 -lemma compact_convex_combinations:
3.1319 - fixes s t :: "'a::real_normed_vector set"
3.1320 - assumes "compact s" "compact t"
3.1321 - 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}"
3.1322 -proof-
3.1323 - let ?X = "{0..1} \<times> s \<times> t"
3.1324 - let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
3.1325 - 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"
3.1326 - apply(rule set_ext) unfolding image_iff mem_Collect_eq
3.1327 - apply rule apply auto
3.1328 - apply (rule_tac x=u in rev_bexI, simp)
3.1329 - apply (erule rev_bexI, erule rev_bexI, simp)
3.1330 - by auto
3.1331 - have "continuous_on ({0..1} \<times> s \<times> t)
3.1332 - (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
3.1333 - unfolding continuous_on by (rule ballI) (intro tendsto_intros)
3.1334 - thus ?thesis unfolding *
3.1335 - apply (rule compact_continuous_image)
3.1336 - apply (intro compact_Times compact_real_interval assms)
3.1337 - done
3.1338 -qed
3.1339 -
3.1340 -lemma compact_convex_hull: fixes s::"(real^'n::finite) set"
3.1341 - assumes "compact s" shows "compact(convex hull s)"
3.1342 -proof(cases "s={}")
3.1343 - case True thus ?thesis using compact_empty by simp
3.1344 -next
3.1345 - case False then obtain w where "w\<in>s" by auto
3.1346 - show ?thesis unfolding caratheodory[of s]
3.1347 - proof(induct "CARD('n) + 1")
3.1348 - have *:"{x.\<exists>sa. finite sa \<and> sa \<subseteq> s \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
3.1349 - using compact_empty by (auto simp add: convex_hull_empty)
3.1350 - case 0 thus ?case unfolding * by simp
3.1351 - next
3.1352 - case (Suc n)
3.1353 - show ?case proof(cases "n=0")
3.1354 - 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"
3.1355 - unfolding expand_set_eq and mem_Collect_eq proof(rule, rule)
3.1356 - fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
3.1357 - then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
3.1358 - show "x\<in>s" proof(cases "card t = 0")
3.1359 - case True thus ?thesis using t(4) unfolding card_0_eq[OF t(1)] by(simp add: convex_hull_empty)
3.1360 - next
3.1361 - case False hence "card t = Suc 0" using t(3) `n=0` by auto
3.1362 - then obtain a where "t = {a}" unfolding card_Suc_eq by auto
3.1363 - thus ?thesis using t(2,4) by (simp add: convex_hull_singleton)
3.1364 - qed
3.1365 - next
3.1366 - fix x assume "x\<in>s"
3.1367 - thus "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
3.1368 - apply(rule_tac x="{x}" in exI) unfolding convex_hull_singleton by auto
3.1369 - qed thus ?thesis using assms by simp
3.1370 - next
3.1371 - case False have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} =
3.1372 - { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
3.1373 - 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}}"
3.1374 - unfolding expand_set_eq and mem_Collect_eq proof(rule,rule)
3.1375 - fix x assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
3.1376 - 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)"
3.1377 - then obtain u v c t where obt:"x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
3.1378 - "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
3.1379 - moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u t"
3.1380 - apply(rule mem_convex) using obt(2) and convex_convex_hull and hull_subset[of "insert u t" convex]
3.1381 - using obt(7) and hull_mono[of t "insert u t"] by auto
3.1382 - ultimately show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
3.1383 - apply(rule_tac x="insert u t" in exI) by (auto simp add: card_insert_if)
3.1384 - next
3.1385 - fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
3.1386 - then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
3.1387 - let ?P = "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
3.1388 - 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)"
3.1389 - show ?P proof(cases "card t = Suc n")
3.1390 - case False hence "card t \<le> n" using t(3) by auto
3.1391 - thus ?P apply(rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI) using `w\<in>s` and t
3.1392 - by(auto intro!: exI[where x=t])
3.1393 - next
3.1394 - case True then obtain a u where au:"t = insert a u" "a\<notin>u" apply(drule_tac card_eq_SucD) by auto
3.1395 - show ?P proof(cases "u={}")
3.1396 - case True hence "x=a" using t(4)[unfolded au] by auto
3.1397 - show ?P unfolding `x=a` apply(rule_tac x=a in exI, rule_tac x=a in exI, rule_tac x=1 in exI)
3.1398 - using t and `n\<noteq>0` unfolding au by(auto intro!: exI[where x="{a}"] simp add: convex_hull_singleton)
3.1399 - next
3.1400 - 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"
3.1401 - using t(4)[unfolded au convex_hull_insert[OF False]] by auto
3.1402 - have *:"1 - vx = ux" using obt(3) by auto
3.1403 - show ?P apply(rule_tac x=a in exI, rule_tac x=b in exI, rule_tac x=vx in exI)
3.1404 - using obt and t(1-3) unfolding au and * using card_insert_disjoint[OF _ au(2)]
3.1405 - by(auto intro!: exI[where x=u])
3.1406 - qed
3.1407 - qed
3.1408 - qed
3.1409 - thus ?thesis using compact_convex_combinations[OF assms Suc] by simp
3.1410 - qed
3.1411 - qed
3.1412 -qed
3.1413 -
3.1414 -lemma finite_imp_compact_convex_hull:
3.1415 - fixes s :: "(real ^ _) set"
3.1416 - shows "finite s \<Longrightarrow> compact(convex hull s)"
3.1417 - apply(drule finite_imp_compact, drule compact_convex_hull) by assumption
3.1418 -
3.1419 -subsection {* Extremal points of a simplex are some vertices. *}
3.1420 -
3.1421 -lemma dist_increases_online:
3.1422 - fixes a b d :: "'a::real_inner"
3.1423 - assumes "d \<noteq> 0"
3.1424 - shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
3.1425 -proof(cases "inner a d - inner b d > 0")
3.1426 - case True hence "0 < inner d d + (inner a d * 2 - inner b d * 2)"
3.1427 - apply(rule_tac add_pos_pos) using assms by auto
3.1428 - thus ?thesis apply(rule_tac disjI2) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
3.1429 - by (simp add: algebra_simps inner_commute)
3.1430 -next
3.1431 - case False hence "0 < inner d d + (inner b d * 2 - inner a d * 2)"
3.1432 - apply(rule_tac add_pos_nonneg) using assms by auto
3.1433 - thus ?thesis apply(rule_tac disjI1) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
3.1434 - by (simp add: algebra_simps inner_commute)
3.1435 -qed
3.1436 -
3.1437 -lemma norm_increases_online:
3.1438 - fixes d :: "'a::real_inner"
3.1439 - shows "d \<noteq> 0 \<Longrightarrow> norm(a + d) > norm a \<or> norm(a - d) > norm a"
3.1440 - using dist_increases_online[of d a 0] unfolding dist_norm by auto
3.1441 -
3.1442 -lemma simplex_furthest_lt:
3.1443 - fixes s::"'a::real_inner set" assumes "finite s"
3.1444 - shows "\<forall>x \<in> (convex hull s). x \<notin> s \<longrightarrow> (\<exists>y\<in>(convex hull s). norm(x - a) < norm(y - a))"
3.1445 -proof(induct_tac rule: finite_induct[of s])
3.1446 - 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))"
3.1447 - 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))"
3.1448 - proof(rule,rule,cases "s = {}")
3.1449 - case False fix y assume y:"y \<in> convex hull insert x s" "y \<notin> insert x s"
3.1450 - 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"
3.1451 - using y(1)[unfolded convex_hull_insert[OF False]] by auto
3.1452 - show "\<exists>z\<in>convex hull insert x s. norm (y - a) < norm (z - a)"
3.1453 - proof(cases "y\<in>convex hull s")
3.1454 - case True then obtain z where "z\<in>convex hull s" "norm (y - a) < norm (z - a)"
3.1455 - using as(3)[THEN bspec[where x=y]] and y(2) by auto
3.1456 - thus ?thesis apply(rule_tac x=z in bexI) unfolding convex_hull_insert[OF False] by auto
3.1457 - next
3.1458 - case False show ?thesis using obt(3) proof(cases "u=0", case_tac[!] "v=0")
3.1459 - assume "u=0" "v\<noteq>0" hence "y = b" using obt by auto
3.1460 - thus ?thesis using False and obt(4) by auto
3.1461 - next
3.1462 - assume "u\<noteq>0" "v=0" hence "y = x" using obt by auto
3.1463 - thus ?thesis using y(2) by auto
3.1464 - next
3.1465 - assume "u\<noteq>0" "v\<noteq>0"
3.1466 - then obtain w where w:"w>0" "w<u" "w<v" using real_lbound_gt_zero[of u v] and obt(1,2) by auto
3.1467 - have "x\<noteq>b" proof(rule ccontr)
3.1468 - assume "\<not> x\<noteq>b" hence "y=b" unfolding obt(5)
3.1469 - using obt(3) by(auto simp add: scaleR_left_distrib[THEN sym])
3.1470 - thus False using obt(4) and False by simp qed
3.1471 - hence *:"w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
3.1472 - show ?thesis using dist_increases_online[OF *, of a y]
3.1473 - proof(erule_tac disjE)
3.1474 - assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
3.1475 - hence "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
3.1476 - unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
3.1477 - moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x s"
3.1478 - unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
3.1479 - apply(rule_tac x="u + w" in exI) apply rule defer
3.1480 - apply(rule_tac x="v - w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
3.1481 - ultimately show ?thesis by auto
3.1482 - next
3.1483 - assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
3.1484 - hence "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
3.1485 - unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
3.1486 - moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x s"
3.1487 - unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
3.1488 - apply(rule_tac x="u - w" in exI) apply rule defer
3.1489 - apply(rule_tac x="v + w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
3.1490 - ultimately show ?thesis by auto
3.1491 - qed
3.1492 - qed auto
3.1493 - qed
3.1494 - qed auto
3.1495 -qed (auto simp add: assms)
3.1496 -
3.1497 -lemma simplex_furthest_le:
3.1498 - fixes s :: "(real ^ _) set"
3.1499 - assumes "finite s" "s \<noteq> {}"
3.1500 - shows "\<exists>y\<in>s. \<forall>x\<in>(convex hull s). norm(x - a) \<le> norm(y - a)"
3.1501 -proof-
3.1502 - have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
3.1503 - then obtain x where x:"x\<in>convex hull s" "\<forall>y\<in>convex hull s. norm (y - a) \<le> norm (x - a)"
3.1504 - using distance_attains_sup[OF finite_imp_compact_convex_hull[OF assms(1)], of a]
3.1505 - unfolding dist_commute[of a] unfolding dist_norm by auto
3.1506 - thus ?thesis proof(cases "x\<in>s")
3.1507 - case False then obtain y where "y\<in>convex hull s" "norm (x - a) < norm (y - a)"
3.1508 - using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1) by auto
3.1509 - thus ?thesis using x(2)[THEN bspec[where x=y]] by auto
3.1510 - qed auto
3.1511 -qed
3.1512 -
3.1513 -lemma simplex_furthest_le_exists:
3.1514 - fixes s :: "(real ^ _) set"
3.1515 - shows "finite s \<Longrightarrow> (\<forall>x\<in>(convex hull s). \<exists>y\<in>s. norm(x - a) \<le> norm(y - a))"
3.1516 - using simplex_furthest_le[of s] by (cases "s={}")auto
3.1517 -
3.1518 -lemma simplex_extremal_le:
3.1519 - fixes s :: "(real ^ _) set"
3.1520 - assumes "finite s" "s \<noteq> {}"
3.1521 - 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)"
3.1522 -proof-
3.1523 - have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
3.1524 - then obtain u v where obt:"u\<in>convex hull s" "v\<in>convex hull s"
3.1525 - "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull s. norm (x - y) \<le> norm (u - v)"
3.1526 - using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]] by auto
3.1527 - thus ?thesis proof(cases "u\<notin>s \<or> v\<notin>s", erule_tac disjE)
3.1528 - assume "u\<notin>s" then obtain y where "y\<in>convex hull s" "norm (u - v) < norm (y - v)"
3.1529 - using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1) by auto
3.1530 - thus ?thesis using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2) by auto
3.1531 - next
3.1532 - assume "v\<notin>s" then obtain y where "y\<in>convex hull s" "norm (v - u) < norm (y - u)"
3.1533 - using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2) by auto
3.1534 - thus ?thesis using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
3.1535 - by (auto simp add: norm_minus_commute)
3.1536 - qed auto
3.1537 -qed
3.1538 -
3.1539 -lemma simplex_extremal_le_exists:
3.1540 - fixes s :: "(real ^ _) set"
3.1541 - shows "finite s \<Longrightarrow> x \<in> convex hull s \<Longrightarrow> y \<in> convex hull s
3.1542 - \<Longrightarrow> (\<exists>u\<in>s. \<exists>v\<in>s. norm(x - y) \<le> norm(u - v))"
3.1543 - using convex_hull_empty simplex_extremal_le[of s] by(cases "s={}")auto
3.1544 -
3.1545 -subsection {* Closest point of a convex set is unique, with a continuous projection. *}
3.1546 -
3.1547 -definition
3.1548 - closest_point :: "(real ^ 'n::finite) set \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
3.1549 - "closest_point s a = (SOME x. x \<in> s \<and> (\<forall>y\<in>s. dist a x \<le> dist a y))"
3.1550 -
3.1551 -lemma closest_point_exists:
3.1552 - assumes "closed s" "s \<noteq> {}"
3.1553 - shows "closest_point s a \<in> s" "\<forall>y\<in>s. dist a (closest_point s a) \<le> dist a y"
3.1554 - unfolding closest_point_def apply(rule_tac[!] someI2_ex)
3.1555 - using distance_attains_inf[OF assms(1,2), of a] by auto
3.1556 -
3.1557 -lemma closest_point_in_set:
3.1558 - "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s a) \<in> s"
3.1559 - by(meson closest_point_exists)
3.1560 -
3.1561 -lemma closest_point_le:
3.1562 - "closed s \<Longrightarrow> x \<in> s \<Longrightarrow> dist a (closest_point s a) \<le> dist a x"
3.1563 - using closest_point_exists[of s] by auto
3.1564 -
3.1565 -lemma closest_point_self:
3.1566 - assumes "x \<in> s" shows "closest_point s x = x"
3.1567 - unfolding closest_point_def apply(rule some1_equality, rule ex1I[of _ x])
3.1568 - using assms by auto
3.1569 -
3.1570 -lemma closest_point_refl:
3.1571 - "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s x = x \<longleftrightarrow> x \<in> s)"
3.1572 - using closest_point_in_set[of s x] closest_point_self[of x s] by auto
3.1573 -
3.1574 -(* TODO: move *)
3.1575 -lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
3.1576 - unfolding norm_eq_sqrt_inner by simp
3.1577 -
3.1578 -(* TODO: move *)
3.1579 -lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> inner x x \<le> inner y y"
3.1580 - unfolding norm_eq_sqrt_inner by simp
3.1581 -
3.1582 -lemma closer_points_lemma: fixes y::"real^'n::finite"
3.1583 - assumes "inner y z > 0"
3.1584 - shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
3.1585 -proof- have z:"inner z z > 0" unfolding inner_gt_zero_iff using assms by auto
3.1586 - thus ?thesis using assms apply(rule_tac x="inner y z / inner z z" in exI) apply(rule) defer proof(rule+)
3.1587 - fix v assume "0<v" "v \<le> inner y z / inner z z"
3.1588 - thus "norm (v *\<^sub>R z - y) < norm y" unfolding norm_lt using z and assms
3.1589 - by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ `0<v`])
3.1590 - qed(rule divide_pos_pos, auto) qed
3.1591 -
3.1592 -lemma closer_point_lemma:
3.1593 - fixes x y z :: "real ^ 'n::finite"
3.1594 - assumes "inner (y - x) (z - x) > 0"
3.1595 - shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
3.1596 -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)"
3.1597 - using closer_points_lemma[OF assms] by auto
3.1598 - show ?thesis apply(rule_tac x="min u 1" in exI) using u[THEN spec[where x="min u 1"]] and `u>0`
3.1599 - unfolding dist_norm by(auto simp add: norm_minus_commute field_simps) qed
3.1600 -
3.1601 -lemma any_closest_point_dot:
3.1602 - fixes s :: "(real ^ _) set"
3.1603 - assumes "convex s" "closed s" "x \<in> s" "y \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
3.1604 - shows "inner (a - x) (y - x) \<le> 0"
3.1605 -proof(rule ccontr) assume "\<not> inner (a - x) (y - x) \<le> 0"
3.1606 - 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
3.1607 - let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y" have "?z \<in> s" using mem_convex[OF assms(1,3,4), of u] using u by auto
3.1608 - thus False using assms(5)[THEN bspec[where x="?z"]] and u(3) by (auto simp add: dist_commute algebra_simps) qed
3.1609 -
3.1610 -(* TODO: move *)
3.1611 -lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
3.1612 -proof -
3.1613 - have "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> norm x \<le> a"
3.1614 - using norm_ge_zero [of x] by arith
3.1615 - also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> (norm x)\<twosuperior> \<le> a\<twosuperior>"
3.1616 - by (auto intro: power_mono dest: power2_le_imp_le)
3.1617 - also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
3.1618 - unfolding power2_norm_eq_inner ..
3.1619 - finally show ?thesis .
3.1620 -qed
3.1621 -
3.1622 -lemma any_closest_point_unique:
3.1623 - fixes s :: "(real ^ _) set"
3.1624 - assumes "convex s" "closed s" "x \<in> s" "y \<in> s"
3.1625 - "\<forall>z\<in>s. dist a x \<le> dist a z" "\<forall>z\<in>s. dist a y \<le> dist a z"
3.1626 - 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)]
3.1627 - unfolding norm_pths(1) and norm_le_square
3.1628 - by (auto simp add: algebra_simps)
3.1629 -
3.1630 -lemma closest_point_unique:
3.1631 - assumes "convex s" "closed s" "x \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
3.1632 - shows "x = closest_point s a"
3.1633 - using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point s a"]
3.1634 - using closest_point_exists[OF assms(2)] and assms(3) by auto
3.1635 -
3.1636 -lemma closest_point_dot:
3.1637 - assumes "convex s" "closed s" "x \<in> s"
3.1638 - shows "inner (a - closest_point s a) (x - closest_point s a) \<le> 0"
3.1639 - apply(rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
3.1640 - using closest_point_exists[OF assms(2)] and assms(3) by auto
3.1641 -
3.1642 -lemma closest_point_lt:
3.1643 - assumes "convex s" "closed s" "x \<in> s" "x \<noteq> closest_point s a"
3.1644 - shows "dist a (closest_point s a) < dist a x"
3.1645 - apply(rule ccontr) apply(rule_tac notE[OF assms(4)])
3.1646 - apply(rule closest_point_unique[OF assms(1-3), of a])
3.1647 - using closest_point_le[OF assms(2), of _ a] by fastsimp
3.1648 -
3.1649 -lemma closest_point_lipschitz:
3.1650 - assumes "convex s" "closed s" "s \<noteq> {}"
3.1651 - shows "dist (closest_point s x) (closest_point s y) \<le> dist x y"
3.1652 -proof-
3.1653 - have "inner (x - closest_point s x) (closest_point s y - closest_point s x) \<le> 0"
3.1654 - "inner (y - closest_point s y) (closest_point s x - closest_point s y) \<le> 0"
3.1655 - apply(rule_tac[!] any_closest_point_dot[OF assms(1-2)])
3.1656 - using closest_point_exists[OF assms(2-3)] by auto
3.1657 - thus ?thesis unfolding dist_norm and norm_le
3.1658 - using inner_ge_zero[of "(x - closest_point s x) - (y - closest_point s y)"]
3.1659 - by (simp add: inner_add inner_diff inner_commute) qed
3.1660 -
3.1661 -lemma continuous_at_closest_point:
3.1662 - assumes "convex s" "closed s" "s \<noteq> {}"
3.1663 - shows "continuous (at x) (closest_point s)"
3.1664 - unfolding continuous_at_eps_delta
3.1665 - using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
3.1666 -
3.1667 -lemma continuous_on_closest_point:
3.1668 - assumes "convex s" "closed s" "s \<noteq> {}"
3.1669 - shows "continuous_on t (closest_point s)"
3.1670 - apply(rule continuous_at_imp_continuous_on) using continuous_at_closest_point[OF assms] by auto
3.1671 -
3.1672 -subsection {* Various point-to-set separating/supporting hyperplane theorems. *}
3.1673 -
3.1674 -lemma supporting_hyperplane_closed_point:
3.1675 - fixes s :: "(real ^ _) set"
3.1676 - assumes "convex s" "closed s" "s \<noteq> {}" "z \<notin> s"
3.1677 - 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)"
3.1678 -proof-
3.1679 - from distance_attains_inf[OF assms(2-3)] obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x" by auto
3.1680 - show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) y" in exI, rule_tac x=y in bexI)
3.1681 - apply rule defer apply rule defer apply(rule, rule ccontr) using `y\<in>s` proof-
3.1682 - show "inner (y - z) z < inner (y - z) y" apply(subst diff_less_iff(1)[THEN sym])
3.1683 - unfolding inner_diff_right[THEN sym] and inner_gt_zero_iff using `y\<in>s` `z\<notin>s` by auto
3.1684 - next
3.1685 - fix x assume "x\<in>s" have *:"\<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
3.1686 - using assms(1)[unfolded convex_alt] and y and `x\<in>s` and `y\<in>s` by auto
3.1687 - assume "\<not> inner (y - z) y \<le> inner (y - z) x" then obtain v where
3.1688 - "v>0" "v\<le>1" "dist (y + v *\<^sub>R (x - y)) z < dist y z" using closer_point_lemma[of z y x] apply - by (auto simp add: inner_diff)
3.1689 - thus False using *[THEN spec[where x=v]] by(auto simp add: dist_commute algebra_simps)
3.1690 - qed auto
3.1691 -qed
3.1692 -
3.1693 -lemma separating_hyperplane_closed_point:
3.1694 - fixes s :: "(real ^ _) set"
3.1695 - assumes "convex s" "closed s" "z \<notin> s"
3.1696 - shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>s. inner a x > b)"
3.1697 -proof(cases "s={}")
3.1698 - case True thus ?thesis apply(rule_tac x="-z" in exI, rule_tac x=1 in exI)
3.1699 - using less_le_trans[OF _ inner_ge_zero[of z]] by auto
3.1700 -next
3.1701 - case False obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x"
3.1702 - using distance_attains_inf[OF assms(2) False] by auto
3.1703 - show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) z + (norm(y - z))\<twosuperior> / 2" in exI)
3.1704 - apply rule defer apply rule proof-
3.1705 - fix x assume "x\<in>s"
3.1706 - have "\<not> 0 < inner (z - y) (x - y)" apply(rule_tac notI) proof(drule closer_point_lemma)
3.1707 - assume "\<exists>u>0. u \<le> 1 \<and> dist (y + u *\<^sub>R (x - y)) z < dist y z"
3.1708 - then obtain u where "u>0" "u\<le>1" "dist (y + u *\<^sub>R (x - y)) z < dist y z" by auto
3.1709 - thus False using y[THEN bspec[where x="y + u *\<^sub>R (x - y)"]]
3.1710 - using assms(1)[unfolded convex_alt, THEN bspec[where x=y]]
3.1711 - using `x\<in>s` `y\<in>s` by (auto simp add: dist_commute algebra_simps) qed
3.1712 - moreover have "0 < norm (y - z) ^ 2" using `y\<in>s` `z\<notin>s` by auto
3.1713 - hence "0 < inner (y - z) (y - z)" unfolding power2_norm_eq_inner by simp
3.1714 - ultimately show "inner (y - z) z + (norm (y - z))\<twosuperior> / 2 < inner (y - z) x"
3.1715 - unfolding power2_norm_eq_inner and not_less by (auto simp add: field_simps inner_commute inner_diff)
3.1716 - qed(insert `y\<in>s` `z\<notin>s`, auto)
3.1717 -qed
3.1718 -
3.1719 -lemma separating_hyperplane_closed_0:
3.1720 - assumes "convex (s::(real^'n::finite) set)" "closed s" "0 \<notin> s"
3.1721 - shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>s. inner a x > b)"
3.1722 - proof(cases "s={}") guess a using UNIV_witness[where 'a='n] ..
3.1723 - case True have "norm ((basis a)::real^'n::finite) = 1"
3.1724 - using norm_basis and dimindex_ge_1 by auto
3.1725 - thus ?thesis apply(rule_tac x="basis a" in exI, rule_tac x=1 in exI) using True by auto
3.1726 -next case False thus ?thesis using False using separating_hyperplane_closed_point[OF assms]
3.1727 - apply - apply(erule exE)+ unfolding dot_rzero apply(rule_tac x=a in exI, rule_tac x=b in exI) by auto qed
3.1728 -
3.1729 -subsection {* Now set-to-set for closed/compact sets. *}
3.1730 -
3.1731 -lemma separating_hyperplane_closed_compact:
3.1732 - assumes "convex (s::(real^'n::finite) set)" "closed s" "convex t" "compact t" "t \<noteq> {}" "s \<inter> t = {}"
3.1733 - shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
3.1734 -proof(cases "s={}")
3.1735 - case True
3.1736 - 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
3.1737 - obtain z::"real^'n" where z:"norm z = b + 1" using vector_choose_size[of "b + 1"] and b(1) by auto
3.1738 - hence "z\<notin>t" using b(2)[THEN bspec[where x=z]] by auto
3.1739 - then obtain a b where ab:"inner a z < b" "\<forall>x\<in>t. b < inner a x"
3.1740 - using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z] by auto
3.1741 - thus ?thesis using True by auto
3.1742 -next
3.1743 - case False then obtain y where "y\<in>s" by auto
3.1744 - obtain a b where "0 < b" "\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. b < inner a x"
3.1745 - using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
3.1746 - using closed_compact_differences[OF assms(2,4)] using assms(6) by(auto, blast)
3.1747 - hence ab:"\<forall>x\<in>s. \<forall>y\<in>t. b + inner a y < inner a x" apply- apply(rule,rule) apply(erule_tac x="x - y" in ballE) by (auto simp add: inner_diff)
3.1748 - def k \<equiv> "rsup ((\<lambda>x. inner a x) ` t)"
3.1749 - show ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-(k + b / 2)" in exI)
3.1750 - apply(rule,rule) defer apply(rule) unfolding inner_minus_left and neg_less_iff_less proof-
3.1751 - from ab have "((\<lambda>x. inner a x) ` t) *<= (inner a y - b)"
3.1752 - apply(erule_tac x=y in ballE) apply(rule setleI) using `y\<in>s` by auto
3.1753 - hence k:"isLub UNIV ((\<lambda>x. inner a x) ` t) k" unfolding k_def apply(rule_tac rsup) using assms(5) by auto
3.1754 - fix x assume "x\<in>t" thus "inner a x < (k + b / 2)" using `0<b` and isLubD2[OF k, of "inner a x"] by auto
3.1755 - next
3.1756 - fix x assume "x\<in>s"
3.1757 - hence "k \<le> inner a x - b" unfolding k_def apply(rule_tac rsup_le) using assms(5)
3.1758 - unfolding setle_def
3.1759 - using ab[THEN bspec[where x=x]] by auto
3.1760 - thus "k + b / 2 < inner a x" using `0 < b` by auto
3.1761 - qed
3.1762 -qed
3.1763 -
3.1764 -lemma separating_hyperplane_compact_closed:
3.1765 - fixes s :: "(real ^ _) set"
3.1766 - assumes "convex s" "compact s" "s \<noteq> {}" "convex t" "closed t" "s \<inter> t = {}"
3.1767 - shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
3.1768 -proof- obtain a b where "(\<forall>x\<in>t. inner a x < b) \<and> (\<forall>x\<in>s. b < inner a x)"
3.1769 - using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6) by auto
3.1770 - thus ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-b" in exI) by auto qed
3.1771 -
3.1772 -subsection {* General case without assuming closure and getting non-strict separation. *}
3.1773 -
3.1774 -lemma separating_hyperplane_set_0:
3.1775 - assumes "convex s" "(0::real^'n::finite) \<notin> s"
3.1776 - shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>s. 0 \<le> inner a x)"
3.1777 -proof- let ?k = "\<lambda>c. {x::real^'n. 0 \<le> inner c x}"
3.1778 - have "frontier (cball 0 1) \<inter> (\<Inter> (?k ` s)) \<noteq> {}"
3.1779 - apply(rule compact_imp_fip) apply(rule compact_frontier[OF compact_cball])
3.1780 - defer apply(rule,rule,erule conjE) proof-
3.1781 - fix f assume as:"f \<subseteq> ?k ` s" "finite f"
3.1782 - obtain c where c:"f = ?k ` c" "c\<subseteq>s" "finite c" using finite_subset_image[OF as(2,1)] by auto
3.1783 - then obtain a b where ab:"a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
3.1784 - using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
3.1785 - using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
3.1786 - using subset_hull[unfolded mem_def, of convex, OF assms(1), THEN sym, of c] by auto
3.1787 - hence "\<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)
3.1788 - using hull_subset[of c convex] unfolding subset_eq and inner_scaleR
3.1789 - apply- apply rule defer apply rule apply(rule mult_nonneg_nonneg)
3.1790 - by(auto simp add: inner_commute elim!: ballE)
3.1791 - thus "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" unfolding c(1) frontier_cball dist_norm by auto
3.1792 - qed(insert closed_halfspace_ge, auto)
3.1793 - then obtain x where "norm x = 1" "\<forall>y\<in>s. x\<in>?k y" unfolding frontier_cball dist_norm by auto
3.1794 - thus ?thesis apply(rule_tac x=x in exI) by(auto simp add: inner_commute) qed
3.1795 -
3.1796 -lemma separating_hyperplane_sets:
3.1797 - assumes "convex s" "convex (t::(real^'n::finite) set)" "s \<noteq> {}" "t \<noteq> {}" "s \<inter> t = {}"
3.1798 - 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)"
3.1799 -proof- from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
3.1800 - 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 auto
3.1801 - hence "\<forall>x\<in>t. \<forall>y\<in>s. inner a y \<le> inner a x" apply- apply(rule, rule) apply(erule_tac x="x - y" in ballE) by (auto simp add: inner_diff)
3.1802 - thus ?thesis apply(rule_tac x=a in exI, rule_tac x="rsup ((\<lambda>x. inner a x) ` s)" in exI) using `a\<noteq>0`
3.1803 - apply(rule) apply(rule,rule) apply(rule rsup[THEN isLubD2]) prefer 4 apply(rule,rule rsup_le) unfolding setle_def
3.1804 - prefer 4 using assms(3-5) by blast+ qed
3.1805 -
3.1806 -subsection {* More convexity generalities. *}
3.1807 -
3.1808 -lemma convex_closure:
3.1809 - fixes s :: "'a::real_normed_vector set"
3.1810 - assumes "convex s" shows "convex(closure s)"
3.1811 - unfolding convex_def Ball_def closure_sequential
3.1812 - apply(rule,rule,rule,rule,rule,rule,rule,rule,rule) apply(erule_tac exE)+
3.1813 - apply(rule_tac x="\<lambda>n. u *\<^sub>R xb n + v *\<^sub>R xc n" in exI) apply(rule,rule)
3.1814 - apply(rule assms[unfolded convex_def, rule_format]) prefer 6
3.1815 - apply(rule Lim_add) apply(rule_tac [1-2] Lim_cmul) by auto
3.1816 -
3.1817 -lemma convex_interior:
3.1818 - fixes s :: "'a::real_normed_vector set"
3.1819 - assumes "convex s" shows "convex(interior s)"
3.1820 - unfolding convex_alt Ball_def mem_interior apply(rule,rule,rule,rule,rule,rule) apply(erule exE | erule conjE)+ proof-
3.1821 - fix x y u assume u:"0 \<le> u" "u \<le> (1::real)"
3.1822 - fix e d assume ed:"ball x e \<subseteq> s" "ball y d \<subseteq> s" "0<d" "0<e"
3.1823 - show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> s" apply(rule_tac x="min d e" in exI)
3.1824 - apply rule unfolding subset_eq defer apply rule proof-
3.1825 - fix z assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
3.1826 - hence "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> s"
3.1827 - apply(rule_tac assms[unfolded convex_alt, rule_format])
3.1828 - using ed(1,2) and u unfolding subset_eq mem_ball Ball_def dist_norm by(auto simp add: algebra_simps)
3.1829 - thus "z \<in> s" using u by (auto simp add: algebra_simps) qed(insert u ed(3-4), auto) qed
3.1830 -
3.1831 -lemma convex_hull_eq_empty: "convex hull s = {} \<longleftrightarrow> s = {}"
3.1832 - using hull_subset[of s convex] convex_hull_empty by auto
3.1833 -
3.1834 -subsection {* Moving and scaling convex hulls. *}
3.1835 -
3.1836 -lemma convex_hull_translation_lemma:
3.1837 - "convex hull ((\<lambda>x. a + x) ` s) \<subseteq> (\<lambda>x. a + x) ` (convex hull s)"
3.1838 - apply(rule hull_minimal, rule image_mono, rule hull_subset) unfolding mem_def
3.1839 - using convex_translation[OF convex_convex_hull, of a s] by assumption
3.1840 -
3.1841 -lemma convex_hull_bilemma: fixes neg
3.1842 - assumes "(\<forall>s a. (convex hull (up a s)) \<subseteq> up a (convex hull s))"
3.1843 - shows "(\<forall>s. up a (up (neg a) s) = s) \<and> (\<forall>s. up (neg a) (up a s) = s) \<and> (\<forall>s t a. s \<subseteq> t \<longrightarrow> up a s \<subseteq> up a t)
3.1844 - \<Longrightarrow> \<forall>s. (convex hull (up a s)) = up a (convex hull s)"
3.1845 - using assms by(metis subset_antisym)
3.1846 -
3.1847 -lemma convex_hull_translation:
3.1848 - "convex hull ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (convex hull s)"
3.1849 - apply(rule convex_hull_bilemma[rule_format, of _ _ "\<lambda>a. -a"], rule convex_hull_translation_lemma) unfolding image_image by auto
3.1850 -
3.1851 -lemma convex_hull_scaling_lemma:
3.1852 - "(convex hull ((\<lambda>x. c *\<^sub>R x) ` s)) \<subseteq> (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
3.1853 - apply(rule hull_minimal, rule image_mono, rule hull_subset)
3.1854 - unfolding mem_def by(rule convex_scaling, rule convex_convex_hull)
3.1855 -
3.1856 -lemma convex_hull_scaling:
3.1857 - "convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
3.1858 - apply(cases "c=0") defer apply(rule convex_hull_bilemma[rule_format, of _ _ inverse]) apply(rule convex_hull_scaling_lemma)
3.1859 - unfolding image_image scaleR_scaleR by(auto simp add:image_constant_conv convex_hull_eq_empty)
3.1860 -
3.1861 -lemma convex_hull_affinity:
3.1862 - "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
3.1863 - unfolding image_image[THEN sym] convex_hull_scaling convex_hull_translation ..
3.1864 -
3.1865 -subsection {* Convex set as intersection of halfspaces. *}
3.1866 -
3.1867 -lemma convex_halfspace_intersection:
3.1868 - fixes s :: "(real ^ _) set"
3.1869 - assumes "closed s" "convex s"
3.1870 - shows "s = \<Inter> {h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
3.1871 - apply(rule set_ext, rule) unfolding Inter_iff Ball_def mem_Collect_eq apply(rule,rule,erule conjE) proof-
3.1872 - fix x assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
3.1873 - hence "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}" by blast
3.1874 - thus "x\<in>s" apply(rule_tac ccontr) apply(drule separating_hyperplane_closed_point[OF assms(2,1)])
3.1875 - apply(erule exE)+ apply(erule_tac x="-a" in allE, erule_tac x="-b" in allE) by auto
3.1876 -qed auto
3.1877 -
3.1878 -subsection {* Radon's theorem (from Lars Schewe). *}
3.1879 -
3.1880 -lemma radon_ex_lemma:
3.1881 - assumes "finite c" "affine_dependent c"
3.1882 - shows "\<exists>u. setsum u c = 0 \<and> (\<exists>v\<in>c. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) c = 0"
3.1883 -proof- from assms(2)[unfolded affine_dependent_explicit] guess s .. then guess u ..
3.1884 - thus ?thesis apply(rule_tac x="\<lambda>v. if v\<in>s then u v else 0" in exI) unfolding if_smult scaleR_zero_left
3.1885 - and setsum_restrict_set[OF assms(1), THEN sym] by(auto simp add: Int_absorb1) qed
3.1886 -
3.1887 -lemma radon_s_lemma:
3.1888 - assumes "finite s" "setsum f s = (0::real)"
3.1889 - shows "setsum f {x\<in>s. 0 < f x} = - setsum f {x\<in>s. f x < 0}"
3.1890 -proof- have *:"\<And>x. (if f x < 0 then f x else 0) + (if 0 < f x then f x else 0) = f x" by auto
3.1891 - show ?thesis unfolding real_add_eq_0_iff[THEN sym] and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
3.1892 - using assms(2) by assumption qed
3.1893 -
3.1894 -lemma radon_v_lemma:
3.1895 - assumes "finite s" "setsum f s = 0" "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::real^'n)"
3.1896 - shows "(setsum f {x\<in>s. 0 < g x}) = - setsum f {x\<in>s. g x < 0}"
3.1897 -proof-
3.1898 - have *:"\<And>x. (if 0 < g x then f x else 0) + (if g x < 0 then f x else 0) = f x" using assms(3) by auto
3.1899 - show ?thesis unfolding eq_neg_iff_add_eq_0 and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
3.1900 - using assms(2) by assumption qed
3.1901 -
3.1902 -lemma radon_partition:
3.1903 - assumes "finite c" "affine_dependent c"
3.1904 - shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}" proof-
3.1905 - obtain u v where uv:"setsum u c = 0" "v\<in>c" "u v \<noteq> 0" "(\<Sum>v\<in>c. u v *\<^sub>R v) = 0" using radon_ex_lemma[OF assms] by auto
3.1906 - have fin:"finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}" using assms(1) by auto
3.1907 - def z \<equiv> "(inverse (setsum u {x\<in>c. u x > 0})) *\<^sub>R setsum (\<lambda>x. u x *\<^sub>R x) {x\<in>c. u x > 0}"
3.1908 - have "setsum u {x \<in> c. 0 < u x} \<noteq> 0" proof(cases "u v \<ge> 0")
3.1909 - case False hence "u v < 0" by auto
3.1910 - thus ?thesis proof(cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
3.1911 - case True thus ?thesis using setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
3.1912 - next
3.1913 - case False hence "setsum u c \<le> setsum (\<lambda>x. if x=v then u v else 0) c" apply(rule_tac setsum_mono) by auto
3.1914 - thus ?thesis unfolding setsum_delta[OF assms(1)] using uv(2) and `u v < 0` and uv(1) by auto qed
3.1915 - qed (insert setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
3.1916 -
3.1917 - hence *:"setsum u {x\<in>c. u x > 0} > 0" unfolding real_less_def apply(rule_tac conjI, rule_tac setsum_nonneg) by auto
3.1918 - moreover have "setsum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = setsum u c"
3.1919 - "(\<Sum>x\<in>{x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}. u x *\<^sub>R x) = (\<Sum>x\<in>c. u x *\<^sub>R x)"
3.1920 - using assms(1) apply(rule_tac[!] setsum_mono_zero_left) by auto
3.1921 - hence "setsum u {x \<in> c. 0 < u x} = - setsum u {x \<in> c. 0 > u x}"
3.1922 - "(\<Sum>x\<in>{x \<in> c. 0 < u x}. u x *\<^sub>R x) = - (\<Sum>x\<in>{x \<in> c. 0 > u x}. u x *\<^sub>R x)"
3.1923 - unfolding eq_neg_iff_add_eq_0 using uv(1,4) by (auto simp add: setsum_Un_zero[OF fin, THEN sym])
3.1924 - moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * - u x"
3.1925 - apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
3.1926 -
3.1927 - ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}" unfolding convex_hull_explicit mem_Collect_eq
3.1928 - apply(rule_tac x="{v \<in> c. u v < 0}" in exI, rule_tac x="\<lambda>y. inverse (setsum u {x\<in>c. u x > 0}) * - u y" in exI)
3.1929 - using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def
3.1930 - by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
3.1931 - moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * u x"
3.1932 - apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
3.1933 - hence "z \<in> convex hull {v \<in> c. u v > 0}" unfolding convex_hull_explicit mem_Collect_eq
3.1934 - apply(rule_tac x="{v \<in> c. 0 < u v}" in exI, rule_tac x="\<lambda>y. inverse (setsum u {x\<in>c. u x > 0}) * u y" in exI)
3.1935 - using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def using *
3.1936 - by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
3.1937 - ultimately show ?thesis apply(rule_tac x="{v\<in>c. u v \<le> 0}" in exI, rule_tac x="{v\<in>c. u v > 0}" in exI) by auto
3.1938 -qed
3.1939 -
3.1940 -lemma radon: assumes "affine_dependent c"
3.1941 - obtains m p where "m\<subseteq>c" "p\<subseteq>c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
3.1942 -proof- from assms[unfolded affine_dependent_explicit] guess s .. then guess u ..
3.1943 - hence *:"finite s" "affine_dependent s" and s:"s \<subseteq> c" unfolding affine_dependent_explicit by auto
3.1944 - from radon_partition[OF *] guess m .. then guess p ..
3.1945 - thus ?thesis apply(rule_tac that[of p m]) using s by auto qed
3.1946 -
3.1947 -subsection {* Helly's theorem. *}
3.1948 -
3.1949 -lemma helly_induct: fixes f::"(real^'n::finite) set set"
3.1950 - assumes "f hassize n" "n \<ge> CARD('n) + 1"
3.1951 - "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
3.1952 - shows "\<Inter> f \<noteq> {}"
3.1953 - using assms unfolding hassize_def apply(erule_tac conjE) proof(induct n arbitrary: f)
3.1954 -case (Suc n)
3.1955 -show "\<Inter> f \<noteq> {}" apply(cases "n = CARD('n)") apply(rule Suc(4)[rule_format])
3.1956 - unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6) proof-
3.1957 - assume ng:"n \<noteq> CARD('n)" hence "\<exists>X. \<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" apply(rule_tac bchoice) unfolding ex_in_conv
3.1958 - apply(rule, rule Suc(1)[rule_format]) unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6)
3.1959 - defer apply(rule Suc(3)[rule_format]) defer apply(rule Suc(4)[rule_format]) using Suc(2,5) by auto
3.1960 - then obtain X where X:"\<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" by auto
3.1961 - show ?thesis proof(cases "inj_on X f")
3.1962 - case False then obtain s t where st:"s\<noteq>t" "s\<in>f" "t\<in>f" "X s = X t" unfolding inj_on_def by auto
3.1963 - hence *:"\<Inter> f = \<Inter> (f - {s}) \<inter> \<Inter> (f - {t})" by auto
3.1964 - show ?thesis unfolding * unfolding ex_in_conv[THEN sym] apply(rule_tac x="X s" in exI)
3.1965 - apply(rule, rule X[rule_format]) using X st by auto
3.1966 - next case True then obtain m p where mp:"m \<inter> p = {}" "m \<union> p = X ` f" "convex hull m \<inter> convex hull p \<noteq> {}"
3.1967 - using radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
3.1968 - unfolding card_image[OF True] and Suc(6) using Suc(2,5) and ng by auto
3.1969 - have "m \<subseteq> X ` f" "p \<subseteq> X ` f" using mp(2) by auto
3.1970 - then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f" unfolding subset_image_iff by auto
3.1971 - hence "f \<union> (g \<union> h) = f" by auto
3.1972 - hence f:"f = g \<union> h" using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
3.1973 - unfolding mp(2)[unfolded image_Un[THEN sym] gh] by auto
3.1974 - have *:"g \<inter> h = {}" using mp(1) unfolding gh using inj_on_image_Int[OF True gh(3,4)] by auto
3.1975 - have "convex hull (X ` h) \<subseteq> \<Inter> g" "convex hull (X ` g) \<subseteq> \<Inter> h"
3.1976 - apply(rule_tac [!] hull_minimal) using Suc(3) gh(3-4) unfolding mem_def unfolding subset_eq
3.1977 - apply(rule_tac [2] convex_Inter, rule_tac [4] convex_Inter) apply rule prefer 3 apply rule proof-
3.1978 - fix x assume "x\<in>X ` g" then guess y unfolding image_iff ..
3.1979 - thus "x\<in>\<Inter>h" using X[THEN bspec[where x=y]] using * f by auto next
3.1980 - fix x assume "x\<in>X ` h" then guess y unfolding image_iff ..
3.1981 - thus "x\<in>\<Inter>g" using X[THEN bspec[where x=y]] using * f by auto
3.1982 - qed(auto)
3.1983 - thus ?thesis unfolding f using mp(3)[unfolded gh] by blast qed
3.1984 -qed(insert dimindex_ge_1, auto) qed(auto)
3.1985 -
3.1986 -lemma helly: fixes f::"(real^'n::finite) set set"
3.1987 - assumes "finite f" "card f \<ge> CARD('n) + 1" "\<forall>s\<in>f. convex s"
3.1988 - "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
3.1989 - shows "\<Inter> f \<noteq>{}"
3.1990 - apply(rule helly_induct) unfolding hassize_def using assms by auto
3.1991 -
3.1992 -subsection {* Convex hull is "preserved" by a linear function. *}
3.1993 -
3.1994 -lemma convex_hull_linear_image:
3.1995 - assumes "bounded_linear f"
3.1996 - shows "f ` (convex hull s) = convex hull (f ` s)"
3.1997 - apply rule unfolding subset_eq ball_simps apply(rule_tac[!] hull_induct, rule hull_inc) prefer 3
3.1998 - apply(erule imageE)apply(rule_tac x=xa in image_eqI) apply assumption
3.1999 - apply(rule hull_subset[unfolded subset_eq, rule_format]) apply assumption
3.2000 -proof-
3.2001 - interpret f: bounded_linear f by fact
3.2002 - show "convex {x. f x \<in> convex hull f ` s}"
3.2003 - unfolding convex_def by(auto simp add: f.scaleR f.add convex_convex_hull[unfolded convex_def, rule_format]) next
3.2004 - interpret f: bounded_linear f by fact
3.2005 - show "convex {x. x \<in> f ` (convex hull s)}" using convex_convex_hull[unfolded convex_def, of s]
3.2006 - unfolding convex_def by (auto simp add: f.scaleR [symmetric] f.add [symmetric])
3.2007 -qed auto
3.2008 -
3.2009 -lemma in_convex_hull_linear_image:
3.2010 - assumes "bounded_linear f" "x \<in> convex hull s"
3.2011 - shows "(f x) \<in> convex hull (f ` s)"
3.2012 -using convex_hull_linear_image[OF assms(1)] assms(2) by auto
3.2013 -
3.2014 -subsection {* Homeomorphism of all convex compact sets with nonempty interior. *}
3.2015 -
3.2016 -lemma compact_frontier_line_lemma:
3.2017 - fixes s :: "(real ^ _) set"
3.2018 - assumes "compact s" "0 \<in> s" "x \<noteq> 0"
3.2019 - obtains u where "0 \<le> u" "(u *\<^sub>R x) \<in> frontier s" "\<forall>v>u. (v *\<^sub>R x) \<notin> s"
3.2020 -proof-
3.2021 - obtain b where b:"b>0" "\<forall>x\<in>s. norm x \<le> b" using compact_imp_bounded[OF assms(1), unfolded bounded_pos] by auto
3.2022 - let ?A = "{y. \<exists>u. 0 \<le> u \<and> u \<le> b / norm(x) \<and> (y = u *\<^sub>R x)}"
3.2023 - have A:"?A = (\<lambda>u. dest_vec1 u *\<^sub>R x) ` {0 .. vec1 (b / norm x)}"
3.2024 - unfolding image_image[of "\<lambda>u. u *\<^sub>R x" "\<lambda>x. dest_vec1 x", THEN sym]
3.2025 - unfolding dest_vec1_inverval vec1_dest_vec1 by auto
3.2026 - have "compact ?A" unfolding A apply(rule compact_continuous_image, rule continuous_at_imp_continuous_on)
3.2027 - apply(rule, rule continuous_vmul)
3.2028 - apply (rule continuous_dest_vec1)
3.2029 - apply(rule continuous_at_id) by(rule compact_interval)
3.2030 - moreover have "{y. \<exists>u\<ge>0. u \<le> b / norm x \<and> y = u *\<^sub>R x} \<inter> s \<noteq> {}" apply(rule not_disjointI[OF _ assms(2)])
3.2031 - unfolding mem_Collect_eq using `b>0` assms(3) by(auto intro!: divide_nonneg_pos)
3.2032 - ultimately obtain u y where obt: "u\<ge>0" "u \<le> b / norm x" "y = u *\<^sub>R x"
3.2033 - "y\<in>?A" "y\<in>s" "\<forall>z\<in>?A \<inter> s. dist 0 z \<le> dist 0 y" using distance_attains_sup[OF compact_inter[OF _ assms(1), of ?A], of 0] by auto
3.2034 -
3.2035 - have "norm x > 0" using assms(3)[unfolded zero_less_norm_iff[THEN sym]] by auto
3.2036 - { fix v assume as:"v > u" "v *\<^sub>R x \<in> s"
3.2037 - hence "v \<le> b / norm x" using b(2)[rule_format, OF as(2)]
3.2038 - using `u\<ge>0` unfolding pos_le_divide_eq[OF `norm x > 0`] by auto
3.2039 - hence "norm (v *\<^sub>R x) \<le> norm y" apply(rule_tac obt(6)[rule_format, unfolded dist_0_norm]) apply(rule IntI) defer
3.2040 - apply(rule as(2)) unfolding mem_Collect_eq apply(rule_tac x=v in exI)
3.2041 - using as(1) `u\<ge>0` by(auto simp add:field_simps)
3.2042 - hence False unfolding obt(3) using `u\<ge>0` `norm x > 0` `v>u` by(auto simp add:field_simps)
3.2043 - } note u_max = this
3.2044 -
3.2045 - have "u *\<^sub>R x \<in> frontier s" unfolding frontier_straddle apply(rule,rule,rule) apply(rule_tac x="u *\<^sub>R x" in bexI) unfolding obt(3)[THEN sym]
3.2046 - prefer 3 apply(rule_tac x="(u + (e / 2) / norm x) *\<^sub>R x" in exI) apply(rule, rule) proof-
3.2047 - fix e assume "0 < e" and as:"(u + e / 2 / norm x) *\<^sub>R x \<in> s"
3.2048 - hence "u + e / 2 / norm x > u" using`norm x > 0` by(auto simp del:zero_less_norm_iff intro!: divide_pos_pos)
3.2049 - thus False using u_max[OF _ as] by auto
3.2050 - qed(insert `y\<in>s`, auto simp add: dist_norm scaleR_left_distrib obt(3))
3.2051 - thus ?thesis apply(rule_tac that[of u]) apply(rule obt(1), assumption)
3.2052 - apply(rule,rule,rule ccontr) apply(rule u_max) by auto qed
3.2053 -
3.2054 -lemma starlike_compact_projective:
3.2055 - assumes "compact s" "cball (0::real^'n::finite) 1 \<subseteq> s "
3.2056 - "\<forall>x\<in>s. \<forall>u. 0 \<le> u \<and> u < 1 \<longrightarrow> (u *\<^sub>R x) \<in> (s - frontier s )"
3.2057 - shows "s homeomorphic (cball (0::real^'n::finite) 1)"
3.2058 -proof-
3.2059 - have fs:"frontier s \<subseteq> s" apply(rule frontier_subset_closed) using compact_imp_closed[OF assms(1)] by simp
3.2060 - def pi \<equiv> "\<lambda>x::real^'n. inverse (norm x) *\<^sub>R x"
3.2061 - have "0 \<notin> frontier s" unfolding frontier_straddle apply(rule ccontr) unfolding not_not apply(erule_tac x=1 in allE)
3.2062 - using assms(2)[unfolded subset_eq Ball_def mem_cball] by auto
3.2063 - have injpi:"\<And>x y. pi x = pi y \<and> norm x = norm y \<longleftrightarrow> x = y" unfolding pi_def by auto
3.2064 -
3.2065 - have contpi:"continuous_on (UNIV - {0}) pi" apply(rule continuous_at_imp_continuous_on)
3.2066 - apply rule unfolding pi_def
3.2067 - apply (rule continuous_mul)
3.2068 - apply (rule continuous_at_inv[unfolded o_def])
3.2069 - apply (rule continuous_at_norm)
3.2070 - apply simp
3.2071 - apply (rule continuous_at_id)
3.2072 - done
3.2073 - def sphere \<equiv> "{x::real^'n. norm x = 1}"
3.2074 - have pi:"\<And>x. x \<noteq> 0 \<Longrightarrow> pi x \<in> sphere" "\<And>x u. u>0 \<Longrightarrow> pi (u *\<^sub>R x) = pi x" unfolding pi_def sphere_def by auto
3.2075 -
3.2076 - have "0\<in>s" using assms(2) and centre_in_cball[of 0 1] by auto
3.2077 - have front_smul:"\<forall>x\<in>frontier s. \<forall>u\<ge>0. u *\<^sub>R x \<in> s \<longleftrightarrow> u \<le> 1" proof(rule,rule,rule)
3.2078 - fix x u assume x:"x\<in>frontier s" and "(0::real)\<le>u"
3.2079 - hence "x\<noteq>0" using `0\<notin>frontier s` by auto
3.2080 - obtain v where v:"0 \<le> v" "v *\<^sub>R x \<in> frontier s" "\<forall>w>v. w *\<^sub>R x \<notin> s"
3.2081 - using compact_frontier_line_lemma[OF assms(1) `0\<in>s` `x\<noteq>0`] by auto
3.2082 - have "v=1" apply(rule ccontr) unfolding neq_iff apply(erule disjE) proof-
3.2083 - assume "v<1" thus False using v(3)[THEN spec[where x=1]] using x and fs by auto next
3.2084 - assume "v>1" thus False using assms(3)[THEN bspec[where x="v *\<^sub>R x"], THEN spec[where x="inverse v"]]
3.2085 - using v and x and fs unfolding inverse_less_1_iff by auto qed
3.2086 - show "u *\<^sub>R x \<in> s \<longleftrightarrow> u \<le> 1" apply rule using v(3)[unfolded `v=1`, THEN spec[where x=u]] proof-
3.2087 - assume "u\<le>1" thus "u *\<^sub>R x \<in> s" apply(cases "u=1")
3.2088 - using assms(3)[THEN bspec[where x=x], THEN spec[where x=u]] using `0\<le>u` and x and fs by auto qed auto qed
3.2089 -
3.2090 - have "\<exists>surf. homeomorphism (frontier s) sphere pi surf"
3.2091 - apply(rule homeomorphism_compact) apply(rule compact_frontier[OF assms(1)])
3.2092 - apply(rule continuous_on_subset[OF contpi]) defer apply(rule set_ext,rule)
3.2093 - unfolding inj_on_def prefer 3 apply(rule,rule,rule)
3.2094 - proof- fix x assume "x\<in>pi ` frontier s" then obtain y where "y\<in>frontier s" "x = pi y" by auto
3.2095 - thus "x \<in> sphere" using pi(1)[of y] and `0 \<notin> frontier s` by auto
3.2096 - next fix x assume "x\<in>sphere" hence "norm x = 1" "x\<noteq>0" unfolding sphere_def by auto
3.2097 - then obtain u where "0 \<le> u" "u *\<^sub>R x \<in> frontier s" "\<forall>v>u. v *\<^sub>R x \<notin> s"
3.2098 - using compact_frontier_line_lemma[OF assms(1) `0\<in>s`, of x] by auto
3.2099 - thus "x \<in> pi ` frontier s" unfolding image_iff le_less pi_def apply(rule_tac x="u *\<^sub>R x" in bexI) using `norm x = 1` `0\<notin>frontier s` by auto
3.2100 - next fix x y assume as:"x \<in> frontier s" "y \<in> frontier s" "pi x = pi y"
3.2101 - hence xys:"x\<in>s" "y\<in>s" using fs by auto
3.2102 - from as(1,2) have nor:"norm x \<noteq> 0" "norm y \<noteq> 0" using `0\<notin>frontier s` by auto
3.2103 - from nor have x:"x = norm x *\<^sub>R ((inverse (norm y)) *\<^sub>R y)" unfolding as(3)[unfolded pi_def, THEN sym] by auto
3.2104 - from nor have y:"y = norm y *\<^sub>R ((inverse (norm x)) *\<^sub>R x)" unfolding as(3)[unfolded pi_def] by auto
3.2105 - have "0 \<le> norm y * inverse (norm x)" "0 \<le> norm x * inverse (norm y)"
3.2106 - unfolding divide_inverse[THEN sym] apply(rule_tac[!] divide_nonneg_pos) using nor by auto
3.2107 - hence "norm x = norm y" apply(rule_tac ccontr) unfolding neq_iff
3.2108 - using x y and front_smul[THEN bspec, OF as(1), THEN spec[where x="norm y * (inverse (norm x))"]]
3.2109 - using front_smul[THEN bspec, OF as(2), THEN spec[where x="norm x * (inverse (norm y))"]]
3.2110 - using xys nor by(auto simp add:field_simps divide_le_eq_1 divide_inverse[THEN sym])
3.2111 - thus "x = y" apply(subst injpi[THEN sym]) using as(3) by auto
3.2112 - qed(insert `0 \<notin> frontier s`, auto)
3.2113 - then obtain surf where surf:"\<forall>x\<in>frontier s. surf (pi x) = x" "pi ` frontier s = sphere" "continuous_on (frontier s) pi"
3.2114 - "\<forall>y\<in>sphere. pi (surf y) = y" "surf ` sphere = frontier s" "continuous_on sphere surf" unfolding homeomorphism_def by auto
3.2115 -
3.2116 - have cont_surfpi:"continuous_on (UNIV - {0}) (surf \<circ> pi)" apply(rule continuous_on_compose, rule contpi)
3.2117 - apply(rule continuous_on_subset[of sphere], rule surf(6)) using pi(1) by auto
3.2118 -
3.2119 - { fix x assume as:"x \<in> cball (0::real^'n) 1"
3.2120 - have "norm x *\<^sub>R surf (pi x) \<in> s" proof(cases "x=0 \<or> norm x = 1")
3.2121 - case False hence "pi x \<in> sphere" "norm x < 1" using pi(1)[of x] as by(auto simp add: dist_norm)
3.2122 - thus ?thesis apply(rule_tac assms(3)[rule_format, THEN DiffD1])
3.2123 - apply(rule_tac fs[unfolded subset_eq, rule_format])
3.2124 - unfolding surf(5)[THEN sym] by auto
3.2125 - next case True thus ?thesis apply rule defer unfolding pi_def apply(rule fs[unfolded subset_eq, rule_format])
3.2126 - unfolding surf(5)[unfolded sphere_def, THEN sym] using `0\<in>s` by auto qed } note hom = this
3.2127 -
3.2128 - { fix x assume "x\<in>s"
3.2129 - hence "x \<in> (\<lambda>x. norm x *\<^sub>R surf (pi x)) ` cball 0 1" proof(cases "x=0")
3.2130 - case True show ?thesis unfolding image_iff True apply(rule_tac x=0 in bexI) by auto
3.2131 - next let ?a = "inverse (norm (surf (pi x)))"
3.2132 - case False hence invn:"inverse (norm x) \<noteq> 0" by auto
3.2133 - from False have pix:"pi x\<in>sphere" using pi(1) by auto
3.2134 - hence "pi (surf (pi x)) = pi x" apply(rule_tac surf(4)[rule_format]) by assumption
3.2135 - hence **:"norm x *\<^sub>R (?a *\<^sub>R surf (pi x)) = x" apply(rule_tac scaleR_left_imp_eq[OF invn]) unfolding pi_def using invn by auto
3.2136 - hence *:"?a * norm x > 0" and"?a > 0" "?a \<noteq> 0" using surf(5) `0\<notin>frontier s` apply -
3.2137 - apply(rule_tac mult_pos_pos) using False[unfolded zero_less_norm_iff[THEN sym]] by auto
3.2138 - have "norm (surf (pi x)) \<noteq> 0" using ** False by auto
3.2139 - hence "norm x = norm ((?a * norm x) *\<^sub>R surf (pi x))"
3.2140 - unfolding norm_scaleR abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`] by auto
3.2141 - moreover have "pi x = pi ((inverse (norm (surf (pi x))) * norm x) *\<^sub>R surf (pi x))"
3.2142 - unfolding pi(2)[OF *] surf(4)[rule_format, OF pix] ..
3.2143 - moreover have "surf (pi x) \<in> frontier s" using surf(5) pix by auto
3.2144 - hence "dist 0 (inverse (norm (surf (pi x))) *\<^sub>R x) \<le> 1" unfolding dist_norm
3.2145 - using ** and * using front_smul[THEN bspec[where x="surf (pi x)"], THEN spec[where x="norm x * ?a"]]
3.2146 - using False `x\<in>s` by(auto simp add:field_simps)
3.2147 - ultimately show ?thesis unfolding image_iff apply(rule_tac x="inverse (norm (surf(pi x))) *\<^sub>R x" in bexI)
3.2148 - apply(subst injpi[THEN sym]) unfolding abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`]
3.2149 - unfolding pi(2)[OF `?a > 0`] by auto
3.2150 - qed } note hom2 = this
3.2151 -
3.2152 - show ?thesis apply(subst homeomorphic_sym) apply(rule homeomorphic_compact[where f="\<lambda>x. norm x *\<^sub>R surf (pi x)"])
3.2153 - apply(rule compact_cball) defer apply(rule set_ext, rule, erule imageE, drule hom)
3.2154 - prefer 4 apply(rule continuous_at_imp_continuous_on, rule) apply(rule_tac [3] hom2) proof-
3.2155 - fix x::"real^'n" assume as:"x \<in> cball 0 1"
3.2156 - thus "continuous (at x) (\<lambda>x. norm x *\<^sub>R surf (pi x))" proof(cases "x=0")
3.2157 - case False thus ?thesis apply(rule_tac continuous_mul, rule_tac continuous_at_norm)
3.2158 - using cont_surfpi unfolding continuous_on_eq_continuous_at[OF open_delete[OF open_UNIV]] o_def by auto
3.2159 - next guess a using UNIV_witness[where 'a = 'n] ..
3.2160 - obtain B where B:"\<forall>x\<in>s. norm x \<le> B" using compact_imp_bounded[OF assms(1)] unfolding bounded_iff by auto
3.2161 - hence "B > 0" using assms(2) unfolding subset_eq apply(erule_tac x="basis a" in ballE) defer apply(erule_tac x="basis a" in ballE)
3.2162 - unfolding Ball_def mem_cball dist_norm by (auto simp add: norm_basis[unfolded One_nat_def])
3.2163 - case True show ?thesis unfolding True continuous_at Lim_at apply(rule,rule) apply(rule_tac x="e / B" in exI)
3.2164 - apply(rule) apply(rule divide_pos_pos) prefer 3 apply(rule,rule,erule conjE)
3.2165 - unfolding norm_0 scaleR_zero_left dist_norm diff_0_right norm_scaleR abs_norm_cancel proof-
3.2166 - fix e and x::"real^'n" assume as:"norm x < e / B" "0 < norm x" "0<e"
3.2167 - hence "surf (pi x) \<in> frontier s" using pi(1)[of x] unfolding surf(5)[THEN sym] by auto
3.2168 - hence "norm (surf (pi x)) \<le> B" using B fs by auto
3.2169 - hence "norm x * norm (surf (pi x)) \<le> norm x * B" using as(2) by auto
3.2170 - also have "\<dots> < e / B * B" apply(rule mult_strict_right_mono) using as(1) `B>0` by auto
3.2171 - also have "\<dots> = e" using `B>0` by auto
3.2172 - finally show "norm x * norm (surf (pi x)) < e" by assumption
3.2173 - qed(insert `B>0`, auto) qed
3.2174 - next { fix x assume as:"surf (pi x) = 0"
3.2175 - have "x = 0" proof(rule ccontr)
3.2176 - assume "x\<noteq>0" hence "pi x \<in> sphere" using pi(1) by auto
3.2177 - hence "surf (pi x) \<in> frontier s" using surf(5) by auto
3.2178 - thus False using `0\<notin>frontier s` unfolding as by simp qed
3.2179 - } note surf_0 = this
3.2180 - show "inj_on (\<lambda>x. norm x *\<^sub>R surf (pi x)) (cball 0 1)" unfolding inj_on_def proof(rule,rule,rule)
3.2181 - fix x y assume as:"x \<in> cball 0 1" "y \<in> cball 0 1" "norm x *\<^sub>R surf (pi x) = norm y *\<^sub>R surf (pi y)"
3.2182 - thus "x=y" proof(cases "x=0 \<or> y=0")
3.2183 - case True thus ?thesis using as by(auto elim: surf_0) next
3.2184 - case False
3.2185 - hence "pi (surf (pi x)) = pi (surf (pi y))" using as(3)
3.2186 - using pi(2)[of "norm x" "surf (pi x)"] pi(2)[of "norm y" "surf (pi y)"] by auto
3.2187 - moreover have "pi x \<in> sphere" "pi y \<in> sphere" using pi(1) False by auto
3.2188 - ultimately have *:"pi x = pi y" using surf(4)[THEN bspec[where x="pi x"]] surf(4)[THEN bspec[where x="pi y"]] by auto
3.2189 - moreover have "norm x = norm y" using as(3)[unfolded *] using False by(auto dest:surf_0)
3.2190 - ultimately show ?thesis using injpi by auto qed qed
3.2191 - qed auto qed
3.2192 -
3.2193 -lemma homeomorphic_convex_compact_lemma: fixes s::"(real^'n::finite) set"
3.2194 - assumes "convex s" "compact s" "cball 0 1 \<subseteq> s"
3.2195 - shows "s homeomorphic (cball (0::real^'n) 1)"
3.2196 - apply(rule starlike_compact_projective[OF assms(2-3)]) proof(rule,rule,rule,erule conjE)
3.2197 - fix x u assume as:"x \<in> s" "0 \<le> u" "u < (1::real)"
3.2198 - hence "u *\<^sub>R x \<in> interior s" unfolding interior_def mem_Collect_eq
3.2199 - apply(rule_tac x="ball (u *\<^sub>R x) (1 - u)" in exI) apply(rule, rule open_ball)
3.2200 - unfolding centre_in_ball apply rule defer apply(rule) unfolding mem_ball proof-
3.2201 - fix y assume "dist (u *\<^sub>R x) y < 1 - u"
3.2202 - hence "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> s"
3.2203 - using assms(3) apply(erule_tac subsetD) unfolding mem_cball dist_commute dist_norm
3.2204 - unfolding group_add_class.diff_0 group_add_class.diff_0_right norm_minus_cancel norm_scaleR
3.2205 - apply (rule mult_left_le_imp_le[of "1 - u"])
3.2206 - unfolding class_semiring.mul_a using `u<1` by auto
3.2207 - thus "y \<in> s" using assms(1)[unfolded convex_def, rule_format, of "inverse(1 - u) *\<^sub>R (y - u *\<^sub>R x)" x "1 - u" u]
3.2208 - using as unfolding scaleR_scaleR by auto qed auto
3.2209 - thus "u *\<^sub>R x \<in> s - frontier s" using frontier_def and interior_subset by auto qed
3.2210 -
3.2211 -lemma homeomorphic_convex_compact_cball: fixes e::real and s::"(real^'n::finite) set"
3.2212 - assumes "convex s" "compact s" "interior s \<noteq> {}" "0 < e"
3.2213 - shows "s homeomorphic (cball (b::real^'n::finite) e)"
3.2214 -proof- obtain a where "a\<in>interior s" using assms(3) by auto
3.2215 - then obtain d where "d>0" and d:"cball a d \<subseteq> s" unfolding mem_interior_cball by auto
3.2216 - let ?d = "inverse d" and ?n = "0::real^'n"
3.2217 - have "cball ?n 1 \<subseteq> (\<lambda>x. inverse d *\<^sub>R (x - a)) ` s"
3.2218 - apply(rule, rule_tac x="d *\<^sub>R x + a" in image_eqI) defer
3.2219 - apply(rule d[unfolded subset_eq, rule_format]) using `d>0` unfolding mem_cball dist_norm
3.2220 - by(auto simp add: mult_right_le_one_le)
3.2221 - hence "(\<lambda>x. inverse d *\<^sub>R (x - a)) ` s homeomorphic cball ?n 1"
3.2222 - using homeomorphic_convex_compact_lemma[of "(\<lambda>x. ?d *\<^sub>R -a + ?d *\<^sub>R x) ` s", OF convex_affinity compact_affinity]
3.2223 - using assms(1,2) by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib)
3.2224 - thus ?thesis apply(rule_tac homeomorphic_trans[OF _ homeomorphic_balls(2)[of 1 _ ?n]])
3.2225 - apply(rule homeomorphic_trans[OF homeomorphic_affinity[of "?d" s "?d *\<^sub>R -a"]])
3.2226 - using `d>0` `e>0` by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib) qed
3.2227 -
3.2228 -lemma homeomorphic_convex_compact: fixes s::"(real^'n::finite) set" and t::"(real^'n) set"
3.2229 - assumes "convex s" "compact s" "interior s \<noteq> {}"
3.2230 - "convex t" "compact t" "interior t \<noteq> {}"
3.2231 - shows "s homeomorphic t"
3.2232 - using assms by(meson zero_less_one homeomorphic_trans homeomorphic_convex_compact_cball homeomorphic_sym)
3.2233 -
3.2234 -subsection {* Epigraphs of convex functions. *}
3.2235 -
3.2236 -definition "epigraph s (f::real^'n \<Rightarrow> real) = {xy. fstcart xy \<in> s \<and> f(fstcart xy) \<le> dest_vec1 (sndcart xy)}"
3.2237 -
3.2238 -lemma mem_epigraph: "(pastecart x (vec1 y)) \<in> epigraph s f \<longleftrightarrow> x \<in> s \<and> f x \<le> y" unfolding epigraph_def by auto
3.2239 -
3.2240 -lemma convex_epigraph:
3.2241 - "convex(epigraph s f) \<longleftrightarrow> convex_on s f \<and> convex s"
3.2242 - unfolding convex_def convex_on_def unfolding Ball_def forall_pastecart epigraph_def
3.2243 - unfolding mem_Collect_eq fstcart_pastecart sndcart_pastecart sndcart_add sndcart_cmul [where 'a=real, unfolded smult_conv_scaleR] fstcart_add fstcart_cmul [where 'a=real, unfolded smult_conv_scaleR]
3.2244 - unfolding Ball_def[symmetric] unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR]
3.2245 - apply(subst forall_dest_vec1[THEN sym])+ by(meson real_le_refl real_le_trans add_mono mult_left_mono)
3.2246 -
3.2247 -lemma convex_epigraphI: assumes "convex_on s f" "convex s"
3.2248 - shows "convex(epigraph s f)" using assms unfolding convex_epigraph by auto
3.2249 -
3.2250 -lemma convex_epigraph_convex: "convex s \<Longrightarrow> (convex_on s f \<longleftrightarrow> convex(epigraph s f))"
3.2251 - using convex_epigraph by auto
3.2252 -
3.2253 -subsection {* Use this to derive general bound property of convex function. *}
3.2254 -
3.2255 -lemma forall_of_pastecart:
3.2256 - "(\<forall>p. P (\<lambda>x. fstcart (p x)) (\<lambda>x. sndcart (p x))) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
3.2257 - apply(erule_tac x="\<lambda>a. pastecart (x a) (y a)" in allE) unfolding o_def by auto
3.2258 -
3.2259 -lemma forall_of_pastecart':
3.2260 - "(\<forall>p. P (fstcart p) (sndcart p)) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
3.2261 - apply(erule_tac x="pastecart x y" in allE) unfolding o_def by auto
3.2262 -
3.2263 -lemma forall_of_dest_vec1: "(\<forall>v. P (\<lambda>x. dest_vec1 (v x))) \<longleftrightarrow> (\<forall>x. P x)"
3.2264 - apply rule apply rule apply(erule_tac x="(vec1 \<circ> x)" in allE) unfolding o_def vec1_dest_vec1 by auto
3.2265 -
3.2266 -lemma forall_of_dest_vec1': "(\<forall>v. P (dest_vec1 v)) \<longleftrightarrow> (\<forall>x. P x)"
3.2267 - apply rule apply rule apply(erule_tac x="(vec1 x)" in allE) defer apply rule
3.2268 - apply(erule_tac x="dest_vec1 v" in allE) unfolding o_def vec1_dest_vec1 by auto
3.2269 -
3.2270 -lemma convex_on:
3.2271 - fixes s :: "(real ^ _) set"
3.2272 - assumes "convex s"
3.2273 - shows "convex_on s f \<longleftrightarrow> (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow>
3.2274 - f (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} ) \<le> setsum (\<lambda>i. u i * f(x i)) {1..k} ) "
3.2275 - unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
3.2276 - unfolding sndcart_setsum[OF finite_atLeastAtMost] fstcart_setsum[OF finite_atLeastAtMost] dest_vec1_setsum[OF finite_atLeastAtMost]
3.2277 - unfolding fstcart_pastecart sndcart_pastecart sndcart_add sndcart_cmul [where 'a=real, unfolded smult_conv_scaleR] fstcart_add fstcart_cmul [where 'a=real, unfolded smult_conv_scaleR]
3.2278 - unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR] apply(subst forall_of_pastecart)+ apply(subst forall_of_dest_vec1)+ apply rule
3.2279 - using assms[unfolded convex] apply simp apply(rule,rule,rule)
3.2280 - apply(erule_tac x=k in allE, erule_tac x=u in allE, erule_tac x=x in allE) apply rule apply rule apply rule defer
3.2281 - apply(rule_tac j="\<Sum>i = 1..k. u i * f (x i)" in real_le_trans)
3.2282 - defer apply(rule setsum_mono) apply(erule conjE)+ apply(erule_tac x=i in allE)apply(rule mult_left_mono)
3.2283 - using assms[unfolded convex] by auto
3.2284 -
3.2285 -subsection {* Convexity of general and special intervals. *}
3.2286 -
3.2287 -lemma is_interval_convex:
3.2288 - fixes s :: "(real ^ _) set"
3.2289 - assumes "is_interval s" shows "convex s"
3.2290 - unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
3.2291 - fix x y u v assume as:"x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
3.2292 - hence *:"u = 1 - v" "1 - v \<ge> 0" and **:"v = 1 - u" "1 - u \<ge> 0" by auto
3.2293 - { fix a b assume "\<not> b \<le> u * a + v * b"
3.2294 - hence "u * a < (1 - v) * b" unfolding not_le using as(4) by(auto simp add: field_simps)
3.2295 - hence "a < b" unfolding * using as(4) *(2) apply(rule_tac mult_left_less_imp_less[of "1 - v"]) by(auto simp add: field_simps)
3.2296 - hence "a \<le> u * a + v * b" unfolding * using as(4) by (auto simp add: field_simps intro!:mult_right_mono)
3.2297 - } moreover
3.2298 - { fix a b assume "\<not> u * a + v * b \<le> a"
3.2299 - hence "v * b > (1 - u) * a" unfolding not_le using as(4) by(auto simp add: field_simps)
3.2300 - hence "a < b" unfolding * using as(4) apply(rule_tac mult_left_less_imp_less) by(auto simp add: ring_simps)
3.2301 - hence "u * a + v * b \<le> b" unfolding ** using **(2) as(3) by(auto simp add: field_simps intro!:mult_right_mono) }
3.2302 - 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)])
3.2303 - using as(3-) dimindex_ge_1 apply- by(auto simp add: vector_component) qed
3.2304 -
3.2305 -lemma is_interval_connected:
3.2306 - fixes s :: "(real ^ _) set"
3.2307 - shows "is_interval s \<Longrightarrow> connected s"
3.2308 - using is_interval_convex convex_connected by auto
3.2309 -
3.2310 -lemma convex_interval: "convex {a .. b}" "convex {a<..<b::real^'n::finite}"
3.2311 - apply(rule_tac[!] is_interval_convex) using is_interval_interval by auto
3.2312 -
3.2313 -subsection {* On @{text "real^1"}, @{text "is_interval"}, @{text "convex"} and @{text "connected"} are all equivalent. *}
3.2314 -
3.2315 -lemma is_interval_1:
3.2316 - "is_interval s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. \<forall> x. dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b \<longrightarrow> x \<in> s)"
3.2317 - unfolding is_interval_def dest_vec1_def forall_1 by auto
3.2318 -
3.2319 -lemma is_interval_connected_1: "is_interval s \<longleftrightarrow> connected (s::(real^1) set)"
3.2320 - apply(rule, rule is_interval_connected, assumption) unfolding is_interval_1
3.2321 - apply(rule,rule,rule,rule,erule conjE,rule ccontr) proof-
3.2322 - fix a b x assume as:"connected s" "a \<in> s" "b \<in> s" "dest_vec1 a \<le> dest_vec1 x" "dest_vec1 x \<le> dest_vec1 b" "x\<notin>s"
3.2323 - hence *:"dest_vec1 a < dest_vec1 x" "dest_vec1 x < dest_vec1 b" apply(rule_tac [!] ccontr) unfolding not_less by auto
3.2324 - let ?halfl = "{z. inner (basis 1) z < dest_vec1 x} " and ?halfr = "{z. inner (basis 1) z > dest_vec1 x} "
3.2325 - { fix y assume "y \<in> s" have "y \<in> ?halfr \<union> ?halfl" apply(rule ccontr)
3.2326 - using as(6) `y\<in>s` by (auto simp add: inner_vector_def dest_vec1_eq [unfolded dest_vec1_def] dest_vec1_def) }
3.2327 - moreover have "a\<in>?halfl" "b\<in>?halfr" using * by (auto simp add: inner_vector_def dest_vec1_def)
3.2328 - hence "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}" using as(2-3) by auto
3.2329 - ultimately show False apply(rule_tac notE[OF as(1)[unfolded connected_def]])
3.2330 - apply(rule_tac x="?halfl" in exI, rule_tac x="?halfr" in exI)
3.2331 - apply(rule, rule open_halfspace_lt, rule, rule open_halfspace_gt) apply(rule, rule, rule ccontr)
3.2332 - by(auto simp add: basis_component field_simps) qed
3.2333 -
3.2334 -lemma is_interval_convex_1:
3.2335 - "is_interval s \<longleftrightarrow> convex (s::(real^1) set)"
3.2336 - using is_interval_convex convex_connected is_interval_connected_1 by auto
3.2337 -
3.2338 -lemma convex_connected_1:
3.2339 - "connected s \<longleftrightarrow> convex (s::(real^1) set)"
3.2340 - using is_interval_convex convex_connected is_interval_connected_1 by auto
3.2341 -
3.2342 -subsection {* Another intermediate value theorem formulation. *}
3.2343 -
3.2344 -lemma ivt_increasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
3.2345 - assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f a)$k \<le> y" "y \<le> (f b)$k"
3.2346 - shows "\<exists>x\<in>{a..b}. (f x)$k = y"
3.2347 -proof- have "f a \<in> f ` {a..b}" "f b \<in> f ` {a..b}" apply(rule_tac[!] imageI)
3.2348 - using assms(1) by(auto simp add: vector_less_eq_def dest_vec1_def)
3.2349 - thus ?thesis using connected_ivt_component[of "f ` {a..b}" "f a" "f b" k y]
3.2350 - using connected_continuous_image[OF assms(2) convex_connected[OF convex_interval(1)]]
3.2351 - using assms by(auto intro!: imageI) qed
3.2352 -
3.2353 -lemma ivt_increasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
3.2354 - assumes "dest_vec1 a \<le> dest_vec1 b"
3.2355 - "\<forall>x\<in>{a .. b}. continuous (at x) f" "f a$k \<le> y" "y \<le> f b$k"
3.2356 - shows "\<exists>x\<in>{a..b}. (f x)$k = y"
3.2357 - apply(rule ivt_increasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
3.2358 -
3.2359 -lemma ivt_decreasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
3.2360 - assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f b)$k \<le> y" "y \<le> (f a)$k"
3.2361 - shows "\<exists>x\<in>{a..b}. (f x)$k = y"
3.2362 - apply(subst neg_equal_iff_equal[THEN sym]) unfolding vector_uminus_component[THEN sym]
3.2363 - apply(rule ivt_increasing_component_on_1) using assms using continuous_on_neg
3.2364 - by(auto simp add:vector_uminus_component)
3.2365 -
3.2366 -lemma ivt_decreasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
3.2367 - assumes "dest_vec1 a \<le> dest_vec1 b" "\<forall>x\<in>{a .. b}. continuous (at x) f" "f b$k \<le> y" "y \<le> f a$k"
3.2368 - shows "\<exists>x\<in>{a..b}. (f x)$k = y"
3.2369 - apply(rule ivt_decreasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
3.2370 -
3.2371 -subsection {* A bound within a convex hull, and so an interval. *}
3.2372 -
3.2373 -lemma convex_on_convex_hull_bound:
3.2374 - fixes s :: "(real ^ _) set"
3.2375 - assumes "convex_on (convex hull s) f" "\<forall>x\<in>s. f x \<le> b"
3.2376 - shows "\<forall>x\<in> convex hull s. f x \<le> b" proof
3.2377 - fix x assume "x\<in>convex hull s"
3.2378 - then obtain k u v where obt:"\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> v i \<in> s" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R v i) = x"
3.2379 - unfolding convex_hull_indexed mem_Collect_eq by auto
3.2380 - have "(\<Sum>i = 1..k. u i * f (v i)) \<le> b" using setsum_mono[of "{1..k}" "\<lambda>i. u i * f (v i)" "\<lambda>i. u i * b"]
3.2381 - unfolding setsum_left_distrib[THEN sym] obt(2) mult_1 apply(drule_tac meta_mp) apply(rule mult_left_mono)
3.2382 - using assms(2) obt(1) by auto
3.2383 - thus "f x \<le> b" using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
3.2384 - unfolding obt(2-3) using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s] by auto qed
3.2385 -
3.2386 -lemma unit_interval_convex_hull:
3.2387 - "{0::real^'n::finite .. 1} = convex hull {x. \<forall>i. (x$i = 0) \<or> (x$i = 1)}" (is "?int = convex hull ?points")
3.2388 -proof- have 01:"{0,1} \<subseteq> convex hull ?points" apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto
3.2389 - { fix n x assume "x\<in>{0::real^'n .. 1}" "n \<le> CARD('n)" "card {i. x$i \<noteq> 0} \<le> n"
3.2390 - hence "x\<in>convex hull ?points" proof(induct n arbitrary: x)
3.2391 - case 0 hence "x = 0" apply(subst Cart_eq) apply rule by auto
3.2392 - thus "x\<in>convex hull ?points" using 01 by auto
3.2393 - next
3.2394 - case (Suc n) show "x\<in>convex hull ?points" proof(cases "{i. x$i \<noteq> 0} = {}")
3.2395 - case True hence "x = 0" unfolding Cart_eq by auto
3.2396 - thus "x\<in>convex hull ?points" using 01 by auto
3.2397 - next
3.2398 - case False def xi \<equiv> "Min ((\<lambda>i. x$i) ` {i. x$i \<noteq> 0})"
3.2399 - have "xi \<in> (\<lambda>i. x$i) ` {i. x$i \<noteq> 0}" unfolding xi_def apply(rule Min_in) using False by auto
3.2400 - then obtain i where i':"x$i = xi" "x$i \<noteq> 0" by auto
3.2401 - have i:"\<And>j. x$j > 0 \<Longrightarrow> x$i \<le> x$j"
3.2402 - unfolding i'(1) xi_def apply(rule_tac Min_le) unfolding image_iff
3.2403 - defer apply(rule_tac x=j in bexI) using i' by auto
3.2404 - have i01:"x$i \<le> 1" "x$i > 0" using Suc(2)[unfolded mem_interval,rule_format,of i] using i'(2) `x$i \<noteq> 0`
3.2405 - by(auto simp add: Cart_lambda_beta)
3.2406 - show ?thesis proof(cases "x$i=1")
3.2407 - case True have "\<forall>j\<in>{i. x$i \<noteq> 0}. x$j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq proof-
3.2408 - fix j assume "x $ j \<noteq> 0" "x $ j \<noteq> 1"
3.2409 - hence j:"x$j \<in> {0<..<1}" using Suc(2) by(auto simp add: vector_less_eq_def elim!:allE[where x=j])
3.2410 - hence "x$j \<in> op $ x ` {i. x $ i \<noteq> 0}" by auto
3.2411 - hence "x$j \<ge> x$i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto
3.2412 - thus False using True Suc(2) j by(auto simp add: vector_less_eq_def elim!:ballE[where x=j]) qed
3.2413 - thus "x\<in>convex hull ?points" apply(rule_tac hull_subset[unfolded subset_eq, rule_format])
3.2414 - by(auto simp add: Cart_lambda_beta)
3.2415 - next let ?y = "\<lambda>j. if x$j = 0 then 0 else (x$j - x$i) / (1 - x$i)"
3.2416 - case False hence *:"x = x$i *\<^sub>R (\<chi> j. if x$j = 0 then 0 else 1) + (1 - x$i) *\<^sub>R (\<chi> j. ?y j)" unfolding Cart_eq
3.2417 - by(auto simp add: Cart_lambda_beta vector_add_component vector_smult_component vector_minus_component field_simps)
3.2418 - { fix j have "x$j \<noteq> 0 \<Longrightarrow> 0 \<le> (x $ j - x $ i) / (1 - x $ i)" "(x $ j - x $ i) / (1 - x $ i) \<le> 1"
3.2419 - apply(rule_tac divide_nonneg_pos) using i(1)[of j] using False i01
3.2420 - using Suc(2)[unfolded mem_interval, rule_format, of j] by(auto simp add:field_simps Cart_lambda_beta)
3.2421 - hence "0 \<le> ?y j \<and> ?y j \<le> 1" by auto }
3.2422 - moreover have "i\<in>{j. x$j \<noteq> 0} - {j. ((\<chi> j. ?y j)::real^'n) $ j \<noteq> 0}" using i01 by(auto simp add: Cart_lambda_beta)
3.2423 - hence "{j. x$j \<noteq> 0} \<noteq> {j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0}" by auto
3.2424 - hence **:"{j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0} \<subset> {j. x$j \<noteq> 0}" apply - apply rule by(auto simp add: Cart_lambda_beta)
3.2425 - have "card {j. ((\<chi> j. ?y j)::real^'n) $ j \<noteq> 0} \<le> n" using less_le_trans[OF psubset_card_mono[OF _ **] Suc(4)] by auto
3.2426 - ultimately show ?thesis apply(subst *) apply(rule convex_convex_hull[unfolded convex_def, rule_format])
3.2427 - apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) defer apply(rule Suc(1))
3.2428 - unfolding mem_interval using i01 Suc(3) by (auto simp add: Cart_lambda_beta)
3.2429 - qed qed qed } note * = this
3.2430 - show ?thesis apply rule defer apply(rule hull_minimal) unfolding subset_eq prefer 3 apply rule
3.2431 - apply(rule_tac n2="CARD('n)" in *) prefer 3 apply(rule card_mono) using 01 and convex_interval(1) prefer 5 apply - apply rule
3.2432 - unfolding mem_interval apply rule unfolding mem_Collect_eq apply(erule_tac x=i in allE)
3.2433 - by(auto simp add: vector_less_eq_def mem_def[of _ convex]) qed
3.2434 -
3.2435 -subsection {* And this is a finite set of vertices. *}
3.2436 -
3.2437 -lemma unit_cube_convex_hull: obtains s where "finite s" "{0 .. 1::real^'n::finite} = convex hull s"
3.2438 - apply(rule that[of "{x::real^'n::finite. \<forall>i. x$i=0 \<or> x$i=1}"])
3.2439 - apply(rule finite_subset[of _ "(\<lambda>s. (\<chi> i. if i\<in>s then 1::real else 0)::real^'n::finite) ` UNIV"])
3.2440 - prefer 3 apply(rule unit_interval_convex_hull) apply rule unfolding mem_Collect_eq proof-
3.2441 - fix x::"real^'n" assume as:"\<forall>i. x $ i = 0 \<or> x $ i = 1"
3.2442 - show "x \<in> (\<lambda>s. \<chi> i. if i \<in> s then 1 else 0) ` UNIV" apply(rule image_eqI[where x="{i. x$i = 1}"])
3.2443 - unfolding Cart_eq using as by(auto simp add:Cart_lambda_beta) qed auto
3.2444 -
3.2445 -subsection {* Hence any cube (could do any nonempty interval). *}
3.2446 -
3.2447 -lemma cube_convex_hull:
3.2448 - assumes "0 < d" obtains s::"(real^'n::finite) set" where "finite s" "{x - (\<chi> i. d) .. x + (\<chi> i. d)} = convex hull s" proof-
3.2449 - let ?d = "(\<chi> i. d)::real^'n"
3.2450 - have *:"{x - ?d .. x + ?d} = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. 1}" apply(rule set_ext, rule)
3.2451 - unfolding image_iff defer apply(erule bexE) proof-
3.2452 - fix y assume as:"y\<in>{x - ?d .. x + ?d}"
3.2453 - { fix i::'n have "x $ i \<le> d + y $ i" "y $ i \<le> d + x $ i" using as[unfolded mem_interval, THEN spec[where x=i]]
3.2454 - by(auto simp add: vector_component)
3.2455 - hence "1 \<ge> inverse d * (x $ i - y $ i)" "1 \<ge> inverse d * (y $ i - x $ i)"
3.2456 - apply(rule_tac[!] mult_left_le_imp_le[OF _ assms]) unfolding mult_assoc[THEN sym]
3.2457 - using assms by(auto simp add: field_simps right_inverse)
3.2458 - hence "inverse d * (x $ i * 2) \<le> 2 + inverse d * (y $ i * 2)"
3.2459 - "inverse d * (y $ i * 2) \<le> 2 + inverse d * (x $ i * 2)" by(auto simp add:field_simps) }
3.2460 - hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> {0..1}" unfolding mem_interval using assms
3.2461 - by(auto simp add: Cart_eq vector_component_simps field_simps)
3.2462 - thus "\<exists>z\<in>{0..1}. y = x - ?d + (2 * d) *\<^sub>R z" apply- apply(rule_tac x="inverse (2 * d) *\<^sub>R (y - (x - ?d))" in bexI)
3.2463 - using assms by(auto simp add: Cart_eq vector_less_eq_def Cart_lambda_beta)
3.2464 - next
3.2465 - fix y z assume as:"z\<in>{0..1}" "y = x - ?d + (2*d) *\<^sub>R z"
3.2466 - have "\<And>i. 0 \<le> d * z $ i \<and> d * z $ i \<le> d" using assms as(1)[unfolded mem_interval] apply(erule_tac x=i in allE)
3.2467 - apply rule apply(rule mult_nonneg_nonneg) prefer 3 apply(rule mult_right_le_one_le)
3.2468 - using assms by(auto simp add: vector_component_simps Cart_eq)
3.2469 - thus "y \<in> {x - ?d..x + ?d}" unfolding as(2) mem_interval apply- apply rule using as(1)[unfolded mem_interval]
3.2470 - apply(erule_tac x=i in allE) using assms by(auto simp add: vector_component_simps Cart_eq) qed
3.2471 - obtain s where "finite s" "{0..1::real^'n} = convex hull s" using unit_cube_convex_hull by auto
3.2472 - thus ?thesis apply(rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` s"]) unfolding * and convex_hull_affinity by auto qed
3.2473 -
3.2474 -subsection {* Bounded convex function on open set is continuous. *}
3.2475 -
3.2476 -lemma convex_on_bounded_continuous:
3.2477 - fixes s :: "(real ^ _) set"
3.2478 - assumes "open s" "convex_on s f" "\<forall>x\<in>s. abs(f x) \<le> b"
3.2479 - shows "continuous_on s f"
3.2480 - apply(rule continuous_at_imp_continuous_on) unfolding continuous_at_real_range proof(rule,rule,rule)
3.2481 - fix x e assume "x\<in>s" "(0::real) < e"
3.2482 - def B \<equiv> "abs b + 1"
3.2483 - have B:"0 < B" "\<And>x. x\<in>s \<Longrightarrow> abs (f x) \<le> B"
3.2484 - unfolding B_def defer apply(drule assms(3)[rule_format]) by auto
3.2485 - obtain k where "k>0"and k:"cball x k \<subseteq> s" using assms(1)[unfolded open_contains_cball, THEN bspec[where x=x]] using `x\<in>s` by auto
3.2486 - show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
3.2487 - apply(rule_tac x="min (k / 2) (e / (2 * B) * k)" in exI) apply rule defer proof(rule,rule)
3.2488 - fix y assume as:"norm (y - x) < min (k / 2) (e / (2 * B) * k)"
3.2489 - show "\<bar>f y - f x\<bar> < e" proof(cases "y=x")
3.2490 - case False def t \<equiv> "k / norm (y - x)"
3.2491 - have "2 < t" "0<t" unfolding t_def using as False and `k>0` by(auto simp add:field_simps)
3.2492 - have "y\<in>s" apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
3.2493 - apply(rule order_trans[of _ "2 * norm (x - y)"]) using as by(auto simp add: field_simps norm_minus_commute)
3.2494 - { def w \<equiv> "x + t *\<^sub>R (y - x)"
3.2495 - have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
3.2496 - unfolding t_def using `k>0` by auto
3.2497 - 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 add: algebra_simps)
3.2498 - also have "\<dots> = 0" using `t>0` by(auto simp add:field_simps)
3.2499 - finally have w:"(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y" unfolding w_def using False and `t>0` by (auto simp add: algebra_simps)
3.2500 - have "2 * B < e * t" unfolding t_def using `0<e` `0<k` `B>0` and as and False by (auto simp add:field_simps)
3.2501 - hence "(f w - f x) / t < e"
3.2502 - using B(2)[OF `w\<in>s`] and B(2)[OF `x\<in>s`] using `t>0` by(auto simp add:field_simps)
3.2503 - hence th1:"f y - f x < e" apply- apply(rule le_less_trans) defer apply assumption
3.2504 - using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
3.2505 - using `0<t` `2<t` and `x\<in>s` `w\<in>s` by(auto simp add:field_simps) }
3.2506 - moreover
3.2507 - { def w \<equiv> "x - t *\<^sub>R (y - x)"
3.2508 - have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
3.2509 - unfolding t_def using `k>0` by auto
3.2510 - 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 add: algebra_simps)
3.2511 - also have "\<dots>=x" using `t>0` by (auto simp add:field_simps)
3.2512 - finally have w:"(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x" unfolding w_def using False and `t>0` by (auto simp add: algebra_simps)
3.2513 - have "2 * B < e * t" unfolding t_def using `0<e` `0<k` `B>0` and as and False by (auto simp add:field_simps)
3.2514 - hence *:"(f w - f y) / t < e" using B(2)[OF `w\<in>s`] and B(2)[OF `y\<in>s`] using `t>0` by(auto simp add:field_simps)
3.2515 - have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
3.2516 - using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
3.2517 - using `0<t` `2<t` and `y\<in>s` `w\<in>s` by (auto simp add:field_simps)
3.2518 - also have "\<dots> = (f w + t * f y) / (1 + t)" using `t>0` unfolding real_divide_def by (auto simp add:field_simps)
3.2519 - also have "\<dots> < e + f y" using `t>0` * `e>0` by(auto simp add:field_simps)
3.2520 - finally have "f x - f y < e" by auto }
3.2521 - ultimately show ?thesis by auto
3.2522 - qed(insert `0<e`, auto)
3.2523 - qed(insert `0<e` `0<k` `0<B`, auto simp add:field_simps intro!:mult_pos_pos) qed
3.2524 -
3.2525 -subsection {* Upper bound on a ball implies upper and lower bounds. *}
3.2526 -
3.2527 -lemma convex_bounds_lemma:
3.2528 - fixes x :: "real ^ _"
3.2529 - assumes "convex_on (cball x e) f" "\<forall>y \<in> cball x e. f y \<le> b"
3.2530 - shows "\<forall>y \<in> cball x e. abs(f y) \<le> b + 2 * abs(f x)"
3.2531 - apply(rule) proof(cases "0 \<le> e") case True
3.2532 - fix y assume y:"y\<in>cball x e" def z \<equiv> "2 *\<^sub>R x - y"
3.2533 - have *:"x - (2 *\<^sub>R x - y) = y - x" by vector
3.2534 - have z:"z\<in>cball x e" using y unfolding z_def mem_cball dist_norm * by(auto simp add: norm_minus_commute)
3.2535 - have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x" unfolding z_def by (auto simp add: algebra_simps)
3.2536 - thus "\<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"]
3.2537 - using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z] by(auto simp add:field_simps)
3.2538 -next case False fix y assume "y\<in>cball x e"
3.2539 - hence "dist x y < 0" using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
3.2540 - thus "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" using zero_le_dist[of x y] by auto qed
3.2541 -
3.2542 -subsection {* Hence a convex function on an open set is continuous. *}
3.2543 -
3.2544 -lemma convex_on_continuous:
3.2545 - assumes "open (s::(real^'n::finite) set)" "convex_on s f"
3.2546 - shows "continuous_on s f"
3.2547 - unfolding continuous_on_eq_continuous_at[OF assms(1)] proof
3.2548 - note dimge1 = dimindex_ge_1[where 'a='n]
3.2549 - fix x assume "x\<in>s"
3.2550 - then obtain e where e:"cball x e \<subseteq> s" "e>0" using assms(1) unfolding open_contains_cball by auto
3.2551 - def d \<equiv> "e / real CARD('n)"
3.2552 - have "0 < d" unfolding d_def using `e>0` dimge1 by(rule_tac divide_pos_pos, auto)
3.2553 - let ?d = "(\<chi> i. d)::real^'n"
3.2554 - obtain c where c:"finite c" "{x - ?d..x + ?d} = convex hull c" using cube_convex_hull[OF `d>0`, of x] by auto
3.2555 - have "x\<in>{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by(auto simp add:vector_component_simps)
3.2556 - hence "c\<noteq>{}" apply(rule_tac ccontr) using c by(auto simp add:convex_hull_empty)
3.2557 - def k \<equiv> "Max (f ` c)"
3.2558 - have "convex_on {x - ?d..x + ?d} f" apply(rule convex_on_subset[OF assms(2)])
3.2559 - apply(rule subset_trans[OF _ e(1)]) unfolding subset_eq mem_cball proof
3.2560 - fix z assume z:"z\<in>{x - ?d..x + ?d}"
3.2561 - have e:"e = setsum (\<lambda>i. d) (UNIV::'n set)" unfolding setsum_constant d_def using dimge1
3.2562 - by (metis card_enum field_simps d_def not_one_le_zero of_nat_le_iff real_eq_of_nat real_of_nat_1)
3.2563 - show "dist x z \<le> e" unfolding dist_norm e apply(rule_tac order_trans[OF norm_le_l1], rule setsum_mono)
3.2564 - using z[unfolded mem_interval] apply(erule_tac x=i in allE) by(auto simp add:field_simps vector_component_simps) qed
3.2565 - hence k:"\<forall>y\<in>{x - ?d..x + ?d}. f y \<le> k" unfolding c(2) apply(rule_tac convex_on_convex_hull_bound) apply assumption
3.2566 - unfolding k_def apply(rule, rule Max_ge) using c(1) by auto
3.2567 - have "d \<le> e" unfolding d_def apply(rule mult_imp_div_pos_le) using `e>0` dimge1 unfolding mult_le_cancel_left1 using real_dimindex_ge_1 by auto
3.2568 - hence dsube:"cball x d \<subseteq> cball x e" unfolding subset_eq Ball_def mem_cball by auto
3.2569 - have conv:"convex_on (cball x d) f" apply(rule convex_on_subset, rule convex_on_subset[OF assms(2)]) apply(rule e(1)) using dsube by auto
3.2570 - hence "\<forall>y\<in>cball x d. abs (f y) \<le> k + 2 * abs (f x)" apply(rule_tac convex_bounds_lemma) apply assumption proof
3.2571 - fix y assume y:"y\<in>cball x d"
3.2572 - { fix i::'n have "x $ i - d \<le> y $ i" "y $ i \<le> x $ i + d"
3.2573 - using order_trans[OF component_le_norm y[unfolded mem_cball dist_norm], of i] by(auto simp add: vector_component) }
3.2574 - thus "f y \<le> k" apply(rule_tac k[rule_format]) unfolding mem_cball mem_interval dist_norm
3.2575 - by(auto simp add: vector_component_simps) qed
3.2576 - hence "continuous_on (ball x d) f" apply(rule_tac convex_on_bounded_continuous)
3.2577 - apply(rule open_ball, rule convex_on_subset[OF conv], rule ball_subset_cball) by auto
3.2578 - thus "continuous (at x) f" unfolding continuous_on_eq_continuous_at[OF open_ball] using `d>0` by auto qed
3.2579 -
3.2580 -subsection {* Line segments, starlike sets etc. *)
3.2581 -(* Use the same overloading tricks as for intervals, so that *)
3.2582 -(* segment[a,b] is closed and segment(a,b) is open relative to affine hull. *}
3.2583 -
3.2584 -definition
3.2585 - midpoint :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
3.2586 - "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
3.2587 -
3.2588 -definition
3.2589 - open_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
3.2590 - "open_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 < u \<and> u < 1}"
3.2591 -
3.2592 -definition
3.2593 - closed_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
3.2594 - "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
3.2595 -
3.2596 -definition "between = (\<lambda> (a,b). closed_segment a b)"
3.2597 -
3.2598 -lemmas segment = open_segment_def closed_segment_def
3.2599 -
3.2600 -definition "starlike s \<longleftrightarrow> (\<exists>a\<in>s. \<forall>x\<in>s. closed_segment a x \<subseteq> s)"
3.2601 -
3.2602 -lemma midpoint_refl: "midpoint x x = x"
3.2603 - unfolding midpoint_def unfolding scaleR_right_distrib unfolding scaleR_left_distrib[THEN sym] by auto
3.2604 -
3.2605 -lemma midpoint_sym: "midpoint a b = midpoint b a" unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
3.2606 -
3.2607 -lemma dist_midpoint:
3.2608 - "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
3.2609 - "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
3.2610 - "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
3.2611 - "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
3.2612 -proof-
3.2613 - have *: "\<And>x y::real^'n::finite. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2" unfolding equation_minus_iff by auto
3.2614 - have **:"\<And>x y::real^'n::finite. 2 *\<^sub>R x = y \<Longrightarrow> norm x = (norm y) / 2" by auto
3.2615 - note scaleR_right_distrib [simp]
3.2616 - show ?t1 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector)
3.2617 - show ?t2 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
3.2618 - show ?t3 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
3.2619 - show ?t4 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector) qed
3.2620 -
3.2621 -lemma midpoint_eq_endpoint:
3.2622 - "midpoint a b = a \<longleftrightarrow> a = (b::real^'n::finite)"
3.2623 - "midpoint a b = b \<longleftrightarrow> a = b"
3.2624 - unfolding dist_eq_0_iff[where 'a="real^'n", THEN sym] dist_midpoint by auto
3.2625 -
3.2626 -lemma convex_contains_segment:
3.2627 - "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. closed_segment a b \<subseteq> s)"
3.2628 - unfolding convex_alt closed_segment_def by auto
3.2629 -
3.2630 -lemma convex_imp_starlike:
3.2631 - "convex s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> starlike s"
3.2632 - unfolding convex_contains_segment starlike_def by auto
3.2633 -
3.2634 -lemma segment_convex_hull:
3.2635 - "closed_segment a b = convex hull {a,b}" proof-
3.2636 - have *:"\<And>x. {x} \<noteq> {}" by auto
3.2637 - have **:"\<And>u v. u + v = 1 \<longleftrightarrow> u = 1 - (v::real)" by auto
3.2638 - show ?thesis unfolding segment convex_hull_insert[OF *] convex_hull_singleton apply(rule set_ext)
3.2639 - unfolding mem_Collect_eq apply(rule,erule exE)
3.2640 - apply(rule_tac x="1 - u" in exI) apply rule defer apply(rule_tac x=u in exI) defer
3.2641 - apply(erule exE, (erule conjE)?)+ apply(rule_tac x="1 - u" in exI) unfolding ** by auto qed
3.2642 -
3.2643 -lemma convex_segment: "convex (closed_segment a b)"
3.2644 - unfolding segment_convex_hull by(rule convex_convex_hull)
3.2645 -
3.2646 -lemma ends_in_segment: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
3.2647 - unfolding segment_convex_hull apply(rule_tac[!] hull_subset[unfolded subset_eq, rule_format]) by auto
3.2648 -
3.2649 -lemma segment_furthest_le:
3.2650 - assumes "x \<in> closed_segment a b" shows "norm(y - x) \<le> norm(y - a) \<or> norm(y - x) \<le> norm(y - b)" proof-
3.2651 - obtain z where "z\<in>{a, b}" "norm (x - y) \<le> norm (z - y)" using simplex_furthest_le[of "{a, b}" y]
3.2652 - using assms[unfolded segment_convex_hull] by auto
3.2653 - thus ?thesis by(auto simp add:norm_minus_commute) qed
3.2654 -
3.2655 -lemma segment_bound:
3.2656 - assumes "x \<in> closed_segment a b"
3.2657 - shows "norm(x - a) \<le> norm(b - a)" "norm(x - b) \<le> norm(b - a)"
3.2658 - using segment_furthest_le[OF assms, of a]
3.2659 - using segment_furthest_le[OF assms, of b]
3.2660 - by (auto simp add:norm_minus_commute)
3.2661 -
3.2662 -lemma segment_refl:"closed_segment a a = {a}" unfolding segment by (auto simp add: algebra_simps)
3.2663 -
3.2664 -lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
3.2665 - unfolding between_def mem_def by auto
3.2666 -
3.2667 -lemma between:"between (a,b) (x::real^'n::finite) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
3.2668 -proof(cases "a = b")
3.2669 - case True thus ?thesis unfolding between_def split_conv mem_def[of x, symmetric]
3.2670 - by(auto simp add:segment_refl dist_commute) next
3.2671 - case False hence Fal:"norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0" by auto
3.2672 - have *:"\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" by (auto simp add: algebra_simps)
3.2673 - show ?thesis unfolding between_def split_conv mem_def[of x, symmetric] closed_segment_def mem_Collect_eq
3.2674 - apply rule apply(erule exE, (erule conjE)+) apply(subst dist_triangle_eq) proof-
3.2675 - fix u assume as:"x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
3.2676 - hence *:"a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
3.2677 - unfolding as(1) by(auto simp add:algebra_simps)
3.2678 - show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
3.2679 - unfolding norm_minus_commute[of x a] * Cart_eq using as(2,3)
3.2680 - by(auto simp add: vector_component_simps field_simps)
3.2681 - next assume as:"dist a b = dist a x + dist x b"
3.2682 - have "norm (a - x) / norm (a - b) \<le> 1" unfolding divide_le_eq_1_pos[OF Fal2] unfolding as[unfolded dist_norm] norm_ge_zero by auto
3.2683 - thus "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1" apply(rule_tac x="dist a x / dist a b" in exI)
3.2684 - unfolding dist_norm Cart_eq apply- apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 proof rule
3.2685 - fix i::'n have "((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i =
3.2686 - ((norm (a - b) - norm (a - x)) * (a $ i) + norm (a - x) * (b $ i)) / norm (a - b)"
3.2687 - using Fal by(auto simp add:vector_component_simps field_simps)
3.2688 - also have "\<dots> = x$i" apply(rule divide_eq_imp[OF Fal])
3.2689 - unfolding as[unfolded dist_norm] using as[unfolded dist_triangle_eq Cart_eq,rule_format, of i]
3.2690 - by(auto simp add:field_simps vector_component_simps)
3.2691 - finally show "x $ i = ((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i" by auto
3.2692 - qed(insert Fal2, auto) qed qed
3.2693 -
3.2694 -lemma between_midpoint: fixes a::"real^'n::finite" shows
3.2695 - "between (a,b) (midpoint a b)" (is ?t1)
3.2696 - "between (b,a) (midpoint a b)" (is ?t2)
3.2697 -proof- have *:"\<And>x y z. x = (1/2::real) *\<^sub>R z \<Longrightarrow> y = (1/2) *\<^sub>R z \<Longrightarrow> norm z = norm x + norm y" by auto
3.2698 - show ?t1 ?t2 unfolding between midpoint_def dist_norm apply(rule_tac[!] *)
3.2699 - by(auto simp add:field_simps Cart_eq vector_component_simps) qed
3.2700 -
3.2701 -lemma between_mem_convex_hull:
3.2702 - "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
3.2703 - unfolding between_mem_segment segment_convex_hull ..
3.2704 -
3.2705 -subsection {* Shrinking towards the interior of a convex set. *}
3.2706 -
3.2707 -lemma mem_interior_convex_shrink:
3.2708 - fixes s :: "(real ^ _) set"
3.2709 - assumes "convex s" "c \<in> interior s" "x \<in> s" "0 < e" "e \<le> 1"
3.2710 - shows "x - e *\<^sub>R (x - c) \<in> interior s"
3.2711 -proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
3.2712 - show ?thesis unfolding mem_interior apply(rule_tac x="e*d" in exI)
3.2713 - apply(rule) defer unfolding subset_eq Ball_def mem_ball proof(rule,rule)
3.2714 - fix y assume as:"dist (x - e *\<^sub>R (x - c)) y < e * d"
3.2715 - have *:"y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x" using `e>0` by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
3.2716 - have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = abs(1/e) * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
3.2717 - unfolding dist_norm unfolding norm_scaleR[THEN sym] apply(rule norm_eqI) using `e>0`
3.2718 - by(auto simp add:vector_component_simps Cart_eq field_simps)
3.2719 - also have "\<dots> = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:norm_eqI simp add: algebra_simps)
3.2720 - also have "\<dots> < d" using as[unfolded dist_norm] and `e>0`
3.2721 - by(auto simp add:pos_divide_less_eq[OF `e>0`] real_mult_commute)
3.2722 - finally show "y \<in> s" apply(subst *) apply(rule assms(1)[unfolded convex_alt,rule_format])
3.2723 - apply(rule d[unfolded subset_eq,rule_format]) unfolding mem_ball using assms(3-5) by auto
3.2724 - qed(rule mult_pos_pos, insert `e>0` `d>0`, auto) qed
3.2725 -
3.2726 -lemma mem_interior_closure_convex_shrink:
3.2727 - fixes s :: "(real ^ _) set"
3.2728 - assumes "convex s" "c \<in> interior s" "x \<in> closure s" "0 < e" "e \<le> 1"
3.2729 - shows "x - e *\<^sub>R (x - c) \<in> interior s"
3.2730 -proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
3.2731 - have "\<exists>y\<in>s. norm (y - x) * (1 - e) < e * d" proof(cases "x\<in>s")
3.2732 - case True thus ?thesis using `e>0` `d>0` by(rule_tac bexI[where x=x], auto intro!: mult_pos_pos) next
3.2733 - case False hence x:"x islimpt s" using assms(3)[unfolded closure_def] by auto
3.2734 - show ?thesis proof(cases "e=1")
3.2735 - case True obtain y where "y\<in>s" "y \<noteq> x" "dist y x < 1"
3.2736 - using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
3.2737 - thus ?thesis apply(rule_tac x=y in bexI) unfolding True using `d>0` by auto next
3.2738 - case False hence "0 < e * d / (1 - e)" and *:"1 - e > 0"
3.2739 - using `e\<le>1` `e>0` `d>0` by(auto intro!:mult_pos_pos divide_pos_pos)
3.2740 - then obtain y where "y\<in>s" "y \<noteq> x" "dist y x < e * d / (1 - e)"
3.2741 - using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
3.2742 - thus ?thesis apply(rule_tac x=y in bexI) unfolding dist_norm using pos_less_divide_eq[OF *] by auto qed qed
3.2743 - then obtain y where "y\<in>s" and y:"norm (y - x) * (1 - e) < e * d" by auto
3.2744 - def z \<equiv> "c + ((1 - e) / e) *\<^sub>R (x - y)"
3.2745 - have *:"x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)" unfolding z_def using `e>0` by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
3.2746 - have "z\<in>interior s" apply(rule subset_interior[OF d,unfolded subset_eq,rule_format])
3.2747 - unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
3.2748 - by(auto simp add:field_simps norm_minus_commute)
3.2749 - thus ?thesis unfolding * apply - apply(rule mem_interior_convex_shrink)
3.2750 - using assms(1,4-5) `y\<in>s` by auto qed
3.2751 -
3.2752 -subsection {* Some obvious but surprisingly hard simplex lemmas. *}
3.2753 -
3.2754 -lemma simplex:
3.2755 - assumes "finite s" "0 \<notin> s"
3.2756 - shows "convex hull (insert 0 s) = { y. (\<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s \<le> 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y)}"
3.2757 - unfolding convex_hull_finite[OF finite.insertI[OF assms(1)]] apply(rule set_ext, rule) unfolding mem_Collect_eq
3.2758 - apply(erule_tac[!] exE) apply(erule_tac[!] conjE)+ unfolding setsum_clauses(2)[OF assms(1)]
3.2759 - apply(rule_tac x=u in exI) defer apply(rule_tac x="\<lambda>x. if x = 0 then 1 - setsum u s else u x" in exI) using assms(2)
3.2760 - unfolding if_smult and setsum_delta_notmem[OF assms(2)] by auto
3.2761 -
3.2762 -lemma std_simplex:
3.2763 - "convex hull (insert 0 { basis i | i. i\<in>UNIV}) =
3.2764 - {x::real^'n::finite . (\<forall>i. 0 \<le> x$i) \<and> setsum (\<lambda>i. x$i) UNIV \<le> 1 }" (is "convex hull (insert 0 ?p) = ?s")
3.2765 -proof- let ?D = "UNIV::'n set"
3.2766 - have "0\<notin>?p" by(auto simp add: basis_nonzero)
3.2767 - have "{(basis i)::real^'n |i. i \<in> ?D} = basis ` ?D" by auto
3.2768 - note sumbas = this setsum_reindex[OF basis_inj, unfolded o_def]
3.2769 - show ?thesis unfolding simplex[OF finite_stdbasis `0\<notin>?p`] apply(rule set_ext) unfolding mem_Collect_eq apply rule
3.2770 - apply(erule exE, (erule conjE)+) apply(erule_tac[2] conjE)+ proof-
3.2771 - fix x::"real^'n" and u assume as: "\<forall>x\<in>{basis i |i. i \<in>?D}. 0 \<le> u x" "setsum u {basis i |i. i \<in> ?D} \<le> 1" "(\<Sum>x\<in>{basis i |i. i \<in>?D}. u x *\<^sub>R x) = x"
3.2772 - have *:"\<forall>i. u (basis i) = x$i" using as(3) unfolding sumbas and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by auto
3.2773 - hence **:"setsum u {basis i |i. i \<in> ?D} = setsum (op $ x) ?D" unfolding sumbas by(rule_tac setsum_cong, auto)
3.2774 - show " (\<forall>i. 0 \<le> x $ i) \<and> setsum (op $ x) ?D \<le> 1" apply - proof(rule,rule)
3.2775 - fix i::'n show "0 \<le> x$i" unfolding *[rule_format,of i,THEN sym] apply(rule_tac as(1)[rule_format]) by auto
3.2776 - qed(insert as(2)[unfolded **], auto)
3.2777 - next fix x::"real^'n" assume as:"\<forall>i. 0 \<le> x $ i" "setsum (op $ x) ?D \<le> 1"
3.2778 - show "\<exists>u. (\<forall>x\<in>{basis i |i. i \<in> ?D}. 0 \<le> u x) \<and> setsum u {basis i |i. i \<in> ?D} \<le> 1 \<and> (\<Sum>x\<in>{basis i |i. i \<in> ?D}. u x *\<^sub>R x) = x"
3.2779 - apply(rule_tac x="\<lambda>y. inner y x" in exI) apply(rule,rule) unfolding mem_Collect_eq apply(erule exE) using as(1) apply(erule_tac x=i in allE)
3.2780 - unfolding sumbas using as(2) and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by(auto simp add:inner_basis) qed qed
3.2781 -
3.2782 -lemma interior_std_simplex:
3.2783 - "interior (convex hull (insert 0 { basis i| i. i\<in>UNIV})) =
3.2784 - {x::real^'n::finite. (\<forall>i. 0 < x$i) \<and> setsum (\<lambda>i. x$i) UNIV < 1 }"
3.2785 - apply(rule set_ext) unfolding mem_interior std_simplex unfolding subset_eq mem_Collect_eq Ball_def mem_ball
3.2786 - unfolding Ball_def[symmetric] apply rule apply(erule exE, (erule conjE)+) defer apply(erule conjE) proof-
3.2787 - fix x::"real^'n" and e assume "0<e" and as:"\<forall>xa. dist x xa < e \<longrightarrow> (\<forall>x. 0 \<le> xa $ x) \<and> setsum (op $ xa) UNIV \<le> 1"
3.2788 - show "(\<forall>xa. 0 < x $ xa) \<and> setsum (op $ x) UNIV < 1" apply(rule,rule) proof-
3.2789 - fix i::'n show "0 < x $ i" using as[THEN spec[where x="x - (e / 2) *\<^sub>R basis i"]] and `e>0`
3.2790 - unfolding dist_norm by(auto simp add: norm_basis vector_component_simps basis_component elim:allE[where x=i])
3.2791 - next guess a using UNIV_witness[where 'a='n] ..
3.2792 - have **:"dist x (x + (e / 2) *\<^sub>R basis a) < e" using `e>0` and norm_basis[of a]
3.2793 - unfolding dist_norm by(auto simp add: vector_component_simps basis_component intro!: mult_strict_left_mono_comm)
3.2794 - have "\<And>i. (x + (e / 2) *\<^sub>R basis a) $ i = x$i + (if i = a then e/2 else 0)" by(auto simp add:vector_component_simps)
3.2795 - hence *:"setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV = setsum (\<lambda>i. x$i + (if a = i then e/2 else 0)) UNIV" by(rule_tac setsum_cong, auto)
3.2796 - have "setsum (op $ x) UNIV < setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV" unfolding * setsum_addf
3.2797 - using `0<e` dimindex_ge_1 by(auto simp add: setsum_delta')
3.2798 - also have "\<dots> \<le> 1" using ** apply(drule_tac as[rule_format]) by auto
3.2799 - finally show "setsum (op $ x) UNIV < 1" by auto qed
3.2800 -next
3.2801 - fix x::"real^'n::finite" assume as:"\<forall>i. 0 < x $ i" "setsum (op $ x) UNIV < 1"
3.2802 - guess a using UNIV_witness[where 'a='b] ..
3.2803 - let ?d = "(1 - setsum (op $ x) UNIV) / real (CARD('n))"
3.2804 - have "Min ((op $ x) ` UNIV) > 0" apply(rule Min_grI) using as(1) dimindex_ge_1 by auto
3.2805 - moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) using dimindex_ge_1 by(auto simp add: Suc_le_eq)
3.2806 - ultimately show "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> (\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1"
3.2807 - apply(rule_tac x="min (Min ((op $ x) ` UNIV)) ?D" in exI) apply rule defer apply(rule,rule) proof-
3.2808 - fix y assume y:"dist x y < min (Min (op $ x ` UNIV)) ?d"
3.2809 - have "setsum (op $ y) UNIV \<le> setsum (\<lambda>i. x$i + ?d) UNIV" proof(rule setsum_mono)
3.2810 - fix i::'n have "abs (y$i - x$i) < ?d" apply(rule le_less_trans) using component_le_norm[of "y - x" i]
3.2811 - using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] by(auto simp add:vector_component_simps norm_minus_commute)
3.2812 - thus "y $ i \<le> x $ i + ?d" by auto qed
3.2813 - also have "\<dots> \<le> 1" unfolding setsum_addf setsum_constant card_enum real_eq_of_nat using dimindex_ge_1 by(auto simp add: Suc_le_eq)
3.2814 - finally show "(\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1" apply- proof(rule,rule)
3.2815 - fix i::'n have "norm (x - y) < x$i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
3.2816 - using Min_gr_iff[of "op $ x ` dimset x"] dimindex_ge_1 by auto
3.2817 - thus "0 \<le> y$i" using component_le_norm[of "x - y" i] and as(1)[rule_format, of i] by(auto simp add: vector_component_simps)
3.2818 - qed auto qed auto qed
3.2819 -
3.2820 -lemma interior_std_simplex_nonempty: obtains a::"real^'n::finite" where
3.2821 - "a \<in> interior(convex hull (insert 0 {basis i | i . i \<in> UNIV}))" proof-
3.2822 - let ?D = "UNIV::'n set" let ?a = "setsum (\<lambda>b::real^'n. inverse (2 * real CARD('n)) *\<^sub>R b) {(basis i) | i. i \<in> ?D}"
3.2823 - have *:"{basis i :: real ^ 'n | i. i \<in> ?D} = basis ` ?D" by auto
3.2824 - { fix i have "?a $ i = inverse (2 * real CARD('n))"
3.2825 - unfolding setsum_component vector_smult_component and * and setsum_reindex[OF basis_inj] and o_def
3.2826 - apply(rule trans[of _ "setsum (\<lambda>j. if i = j then inverse (2 * real CARD('n)) else 0) ?D"]) apply(rule setsum_cong2)
3.2827 - unfolding setsum_delta'[OF finite_UNIV[where 'a='n]] and real_dimindex_ge_1[where 'n='n] by(auto simp add: basis_component[of i]) }
3.2828 - note ** = this
3.2829 - show ?thesis apply(rule that[of ?a]) unfolding interior_std_simplex mem_Collect_eq proof(rule,rule)
3.2830 - fix i::'n show "0 < ?a $ i" unfolding ** using dimindex_ge_1 by(auto simp add: Suc_le_eq) next
3.2831 - have "setsum (op $ ?a) ?D = setsum (\<lambda>i. inverse (2 * real CARD('n))) ?D" by(rule setsum_cong2, rule **)
3.2832 - also have "\<dots> < 1" unfolding setsum_constant card_enum real_eq_of_nat real_divide_def[THEN sym] by (auto simp add:field_simps)
3.2833 - finally show "setsum (op $ ?a) ?D < 1" by auto qed qed
3.2834 -
3.2835 -subsection {* Paths. *}
3.2836 -
3.2837 -definition "path (g::real^1 \<Rightarrow> real^'n::finite) \<longleftrightarrow> continuous_on {0 .. 1} g"
3.2838 -
3.2839 -definition "pathstart (g::real^1 \<Rightarrow> real^'n) = g 0"
3.2840 -
3.2841 -definition "pathfinish (g::real^1 \<Rightarrow> real^'n) = g 1"
3.2842 -
3.2843 -definition "path_image (g::real^1 \<Rightarrow> real^'n) = g ` {0 .. 1}"
3.2844 -
3.2845 -definition "reversepath (g::real^1 \<Rightarrow> real^'n) = (\<lambda>x. g(1 - x))"
3.2846 -
3.2847 -definition joinpaths:: "(real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n)" (infixr "+++" 75)
3.2848 - where "joinpaths g1 g2 = (\<lambda>x. if dest_vec1 x \<le> ((1 / 2)::real) then g1 (2 *\<^sub>R x) else g2(2 *\<^sub>R x - 1))"
3.2849 -definition "simple_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
3.2850 - (\<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)"
3.2851 -
3.2852 -definition "injective_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
3.2853 - (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y)"
3.2854 -
3.2855 -subsection {* Some lemmas about these concepts. *}
3.2856 -
3.2857 -lemma injective_imp_simple_path:
3.2858 - "injective_path g \<Longrightarrow> simple_path g"
3.2859 - unfolding injective_path_def simple_path_def by auto
3.2860 -
3.2861 -lemma path_image_nonempty: "path_image g \<noteq> {}"
3.2862 - unfolding path_image_def image_is_empty interval_eq_empty by auto
3.2863 -
3.2864 -lemma pathstart_in_path_image[intro]: "(pathstart g) \<in> path_image g"
3.2865 - unfolding pathstart_def path_image_def apply(rule imageI)
3.2866 - unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
3.2867 -
3.2868 -lemma pathfinish_in_path_image[intro]: "(pathfinish g) \<in> path_image g"
3.2869 - unfolding pathfinish_def path_image_def apply(rule imageI)
3.2870 - unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
3.2871 -
3.2872 -lemma connected_path_image[intro]: "path g \<Longrightarrow> connected(path_image g)"
3.2873 - unfolding path_def path_image_def apply(rule connected_continuous_image, assumption)
3.2874 - by(rule convex_connected, rule convex_interval)
3.2875 -
3.2876 -lemma compact_path_image[intro]: "path g \<Longrightarrow> compact(path_image g)"
3.2877 - unfolding path_def path_image_def apply(rule compact_continuous_image, assumption)
3.2878 - by(rule compact_interval)
3.2879 -
3.2880 -lemma reversepath_reversepath[simp]: "reversepath(reversepath g) = g"
3.2881 - unfolding reversepath_def by auto
3.2882 -
3.2883 -lemma pathstart_reversepath[simp]: "pathstart(reversepath g) = pathfinish g"
3.2884 - unfolding pathstart_def reversepath_def pathfinish_def by auto
3.2885 -
3.2886 -lemma pathfinish_reversepath[simp]: "pathfinish(reversepath g) = pathstart g"
3.2887 - unfolding pathstart_def reversepath_def pathfinish_def by auto
3.2888 -
3.2889 -lemma pathstart_join[simp]: "pathstart(g1 +++ g2) = pathstart g1"
3.2890 - unfolding pathstart_def joinpaths_def pathfinish_def by auto
3.2891 -
3.2892 -lemma pathfinish_join[simp]:"pathfinish(g1 +++ g2) = pathfinish g2" proof-
3.2893 - have "2 *\<^sub>R 1 - 1 = (1::real^1)" unfolding Cart_eq by(auto simp add:vector_component_simps)
3.2894 - thus ?thesis unfolding pathstart_def joinpaths_def pathfinish_def
3.2895 - unfolding vec_1[THEN sym] dest_vec1_vec by auto qed
3.2896 -
3.2897 -lemma path_image_reversepath[simp]: "path_image(reversepath g) = path_image g" proof-
3.2898 - have *:"\<And>g. path_image(reversepath g) \<subseteq> path_image g"
3.2899 - unfolding path_image_def subset_eq reversepath_def Ball_def image_iff apply(rule,rule,erule bexE)
3.2900 - apply(rule_tac x="1 - xa" in bexI) by(auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
3.2901 - show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
3.2902 -
3.2903 -lemma path_reversepath[simp]: "path(reversepath g) \<longleftrightarrow> path g" proof-
3.2904 - have *:"\<And>g. path g \<Longrightarrow> path(reversepath g)" unfolding path_def reversepath_def
3.2905 - apply(rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
3.2906 - apply(rule continuous_on_sub, rule continuous_on_const, rule continuous_on_id)
3.2907 - apply(rule continuous_on_subset[of "{0..1}"], assumption)
3.2908 - by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
3.2909 - show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
3.2910 -
3.2911 -lemmas reversepath_simps = path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
3.2912 -
3.2913 -lemma path_join[simp]: assumes "pathfinish g1 = pathstart g2" shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
3.2914 - unfolding path_def pathfinish_def pathstart_def apply rule defer apply(erule conjE) proof-
3.2915 - assume as:"continuous_on {0..1} (g1 +++ g2)"
3.2916 - have *:"g1 = (\<lambda>x. g1 (2 *\<^sub>R x)) \<circ> (\<lambda>x. (1/2) *\<^sub>R x)"
3.2917 - "g2 = (\<lambda>x. g2 (2 *\<^sub>R x - 1)) \<circ> (\<lambda>x. (1/2) *\<^sub>R (x + 1))" unfolding o_def by auto
3.2918 - have "op *\<^sub>R (1 / 2) ` {0::real^1..1} \<subseteq> {0..1}" "(\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {(0::real^1)..1} \<subseteq> {0..1}"
3.2919 - unfolding image_smult_interval by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
3.2920 - thus "continuous_on {0..1} g1 \<and> continuous_on {0..1} g2" apply -apply rule
3.2921 - apply(subst *) defer apply(subst *) apply (rule_tac[!] continuous_on_compose)
3.2922 - apply (rule continuous_on_cmul, rule continuous_on_add, rule continuous_on_id, rule continuous_on_const) defer
3.2923 - apply (rule continuous_on_cmul, rule continuous_on_id) apply(rule_tac[!] continuous_on_eq[of _ "g1 +++ g2"]) defer prefer 3
3.2924 - apply(rule_tac[1-2] continuous_on_subset[of "{0 .. 1}"]) apply(rule as, assumption, rule as, assumption)
3.2925 - apply(rule) defer apply rule proof-
3.2926 - fix x assume "x \<in> op *\<^sub>R (1 / 2) ` {0::real^1..1}"
3.2927 - hence "dest_vec1 x \<le> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
3.2928 - thus "(g1 +++ g2) x = g1 (2 *\<^sub>R x)" unfolding joinpaths_def by auto next
3.2929 - fix x assume "x \<in> (\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {0::real^1..1}"
3.2930 - hence "dest_vec1 x \<ge> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
3.2931 - thus "(g1 +++ g2) x = g2 (2 *\<^sub>R x - 1)" proof(cases "dest_vec1 x = 1 / 2")
3.2932 - case True hence "x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
3.2933 - thus ?thesis unfolding joinpaths_def using assms[unfolded pathstart_def pathfinish_def] by auto
3.2934 - qed (auto simp add:le_less joinpaths_def) qed
3.2935 -next assume as:"continuous_on {0..1} g1" "continuous_on {0..1} g2"
3.2936 - have *:"{0 .. 1::real^1} = {0.. (1/2)*\<^sub>R 1} \<union> {(1/2) *\<^sub>R 1 .. 1}" by(auto simp add: vector_component_simps)
3.2937 - have **:"op *\<^sub>R 2 ` {0..(1 / 2) *\<^sub>R 1} = {0..1::real^1}" apply(rule set_ext, rule) unfolding image_iff
3.2938 - defer apply(rule_tac x="(1/2)*\<^sub>R x" in bexI) by(auto simp add: vector_component_simps)
3.2939 - have ***:"(\<lambda>x. 2 *\<^sub>R x - 1) ` {(1 / 2) *\<^sub>R 1..1} = {0..1::real^1}"
3.2940 - unfolding image_affinity_interval[of _ "- 1", unfolded diff_def[symmetric]] and interval_eq_empty_1
3.2941 - by(auto simp add: vector_component_simps)
3.2942 - have ****:"\<And>x::real^1. x $ 1 * 2 = 1 \<longleftrightarrow> x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
3.2943 - show "continuous_on {0..1} (g1 +++ g2)" unfolding * apply(rule continuous_on_union) apply(rule closed_interval)+ proof-
3.2944 - show "continuous_on {0..(1 / 2) *\<^sub>R 1} (g1 +++ g2)" apply(rule continuous_on_eq[of _ "\<lambda>x. g1 (2 *\<^sub>R x)"]) defer
3.2945 - unfolding o_def[THEN sym] apply(rule continuous_on_compose) apply(rule continuous_on_cmul, rule continuous_on_id)
3.2946 - unfolding ** apply(rule as(1)) unfolding joinpaths_def by(auto simp add: vector_component_simps) next
3.2947 - show "continuous_on {(1/2)*\<^sub>R1..1} (g1 +++ g2)" apply(rule continuous_on_eq[of _ "g2 \<circ> (\<lambda>x. 2 *\<^sub>R x - 1)"]) defer
3.2948 - apply(rule continuous_on_compose) apply(rule continuous_on_sub, rule continuous_on_cmul, rule continuous_on_id, rule continuous_on_const)
3.2949 - unfolding *** o_def joinpaths_def apply(rule as(2)) using assms[unfolded pathstart_def pathfinish_def]
3.2950 - by(auto simp add: vector_component_simps ****) qed qed
3.2951 -
3.2952 -lemma path_image_join_subset: "path_image(g1 +++ g2) \<subseteq> (path_image g1 \<union> path_image g2)" proof
3.2953 - fix x assume "x \<in> path_image (g1 +++ g2)"
3.2954 - then obtain y where y:"y\<in>{0..1}" "x = (if dest_vec1 y \<le> 1 / 2 then g1 (2 *\<^sub>R y) else g2 (2 *\<^sub>R y - 1))"
3.2955 - unfolding path_image_def image_iff joinpaths_def by auto
3.2956 - thus "x \<in> path_image g1 \<union> path_image g2" apply(cases "dest_vec1 y \<le> 1/2")
3.2957 - apply(rule_tac UnI1) defer apply(rule_tac UnI2) unfolding y(2) path_image_def using y(1)
3.2958 - by(auto intro!: imageI simp add: vector_component_simps) qed
3.2959 -
3.2960 -lemma subset_path_image_join:
3.2961 - assumes "path_image g1 \<subseteq> s" "path_image g2 \<subseteq> s" shows "path_image(g1 +++ g2) \<subseteq> s"
3.2962 - using path_image_join_subset[of g1 g2] and assms by auto
3.2963 -
3.2964 -lemma path_image_join:
3.2965 - assumes "path g1" "path g2" "pathfinish g1 = pathstart g2"
3.2966 - shows "path_image(g1 +++ g2) = (path_image g1) \<union> (path_image g2)"
3.2967 -apply(rule, rule path_image_join_subset, rule) unfolding Un_iff proof(erule disjE)
3.2968 - fix x assume "x \<in> path_image g1"
3.2969 - then obtain y where y:"y\<in>{0..1}" "x = g1 y" unfolding path_image_def image_iff by auto
3.2970 - thus "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
3.2971 - apply(rule_tac x="(1/2) *\<^sub>R y" in bexI) by(auto simp add: vector_component_simps) next
3.2972 - fix x assume "x \<in> path_image g2"
3.2973 - then obtain y where y:"y\<in>{0..1}" "x = g2 y" unfolding path_image_def image_iff by auto
3.2974 - moreover have *:"y $ 1 = 0 \<Longrightarrow> y = 0" unfolding Cart_eq by auto
3.2975 - ultimately show "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
3.2976 - apply(rule_tac x="(1/2) *\<^sub>R (y + 1)" in bexI) using assms(3)[unfolded pathfinish_def pathstart_def]
3.2977 - by(auto simp add: vector_component_simps) qed
3.2978 -
3.2979 -lemma not_in_path_image_join:
3.2980 - assumes "x \<notin> path_image g1" "x \<notin> path_image g2" shows "x \<notin> path_image(g1 +++ g2)"
3.2981 - using assms and path_image_join_subset[of g1 g2] by auto
3.2982 -
3.2983 -lemma simple_path_reversepath: assumes "simple_path g" shows "simple_path (reversepath g)"
3.2984 - using assms unfolding simple_path_def reversepath_def apply- apply(rule ballI)+
3.2985 - apply(erule_tac x="1-x" in ballE, erule_tac x="1-y" in ballE)
3.2986 - unfolding mem_interval_1 by(auto simp add:vector_component_simps)
3.2987 -
3.2988 -lemma dest_vec1_scaleR [simp]:
3.2989 - "dest_vec1 (scaleR a x) = scaleR a (dest_vec1 x)"
3.2990 -unfolding dest_vec1_def by simp
3.2991 -
3.2992 -lemma simple_path_join_loop:
3.2993 - assumes "injective_path g1" "injective_path g2" "pathfinish g2 = pathstart g1"
3.2994 - "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g1,pathstart g2}"
3.2995 - shows "simple_path(g1 +++ g2)"
3.2996 -unfolding simple_path_def proof((rule ballI)+, rule impI) let ?g = "g1 +++ g2"
3.2997 - note inj = assms(1,2)[unfolded injective_path_def, rule_format]
3.2998 - fix x y::"real^1" assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "?g x = ?g y"
3.2999 - show "x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0" proof(case_tac "x$1 \<le> 1/2",case_tac[!] "y$1 \<le> 1/2", unfold not_le)
3.3000 - assume as:"x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2"
3.3001 - hence "g1 (2 *\<^sub>R x) = g1 (2 *\<^sub>R y)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
3.3002 - moreover have "2 *\<^sub>R x \<in> {0..1}" "2 *\<^sub>R y \<in> {0..1}" using xy(1,2) as
3.3003 - unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
3.3004 - ultimately show ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] by auto
3.3005 - next assume as:"x $ 1 > 1 / 2" "y $ 1 > 1 / 2"
3.3006 - hence "g2 (2 *\<^sub>R x - 1) = g2 (2 *\<^sub>R y - 1)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
3.3007 - moreover have "2 *\<^sub>R x - 1 \<in> {0..1}" "2 *\<^sub>R y - 1 \<in> {0..1}" using xy(1,2) as
3.3008 - unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
3.3009 - ultimately show ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] by auto
3.3010 - next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
3.3011 - hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
3.3012 - using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
3.3013 - moreover have "?g y \<noteq> pathstart g2" using as(2) unfolding pathstart_def joinpaths_def
3.3014 - using inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(2)[unfolded mem_interval_1]
3.3015 - apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
3.3016 - ultimately have *:"?g x = pathstart g1" using assms(4) unfolding xy(3) by auto
3.3017 - hence "x = 0" unfolding pathstart_def joinpaths_def using as(1) and xy(1)[unfolded mem_interval_1]
3.3018 - using inj(1)[of "2 *\<^sub>R x" 0] by(auto simp add:vector_component_simps)
3.3019 - moreover have "y = 1" using * unfolding xy(3) assms(3)[THEN sym]
3.3020 - unfolding joinpaths_def pathfinish_def using as(2) and xy(2)[unfolded mem_interval_1]
3.3021 - using inj(2)[of "2 *\<^sub>R y - 1" 1] by (auto simp add:vector_component_simps Cart_eq)
3.3022 - ultimately show ?thesis by auto
3.3023 - next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
3.3024 - hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
3.3025 - using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
3.3026 - moreover have "?g x \<noteq> pathstart g2" using as(1) unfolding pathstart_def joinpaths_def
3.3027 - using inj(2)[of "2 *\<^sub>R x - 1" 0] and xy(1)[unfolded mem_interval_1]
3.3028 - apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
3.3029 - ultimately have *:"?g y = pathstart g1" using assms(4) unfolding xy(3) by auto
3.3030 - hence "y = 0" unfolding pathstart_def joinpaths_def using as(2) and xy(2)[unfolded mem_interval_1]
3.3031 - using inj(1)[of "2 *\<^sub>R y" 0] by(auto simp add:vector_component_simps)
3.3032 - moreover have "x = 1" using * unfolding xy(3)[THEN sym] assms(3)[THEN sym]
3.3033 - unfolding joinpaths_def pathfinish_def using as(1) and xy(1)[unfolded mem_interval_1]
3.3034 - using inj(2)[of "2 *\<^sub>R x - 1" 1] by(auto simp add:vector_component_simps Cart_eq)
3.3035 - ultimately show ?thesis by auto qed qed
3.3036 -
3.3037 -lemma injective_path_join:
3.3038 - assumes "injective_path g1" "injective_path g2" "pathfinish g1 = pathstart g2"
3.3039 - "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g2}"
3.3040 - shows "injective_path(g1 +++ g2)"
3.3041 - unfolding injective_path_def proof(rule,rule,rule) let ?g = "g1 +++ g2"
3.3042 - note inj = assms(1,2)[unfolded injective_path_def, rule_format]
3.3043 - fix x y assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "(g1 +++ g2) x = (g1 +++ g2) y"
3.3044 - show "x = y" proof(cases "x$1 \<le> 1/2", case_tac[!] "y$1 \<le> 1/2", unfold not_le)
3.3045 - assume "x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2" thus ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] and xy
3.3046 - unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
3.3047 - next assume "x $ 1 > 1 / 2" "y $ 1 > 1 / 2" thus ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] and xy
3.3048 - unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
3.3049 - next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
3.3050 - hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
3.3051 - using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
3.3052 - hence "?g x = pathfinish g1" "?g y = pathstart g2" using assms(4) unfolding assms(3) xy(3) by auto
3.3053 - thus ?thesis using as and inj(1)[of "2 *\<^sub>R x" 1] inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(1,2)
3.3054 - unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
3.3055 - by(auto simp add:vector_component_simps Cart_eq forall_1)
3.3056 - next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
3.3057 - hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
3.3058 - using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
3.3059 - hence "?g x = pathstart g2" "?g y = pathfinish g1" using assms(4) unfolding assms(3) xy(3) by auto
3.3060 - thus ?thesis using as and inj(2)[of "2 *\<^sub>R x - 1" 0] inj(1)[of "2 *\<^sub>R y" 1] and xy(1,2)
3.3061 - unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
3.3062 - by(auto simp add:vector_component_simps forall_1 Cart_eq) qed qed
3.3063 -
3.3064 -lemmas join_paths_simps = path_join path_image_join pathstart_join pathfinish_join
3.3065 -
3.3066 -subsection {* Reparametrizing a closed curve to start at some chosen point. *}
3.3067 -
3.3068 -definition "shiftpath a (f::real^1 \<Rightarrow> real^'n) =
3.3069 - (\<lambda>x. if dest_vec1 (a + x) \<le> 1 then f(a + x) else f(a + x - 1))"
3.3070 -
3.3071 -lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart(shiftpath a g) = g a"
3.3072 - unfolding pathstart_def shiftpath_def by auto
3.3073 -
3.3074 -(** move this **)
3.3075 -declare forall_1[simp] ex_1[simp]
3.3076 -
3.3077 -lemma pathfinish_shiftpath: assumes "0 \<le> a" "pathfinish g = pathstart g"
3.3078 - shows "pathfinish(shiftpath a g) = g a"
3.3079 - using assms unfolding pathstart_def pathfinish_def shiftpath_def
3.3080 - by(auto simp add: vector_component_simps)
3.3081 -
3.3082 -lemma endpoints_shiftpath:
3.3083 - assumes "pathfinish g = pathstart g" "a \<in> {0 .. 1}"
3.3084 - shows "pathfinish(shiftpath a g) = g a" "pathstart(shiftpath a g) = g a"
3.3085 - using assms by(auto intro!:pathfinish_shiftpath pathstart_shiftpath)
3.3086 -
3.3087 -lemma closed_shiftpath:
3.3088 - assumes "pathfinish g = pathstart g" "a \<in> {0..1}"
3.3089 - shows "pathfinish(shiftpath a g) = pathstart(shiftpath a g)"
3.3090 - using endpoints_shiftpath[OF assms] by auto
3.3091 -
3.3092 -lemma path_shiftpath:
3.3093 - assumes "path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
3.3094 - shows "path(shiftpath a g)" proof-
3.3095 - have *:"{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}" using assms(3) by(auto simp add: vector_component_simps)
3.3096 - have **:"\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
3.3097 - using assms(2)[unfolded pathfinish_def pathstart_def] by auto
3.3098 - show ?thesis unfolding path_def shiftpath_def * apply(rule continuous_on_union)
3.3099 - apply(rule closed_interval)+ apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a + x)"]) prefer 3
3.3100 - apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a - 1 + x)"]) defer prefer 3
3.3101 - apply(rule continuous_on_intros)+ prefer 2 apply(rule continuous_on_intros)+
3.3102 - apply(rule_tac[1-2] continuous_on_subset[OF assms(1)[unfolded path_def]])
3.3103 - using assms(3) and ** by(auto simp add:vector_component_simps field_simps Cart_eq) qed
3.3104 -
3.3105 -lemma shiftpath_shiftpath: assumes "pathfinish g = pathstart g" "a \<in> {0..1}" "x \<in> {0..1}"
3.3106 - shows "shiftpath (1 - a) (shiftpath a g) x = g x"
3.3107 - using assms unfolding pathfinish_def pathstart_def shiftpath_def
3.3108 - by(auto simp add: vector_component_simps)
3.3109 -
3.3110 -lemma path_image_shiftpath:
3.3111 - assumes "a \<in> {0..1}" "pathfinish g = pathstart g"
3.3112 - shows "path_image(shiftpath a g) = path_image g" proof-
3.3113 - { fix x assume as:"g 1 = g 0" "x \<in> {0..1::real^1}" " \<forall>y\<in>{0..1} \<inter> {x. \<not> a $ 1 + x $ 1 \<le> 1}. g x \<noteq> g (a + y - 1)"
3.3114 - hence "\<exists>y\<in>{0..1} \<inter> {x. a $ 1 + x $ 1 \<le> 1}. g x = g (a + y)" proof(cases "a \<le> x")
3.3115 - case False thus ?thesis apply(rule_tac x="1 + x - a" in bexI)
3.3116 - using as(1,2) and as(3)[THEN bspec[where x="1 + x - a"]] and assms(1)
3.3117 - by(auto simp add:vector_component_simps field_simps atomize_not) next
3.3118 - case True thus ?thesis using as(1-2) and assms(1) apply(rule_tac x="x - a" in bexI)
3.3119 - by(auto simp add:vector_component_simps field_simps) qed }
3.3120 - thus ?thesis using assms unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
3.3121 - by(auto simp add:vector_component_simps image_iff) qed
3.3122 -
3.3123 -subsection {* Special case of straight-line paths. *}
3.3124 -
3.3125 -definition
3.3126 - linepath :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 1 \<Rightarrow> real ^ 'n" where
3.3127 - "linepath a b = (\<lambda>x. (1 - dest_vec1 x) *\<^sub>R a + dest_vec1 x *\<^sub>R b)"
3.3128 -
3.3129 -lemma pathstart_linepath[simp]: "pathstart(linepath a b) = a"
3.3130 - unfolding pathstart_def linepath_def by auto
3.3131 -
3.3132 -lemma pathfinish_linepath[simp]: "pathfinish(linepath a b) = b"
3.3133 - unfolding pathfinish_def linepath_def by auto
3.3134 -
3.3135 -lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
3.3136 - unfolding linepath_def
3.3137 - by (intro continuous_intros continuous_dest_vec1)
3.3138 -
3.3139 -lemma continuous_on_linepath[intro]: "continuous_on s (linepath a b)"
3.3140 - using continuous_linepath_at by(auto intro!: continuous_at_imp_continuous_on)
3.3141 -
3.3142 -lemma path_linepath[intro]: "path(linepath a b)"
3.3143 - unfolding path_def by(rule continuous_on_linepath)
3.3144 -
3.3145 -lemma path_image_linepath[simp]: "path_image(linepath a b) = (closed_segment a b)"
3.3146 - unfolding path_image_def segment linepath_def apply (rule set_ext, rule) defer
3.3147 - unfolding mem_Collect_eq image_iff apply(erule exE) apply(rule_tac x="u *\<^sub>R 1" in bexI)
3.3148 - by(auto simp add:vector_component_simps)
3.3149 -
3.3150 -lemma reversepath_linepath[simp]: "reversepath(linepath a b) = linepath b a"
3.3151 - unfolding reversepath_def linepath_def by(rule ext, auto simp add:vector_component_simps)
3.3152 -
3.3153 -lemma injective_path_linepath: assumes "a \<noteq> b" shows "injective_path(linepath a b)" proof-
3.3154 - { obtain i where i:"a$i \<noteq> b$i" using assms[unfolded Cart_eq] by auto
3.3155 - fix x y::"real^1" assume "x $ 1 *\<^sub>R b + y $ 1 *\<^sub>R a = x $ 1 *\<^sub>R a + y $ 1 *\<^sub>R b"
3.3156 - hence "x$1 * (b$i - a$i) = y$1 * (b$i - a$i)" unfolding Cart_eq by(auto simp add:field_simps vector_component_simps)
3.3157 - hence "x = y" unfolding mult_cancel_right Cart_eq using i(1) by(auto simp add:field_simps) }
3.3158 - thus ?thesis unfolding injective_path_def linepath_def by(auto simp add:vector_component_simps algebra_simps) qed
3.3159 -
3.3160 -lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path(linepath a b)" by(auto intro!: injective_imp_simple_path injective_path_linepath)
3.3161 -
3.3162 -subsection {* Bounding a point away from a path. *}
3.3163 -
3.3164 -lemma not_on_path_ball: assumes "path g" "z \<notin> path_image g"
3.3165 - shows "\<exists>e>0. ball z e \<inter> (path_image g) = {}" proof-
3.3166 - obtain a where "a\<in>path_image g" "\<forall>y\<in>path_image g. dist z a \<le> dist z y"
3.3167 - using distance_attains_inf[OF _ path_image_nonempty, of g z]
3.3168 - using compact_path_image[THEN compact_imp_closed, OF assms(1)] by auto
3.3169 - thus ?thesis apply(rule_tac x="dist z a" in exI) using assms(2) by(auto intro!: dist_pos_lt) qed
3.3170 -
3.3171 -lemma not_on_path_cball: assumes "path g" "z \<notin> path_image g"
3.3172 - shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}" proof-
3.3173 - obtain e where "ball z e \<inter> path_image g = {}" "e>0" using not_on_path_ball[OF assms] by auto
3.3174 - moreover have "cball z (e/2) \<subseteq> ball z e" using `e>0` by auto
3.3175 - ultimately show ?thesis apply(rule_tac x="e/2" in exI) by auto qed
3.3176 -
3.3177 -subsection {* Path component, considered as a "joinability" relation (from Tom Hales). *}
3.3178 -
3.3179 -definition "path_component s x y \<longleftrightarrow> (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y)"
3.3180 -
3.3181 -lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
3.3182 -
3.3183 -lemma path_component_mem: assumes "path_component s x y" shows "x \<in> s" "y \<in> s"
3.3184 - using assms unfolding path_defs by auto
3.3185 -
3.3186 -lemma path_component_refl: assumes "x \<in> s" shows "path_component s x x"
3.3187 - unfolding path_defs apply(rule_tac x="\<lambda>u. x" in exI) using assms
3.3188 - by(auto intro!:continuous_on_intros)
3.3189 -
3.3190 -lemma path_component_refl_eq: "path_component s x x \<longleftrightarrow> x \<in> s"
3.3191 - by(auto intro!: path_component_mem path_component_refl)
3.3192 -
3.3193 -lemma path_component_sym: "path_component s x y \<Longrightarrow> path_component s y x"
3.3194 - using assms unfolding path_component_def apply(erule exE) apply(rule_tac x="reversepath g" in exI)
3.3195 - by(auto simp add: reversepath_simps)
3.3196 -
3.3197 -lemma path_component_trans: assumes "path_component s x y" "path_component s y z" shows "path_component s x z"
3.3198 - using assms unfolding path_component_def apply- apply(erule exE)+ apply(rule_tac x="g +++ ga" in exI) by(auto simp add: path_image_join)
3.3199 -
3.3200 -lemma path_component_of_subset: "s \<subseteq> t \<Longrightarrow> path_component s x y \<Longrightarrow> path_component t x y"
3.3201 - unfolding path_component_def by auto
3.3202 -
3.3203 -subsection {* Can also consider it as a set, as the name suggests. *}
3.3204 -
3.3205 -lemma path_component_set: "path_component s x = { y. (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y )}"
3.3206 - apply(rule set_ext) unfolding mem_Collect_eq unfolding mem_def path_component_def by auto
3.3207 -
3.3208 -lemma mem_path_component_set:"x \<in> path_component s y \<longleftrightarrow> path_component s y x" unfolding mem_def by auto
3.3209 -
3.3210 -lemma path_component_subset: "(path_component s x) \<subseteq> s"
3.3211 - apply(rule, rule path_component_mem(2)) by(auto simp add:mem_def)
3.3212 -
3.3213 -lemma path_component_eq_empty: "path_component s x = {} \<longleftrightarrow> x \<notin> s"
3.3214 - apply rule apply(drule equals0D[of _ x]) defer apply(rule equals0I) unfolding mem_path_component_set
3.3215 - apply(drule path_component_mem(1)) using path_component_refl by auto
3.3216 -
3.3217 -subsection {* Path connectedness of a space. *}
3.3218 -
3.3219 -definition "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)"
3.3220 -
3.3221 -lemma path_connected_component: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. path_component s x y)"
3.3222 - unfolding path_connected_def path_component_def by auto
3.3223 -
3.3224 -lemma path_connected_component_set: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. path_component s x = s)"
3.3225 - unfolding path_connected_component apply(rule, rule, rule, rule path_component_subset)
3.3226 - unfolding subset_eq mem_path_component_set Ball_def mem_def by auto
3.3227 -
3.3228 -subsection {* Some useful lemmas about path-connectedness. *}
3.3229 -
3.3230 -lemma convex_imp_path_connected: assumes "convex s" shows "path_connected s"
3.3231 - unfolding path_connected_def apply(rule,rule,rule_tac x="linepath x y" in exI)
3.3232 - unfolding path_image_linepath using assms[unfolded convex_contains_segment] by auto
3.3233 -
3.3234 -lemma path_connected_imp_connected: assumes "path_connected s" shows "connected s"
3.3235 - unfolding connected_def not_ex apply(rule,rule,rule ccontr) unfolding not_not apply(erule conjE)+ proof-
3.3236 - 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> {}"
3.3237 - then obtain x1 x2 where obt:"x1\<in>e1\<inter>s" "x2\<in>e2\<inter>s" by auto
3.3238 - then obtain g where g:"path g" "path_image g \<subseteq> s" "pathstart g = x1" "pathfinish g = x2"
3.3239 - using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
3.3240 - have *:"connected {0..1::real^1}" by(auto intro!: convex_connected convex_interval)
3.3241 - 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
3.3242 - 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
3.3243 - 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(auto intro!: exI)
3.3244 - ultimately show False using *[unfolded connected_local not_ex,rule_format, of "{x\<in>{0..1}. g x \<in> e1}" "{x\<in>{0..1}. g x \<in> e2}"]
3.3245 - using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(1)]
3.3246 - using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(2)] by auto qed
3.3247 -
3.3248 -lemma open_path_component: assumes "open s" shows "open(path_component s x)"
3.3249 - unfolding open_contains_ball proof
3.3250 - fix y assume as:"y \<in> path_component s x"
3.3251 - hence "y\<in>s" apply- apply(rule path_component_mem(2)) unfolding mem_def by auto
3.3252 - then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
3.3253 - show "\<exists>e>0. ball y e \<subseteq> path_component s x" apply(rule_tac x=e in exI) apply(rule,rule `e>0`,rule) unfolding mem_ball mem_path_component_set proof-
3.3254 - fix z assume "dist y z < e" thus "path_component s x z" apply(rule_tac path_component_trans[of _ _ y]) defer
3.3255 - apply(rule path_component_of_subset[OF e(2)]) apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) using `e>0`
3.3256 - using as[unfolded mem_def] by auto qed qed
3.3257 -
3.3258 -lemma open_non_path_component: assumes "open s" shows "open(s - path_component s x)" unfolding open_contains_ball proof
3.3259 - fix y assume as:"y\<in>s - path_component s x"
3.3260 - then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
3.3261 - show "\<exists>e>0. ball y e \<subseteq> s - path_component s x" apply(rule_tac x=e in exI) apply(rule,rule `e>0`,rule,rule) defer proof(rule ccontr)
3.3262 - fix z assume "z\<in>ball y e" "\<not> z \<notin> path_component s x"
3.3263 - hence "y \<in> path_component s x" unfolding not_not mem_path_component_set using `e>0`
3.3264 - apply- apply(rule path_component_trans,assumption) apply(rule path_component_of_subset[OF e(2)])
3.3265 - apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) by auto
3.3266 - thus False using as by auto qed(insert e(2), auto) qed
3.3267 -
3.3268 -lemma connected_open_path_connected: assumes "open s" "connected s" shows "path_connected s"
3.3269 - unfolding path_connected_component_set proof(rule,rule,rule path_component_subset, rule)
3.3270 - fix x y assume "x \<in> s" "y \<in> s" show "y \<in> path_component s x" proof(rule ccontr)
3.3271 - assume "y \<notin> path_component s x" moreover
3.3272 - have "path_component s x \<inter> s \<noteq> {}" using `x\<in>s` path_component_eq_empty path_component_subset[of s x] by auto
3.3273 - ultimately show False using `y\<in>s` open_non_path_component[OF assms(1)] open_path_component[OF assms(1)]
3.3274 - using assms(2)[unfolded connected_def not_ex, rule_format, of"path_component s x" "s - path_component s x"] by auto
3.3275 -qed qed
3.3276 -
3.3277 -lemma path_connected_continuous_image:
3.3278 - assumes "continuous_on s f" "path_connected s" shows "path_connected (f ` s)"
3.3279 - unfolding path_connected_def proof(rule,rule)
3.3280 - fix x' y' assume "x' \<in> f ` s" "y' \<in> f ` s"
3.3281 - then obtain x y where xy:"x\<in>s" "y\<in>s" "x' = f x" "y' = f y" by auto
3.3282 - guess g using assms(2)[unfolded path_connected_def,rule_format,OF xy(1,2)] ..
3.3283 - thus "\<exists>g. path g \<and> path_image g \<subseteq> f ` s \<and> pathstart g = x' \<and> pathfinish g = y'"
3.3284 - unfolding xy apply(rule_tac x="f \<circ> g" in exI) unfolding path_defs
3.3285 - using assms(1) by(auto intro!: continuous_on_compose continuous_on_subset[of _ _ "g ` {0..1}"]) qed
3.3286 -
3.3287 -lemma homeomorphic_path_connectedness:
3.3288 - "s homeomorphic t \<Longrightarrow> (path_connected s \<longleftrightarrow> path_connected t)"
3.3289 - unfolding homeomorphic_def homeomorphism_def apply(erule exE|erule conjE)+ apply rule
3.3290 - apply(drule_tac f=f in path_connected_continuous_image) prefer 3
3.3291 - apply(drule_tac f=g in path_connected_continuous_image) by auto
3.3292 -
3.3293 -lemma path_connected_empty: "path_connected {}"
3.3294 - unfolding path_connected_def by auto
3.3295 -
3.3296 -lemma path_connected_singleton: "path_connected {a}"
3.3297 - unfolding path_connected_def apply(rule,rule)
3.3298 - apply(rule_tac x="linepath a a" in exI) by(auto simp add:segment scaleR_left_diff_distrib)
3.3299 -
3.3300 -lemma path_connected_Un: assumes "path_connected s" "path_connected t" "s \<inter> t \<noteq> {}"
3.3301 - shows "path_connected (s \<union> t)" unfolding path_connected_component proof(rule,rule)
3.3302 - fix x y assume as:"x \<in> s \<union> t" "y \<in> s \<union> t"
3.3303 - from assms(3) obtain z where "z \<in> s \<inter> t" by auto
3.3304 - thus "path_component (s \<union> t) x y" using as using assms(1-2)[unfolded path_connected_component] apply-
3.3305 - apply(erule_tac[!] UnE)+ apply(rule_tac[2-3] path_component_trans[of _ _ z])
3.3306 - by(auto simp add:path_component_of_subset [OF Un_upper1] path_component_of_subset[OF Un_upper2]) qed
3.3307 -
3.3308 -subsection {* sphere is path-connected. *}
3.3309 -
3.3310 -lemma path_connected_punctured_universe:
3.3311 - assumes "2 \<le> CARD('n::finite)" shows "path_connected((UNIV::(real^'n::finite) set) - {a})" proof-
3.3312 - obtain \<psi> where \<psi>:"bij_betw \<psi> {1..CARD('n)} (UNIV::'n set)" using ex_bij_betw_nat_finite_1[OF finite_UNIV] by auto
3.3313 - let ?U = "UNIV::(real^'n) set" let ?u = "?U - {0}"
3.3314 - let ?basis = "\<lambda>k. basis (\<psi> k)"
3.3315 - let ?A = "\<lambda>k. {x::real^'n. \<exists>i\<in>{1..k}. inner (basis (\<psi> i)) x \<noteq> 0}"
3.3316 - have "\<forall>k\<in>{2..CARD('n)}. path_connected (?A k)" proof
3.3317 - have *:"\<And>k. ?A (Suc k) = {x. inner (?basis (Suc k)) x < 0} \<union> {x. inner (?basis (Suc k)) x > 0} \<union> ?A k" apply(rule set_ext,rule) defer
3.3318 - apply(erule UnE)+ unfolding mem_Collect_eq apply(rule_tac[1-2] x="Suc k" in bexI)
3.3319 - by(auto elim!: ballE simp add: not_less le_Suc_eq)
3.3320 - fix k assume "k \<in> {2..CARD('n)}" thus "path_connected (?A k)" proof(induct k)
3.3321 - case (Suc k) show ?case proof(cases "k = 1")
3.3322 - case False from Suc have d:"k \<in> {1..CARD('n)}" "Suc k \<in> {1..CARD('n)}" by auto
3.3323 - hence "\<psi> k \<noteq> \<psi> (Suc k)" using \<psi>[unfolded bij_betw_def inj_on_def, THEN conjunct1, THEN bspec[where x=k]] by auto
3.3324 - hence **:"?basis k + ?basis (Suc k) \<in> {x. 0 < inner (?basis (Suc k)) x} \<inter> (?A k)"
3.3325 - "?basis k - ?basis (Suc k) \<in> {x. 0 > inner (?basis (Suc k)) x} \<inter> ({x. 0 < inner (?basis (Suc k)) x} \<union> (?A k))" using d
3.3326 - by(auto simp add: inner_basis vector_component_simps intro!:bexI[where x=k])
3.3327 - show ?thesis unfolding * Un_assoc apply(rule path_connected_Un) defer apply(rule path_connected_Un)
3.3328 - prefer 5 apply(rule_tac[1-2] convex_imp_path_connected, rule convex_halfspace_lt, rule convex_halfspace_gt)
3.3329 - apply(rule Suc(1)) apply(rule_tac[2-3] ccontr) using d ** False by auto
3.3330 - next case True hence d:"1\<in>{1..CARD('n)}" "2\<in>{1..CARD('n)}" using Suc(2) by auto
3.3331 - have ***:"Suc 1 = 2" by auto
3.3332 - have **:"\<And>s t P Q. s \<union> t \<union> {x. P x \<or> Q x} = (s \<union> {x. P x}) \<union> (t \<union> {x. Q x})" by auto
3.3333 - have "\<psi> 2 \<noteq> \<psi> (Suc 0)" apply(rule ccontr) using \<psi>[unfolded bij_betw_def inj_on_def, THEN conjunct1, THEN bspec[where x=2]] using assms by auto
3.3334 - thus ?thesis unfolding * True unfolding ** neq_iff bex_disj_distrib apply -
3.3335 - apply(rule path_connected_Un, rule_tac[1-2] path_connected_Un) defer 3 apply(rule_tac[1-4] convex_imp_path_connected)
3.3336 - apply(rule_tac[5] x=" ?basis 1 + ?basis 2" in nequals0I)
3.3337 - apply(rule_tac[6] x="-?basis 1 + ?basis 2" in nequals0I)
3.3338 - apply(rule_tac[7] x="-?basis 1 - ?basis 2" in nequals0I)
3.3339 - using d unfolding *** by(auto intro!: convex_halfspace_gt convex_halfspace_lt, auto simp add:vector_component_simps inner_basis)
3.3340 - qed qed auto qed note lem = this
3.3341 -
3.3342 - have ***:"\<And>x::real^'n. (\<exists>i\<in>{1..CARD('n)}. inner (basis (\<psi> i)) x \<noteq> 0) \<longleftrightarrow> (\<exists>i. inner (basis i) x \<noteq> 0)"
3.3343 - apply rule apply(erule bexE) apply(rule_tac x="\<psi> i" in exI) defer apply(erule exE) proof-
3.3344 - fix x::"real^'n" and i assume as:"inner (basis i) x \<noteq> 0"
3.3345 - have "i\<in>\<psi> ` {1..CARD('n)}" using \<psi>[unfolded bij_betw_def, THEN conjunct2] by auto
3.3346 - then obtain j where "j\<in>{1..CARD('n)}" "\<psi> j = i" by auto
3.3347 - thus "\<exists>i\<in>{1..CARD('n)}. inner (basis (\<psi> i)) x \<noteq> 0" apply(rule_tac x=j in bexI) using as by auto qed auto
3.3348 - have *:"?U - {a} = (\<lambda>x. x + a) ` {x. x \<noteq> 0}" apply(rule set_ext) unfolding image_iff
3.3349 - apply rule apply(rule_tac x="x - a" in bexI) by auto
3.3350 - have **:"\<And>x::real^'n. x\<noteq>0 \<longleftrightarrow> (\<exists>i. inner (basis i) x \<noteq> 0)" unfolding Cart_eq by(auto simp add: inner_basis)
3.3351 - show ?thesis unfolding * apply(rule path_connected_continuous_image) apply(rule continuous_on_intros)+
3.3352 - unfolding ** apply(rule lem[THEN bspec[where x="CARD('n)"], unfolded ***]) using assms by auto qed
3.3353 -
3.3354 -lemma path_connected_sphere: assumes "2 \<le> CARD('n::finite)" shows "path_connected {x::real^'n::finite. norm(x - a) = r}" proof(cases "r\<le>0")
3.3355 - case True thus ?thesis proof(cases "r=0")
3.3356 - case False hence "{x::real^'n. norm(x - a) = r} = {}" using True by auto
3.3357 - thus ?thesis using path_connected_empty by auto
3.3358 - qed(auto intro!:path_connected_singleton) next
3.3359 - case False hence *:"{x::real^'n. norm(x - a) = r} = (\<lambda>x. a + r *\<^sub>R x) ` {x. norm x = 1}" unfolding not_le apply -apply(rule set_ext,rule)
3.3360 - unfolding image_iff apply(rule_tac x="(1/r) *\<^sub>R (x - a)" in bexI) unfolding mem_Collect_eq norm_scaleR by (auto simp add: scaleR_right_diff_distrib)
3.3361 - have **:"{x::real^'n. norm x = 1} = (\<lambda>x. (1/norm x) *\<^sub>R x) ` (UNIV - {0})" apply(rule set_ext,rule)
3.3362 - unfolding image_iff apply(rule_tac x=x in bexI) unfolding mem_Collect_eq by(auto split:split_if_asm)
3.3363 - have "continuous_on (UNIV - {0}) (\<lambda>x::real^'n. 1 / norm x)" unfolding o_def continuous_on_eq_continuous_within
3.3364 - apply(rule, rule continuous_at_within_inv[unfolded o_def inverse_eq_divide]) apply(rule continuous_at_within)
3.3365 - apply(rule continuous_at_norm[unfolded o_def]) by auto
3.3366 - thus ?thesis unfolding * ** using path_connected_punctured_universe[OF assms]
3.3367 - by(auto intro!: path_connected_continuous_image continuous_on_intros continuous_on_mul) qed
3.3368 -
3.3369 -lemma connected_sphere: "2 \<le> CARD('n) \<Longrightarrow> connected {x::real^'n::finite. norm(x - a) = r}"
3.3370 - using path_connected_sphere path_connected_imp_connected by auto
3.3371 -
3.3372 -(** In continuous_at_vec1_norm : Use \<And> instead of \<forall>. **)
3.3373 -
3.3374 -end
4.1 --- a/src/HOL/Library/Determinants.thy Fri Oct 23 14:33:07 2009 +0200
4.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
4.3 @@ -1,1087 +0,0 @@
4.4 -(* Title: Determinants
4.5 - Author: Amine Chaieb, University of Cambridge
4.6 -*)
4.7 -
4.8 -header {* Traces, Determinant of square matrices and some properties *}
4.9 -
4.10 -theory Determinants
4.11 -imports Euclidean_Space Permutations
4.12 -begin
4.13 -
4.14 -subsection{* First some facts about products*}
4.15 -lemma setprod_insert_eq: "finite A \<Longrightarrow> setprod f (insert a A) = (if a \<in> A then setprod f A else f a * setprod f A)"
4.16 -apply clarsimp
4.17 -by(subgoal_tac "insert a A = A", auto)
4.18 -
4.19 -lemma setprod_add_split:
4.20 - assumes mn: "(m::nat) <= n + 1"
4.21 - shows "setprod f {m.. n+p} = setprod f {m .. n} * setprod f {n+1..n+p}"
4.22 -proof-
4.23 - let ?A = "{m .. n+p}"
4.24 - let ?B = "{m .. n}"
4.25 - let ?C = "{n+1..n+p}"
4.26 - from mn have un: "?B \<union> ?C = ?A" by auto
4.27 - from mn have dj: "?B \<inter> ?C = {}" by auto
4.28 - have f: "finite ?B" "finite ?C" by simp_all
4.29 - from setprod_Un_disjoint[OF f dj, of f, unfolded un] show ?thesis .
4.30 -qed
4.31 -
4.32 -
4.33 -lemma setprod_offset: "setprod f {(m::nat) + p .. n + p} = setprod (\<lambda>i. f (i + p)) {m..n}"
4.34 -apply (rule setprod_reindex_cong[where f="op + p"])
4.35 -apply (auto simp add: image_iff Bex_def inj_on_def)
4.36 -apply arith
4.37 -apply (rule ext)
4.38 -apply (simp add: add_commute)
4.39 -done
4.40 -
4.41 -lemma setprod_singleton: "setprod f {x} = f x" by simp
4.42 -
4.43 -lemma setprod_singleton_nat_seg: "setprod f {n..n} = f (n::'a::order)" by simp
4.44 -
4.45 -lemma setprod_numseg: "setprod f {m..0} = (if m=0 then f 0 else 1)"
4.46 - "setprod f {m .. Suc n} = (if m \<le> Suc n then f (Suc n) * setprod f {m..n}
4.47 - else setprod f {m..n})"
4.48 - by (auto simp add: atLeastAtMostSuc_conv)
4.49 -
4.50 -lemma setprod_le: assumes fS: "finite S" and fg: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (g x :: 'a::ordered_idom)"
4.51 - shows "setprod f S \<le> setprod g S"
4.52 -using fS fg
4.53 -apply(induct S)
4.54 -apply simp
4.55 -apply auto
4.56 -apply (rule mult_mono)
4.57 -apply (auto intro: setprod_nonneg)
4.58 -done
4.59 -
4.60 - (* FIXME: In Finite_Set there is a useless further assumption *)
4.61 -lemma setprod_inversef: "finite A ==> setprod (inverse \<circ> f) A = (inverse (setprod f A) :: 'a:: {division_by_zero, field})"
4.62 - apply (erule finite_induct)
4.63 - apply (simp)
4.64 - apply simp
4.65 - done
4.66 -
4.67 -lemma setprod_le_1: assumes fS: "finite S" and f: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (1::'a::ordered_idom)"
4.68 - shows "setprod f S \<le> 1"
4.69 -using setprod_le[OF fS f] unfolding setprod_1 .
4.70 -
4.71 -subsection{* Trace *}
4.72 -
4.73 -definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a" where
4.74 - "trace A = setsum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
4.75 -
4.76 -lemma trace_0: "trace(mat 0) = 0"
4.77 - by (simp add: trace_def mat_def)
4.78 -
4.79 -lemma trace_I: "trace(mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
4.80 - by (simp add: trace_def mat_def)
4.81 -
4.82 -lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
4.83 - by (simp add: trace_def setsum_addf)
4.84 -
4.85 -lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
4.86 - by (simp add: trace_def setsum_subtractf)
4.87 -
4.88 -lemma trace_mul_sym:"trace ((A::'a::comm_semiring_1^'n^'n) ** B) = trace (B**A)"
4.89 - apply (simp add: trace_def matrix_matrix_mult_def)
4.90 - apply (subst setsum_commute)
4.91 - by (simp add: mult_commute)
4.92 -
4.93 -(* ------------------------------------------------------------------------- *)
4.94 -(* Definition of determinant. *)
4.95 -(* ------------------------------------------------------------------------- *)
4.96 -
4.97 -definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
4.98 - "det A = setsum (\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)) {p. p permutes (UNIV :: 'n set)}"
4.99 -
4.100 -(* ------------------------------------------------------------------------- *)
4.101 -(* A few general lemmas we need below. *)
4.102 -(* ------------------------------------------------------------------------- *)
4.103 -
4.104 -lemma setprod_permute:
4.105 - assumes p: "p permutes S"
4.106 - shows "setprod f S = setprod (f o p) S"
4.107 -proof-
4.108 - {assume "\<not> finite S" hence ?thesis by simp}
4.109 - moreover
4.110 - {assume fS: "finite S"
4.111 - then have ?thesis
4.112 - apply (simp add: setprod_def cong del:strong_setprod_cong)
4.113 - apply (rule ab_semigroup_mult.fold_image_permute)
4.114 - apply (auto simp add: p)
4.115 - apply unfold_locales
4.116 - done}
4.117 - ultimately show ?thesis by blast
4.118 -qed
4.119 -
4.120 -lemma setproduct_permute_nat_interval: "p permutes {m::nat .. n} ==> setprod f {m..n} = setprod (f o p) {m..n}"
4.121 - by (blast intro!: setprod_permute)
4.122 -
4.123 -(* ------------------------------------------------------------------------- *)
4.124 -(* Basic determinant properties. *)
4.125 -(* ------------------------------------------------------------------------- *)
4.126 -
4.127 -lemma det_transp: "det (transp A) = det (A::'a::comm_ring_1 ^'n^'n::finite)"
4.128 -proof-
4.129 - let ?di = "\<lambda>A i j. A$i$j"
4.130 - let ?U = "(UNIV :: 'n set)"
4.131 - have fU: "finite ?U" by simp
4.132 - {fix p assume p: "p \<in> {p. p permutes ?U}"
4.133 - from p have pU: "p permutes ?U" by blast
4.134 - have sth: "sign (inv p) = sign p"
4.135 - by (metis sign_inverse fU p mem_def Collect_def permutation_permutes)
4.136 - from permutes_inj[OF pU]
4.137 - have pi: "inj_on p ?U" by (blast intro: subset_inj_on)
4.138 - from permutes_image[OF pU]
4.139 - have "setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U = setprod (\<lambda>i. ?di (transp A) i (inv p i)) (p ` ?U)" by simp
4.140 - also have "\<dots> = setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U"
4.141 - unfolding setprod_reindex[OF pi] ..
4.142 - also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
4.143 - proof-
4.144 - {fix i assume i: "i \<in> ?U"
4.145 - from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
4.146 - have "((\<lambda>i. ?di (transp A) i (inv p i)) o p) i = ?di A i (p i)"
4.147 - unfolding transp_def by (simp add: expand_fun_eq)}
4.148 - then show "setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U = setprod (\<lambda>i. ?di A i (p i)) ?U" by (auto intro: setprod_cong)
4.149 - qed
4.150 - finally have "of_int (sign (inv p)) * (setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U) = of_int (sign p) * (setprod (\<lambda>i. ?di A i (p i)) ?U)" using sth
4.151 - by simp}
4.152 - then show ?thesis unfolding det_def apply (subst setsum_permutations_inverse)
4.153 - apply (rule setsum_cong2) by blast
4.154 -qed
4.155 -
4.156 -lemma det_lowerdiagonal:
4.157 - fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
4.158 - assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
4.159 - shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
4.160 -proof-
4.161 - let ?U = "UNIV:: 'n set"
4.162 - let ?PU = "{p. p permutes ?U}"
4.163 - let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
4.164 - have fU: "finite ?U" by simp
4.165 - from finite_permutations[OF fU] have fPU: "finite ?PU" .
4.166 - have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
4.167 - {fix p assume p: "p \<in> ?PU -{id}"
4.168 - from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
4.169 - from permutes_natset_le[OF pU] pid obtain i where
4.170 - i: "p i > i" by (metis not_le)
4.171 - from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
4.172 - from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
4.173 - then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
4.174 - from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
4.175 - unfolding det_def by (simp add: sign_id)
4.176 -qed
4.177 -
4.178 -lemma det_upperdiagonal:
4.179 - fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
4.180 - assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
4.181 - shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
4.182 -proof-
4.183 - let ?U = "UNIV:: 'n set"
4.184 - let ?PU = "{p. p permutes ?U}"
4.185 - let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
4.186 - have fU: "finite ?U" by simp
4.187 - from finite_permutations[OF fU] have fPU: "finite ?PU" .
4.188 - have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
4.189 - {fix p assume p: "p \<in> ?PU -{id}"
4.190 - from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
4.191 - from permutes_natset_ge[OF pU] pid obtain i where
4.192 - i: "p i < i" by (metis not_le)
4.193 - from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
4.194 - from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
4.195 - then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
4.196 - from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
4.197 - unfolding det_def by (simp add: sign_id)
4.198 -qed
4.199 -
4.200 -lemma det_diagonal:
4.201 - fixes A :: "'a::comm_ring_1^'n^'n::finite"
4.202 - assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
4.203 - shows "det A = setprod (\<lambda>i. A$i$i) (UNIV::'n set)"
4.204 -proof-
4.205 - let ?U = "UNIV:: 'n set"
4.206 - let ?PU = "{p. p permutes ?U}"
4.207 - let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
4.208 - have fU: "finite ?U" by simp
4.209 - from finite_permutations[OF fU] have fPU: "finite ?PU" .
4.210 - have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
4.211 - {fix p assume p: "p \<in> ?PU - {id}"
4.212 - then have "p \<noteq> id" by simp
4.213 - then obtain i where i: "p i \<noteq> i" unfolding expand_fun_eq by auto
4.214 - from ld [OF i [symmetric]] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
4.215 - from setprod_zero [OF fU ex] have "?pp p = 0" by simp}
4.216 - then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0" by blast
4.217 - from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
4.218 - unfolding det_def by (simp add: sign_id)
4.219 -qed
4.220 -
4.221 -lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n::finite) = 1"
4.222 -proof-
4.223 - let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
4.224 - let ?U = "UNIV :: 'n set"
4.225 - let ?f = "\<lambda>i j. ?A$i$j"
4.226 - {fix i assume i: "i \<in> ?U"
4.227 - have "?f i i = 1" using i by (vector mat_def)}
4.228 - hence th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
4.229 - by (auto intro: setprod_cong)
4.230 - {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i \<noteq> j"
4.231 - have "?f i j = 0" using i j ij by (vector mat_def) }
4.232 - then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_diagonal
4.233 - by blast
4.234 - also have "\<dots> = 1" unfolding th setprod_1 ..
4.235 - finally show ?thesis .
4.236 -qed
4.237 -
4.238 -lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n::finite) = 0"
4.239 - by (simp add: det_def setprod_zero)
4.240 -
4.241 -lemma det_permute_rows:
4.242 - fixes A :: "'a::comm_ring_1^'n^'n::finite"
4.243 - assumes p: "p permutes (UNIV :: 'n::finite set)"
4.244 - shows "det(\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
4.245 - apply (simp add: det_def setsum_right_distrib mult_assoc[symmetric])
4.246 - apply (subst sum_permutations_compose_right[OF p])
4.247 -proof(rule setsum_cong2)
4.248 - let ?U = "UNIV :: 'n set"
4.249 - let ?PU = "{p. p permutes ?U}"
4.250 - fix q assume qPU: "q \<in> ?PU"
4.251 - have fU: "finite ?U" by simp
4.252 - from qPU have q: "q permutes ?U" by blast
4.253 - from p q have pp: "permutation p" and qp: "permutation q"
4.254 - by (metis fU permutation_permutes)+
4.255 - from permutes_inv[OF p] have ip: "inv p permutes ?U" .
4.256 - have "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod ((\<lambda>i. A$p i$(q o p) i) o inv p) ?U"
4.257 - by (simp only: setprod_permute[OF ip, symmetric])
4.258 - also have "\<dots> = setprod (\<lambda>i. A $ (p o inv p) i $ (q o (p o inv p)) i) ?U"
4.259 - by (simp only: o_def)
4.260 - also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U" by (simp only: o_def permutes_inverses[OF p])
4.261 - finally have thp: "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
4.262 - by blast
4.263 - show "of_int (sign (q o p)) * setprod (\<lambda>i. A$ p i$ (q o p) i) ?U = of_int (sign p) * of_int (sign q) * setprod (\<lambda>i. A$i$q i) ?U"
4.264 - by (simp only: thp sign_compose[OF qp pp] mult_commute of_int_mult)
4.265 -qed
4.266 -
4.267 -lemma det_permute_columns:
4.268 - fixes A :: "'a::comm_ring_1^'n^'n::finite"
4.269 - assumes p: "p permutes (UNIV :: 'n set)"
4.270 - shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
4.271 -proof-
4.272 - let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
4.273 - let ?At = "transp A"
4.274 - have "of_int (sign p) * det A = det (transp (\<chi> i. transp A $ p i))"
4.275 - unfolding det_permute_rows[OF p, of ?At] det_transp ..
4.276 - moreover
4.277 - have "?Ap = transp (\<chi> i. transp A $ p i)"
4.278 - by (simp add: transp_def Cart_eq)
4.279 - ultimately show ?thesis by simp
4.280 -qed
4.281 -
4.282 -lemma det_identical_rows:
4.283 - fixes A :: "'a::ordered_idom^'n^'n::finite"
4.284 - assumes ij: "i \<noteq> j"
4.285 - and r: "row i A = row j A"
4.286 - shows "det A = 0"
4.287 -proof-
4.288 - have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
4.289 - by simp
4.290 - have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
4.291 - let ?p = "Fun.swap i j id"
4.292 - let ?A = "\<chi> i. A $ ?p i"
4.293 - from r have "A = ?A" by (simp add: Cart_eq row_def swap_def)
4.294 - hence "det A = det ?A" by simp
4.295 - moreover have "det A = - det ?A"
4.296 - by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
4.297 - ultimately show "det A = 0" by (metis tha)
4.298 -qed
4.299 -
4.300 -lemma det_identical_columns:
4.301 - fixes A :: "'a::ordered_idom^'n^'n::finite"
4.302 - assumes ij: "i \<noteq> j"
4.303 - and r: "column i A = column j A"
4.304 - shows "det A = 0"
4.305 -apply (subst det_transp[symmetric])
4.306 -apply (rule det_identical_rows[OF ij])
4.307 -by (metis row_transp r)
4.308 -
4.309 -lemma det_zero_row:
4.310 - fixes A :: "'a::{idom, ring_char_0}^'n^'n::finite"
4.311 - assumes r: "row i A = 0"
4.312 - shows "det A = 0"
4.313 -using r
4.314 -apply (simp add: row_def det_def Cart_eq)
4.315 -apply (rule setsum_0')
4.316 -apply (auto simp: sign_nz)
4.317 -done
4.318 -
4.319 -lemma det_zero_column:
4.320 - fixes A :: "'a::{idom,ring_char_0}^'n^'n::finite"
4.321 - assumes r: "column i A = 0"
4.322 - shows "det A = 0"
4.323 - apply (subst det_transp[symmetric])
4.324 - apply (rule det_zero_row [of i])
4.325 - by (metis row_transp r)
4.326 -
4.327 -lemma det_row_add:
4.328 - fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
4.329 - shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
4.330 - det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
4.331 - det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
4.332 -unfolding det_def Cart_lambda_beta setsum_addf[symmetric]
4.333 -proof (rule setsum_cong2)
4.334 - let ?U = "UNIV :: 'n set"
4.335 - let ?pU = "{p. p permutes ?U}"
4.336 - let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
4.337 - let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
4.338 - let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
4.339 - fix p assume p: "p \<in> ?pU"
4.340 - let ?Uk = "?U - {k}"
4.341 - from p have pU: "p permutes ?U" by blast
4.342 - have kU: "?U = insert k ?Uk" by blast
4.343 - {fix j assume j: "j \<in> ?Uk"
4.344 - from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
4.345 - by simp_all}
4.346 - then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
4.347 - and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
4.348 - apply -
4.349 - apply (rule setprod_cong, simp_all)+
4.350 - done
4.351 - have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
4.352 - have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
4.353 - unfolding kU[symmetric] ..
4.354 - also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
4.355 - apply (rule setprod_insert)
4.356 - apply simp
4.357 - by blast
4.358 - also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk)" by (simp add: ring_simps)
4.359 - also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?h i $ p i) ?Uk)" by (metis th1 th2)
4.360 - also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
4.361 - unfolding setprod_insert[OF th3] by simp
4.362 - finally have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?g i $ p i) ?U + setprod (\<lambda>i. ?h i $ p i) ?U" unfolding kU[symmetric] .
4.363 - then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * setprod (\<lambda>i. ?h i $ p i) ?U"
4.364 - by (simp add: ring_simps)
4.365 -qed
4.366 -
4.367 -lemma det_row_mul:
4.368 - fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
4.369 - shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
4.370 - c* det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
4.371 -
4.372 -unfolding det_def Cart_lambda_beta setsum_right_distrib
4.373 -proof (rule setsum_cong2)
4.374 - let ?U = "UNIV :: 'n set"
4.375 - let ?pU = "{p. p permutes ?U}"
4.376 - let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
4.377 - let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
4.378 - fix p assume p: "p \<in> ?pU"
4.379 - let ?Uk = "?U - {k}"
4.380 - from p have pU: "p permutes ?U" by blast
4.381 - have kU: "?U = insert k ?Uk" by blast
4.382 - {fix j assume j: "j \<in> ?Uk"
4.383 - from j have "?f j $ p j = ?g j $ p j" by simp}
4.384 - then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
4.385 - apply -
4.386 - apply (rule setprod_cong, simp_all)
4.387 - done
4.388 - have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
4.389 - have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
4.390 - unfolding kU[symmetric] ..
4.391 - also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
4.392 - apply (rule setprod_insert)
4.393 - apply simp
4.394 - by blast
4.395 - also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk" by (simp add: ring_simps)
4.396 - also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
4.397 - unfolding th1 by (simp add: mult_ac)
4.398 - also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
4.399 - unfolding setprod_insert[OF th3] by simp
4.400 - finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)" unfolding kU[symmetric] .
4.401 - then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U)"
4.402 - by (simp add: ring_simps)
4.403 -qed
4.404 -
4.405 -lemma det_row_0:
4.406 - fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
4.407 - shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
4.408 -using det_row_mul[of k 0 "\<lambda>i. 1" b]
4.409 -apply (simp)
4.410 - unfolding vector_smult_lzero .
4.411 -
4.412 -lemma det_row_operation:
4.413 - fixes A :: "'a::ordered_idom^'n^'n::finite"
4.414 - assumes ij: "i \<noteq> j"
4.415 - shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
4.416 -proof-
4.417 - let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
4.418 - have th: "row i ?Z = row j ?Z" by (vector row_def)
4.419 - have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
4.420 - by (vector row_def)
4.421 - show ?thesis
4.422 - unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
4.423 - by simp
4.424 -qed
4.425 -
4.426 -lemma det_row_span:
4.427 - fixes A :: "'a:: ordered_idom^'n^'n::finite"
4.428 - assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
4.429 - shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
4.430 -proof-
4.431 - let ?U = "UNIV :: 'n set"
4.432 - let ?S = "{row j A |j. j \<noteq> i}"
4.433 - let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
4.434 - let ?P = "\<lambda>x. ?d (row i A + x) = det A"
4.435 - {fix k
4.436 -
4.437 - have "(if k = i then row i A + 0 else row k A) = row k A" by simp}
4.438 - then have P0: "?P 0"
4.439 - apply -
4.440 - apply (rule cong[of det, OF refl])
4.441 - by (vector row_def)
4.442 - moreover
4.443 - {fix c z y assume zS: "z \<in> ?S" and Py: "?P y"
4.444 - from zS obtain j where j: "z = row j A" "i \<noteq> j" by blast
4.445 - let ?w = "row i A + y"
4.446 - have th0: "row i A + (c*s z + y) = ?w + c*s z" by vector
4.447 - have thz: "?d z = 0"
4.448 - apply (rule det_identical_rows[OF j(2)])
4.449 - using j by (vector row_def)
4.450 - have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)" unfolding th0 ..
4.451 - then have "?P (c*s z + y)" unfolding thz Py det_row_mul[of i] det_row_add[of i]
4.452 - by simp }
4.453 -
4.454 - ultimately show ?thesis
4.455 - apply -
4.456 - apply (rule span_induct_alt[of ?P ?S, OF P0])
4.457 - apply blast
4.458 - apply (rule x)
4.459 - done
4.460 -qed
4.461 -
4.462 -(* ------------------------------------------------------------------------- *)
4.463 -(* May as well do this, though it's a bit unsatisfactory since it ignores *)
4.464 -(* exact duplicates by considering the rows/columns as a set. *)
4.465 -(* ------------------------------------------------------------------------- *)
4.466 -
4.467 -lemma det_dependent_rows:
4.468 - fixes A:: "'a::ordered_idom^'n^'n::finite"
4.469 - assumes d: "dependent (rows A)"
4.470 - shows "det A = 0"
4.471 -proof-
4.472 - let ?U = "UNIV :: 'n set"
4.473 - from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
4.474 - unfolding dependent_def rows_def by blast
4.475 - {fix j k assume jk: "j \<noteq> k"
4.476 - and c: "row j A = row k A"
4.477 - from det_identical_rows[OF jk c] have ?thesis .}
4.478 - moreover
4.479 - {assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
4.480 - have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
4.481 - apply (rule span_neg)
4.482 - apply (rule set_rev_mp)
4.483 - apply (rule i)
4.484 - apply (rule span_mono)
4.485 - using H i by (auto simp add: rows_def)
4.486 - from det_row_span[OF th0]
4.487 - have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
4.488 - unfolding right_minus vector_smult_lzero ..
4.489 - with det_row_mul[of i "0::'a" "\<lambda>i. 1"]
4.490 - have "det A = 0" by simp}
4.491 - ultimately show ?thesis by blast
4.492 -qed
4.493 -
4.494 -lemma det_dependent_columns: assumes d: "dependent(columns (A::'a::ordered_idom^'n^'n::finite))" shows "det A = 0"
4.495 -by (metis d det_dependent_rows rows_transp det_transp)
4.496 -
4.497 -(* ------------------------------------------------------------------------- *)
4.498 -(* Multilinearity and the multiplication formula. *)
4.499 -(* ------------------------------------------------------------------------- *)
4.500 -
4.501 -lemma Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (Cart_lambda f::'a^'n) = (Cart_lambda g :: 'a^'n)"
4.502 - apply (rule iffD1[OF Cart_lambda_unique]) by vector
4.503 -
4.504 -lemma det_linear_row_setsum:
4.505 - assumes fS: "finite S"
4.506 - shows "det ((\<chi> i. if i = k then setsum (a i) S else c i)::'a::comm_ring_1^'n^'n::finite) = setsum (\<lambda>j. det ((\<chi> i. if i = k then a i j else c i)::'a^'n^'n)) S"
4.507 -proof(induct rule: finite_induct[OF fS])
4.508 - case 1 thus ?case apply simp unfolding setsum_empty det_row_0[of k] ..
4.509 -next
4.510 - case (2 x F)
4.511 - then show ?case by (simp add: det_row_add cong del: if_weak_cong)
4.512 -qed
4.513 -
4.514 -lemma finite_bounded_functions:
4.515 - assumes fS: "finite S"
4.516 - shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
4.517 -proof(induct k)
4.518 - case 0
4.519 - have th: "{f. \<forall>i. f i = i} = {id}" by (auto intro: ext)
4.520 - show ?case by (auto simp add: th)
4.521 -next
4.522 - case (Suc k)
4.523 - let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
4.524 - let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>{1..k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)})"
4.525 - have "?S = {f. (\<forall>i\<in>{1.. Suc k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1.. Suc k} \<longrightarrow> f i = i)}"
4.526 - apply (auto simp add: image_iff)
4.527 - apply (rule_tac x="x (Suc k)" in bexI)
4.528 - apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
4.529 - apply (auto intro: ext)
4.530 - done
4.531 - with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
4.532 - show ?case by metis
4.533 -qed
4.534 -
4.535 -
4.536 -lemma eq_id_iff[simp]: "(\<forall>x. f x = x) = (f = id)" by (auto intro: ext)
4.537 -
4.538 -lemma det_linear_rows_setsum_lemma:
4.539 - assumes fS: "finite S" and fT: "finite T"
4.540 - shows "det((\<chi> i. if i \<in> T then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n::finite) =
4.541 - setsum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
4.542 - {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
4.543 -using fT
4.544 -proof(induct T arbitrary: a c set: finite)
4.545 - case empty
4.546 - have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)" by vector
4.547 - from "empty.prems" show ?case unfolding th0 by simp
4.548 -next
4.549 - case (insert z T a c)
4.550 - let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
4.551 - let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
4.552 - let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
4.553 - let ?s = "\<lambda> k a c f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n)"
4.554 - let ?c = "\<lambda>i. if i = z then a i j else c i"
4.555 - have thif: "\<And>a b c d. (if a \<or> b then c else d) = (if a then c else if b then c else d)" by simp
4.556 - have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
4.557 - (if c then (if a then b else d) else (if a then b else e))" by simp
4.558 - from `z \<notin> T` have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False" by auto
4.559 - have "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
4.560 - det (\<chi> i. if i = z then setsum (a i) S
4.561 - else if i \<in> T then setsum (a i) S else c i)"
4.562 - unfolding insert_iff thif ..
4.563 - also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then setsum (a i) S
4.564 - else if i = z then a i j else c i))"
4.565 - unfolding det_linear_row_setsum[OF fS]
4.566 - apply (subst thif2)
4.567 - using nz by (simp cong del: if_weak_cong cong add: if_cong)
4.568 - finally have tha:
4.569 - "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
4.570 - (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
4.571 - else if i = z then a i j
4.572 - else c i))"
4.573 - unfolding insert.hyps unfolding setsum_cartesian_product by blast
4.574 - show ?case unfolding tha
4.575 - apply(rule setsum_eq_general_reverses[where h= "?h" and k= "?k"],
4.576 - blast intro: finite_cartesian_product fS finite,
4.577 - blast intro: finite_cartesian_product fS finite)
4.578 - using `z \<notin> T`
4.579 - apply (auto intro: ext)
4.580 - apply (rule cong[OF refl[of det]])
4.581 - by vector
4.582 -qed
4.583 -
4.584 -lemma det_linear_rows_setsum:
4.585 - assumes fS: "finite (S::'n::finite set)"
4.586 - shows "det (\<chi> i. setsum (a i) S) = setsum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n::finite)) {f. \<forall>i. f i \<in> S}"
4.587 -proof-
4.588 - have th0: "\<And>x y. ((\<chi> i. if i \<in> (UNIV:: 'n set) then x i else y i) :: 'a^'n^'n) = (\<chi> i. x i)" by vector
4.589 -
4.590 - from det_linear_rows_setsum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite] show ?thesis by simp
4.591 -qed
4.592 -
4.593 -lemma matrix_mul_setsum_alt:
4.594 - fixes A B :: "'a::comm_ring_1^'n^'n::finite"
4.595 - shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
4.596 - by (vector matrix_matrix_mult_def setsum_component)
4.597 -
4.598 -lemma det_rows_mul:
4.599 - "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n::finite) =
4.600 - setprod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
4.601 -proof (simp add: det_def setsum_right_distrib cong add: setprod_cong, rule setsum_cong2)
4.602 - let ?U = "UNIV :: 'n set"
4.603 - let ?PU = "{p. p permutes ?U}"
4.604 - fix p assume pU: "p \<in> ?PU"
4.605 - let ?s = "of_int (sign p)"
4.606 - from pU have p: "p permutes ?U" by blast
4.607 - have "setprod (\<lambda>i. c i * a i $ p i) ?U = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
4.608 - unfolding setprod_timesf ..
4.609 - then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
4.610 - setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))" by (simp add: ring_simps)
4.611 -qed
4.612 -
4.613 -lemma det_mul:
4.614 - fixes A B :: "'a::ordered_idom^'n^'n::finite"
4.615 - shows "det (A ** B) = det A * det B"
4.616 -proof-
4.617 - let ?U = "UNIV :: 'n set"
4.618 - let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
4.619 - let ?PU = "{p. p permutes ?U}"
4.620 - have fU: "finite ?U" by simp
4.621 - have fF: "finite ?F" by (rule finite)
4.622 - {fix p assume p: "p permutes ?U"
4.623 -
4.624 - have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
4.625 - using p[unfolded permutes_def] by simp}
4.626 - then have PUF: "?PU \<subseteq> ?F" by blast
4.627 - {fix f assume fPU: "f \<in> ?F - ?PU"
4.628 - have fUU: "f ` ?U \<subseteq> ?U" using fPU by auto
4.629 - from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U"
4.630 - "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)" unfolding permutes_def
4.631 - by auto
4.632 -
4.633 - let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
4.634 - let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
4.635 - {assume fni: "\<not> inj_on f ?U"
4.636 - then obtain i j where ij: "f i = f j" "i \<noteq> j"
4.637 - unfolding inj_on_def by blast
4.638 - from ij
4.639 - have rth: "row i ?B = row j ?B" by (vector row_def)
4.640 - from det_identical_rows[OF ij(2) rth]
4.641 - have "det (\<chi> i. A$i$f i *s B$f i) = 0"
4.642 - unfolding det_rows_mul by simp}
4.643 - moreover
4.644 - {assume fi: "inj_on f ?U"
4.645 - from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
4.646 - unfolding inj_on_def by metis
4.647 - note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
4.648 -
4.649 - {fix y
4.650 - from fs f have "\<exists>x. f x = y" by blast
4.651 - then obtain x where x: "f x = y" by blast
4.652 - {fix z assume z: "f z = y" from fith x z have "z = x" by metis}
4.653 - with x have "\<exists>!x. f x = y" by blast}
4.654 - with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
4.655 - ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
4.656 - hence zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0" by simp
4.657 - {fix p assume pU: "p \<in> ?PU"
4.658 - from pU have p: "p permutes ?U" by blast
4.659 - let ?s = "\<lambda>p. of_int (sign p)"
4.660 - let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
4.661 - (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
4.662 - have "(setsum (\<lambda>q. ?s q *
4.663 - (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
4.664 - (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
4.665 - (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
4.666 - unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
4.667 - proof(rule setsum_cong2)
4.668 - fix q assume qU: "q \<in> ?PU"
4.669 - hence q: "q permutes ?U" by blast
4.670 - from p q have pp: "permutation p" and pq: "permutation q"
4.671 - unfolding permutation_permutes by auto
4.672 - have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
4.673 - "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
4.674 - unfolding mult_assoc[symmetric] unfolding of_int_mult[symmetric]
4.675 - by (simp_all add: sign_idempotent)
4.676 - have ths: "?s q = ?s p * ?s (q o inv p)"
4.677 - using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
4.678 - by (simp add: th00 mult_ac sign_idempotent sign_compose)
4.679 - have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) o p) ?U"
4.680 - by (rule setprod_permute[OF p])
4.681 - have thp: "setprod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U = setprod (\<lambda>i. A$i$p i) ?U * setprod (\<lambda>i. B$i$ q (inv p i)) ?U"
4.682 - unfolding th001 setprod_timesf[symmetric] o_def permutes_inverses[OF p]
4.683 - apply (rule setprod_cong[OF refl])
4.684 - using permutes_in_image[OF q] by vector
4.685 - show "?s q * setprod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U = ?s p * (setprod (\<lambda>i. A$i$p i) ?U) * (?s (q o inv p) * setprod (\<lambda>i. B$i$(q o inv p) i) ?U)"
4.686 - using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
4.687 - by (simp add: sign_nz th00 ring_simps sign_idempotent sign_compose)
4.688 - qed
4.689 - }
4.690 - then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
4.691 - unfolding det_def setsum_product
4.692 - by (rule setsum_cong2)
4.693 - have "det (A**B) = setsum (\<lambda>f. det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
4.694 - unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU] by simp
4.695 - also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
4.696 - using setsum_mono_zero_cong_left[OF fF PUF zth, symmetric]
4.697 - unfolding det_rows_mul by auto
4.698 - finally show ?thesis unfolding th2 .
4.699 -qed
4.700 -
4.701 -(* ------------------------------------------------------------------------- *)
4.702 -(* Relation to invertibility. *)
4.703 -(* ------------------------------------------------------------------------- *)
4.704 -
4.705 -lemma invertible_left_inverse:
4.706 - fixes A :: "real^'n^'n::finite"
4.707 - shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
4.708 - by (metis invertible_def matrix_left_right_inverse)
4.709 -
4.710 -lemma invertible_righ_inverse:
4.711 - fixes A :: "real^'n^'n::finite"
4.712 - shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
4.713 - by (metis invertible_def matrix_left_right_inverse)
4.714 -
4.715 -lemma invertible_det_nz:
4.716 - fixes A::"real ^'n^'n::finite"
4.717 - shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
4.718 -proof-
4.719 - {assume "invertible A"
4.720 - then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
4.721 - unfolding invertible_righ_inverse by blast
4.722 - hence "det (A ** B) = det (mat 1 :: real ^'n^'n)" by simp
4.723 - hence "det A \<noteq> 0"
4.724 - apply (simp add: det_mul det_I) by algebra }
4.725 - moreover
4.726 - {assume H: "\<not> invertible A"
4.727 - let ?U = "UNIV :: 'n set"
4.728 - have fU: "finite ?U" by simp
4.729 - from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
4.730 - and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
4.731 - unfolding invertible_righ_inverse
4.732 - unfolding matrix_right_invertible_independent_rows by blast
4.733 - have stupid: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
4.734 - apply (drule_tac f="op + (- a)" in cong[OF refl])
4.735 - apply (simp only: ab_left_minus add_assoc[symmetric])
4.736 - apply simp
4.737 - done
4.738 - from c ci
4.739 - have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
4.740 - unfolding setsum_diff1'[OF fU iU] setsum_cmul
4.741 - apply -
4.742 - apply (rule vector_mul_lcancel_imp[OF ci])
4.743 - apply (auto simp add: vector_smult_assoc vector_smult_rneg field_simps)
4.744 - unfolding stupid ..
4.745 - have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
4.746 - unfolding thr0
4.747 - apply (rule span_setsum)
4.748 - apply simp
4.749 - apply (rule ballI)
4.750 - apply (rule span_mul)+
4.751 - apply (rule span_superset)
4.752 - apply auto
4.753 - done
4.754 - let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
4.755 - have thrb: "row i ?B = 0" using iU by (vector row_def)
4.756 - have "det A = 0"
4.757 - unfolding det_row_span[OF thr, symmetric] right_minus
4.758 - unfolding det_zero_row[OF thrb] ..}
4.759 - ultimately show ?thesis by blast
4.760 -qed
4.761 -
4.762 -(* ------------------------------------------------------------------------- *)
4.763 -(* Cramer's rule. *)
4.764 -(* ------------------------------------------------------------------------- *)
4.765 -
4.766 -lemma cramer_lemma_transp:
4.767 - fixes A:: "'a::ordered_idom^'n^'n::finite" and x :: "'a ^'n::finite"
4.768 - shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
4.769 - else row i A)::'a^'n^'n) = x$k * det A"
4.770 - (is "?lhs = ?rhs")
4.771 -proof-
4.772 - let ?U = "UNIV :: 'n set"
4.773 - let ?Uk = "?U - {k}"
4.774 - have U: "?U = insert k ?Uk" by blast
4.775 - have fUk: "finite ?Uk" by simp
4.776 - have kUk: "k \<notin> ?Uk" by simp
4.777 - have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
4.778 - by (vector ring_simps)
4.779 - have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f" by (auto intro: ext)
4.780 - have "(\<chi> i. row i A) = A" by (vector row_def)
4.781 - then have thd1: "det (\<chi> i. row i A) = det A" by simp
4.782 - have thd0: "det (\<chi> i. if i = k then row k A + (\<Sum>i \<in> ?Uk. x $ i *s row i A) else row i A) = det A"
4.783 - apply (rule det_row_span)
4.784 - apply (rule span_setsum[OF fUk])
4.785 - apply (rule ballI)
4.786 - apply (rule span_mul)
4.787 - apply (rule span_superset)
4.788 - apply auto
4.789 - done
4.790 - show "?lhs = x$k * det A"
4.791 - apply (subst U)
4.792 - unfolding setsum_insert[OF fUk kUk]
4.793 - apply (subst th00)
4.794 - unfolding add_assoc
4.795 - apply (subst det_row_add)
4.796 - unfolding thd0
4.797 - unfolding det_row_mul
4.798 - unfolding th001[of k "\<lambda>i. row i A"]
4.799 - unfolding thd1 by (simp add: ring_simps)
4.800 -qed
4.801 -
4.802 -lemma cramer_lemma:
4.803 - fixes A :: "'a::ordered_idom ^'n^'n::finite"
4.804 - shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a^'n^'n) = x$k * det A"
4.805 -proof-
4.806 - let ?U = "UNIV :: 'n set"
4.807 - have stupid: "\<And>c. setsum (\<lambda>i. c i *s row i (transp A)) ?U = setsum (\<lambda>i. c i *s column i A) ?U"
4.808 - by (auto simp add: row_transp intro: setsum_cong2)
4.809 - show ?thesis unfolding matrix_mult_vsum
4.810 - unfolding cramer_lemma_transp[of k x "transp A", unfolded det_transp, symmetric]
4.811 - unfolding stupid[of "\<lambda>i. x$i"]
4.812 - apply (subst det_transp[symmetric])
4.813 - apply (rule cong[OF refl[of det]]) by (vector transp_def column_def row_def)
4.814 -qed
4.815 -
4.816 -lemma cramer:
4.817 - fixes A ::"real^'n^'n::finite"
4.818 - assumes d0: "det A \<noteq> 0"
4.819 - shows "A *v x = b \<longleftrightarrow> x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
4.820 -proof-
4.821 - from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
4.822 - unfolding invertible_det_nz[symmetric] invertible_def by blast
4.823 - have "(A ** B) *v b = b" by (simp add: B matrix_vector_mul_lid)
4.824 - hence "A *v (B *v b) = b" by (simp add: matrix_vector_mul_assoc)
4.825 - then have xe: "\<exists>x. A*v x = b" by blast
4.826 - {fix x assume x: "A *v x = b"
4.827 - have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
4.828 - unfolding x[symmetric]
4.829 - using d0 by (simp add: Cart_eq cramer_lemma field_simps)}
4.830 - with xe show ?thesis by auto
4.831 -qed
4.832 -
4.833 -(* ------------------------------------------------------------------------- *)
4.834 -(* Orthogonality of a transformation and matrix. *)
4.835 -(* ------------------------------------------------------------------------- *)
4.836 -
4.837 -definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
4.838 -
4.839 -lemma orthogonal_transformation: "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^_). norm (f v) = norm v)"
4.840 - unfolding orthogonal_transformation_def
4.841 - apply auto
4.842 - apply (erule_tac x=v in allE)+
4.843 - apply (simp add: real_vector_norm_def)
4.844 - by (simp add: dot_norm linear_add[symmetric])
4.845 -
4.846 -definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1 \<and> Q ** transp Q = mat 1"
4.847 -
4.848 -lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n::finite) \<longleftrightarrow> transp Q ** Q = mat 1"
4.849 - by (metis matrix_left_right_inverse orthogonal_matrix_def)
4.850 -
4.851 -lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n::finite)"
4.852 - by (simp add: orthogonal_matrix_def transp_mat matrix_mul_lid)
4.853 -
4.854 -lemma orthogonal_matrix_mul:
4.855 - fixes A :: "real ^'n^'n::finite"
4.856 - assumes oA : "orthogonal_matrix A"
4.857 - and oB: "orthogonal_matrix B"
4.858 - shows "orthogonal_matrix(A ** B)"
4.859 - using oA oB
4.860 - unfolding orthogonal_matrix matrix_transp_mul
4.861 - apply (subst matrix_mul_assoc)
4.862 - apply (subst matrix_mul_assoc[symmetric])
4.863 - by (simp add: matrix_mul_rid)
4.864 -
4.865 -lemma orthogonal_transformation_matrix:
4.866 - fixes f:: "real^'n \<Rightarrow> real^'n::finite"
4.867 - shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
4.868 - (is "?lhs \<longleftrightarrow> ?rhs")
4.869 -proof-
4.870 - let ?mf = "matrix f"
4.871 - let ?ot = "orthogonal_transformation f"
4.872 - let ?U = "UNIV :: 'n set"
4.873 - have fU: "finite ?U" by simp
4.874 - let ?m1 = "mat 1 :: real ^'n^'n"
4.875 - {assume ot: ?ot
4.876 - from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
4.877 - unfolding orthogonal_transformation_def orthogonal_matrix by blast+
4.878 - {fix i j
4.879 - let ?A = "transp ?mf ** ?mf"
4.880 - have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
4.881 - "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
4.882 - by simp_all
4.883 - from fd[rule_format, of "basis i" "basis j", unfolded matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
4.884 - have "?A$i$j = ?m1 $ i $ j"
4.885 - by (simp add: dot_def matrix_matrix_mult_def columnvector_def rowvector_def basis_def th0 setsum_delta[OF fU] mat_def)}
4.886 - hence "orthogonal_matrix ?mf" unfolding orthogonal_matrix by vector
4.887 - with lf have ?rhs by blast}
4.888 - moreover
4.889 - {assume lf: "linear f" and om: "orthogonal_matrix ?mf"
4.890 - from lf om have ?lhs
4.891 - unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
4.892 - unfolding matrix_works[OF lf, symmetric]
4.893 - apply (subst dot_matrix_vector_mul)
4.894 - by (simp add: dot_matrix_product matrix_mul_lid)}
4.895 - ultimately show ?thesis by blast
4.896 -qed
4.897 -
4.898 -lemma det_orthogonal_matrix:
4.899 - fixes Q:: "'a::ordered_idom^'n^'n::finite"
4.900 - assumes oQ: "orthogonal_matrix Q"
4.901 - shows "det Q = 1 \<or> det Q = - 1"
4.902 -proof-
4.903 -
4.904 - have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
4.905 - proof-
4.906 - fix x:: 'a
4.907 - have th0: "x*x - 1 = (x - 1)*(x + 1)" by (simp add: ring_simps)
4.908 - have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
4.909 - apply (subst eq_iff_diff_eq_0) by simp
4.910 - have "x*x = 1 \<longleftrightarrow> x*x - 1 = 0" by simp
4.911 - also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1" unfolding th0 th1 by simp
4.912 - finally show "?ths x" ..
4.913 - qed
4.914 - from oQ have "Q ** transp Q = mat 1" by (metis orthogonal_matrix_def)
4.915 - hence "det (Q ** transp Q) = det (mat 1:: 'a^'n^'n)" by simp
4.916 - hence "det Q * det Q = 1" by (simp add: det_mul det_I det_transp)
4.917 - then show ?thesis unfolding th .
4.918 -qed
4.919 -
4.920 -(* ------------------------------------------------------------------------- *)
4.921 -(* Linearity of scaling, and hence isometry, that preserves origin. *)
4.922 -(* ------------------------------------------------------------------------- *)
4.923 -lemma scaling_linear:
4.924 - fixes f :: "real ^'n \<Rightarrow> real ^'n::finite"
4.925 - assumes f0: "f 0 = 0" and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
4.926 - shows "linear f"
4.927 -proof-
4.928 - {fix v w
4.929 - {fix x note fd[rule_format, of x 0, unfolded dist_norm f0 diff_0_right] }
4.930 - note th0 = this
4.931 - have "f v \<bullet> f w = c^2 * (v \<bullet> w)"
4.932 - unfolding dot_norm_neg dist_norm[symmetric]
4.933 - unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
4.934 - note fc = this
4.935 - show ?thesis unfolding linear_def vector_eq
4.936 - by (simp add: dot_lmult dot_ladd dot_rmult dot_radd fc ring_simps)
4.937 -qed
4.938 -
4.939 -lemma isometry_linear:
4.940 - "f (0:: real^'n) = (0:: real^'n::finite) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y
4.941 - \<Longrightarrow> linear f"
4.942 -by (rule scaling_linear[where c=1]) simp_all
4.943 -
4.944 -(* ------------------------------------------------------------------------- *)
4.945 -(* Hence another formulation of orthogonal transformation. *)
4.946 -(* ------------------------------------------------------------------------- *)
4.947 -
4.948 -lemma orthogonal_transformation_isometry:
4.949 - "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n::finite) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
4.950 - unfolding orthogonal_transformation
4.951 - apply (rule iffI)
4.952 - apply clarify
4.953 - apply (clarsimp simp add: linear_0 linear_sub[symmetric] dist_norm)
4.954 - apply (rule conjI)
4.955 - apply (rule isometry_linear)
4.956 - apply simp
4.957 - apply simp
4.958 - apply clarify
4.959 - apply (erule_tac x=v in allE)
4.960 - apply (erule_tac x=0 in allE)
4.961 - by (simp add: dist_norm)
4.962 -
4.963 -(* ------------------------------------------------------------------------- *)
4.964 -(* Can extend an isometry from unit sphere. *)
4.965 -(* ------------------------------------------------------------------------- *)
4.966 -
4.967 -lemma isometry_sphere_extend:
4.968 - fixes f:: "real ^'n \<Rightarrow> real ^'n::finite"
4.969 - assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
4.970 - and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
4.971 - shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
4.972 -proof-
4.973 - {fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
4.974 - assume H: "x = norm x *s x0" "y = norm y *s y0"
4.975 - "x' = norm x *s x0'" "y' = norm y *s y0'"
4.976 - "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
4.977 - "norm(x0' - y0') = norm(x0 - y0)"
4.978 -
4.979 - have "norm(x' - y') = norm(x - y)"
4.980 - apply (subst H(1))
4.981 - apply (subst H(2))
4.982 - apply (subst H(3))
4.983 - apply (subst H(4))
4.984 - using H(5-9)
4.985 - apply (simp add: norm_eq norm_eq_1)
4.986 - apply (simp add: dot_lsub dot_rsub dot_lmult dot_rmult)
4.987 - apply (simp add: ring_simps)
4.988 - by (simp only: right_distrib[symmetric])}
4.989 - note th0 = this
4.990 - let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
4.991 - {fix x:: "real ^'n" assume nx: "norm x = 1"
4.992 - have "?g x = f x" using nx by auto}
4.993 - hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
4.994 - have g0: "?g 0 = 0" by simp
4.995 - {fix x y :: "real ^'n"
4.996 - {assume "x = 0" "y = 0"
4.997 - then have "dist (?g x) (?g y) = dist x y" by simp }
4.998 - moreover
4.999 - {assume "x = 0" "y \<noteq> 0"
4.1000 - then have "dist (?g x) (?g y) = dist x y"
4.1001 - apply (simp add: dist_norm norm_mul)
4.1002 - apply (rule f1[rule_format])
4.1003 - by(simp add: norm_mul field_simps)}
4.1004 - moreover
4.1005 - {assume "x \<noteq> 0" "y = 0"
4.1006 - then have "dist (?g x) (?g y) = dist x y"
4.1007 - apply (simp add: dist_norm norm_mul)
4.1008 - apply (rule f1[rule_format])
4.1009 - by(simp add: norm_mul field_simps)}
4.1010 - moreover
4.1011 - {assume z: "x \<noteq> 0" "y \<noteq> 0"
4.1012 - have th00: "x = norm x *s (inverse (norm x) *s x)" "y = norm y *s (inverse (norm y) *s y)" "norm x *s f ((inverse (norm x) *s x)) = norm x *s f (inverse (norm x) *s x)"
4.1013 - "norm y *s f (inverse (norm y) *s y) = norm y *s f (inverse (norm y) *s y)"
4.1014 - "norm (inverse (norm x) *s x) = 1"
4.1015 - "norm (f (inverse (norm x) *s x)) = 1"
4.1016 - "norm (inverse (norm y) *s y) = 1"
4.1017 - "norm (f (inverse (norm y) *s y)) = 1"
4.1018 - "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
4.1019 - norm (inverse (norm x) *s x - inverse (norm y) *s y)"
4.1020 - using z
4.1021 - by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
4.1022 - from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
4.1023 - by (simp add: dist_norm)}
4.1024 - ultimately have "dist (?g x) (?g y) = dist x y" by blast}
4.1025 - note thd = this
4.1026 - show ?thesis
4.1027 - apply (rule exI[where x= ?g])
4.1028 - unfolding orthogonal_transformation_isometry
4.1029 - using g0 thfg thd by metis
4.1030 -qed
4.1031 -
4.1032 -(* ------------------------------------------------------------------------- *)
4.1033 -(* Rotation, reflection, rotoinversion. *)
4.1034 -(* ------------------------------------------------------------------------- *)
4.1035 -
4.1036 -definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
4.1037 -definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
4.1038 -
4.1039 -lemma orthogonal_rotation_or_rotoinversion:
4.1040 - fixes Q :: "'a::ordered_idom^'n^'n::finite"
4.1041 - shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
4.1042 - by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
4.1043 -(* ------------------------------------------------------------------------- *)
4.1044 -(* Explicit formulas for low dimensions. *)
4.1045 -(* ------------------------------------------------------------------------- *)
4.1046 -
4.1047 -lemma setprod_1: "setprod f {(1::nat)..1} = f 1" by simp
4.1048 -
4.1049 -lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
4.1050 - by (simp add: nat_number setprod_numseg mult_commute)
4.1051 -lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
4.1052 - by (simp add: nat_number setprod_numseg mult_commute)
4.1053 -
4.1054 -lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
4.1055 - by (simp add: det_def permutes_sing sign_id UNIV_1)
4.1056 -
4.1057 -lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
4.1058 -proof-
4.1059 - have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
4.1060 - show ?thesis
4.1061 - unfolding det_def UNIV_2
4.1062 - unfolding setsum_over_permutations_insert[OF f12]
4.1063 - unfolding permutes_sing
4.1064 - apply (simp add: sign_swap_id sign_id swap_id_eq)
4.1065 - by (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
4.1066 -qed
4.1067 -
4.1068 -lemma det_3: "det (A::'a::comm_ring_1^3^3) =
4.1069 - A$1$1 * A$2$2 * A$3$3 +
4.1070 - A$1$2 * A$2$3 * A$3$1 +
4.1071 - A$1$3 * A$2$1 * A$3$2 -
4.1072 - A$1$1 * A$2$3 * A$3$2 -
4.1073 - A$1$2 * A$2$1 * A$3$3 -
4.1074 - A$1$3 * A$2$2 * A$3$1"
4.1075 -proof-
4.1076 - have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}" by auto
4.1077 - have f23: "finite {3::3}" "2 \<notin> {3::3}" by auto
4.1078 -
4.1079 - show ?thesis
4.1080 - unfolding det_def UNIV_3
4.1081 - unfolding setsum_over_permutations_insert[OF f123]
4.1082 - unfolding setsum_over_permutations_insert[OF f23]
4.1083 -
4.1084 - unfolding permutes_sing
4.1085 - apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
4.1086 - apply (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
4.1087 - by (simp add: ring_simps)
4.1088 -qed
4.1089 -
4.1090 -end
5.1 --- a/src/HOL/Library/Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
5.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
5.3 @@ -1,5372 +0,0 @@
5.4 -(* Title: Library/Euclidean_Space
5.5 - Author: Amine Chaieb, University of Cambridge
5.6 -*)
5.7 -
5.8 -header {* (Real) Vectors in Euclidean space, and elementary linear algebra.*}
5.9 -
5.10 -theory Euclidean_Space
5.11 -imports
5.12 - Complex_Main "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
5.13 - Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
5.14 - Inner_Product
5.15 -uses "positivstellensatz.ML" ("normarith.ML")
5.16 -begin
5.17 -
5.18 -text{* Some common special cases.*}
5.19 -
5.20 -lemma forall_1: "(\<forall>i::1. P i) \<longleftrightarrow> P 1"
5.21 - by (metis num1_eq_iff)
5.22 -
5.23 -lemma exhaust_2:
5.24 - fixes x :: 2 shows "x = 1 \<or> x = 2"
5.25 -proof (induct x)
5.26 - case (of_int z)
5.27 - then have "0 <= z" and "z < 2" by simp_all
5.28 - then have "z = 0 | z = 1" by arith
5.29 - then show ?case by auto
5.30 -qed
5.31 -
5.32 -lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2"
5.33 - by (metis exhaust_2)
5.34 -
5.35 -lemma exhaust_3:
5.36 - fixes x :: 3 shows "x = 1 \<or> x = 2 \<or> x = 3"
5.37 -proof (induct x)
5.38 - case (of_int z)
5.39 - then have "0 <= z" and "z < 3" by simp_all
5.40 - then have "z = 0 \<or> z = 1 \<or> z = 2" by arith
5.41 - then show ?case by auto
5.42 -qed
5.43 -
5.44 -lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
5.45 - by (metis exhaust_3)
5.46 -
5.47 -lemma UNIV_1: "UNIV = {1::1}"
5.48 - by (auto simp add: num1_eq_iff)
5.49 -
5.50 -lemma UNIV_2: "UNIV = {1::2, 2::2}"
5.51 - using exhaust_2 by auto
5.52 -
5.53 -lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}"
5.54 - using exhaust_3 by auto
5.55 -
5.56 -lemma setsum_1: "setsum f (UNIV::1 set) = f 1"
5.57 - unfolding UNIV_1 by simp
5.58 -
5.59 -lemma setsum_2: "setsum f (UNIV::2 set) = f 1 + f 2"
5.60 - unfolding UNIV_2 by simp
5.61 -
5.62 -lemma setsum_3: "setsum f (UNIV::3 set) = f 1 + f 2 + f 3"
5.63 - unfolding UNIV_3 by (simp add: add_ac)
5.64 -
5.65 -subsection{* Basic componentwise operations on vectors. *}
5.66 -
5.67 -instantiation "^" :: (plus,type) plus
5.68 -begin
5.69 -definition vector_add_def : "op + \<equiv> (\<lambda> x y. (\<chi> i. (x$i) + (y$i)))"
5.70 -instance ..
5.71 -end
5.72 -
5.73 -instantiation "^" :: (times,type) times
5.74 -begin
5.75 - definition vector_mult_def : "op * \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
5.76 - instance ..
5.77 -end
5.78 -
5.79 -instantiation "^" :: (minus,type) minus begin
5.80 - definition vector_minus_def : "op - \<equiv> (\<lambda> x y. (\<chi> i. (x$i) - (y$i)))"
5.81 -instance ..
5.82 -end
5.83 -
5.84 -instantiation "^" :: (uminus,type) uminus begin
5.85 - definition vector_uminus_def : "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
5.86 -instance ..
5.87 -end
5.88 -instantiation "^" :: (zero,type) zero begin
5.89 - definition vector_zero_def : "0 \<equiv> (\<chi> i. 0)"
5.90 -instance ..
5.91 -end
5.92 -
5.93 -instantiation "^" :: (one,type) one begin
5.94 - definition vector_one_def : "1 \<equiv> (\<chi> i. 1)"
5.95 -instance ..
5.96 -end
5.97 -
5.98 -instantiation "^" :: (ord,type) ord
5.99 - begin
5.100 -definition vector_less_eq_def:
5.101 - "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)"
5.102 -definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)"
5.103 -
5.104 -instance by (intro_classes)
5.105 -end
5.106 -
5.107 -instantiation "^" :: (scaleR, type) scaleR
5.108 -begin
5.109 -definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
5.110 -instance ..
5.111 -end
5.112 -
5.113 -text{* Also the scalar-vector multiplication. *}
5.114 -
5.115 -definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
5.116 - where "c *s x = (\<chi> i. c * (x$i))"
5.117 -
5.118 -text{* Constant Vectors *}
5.119 -
5.120 -definition "vec x = (\<chi> i. x)"
5.121 -
5.122 -text{* Dot products. *}
5.123 -
5.124 -definition dot :: "'a::{comm_monoid_add, times} ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" (infix "\<bullet>" 70) where
5.125 - "x \<bullet> y = setsum (\<lambda>i. x$i * y$i) UNIV"
5.126 -
5.127 -lemma dot_1[simp]: "(x::'a::{comm_monoid_add, times}^1) \<bullet> y = (x$1) * (y$1)"
5.128 - by (simp add: dot_def setsum_1)
5.129 -
5.130 -lemma dot_2[simp]: "(x::'a::{comm_monoid_add, times}^2) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2)"
5.131 - by (simp add: dot_def setsum_2)
5.132 -
5.133 -lemma dot_3[simp]: "(x::'a::{comm_monoid_add, times}^3) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2) + (x$3) * (y$3)"
5.134 - by (simp add: dot_def setsum_3)
5.135 -
5.136 -subsection {* A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space. *}
5.137 -
5.138 -method_setup vector = {*
5.139 -let
5.140 - val ss1 = HOL_basic_ss addsimps [@{thm dot_def}, @{thm setsum_addf} RS sym,
5.141 - @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
5.142 - @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym]
5.143 - val ss2 = @{simpset} addsimps
5.144 - [@{thm vector_add_def}, @{thm vector_mult_def},
5.145 - @{thm vector_minus_def}, @{thm vector_uminus_def},
5.146 - @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def},
5.147 - @{thm vector_scaleR_def},
5.148 - @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}]
5.149 - fun vector_arith_tac ths =
5.150 - simp_tac ss1
5.151 - THEN' (fn i => rtac @{thm setsum_cong2} i
5.152 - ORELSE rtac @{thm setsum_0'} i
5.153 - ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i)
5.154 - (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
5.155 - THEN' asm_full_simp_tac (ss2 addsimps ths)
5.156 - in
5.157 - Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths)))
5.158 - end
5.159 -*} "Lifts trivial vector statements to real arith statements"
5.160 -
5.161 -lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def)
5.162 -lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def)
5.163 -
5.164 -
5.165 -
5.166 -text{* Obvious "component-pushing". *}
5.167 -
5.168 -lemma vec_component [simp]: "(vec x :: 'a ^ 'n)$i = x"
5.169 - by (vector vec_def)
5.170 -
5.171 -lemma vector_add_component [simp]:
5.172 - fixes x y :: "'a::{plus} ^ 'n"
5.173 - shows "(x + y)$i = x$i + y$i"
5.174 - by vector
5.175 -
5.176 -lemma vector_minus_component [simp]:
5.177 - fixes x y :: "'a::{minus} ^ 'n"
5.178 - shows "(x - y)$i = x$i - y$i"
5.179 - by vector
5.180 -
5.181 -lemma vector_mult_component [simp]:
5.182 - fixes x y :: "'a::{times} ^ 'n"
5.183 - shows "(x * y)$i = x$i * y$i"
5.184 - by vector
5.185 -
5.186 -lemma vector_smult_component [simp]:
5.187 - fixes y :: "'a::{times} ^ 'n"
5.188 - shows "(c *s y)$i = c * (y$i)"
5.189 - by vector
5.190 -
5.191 -lemma vector_uminus_component [simp]:
5.192 - fixes x :: "'a::{uminus} ^ 'n"
5.193 - shows "(- x)$i = - (x$i)"
5.194 - by vector
5.195 -
5.196 -lemma vector_scaleR_component [simp]:
5.197 - fixes x :: "'a::scaleR ^ 'n"
5.198 - shows "(scaleR r x)$i = scaleR r (x$i)"
5.199 - by vector
5.200 -
5.201 -lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
5.202 -
5.203 -lemmas vector_component =
5.204 - vec_component vector_add_component vector_mult_component
5.205 - vector_smult_component vector_minus_component vector_uminus_component
5.206 - vector_scaleR_component cond_component
5.207 -
5.208 -subsection {* Some frequently useful arithmetic lemmas over vectors. *}
5.209 -
5.210 -instance "^" :: (semigroup_add,type) semigroup_add
5.211 - apply (intro_classes) by (vector add_assoc)
5.212 -
5.213 -
5.214 -instance "^" :: (monoid_add,type) monoid_add
5.215 - apply (intro_classes) by vector+
5.216 -
5.217 -instance "^" :: (group_add,type) group_add
5.218 - apply (intro_classes) by (vector algebra_simps)+
5.219 -
5.220 -instance "^" :: (ab_semigroup_add,type) ab_semigroup_add
5.221 - apply (intro_classes) by (vector add_commute)
5.222 -
5.223 -instance "^" :: (comm_monoid_add,type) comm_monoid_add
5.224 - apply (intro_classes) by vector
5.225 -
5.226 -instance "^" :: (ab_group_add,type) ab_group_add
5.227 - apply (intro_classes) by vector+
5.228 -
5.229 -instance "^" :: (cancel_semigroup_add,type) cancel_semigroup_add
5.230 - apply (intro_classes)
5.231 - by (vector Cart_eq)+
5.232 -
5.233 -instance "^" :: (cancel_ab_semigroup_add,type) cancel_ab_semigroup_add
5.234 - apply (intro_classes)
5.235 - by (vector Cart_eq)
5.236 -
5.237 -instance "^" :: (real_vector, type) real_vector
5.238 - by default (vector scaleR_left_distrib scaleR_right_distrib)+
5.239 -
5.240 -instance "^" :: (semigroup_mult,type) semigroup_mult
5.241 - apply (intro_classes) by (vector mult_assoc)
5.242 -
5.243 -instance "^" :: (monoid_mult,type) monoid_mult
5.244 - apply (intro_classes) by vector+
5.245 -
5.246 -instance "^" :: (ab_semigroup_mult,type) ab_semigroup_mult
5.247 - apply (intro_classes) by (vector mult_commute)
5.248 -
5.249 -instance "^" :: (ab_semigroup_idem_mult,type) ab_semigroup_idem_mult
5.250 - apply (intro_classes) by (vector mult_idem)
5.251 -
5.252 -instance "^" :: (comm_monoid_mult,type) comm_monoid_mult
5.253 - apply (intro_classes) by vector
5.254 -
5.255 -fun vector_power :: "('a::{one,times} ^'n) \<Rightarrow> nat \<Rightarrow> 'a^'n" where
5.256 - "vector_power x 0 = 1"
5.257 - | "vector_power x (Suc n) = x * vector_power x n"
5.258 -
5.259 -instance "^" :: (semiring,type) semiring
5.260 - apply (intro_classes) by (vector ring_simps)+
5.261 -
5.262 -instance "^" :: (semiring_0,type) semiring_0
5.263 - apply (intro_classes) by (vector ring_simps)+
5.264 -instance "^" :: (semiring_1,type) semiring_1
5.265 - apply (intro_classes) by vector
5.266 -instance "^" :: (comm_semiring,type) comm_semiring
5.267 - apply (intro_classes) by (vector ring_simps)+
5.268 -
5.269 -instance "^" :: (comm_semiring_0,type) comm_semiring_0 by (intro_classes)
5.270 -instance "^" :: (cancel_comm_monoid_add, type) cancel_comm_monoid_add ..
5.271 -instance "^" :: (semiring_0_cancel,type) semiring_0_cancel by (intro_classes)
5.272 -instance "^" :: (comm_semiring_0_cancel,type) comm_semiring_0_cancel by (intro_classes)
5.273 -instance "^" :: (ring,type) ring by (intro_classes)
5.274 -instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes)
5.275 -instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
5.276 -
5.277 -instance "^" :: (ring_1,type) ring_1 ..
5.278 -
5.279 -instance "^" :: (real_algebra,type) real_algebra
5.280 - apply intro_classes
5.281 - apply (simp_all add: vector_scaleR_def ring_simps)
5.282 - apply vector
5.283 - apply vector
5.284 - done
5.285 -
5.286 -instance "^" :: (real_algebra_1,type) real_algebra_1 ..
5.287 -
5.288 -lemma of_nat_index:
5.289 - "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
5.290 - apply (induct n)
5.291 - apply vector
5.292 - apply vector
5.293 - done
5.294 -lemma zero_index[simp]:
5.295 - "(0 :: 'a::zero ^'n)$i = 0" by vector
5.296 -
5.297 -lemma one_index[simp]:
5.298 - "(1 :: 'a::one ^'n)$i = 1" by vector
5.299 -
5.300 -lemma one_plus_of_nat_neq_0: "(1::'a::semiring_char_0) + of_nat n \<noteq> 0"
5.301 -proof-
5.302 - have "(1::'a) + of_nat n = 0 \<longleftrightarrow> of_nat 1 + of_nat n = (of_nat 0 :: 'a)" by simp
5.303 - also have "\<dots> \<longleftrightarrow> 1 + n = 0" by (simp only: of_nat_add[symmetric] of_nat_eq_iff)
5.304 - finally show ?thesis by simp
5.305 -qed
5.306 -
5.307 -instance "^" :: (semiring_char_0,type) semiring_char_0
5.308 -proof (intro_classes)
5.309 - fix m n ::nat
5.310 - show "(of_nat m :: 'a^'b) = of_nat n \<longleftrightarrow> m = n"
5.311 - by (simp add: Cart_eq of_nat_index)
5.312 -qed
5.313 -
5.314 -instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
5.315 -instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
5.316 -
5.317 -lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
5.318 - by (vector mult_assoc)
5.319 -lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
5.320 - by (vector ring_simps)
5.321 -lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
5.322 - by (vector ring_simps)
5.323 -lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
5.324 -lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
5.325 -lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
5.326 - by (vector ring_simps)
5.327 -lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
5.328 -lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
5.329 -lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
5.330 -lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
5.331 -lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
5.332 - by (vector ring_simps)
5.333 -
5.334 -lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
5.335 - by (simp add: Cart_eq)
5.336 -
5.337 -subsection {* Topological space *}
5.338 -
5.339 -instantiation "^" :: (topological_space, finite) topological_space
5.340 -begin
5.341 -
5.342 -definition open_vector_def:
5.343 - "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
5.344 - (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
5.345 - (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
5.346 -
5.347 -instance proof
5.348 - show "open (UNIV :: ('a ^ 'b) set)"
5.349 - unfolding open_vector_def by auto
5.350 -next
5.351 - fix S T :: "('a ^ 'b) set"
5.352 - assume "open S" "open T" thus "open (S \<inter> T)"
5.353 - unfolding open_vector_def
5.354 - apply clarify
5.355 - apply (drule (1) bspec)+
5.356 - apply (clarify, rename_tac Sa Ta)
5.357 - apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
5.358 - apply (simp add: open_Int)
5.359 - done
5.360 -next
5.361 - fix K :: "('a ^ 'b) set set"
5.362 - assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
5.363 - unfolding open_vector_def
5.364 - apply clarify
5.365 - apply (drule (1) bspec)
5.366 - apply (drule (1) bspec)
5.367 - apply clarify
5.368 - apply (rule_tac x=A in exI)
5.369 - apply fast
5.370 - done
5.371 -qed
5.372 -
5.373 -end
5.374 -
5.375 -lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
5.376 -unfolding open_vector_def by auto
5.377 -
5.378 -lemma open_vimage_Cart_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
5.379 -unfolding open_vector_def
5.380 -apply clarify
5.381 -apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
5.382 -done
5.383 -
5.384 -lemma closed_vimage_Cart_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
5.385 -unfolding closed_open vimage_Compl [symmetric]
5.386 -by (rule open_vimage_Cart_nth)
5.387 -
5.388 -lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
5.389 -proof -
5.390 - have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
5.391 - thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
5.392 - by (simp add: closed_INT closed_vimage_Cart_nth)
5.393 -qed
5.394 -
5.395 -lemma tendsto_Cart_nth [tendsto_intros]:
5.396 - assumes "((\<lambda>x. f x) ---> a) net"
5.397 - shows "((\<lambda>x. f x $ i) ---> a $ i) net"
5.398 -proof (rule topological_tendstoI)
5.399 - fix S assume "open S" "a $ i \<in> S"
5.400 - then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
5.401 - by (simp_all add: open_vimage_Cart_nth)
5.402 - with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
5.403 - by (rule topological_tendstoD)
5.404 - then show "eventually (\<lambda>x. f x $ i \<in> S) net"
5.405 - by simp
5.406 -qed
5.407 -
5.408 -subsection {* Square root of sum of squares *}
5.409 -
5.410 -definition
5.411 - "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
5.412 -
5.413 -lemma setL2_cong:
5.414 - "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
5.415 - unfolding setL2_def by simp
5.416 -
5.417 -lemma strong_setL2_cong:
5.418 - "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
5.419 - unfolding setL2_def simp_implies_def by simp
5.420 -
5.421 -lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
5.422 - unfolding setL2_def by simp
5.423 -
5.424 -lemma setL2_empty [simp]: "setL2 f {} = 0"
5.425 - unfolding setL2_def by simp
5.426 -
5.427 -lemma setL2_insert [simp]:
5.428 - "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
5.429 - setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
5.430 - unfolding setL2_def by (simp add: setsum_nonneg)
5.431 -
5.432 -lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
5.433 - unfolding setL2_def by (simp add: setsum_nonneg)
5.434 -
5.435 -lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
5.436 - unfolding setL2_def by simp
5.437 -
5.438 -lemma setL2_constant: "setL2 (\<lambda>x. y) A = sqrt (of_nat (card A)) * \<bar>y\<bar>"
5.439 - unfolding setL2_def by (simp add: real_sqrt_mult)
5.440 -
5.441 -lemma setL2_mono:
5.442 - assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
5.443 - assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
5.444 - shows "setL2 f K \<le> setL2 g K"
5.445 - unfolding setL2_def
5.446 - by (simp add: setsum_nonneg setsum_mono power_mono prems)
5.447 -
5.448 -lemma setL2_strict_mono:
5.449 - assumes "finite K" and "K \<noteq> {}"
5.450 - assumes "\<And>i. i \<in> K \<Longrightarrow> f i < g i"
5.451 - assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
5.452 - shows "setL2 f K < setL2 g K"
5.453 - unfolding setL2_def
5.454 - by (simp add: setsum_strict_mono power_strict_mono assms)
5.455 -
5.456 -lemma setL2_right_distrib:
5.457 - "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
5.458 - unfolding setL2_def
5.459 - apply (simp add: power_mult_distrib)
5.460 - apply (simp add: setsum_right_distrib [symmetric])
5.461 - apply (simp add: real_sqrt_mult setsum_nonneg)
5.462 - done
5.463 -
5.464 -lemma setL2_left_distrib:
5.465 - "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
5.466 - unfolding setL2_def
5.467 - apply (simp add: power_mult_distrib)
5.468 - apply (simp add: setsum_left_distrib [symmetric])
5.469 - apply (simp add: real_sqrt_mult setsum_nonneg)
5.470 - done
5.471 -
5.472 -lemma setsum_nonneg_eq_0_iff:
5.473 - fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
5.474 - shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
5.475 - apply (induct set: finite, simp)
5.476 - apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
5.477 - done
5.478 -
5.479 -lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
5.480 - unfolding setL2_def
5.481 - by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
5.482 -
5.483 -lemma setL2_triangle_ineq:
5.484 - shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
5.485 -proof (cases "finite A")
5.486 - case False
5.487 - thus ?thesis by simp
5.488 -next
5.489 - case True
5.490 - thus ?thesis
5.491 - proof (induct set: finite)
5.492 - case empty
5.493 - show ?case by simp
5.494 - next
5.495 - case (insert x F)
5.496 - hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
5.497 - sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
5.498 - by (intro real_sqrt_le_mono add_left_mono power_mono insert
5.499 - setL2_nonneg add_increasing zero_le_power2)
5.500 - also have
5.501 - "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
5.502 - by (rule real_sqrt_sum_squares_triangle_ineq)
5.503 - finally show ?case
5.504 - using insert by simp
5.505 - qed
5.506 -qed
5.507 -
5.508 -lemma sqrt_sum_squares_le_sum:
5.509 - "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
5.510 - apply (rule power2_le_imp_le)
5.511 - apply (simp add: power2_sum)
5.512 - apply (simp add: mult_nonneg_nonneg)
5.513 - apply (simp add: add_nonneg_nonneg)
5.514 - done
5.515 -
5.516 -lemma setL2_le_setsum [rule_format]:
5.517 - "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
5.518 - apply (cases "finite A")
5.519 - apply (induct set: finite)
5.520 - apply simp
5.521 - apply clarsimp
5.522 - apply (erule order_trans [OF sqrt_sum_squares_le_sum])
5.523 - apply simp
5.524 - apply simp
5.525 - apply simp
5.526 - done
5.527 -
5.528 -lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
5.529 - apply (rule power2_le_imp_le)
5.530 - apply (simp add: power2_sum)
5.531 - apply (simp add: mult_nonneg_nonneg)
5.532 - apply (simp add: add_nonneg_nonneg)
5.533 - done
5.534 -
5.535 -lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
5.536 - apply (cases "finite A")
5.537 - apply (induct set: finite)
5.538 - apply simp
5.539 - apply simp
5.540 - apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
5.541 - apply simp
5.542 - apply simp
5.543 - done
5.544 -
5.545 -lemma setL2_mult_ineq_lemma:
5.546 - fixes a b c d :: real
5.547 - shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
5.548 -proof -
5.549 - have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
5.550 - also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
5.551 - by (simp only: power2_diff power_mult_distrib)
5.552 - also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
5.553 - by simp
5.554 - finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
5.555 - by simp
5.556 -qed
5.557 -
5.558 -lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
5.559 - apply (cases "finite A")
5.560 - apply (induct set: finite)
5.561 - apply simp
5.562 - apply (rule power2_le_imp_le, simp)
5.563 - apply (rule order_trans)
5.564 - apply (rule power_mono)
5.565 - apply (erule add_left_mono)
5.566 - apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
5.567 - apply (simp add: power2_sum)
5.568 - apply (simp add: power_mult_distrib)
5.569 - apply (simp add: right_distrib left_distrib)
5.570 - apply (rule ord_le_eq_trans)
5.571 - apply (rule setL2_mult_ineq_lemma)
5.572 - apply simp
5.573 - apply (intro mult_nonneg_nonneg setL2_nonneg)
5.574 - apply simp
5.575 - done
5.576 -
5.577 -lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
5.578 - apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
5.579 - apply fast
5.580 - apply (subst setL2_insert)
5.581 - apply simp
5.582 - apply simp
5.583 - apply simp
5.584 - done
5.585 -
5.586 -subsection {* Metric *}
5.587 -
5.588 -(* TODO: move somewhere else *)
5.589 -lemma finite_choice: "finite A \<Longrightarrow> \<forall>x\<in>A. \<exists>y. P x y \<Longrightarrow> \<exists>f. \<forall>x\<in>A. P x (f x)"
5.590 -apply (induct set: finite, simp_all)
5.591 -apply (clarify, rename_tac y)
5.592 -apply (rule_tac x="f(x:=y)" in exI, simp)
5.593 -done
5.594 -
5.595 -instantiation "^" :: (metric_space, finite) metric_space
5.596 -begin
5.597 -
5.598 -definition dist_vector_def:
5.599 - "dist (x::'a^'b) (y::'a^'b) = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV"
5.600 -
5.601 -lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
5.602 -unfolding dist_vector_def
5.603 -by (rule member_le_setL2) simp_all
5.604 -
5.605 -instance proof
5.606 - fix x y :: "'a ^ 'b"
5.607 - show "dist x y = 0 \<longleftrightarrow> x = y"
5.608 - unfolding dist_vector_def
5.609 - by (simp add: setL2_eq_0_iff Cart_eq)
5.610 -next
5.611 - fix x y z :: "'a ^ 'b"
5.612 - show "dist x y \<le> dist x z + dist y z"
5.613 - unfolding dist_vector_def
5.614 - apply (rule order_trans [OF _ setL2_triangle_ineq])
5.615 - apply (simp add: setL2_mono dist_triangle2)
5.616 - done
5.617 -next
5.618 - (* FIXME: long proof! *)
5.619 - fix S :: "('a ^ 'b) set"
5.620 - show "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
5.621 - unfolding open_vector_def open_dist
5.622 - apply safe
5.623 - apply (drule (1) bspec)
5.624 - apply clarify
5.625 - apply (subgoal_tac "\<exists>e>0. \<forall>i y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
5.626 - apply clarify
5.627 - apply (rule_tac x=e in exI, clarify)
5.628 - apply (drule spec, erule mp, clarify)
5.629 - apply (drule spec, drule spec, erule mp)
5.630 - apply (erule le_less_trans [OF dist_nth_le])
5.631 - apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
5.632 - apply (drule finite_choice [OF finite], clarify)
5.633 - apply (rule_tac x="Min (range f)" in exI, simp)
5.634 - apply clarify
5.635 - apply (drule_tac x=i in spec, clarify)
5.636 - apply (erule (1) bspec)
5.637 - apply (drule (1) bspec, clarify)
5.638 - apply (subgoal_tac "\<exists>r. (\<forall>i::'b. 0 < r i) \<and> e = setL2 r UNIV")
5.639 - apply clarify
5.640 - apply (rule_tac x="\<lambda>i. {y. dist y (x$i) < r i}" in exI)
5.641 - apply (rule conjI)
5.642 - apply clarify
5.643 - apply (rule conjI)
5.644 - apply (clarify, rename_tac y)
5.645 - apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp)
5.646 - apply clarify
5.647 - apply (simp only: less_diff_eq)
5.648 - apply (erule le_less_trans [OF dist_triangle])
5.649 - apply simp
5.650 - apply clarify
5.651 - apply (drule spec, erule mp)
5.652 - apply (simp add: dist_vector_def setL2_strict_mono)
5.653 - apply (rule_tac x="\<lambda>i. e / sqrt (of_nat CARD('b))" in exI)
5.654 - apply (simp add: divide_pos_pos setL2_constant)
5.655 - done
5.656 -qed
5.657 -
5.658 -end
5.659 -
5.660 -lemma LIMSEQ_Cart_nth:
5.661 - "(X ----> a) \<Longrightarrow> (\<lambda>n. X n $ i) ----> a $ i"
5.662 -unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth)
5.663 -
5.664 -lemma LIM_Cart_nth:
5.665 - "(f -- x --> y) \<Longrightarrow> (\<lambda>x. f x $ i) -- x --> y $ i"
5.666 -unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth)
5.667 -
5.668 -lemma Cauchy_Cart_nth:
5.669 - "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
5.670 -unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le])
5.671 -
5.672 -lemma LIMSEQ_vector:
5.673 - fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
5.674 - assumes X: "\<And>i. (\<lambda>n. X n $ i) ----> (a $ i)"
5.675 - shows "X ----> a"
5.676 -proof (rule metric_LIMSEQ_I)
5.677 - fix r :: real assume "0 < r"
5.678 - then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
5.679 - by (simp add: divide_pos_pos)
5.680 - def N \<equiv> "\<lambda>i. LEAST N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
5.681 - def M \<equiv> "Max (range N)"
5.682 - have "\<And>i. \<exists>N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
5.683 - using X `0 < ?s` by (rule metric_LIMSEQ_D)
5.684 - hence "\<And>i. \<forall>n\<ge>N i. dist (X n $ i) (a $ i) < ?s"
5.685 - unfolding N_def by (rule LeastI_ex)
5.686 - hence M: "\<And>i. \<forall>n\<ge>M. dist (X n $ i) (a $ i) < ?s"
5.687 - unfolding M_def by simp
5.688 - {
5.689 - fix n :: nat assume "M \<le> n"
5.690 - have "dist (X n) a = setL2 (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
5.691 - unfolding dist_vector_def ..
5.692 - also have "\<dots> \<le> setsum (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
5.693 - by (rule setL2_le_setsum [OF zero_le_dist])
5.694 - also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
5.695 - by (rule setsum_strict_mono, simp_all add: M `M \<le> n`)
5.696 - also have "\<dots> = r"
5.697 - by simp
5.698 - finally have "dist (X n) a < r" .
5.699 - }
5.700 - hence "\<forall>n\<ge>M. dist (X n) a < r"
5.701 - by simp
5.702 - then show "\<exists>M. \<forall>n\<ge>M. dist (X n) a < r" ..
5.703 -qed
5.704 -
5.705 -lemma Cauchy_vector:
5.706 - fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
5.707 - assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
5.708 - shows "Cauchy (\<lambda>n. X n)"
5.709 -proof (rule metric_CauchyI)
5.710 - fix r :: real assume "0 < r"
5.711 - then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
5.712 - by (simp add: divide_pos_pos)
5.713 - def N \<equiv> "\<lambda>i. LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
5.714 - def M \<equiv> "Max (range N)"
5.715 - have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
5.716 - using X `0 < ?s` by (rule metric_CauchyD)
5.717 - hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
5.718 - unfolding N_def by (rule LeastI_ex)
5.719 - hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
5.720 - unfolding M_def by simp
5.721 - {
5.722 - fix m n :: nat
5.723 - assume "M \<le> m" "M \<le> n"
5.724 - have "dist (X m) (X n) = setL2 (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
5.725 - unfolding dist_vector_def ..
5.726 - also have "\<dots> \<le> setsum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
5.727 - by (rule setL2_le_setsum [OF zero_le_dist])
5.728 - also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
5.729 - by (rule setsum_strict_mono, simp_all add: M `M \<le> m` `M \<le> n`)
5.730 - also have "\<dots> = r"
5.731 - by simp
5.732 - finally have "dist (X m) (X n) < r" .
5.733 - }
5.734 - hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
5.735 - by simp
5.736 - then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
5.737 -qed
5.738 -
5.739 -instance "^" :: (complete_space, finite) complete_space
5.740 -proof
5.741 - fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
5.742 - have "\<And>i. (\<lambda>n. X n $ i) ----> lim (\<lambda>n. X n $ i)"
5.743 - using Cauchy_Cart_nth [OF `Cauchy X`]
5.744 - by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
5.745 - hence "X ----> Cart_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
5.746 - by (simp add: LIMSEQ_vector)
5.747 - then show "convergent X"
5.748 - by (rule convergentI)
5.749 -qed
5.750 -
5.751 -subsection {* Norms *}
5.752 -
5.753 -instantiation "^" :: (real_normed_vector, finite) real_normed_vector
5.754 -begin
5.755 -
5.756 -definition norm_vector_def:
5.757 - "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) UNIV"
5.758 -
5.759 -definition vector_sgn_def:
5.760 - "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
5.761 -
5.762 -instance proof
5.763 - fix a :: real and x y :: "'a ^ 'b"
5.764 - show "0 \<le> norm x"
5.765 - unfolding norm_vector_def
5.766 - by (rule setL2_nonneg)
5.767 - show "norm x = 0 \<longleftrightarrow> x = 0"
5.768 - unfolding norm_vector_def
5.769 - by (simp add: setL2_eq_0_iff Cart_eq)
5.770 - show "norm (x + y) \<le> norm x + norm y"
5.771 - unfolding norm_vector_def
5.772 - apply (rule order_trans [OF _ setL2_triangle_ineq])
5.773 - apply (simp add: setL2_mono norm_triangle_ineq)
5.774 - done
5.775 - show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
5.776 - unfolding norm_vector_def
5.777 - by (simp add: setL2_right_distrib)
5.778 - show "sgn x = scaleR (inverse (norm x)) x"
5.779 - by (rule vector_sgn_def)
5.780 - show "dist x y = norm (x - y)"
5.781 - unfolding dist_vector_def norm_vector_def
5.782 - by (simp add: dist_norm)
5.783 -qed
5.784 -
5.785 -end
5.786 -
5.787 -lemma norm_nth_le: "norm (x $ i) \<le> norm x"
5.788 -unfolding norm_vector_def
5.789 -by (rule member_le_setL2) simp_all
5.790 -
5.791 -interpretation Cart_nth: bounded_linear "\<lambda>x. x $ i"
5.792 -apply default
5.793 -apply (rule vector_add_component)
5.794 -apply (rule vector_scaleR_component)
5.795 -apply (rule_tac x="1" in exI, simp add: norm_nth_le)
5.796 -done
5.797 -
5.798 -instance "^" :: (banach, finite) banach ..
5.799 -
5.800 -subsection {* Inner products *}
5.801 -
5.802 -instantiation "^" :: (real_inner, finite) real_inner
5.803 -begin
5.804 -
5.805 -definition inner_vector_def:
5.806 - "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) UNIV"
5.807 -
5.808 -instance proof
5.809 - fix r :: real and x y z :: "'a ^ 'b"
5.810 - show "inner x y = inner y x"
5.811 - unfolding inner_vector_def
5.812 - by (simp add: inner_commute)
5.813 - show "inner (x + y) z = inner x z + inner y z"
5.814 - unfolding inner_vector_def
5.815 - by (simp add: inner_add_left setsum_addf)
5.816 - show "inner (scaleR r x) y = r * inner x y"
5.817 - unfolding inner_vector_def
5.818 - by (simp add: setsum_right_distrib)
5.819 - show "0 \<le> inner x x"
5.820 - unfolding inner_vector_def
5.821 - by (simp add: setsum_nonneg)
5.822 - show "inner x x = 0 \<longleftrightarrow> x = 0"
5.823 - unfolding inner_vector_def
5.824 - by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
5.825 - show "norm x = sqrt (inner x x)"
5.826 - unfolding inner_vector_def norm_vector_def setL2_def
5.827 - by (simp add: power2_norm_eq_inner)
5.828 -qed
5.829 -
5.830 -end
5.831 -
5.832 -subsection{* Properties of the dot product. *}
5.833 -
5.834 -lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x"
5.835 - by (vector mult_commute)
5.836 -lemma dot_ladd: "((x::'a::ring ^ 'n) + y) \<bullet> z = (x \<bullet> z) + (y \<bullet> z)"
5.837 - by (vector ring_simps)
5.838 -lemma dot_radd: "x \<bullet> (y + (z::'a::ring ^ 'n)) = (x \<bullet> y) + (x \<bullet> z)"
5.839 - by (vector ring_simps)
5.840 -lemma dot_lsub: "((x::'a::ring ^ 'n) - y) \<bullet> z = (x \<bullet> z) - (y \<bullet> z)"
5.841 - by (vector ring_simps)
5.842 -lemma dot_rsub: "(x::'a::ring ^ 'n) \<bullet> (y - z) = (x \<bullet> y) - (x \<bullet> z)"
5.843 - by (vector ring_simps)
5.844 -lemma dot_lmult: "(c *s x) \<bullet> y = (c::'a::ring) * (x \<bullet> y)" by (vector ring_simps)
5.845 -lemma dot_rmult: "x \<bullet> (c *s y) = (c::'a::comm_ring) * (x \<bullet> y)" by (vector ring_simps)
5.846 -lemma dot_lneg: "(-x) \<bullet> (y::'a::ring ^ 'n) = -(x \<bullet> y)" by vector
5.847 -lemma dot_rneg: "(x::'a::ring ^ 'n) \<bullet> (-y) = -(x \<bullet> y)" by vector
5.848 -lemma dot_lzero[simp]: "0 \<bullet> x = (0::'a::{comm_monoid_add, mult_zero})" by vector
5.849 -lemma dot_rzero[simp]: "x \<bullet> 0 = (0::'a::{comm_monoid_add, mult_zero})" by vector
5.850 -lemma dot_pos_le[simp]: "(0::'a\<Colon>ordered_ring_strict) <= x \<bullet> x"
5.851 - by (simp add: dot_def setsum_nonneg)
5.852 -
5.853 -lemma setsum_squares_eq_0_iff: assumes fS: "finite F" and fp: "\<forall>x \<in> F. f x \<ge> (0 ::'a::pordered_ab_group_add)" shows "setsum f F = 0 \<longleftrightarrow> (ALL x:F. f x = 0)"
5.854 -using fS fp setsum_nonneg[OF fp]
5.855 -proof (induct set: finite)
5.856 - case empty thus ?case by simp
5.857 -next
5.858 - case (insert x F)
5.859 - from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all
5.860 - from insert.hyps Fp setsum_nonneg[OF Fp]
5.861 - have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis
5.862 - from add_nonneg_eq_0_iff[OF Fx setsum_nonneg[OF Fp]] insert.hyps(1,2)
5.863 - show ?case by (simp add: h)
5.864 -qed
5.865 -
5.866 -lemma dot_eq_0: "x \<bullet> x = 0 \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) = 0"
5.867 - by (simp add: dot_def setsum_squares_eq_0_iff Cart_eq)
5.868 -
5.869 -lemma dot_pos_lt[simp]: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x]
5.870 - by (auto simp add: le_less)
5.871 -
5.872 -subsection{* The collapse of the general concepts to dimension one. *}
5.873 -
5.874 -lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
5.875 - by (simp add: Cart_eq forall_1)
5.876 -
5.877 -lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))"
5.878 - apply auto
5.879 - apply (erule_tac x= "x$1" in allE)
5.880 - apply (simp only: vector_one[symmetric])
5.881 - done
5.882 -
5.883 -lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
5.884 - by (simp add: norm_vector_def UNIV_1)
5.885 -
5.886 -lemma norm_real: "norm(x::real ^ 1) = abs(x$1)"
5.887 - by (simp add: norm_vector_1)
5.888 -
5.889 -lemma dist_real: "dist(x::real ^ 1) y = abs((x$1) - (y$1))"
5.890 - by (auto simp add: norm_real dist_norm)
5.891 -
5.892 -subsection {* A connectedness or intermediate value lemma with several applications. *}
5.893 -
5.894 -lemma connected_real_lemma:
5.895 - fixes f :: "real \<Rightarrow> 'a::metric_space"
5.896 - assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
5.897 - and dst: "\<And>e x. a <= x \<Longrightarrow> x <= b \<Longrightarrow> 0 < e ==> \<exists>d > 0. \<forall>y. abs(y - x) < d \<longrightarrow> dist(f y) (f x) < e"
5.898 - and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
5.899 - and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
5.900 - and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
5.901 - shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
5.902 -proof-
5.903 - let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
5.904 - have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
5.905 - have Sub: "\<exists>y. isUb UNIV ?S y"
5.906 - apply (rule exI[where x= b])
5.907 - using ab fb e12 by (auto simp add: isUb_def setle_def)
5.908 - from reals_complete[OF Se Sub] obtain l where
5.909 - l: "isLub UNIV ?S l"by blast
5.910 - have alb: "a \<le> l" "l \<le> b" using l ab fa fb e12
5.911 - apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
5.912 - by (metis linorder_linear)
5.913 - have ale1: "\<forall>z \<ge> a. z < l \<longrightarrow> f z \<in> e1" using l
5.914 - apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
5.915 - by (metis linorder_linear not_le)
5.916 - have th1: "\<And>z x e d :: real. z <= x + e \<Longrightarrow> e < d ==> z < x \<or> abs(z - x) < d" by arith
5.917 - have th2: "\<And>e x:: real. 0 < e ==> ~(x + e <= x)" by arith
5.918 - have th3: "\<And>d::real. d > 0 \<Longrightarrow> \<exists>e > 0. e < d" by dlo
5.919 - {assume le2: "f l \<in> e2"
5.920 - from le2 fa fb e12 alb have la: "l \<noteq> a" by metis
5.921 - hence lap: "l - a > 0" using alb by arith
5.922 - from e2[rule_format, OF le2] obtain e where
5.923 - e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e2" by metis
5.924 - from dst[OF alb e(1)] obtain d where
5.925 - d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
5.926 - have "\<exists>d'. d' < d \<and> d' >0 \<and> l - d' > a" using lap d(1)
5.927 - apply ferrack by arith
5.928 - then obtain d' where d': "d' > 0" "d' < d" "l - d' > a" by metis
5.929 - from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e2" by metis
5.930 - from th0[rule_format, of "l - d'"] d' have "f (l - d') \<in> e2" by auto
5.931 - moreover
5.932 - have "f (l - d') \<in> e1" using ale1[rule_format, of "l -d'"] d' by auto
5.933 - ultimately have False using e12 alb d' by auto}
5.934 - moreover
5.935 - {assume le1: "f l \<in> e1"
5.936 - from le1 fa fb e12 alb have lb: "l \<noteq> b" by metis
5.937 - hence blp: "b - l > 0" using alb by arith
5.938 - from e1[rule_format, OF le1] obtain e where
5.939 - e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e1" by metis
5.940 - from dst[OF alb e(1)] obtain d where
5.941 - d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
5.942 - have "\<exists>d'. d' < d \<and> d' >0" using d(1) by dlo
5.943 - then obtain d' where d': "d' > 0" "d' < d" by metis
5.944 - from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e1" by auto
5.945 - hence "\<forall>y. l \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" using d' by auto
5.946 - with ale1 have "\<forall>y. a \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" by auto
5.947 - with l d' have False
5.948 - by (auto simp add: isLub_def isUb_def setle_def setge_def leastP_def) }
5.949 - ultimately show ?thesis using alb by metis
5.950 -qed
5.951 -
5.952 -text{* One immediately useful corollary is the existence of square roots! --- Should help to get rid of all the development of square-root for reals as a special case @{typ "real^1"} *}
5.953 -
5.954 -lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)"
5.955 -proof-
5.956 - have "(x + 1/2)^2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith
5.957 - thus ?thesis by (simp add: ring_simps power2_eq_square)
5.958 -qed
5.959 -
5.960 -lemma square_continuous: "0 < (e::real) ==> \<exists>d. 0 < d \<and> (\<forall>y. abs(y - x) < d \<longrightarrow> abs(y * y - x * x) < e)"
5.961 - using isCont_power[OF isCont_ident, of 2, unfolded isCont_def LIM_eq, rule_format, of e x] apply (auto simp add: power2_eq_square)
5.962 - apply (rule_tac x="s" in exI)
5.963 - apply auto
5.964 - apply (erule_tac x=y in allE)
5.965 - apply auto
5.966 - done
5.967 -
5.968 -lemma real_le_lsqrt: "0 <= x \<Longrightarrow> 0 <= y \<Longrightarrow> x <= y^2 ==> sqrt x <= y"
5.969 - using real_sqrt_le_iff[of x "y^2"] by simp
5.970 -
5.971 -lemma real_le_rsqrt: "x^2 \<le> y \<Longrightarrow> x \<le> sqrt y"
5.972 - using real_sqrt_le_mono[of "x^2" y] by simp
5.973 -
5.974 -lemma real_less_rsqrt: "x^2 < y \<Longrightarrow> x < sqrt y"
5.975 - using real_sqrt_less_mono[of "x^2" y] by simp
5.976 -
5.977 -lemma sqrt_even_pow2: assumes n: "even n"
5.978 - shows "sqrt(2 ^ n) = 2 ^ (n div 2)"
5.979 -proof-
5.980 - from n obtain m where m: "n = 2*m" unfolding even_nat_equiv_def2
5.981 - by (auto simp add: nat_number)
5.982 - from m have "sqrt(2 ^ n) = sqrt ((2 ^ m) ^ 2)"
5.983 - by (simp only: power_mult[symmetric] mult_commute)
5.984 - then show ?thesis using m by simp
5.985 -qed
5.986 -
5.987 -lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)"
5.988 - apply (cases "x = 0", simp_all)
5.989 - using sqrt_divide_self_eq[of x]
5.990 - apply (simp add: inverse_eq_divide real_sqrt_ge_0_iff field_simps)
5.991 - done
5.992 -
5.993 -text{* Hence derive more interesting properties of the norm. *}
5.994 -
5.995 -text {*
5.996 - This type-specific version is only here
5.997 - to make @{text normarith.ML} happy.
5.998 -*}
5.999 -lemma norm_0: "norm (0::real ^ _) = 0"
5.1000 - by (rule norm_zero)
5.1001 -
5.1002 -lemma norm_mul[simp]: "norm(a *s x) = abs(a) * norm x"
5.1003 - by (simp add: norm_vector_def vector_component setL2_right_distrib
5.1004 - abs_mult cong: strong_setL2_cong)
5.1005 -lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
5.1006 - by (simp add: norm_vector_def dot_def setL2_def power2_eq_square)
5.1007 -lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
5.1008 - by (simp add: norm_vector_def setL2_def dot_def power2_eq_square)
5.1009 -lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
5.1010 - by (simp add: real_vector_norm_def)
5.1011 -lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n::finite)" by (metis norm_eq_zero)
5.1012 -lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
5.1013 - by vector
5.1014 -lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
5.1015 - by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
5.1016 -lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0"
5.1017 - by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
5.1018 -lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)"
5.1019 - by (metis vector_mul_lcancel)
5.1020 -lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b"
5.1021 - by (metis vector_mul_rcancel)
5.1022 -lemma norm_cauchy_schwarz:
5.1023 - fixes x y :: "real ^ 'n::finite"
5.1024 - shows "x \<bullet> y <= norm x * norm y"
5.1025 -proof-
5.1026 - {assume "norm x = 0"
5.1027 - hence ?thesis by (simp add: dot_lzero dot_rzero)}
5.1028 - moreover
5.1029 - {assume "norm y = 0"
5.1030 - hence ?thesis by (simp add: dot_lzero dot_rzero)}
5.1031 - moreover
5.1032 - {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
5.1033 - let ?z = "norm y *s x - norm x *s y"
5.1034 - from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
5.1035 - from dot_pos_le[of ?z]
5.1036 - have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
5.1037 - apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
5.1038 - by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym)
5.1039 - hence "x\<bullet>y \<le> (norm x ^2 * norm y ^2) / (norm x * norm y)" using p
5.1040 - by (simp add: field_simps)
5.1041 - hence ?thesis using h by (simp add: power2_eq_square)}
5.1042 - ultimately show ?thesis by metis
5.1043 -qed
5.1044 -
5.1045 -lemma norm_cauchy_schwarz_abs:
5.1046 - fixes x y :: "real ^ 'n::finite"
5.1047 - shows "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
5.1048 - using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
5.1049 - by (simp add: real_abs_def dot_rneg)
5.1050 -
5.1051 -lemma norm_triangle_sub:
5.1052 - fixes x y :: "'a::real_normed_vector"
5.1053 - shows "norm x \<le> norm y + norm (x - y)"
5.1054 - using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
5.1055 -
5.1056 -lemma norm_triangle_le: "norm(x::real ^'n::finite) + norm y <= e ==> norm(x + y) <= e"
5.1057 - by (metis order_trans norm_triangle_ineq)
5.1058 -lemma norm_triangle_lt: "norm(x::real ^'n::finite) + norm(y) < e ==> norm(x + y) < e"
5.1059 - by (metis basic_trans_rules(21) norm_triangle_ineq)
5.1060 -
5.1061 -lemma component_le_norm: "\<bar>x$i\<bar> <= norm (x::real ^ 'n::finite)"
5.1062 - apply (simp add: norm_vector_def)
5.1063 - apply (rule member_le_setL2, simp_all)
5.1064 - done
5.1065 -
5.1066 -lemma norm_bound_component_le: "norm(x::real ^ 'n::finite) <= e
5.1067 - ==> \<bar>x$i\<bar> <= e"
5.1068 - by (metis component_le_norm order_trans)
5.1069 -
5.1070 -lemma norm_bound_component_lt: "norm(x::real ^ 'n::finite) < e
5.1071 - ==> \<bar>x$i\<bar> < e"
5.1072 - by (metis component_le_norm basic_trans_rules(21))
5.1073 -
5.1074 -lemma norm_le_l1: "norm (x:: real ^'n::finite) <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
5.1075 - by (simp add: norm_vector_def setL2_le_setsum)
5.1076 -
5.1077 -lemma real_abs_norm: "\<bar>norm x\<bar> = norm (x :: real ^ _)"
5.1078 - by (rule abs_norm_cancel)
5.1079 -lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n::finite) - norm y\<bar> <= norm(x - y)"
5.1080 - by (rule norm_triangle_ineq3)
5.1081 -lemma norm_le: "norm(x::real ^ _) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
5.1082 - by (simp add: real_vector_norm_def)
5.1083 -lemma norm_lt: "norm(x::real ^ _) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
5.1084 - by (simp add: real_vector_norm_def)
5.1085 -lemma norm_eq: "norm (x::real ^ _) = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
5.1086 - by (simp add: order_eq_iff norm_le)
5.1087 -lemma norm_eq_1: "norm(x::real ^ _) = 1 \<longleftrightarrow> x \<bullet> x = 1"
5.1088 - by (simp add: real_vector_norm_def)
5.1089 -
5.1090 -text{* Squaring equations and inequalities involving norms. *}
5.1091 -
5.1092 -lemma dot_square_norm: "x \<bullet> x = norm(x)^2"
5.1093 - by (simp add: real_vector_norm_def)
5.1094 -
5.1095 -lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
5.1096 - by (auto simp add: real_vector_norm_def)
5.1097 -
5.1098 -lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
5.1099 -proof-
5.1100 - have "x^2 \<le> y^2 \<longleftrightarrow> (x -y) * (y + x) \<le> 0" by (simp add: ring_simps power2_eq_square)
5.1101 - also have "\<dots> \<longleftrightarrow> \<bar>x\<bar> \<le> \<bar>y\<bar>" apply (simp add: zero_compare_simps real_abs_def not_less) by arith
5.1102 -finally show ?thesis ..
5.1103 -qed
5.1104 -
5.1105 -lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
5.1106 - apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
5.1107 - using norm_ge_zero[of x]
5.1108 - apply arith
5.1109 - done
5.1110 -
5.1111 -lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2"
5.1112 - apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
5.1113 - using norm_ge_zero[of x]
5.1114 - apply arith
5.1115 - done
5.1116 -
5.1117 -lemma norm_lt_square: "norm(x) < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a^2"
5.1118 - by (metis not_le norm_ge_square)
5.1119 -lemma norm_gt_square: "norm(x) > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a^2"
5.1120 - by (metis norm_le_square not_less)
5.1121 -
5.1122 -text{* Dot product in terms of the norm rather than conversely. *}
5.1123 -
5.1124 -lemma dot_norm: "x \<bullet> y = (norm(x + y) ^2 - norm x ^ 2 - norm y ^ 2) / 2"
5.1125 - by (simp add: norm_pow_2 dot_ladd dot_radd dot_sym)
5.1126 -
5.1127 -lemma dot_norm_neg: "x \<bullet> y = ((norm x ^ 2 + norm y ^ 2) - norm(x - y) ^ 2) / 2"
5.1128 - by (simp add: norm_pow_2 dot_ladd dot_radd dot_lsub dot_rsub dot_sym)
5.1129 -
5.1130 -
5.1131 -text{* Equality of vectors in terms of @{term "op \<bullet>"} products. *}
5.1132 -
5.1133 -lemma vector_eq: "(x:: real ^ 'n::finite) = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y\<and> y \<bullet> y = x \<bullet> x" (is "?lhs \<longleftrightarrow> ?rhs")
5.1134 -proof
5.1135 - assume "?lhs" then show ?rhs by simp
5.1136 -next
5.1137 - assume ?rhs
5.1138 - then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y\<bullet> y = 0" by simp
5.1139 - hence "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
5.1140 - by (simp add: dot_rsub dot_lsub dot_sym)
5.1141 - then have "(x - y) \<bullet> (x - y) = 0" by (simp add: ring_simps dot_lsub dot_rsub)
5.1142 - then show "x = y" by (simp add: dot_eq_0)
5.1143 -qed
5.1144 -
5.1145 -
5.1146 -subsection{* General linear decision procedure for normed spaces. *}
5.1147 -
5.1148 -lemma norm_cmul_rule_thm:
5.1149 - fixes x :: "'a::real_normed_vector"
5.1150 - shows "b >= norm(x) ==> \<bar>c\<bar> * b >= norm(scaleR c x)"
5.1151 - unfolding norm_scaleR
5.1152 - apply (erule mult_mono1)
5.1153 - apply simp
5.1154 - done
5.1155 -
5.1156 - (* FIXME: Move all these theorems into the ML code using lemma antiquotation *)
5.1157 -lemma norm_add_rule_thm:
5.1158 - fixes x1 x2 :: "'a::real_normed_vector"
5.1159 - shows "norm x1 \<le> b1 \<Longrightarrow> norm x2 \<le> b2 \<Longrightarrow> norm (x1 + x2) \<le> b1 + b2"
5.1160 - by (rule order_trans [OF norm_triangle_ineq add_mono])
5.1161 -
5.1162 -lemma ge_iff_diff_ge_0: "(a::'a::ordered_ring) \<ge> b == a - b \<ge> 0"
5.1163 - by (simp add: ring_simps)
5.1164 -
5.1165 -lemma pth_1:
5.1166 - fixes x :: "'a::real_normed_vector"
5.1167 - shows "x == scaleR 1 x" by simp
5.1168 -
5.1169 -lemma pth_2:
5.1170 - fixes x :: "'a::real_normed_vector"
5.1171 - shows "x - y == x + -y" by (atomize (full)) simp
5.1172 -
5.1173 -lemma pth_3:
5.1174 - fixes x :: "'a::real_normed_vector"
5.1175 - shows "- x == scaleR (-1) x" by simp
5.1176 -
5.1177 -lemma pth_4:
5.1178 - fixes x :: "'a::real_normed_vector"
5.1179 - shows "scaleR 0 x == 0" and "scaleR c 0 = (0::'a)" by simp_all
5.1180 -
5.1181 -lemma pth_5:
5.1182 - fixes x :: "'a::real_normed_vector"
5.1183 - shows "scaleR c (scaleR d x) == scaleR (c * d) x" by simp
5.1184 -
5.1185 -lemma pth_6:
5.1186 - fixes x :: "'a::real_normed_vector"
5.1187 - shows "scaleR c (x + y) == scaleR c x + scaleR c y"
5.1188 - by (simp add: scaleR_right_distrib)
5.1189 -
5.1190 -lemma pth_7:
5.1191 - fixes x :: "'a::real_normed_vector"
5.1192 - shows "0 + x == x" and "x + 0 == x" by simp_all
5.1193 -
5.1194 -lemma pth_8:
5.1195 - fixes x :: "'a::real_normed_vector"
5.1196 - shows "scaleR c x + scaleR d x == scaleR (c + d) x"
5.1197 - by (simp add: scaleR_left_distrib)
5.1198 -
5.1199 -lemma pth_9:
5.1200 - fixes x :: "'a::real_normed_vector" shows
5.1201 - "(scaleR c x + z) + scaleR d x == scaleR (c + d) x + z"
5.1202 - "scaleR c x + (scaleR d x + z) == scaleR (c + d) x + z"
5.1203 - "(scaleR c x + w) + (scaleR d x + z) == scaleR (c + d) x + (w + z)"
5.1204 - by (simp_all add: algebra_simps)
5.1205 -
5.1206 -lemma pth_a:
5.1207 - fixes x :: "'a::real_normed_vector"
5.1208 - shows "scaleR 0 x + y == y" by simp
5.1209 -
5.1210 -lemma pth_b:
5.1211 - fixes x :: "'a::real_normed_vector" shows
5.1212 - "scaleR c x + scaleR d y == scaleR c x + scaleR d y"
5.1213 - "(scaleR c x + z) + scaleR d y == scaleR c x + (z + scaleR d y)"
5.1214 - "scaleR c x + (scaleR d y + z) == scaleR c x + (scaleR d y + z)"
5.1215 - "(scaleR c x + w) + (scaleR d y + z) == scaleR c x + (w + (scaleR d y + z))"
5.1216 - by (simp_all add: algebra_simps)
5.1217 -
5.1218 -lemma pth_c:
5.1219 - fixes x :: "'a::real_normed_vector" shows
5.1220 - "scaleR c x + scaleR d y == scaleR d y + scaleR c x"
5.1221 - "(scaleR c x + z) + scaleR d y == scaleR d y + (scaleR c x + z)"
5.1222 - "scaleR c x + (scaleR d y + z) == scaleR d y + (scaleR c x + z)"
5.1223 - "(scaleR c x + w) + (scaleR d y + z) == scaleR d y + ((scaleR c x + w) + z)"
5.1224 - by (simp_all add: algebra_simps)
5.1225 -
5.1226 -lemma pth_d:
5.1227 - fixes x :: "'a::real_normed_vector"
5.1228 - shows "x + 0 == x" by simp
5.1229 -
5.1230 -lemma norm_imp_pos_and_ge:
5.1231 - fixes x :: "'a::real_normed_vector"
5.1232 - shows "norm x == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
5.1233 - by atomize auto
5.1234 -
5.1235 -lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
5.1236 -
5.1237 -lemma norm_pths:
5.1238 - fixes x :: "'a::real_normed_vector" shows
5.1239 - "x = y \<longleftrightarrow> norm (x - y) \<le> 0"
5.1240 - "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
5.1241 - using norm_ge_zero[of "x - y"] by auto
5.1242 -
5.1243 -lemma vector_dist_norm:
5.1244 - fixes x :: "'a::real_normed_vector"
5.1245 - shows "dist x y = norm (x - y)"
5.1246 - by (rule dist_norm)
5.1247 -
5.1248 -use "normarith.ML"
5.1249 -
5.1250 -method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
5.1251 -*} "Proves simple linear statements about vector norms"
5.1252 -
5.1253 -
5.1254 -text{* Hence more metric properties. *}
5.1255 -
5.1256 -lemma dist_triangle_alt:
5.1257 - fixes x y z :: "'a::metric_space"
5.1258 - shows "dist y z <= dist x y + dist x z"
5.1259 -using dist_triangle [of y z x] by (simp add: dist_commute)
5.1260 -
5.1261 -lemma dist_pos_lt:
5.1262 - fixes x y :: "'a::metric_space"
5.1263 - shows "x \<noteq> y ==> 0 < dist x y"
5.1264 -by (simp add: zero_less_dist_iff)
5.1265 -
5.1266 -lemma dist_nz:
5.1267 - fixes x y :: "'a::metric_space"
5.1268 - shows "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
5.1269 -by (simp add: zero_less_dist_iff)
5.1270 -
5.1271 -lemma dist_triangle_le:
5.1272 - fixes x y z :: "'a::metric_space"
5.1273 - shows "dist x z + dist y z <= e \<Longrightarrow> dist x y <= e"
5.1274 -by (rule order_trans [OF dist_triangle2])
5.1275 -
5.1276 -lemma dist_triangle_lt:
5.1277 - fixes x y z :: "'a::metric_space"
5.1278 - shows "dist x z + dist y z < e ==> dist x y < e"
5.1279 -by (rule le_less_trans [OF dist_triangle2])
5.1280 -
5.1281 -lemma dist_triangle_half_l:
5.1282 - fixes x1 x2 y :: "'a::metric_space"
5.1283 - shows "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
5.1284 -by (rule dist_triangle_lt [where z=y], simp)
5.1285 -
5.1286 -lemma dist_triangle_half_r:
5.1287 - fixes x1 x2 y :: "'a::metric_space"
5.1288 - shows "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
5.1289 -by (rule dist_triangle_half_l, simp_all add: dist_commute)
5.1290 -
5.1291 -lemma dist_triangle_add:
5.1292 - fixes x y x' y' :: "'a::real_normed_vector"
5.1293 - shows "dist (x + y) (x' + y') <= dist x x' + dist y y'"
5.1294 - by norm
5.1295 -
5.1296 -lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
5.1297 - unfolding dist_norm vector_ssub_ldistrib[symmetric] norm_mul ..
5.1298 -
5.1299 -lemma dist_triangle_add_half:
5.1300 - fixes x x' y y' :: "'a::real_normed_vector"
5.1301 - shows "dist x x' < e / 2 \<Longrightarrow> dist y y' < e / 2 \<Longrightarrow> dist(x + y) (x' + y') < e"
5.1302 - by norm
5.1303 -
5.1304 -lemma setsum_component [simp]:
5.1305 - fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
5.1306 - shows "(setsum f S)$i = setsum (\<lambda>x. (f x)$i) S"
5.1307 - by (cases "finite S", induct S set: finite, simp_all)
5.1308 -
5.1309 -lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
5.1310 - by (simp add: Cart_eq)
5.1311 -
5.1312 -lemma setsum_clauses:
5.1313 - shows "setsum f {} = 0"
5.1314 - and "finite S \<Longrightarrow> setsum f (insert x S) =
5.1315 - (if x \<in> S then setsum f S else f x + setsum f S)"
5.1316 - by (auto simp add: insert_absorb)
5.1317 -
5.1318 -lemma setsum_cmul:
5.1319 - fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
5.1320 - shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S"
5.1321 - by (simp add: Cart_eq setsum_right_distrib)
5.1322 -
5.1323 -lemma setsum_norm:
5.1324 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
5.1325 - assumes fS: "finite S"
5.1326 - shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
5.1327 -proof(induct rule: finite_induct[OF fS])
5.1328 - case 1 thus ?case by simp
5.1329 -next
5.1330 - case (2 x S)
5.1331 - from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
5.1332 - also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
5.1333 - using "2.hyps" by simp
5.1334 - finally show ?case using "2.hyps" by simp
5.1335 -qed
5.1336 -
5.1337 -lemma real_setsum_norm:
5.1338 - fixes f :: "'a \<Rightarrow> real ^'n::finite"
5.1339 - assumes fS: "finite S"
5.1340 - shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
5.1341 -proof(induct rule: finite_induct[OF fS])
5.1342 - case 1 thus ?case by simp
5.1343 -next
5.1344 - case (2 x S)
5.1345 - from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
5.1346 - also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
5.1347 - using "2.hyps" by simp
5.1348 - finally show ?case using "2.hyps" by simp
5.1349 -qed
5.1350 -
5.1351 -lemma setsum_norm_le:
5.1352 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
5.1353 - assumes fS: "finite S"
5.1354 - and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
5.1355 - shows "norm (setsum f S) \<le> setsum g S"
5.1356 -proof-
5.1357 - from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
5.1358 - by - (rule setsum_mono, simp)
5.1359 - then show ?thesis using setsum_norm[OF fS, of f] fg
5.1360 - by arith
5.1361 -qed
5.1362 -
5.1363 -lemma real_setsum_norm_le:
5.1364 - fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
5.1365 - assumes fS: "finite S"
5.1366 - and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
5.1367 - shows "norm (setsum f S) \<le> setsum g S"
5.1368 -proof-
5.1369 - from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
5.1370 - by - (rule setsum_mono, simp)
5.1371 - then show ?thesis using real_setsum_norm[OF fS, of f] fg
5.1372 - by arith
5.1373 -qed
5.1374 -
5.1375 -lemma setsum_norm_bound:
5.1376 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
5.1377 - assumes fS: "finite S"
5.1378 - and K: "\<forall>x \<in> S. norm (f x) \<le> K"
5.1379 - shows "norm (setsum f S) \<le> of_nat (card S) * K"
5.1380 - using setsum_norm_le[OF fS K] setsum_constant[symmetric]
5.1381 - by simp
5.1382 -
5.1383 -lemma real_setsum_norm_bound:
5.1384 - fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
5.1385 - assumes fS: "finite S"
5.1386 - and K: "\<forall>x \<in> S. norm (f x) \<le> K"
5.1387 - shows "norm (setsum f S) \<le> of_nat (card S) * K"
5.1388 - using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
5.1389 - by simp
5.1390 -
5.1391 -lemma setsum_vmul:
5.1392 - fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
5.1393 - assumes fS: "finite S"
5.1394 - shows "setsum f S *s v = setsum (\<lambda>x. f x *s v) S"
5.1395 -proof(induct rule: finite_induct[OF fS])
5.1396 - case 1 then show ?case by (simp add: vector_smult_lzero)
5.1397 -next
5.1398 - case (2 x F)
5.1399 - from "2.hyps" have "setsum f (insert x F) *s v = (f x + setsum f F) *s v"
5.1400 - by simp
5.1401 - also have "\<dots> = f x *s v + setsum f F *s v"
5.1402 - by (simp add: vector_sadd_rdistrib)
5.1403 - also have "\<dots> = setsum (\<lambda>x. f x *s v) (insert x F)" using "2.hyps" by simp
5.1404 - finally show ?case .
5.1405 -qed
5.1406 -
5.1407 -(* FIXME : Problem thm setsum_vmul[of _ "f:: 'a \<Rightarrow> real ^'n"] ---
5.1408 - Get rid of *s and use real_vector instead! Also prove that ^ creates a real_vector !! *)
5.1409 -
5.1410 - (* FIXME: Here too need stupid finiteness assumption on T!!! *)
5.1411 -lemma setsum_group:
5.1412 - assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
5.1413 - shows "setsum (\<lambda>y. setsum g {x. x\<in> S \<and> f x = y}) T = setsum g S"
5.1414 -
5.1415 -apply (subst setsum_image_gen[OF fS, of g f])
5.1416 -apply (rule setsum_mono_zero_right[OF fT fST])
5.1417 -by (auto intro: setsum_0')
5.1418 -
5.1419 -lemma vsum_norm_allsubsets_bound:
5.1420 - fixes f:: "'a \<Rightarrow> real ^'n::finite"
5.1421 - assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
5.1422 - shows "setsum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
5.1423 -proof-
5.1424 - let ?d = "real CARD('n)"
5.1425 - let ?nf = "\<lambda>x. norm (f x)"
5.1426 - let ?U = "UNIV :: 'n set"
5.1427 - have th0: "setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P = setsum (\<lambda>i. setsum (\<lambda>x. \<bar>f x $ i\<bar>) P) ?U"
5.1428 - by (rule setsum_commute)
5.1429 - have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def)
5.1430 - have "setsum ?nf P \<le> setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P"
5.1431 - apply (rule setsum_mono)
5.1432 - by (rule norm_le_l1)
5.1433 - also have "\<dots> \<le> 2 * ?d * e"
5.1434 - unfolding th0 th1
5.1435 - proof(rule setsum_bounded)
5.1436 - fix i assume i: "i \<in> ?U"
5.1437 - let ?Pp = "{x. x\<in> P \<and> f x $ i \<ge> 0}"
5.1438 - let ?Pn = "{x. x \<in> P \<and> f x $ i < 0}"
5.1439 - have thp: "P = ?Pp \<union> ?Pn" by auto
5.1440 - have thp0: "?Pp \<inter> ?Pn ={}" by auto
5.1441 - have PpP: "?Pp \<subseteq> P" and PnP: "?Pn \<subseteq> P" by blast+
5.1442 - have Ppe:"setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp \<le> e"
5.1443 - using component_le_norm[of "setsum (\<lambda>x. f x) ?Pp" i] fPs[OF PpP]
5.1444 - by (auto intro: abs_le_D1)
5.1445 - have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
5.1446 - using component_le_norm[of "setsum (\<lambda>x. - f x) ?Pn" i] fPs[OF PnP]
5.1447 - by (auto simp add: setsum_negf intro: abs_le_D1)
5.1448 - have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn"
5.1449 - apply (subst thp)
5.1450 - apply (rule setsum_Un_zero)
5.1451 - using fP thp0 by auto
5.1452 - also have "\<dots> \<le> 2*e" using Pne Ppe by arith
5.1453 - finally show "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P \<le> 2*e" .
5.1454 - qed
5.1455 - finally show ?thesis .
5.1456 -qed
5.1457 -
5.1458 -lemma dot_lsum: "finite S \<Longrightarrow> setsum f S \<bullet> (y::'a::{comm_ring}^'n) = setsum (\<lambda>x. f x \<bullet> y) S "
5.1459 - by (induct rule: finite_induct, auto simp add: dot_lzero dot_ladd dot_radd)
5.1460 -
5.1461 -lemma dot_rsum: "finite S \<Longrightarrow> (y::'a::{comm_ring}^'n) \<bullet> setsum f S = setsum (\<lambda>x. y \<bullet> f x) S "
5.1462 - by (induct rule: finite_induct, auto simp add: dot_rzero dot_radd)
5.1463 -
5.1464 -subsection{* Basis vectors in coordinate directions. *}
5.1465 -
5.1466 -
5.1467 -definition "basis k = (\<chi> i. if i = k then 1 else 0)"
5.1468 -
5.1469 -lemma basis_component [simp]: "basis k $ i = (if k=i then 1 else 0)"
5.1470 - unfolding basis_def by simp
5.1471 -
5.1472 -lemma delta_mult_idempotent:
5.1473 - "(if k=a then 1 else (0::'a::semiring_1)) * (if k=a then 1 else 0) = (if k=a then 1 else 0)" by (cases "k=a", auto)
5.1474 -
5.1475 -lemma norm_basis:
5.1476 - shows "norm (basis k :: real ^'n::finite) = 1"
5.1477 - apply (simp add: basis_def real_vector_norm_def dot_def)
5.1478 - apply (vector delta_mult_idempotent)
5.1479 - using setsum_delta[of "UNIV :: 'n set" "k" "\<lambda>k. 1::real"]
5.1480 - apply auto
5.1481 - done
5.1482 -
5.1483 -lemma norm_basis_1: "norm(basis 1 :: real ^'n::{finite,one}) = 1"
5.1484 - by (rule norm_basis)
5.1485 -
5.1486 -lemma vector_choose_size: "0 <= c ==> \<exists>(x::real^'n::finite). norm x = c"
5.1487 - apply (rule exI[where x="c *s basis arbitrary"])
5.1488 - by (simp only: norm_mul norm_basis)
5.1489 -
5.1490 -lemma vector_choose_dist: assumes e: "0 <= e"
5.1491 - shows "\<exists>(y::real^'n::finite). dist x y = e"
5.1492 -proof-
5.1493 - from vector_choose_size[OF e] obtain c:: "real ^'n" where "norm c = e"
5.1494 - by blast
5.1495 - then have "dist x (x - c) = e" by (simp add: dist_norm)
5.1496 - then show ?thesis by blast
5.1497 -qed
5.1498 -
5.1499 -lemma basis_inj: "inj (basis :: 'n \<Rightarrow> real ^'n::finite)"
5.1500 - by (simp add: inj_on_def Cart_eq)
5.1501 -
5.1502 -lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)"
5.1503 - by auto
5.1504 -
5.1505 -lemma basis_expansion:
5.1506 - "setsum (\<lambda>i. (x$i) *s basis i) UNIV = (x::('a::ring_1) ^'n::finite)" (is "?lhs = ?rhs" is "setsum ?f ?S = _")
5.1507 - by (auto simp add: Cart_eq cond_value_iff setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong)
5.1508 -
5.1509 -lemma basis_expansion_unique:
5.1510 - "setsum (\<lambda>i. f i *s basis i) UNIV = (x::('a::comm_ring_1) ^'n::finite) \<longleftrightarrow> (\<forall>i. f i = x$i)"
5.1511 - by (simp add: Cart_eq setsum_delta cond_value_iff cong del: if_weak_cong)
5.1512 -
5.1513 -lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
5.1514 - by auto
5.1515 -
5.1516 -lemma dot_basis:
5.1517 - shows "basis i \<bullet> x = x$i" "x \<bullet> (basis i :: 'a^'n::finite) = (x$i :: 'a::semiring_1)"
5.1518 - by (auto simp add: dot_def basis_def cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
5.1519 -
5.1520 -lemma inner_basis:
5.1521 - fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n::finite"
5.1522 - shows "inner (basis i) x = inner 1 (x $ i)"
5.1523 - and "inner x (basis i) = inner (x $ i) 1"
5.1524 - unfolding inner_vector_def basis_def
5.1525 - by (auto simp add: cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
5.1526 -
5.1527 -lemma basis_eq_0: "basis i = (0::'a::semiring_1^'n) \<longleftrightarrow> False"
5.1528 - by (auto simp add: Cart_eq)
5.1529 -
5.1530 -lemma basis_nonzero:
5.1531 - shows "basis k \<noteq> (0:: 'a::semiring_1 ^'n)"
5.1532 - by (simp add: basis_eq_0)
5.1533 -
5.1534 -lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = (z::'a::semiring_1^'n::finite)"
5.1535 - apply (auto simp add: Cart_eq dot_basis)
5.1536 - apply (erule_tac x="basis i" in allE)
5.1537 - apply (simp add: dot_basis)
5.1538 - apply (subgoal_tac "y = z")
5.1539 - apply simp
5.1540 - apply (simp add: Cart_eq)
5.1541 - done
5.1542 -
5.1543 -lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = (y::'a::semiring_1^'n::finite)"
5.1544 - apply (auto simp add: Cart_eq dot_basis)
5.1545 - apply (erule_tac x="basis i" in allE)
5.1546 - apply (simp add: dot_basis)
5.1547 - apply (subgoal_tac "x = y")
5.1548 - apply simp
5.1549 - apply (simp add: Cart_eq)
5.1550 - done
5.1551 -
5.1552 -subsection{* Orthogonality. *}
5.1553 -
5.1554 -definition "orthogonal x y \<longleftrightarrow> (x \<bullet> y = 0)"
5.1555 -
5.1556 -lemma orthogonal_basis:
5.1557 - shows "orthogonal (basis i :: 'a^'n::finite) x \<longleftrightarrow> x$i = (0::'a::ring_1)"
5.1558 - by (auto simp add: orthogonal_def dot_def basis_def cond_value_iff cond_application_beta setsum_delta cong del: if_weak_cong)
5.1559 -
5.1560 -lemma orthogonal_basis_basis:
5.1561 - shows "orthogonal (basis i :: 'a::ring_1^'n::finite) (basis j) \<longleftrightarrow> i \<noteq> j"
5.1562 - unfolding orthogonal_basis[of i] basis_component[of j] by simp
5.1563 -
5.1564 - (* FIXME : Maybe some of these require less than comm_ring, but not all*)
5.1565 -lemma orthogonal_clauses:
5.1566 - "orthogonal a (0::'a::comm_ring ^'n)"
5.1567 - "orthogonal a x ==> orthogonal a (c *s x)"
5.1568 - "orthogonal a x ==> orthogonal a (-x)"
5.1569 - "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x + y)"
5.1570 - "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x - y)"
5.1571 - "orthogonal 0 a"
5.1572 - "orthogonal x a ==> orthogonal (c *s x) a"
5.1573 - "orthogonal x a ==> orthogonal (-x) a"
5.1574 - "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x + y) a"
5.1575 - "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x - y) a"
5.1576 - unfolding orthogonal_def dot_rneg dot_rmult dot_radd dot_rsub
5.1577 - dot_lzero dot_rzero dot_lneg dot_lmult dot_ladd dot_lsub
5.1578 - by simp_all
5.1579 -
5.1580 -lemma orthogonal_commute: "orthogonal (x::'a::{ab_semigroup_mult,comm_monoid_add} ^'n)y \<longleftrightarrow> orthogonal y x"
5.1581 - by (simp add: orthogonal_def dot_sym)
5.1582 -
5.1583 -subsection{* Explicit vector construction from lists. *}
5.1584 -
5.1585 -primrec from_nat :: "nat \<Rightarrow> 'a::{monoid_add,one}"
5.1586 -where "from_nat 0 = 0" | "from_nat (Suc n) = 1 + from_nat n"
5.1587 -
5.1588 -lemma from_nat [simp]: "from_nat = of_nat"
5.1589 -by (rule ext, induct_tac x, simp_all)
5.1590 -
5.1591 -primrec
5.1592 - list_fun :: "nat \<Rightarrow> _ list \<Rightarrow> _ \<Rightarrow> _"
5.1593 -where
5.1594 - "list_fun n [] = (\<lambda>x. 0)"
5.1595 -| "list_fun n (x # xs) = fun_upd (list_fun (Suc n) xs) (from_nat n) x"
5.1596 -
5.1597 -definition "vector l = (\<chi> i. list_fun 1 l i)"
5.1598 -(*definition "vector l = (\<chi> i. if i <= length l then l ! (i - 1) else 0)"*)
5.1599 -
5.1600 -lemma vector_1: "(vector[x]) $1 = x"
5.1601 - unfolding vector_def by simp
5.1602 -
5.1603 -lemma vector_2:
5.1604 - "(vector[x,y]) $1 = x"
5.1605 - "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
5.1606 - unfolding vector_def by simp_all
5.1607 -
5.1608 -lemma vector_3:
5.1609 - "(vector [x,y,z] ::('a::zero)^3)$1 = x"
5.1610 - "(vector [x,y,z] ::('a::zero)^3)$2 = y"
5.1611 - "(vector [x,y,z] ::('a::zero)^3)$3 = z"
5.1612 - unfolding vector_def by simp_all
5.1613 -
5.1614 -lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))"
5.1615 - apply auto
5.1616 - apply (erule_tac x="v$1" in allE)
5.1617 - apply (subgoal_tac "vector [v$1] = v")
5.1618 - apply simp
5.1619 - apply (vector vector_def)
5.1620 - apply (simp add: forall_1)
5.1621 - done
5.1622 -
5.1623 -lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))"
5.1624 - apply auto
5.1625 - apply (erule_tac x="v$1" in allE)
5.1626 - apply (erule_tac x="v$2" in allE)
5.1627 - apply (subgoal_tac "vector [v$1, v$2] = v")
5.1628 - apply simp
5.1629 - apply (vector vector_def)
5.1630 - apply (simp add: forall_2)
5.1631 - done
5.1632 -
5.1633 -lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))"
5.1634 - apply auto
5.1635 - apply (erule_tac x="v$1" in allE)
5.1636 - apply (erule_tac x="v$2" in allE)
5.1637 - apply (erule_tac x="v$3" in allE)
5.1638 - apply (subgoal_tac "vector [v$1, v$2, v$3] = v")
5.1639 - apply simp
5.1640 - apply (vector vector_def)
5.1641 - apply (simp add: forall_3)
5.1642 - done
5.1643 -
5.1644 -subsection{* Linear functions. *}
5.1645 -
5.1646 -definition "linear f \<longleftrightarrow> (\<forall>x y. f(x + y) = f x + f y) \<and> (\<forall>c x. f(c *s x) = c *s f x)"
5.1647 -
5.1648 -lemma linear_compose_cmul: "linear f ==> linear (\<lambda>x. (c::'a::comm_semiring) *s f x)"
5.1649 - by (vector linear_def Cart_eq ring_simps)
5.1650 -
5.1651 -lemma linear_compose_neg: "linear (f :: 'a ^'n \<Rightarrow> 'a::comm_ring ^'m) ==> linear (\<lambda>x. -(f(x)))" by (vector linear_def Cart_eq)
5.1652 -
5.1653 -lemma linear_compose_add: "linear (f :: 'a ^'n \<Rightarrow> 'a::semiring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f(x) + g(x))"
5.1654 - by (vector linear_def Cart_eq ring_simps)
5.1655 -
5.1656 -lemma linear_compose_sub: "linear (f :: 'a ^'n \<Rightarrow> 'a::ring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f x - g x)"
5.1657 - by (vector linear_def Cart_eq ring_simps)
5.1658 -
5.1659 -lemma linear_compose: "linear f \<Longrightarrow> linear g ==> linear (g o f)"
5.1660 - by (simp add: linear_def)
5.1661 -
5.1662 -lemma linear_id: "linear id" by (simp add: linear_def id_def)
5.1663 -
5.1664 -lemma linear_zero: "linear (\<lambda>x. 0::'a::semiring_1 ^ 'n)" by (simp add: linear_def)
5.1665 -
5.1666 -lemma linear_compose_setsum:
5.1667 - assumes fS: "finite S" and lS: "\<forall>a \<in> S. linear (f a :: 'a::semiring_1 ^ 'n \<Rightarrow> 'a ^ 'm)"
5.1668 - shows "linear(\<lambda>x. setsum (\<lambda>a. f a x :: 'a::semiring_1 ^'m) S)"
5.1669 - using lS
5.1670 - apply (induct rule: finite_induct[OF fS])
5.1671 - by (auto simp add: linear_zero intro: linear_compose_add)
5.1672 -
5.1673 -lemma linear_vmul_component:
5.1674 - fixes f:: "'a::semiring_1^'m \<Rightarrow> 'a^'n"
5.1675 - assumes lf: "linear f"
5.1676 - shows "linear (\<lambda>x. f x $ k *s v)"
5.1677 - using lf
5.1678 - apply (auto simp add: linear_def )
5.1679 - by (vector ring_simps)+
5.1680 -
5.1681 -lemma linear_0: "linear f ==> f 0 = (0::'a::semiring_1 ^'n)"
5.1682 - unfolding linear_def
5.1683 - apply clarsimp
5.1684 - apply (erule allE[where x="0::'a"])
5.1685 - apply simp
5.1686 - done
5.1687 -
5.1688 -lemma linear_cmul: "linear f ==> f(c*s x) = c *s f x" by (simp add: linear_def)
5.1689 -
5.1690 -lemma linear_neg: "linear (f :: 'a::ring_1 ^'n \<Rightarrow> _) ==> f (-x) = - f x"
5.1691 - unfolding vector_sneg_minus1
5.1692 - using linear_cmul[of f] by auto
5.1693 -
5.1694 -lemma linear_add: "linear f ==> f(x + y) = f x + f y" by (metis linear_def)
5.1695 -
5.1696 -lemma linear_sub: "linear (f::'a::ring_1 ^'n \<Rightarrow> _) ==> f(x - y) = f x - f y"
5.1697 - by (simp add: diff_def linear_add linear_neg)
5.1698 -
5.1699 -lemma linear_setsum:
5.1700 - fixes f:: "'a::semiring_1^'n \<Rightarrow> _"
5.1701 - assumes lf: "linear f" and fS: "finite S"
5.1702 - shows "f (setsum g S) = setsum (f o g) S"
5.1703 -proof (induct rule: finite_induct[OF fS])
5.1704 - case 1 thus ?case by (simp add: linear_0[OF lf])
5.1705 -next
5.1706 - case (2 x F)
5.1707 - have "f (setsum g (insert x F)) = f (g x + setsum g F)" using "2.hyps"
5.1708 - by simp
5.1709 - also have "\<dots> = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp
5.1710 - also have "\<dots> = setsum (f o g) (insert x F)" using "2.hyps" by simp
5.1711 - finally show ?case .
5.1712 -qed
5.1713 -
5.1714 -lemma linear_setsum_mul:
5.1715 - fixes f:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m"
5.1716 - assumes lf: "linear f" and fS: "finite S"
5.1717 - shows "f (setsum (\<lambda>i. c i *s v i) S) = setsum (\<lambda>i. c i *s f (v i)) S"
5.1718 - using linear_setsum[OF lf fS, of "\<lambda>i. c i *s v i" , unfolded o_def]
5.1719 - linear_cmul[OF lf] by simp
5.1720 -
5.1721 -lemma linear_injective_0:
5.1722 - assumes lf: "linear (f:: 'a::ring_1 ^ 'n \<Rightarrow> _)"
5.1723 - shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
5.1724 -proof-
5.1725 - have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)" by (simp add: inj_on_def)
5.1726 - also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)" by simp
5.1727 - also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
5.1728 - by (simp add: linear_sub[OF lf])
5.1729 - also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)" by auto
5.1730 - finally show ?thesis .
5.1731 -qed
5.1732 -
5.1733 -lemma linear_bounded:
5.1734 - fixes f:: "real ^'m::finite \<Rightarrow> real ^'n::finite"
5.1735 - assumes lf: "linear f"
5.1736 - shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
5.1737 -proof-
5.1738 - let ?S = "UNIV:: 'm set"
5.1739 - let ?B = "setsum (\<lambda>i. norm(f(basis i))) ?S"
5.1740 - have fS: "finite ?S" by simp
5.1741 - {fix x:: "real ^ 'm"
5.1742 - let ?g = "(\<lambda>i. (x$i) *s (basis i) :: real ^ 'm)"
5.1743 - have "norm (f x) = norm (f (setsum (\<lambda>i. (x$i) *s (basis i)) ?S))"
5.1744 - by (simp only: basis_expansion)
5.1745 - also have "\<dots> = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)"
5.1746 - using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf]
5.1747 - by auto
5.1748 - finally have th0: "norm (f x) = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" .
5.1749 - {fix i assume i: "i \<in> ?S"
5.1750 - from component_le_norm[of x i]
5.1751 - have "norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x"
5.1752 - unfolding norm_mul
5.1753 - apply (simp only: mult_commute)
5.1754 - apply (rule mult_mono)
5.1755 - by (auto simp add: ring_simps norm_ge_zero) }
5.1756 - then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis
5.1757 - from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
5.1758 - have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
5.1759 - then show ?thesis by blast
5.1760 -qed
5.1761 -
5.1762 -lemma linear_bounded_pos:
5.1763 - fixes f:: "real ^'n::finite \<Rightarrow> real ^ 'm::finite"
5.1764 - assumes lf: "linear f"
5.1765 - shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
5.1766 -proof-
5.1767 - from linear_bounded[OF lf] obtain B where
5.1768 - B: "\<forall>x. norm (f x) \<le> B * norm x" by blast
5.1769 - let ?K = "\<bar>B\<bar> + 1"
5.1770 - have Kp: "?K > 0" by arith
5.1771 - {assume C: "B < 0"
5.1772 - have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
5.1773 - with C have "B * norm (1:: real ^ 'n) < 0"
5.1774 - by (simp add: zero_compare_simps)
5.1775 - with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
5.1776 - }
5.1777 - then have Bp: "B \<ge> 0" by ferrack
5.1778 - {fix x::"real ^ 'n"
5.1779 - have "norm (f x) \<le> ?K * norm x"
5.1780 - using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
5.1781 - apply (auto simp add: ring_simps split add: abs_split)
5.1782 - apply (erule order_trans, simp)
5.1783 - done
5.1784 - }
5.1785 - then show ?thesis using Kp by blast
5.1786 -qed
5.1787 -
5.1788 -lemma smult_conv_scaleR: "c *s x = scaleR c x"
5.1789 - unfolding vector_scalar_mult_def vector_scaleR_def by simp
5.1790 -
5.1791 -lemma linear_conv_bounded_linear:
5.1792 - fixes f :: "real ^ _ \<Rightarrow> real ^ _"
5.1793 - shows "linear f \<longleftrightarrow> bounded_linear f"
5.1794 -proof
5.1795 - assume "linear f"
5.1796 - show "bounded_linear f"
5.1797 - proof
5.1798 - fix x y show "f (x + y) = f x + f y"
5.1799 - using `linear f` unfolding linear_def by simp
5.1800 - next
5.1801 - fix r x show "f (scaleR r x) = scaleR r (f x)"
5.1802 - using `linear f` unfolding linear_def
5.1803 - by (simp add: smult_conv_scaleR)
5.1804 - next
5.1805 - have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
5.1806 - using `linear f` by (rule linear_bounded)
5.1807 - thus "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
5.1808 - by (simp add: mult_commute)
5.1809 - qed
5.1810 -next
5.1811 - assume "bounded_linear f"
5.1812 - then interpret f: bounded_linear f .
5.1813 - show "linear f"
5.1814 - unfolding linear_def smult_conv_scaleR
5.1815 - by (simp add: f.add f.scaleR)
5.1816 -qed
5.1817 -
5.1818 -subsection{* Bilinear functions. *}
5.1819 -
5.1820 -definition "bilinear f \<longleftrightarrow> (\<forall>x. linear(\<lambda>y. f x y)) \<and> (\<forall>y. linear(\<lambda>x. f x y))"
5.1821 -
5.1822 -lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)"
5.1823 - by (simp add: bilinear_def linear_def)
5.1824 -lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)"
5.1825 - by (simp add: bilinear_def linear_def)
5.1826 -
5.1827 -lemma bilinear_lmul: "bilinear h ==> h (c *s x) y = c *s (h x y)"
5.1828 - by (simp add: bilinear_def linear_def)
5.1829 -
5.1830 -lemma bilinear_rmul: "bilinear h ==> h x (c *s y) = c *s (h x y)"
5.1831 - by (simp add: bilinear_def linear_def)
5.1832 -
5.1833 -lemma bilinear_lneg: "bilinear h ==> h (- (x:: 'a::ring_1 ^ 'n)) y = -(h x y)"
5.1834 - by (simp only: vector_sneg_minus1 bilinear_lmul)
5.1835 -
5.1836 -lemma bilinear_rneg: "bilinear h ==> h x (- (y:: 'a::ring_1 ^ 'n)) = - h x y"
5.1837 - by (simp only: vector_sneg_minus1 bilinear_rmul)
5.1838 -
5.1839 -lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
5.1840 - using add_imp_eq[of x y 0] by auto
5.1841 -
5.1842 -lemma bilinear_lzero:
5.1843 - fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h 0 x = 0"
5.1844 - using bilinear_ladd[OF bh, of 0 0 x]
5.1845 - by (simp add: eq_add_iff ring_simps)
5.1846 -
5.1847 -lemma bilinear_rzero:
5.1848 - fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h x 0 = 0"
5.1849 - using bilinear_radd[OF bh, of x 0 0 ]
5.1850 - by (simp add: eq_add_iff ring_simps)
5.1851 -
5.1852 -lemma bilinear_lsub: "bilinear h ==> h (x - (y:: 'a::ring_1 ^ 'n)) z = h x z - h y z"
5.1853 - by (simp add: diff_def bilinear_ladd bilinear_lneg)
5.1854 -
5.1855 -lemma bilinear_rsub: "bilinear h ==> h z (x - (y:: 'a::ring_1 ^ 'n)) = h z x - h z y"
5.1856 - by (simp add: diff_def bilinear_radd bilinear_rneg)
5.1857 -
5.1858 -lemma bilinear_setsum:
5.1859 - fixes h:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m \<Rightarrow> 'a ^ 'k"
5.1860 - assumes bh: "bilinear h" and fS: "finite S" and fT: "finite T"
5.1861 - shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
5.1862 -proof-
5.1863 - have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
5.1864 - apply (rule linear_setsum[unfolded o_def])
5.1865 - using bh fS by (auto simp add: bilinear_def)
5.1866 - also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
5.1867 - apply (rule setsum_cong, simp)
5.1868 - apply (rule linear_setsum[unfolded o_def])
5.1869 - using bh fT by (auto simp add: bilinear_def)
5.1870 - finally show ?thesis unfolding setsum_cartesian_product .
5.1871 -qed
5.1872 -
5.1873 -lemma bilinear_bounded:
5.1874 - fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
5.1875 - assumes bh: "bilinear h"
5.1876 - shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
5.1877 -proof-
5.1878 - let ?M = "UNIV :: 'm set"
5.1879 - let ?N = "UNIV :: 'n set"
5.1880 - let ?B = "setsum (\<lambda>(i,j). norm (h (basis i) (basis j))) (?M \<times> ?N)"
5.1881 - have fM: "finite ?M" and fN: "finite ?N" by simp_all
5.1882 - {fix x:: "real ^ 'm" and y :: "real^'n"
5.1883 - have "norm (h x y) = norm (h (setsum (\<lambda>i. (x$i) *s basis i) ?M) (setsum (\<lambda>i. (y$i) *s basis i) ?N))" unfolding basis_expansion ..
5.1884 - also have "\<dots> = norm (setsum (\<lambda> (i,j). h ((x$i) *s basis i) ((y$j) *s basis j)) (?M \<times> ?N))" unfolding bilinear_setsum[OF bh fM fN] ..
5.1885 - finally have th: "norm (h x y) = \<dots>" .
5.1886 - have "norm (h x y) \<le> ?B * norm x * norm y"
5.1887 - apply (simp add: setsum_left_distrib th)
5.1888 - apply (rule real_setsum_norm_le)
5.1889 - using fN fM
5.1890 - apply simp
5.1891 - apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
5.1892 - apply (rule mult_mono)
5.1893 - apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
5.1894 - apply (rule mult_mono)
5.1895 - apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
5.1896 - done}
5.1897 - then show ?thesis by metis
5.1898 -qed
5.1899 -
5.1900 -lemma bilinear_bounded_pos:
5.1901 - fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
5.1902 - assumes bh: "bilinear h"
5.1903 - shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
5.1904 -proof-
5.1905 - from bilinear_bounded[OF bh] obtain B where
5.1906 - B: "\<forall>x y. norm (h x y) \<le> B * norm x * norm y" by blast
5.1907 - let ?K = "\<bar>B\<bar> + 1"
5.1908 - have Kp: "?K > 0" by arith
5.1909 - have KB: "B < ?K" by arith
5.1910 - {fix x::"real ^'m" and y :: "real ^'n"
5.1911 - from KB Kp
5.1912 - have "B * norm x * norm y \<le> ?K * norm x * norm y"
5.1913 - apply -
5.1914 - apply (rule mult_right_mono, rule mult_right_mono)
5.1915 - by (auto simp add: norm_ge_zero)
5.1916 - then have "norm (h x y) \<le> ?K * norm x * norm y"
5.1917 - using B[rule_format, of x y] by simp}
5.1918 - with Kp show ?thesis by blast
5.1919 -qed
5.1920 -
5.1921 -lemma bilinear_conv_bounded_bilinear:
5.1922 - fixes h :: "real ^ _ \<Rightarrow> real ^ _ \<Rightarrow> real ^ _"
5.1923 - shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
5.1924 -proof
5.1925 - assume "bilinear h"
5.1926 - show "bounded_bilinear h"
5.1927 - proof
5.1928 - fix x y z show "h (x + y) z = h x z + h y z"
5.1929 - using `bilinear h` unfolding bilinear_def linear_def by simp
5.1930 - next
5.1931 - fix x y z show "h x (y + z) = h x y + h x z"
5.1932 - using `bilinear h` unfolding bilinear_def linear_def by simp
5.1933 - next
5.1934 - fix r x y show "h (scaleR r x) y = scaleR r (h x y)"
5.1935 - using `bilinear h` unfolding bilinear_def linear_def
5.1936 - by (simp add: smult_conv_scaleR)
5.1937 - next
5.1938 - fix r x y show "h x (scaleR r y) = scaleR r (h x y)"
5.1939 - using `bilinear h` unfolding bilinear_def linear_def
5.1940 - by (simp add: smult_conv_scaleR)
5.1941 - next
5.1942 - have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
5.1943 - using `bilinear h` by (rule bilinear_bounded)
5.1944 - thus "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
5.1945 - by (simp add: mult_ac)
5.1946 - qed
5.1947 -next
5.1948 - assume "bounded_bilinear h"
5.1949 - then interpret h: bounded_bilinear h .
5.1950 - show "bilinear h"
5.1951 - unfolding bilinear_def linear_conv_bounded_linear
5.1952 - using h.bounded_linear_left h.bounded_linear_right
5.1953 - by simp
5.1954 -qed
5.1955 -
5.1956 -subsection{* Adjoints. *}
5.1957 -
5.1958 -definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
5.1959 -
5.1960 -lemma choice_iff: "(\<forall>x. \<exists>y. P x y) \<longleftrightarrow> (\<exists>f. \<forall>x. P x (f x))" by metis
5.1961 -
5.1962 -lemma adjoint_works_lemma:
5.1963 - fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.1964 - assumes lf: "linear f"
5.1965 - shows "\<forall>x y. f x \<bullet> y = x \<bullet> adjoint f y"
5.1966 -proof-
5.1967 - let ?N = "UNIV :: 'n set"
5.1968 - let ?M = "UNIV :: 'm set"
5.1969 - have fN: "finite ?N" by simp
5.1970 - have fM: "finite ?M" by simp
5.1971 - {fix y:: "'a ^ 'm"
5.1972 - let ?w = "(\<chi> i. (f (basis i) \<bullet> y)) :: 'a ^ 'n"
5.1973 - {fix x
5.1974 - have "f x \<bullet> y = f (setsum (\<lambda>i. (x$i) *s basis i) ?N) \<bullet> y"
5.1975 - by (simp only: basis_expansion)
5.1976 - also have "\<dots> = (setsum (\<lambda>i. (x$i) *s f (basis i)) ?N) \<bullet> y"
5.1977 - unfolding linear_setsum[OF lf fN]
5.1978 - by (simp add: linear_cmul[OF lf])
5.1979 - finally have "f x \<bullet> y = x \<bullet> ?w"
5.1980 - apply (simp only: )
5.1981 - apply (simp add: dot_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] ring_simps)
5.1982 - done}
5.1983 - }
5.1984 - then show ?thesis unfolding adjoint_def
5.1985 - some_eq_ex[of "\<lambda>f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y"]
5.1986 - using choice_iff[of "\<lambda>a b. \<forall>x. f x \<bullet> a = x \<bullet> b "]
5.1987 - by metis
5.1988 -qed
5.1989 -
5.1990 -lemma adjoint_works:
5.1991 - fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.1992 - assumes lf: "linear f"
5.1993 - shows "x \<bullet> adjoint f y = f x \<bullet> y"
5.1994 - using adjoint_works_lemma[OF lf] by metis
5.1995 -
5.1996 -
5.1997 -lemma adjoint_linear:
5.1998 - fixes f :: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.1999 - assumes lf: "linear f"
5.2000 - shows "linear (adjoint f)"
5.2001 - by (simp add: linear_def vector_eq_ldot[symmetric] dot_radd dot_rmult adjoint_works[OF lf])
5.2002 -
5.2003 -lemma adjoint_clauses:
5.2004 - fixes f:: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.2005 - assumes lf: "linear f"
5.2006 - shows "x \<bullet> adjoint f y = f x \<bullet> y"
5.2007 - and "adjoint f y \<bullet> x = y \<bullet> f x"
5.2008 - by (simp_all add: adjoint_works[OF lf] dot_sym )
5.2009 -
5.2010 -lemma adjoint_adjoint:
5.2011 - fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.2012 - assumes lf: "linear f"
5.2013 - shows "adjoint (adjoint f) = f"
5.2014 - apply (rule ext)
5.2015 - by (simp add: vector_eq_ldot[symmetric] adjoint_clauses[OF adjoint_linear[OF lf]] adjoint_clauses[OF lf])
5.2016 -
5.2017 -lemma adjoint_unique:
5.2018 - fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
5.2019 - assumes lf: "linear f" and u: "\<forall>x y. f' x \<bullet> y = x \<bullet> f y"
5.2020 - shows "f' = adjoint f"
5.2021 - apply (rule ext)
5.2022 - using u
5.2023 - by (simp add: vector_eq_rdot[symmetric] adjoint_clauses[OF lf])
5.2024 -
5.2025 -text{* Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"} *}
5.2026 -
5.2027 -consts generic_mult :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infixr "\<star>" 75)
5.2028 -
5.2029 -defs (overloaded)
5.2030 -matrix_matrix_mult_def: "(m:: ('a::semiring_1) ^'n^'m) \<star> (m' :: 'a ^'p^'n) \<equiv> (\<chi> i j. setsum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
5.2031 -
5.2032 -abbreviation
5.2033 - matrix_matrix_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m" (infixl "**" 70)
5.2034 - where "m ** m' == m\<star> m'"
5.2035 -
5.2036 -defs (overloaded)
5.2037 - matrix_vector_mult_def: "(m::('a::semiring_1) ^'n^'m) \<star> (x::'a ^'n) \<equiv> (\<chi> i. setsum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
5.2038 -
5.2039 -abbreviation
5.2040 - matrix_vector_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm" (infixl "*v" 70)
5.2041 - where
5.2042 - "m *v v == m \<star> v"
5.2043 -
5.2044 -defs (overloaded)
5.2045 - vector_matrix_mult_def: "(x::'a^'m) \<star> (m::('a::semiring_1) ^'n^'m) \<equiv> (\<chi> j. setsum (\<lambda>i. ((m$i)$j) * (x$i)) (UNIV :: 'm set)) :: 'a^'n"
5.2046 -
5.2047 -abbreviation
5.2048 - vactor_matrix_mult' :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n " (infixl "v*" 70)
5.2049 - where
5.2050 - "v v* m == v \<star> m"
5.2051 -
5.2052 -definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
5.2053 -definition "(transp::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
5.2054 -definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
5.2055 -definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
5.2056 -definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
5.2057 -definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
5.2058 -
5.2059 -lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
5.2060 -lemma matrix_add_ldistrib: "(A ** (B + C)) = (A \<star> B) + (A \<star> C)"
5.2061 - by (vector matrix_matrix_mult_def setsum_addf[symmetric] ring_simps)
5.2062 -
5.2063 -lemma matrix_mul_lid:
5.2064 - fixes A :: "'a::semiring_1 ^ 'm ^ 'n::finite"
5.2065 - shows "mat 1 ** A = A"
5.2066 - apply (simp add: matrix_matrix_mult_def mat_def)
5.2067 - apply vector
5.2068 - by (auto simp only: cond_value_iff cond_application_beta setsum_delta'[OF finite] mult_1_left mult_zero_left if_True UNIV_I)
5.2069 -
5.2070 -
5.2071 -lemma matrix_mul_rid:
5.2072 - fixes A :: "'a::semiring_1 ^ 'm::finite ^ 'n"
5.2073 - shows "A ** mat 1 = A"
5.2074 - apply (simp add: matrix_matrix_mult_def mat_def)
5.2075 - apply vector
5.2076 - by (auto simp only: cond_value_iff cond_application_beta setsum_delta[OF finite] mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
5.2077 -
5.2078 -lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
5.2079 - apply (vector matrix_matrix_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
5.2080 - apply (subst setsum_commute)
5.2081 - apply simp
5.2082 - done
5.2083 -
5.2084 -lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
5.2085 - apply (vector matrix_matrix_mult_def matrix_vector_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
5.2086 - apply (subst setsum_commute)
5.2087 - apply simp
5.2088 - done
5.2089 -
5.2090 -lemma matrix_vector_mul_lid: "mat 1 *v x = (x::'a::semiring_1 ^ 'n::finite)"
5.2091 - apply (vector matrix_vector_mult_def mat_def)
5.2092 - by (simp add: cond_value_iff cond_application_beta
5.2093 - setsum_delta' cong del: if_weak_cong)
5.2094 -
5.2095 -lemma matrix_transp_mul: "transp(A ** B) = transp B ** transp (A::'a::comm_semiring_1^'m^'n)"
5.2096 - by (simp add: matrix_matrix_mult_def transp_def Cart_eq mult_commute)
5.2097 -
5.2098 -lemma matrix_eq:
5.2099 - fixes A B :: "'a::semiring_1 ^ 'n::finite ^ 'm"
5.2100 - shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
5.2101 - apply auto
5.2102 - apply (subst Cart_eq)
5.2103 - apply clarify
5.2104 - apply (clarsimp simp add: matrix_vector_mult_def basis_def cond_value_iff cond_application_beta Cart_eq cong del: if_weak_cong)
5.2105 - apply (erule_tac x="basis ia" in allE)
5.2106 - apply (erule_tac x="i" in allE)
5.2107 - by (auto simp add: basis_def cond_value_iff cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong)
5.2108 -
5.2109 -lemma matrix_vector_mul_component:
5.2110 - shows "((A::'a::semiring_1^'n'^'m) *v x)$k = (A$k) \<bullet> x"
5.2111 - by (simp add: matrix_vector_mult_def dot_def)
5.2112 -
5.2113 -lemma dot_lmul_matrix: "((x::'a::comm_semiring_1 ^'n) v* A) \<bullet> y = x \<bullet> (A *v y)"
5.2114 - apply (simp add: dot_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac)
5.2115 - apply (subst setsum_commute)
5.2116 - by simp
5.2117 -
5.2118 -lemma transp_mat: "transp (mat n) = mat n"
5.2119 - by (vector transp_def mat_def)
5.2120 -
5.2121 -lemma transp_transp: "transp(transp A) = A"
5.2122 - by (vector transp_def)
5.2123 -
5.2124 -lemma row_transp:
5.2125 - fixes A:: "'a::semiring_1^'n^'m"
5.2126 - shows "row i (transp A) = column i A"
5.2127 - by (simp add: row_def column_def transp_def Cart_eq)
5.2128 -
5.2129 -lemma column_transp:
5.2130 - fixes A:: "'a::semiring_1^'n^'m"
5.2131 - shows "column i (transp A) = row i A"
5.2132 - by (simp add: row_def column_def transp_def Cart_eq)
5.2133 -
5.2134 -lemma rows_transp: "rows(transp (A::'a::semiring_1^'n^'m)) = columns A"
5.2135 -by (auto simp add: rows_def columns_def row_transp intro: set_ext)
5.2136 -
5.2137 -lemma columns_transp: "columns(transp (A::'a::semiring_1^'n^'m)) = rows A" by (metis transp_transp rows_transp)
5.2138 -
5.2139 -text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *}
5.2140 -
5.2141 -lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)"
5.2142 - by (simp add: matrix_vector_mult_def dot_def)
5.2143 -
5.2144 -lemma matrix_mult_vsum: "(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
5.2145 - by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute)
5.2146 -
5.2147 -lemma vector_componentwise:
5.2148 - "(x::'a::ring_1^'n::finite) = (\<chi> j. setsum (\<lambda>i. (x$i) * (basis i :: 'a^'n)$j) (UNIV :: 'n set))"
5.2149 - apply (subst basis_expansion[symmetric])
5.2150 - by (vector Cart_eq setsum_component)
5.2151 -
5.2152 -lemma linear_componentwise:
5.2153 - fixes f:: "'a::ring_1 ^ 'm::finite \<Rightarrow> 'a ^ 'n"
5.2154 - assumes lf: "linear f"
5.2155 - shows "(f x)$j = setsum (\<lambda>i. (x$i) * (f (basis i)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
5.2156 -proof-
5.2157 - let ?M = "(UNIV :: 'm set)"
5.2158 - let ?N = "(UNIV :: 'n set)"
5.2159 - have fM: "finite ?M" by simp
5.2160 - have "?rhs = (setsum (\<lambda>i.(x$i) *s f (basis i) ) ?M)$j"
5.2161 - unfolding vector_smult_component[symmetric]
5.2162 - unfolding setsum_component[of "(\<lambda>i.(x$i) *s f (basis i :: 'a^'m))" ?M]
5.2163 - ..
5.2164 - then show ?thesis unfolding linear_setsum_mul[OF lf fM, symmetric] basis_expansion ..
5.2165 -qed
5.2166 -
5.2167 -text{* Inverse matrices (not necessarily square) *}
5.2168 -
5.2169 -definition "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
5.2170 -
5.2171 -definition "matrix_inv(A:: 'a::semiring_1^'n^'m) =
5.2172 - (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
5.2173 -
5.2174 -text{* Correspondence between matrices and linear operators. *}
5.2175 -
5.2176 -definition matrix:: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
5.2177 -where "matrix f = (\<chi> i j. (f(basis j))$i)"
5.2178 -
5.2179 -lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::'a::comm_semiring_1 ^ 'n))"
5.2180 - by (simp add: linear_def matrix_vector_mult_def Cart_eq ring_simps setsum_right_distrib setsum_addf)
5.2181 -
5.2182 -lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::'a::comm_ring_1 ^ 'n::finite)"
5.2183 -apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute)
5.2184 -apply clarify
5.2185 -apply (rule linear_componentwise[OF lf, symmetric])
5.2186 -done
5.2187 -
5.2188 -lemma matrix_vector_mul: "linear f ==> f = (\<lambda>x. matrix f *v (x::'a::comm_ring_1 ^ 'n::finite))" by (simp add: ext matrix_works)
5.2189 -
5.2190 -lemma matrix_of_matrix_vector_mul: "matrix(\<lambda>x. A *v (x :: 'a:: comm_ring_1 ^ 'n::finite)) = A"
5.2191 - by (simp add: matrix_eq matrix_vector_mul_linear matrix_works)
5.2192 -
5.2193 -lemma matrix_compose:
5.2194 - assumes lf: "linear (f::'a::comm_ring_1^'n::finite \<Rightarrow> 'a^'m::finite)"
5.2195 - and lg: "linear (g::'a::comm_ring_1^'m::finite \<Rightarrow> 'a^'k)"
5.2196 - shows "matrix (g o f) = matrix g ** matrix f"
5.2197 - using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]]
5.2198 - by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
5.2199 -
5.2200 -lemma matrix_vector_column:"(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s ((transp A)$i)) (UNIV:: 'n set)"
5.2201 - by (simp add: matrix_vector_mult_def transp_def Cart_eq mult_commute)
5.2202 -
5.2203 -lemma adjoint_matrix: "adjoint(\<lambda>x. (A::'a::comm_ring_1^'n::finite^'m::finite) *v x) = (\<lambda>x. transp A *v x)"
5.2204 - apply (rule adjoint_unique[symmetric])
5.2205 - apply (rule matrix_vector_mul_linear)
5.2206 - apply (simp add: transp_def dot_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib)
5.2207 - apply (subst setsum_commute)
5.2208 - apply (auto simp add: mult_ac)
5.2209 - done
5.2210 -
5.2211 -lemma matrix_adjoint: assumes lf: "linear (f :: 'a::comm_ring_1^'n::finite \<Rightarrow> 'a ^ 'm::finite)"
5.2212 - shows "matrix(adjoint f) = transp(matrix f)"
5.2213 - apply (subst matrix_vector_mul[OF lf])
5.2214 - unfolding adjoint_matrix matrix_of_matrix_vector_mul ..
5.2215 -
5.2216 -subsection{* Interlude: Some properties of real sets *}
5.2217 -
5.2218 -lemma seq_mono_lemma: assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n" and "\<forall>n \<ge> m. e n <= e m"
5.2219 - shows "\<forall>n \<ge> m. d n < e m"
5.2220 - using prems apply auto
5.2221 - apply (erule_tac x="n" in allE)
5.2222 - apply (erule_tac x="n" in allE)
5.2223 - apply auto
5.2224 - done
5.2225 -
5.2226 -
5.2227 -lemma real_convex_bound_lt:
5.2228 - assumes xa: "(x::real) < a" and ya: "y < a" and u: "0 <= u" and v: "0 <= v"
5.2229 - and uv: "u + v = 1"
5.2230 - shows "u * x + v * y < a"
5.2231 -proof-
5.2232 - have uv': "u = 0 \<longrightarrow> v \<noteq> 0" using u v uv by arith
5.2233 - have "a = a * (u + v)" unfolding uv by simp
5.2234 - hence th: "u * a + v * a = a" by (simp add: ring_simps)
5.2235 - from xa u have "u \<noteq> 0 \<Longrightarrow> u*x < u*a" by (simp add: mult_compare_simps)
5.2236 - from ya v have "v \<noteq> 0 \<Longrightarrow> v * y < v * a" by (simp add: mult_compare_simps)
5.2237 - from xa ya u v have "u * x + v * y < u * a + v * a"
5.2238 - apply (cases "u = 0", simp_all add: uv')
5.2239 - apply(rule mult_strict_left_mono)
5.2240 - using uv' apply simp_all
5.2241 -
5.2242 - apply (rule add_less_le_mono)
5.2243 - apply(rule mult_strict_left_mono)
5.2244 - apply simp_all
5.2245 - apply (rule mult_left_mono)
5.2246 - apply simp_all
5.2247 - done
5.2248 - thus ?thesis unfolding th .
5.2249 -qed
5.2250 -
5.2251 -lemma real_convex_bound_le:
5.2252 - assumes xa: "(x::real) \<le> a" and ya: "y \<le> a" and u: "0 <= u" and v: "0 <= v"
5.2253 - and uv: "u + v = 1"
5.2254 - shows "u * x + v * y \<le> a"
5.2255 -proof-
5.2256 - from xa ya u v have "u * x + v * y \<le> u * a + v * a" by (simp add: add_mono mult_left_mono)
5.2257 - also have "\<dots> \<le> (u + v) * a" by (simp add: ring_simps)
5.2258 - finally show ?thesis unfolding uv by simp
5.2259 -qed
5.2260 -
5.2261 -lemma infinite_enumerate: assumes fS: "infinite S"
5.2262 - shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
5.2263 -unfolding subseq_def
5.2264 -using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
5.2265 -
5.2266 -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)"
5.2267 -apply auto
5.2268 -apply (rule_tac x="d/2" in exI)
5.2269 -apply auto
5.2270 -done
5.2271 -
5.2272 -
5.2273 -lemma triangle_lemma:
5.2274 - assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x^2 <= y^2 + z^2"
5.2275 - shows "x <= y + z"
5.2276 -proof-
5.2277 - have "y^2 + z^2 \<le> y^2 + 2*y*z + z^2" using z y by (simp add: zero_compare_simps)
5.2278 - with xy have th: "x ^2 \<le> (y+z)^2" by (simp add: power2_eq_square ring_simps)
5.2279 - from y z have yz: "y + z \<ge> 0" by arith
5.2280 - from power2_le_imp_le[OF th yz] show ?thesis .
5.2281 -qed
5.2282 -
5.2283 -
5.2284 -lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow>
5.2285 - (\<exists>x::'a ^ 'n. \<forall>i. P i (x$i))" (is "?lhs \<longleftrightarrow> ?rhs")
5.2286 -proof-
5.2287 - let ?S = "(UNIV :: 'n set)"
5.2288 - {assume H: "?rhs"
5.2289 - then have ?lhs by auto}
5.2290 - moreover
5.2291 - {assume H: "?lhs"
5.2292 - then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis
5.2293 - let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n"
5.2294 - {fix i
5.2295 - from f have "P i (f i)" by metis
5.2296 - then have "P i (?x$i)" by auto
5.2297 - }
5.2298 - hence "\<forall>i. P i (?x$i)" by metis
5.2299 - hence ?rhs by metis }
5.2300 - ultimately show ?thesis by metis
5.2301 -qed
5.2302 -
5.2303 -(* Supremum and infimum of real sets *)
5.2304 -
5.2305 -
5.2306 -definition rsup:: "real set \<Rightarrow> real" where
5.2307 - "rsup S = (SOME a. isLub UNIV S a)"
5.2308 -
5.2309 -lemma rsup_alt: "rsup S = (SOME a. (\<forall>x \<in> S. x \<le> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<le> b) \<longrightarrow> a \<le> b))" by (auto simp add: isLub_def rsup_def leastP_def isUb_def setle_def setge_def)
5.2310 -
5.2311 -lemma rsup: assumes Se: "S \<noteq> {}" and b: "\<exists>b. S *<= b"
5.2312 - shows "isLub UNIV S (rsup S)"
5.2313 -using Se b
5.2314 -unfolding rsup_def
5.2315 -apply clarify
5.2316 -apply (rule someI_ex)
5.2317 -apply (rule reals_complete)
5.2318 -by (auto simp add: isUb_def setle_def)
5.2319 -
5.2320 -lemma rsup_le: assumes Se: "S \<noteq> {}" and Sb: "S *<= b" shows "rsup S \<le> b"
5.2321 -proof-
5.2322 - from Sb have bu: "isUb UNIV S b" by (simp add: isUb_def setle_def)
5.2323 - from rsup[OF Se] Sb have "isLub UNIV S (rsup S)" by blast
5.2324 - then show ?thesis using bu by (auto simp add: isLub_def leastP_def setle_def setge_def)
5.2325 -qed
5.2326 -
5.2327 -lemma rsup_finite_Max: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2328 - shows "rsup S = Max S"
5.2329 -using fS Se
5.2330 -proof-
5.2331 - let ?m = "Max S"
5.2332 - from Max_ge[OF fS] have Sm: "\<forall> x\<in> S. x \<le> ?m" by metis
5.2333 - with rsup[OF Se] have lub: "isLub UNIV S (rsup S)" by (metis setle_def)
5.2334 - from Max_in[OF fS Se] lub have mrS: "?m \<le> rsup S"
5.2335 - by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def)
5.2336 - moreover
5.2337 - have "rsup S \<le> ?m" using Sm lub
5.2338 - by (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
5.2339 - ultimately show ?thesis by arith
5.2340 -qed
5.2341 -
5.2342 -lemma rsup_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2343 - shows "rsup S \<in> S"
5.2344 - using rsup_finite_Max[OF fS Se] Max_in[OF fS Se] by metis
5.2345 -
5.2346 -lemma rsup_finite_Ub: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2347 - shows "isUb S S (rsup S)"
5.2348 - using rsup_finite_Max[OF fS Se] rsup_finite_in[OF fS Se] Max_ge[OF fS]
5.2349 - unfolding isUb_def setle_def by metis
5.2350 -
5.2351 -lemma rsup_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2352 - shows "a \<le> rsup S \<longleftrightarrow> (\<exists> x \<in> S. a \<le> x)"
5.2353 -using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
5.2354 -
5.2355 -lemma rsup_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2356 - shows "a \<ge> rsup S \<longleftrightarrow> (\<forall> x \<in> S. a \<ge> x)"
5.2357 -using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
5.2358 -
5.2359 -lemma rsup_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2360 - shows "a < rsup S \<longleftrightarrow> (\<exists> x \<in> S. a < x)"
5.2361 -using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
5.2362 -
5.2363 -lemma rsup_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2364 - shows "a > rsup S \<longleftrightarrow> (\<forall> x \<in> S. a > x)"
5.2365 -using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
5.2366 -
5.2367 -lemma rsup_unique: assumes b: "S *<= b" and S: "\<forall>b' < b. \<exists>x \<in> S. b' < x"
5.2368 - shows "rsup S = b"
5.2369 -using b S
5.2370 -unfolding setle_def rsup_alt
5.2371 -apply -
5.2372 -apply (rule some_equality)
5.2373 -apply (metis linorder_not_le order_eq_iff[symmetric])+
5.2374 -done
5.2375 -
5.2376 -lemma rsup_le_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. T *<= b) \<Longrightarrow> rsup S \<le> rsup T"
5.2377 - apply (rule rsup_le)
5.2378 - apply simp
5.2379 - using rsup[of T] by (auto simp add: isLub_def leastP_def setge_def setle_def isUb_def)
5.2380 -
5.2381 -lemma isUb_def': "isUb R S = (\<lambda>x. S *<= x \<and> x \<in> R)"
5.2382 - apply (rule ext)
5.2383 - by (metis isUb_def)
5.2384 -
5.2385 -lemma UNIV_trivial: "UNIV x" using UNIV_I[of x] by (metis mem_def)
5.2386 -lemma rsup_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
5.2387 - shows "a \<le> rsup S \<and> rsup S \<le> b"
5.2388 -proof-
5.2389 - from rsup[OF Se] u have lub: "isLub UNIV S (rsup S)" by blast
5.2390 - hence b: "rsup S \<le> b" using u by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
5.2391 - from Se obtain y where y: "y \<in> S" by blast
5.2392 - from lub l have "a \<le> rsup S" apply (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
5.2393 - apply (erule ballE[where x=y])
5.2394 - apply (erule ballE[where x=y])
5.2395 - apply arith
5.2396 - using y apply auto
5.2397 - done
5.2398 - with b show ?thesis by blast
5.2399 -qed
5.2400 -
5.2401 -lemma rsup_abs_le: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rsup S\<bar> \<le> a"
5.2402 - unfolding abs_le_interval_iff using rsup_bounds[of S "-a" a]
5.2403 - by (auto simp add: setge_def setle_def)
5.2404 -
5.2405 -lemma rsup_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rsup S - l\<bar> \<le> e"
5.2406 -proof-
5.2407 - have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith
5.2408 - show ?thesis using S b rsup_bounds[of S "l - e" "l+e"] unfolding th
5.2409 - by (auto simp add: setge_def setle_def)
5.2410 -qed
5.2411 -
5.2412 -definition rinf:: "real set \<Rightarrow> real" where
5.2413 - "rinf S = (SOME a. isGlb UNIV S a)"
5.2414 -
5.2415 -lemma rinf_alt: "rinf S = (SOME a. (\<forall>x \<in> S. x \<ge> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<ge> b) \<longrightarrow> a \<ge> b))" by (auto simp add: isGlb_def rinf_def greatestP_def isLb_def setle_def setge_def)
5.2416 -
5.2417 -lemma reals_complete_Glb: assumes Se: "\<exists>x. x \<in> S" and lb: "\<exists> y. isLb UNIV S y"
5.2418 - shows "\<exists>(t::real). isGlb UNIV S t"
5.2419 -proof-
5.2420 - let ?M = "uminus ` S"
5.2421 - from lb have th: "\<exists>y. isUb UNIV ?M y" apply (auto simp add: isUb_def isLb_def setle_def setge_def)
5.2422 - by (rule_tac x="-y" in exI, auto)
5.2423 - from Se have Me: "\<exists>x. x \<in> ?M" by blast
5.2424 - from reals_complete[OF Me th] obtain t where t: "isLub UNIV ?M t" by blast
5.2425 - have "isGlb UNIV S (- t)" using t
5.2426 - apply (auto simp add: isLub_def isGlb_def leastP_def greatestP_def setle_def setge_def isUb_def isLb_def)
5.2427 - apply (erule_tac x="-y" in allE)
5.2428 - apply auto
5.2429 - done
5.2430 - then show ?thesis by metis
5.2431 -qed
5.2432 -
5.2433 -lemma rinf: assumes Se: "S \<noteq> {}" and b: "\<exists>b. b <=* S"
5.2434 - shows "isGlb UNIV S (rinf S)"
5.2435 -using Se b
5.2436 -unfolding rinf_def
5.2437 -apply clarify
5.2438 -apply (rule someI_ex)
5.2439 -apply (rule reals_complete_Glb)
5.2440 -apply (auto simp add: isLb_def setle_def setge_def)
5.2441 -done
5.2442 -
5.2443 -lemma rinf_ge: assumes Se: "S \<noteq> {}" and Sb: "b <=* S" shows "rinf S \<ge> b"
5.2444 -proof-
5.2445 - from Sb have bu: "isLb UNIV S b" by (simp add: isLb_def setge_def)
5.2446 - from rinf[OF Se] Sb have "isGlb UNIV S (rinf S)" by blast
5.2447 - then show ?thesis using bu by (auto simp add: isGlb_def greatestP_def setle_def setge_def)
5.2448 -qed
5.2449 -
5.2450 -lemma rinf_finite_Min: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2451 - shows "rinf S = Min S"
5.2452 -using fS Se
5.2453 -proof-
5.2454 - let ?m = "Min S"
5.2455 - from Min_le[OF fS] have Sm: "\<forall> x\<in> S. x \<ge> ?m" by metis
5.2456 - with rinf[OF Se] have glb: "isGlb UNIV S (rinf S)" by (metis setge_def)
5.2457 - from Min_in[OF fS Se] glb have mrS: "?m \<ge> rinf S"
5.2458 - by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def)
5.2459 - moreover
5.2460 - have "rinf S \<ge> ?m" using Sm glb
5.2461 - by (auto simp add: isGlb_def greatestP_def isLb_def setle_def setge_def)
5.2462 - ultimately show ?thesis by arith
5.2463 -qed
5.2464 -
5.2465 -lemma rinf_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2466 - shows "rinf S \<in> S"
5.2467 - using rinf_finite_Min[OF fS Se] Min_in[OF fS Se] by metis
5.2468 -
5.2469 -lemma rinf_finite_Lb: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2470 - shows "isLb S S (rinf S)"
5.2471 - using rinf_finite_Min[OF fS Se] rinf_finite_in[OF fS Se] Min_le[OF fS]
5.2472 - unfolding isLb_def setge_def by metis
5.2473 -
5.2474 -lemma rinf_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2475 - shows "a \<le> rinf S \<longleftrightarrow> (\<forall> x \<in> S. a \<le> x)"
5.2476 -using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
5.2477 -
5.2478 -lemma rinf_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2479 - shows "a \<ge> rinf S \<longleftrightarrow> (\<exists> x \<in> S. a \<ge> x)"
5.2480 -using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
5.2481 -
5.2482 -lemma rinf_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2483 - shows "a < rinf S \<longleftrightarrow> (\<forall> x \<in> S. a < x)"
5.2484 -using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
5.2485 -
5.2486 -lemma rinf_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
5.2487 - shows "a > rinf S \<longleftrightarrow> (\<exists> x \<in> S. a > x)"
5.2488 -using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
5.2489 -
5.2490 -lemma rinf_unique: assumes b: "b <=* S" and S: "\<forall>b' > b. \<exists>x \<in> S. b' > x"
5.2491 - shows "rinf S = b"
5.2492 -using b S
5.2493 -unfolding setge_def rinf_alt
5.2494 -apply -
5.2495 -apply (rule some_equality)
5.2496 -apply (metis linorder_not_le order_eq_iff[symmetric])+
5.2497 -done
5.2498 -
5.2499 -lemma rinf_ge_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. b <=* T) \<Longrightarrow> rinf S >= rinf T"
5.2500 - apply (rule rinf_ge)
5.2501 - apply simp
5.2502 - using rinf[of T] by (auto simp add: isGlb_def greatestP_def setge_def setle_def isLb_def)
5.2503 -
5.2504 -lemma isLb_def': "isLb R S = (\<lambda>x. x <=* S \<and> x \<in> R)"
5.2505 - apply (rule ext)
5.2506 - by (metis isLb_def)
5.2507 -
5.2508 -lemma rinf_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
5.2509 - shows "a \<le> rinf S \<and> rinf S \<le> b"
5.2510 -proof-
5.2511 - from rinf[OF Se] l have lub: "isGlb UNIV S (rinf S)" by blast
5.2512 - hence b: "a \<le> rinf S" using l by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
5.2513 - from Se obtain y where y: "y \<in> S" by blast
5.2514 - from lub u have "b \<ge> rinf S" apply (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
5.2515 - apply (erule ballE[where x=y])
5.2516 - apply (erule ballE[where x=y])
5.2517 - apply arith
5.2518 - using y apply auto
5.2519 - done
5.2520 - with b show ?thesis by blast
5.2521 -qed
5.2522 -
5.2523 -lemma rinf_abs_ge: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rinf S\<bar> \<le> a"
5.2524 - unfolding abs_le_interval_iff using rinf_bounds[of S "-a" a]
5.2525 - by (auto simp add: setge_def setle_def)
5.2526 -
5.2527 -lemma rinf_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rinf S - l\<bar> \<le> e"
5.2528 -proof-
5.2529 - have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith
5.2530 - show ?thesis using S b rinf_bounds[of S "l - e" "l+e"] unfolding th
5.2531 - by (auto simp add: setge_def setle_def)
5.2532 -qed
5.2533 -
5.2534 -
5.2535 -
5.2536 -subsection{* Operator norm. *}
5.2537 -
5.2538 -definition "onorm f = rsup {norm (f x)| x. norm x = 1}"
5.2539 -
5.2540 -lemma norm_bound_generalize:
5.2541 - fixes f:: "real ^'n::finite \<Rightarrow> real^'m::finite"
5.2542 - assumes lf: "linear f"
5.2543 - shows "(\<forall>x. norm x = 1 \<longrightarrow> norm (f x) \<le> b) \<longleftrightarrow> (\<forall>x. norm (f x) \<le> b * norm x)" (is "?lhs \<longleftrightarrow> ?rhs")
5.2544 -proof-
5.2545 - {assume H: ?rhs
5.2546 - {fix x :: "real^'n" assume x: "norm x = 1"
5.2547 - from H[rule_format, of x] x have "norm (f x) \<le> b" by simp}
5.2548 - then have ?lhs by blast }
5.2549 -
5.2550 - moreover
5.2551 - {assume H: ?lhs
5.2552 - from H[rule_format, of "basis arbitrary"]
5.2553 - have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis arbitrary)"]
5.2554 - by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
5.2555 - {fix x :: "real ^'n"
5.2556 - {assume "x = 0"
5.2557 - then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
5.2558 - moreover
5.2559 - {assume x0: "x \<noteq> 0"
5.2560 - hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
5.2561 - let ?c = "1/ norm x"
5.2562 - have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
5.2563 - with H have "norm (f(?c*s x)) \<le> b" by blast
5.2564 - hence "?c * norm (f x) \<le> b"
5.2565 - by (simp add: linear_cmul[OF lf] norm_mul)
5.2566 - hence "norm (f x) \<le> b * norm x"
5.2567 - using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
5.2568 - ultimately have "norm (f x) \<le> b * norm x" by blast}
5.2569 - then have ?rhs by blast}
5.2570 - ultimately show ?thesis by blast
5.2571 -qed
5.2572 -
5.2573 -lemma onorm:
5.2574 - fixes f:: "real ^'n::finite \<Rightarrow> real ^'m::finite"
5.2575 - assumes lf: "linear f"
5.2576 - shows "norm (f x) <= onorm f * norm x"
5.2577 - and "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
5.2578 -proof-
5.2579 - {
5.2580 - let ?S = "{norm (f x) |x. norm x = 1}"
5.2581 - have Se: "?S \<noteq> {}" using norm_basis by auto
5.2582 - from linear_bounded[OF lf] have b: "\<exists> b. ?S *<= b"
5.2583 - unfolding norm_bound_generalize[OF lf, symmetric] by (auto simp add: setle_def)
5.2584 - {from rsup[OF Se b, unfolded onorm_def[symmetric]]
5.2585 - show "norm (f x) <= onorm f * norm x"
5.2586 - apply -
5.2587 - apply (rule spec[where x = x])
5.2588 - unfolding norm_bound_generalize[OF lf, symmetric]
5.2589 - by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
5.2590 - {
5.2591 - show "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
5.2592 - using rsup[OF Se b, unfolded onorm_def[symmetric]]
5.2593 - unfolding norm_bound_generalize[OF lf, symmetric]
5.2594 - by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
5.2595 - }
5.2596 -qed
5.2597 -
5.2598 -lemma onorm_pos_le: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" shows "0 <= onorm f"
5.2599 - using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis arbitrary"], unfolded norm_basis] by simp
5.2600 -
5.2601 -lemma onorm_eq_0: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
5.2602 - shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
5.2603 - using onorm[OF lf]
5.2604 - apply (auto simp add: onorm_pos_le)
5.2605 - apply atomize
5.2606 - apply (erule allE[where x="0::real"])
5.2607 - using onorm_pos_le[OF lf]
5.2608 - apply arith
5.2609 - done
5.2610 -
5.2611 -lemma onorm_const: "onorm(\<lambda>x::real^'n::finite. (y::real ^ 'm::finite)) = norm y"
5.2612 -proof-
5.2613 - let ?f = "\<lambda>x::real^'n. (y::real ^ 'm)"
5.2614 - have th: "{norm (?f x)| x. norm x = 1} = {norm y}"
5.2615 - by(auto intro: vector_choose_size set_ext)
5.2616 - show ?thesis
5.2617 - unfolding onorm_def th
5.2618 - apply (rule rsup_unique) by (simp_all add: setle_def)
5.2619 -qed
5.2620 -
5.2621 -lemma onorm_pos_lt: assumes lf: "linear (f::real ^ 'n::finite \<Rightarrow> real ^'m::finite)"
5.2622 - shows "0 < onorm f \<longleftrightarrow> ~(\<forall>x. f x = 0)"
5.2623 - unfolding onorm_eq_0[OF lf, symmetric]
5.2624 - using onorm_pos_le[OF lf] by arith
5.2625 -
5.2626 -lemma onorm_compose:
5.2627 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
5.2628 - and lg: "linear (g::real^'k::finite \<Rightarrow> real^'n::finite)"
5.2629 - shows "onorm (f o g) <= onorm f * onorm g"
5.2630 - apply (rule onorm(2)[OF linear_compose[OF lg lf], rule_format])
5.2631 - unfolding o_def
5.2632 - apply (subst mult_assoc)
5.2633 - apply (rule order_trans)
5.2634 - apply (rule onorm(1)[OF lf])
5.2635 - apply (rule mult_mono1)
5.2636 - apply (rule onorm(1)[OF lg])
5.2637 - apply (rule onorm_pos_le[OF lf])
5.2638 - done
5.2639 -
5.2640 -lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
5.2641 - shows "onorm (\<lambda>x. - f x) \<le> onorm f"
5.2642 - using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
5.2643 - unfolding norm_minus_cancel by metis
5.2644 -
5.2645 -lemma onorm_neg: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
5.2646 - shows "onorm (\<lambda>x. - f x) = onorm f"
5.2647 - using onorm_neg_lemma[OF lf] onorm_neg_lemma[OF linear_compose_neg[OF lf]]
5.2648 - by simp
5.2649 -
5.2650 -lemma onorm_triangle:
5.2651 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and lg: "linear g"
5.2652 - shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
5.2653 - apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
5.2654 - apply (rule order_trans)
5.2655 - apply (rule norm_triangle_ineq)
5.2656 - apply (simp add: distrib)
5.2657 - apply (rule add_mono)
5.2658 - apply (rule onorm(1)[OF lf])
5.2659 - apply (rule onorm(1)[OF lg])
5.2660 - done
5.2661 -
5.2662 -lemma onorm_triangle_le: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) <= e
5.2663 - \<Longrightarrow> onorm(\<lambda>x. f x + g x) <= e"
5.2664 - apply (rule order_trans)
5.2665 - apply (rule onorm_triangle)
5.2666 - apply assumption+
5.2667 - done
5.2668 -
5.2669 -lemma onorm_triangle_lt: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) < e
5.2670 - ==> onorm(\<lambda>x. f x + g x) < e"
5.2671 - apply (rule order_le_less_trans)
5.2672 - apply (rule onorm_triangle)
5.2673 - by assumption+
5.2674 -
5.2675 -(* "lift" from 'a to 'a^1 and "drop" from 'a^1 to 'a -- FIXME: potential use of transfer *)
5.2676 -
5.2677 -definition vec1:: "'a \<Rightarrow> 'a ^ 1" where "vec1 x = (\<chi> i. x)"
5.2678 -
5.2679 -definition dest_vec1:: "'a ^1 \<Rightarrow> 'a"
5.2680 - where "dest_vec1 x = (x$1)"
5.2681 -
5.2682 -lemma vec1_component[simp]: "(vec1 x)$1 = x"
5.2683 - by (simp add: vec1_def)
5.2684 -
5.2685 -lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y"
5.2686 - by (simp_all add: vec1_def dest_vec1_def Cart_eq forall_1)
5.2687 -
5.2688 -lemma forall_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P (vec1 x))" by (metis vec1_dest_vec1)
5.2689 -
5.2690 -lemma exists_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(vec1 x))" by (metis vec1_dest_vec1)
5.2691 -
5.2692 -lemma forall_dest_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P(dest_vec1 x))" by (metis vec1_dest_vec1)
5.2693 -
5.2694 -lemma exists_dest_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(dest_vec1 x))"by (metis vec1_dest_vec1)
5.2695 -
5.2696 -lemma vec1_eq[simp]: "vec1 x = vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
5.2697 -
5.2698 -lemma dest_vec1_eq[simp]: "dest_vec1 x = dest_vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
5.2699 -
5.2700 -lemma vec1_in_image_vec1: "vec1 x \<in> (vec1 ` S) \<longleftrightarrow> x \<in> S" by auto
5.2701 -
5.2702 -lemma vec1_vec: "vec1 x = vec x" by (vector vec1_def)
5.2703 -
5.2704 -lemma vec1_add: "vec1(x + y) = vec1 x + vec1 y" by (vector vec1_def)
5.2705 -lemma vec1_sub: "vec1(x - y) = vec1 x - vec1 y" by (vector vec1_def)
5.2706 -lemma vec1_cmul: "vec1(c* x) = c *s vec1 x " by (vector vec1_def)
5.2707 -lemma vec1_neg: "vec1(- x) = - vec1 x " by (vector vec1_def)
5.2708 -
5.2709 -lemma vec1_setsum: assumes fS: "finite S"
5.2710 - shows "vec1(setsum f S) = setsum (vec1 o f) S"
5.2711 - apply (induct rule: finite_induct[OF fS])
5.2712 - apply (simp add: vec1_vec)
5.2713 - apply (auto simp add: vec1_add)
5.2714 - done
5.2715 -
5.2716 -lemma dest_vec1_lambda: "dest_vec1(\<chi> i. x i) = x 1"
5.2717 - by (simp add: dest_vec1_def)
5.2718 -
5.2719 -lemma dest_vec1_vec: "dest_vec1(vec x) = x"
5.2720 - by (simp add: vec1_vec[symmetric])
5.2721 -
5.2722 -lemma dest_vec1_add: "dest_vec1(x + y) = dest_vec1 x + dest_vec1 y"
5.2723 - by (metis vec1_dest_vec1 vec1_add)
5.2724 -
5.2725 -lemma dest_vec1_sub: "dest_vec1(x - y) = dest_vec1 x - dest_vec1 y"
5.2726 - by (metis vec1_dest_vec1 vec1_sub)
5.2727 -
5.2728 -lemma dest_vec1_cmul: "dest_vec1(c*sx) = c * dest_vec1 x"
5.2729 - by (metis vec1_dest_vec1 vec1_cmul)
5.2730 -
5.2731 -lemma dest_vec1_neg: "dest_vec1(- x) = - dest_vec1 x"
5.2732 - by (metis vec1_dest_vec1 vec1_neg)
5.2733 -
5.2734 -lemma dest_vec1_0[simp]: "dest_vec1 0 = 0" by (metis vec_0 dest_vec1_vec)
5.2735 -
5.2736 -lemma dest_vec1_sum: assumes fS: "finite S"
5.2737 - shows "dest_vec1(setsum f S) = setsum (dest_vec1 o f) S"
5.2738 - apply (induct rule: finite_induct[OF fS])
5.2739 - apply (simp add: dest_vec1_vec)
5.2740 - apply (auto simp add: dest_vec1_add)
5.2741 - done
5.2742 -
5.2743 -lemma norm_vec1: "norm(vec1 x) = abs(x)"
5.2744 - by (simp add: vec1_def norm_real)
5.2745 -
5.2746 -lemma dist_vec1: "dist(vec1 x) (vec1 y) = abs(x - y)"
5.2747 - by (simp only: dist_real vec1_component)
5.2748 -lemma abs_dest_vec1: "norm x = \<bar>dest_vec1 x\<bar>"
5.2749 - by (metis vec1_dest_vec1 norm_vec1)
5.2750 -
5.2751 -lemma linear_vmul_dest_vec1:
5.2752 - fixes f:: "'a::semiring_1^'n \<Rightarrow> 'a^1"
5.2753 - shows "linear f \<Longrightarrow> linear (\<lambda>x. dest_vec1(f x) *s v)"
5.2754 - unfolding dest_vec1_def
5.2755 - apply (rule linear_vmul_component)
5.2756 - by auto
5.2757 -
5.2758 -lemma linear_from_scalars:
5.2759 - assumes lf: "linear (f::'a::comm_ring_1 ^1 \<Rightarrow> 'a^'n)"
5.2760 - shows "f = (\<lambda>x. dest_vec1 x *s column 1 (matrix f))"
5.2761 - apply (rule ext)
5.2762 - apply (subst matrix_works[OF lf, symmetric])
5.2763 - apply (auto simp add: Cart_eq matrix_vector_mult_def dest_vec1_def column_def mult_commute UNIV_1)
5.2764 - done
5.2765 -
5.2766 -lemma linear_to_scalars: assumes lf: "linear (f::'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a^1)"
5.2767 - shows "f = (\<lambda>x. vec1(row 1 (matrix f) \<bullet> x))"
5.2768 - apply (rule ext)
5.2769 - apply (subst matrix_works[OF lf, symmetric])
5.2770 - apply (simp add: Cart_eq matrix_vector_mult_def vec1_def row_def dot_def mult_commute forall_1)
5.2771 - done
5.2772 -
5.2773 -lemma dest_vec1_eq_0: "dest_vec1 x = 0 \<longleftrightarrow> x = 0"
5.2774 - by (simp add: dest_vec1_eq[symmetric])
5.2775 -
5.2776 -lemma setsum_scalars: assumes fS: "finite S"
5.2777 - shows "setsum f S = vec1 (setsum (dest_vec1 o f) S)"
5.2778 - unfolding vec1_setsum[OF fS] by simp
5.2779 -
5.2780 -lemma dest_vec1_wlog_le: "(\<And>(x::'a::linorder ^ 1) y. P x y \<longleftrightarrow> P y x) \<Longrightarrow> (\<And>x y. dest_vec1 x <= dest_vec1 y ==> P x y) \<Longrightarrow> P x y"
5.2781 - apply (cases "dest_vec1 x \<le> dest_vec1 y")
5.2782 - apply simp
5.2783 - apply (subgoal_tac "dest_vec1 y \<le> dest_vec1 x")
5.2784 - apply (auto)
5.2785 - done
5.2786 -
5.2787 -text{* Pasting vectors. *}
5.2788 -
5.2789 -lemma linear_fstcart: "linear fstcart"
5.2790 - by (auto simp add: linear_def Cart_eq)
5.2791 -
5.2792 -lemma linear_sndcart: "linear sndcart"
5.2793 - by (auto simp add: linear_def Cart_eq)
5.2794 -
5.2795 -lemma fstcart_vec[simp]: "fstcart(vec x) = vec x"
5.2796 - by (simp add: Cart_eq)
5.2797 -
5.2798 -lemma fstcart_add[simp]:"fstcart(x + y) = fstcart (x::'a::{plus,times}^('b + 'c)) + fstcart y"
5.2799 - by (simp add: Cart_eq)
5.2800 -
5.2801 -lemma fstcart_cmul[simp]:"fstcart(c*s x) = c*s fstcart (x::'a::{plus,times}^('b + 'c))"
5.2802 - by (simp add: Cart_eq)
5.2803 -
5.2804 -lemma fstcart_neg[simp]:"fstcart(- x) = - fstcart (x::'a::ring_1^('b + 'c))"
5.2805 - by (simp add: Cart_eq)
5.2806 -
5.2807 -lemma fstcart_sub[simp]:"fstcart(x - y) = fstcart (x::'a::ring_1^('b + 'c)) - fstcart y"
5.2808 - by (simp add: Cart_eq)
5.2809 -
5.2810 -lemma fstcart_setsum:
5.2811 - fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
5.2812 - assumes fS: "finite S"
5.2813 - shows "fstcart (setsum f S) = setsum (\<lambda>i. fstcart (f i)) S"
5.2814 - by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
5.2815 -
5.2816 -lemma sndcart_vec[simp]: "sndcart(vec x) = vec x"
5.2817 - by (simp add: Cart_eq)
5.2818 -
5.2819 -lemma sndcart_add[simp]:"sndcart(x + y) = sndcart (x::'a::{plus,times}^('b + 'c)) + sndcart y"
5.2820 - by (simp add: Cart_eq)
5.2821 -
5.2822 -lemma sndcart_cmul[simp]:"sndcart(c*s x) = c*s sndcart (x::'a::{plus,times}^('b + 'c))"
5.2823 - by (simp add: Cart_eq)
5.2824 -
5.2825 -lemma sndcart_neg[simp]:"sndcart(- x) = - sndcart (x::'a::ring_1^('b + 'c))"
5.2826 - by (simp add: Cart_eq)
5.2827 -
5.2828 -lemma sndcart_sub[simp]:"sndcart(x - y) = sndcart (x::'a::ring_1^('b + 'c)) - sndcart y"
5.2829 - by (simp add: Cart_eq)
5.2830 -
5.2831 -lemma sndcart_setsum:
5.2832 - fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
5.2833 - assumes fS: "finite S"
5.2834 - shows "sndcart (setsum f S) = setsum (\<lambda>i. sndcart (f i)) S"
5.2835 - by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
5.2836 -
5.2837 -lemma pastecart_vec[simp]: "pastecart (vec x) (vec x) = vec x"
5.2838 - by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
5.2839 -
5.2840 -lemma pastecart_add[simp]:"pastecart (x1::'a::{plus,times}^_) y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)"
5.2841 - by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
5.2842 -
5.2843 -lemma pastecart_cmul[simp]: "pastecart (c *s (x1::'a::{plus,times}^_)) (c *s y1) = c *s pastecart x1 y1"
5.2844 - by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
5.2845 -
5.2846 -lemma pastecart_neg[simp]: "pastecart (- (x::'a::ring_1^_)) (- y) = - pastecart x y"
5.2847 - unfolding vector_sneg_minus1 pastecart_cmul ..
5.2848 -
5.2849 -lemma pastecart_sub: "pastecart (x1::'a::ring_1^_) y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)"
5.2850 - by (simp add: diff_def pastecart_neg[symmetric] del: pastecart_neg)
5.2851 -
5.2852 -lemma pastecart_setsum:
5.2853 - fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
5.2854 - assumes fS: "finite S"
5.2855 - shows "pastecart (setsum f S) (setsum g S) = setsum (\<lambda>i. pastecart (f i) (g i)) S"
5.2856 - by (simp add: pastecart_eq fstcart_setsum[OF fS] sndcart_setsum[OF fS] fstcart_pastecart sndcart_pastecart)
5.2857 -
5.2858 -lemma setsum_Plus:
5.2859 - "\<lbrakk>finite A; finite B\<rbrakk> \<Longrightarrow>
5.2860 - (\<Sum>x\<in>A <+> B. g x) = (\<Sum>x\<in>A. g (Inl x)) + (\<Sum>x\<in>B. g (Inr x))"
5.2861 - unfolding Plus_def
5.2862 - by (subst setsum_Un_disjoint, auto simp add: setsum_reindex)
5.2863 -
5.2864 -lemma setsum_UNIV_sum:
5.2865 - fixes g :: "'a::finite + 'b::finite \<Rightarrow> _"
5.2866 - shows "(\<Sum>x\<in>UNIV. g x) = (\<Sum>x\<in>UNIV. g (Inl x)) + (\<Sum>x\<in>UNIV. g (Inr x))"
5.2867 - apply (subst UNIV_Plus_UNIV [symmetric])
5.2868 - apply (rule setsum_Plus [OF finite finite])
5.2869 - done
5.2870 -
5.2871 -lemma norm_fstcart: "norm(fstcart x) <= norm (x::real ^('n::finite + 'm::finite))"
5.2872 -proof-
5.2873 - have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
5.2874 - by (simp add: pastecart_fst_snd)
5.2875 - have th1: "fstcart x \<bullet> fstcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
5.2876 - by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
5.2877 - then show ?thesis
5.2878 - unfolding th0
5.2879 - unfolding real_vector_norm_def real_sqrt_le_iff id_def
5.2880 - by (simp add: dot_def)
5.2881 -qed
5.2882 -
5.2883 -lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y"
5.2884 - unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart)
5.2885 -
5.2886 -lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))"
5.2887 -proof-
5.2888 - have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
5.2889 - by (simp add: pastecart_fst_snd)
5.2890 - have th1: "sndcart x \<bullet> sndcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
5.2891 - by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
5.2892 - then show ?thesis
5.2893 - unfolding th0
5.2894 - unfolding real_vector_norm_def real_sqrt_le_iff id_def
5.2895 - by (simp add: dot_def)
5.2896 -qed
5.2897 -
5.2898 -lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y"
5.2899 - unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart)
5.2900 -
5.2901 -lemma dot_pastecart: "(pastecart (x1::'a::{times,comm_monoid_add}^'n::finite) (x2::'a::{times,comm_monoid_add}^'m::finite)) \<bullet> (pastecart y1 y2) = x1 \<bullet> y1 + x2 \<bullet> y2"
5.2902 - by (simp add: dot_def setsum_UNIV_sum pastecart_def)
5.2903 -
5.2904 -text {* TODO: move to NthRoot *}
5.2905 -lemma sqrt_add_le_add_sqrt:
5.2906 - assumes x: "0 \<le> x" and y: "0 \<le> y"
5.2907 - shows "sqrt (x + y) \<le> sqrt x + sqrt y"
5.2908 -apply (rule power2_le_imp_le)
5.2909 -apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y)
5.2910 -apply (simp add: mult_nonneg_nonneg x y)
5.2911 -apply (simp add: add_nonneg_nonneg x y)
5.2912 -done
5.2913 -
5.2914 -lemma norm_pastecart: "norm (pastecart x y) <= norm x + norm y"
5.2915 - unfolding norm_vector_def setL2_def setsum_UNIV_sum
5.2916 - by (simp add: sqrt_add_le_add_sqrt setsum_nonneg)
5.2917 -
5.2918 -subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *}
5.2919 -
5.2920 -definition hull :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75) where
5.2921 - "S hull s = Inter {t. t \<in> S \<and> s \<subseteq> t}"
5.2922 -
5.2923 -lemma hull_same: "s \<in> S \<Longrightarrow> S hull s = s"
5.2924 - unfolding hull_def by auto
5.2925 -
5.2926 -lemma hull_in: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) \<in> S"
5.2927 -unfolding hull_def subset_iff by auto
5.2928 -
5.2929 -lemma hull_eq: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) = s \<longleftrightarrow> s \<in> S"
5.2930 -using hull_same[of s S] hull_in[of S s] by metis
5.2931 -
5.2932 -
5.2933 -lemma hull_hull: "S hull (S hull s) = S hull s"
5.2934 - unfolding hull_def by blast
5.2935 -
5.2936 -lemma hull_subset: "s \<subseteq> (S hull s)"
5.2937 - unfolding hull_def by blast
5.2938 -
5.2939 -lemma hull_mono: " s \<subseteq> t ==> (S hull s) \<subseteq> (S hull t)"
5.2940 - unfolding hull_def by blast
5.2941 -
5.2942 -lemma hull_antimono: "S \<subseteq> T ==> (T hull s) \<subseteq> (S hull s)"
5.2943 - unfolding hull_def by blast
5.2944 -
5.2945 -lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> t \<in> S ==> (S hull s) \<subseteq> t"
5.2946 - unfolding hull_def by blast
5.2947 -
5.2948 -lemma subset_hull: "t \<in> S ==> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
5.2949 - unfolding hull_def by blast
5.2950 -
5.2951 -lemma hull_unique: "s \<subseteq> t \<Longrightarrow> t \<in> S \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> t' \<in> S ==> t \<subseteq> t')
5.2952 - ==> (S hull s = t)"
5.2953 -unfolding hull_def by auto
5.2954 -
5.2955 -lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x"
5.2956 - using hull_minimal[of S "{x. P x}" Q]
5.2957 - by (auto simp add: subset_eq Collect_def mem_def)
5.2958 -
5.2959 -lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S" by (metis hull_subset subset_eq)
5.2960 -
5.2961 -lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
5.2962 -unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
5.2963 -
5.2964 -lemma hull_union: assumes T: "\<And>T. T \<subseteq> S ==> Inter T \<in> S"
5.2965 - shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
5.2966 -apply rule
5.2967 -apply (rule hull_mono)
5.2968 -unfolding Un_subset_iff
5.2969 -apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
5.2970 -apply (rule hull_minimal)
5.2971 -apply (metis hull_union_subset)
5.2972 -apply (metis hull_in T)
5.2973 -done
5.2974 -
5.2975 -lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> (S hull (insert a s) = S hull s)"
5.2976 - unfolding hull_def by blast
5.2977 -
5.2978 -lemma hull_redundant: "a \<in> (S hull s) ==> (S hull (insert a s) = S hull s)"
5.2979 -by (metis hull_redundant_eq)
5.2980 -
5.2981 -text{* Archimedian properties and useful consequences. *}
5.2982 -
5.2983 -lemma real_arch_simple: "\<exists>n. x <= real (n::nat)"
5.2984 - using reals_Archimedean2[of x] apply auto by (rule_tac x="Suc n" in exI, auto)
5.2985 -lemmas real_arch_lt = reals_Archimedean2
5.2986 -
5.2987 -lemmas real_arch = reals_Archimedean3
5.2988 -
5.2989 -lemma real_arch_inv: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
5.2990 - using reals_Archimedean
5.2991 - apply (auto simp add: field_simps inverse_positive_iff_positive)
5.2992 - apply (subgoal_tac "inverse (real n) > 0")
5.2993 - apply arith
5.2994 - apply simp
5.2995 - done
5.2996 -
5.2997 -lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n"
5.2998 -proof(induct n)
5.2999 - case 0 thus ?case by simp
5.3000 -next
5.3001 - case (Suc n)
5.3002 - hence h: "1 + real n * x \<le> (1 + x) ^ n" by simp
5.3003 - from h have p: "1 \<le> (1 + x) ^ n" using Suc.prems by simp
5.3004 - from h have "1 + real n * x + x \<le> (1 + x) ^ n + x" by simp
5.3005 - also have "\<dots> \<le> (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric])
5.3006 - apply (simp add: ring_simps)
5.3007 - using mult_left_mono[OF p Suc.prems] by simp
5.3008 - finally show ?case by (simp add: real_of_nat_Suc ring_simps)
5.3009 -qed
5.3010 -
5.3011 -lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\<exists>n. y < x^n"
5.3012 -proof-
5.3013 - from x have x0: "x - 1 > 0" by arith
5.3014 - from real_arch[OF x0, rule_format, of y]
5.3015 - obtain n::nat where n:"y < real n * (x - 1)" by metis
5.3016 - from x0 have x00: "x- 1 \<ge> 0" by arith
5.3017 - from real_pow_lbound[OF x00, of n] n
5.3018 - have "y < x^n" by auto
5.3019 - then show ?thesis by metis
5.3020 -qed
5.3021 -
5.3022 -lemma real_arch_pow2: "\<exists>n. (x::real) < 2^ n"
5.3023 - using real_arch_pow[of 2 x] by simp
5.3024 -
5.3025 -lemma real_arch_pow_inv: assumes y: "(y::real) > 0" and x1: "x < 1"
5.3026 - shows "\<exists>n. x^n < y"
5.3027 -proof-
5.3028 - {assume x0: "x > 0"
5.3029 - from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps)
5.3030 - from real_arch_pow[OF ix, of "1/y"]
5.3031 - obtain n where n: "1/y < (1/x)^n" by blast
5.3032 - then
5.3033 - have ?thesis using y x0 by (auto simp add: field_simps power_divide) }
5.3034 - moreover
5.3035 - {assume "\<not> x > 0" with y x1 have ?thesis apply auto by (rule exI[where x=1], auto)}
5.3036 - ultimately show ?thesis by metis
5.3037 -qed
5.3038 -
5.3039 -lemma forall_pos_mono: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n::nat. n \<noteq> 0 ==> P(inverse(real n))) \<Longrightarrow> (\<And>e. 0 < e ==> P e)"
5.3040 - by (metis real_arch_inv)
5.3041 -
5.3042 -lemma forall_pos_mono_1: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n. P(inverse(real (Suc n)))) ==> 0 < e ==> P e"
5.3043 - apply (rule forall_pos_mono)
5.3044 - apply auto
5.3045 - apply (atomize)
5.3046 - apply (erule_tac x="n - 1" in allE)
5.3047 - apply auto
5.3048 - done
5.3049 -
5.3050 -lemma real_archimedian_rdiv_eq_0: assumes x0: "x \<ge> 0" and c: "c \<ge> 0" and xc: "\<forall>(m::nat)>0. real m * x \<le> c"
5.3051 - shows "x = 0"
5.3052 -proof-
5.3053 - {assume "x \<noteq> 0" with x0 have xp: "x > 0" by arith
5.3054 - from real_arch[OF xp, rule_format, of c] obtain n::nat where n: "c < real n * x" by blast
5.3055 - with xc[rule_format, of n] have "n = 0" by arith
5.3056 - with n c have False by simp}
5.3057 - then show ?thesis by blast
5.3058 -qed
5.3059 -
5.3060 -(* ------------------------------------------------------------------------- *)
5.3061 -(* Relate max and min to sup and inf. *)
5.3062 -(* ------------------------------------------------------------------------- *)
5.3063 -
5.3064 -lemma real_max_rsup: "max x y = rsup {x,y}"
5.3065 -proof-
5.3066 - have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
5.3067 - from rsup_finite_le_iff[OF f, of "max x y"] have "rsup {x,y} \<le> max x y" by simp
5.3068 - moreover
5.3069 - have "max x y \<le> rsup {x,y}" using rsup_finite_ge_iff[OF f, of "max x y"]
5.3070 - by (simp add: linorder_linear)
5.3071 - ultimately show ?thesis by arith
5.3072 -qed
5.3073 -
5.3074 -lemma real_min_rinf: "min x y = rinf {x,y}"
5.3075 -proof-
5.3076 - have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
5.3077 - from rinf_finite_le_iff[OF f, of "min x y"] have "rinf {x,y} \<le> min x y"
5.3078 - by (simp add: linorder_linear)
5.3079 - moreover
5.3080 - have "min x y \<le> rinf {x,y}" using rinf_finite_ge_iff[OF f, of "min x y"]
5.3081 - by simp
5.3082 - ultimately show ?thesis by arith
5.3083 -qed
5.3084 -
5.3085 -(* ------------------------------------------------------------------------- *)
5.3086 -(* Geometric progression. *)
5.3087 -(* ------------------------------------------------------------------------- *)
5.3088 -
5.3089 -lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
5.3090 - (is "?lhs = ?rhs")
5.3091 -proof-
5.3092 - {assume x1: "x = 1" hence ?thesis by simp}
5.3093 - moreover
5.3094 - {assume x1: "x\<noteq>1"
5.3095 - hence x1': "x - 1 \<noteq> 0" "1 - x \<noteq> 0" "x - 1 = - (1 - x)" "- (1 - x) \<noteq> 0" by auto
5.3096 - from geometric_sum[OF x1, of "Suc n", unfolded x1']
5.3097 - have "(- (1 - x)) * setsum (\<lambda>i. x^i) {0 .. n} = - (1 - x^(Suc n))"
5.3098 - unfolding atLeastLessThanSuc_atLeastAtMost
5.3099 - using x1' apply (auto simp only: field_simps)
5.3100 - apply (simp add: ring_simps)
5.3101 - done
5.3102 - then have ?thesis by (simp add: ring_simps) }
5.3103 - ultimately show ?thesis by metis
5.3104 -qed
5.3105 -
5.3106 -lemma sum_gp_multiplied: assumes mn: "m <= n"
5.3107 - shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
5.3108 - (is "?lhs = ?rhs")
5.3109 -proof-
5.3110 - let ?S = "{0..(n - m)}"
5.3111 - from mn have mn': "n - m \<ge> 0" by arith
5.3112 - let ?f = "op + m"
5.3113 - have i: "inj_on ?f ?S" unfolding inj_on_def by auto
5.3114 - have f: "?f ` ?S = {m..n}"
5.3115 - using mn apply (auto simp add: image_iff Bex_def) by arith
5.3116 - have th: "op ^ x o op + m = (\<lambda>i. x^m * x^i)"
5.3117 - by (rule ext, simp add: power_add power_mult)
5.3118 - from setsum_reindex[OF i, of "op ^ x", unfolded f th setsum_right_distrib[symmetric]]
5.3119 - have "?lhs = x^m * ((1 - x) * setsum (op ^ x) {0..n - m})" by simp
5.3120 - then show ?thesis unfolding sum_gp_basic using mn
5.3121 - by (simp add: ring_simps power_add[symmetric])
5.3122 -qed
5.3123 -
5.3124 -lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} =
5.3125 - (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m)
5.3126 - else (x^ m - x^ (Suc n)) / (1 - x))"
5.3127 -proof-
5.3128 - {assume nm: "n < m" hence ?thesis by simp}
5.3129 - moreover
5.3130 - {assume "\<not> n < m" hence nm: "m \<le> n" by arith
5.3131 - {assume x: "x = 1" hence ?thesis by simp}
5.3132 - moreover
5.3133 - {assume x: "x \<noteq> 1" hence nz: "1 - x \<noteq> 0" by simp
5.3134 - from sum_gp_multiplied[OF nm, of x] nz have ?thesis by (simp add: field_simps)}
5.3135 - ultimately have ?thesis by metis
5.3136 - }
5.3137 - ultimately show ?thesis by metis
5.3138 -qed
5.3139 -
5.3140 -lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} =
5.3141 - (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
5.3142 - unfolding sum_gp[of x m "m + n"] power_Suc
5.3143 - by (simp add: ring_simps power_add)
5.3144 -
5.3145 -
5.3146 -subsection{* A bit of linear algebra. *}
5.3147 -
5.3148 -definition "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x\<in> S. \<forall>y \<in>S. x + y \<in> S) \<and> (\<forall>c. \<forall>x \<in>S. c *s x \<in>S )"
5.3149 -definition "span S = (subspace hull S)"
5.3150 -definition "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span(S - {a}))"
5.3151 -abbreviation "independent s == ~(dependent s)"
5.3152 -
5.3153 -(* Closure properties of subspaces. *)
5.3154 -
5.3155 -lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def)
5.3156 -
5.3157 -lemma subspace_0: "subspace S ==> 0 \<in> S" by (metis subspace_def)
5.3158 -
5.3159 -lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S ==> x + y \<in> S"
5.3160 - by (metis subspace_def)
5.3161 -
5.3162 -lemma subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
5.3163 - by (metis subspace_def)
5.3164 -
5.3165 -lemma subspace_neg: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> - x \<in> S"
5.3166 - by (metis vector_sneg_minus1 subspace_mul)
5.3167 -
5.3168 -lemma subspace_sub: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
5.3169 - by (metis diff_def subspace_add subspace_neg)
5.3170 -
5.3171 -lemma subspace_setsum:
5.3172 - assumes sA: "subspace A" and fB: "finite B"
5.3173 - and f: "\<forall>x\<in> B. f x \<in> A"
5.3174 - shows "setsum f B \<in> A"
5.3175 - using fB f sA
5.3176 - apply(induct rule: finite_induct[OF fB])
5.3177 - by (simp add: subspace_def sA, auto simp add: sA subspace_add)
5.3178 -
5.3179 -lemma subspace_linear_image:
5.3180 - assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and sS: "subspace S"
5.3181 - shows "subspace(f ` S)"
5.3182 - using lf sS linear_0[OF lf]
5.3183 - unfolding linear_def subspace_def
5.3184 - apply (auto simp add: image_iff)
5.3185 - apply (rule_tac x="x + y" in bexI, auto)
5.3186 - apply (rule_tac x="c*s x" in bexI, auto)
5.3187 - done
5.3188 -
5.3189 -lemma subspace_linear_preimage: "linear (f::'a::semiring_1^'n \<Rightarrow> _) ==> subspace S ==> subspace {x. f x \<in> S}"
5.3190 - by (auto simp add: subspace_def linear_def linear_0[of f])
5.3191 -
5.3192 -lemma subspace_trivial: "subspace {0::'a::semiring_1 ^_}"
5.3193 - by (simp add: subspace_def)
5.3194 -
5.3195 -lemma subspace_inter: "subspace A \<Longrightarrow> subspace B ==> subspace (A \<inter> B)"
5.3196 - by (simp add: subspace_def)
5.3197 -
5.3198 -
5.3199 -lemma span_mono: "A \<subseteq> B ==> span A \<subseteq> span B"
5.3200 - by (metis span_def hull_mono)
5.3201 -
5.3202 -lemma subspace_span: "subspace(span S)"
5.3203 - unfolding span_def
5.3204 - apply (rule hull_in[unfolded mem_def])
5.3205 - apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
5.3206 - apply auto
5.3207 - apply (erule_tac x="X" in ballE)
5.3208 - apply (simp add: mem_def)
5.3209 - apply blast
5.3210 - apply (erule_tac x="X" in ballE)
5.3211 - apply (erule_tac x="X" in ballE)
5.3212 - apply (erule_tac x="X" in ballE)
5.3213 - apply (clarsimp simp add: mem_def)
5.3214 - apply simp
5.3215 - apply simp
5.3216 - apply simp
5.3217 - apply (erule_tac x="X" in ballE)
5.3218 - apply (erule_tac x="X" in ballE)
5.3219 - apply (simp add: mem_def)
5.3220 - apply simp
5.3221 - apply simp
5.3222 - done
5.3223 -
5.3224 -lemma span_clauses:
5.3225 - "a \<in> S ==> a \<in> span S"
5.3226 - "0 \<in> span S"
5.3227 - "x\<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
5.3228 - "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
5.3229 - by (metis span_def hull_subset subset_eq subspace_span subspace_def)+
5.3230 -
5.3231 -lemma span_induct: assumes SP: "\<And>x. x \<in> S ==> P x"
5.3232 - and P: "subspace P" and x: "x \<in> span S" shows "P x"
5.3233 -proof-
5.3234 - from SP have SP': "S \<subseteq> P" by (simp add: mem_def subset_eq)
5.3235 - from P have P': "P \<in> subspace" by (simp add: mem_def)
5.3236 - from x hull_minimal[OF SP' P', unfolded span_def[symmetric]]
5.3237 - show "P x" by (metis mem_def subset_eq)
5.3238 -qed
5.3239 -
5.3240 -lemma span_empty: "span {} = {(0::'a::semiring_0 ^ 'n)}"
5.3241 - apply (simp add: span_def)
5.3242 - apply (rule hull_unique)
5.3243 - apply (auto simp add: mem_def subspace_def)
5.3244 - unfolding mem_def[of "0::'a^'n", symmetric]
5.3245 - apply simp
5.3246 - done
5.3247 -
5.3248 -lemma independent_empty: "independent {}"
5.3249 - by (simp add: dependent_def)
5.3250 -
5.3251 -lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A ==> independent B"
5.3252 - apply (clarsimp simp add: dependent_def span_mono)
5.3253 - apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
5.3254 - apply force
5.3255 - apply (rule span_mono)
5.3256 - apply auto
5.3257 - done
5.3258 -
5.3259 -lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
5.3260 - by (metis order_antisym span_def hull_minimal mem_def)
5.3261 -
5.3262 -lemma span_induct': assumes SP: "\<forall>x \<in> S. P x"
5.3263 - and P: "subspace P" shows "\<forall>x \<in> span S. P x"
5.3264 - using span_induct SP P by blast
5.3265 -
5.3266 -inductive span_induct_alt_help for S:: "'a::semiring_1^'n \<Rightarrow> bool"
5.3267 - where
5.3268 - span_induct_alt_help_0: "span_induct_alt_help S 0"
5.3269 - | span_induct_alt_help_S: "x \<in> S \<Longrightarrow> span_induct_alt_help S z \<Longrightarrow> span_induct_alt_help S (c *s x + z)"
5.3270 -
5.3271 -lemma span_induct_alt':
5.3272 - assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" shows "\<forall>x \<in> span S. h x"
5.3273 -proof-
5.3274 - {fix x:: "'a^'n" assume x: "span_induct_alt_help S x"
5.3275 - have "h x"
5.3276 - apply (rule span_induct_alt_help.induct[OF x])
5.3277 - apply (rule h0)
5.3278 - apply (rule hS, assumption, assumption)
5.3279 - done}
5.3280 - note th0 = this
5.3281 - {fix x assume x: "x \<in> span S"
5.3282 -
5.3283 - have "span_induct_alt_help S x"
5.3284 - proof(rule span_induct[where x=x and S=S])
5.3285 - show "x \<in> span S" using x .
5.3286 - next
5.3287 - fix x assume xS : "x \<in> S"
5.3288 - from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
5.3289 - show "span_induct_alt_help S x" by simp
5.3290 - next
5.3291 - have "span_induct_alt_help S 0" by (rule span_induct_alt_help_0)
5.3292 - moreover
5.3293 - {fix x y assume h: "span_induct_alt_help S x" "span_induct_alt_help S y"
5.3294 - from h
5.3295 - have "span_induct_alt_help S (x + y)"
5.3296 - apply (induct rule: span_induct_alt_help.induct)
5.3297 - apply simp
5.3298 - unfolding add_assoc
5.3299 - apply (rule span_induct_alt_help_S)
5.3300 - apply assumption
5.3301 - apply simp
5.3302 - done}
5.3303 - moreover
5.3304 - {fix c x assume xt: "span_induct_alt_help S x"
5.3305 - then have "span_induct_alt_help S (c*s x)"
5.3306 - apply (induct rule: span_induct_alt_help.induct)
5.3307 - apply (simp add: span_induct_alt_help_0)
5.3308 - apply (simp add: vector_smult_assoc vector_add_ldistrib)
5.3309 - apply (rule span_induct_alt_help_S)
5.3310 - apply assumption
5.3311 - apply simp
5.3312 - done
5.3313 - }
5.3314 - ultimately show "subspace (span_induct_alt_help S)"
5.3315 - unfolding subspace_def mem_def Ball_def by blast
5.3316 - qed}
5.3317 - with th0 show ?thesis by blast
5.3318 -qed
5.3319 -
5.3320 -lemma span_induct_alt:
5.3321 - assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" and x: "x \<in> span S"
5.3322 - shows "h x"
5.3323 -using span_induct_alt'[of h S] h0 hS x by blast
5.3324 -
5.3325 -(* Individual closure properties. *)
5.3326 -
5.3327 -lemma span_superset: "x \<in> S ==> x \<in> span S" by (metis span_clauses)
5.3328 -
5.3329 -lemma span_0: "0 \<in> span S" by (metis subspace_span subspace_0)
5.3330 -
5.3331 -lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
5.3332 - by (metis subspace_add subspace_span)
5.3333 -
5.3334 -lemma span_mul: "x \<in> span S ==> (c *s x) \<in> span S"
5.3335 - by (metis subspace_span subspace_mul)
5.3336 -
5.3337 -lemma span_neg: "x \<in> span S ==> - (x::'a::ring_1^'n) \<in> span S"
5.3338 - by (metis subspace_neg subspace_span)
5.3339 -
5.3340 -lemma span_sub: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> y \<in> span S ==> x - y \<in> span S"
5.3341 - by (metis subspace_span subspace_sub)
5.3342 -
5.3343 -lemma span_setsum: "finite A \<Longrightarrow> \<forall>x \<in> A. f x \<in> span S ==> setsum f A \<in> span S"
5.3344 - apply (rule subspace_setsum)
5.3345 - by (metis subspace_span subspace_setsum)+
5.3346 -
5.3347 -lemma span_add_eq: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
5.3348 - apply (auto simp only: span_add span_sub)
5.3349 - apply (subgoal_tac "(x + y) - x \<in> span S", simp)
5.3350 - by (simp only: span_add span_sub)
5.3351 -
5.3352 -(* Mapping under linear image. *)
5.3353 -
5.3354 -lemma span_linear_image: assumes lf: "linear (f::'a::semiring_1 ^ 'n => _)"
5.3355 - shows "span (f ` S) = f ` (span S)"
5.3356 -proof-
5.3357 - {fix x
5.3358 - assume x: "x \<in> span (f ` S)"
5.3359 - have "x \<in> f ` span S"
5.3360 - apply (rule span_induct[where x=x and S = "f ` S"])
5.3361 - apply (clarsimp simp add: image_iff)
5.3362 - apply (frule span_superset)
5.3363 - apply blast
5.3364 - apply (simp only: mem_def)
5.3365 - apply (rule subspace_linear_image[OF lf])
5.3366 - apply (rule subspace_span)
5.3367 - apply (rule x)
5.3368 - done}
5.3369 - moreover
5.3370 - {fix x assume x: "x \<in> span S"
5.3371 - have th0:"(\<lambda>a. f a \<in> span (f ` S)) = {x. f x \<in> span (f ` S)}" apply (rule set_ext)
5.3372 - unfolding mem_def Collect_def ..
5.3373 - have "f x \<in> span (f ` S)"
5.3374 - apply (rule span_induct[where S=S])
5.3375 - apply (rule span_superset)
5.3376 - apply simp
5.3377 - apply (subst th0)
5.3378 - apply (rule subspace_linear_preimage[OF lf subspace_span, of "f ` S"])
5.3379 - apply (rule x)
5.3380 - done}
5.3381 - ultimately show ?thesis by blast
5.3382 -qed
5.3383 -
5.3384 -(* The key breakdown property. *)
5.3385 -
5.3386 -lemma span_breakdown:
5.3387 - assumes bS: "(b::'a::ring_1 ^ 'n) \<in> S" and aS: "a \<in> span S"
5.3388 - shows "\<exists>k. a - k*s b \<in> span (S - {b})" (is "?P a")
5.3389 -proof-
5.3390 - {fix x assume xS: "x \<in> S"
5.3391 - {assume ab: "x = b"
5.3392 - then have "?P x"
5.3393 - apply simp
5.3394 - apply (rule exI[where x="1"], simp)
5.3395 - by (rule span_0)}
5.3396 - moreover
5.3397 - {assume ab: "x \<noteq> b"
5.3398 - then have "?P x" using xS
5.3399 - apply -
5.3400 - apply (rule exI[where x=0])
5.3401 - apply (rule span_superset)
5.3402 - by simp}
5.3403 - ultimately have "?P x" by blast}
5.3404 - moreover have "subspace ?P"
5.3405 - unfolding subspace_def
5.3406 - apply auto
5.3407 - apply (simp add: mem_def)
5.3408 - apply (rule exI[where x=0])
5.3409 - using span_0[of "S - {b}"]
5.3410 - apply (simp add: mem_def)
5.3411 - apply (clarsimp simp add: mem_def)
5.3412 - apply (rule_tac x="k + ka" in exI)
5.3413 - apply (subgoal_tac "x + y - (k + ka) *s b = (x - k*s b) + (y - ka *s b)")
5.3414 - apply (simp only: )
5.3415 - apply (rule span_add[unfolded mem_def])
5.3416 - apply assumption+
5.3417 - apply (vector ring_simps)
5.3418 - apply (clarsimp simp add: mem_def)
5.3419 - apply (rule_tac x= "c*k" in exI)
5.3420 - apply (subgoal_tac "c *s x - (c * k) *s b = c*s (x - k*s b)")
5.3421 - apply (simp only: )
5.3422 - apply (rule span_mul[unfolded mem_def])
5.3423 - apply assumption
5.3424 - by (vector ring_simps)
5.3425 - ultimately show "?P a" using aS span_induct[where S=S and P= "?P"] by metis
5.3426 -qed
5.3427 -
5.3428 -lemma span_breakdown_eq:
5.3429 - "(x::'a::ring_1^'n) \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. (x - k *s a) \<in> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
5.3430 -proof-
5.3431 - {assume x: "x \<in> span (insert a S)"
5.3432 - from x span_breakdown[of "a" "insert a S" "x"]
5.3433 - have ?rhs apply clarsimp
5.3434 - apply (rule_tac x= "k" in exI)
5.3435 - apply (rule set_rev_mp[of _ "span (S - {a})" _])
5.3436 - apply assumption
5.3437 - apply (rule span_mono)
5.3438 - apply blast
5.3439 - done}
5.3440 - moreover
5.3441 - { fix k assume k: "x - k *s a \<in> span S"
5.3442 - have eq: "x = (x - k *s a) + k *s a" by vector
5.3443 - have "(x - k *s a) + k *s a \<in> span (insert a S)"
5.3444 - apply (rule span_add)
5.3445 - apply (rule set_rev_mp[of _ "span S" _])
5.3446 - apply (rule k)
5.3447 - apply (rule span_mono)
5.3448 - apply blast
5.3449 - apply (rule span_mul)
5.3450 - apply (rule span_superset)
5.3451 - apply blast
5.3452 - done
5.3453 - then have ?lhs using eq by metis}
5.3454 - ultimately show ?thesis by blast
5.3455 -qed
5.3456 -
5.3457 -(* Hence some "reversal" results.*)
5.3458 -
5.3459 -lemma in_span_insert:
5.3460 - assumes a: "(a::'a::field^'n) \<in> span (insert b S)" and na: "a \<notin> span S"
5.3461 - shows "b \<in> span (insert a S)"
5.3462 -proof-
5.3463 - from span_breakdown[of b "insert b S" a, OF insertI1 a]
5.3464 - obtain k where k: "a - k*s b \<in> span (S - {b})" by auto
5.3465 - {assume k0: "k = 0"
5.3466 - with k have "a \<in> span S"
5.3467 - apply (simp)
5.3468 - apply (rule set_rev_mp)
5.3469 - apply assumption
5.3470 - apply (rule span_mono)
5.3471 - apply blast
5.3472 - done
5.3473 - with na have ?thesis by blast}
5.3474 - moreover
5.3475 - {assume k0: "k \<noteq> 0"
5.3476 - have eq: "b = (1/k) *s a - ((1/k) *s a - b)" by vector
5.3477 - from k0 have eq': "(1/k) *s (a - k*s b) = (1/k) *s a - b"
5.3478 - by (vector field_simps)
5.3479 - from k have "(1/k) *s (a - k*s b) \<in> span (S - {b})"
5.3480 - by (rule span_mul)
5.3481 - hence th: "(1/k) *s a - b \<in> span (S - {b})"
5.3482 - unfolding eq' .
5.3483 -
5.3484 - from k
5.3485 - have ?thesis
5.3486 - apply (subst eq)
5.3487 - apply (rule span_sub)
5.3488 - apply (rule span_mul)
5.3489 - apply (rule span_superset)
5.3490 - apply blast
5.3491 - apply (rule set_rev_mp)
5.3492 - apply (rule th)
5.3493 - apply (rule span_mono)
5.3494 - using na by blast}
5.3495 - ultimately show ?thesis by blast
5.3496 -qed
5.3497 -
5.3498 -lemma in_span_delete:
5.3499 - assumes a: "(a::'a::field^'n) \<in> span S"
5.3500 - and na: "a \<notin> span (S-{b})"
5.3501 - shows "b \<in> span (insert a (S - {b}))"
5.3502 - apply (rule in_span_insert)
5.3503 - apply (rule set_rev_mp)
5.3504 - apply (rule a)
5.3505 - apply (rule span_mono)
5.3506 - apply blast
5.3507 - apply (rule na)
5.3508 - done
5.3509 -
5.3510 -(* Transitivity property. *)
5.3511 -
5.3512 -lemma span_trans:
5.3513 - assumes x: "(x::'a::ring_1^'n) \<in> span S" and y: "y \<in> span (insert x S)"
5.3514 - shows "y \<in> span S"
5.3515 -proof-
5.3516 - from span_breakdown[of x "insert x S" y, OF insertI1 y]
5.3517 - obtain k where k: "y -k*s x \<in> span (S - {x})" by auto
5.3518 - have eq: "y = (y - k *s x) + k *s x" by vector
5.3519 - show ?thesis
5.3520 - apply (subst eq)
5.3521 - apply (rule span_add)
5.3522 - apply (rule set_rev_mp)
5.3523 - apply (rule k)
5.3524 - apply (rule span_mono)
5.3525 - apply blast
5.3526 - apply (rule span_mul)
5.3527 - by (rule x)
5.3528 -qed
5.3529 -
5.3530 -(* ------------------------------------------------------------------------- *)
5.3531 -(* An explicit expansion is sometimes needed. *)
5.3532 -(* ------------------------------------------------------------------------- *)
5.3533 -
5.3534 -lemma span_explicit:
5.3535 - "span P = {y::'a::semiring_1^'n. \<exists>S u. finite S \<and> S \<subseteq> P \<and> setsum (\<lambda>v. u v *s v) S = y}"
5.3536 - (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
5.3537 -proof-
5.3538 - {fix x assume x: "x \<in> ?E"
5.3539 - then obtain S u where fS: "finite S" and SP: "S\<subseteq>P" and u: "setsum (\<lambda>v. u v *s v) S = x"
5.3540 - by blast
5.3541 - have "x \<in> span P"
5.3542 - unfolding u[symmetric]
5.3543 - apply (rule span_setsum[OF fS])
5.3544 - using span_mono[OF SP]
5.3545 - by (auto intro: span_superset span_mul)}
5.3546 - moreover
5.3547 - have "\<forall>x \<in> span P. x \<in> ?E"
5.3548 - unfolding mem_def Collect_def
5.3549 - proof(rule span_induct_alt')
5.3550 - show "?h 0"
5.3551 - apply (rule exI[where x="{}"]) by simp
5.3552 - next
5.3553 - fix c x y
5.3554 - assume x: "x \<in> P" and hy: "?h y"
5.3555 - from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
5.3556 - and u: "setsum (\<lambda>v. u v *s v) S = y" by blast
5.3557 - let ?S = "insert x S"
5.3558 - let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c)
5.3559 - else u y"
5.3560 - from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P" by blast+
5.3561 - {assume xS: "x \<in> S"
5.3562 - have S1: "S = (S - {x}) \<union> {x}"
5.3563 - and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \<inter> {x} = {}" using xS fS by auto
5.3564 - have "setsum (\<lambda>v. ?u v *s v) ?S =(\<Sum>v\<in>S - {x}. u v *s v) + (u x + c) *s x"
5.3565 - using xS
5.3566 - by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]]
5.3567 - setsum_clauses(2)[OF fS] cong del: if_weak_cong)
5.3568 - also have "\<dots> = (\<Sum>v\<in>S. u v *s v) + c *s x"
5.3569 - apply (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]])
5.3570 - by (vector ring_simps)
5.3571 - also have "\<dots> = c*s x + y"
5.3572 - by (simp add: add_commute u)
5.3573 - finally have "setsum (\<lambda>v. ?u v *s v) ?S = c*s x + y" .
5.3574 - then have "?Q ?S ?u (c*s x + y)" using th0 by blast}
5.3575 - moreover
5.3576 - {assume xS: "x \<notin> S"
5.3577 - have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *s v) = y"
5.3578 - unfolding u[symmetric]
5.3579 - apply (rule setsum_cong2)
5.3580 - using xS by auto
5.3581 - have "?Q ?S ?u (c*s x + y)" using fS xS th0
5.3582 - by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong)}
5.3583 - ultimately have "?Q ?S ?u (c*s x + y)"
5.3584 - by (cases "x \<in> S", simp, simp)
5.3585 - then show "?h (c*s x + y)"
5.3586 - apply -
5.3587 - apply (rule exI[where x="?S"])
5.3588 - apply (rule exI[where x="?u"]) by metis
5.3589 - qed
5.3590 - ultimately show ?thesis by blast
5.3591 -qed
5.3592 -
5.3593 -lemma dependent_explicit:
5.3594 - "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>(v::'a::{idom,field}^'n) \<in>S. u v \<noteq> 0 \<and> setsum (\<lambda>v. u v *s v) S = 0))" (is "?lhs = ?rhs")
5.3595 -proof-
5.3596 - {assume dP: "dependent P"
5.3597 - then obtain a S u where aP: "a \<in> P" and fS: "finite S"
5.3598 - and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *s v) S = a"
5.3599 - unfolding dependent_def span_explicit by blast
5.3600 - let ?S = "insert a S"
5.3601 - let ?u = "\<lambda>y. if y = a then - 1 else u y"
5.3602 - let ?v = a
5.3603 - from aP SP have aS: "a \<notin> S" by blast
5.3604 - from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0" by auto
5.3605 - have s0: "setsum (\<lambda>v. ?u v *s v) ?S = 0"
5.3606 - using fS aS
5.3607 - apply (simp add: vector_smult_lneg vector_smult_lid setsum_clauses ring_simps )
5.3608 - apply (subst (2) ua[symmetric])
5.3609 - apply (rule setsum_cong2)
5.3610 - by auto
5.3611 - with th0 have ?rhs
5.3612 - apply -
5.3613 - apply (rule exI[where x= "?S"])
5.3614 - apply (rule exI[where x= "?u"])
5.3615 - by clarsimp}
5.3616 - moreover
5.3617 - {fix S u v assume fS: "finite S"
5.3618 - and SP: "S \<subseteq> P" and vS: "v \<in> S" and uv: "u v \<noteq> 0"
5.3619 - and u: "setsum (\<lambda>v. u v *s v) S = 0"
5.3620 - let ?a = v
5.3621 - let ?S = "S - {v}"
5.3622 - let ?u = "\<lambda>i. (- u i) / u v"
5.3623 - have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P" using fS SP vS by auto
5.3624 - have "setsum (\<lambda>v. ?u v *s v) ?S = setsum (\<lambda>v. (- (inverse (u ?a))) *s (u v *s v)) S - ?u v *s v"
5.3625 - using fS vS uv
5.3626 - by (simp add: setsum_diff1 vector_smult_lneg divide_inverse
5.3627 - vector_smult_assoc field_simps)
5.3628 - also have "\<dots> = ?a"
5.3629 - unfolding setsum_cmul u
5.3630 - using uv by (simp add: vector_smult_lneg)
5.3631 - finally have "setsum (\<lambda>v. ?u v *s v) ?S = ?a" .
5.3632 - with th0 have ?lhs
5.3633 - unfolding dependent_def span_explicit
5.3634 - apply -
5.3635 - apply (rule bexI[where x= "?a"])
5.3636 - apply simp_all
5.3637 - apply (rule exI[where x= "?S"])
5.3638 - by auto}
5.3639 - ultimately show ?thesis by blast
5.3640 -qed
5.3641 -
5.3642 -
5.3643 -lemma span_finite:
5.3644 - assumes fS: "finite S"
5.3645 - shows "span S = {(y::'a::semiring_1^'n). \<exists>u. setsum (\<lambda>v. u v *s v) S = y}"
5.3646 - (is "_ = ?rhs")
5.3647 -proof-
5.3648 - {fix y assume y: "y \<in> span S"
5.3649 - from y obtain S' u where fS': "finite S'" and SS': "S' \<subseteq> S" and
5.3650 - u: "setsum (\<lambda>v. u v *s v) S' = y" unfolding span_explicit by blast
5.3651 - let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
5.3652 - from setsum_restrict_set[OF fS, of "\<lambda>v. u v *s v" S', symmetric] SS'
5.3653 - have "setsum (\<lambda>v. ?u v *s v) S = setsum (\<lambda>v. u v *s v) S'"
5.3654 - unfolding cond_value_iff cond_application_beta
5.3655 - by (simp add: cond_value_iff inf_absorb2 cong del: if_weak_cong)
5.3656 - hence "setsum (\<lambda>v. ?u v *s v) S = y" by (metis u)
5.3657 - hence "y \<in> ?rhs" by auto}
5.3658 - moreover
5.3659 - {fix y u assume u: "setsum (\<lambda>v. u v *s v) S = y"
5.3660 - then have "y \<in> span S" using fS unfolding span_explicit by auto}
5.3661 - ultimately show ?thesis by blast
5.3662 -qed
5.3663 -
5.3664 -
5.3665 -(* Standard bases are a spanning set, and obviously finite. *)
5.3666 -
5.3667 -lemma span_stdbasis:"span {basis i :: 'a::ring_1^'n::finite | i. i \<in> (UNIV :: 'n set)} = UNIV"
5.3668 -apply (rule set_ext)
5.3669 -apply auto
5.3670 -apply (subst basis_expansion[symmetric])
5.3671 -apply (rule span_setsum)
5.3672 -apply simp
5.3673 -apply auto
5.3674 -apply (rule span_mul)
5.3675 -apply (rule span_superset)
5.3676 -apply (auto simp add: Collect_def mem_def)
5.3677 -done
5.3678 -
5.3679 -lemma has_size_stdbasis: "{basis i ::real ^'n::finite | i. i \<in> (UNIV :: 'n set)} hassize CARD('n)" (is "?S hassize ?n")
5.3680 -proof-
5.3681 - have eq: "?S = basis ` UNIV" by blast
5.3682 - show ?thesis unfolding eq
5.3683 - apply (rule hassize_image_inj[OF basis_inj])
5.3684 - by (simp add: hassize_def)
5.3685 -qed
5.3686 -
5.3687 -lemma finite_stdbasis: "finite {basis i ::real^'n::finite |i. i\<in> (UNIV:: 'n set)}"
5.3688 - using has_size_stdbasis[unfolded hassize_def]
5.3689 - ..
5.3690 -
5.3691 -lemma card_stdbasis: "card {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)} = CARD('n)"
5.3692 - using has_size_stdbasis[unfolded hassize_def]
5.3693 - ..
5.3694 -
5.3695 -lemma independent_stdbasis_lemma:
5.3696 - assumes x: "(x::'a::semiring_1 ^ 'n) \<in> span (basis ` S)"
5.3697 - and iS: "i \<notin> S"
5.3698 - shows "(x$i) = 0"
5.3699 -proof-
5.3700 - let ?U = "UNIV :: 'n set"
5.3701 - let ?B = "basis ` S"
5.3702 - let ?P = "\<lambda>(x::'a^'n). \<forall>i\<in> ?U. i \<notin> S \<longrightarrow> x$i =0"
5.3703 - {fix x::"'a^'n" assume xS: "x\<in> ?B"
5.3704 - from xS have "?P x" by auto}
5.3705 - moreover
5.3706 - have "subspace ?P"
5.3707 - by (auto simp add: subspace_def Collect_def mem_def)
5.3708 - ultimately show ?thesis
5.3709 - using x span_induct[of ?B ?P x] iS by blast
5.3710 -qed
5.3711 -
5.3712 -lemma independent_stdbasis: "independent {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)}"
5.3713 -proof-
5.3714 - let ?I = "UNIV :: 'n set"
5.3715 - let ?b = "basis :: _ \<Rightarrow> real ^'n"
5.3716 - let ?B = "?b ` ?I"
5.3717 - have eq: "{?b i|i. i \<in> ?I} = ?B"
5.3718 - by auto
5.3719 - {assume d: "dependent ?B"
5.3720 - then obtain k where k: "k \<in> ?I" "?b k \<in> span (?B - {?b k})"
5.3721 - unfolding dependent_def by auto
5.3722 - have eq1: "?B - {?b k} = ?B - ?b ` {k}" by simp
5.3723 - have eq2: "?B - {?b k} = ?b ` (?I - {k})"
5.3724 - unfolding eq1
5.3725 - apply (rule inj_on_image_set_diff[symmetric])
5.3726 - apply (rule basis_inj) using k(1) by auto
5.3727 - from k(2) have th0: "?b k \<in> span (?b ` (?I - {k}))" unfolding eq2 .
5.3728 - from independent_stdbasis_lemma[OF th0, of k, simplified]
5.3729 - have False by simp}
5.3730 - then show ?thesis unfolding eq dependent_def ..
5.3731 -qed
5.3732 -
5.3733 -(* This is useful for building a basis step-by-step. *)
5.3734 -
5.3735 -lemma independent_insert:
5.3736 - "independent(insert (a::'a::field ^'n) S) \<longleftrightarrow>
5.3737 - (if a \<in> S then independent S
5.3738 - else independent S \<and> a \<notin> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
5.3739 -proof-
5.3740 - {assume aS: "a \<in> S"
5.3741 - hence ?thesis using insert_absorb[OF aS] by simp}
5.3742 - moreover
5.3743 - {assume aS: "a \<notin> S"
5.3744 - {assume i: ?lhs
5.3745 - then have ?rhs using aS
5.3746 - apply simp
5.3747 - apply (rule conjI)
5.3748 - apply (rule independent_mono)
5.3749 - apply assumption
5.3750 - apply blast
5.3751 - by (simp add: dependent_def)}
5.3752 - moreover
5.3753 - {assume i: ?rhs
5.3754 - have ?lhs using i aS
5.3755 - apply simp
5.3756 - apply (auto simp add: dependent_def)
5.3757 - apply (case_tac "aa = a", auto)
5.3758 - apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})")
5.3759 - apply simp
5.3760 - apply (subgoal_tac "a \<in> span (insert aa (S - {aa}))")
5.3761 - apply (subgoal_tac "insert aa (S - {aa}) = S")
5.3762 - apply simp
5.3763 - apply blast
5.3764 - apply (rule in_span_insert)
5.3765 - apply assumption
5.3766 - apply blast
5.3767 - apply blast
5.3768 - done}
5.3769 - ultimately have ?thesis by blast}
5.3770 - ultimately show ?thesis by blast
5.3771 -qed
5.3772 -
5.3773 -(* The degenerate case of the Exchange Lemma. *)
5.3774 -
5.3775 -lemma mem_delete: "x \<in> (A - {a}) \<longleftrightarrow> x \<noteq> a \<and> x \<in> A"
5.3776 - by blast
5.3777 -
5.3778 -lemma span_span: "span (span A) = span A"
5.3779 - unfolding span_def hull_hull ..
5.3780 -
5.3781 -lemma span_inc: "S \<subseteq> span S"
5.3782 - by (metis subset_eq span_superset)
5.3783 -
5.3784 -lemma spanning_subset_independent:
5.3785 - assumes BA: "B \<subseteq> A" and iA: "independent (A::('a::field ^'n) set)"
5.3786 - and AsB: "A \<subseteq> span B"
5.3787 - shows "A = B"
5.3788 -proof
5.3789 - from BA show "B \<subseteq> A" .
5.3790 -next
5.3791 - from span_mono[OF BA] span_mono[OF AsB]
5.3792 - have sAB: "span A = span B" unfolding span_span by blast
5.3793 -
5.3794 - {fix x assume x: "x \<in> A"
5.3795 - from iA have th0: "x \<notin> span (A - {x})"
5.3796 - unfolding dependent_def using x by blast
5.3797 - from x have xsA: "x \<in> span A" by (blast intro: span_superset)
5.3798 - have "A - {x} \<subseteq> A" by blast
5.3799 - hence th1:"span (A - {x}) \<subseteq> span A" by (metis span_mono)
5.3800 - {assume xB: "x \<notin> B"
5.3801 - from xB BA have "B \<subseteq> A -{x}" by blast
5.3802 - hence "span B \<subseteq> span (A - {x})" by (metis span_mono)
5.3803 - with th1 th0 sAB have "x \<notin> span A" by blast
5.3804 - with x have False by (metis span_superset)}
5.3805 - then have "x \<in> B" by blast}
5.3806 - then show "A \<subseteq> B" by blast
5.3807 -qed
5.3808 -
5.3809 -(* The general case of the Exchange Lemma, the key to what follows. *)
5.3810 -
5.3811 -lemma exchange_lemma:
5.3812 - assumes f:"finite (t:: ('a::field^'n) set)" and i: "independent s"
5.3813 - and sp:"s \<subseteq> span t"
5.3814 - shows "\<exists>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
5.3815 -using f i sp
5.3816 -proof(induct c\<equiv>"card(t - s)" arbitrary: s t rule: nat_less_induct)
5.3817 - fix n:: nat and s t :: "('a ^'n) set"
5.3818 - assume H: " \<forall>m<n. \<forall>(x:: ('a ^'n) set) xa.
5.3819 - finite xa \<longrightarrow>
5.3820 - independent x \<longrightarrow>
5.3821 - x \<subseteq> span xa \<longrightarrow>
5.3822 - m = card (xa - x) \<longrightarrow>
5.3823 - (\<exists>t'. (t' hassize card xa) \<and>
5.3824 - x \<subseteq> t' \<and> t' \<subseteq> x \<union> xa \<and> x \<subseteq> span t')"
5.3825 - and ft: "finite t" and s: "independent s" and sp: "s \<subseteq> span t"
5.3826 - and n: "n = card (t - s)"
5.3827 - let ?P = "\<lambda>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
5.3828 - let ?ths = "\<exists>t'. ?P t'"
5.3829 - {assume st: "s \<subseteq> t"
5.3830 - from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
5.3831 - by (auto simp add: hassize_def intro: span_superset)}
5.3832 - moreover
5.3833 - {assume st: "t \<subseteq> s"
5.3834 -
5.3835 - from spanning_subset_independent[OF st s sp]
5.3836 - st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
5.3837 - by (auto simp add: hassize_def intro: span_superset)}
5.3838 - moreover
5.3839 - {assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
5.3840 - from st(2) obtain b where b: "b \<in> t" "b \<notin> s" by blast
5.3841 - from b have "t - {b} - s \<subset> t - s" by blast
5.3842 - then have cardlt: "card (t - {b} - s) < n" using n ft
5.3843 - by (auto intro: psubset_card_mono)
5.3844 - from b ft have ct0: "card t \<noteq> 0" by auto
5.3845 - {assume stb: "s \<subseteq> span(t -{b})"
5.3846 - from ft have ftb: "finite (t -{b})" by auto
5.3847 - from H[rule_format, OF cardlt ftb s stb]
5.3848 - obtain u where u: "u hassize card (t-{b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u" by blast
5.3849 - let ?w = "insert b u"
5.3850 - have th0: "s \<subseteq> insert b u" using u by blast
5.3851 - from u(3) b have "u \<subseteq> s \<union> t" by blast
5.3852 - then have th1: "insert b u \<subseteq> s \<union> t" using u b by blast
5.3853 - have bu: "b \<notin> u" using b u by blast
5.3854 - from u(1) have fu: "finite u" by (simp add: hassize_def)
5.3855 - from u(1) ft b have "u hassize (card t - 1)" by auto
5.3856 - then
5.3857 - have th2: "insert b u hassize card t"
5.3858 - using card_insert_disjoint[OF fu bu] ct0 by (auto simp add: hassize_def)
5.3859 - from u(4) have "s \<subseteq> span u" .
5.3860 - also have "\<dots> \<subseteq> span (insert b u)" apply (rule span_mono) by blast
5.3861 - finally have th3: "s \<subseteq> span (insert b u)" . from th0 th1 th2 th3 have th: "?P ?w" by blast
5.3862 - from th have ?ths by blast}
5.3863 - moreover
5.3864 - {assume stb: "\<not> s \<subseteq> span(t -{b})"
5.3865 - from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})" by blast
5.3866 - have ab: "a \<noteq> b" using a b by blast
5.3867 - have at: "a \<notin> t" using a ab span_superset[of a "t- {b}"] by auto
5.3868 - have mlt: "card ((insert a (t - {b})) - s) < n"
5.3869 - using cardlt ft n a b by auto
5.3870 - have ft': "finite (insert a (t - {b}))" using ft by auto
5.3871 - {fix x assume xs: "x \<in> s"
5.3872 - have t: "t \<subseteq> (insert b (insert a (t -{b})))" using b by auto
5.3873 - from b(1) have "b \<in> span t" by (simp add: span_superset)
5.3874 - have bs: "b \<in> span (insert a (t - {b}))"
5.3875 - by (metis in_span_delete a sp mem_def subset_eq)
5.3876 - from xs sp have "x \<in> span t" by blast
5.3877 - with span_mono[OF t]
5.3878 - have x: "x \<in> span (insert b (insert a (t - {b})))" ..
5.3879 - from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .}
5.3880 - then have sp': "s \<subseteq> span (insert a (t - {b}))" by blast
5.3881 -
5.3882 - from H[rule_format, OF mlt ft' s sp' refl] obtain u where
5.3883 - u: "u hassize card (insert a (t -{b}))" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t -{b})"
5.3884 - "s \<subseteq> span u" by blast
5.3885 - from u a b ft at ct0 have "?P u" by (auto simp add: hassize_def)
5.3886 - then have ?ths by blast }
5.3887 - ultimately have ?ths by blast
5.3888 - }
5.3889 - ultimately
5.3890 - show ?ths by blast
5.3891 -qed
5.3892 -
5.3893 -(* This implies corresponding size bounds. *)
5.3894 -
5.3895 -lemma independent_span_bound:
5.3896 - assumes f: "finite t" and i: "independent (s::('a::field^'n) set)" and sp:"s \<subseteq> span t"
5.3897 - shows "finite s \<and> card s \<le> card t"
5.3898 - by (metis exchange_lemma[OF f i sp] hassize_def finite_subset card_mono)
5.3899 -
5.3900 -
5.3901 -lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
5.3902 -proof-
5.3903 - have eq: "{f x |x. x\<in> UNIV} = f ` UNIV" by auto
5.3904 - show ?thesis unfolding eq
5.3905 - apply (rule finite_imageI)
5.3906 - apply (rule finite)
5.3907 - done
5.3908 -qed
5.3909 -
5.3910 -
5.3911 -lemma independent_bound:
5.3912 - fixes S:: "(real^'n::finite) set"
5.3913 - shows "independent S \<Longrightarrow> finite S \<and> card S <= CARD('n)"
5.3914 - apply (subst card_stdbasis[symmetric])
5.3915 - apply (rule independent_span_bound)
5.3916 - apply (rule finite_Atleast_Atmost_nat)
5.3917 - apply assumption
5.3918 - unfolding span_stdbasis
5.3919 - apply (rule subset_UNIV)
5.3920 - done
5.3921 -
5.3922 -lemma dependent_biggerset: "(finite (S::(real ^'n::finite) set) ==> card S > CARD('n)) ==> dependent S"
5.3923 - by (metis independent_bound not_less)
5.3924 -
5.3925 -(* Hence we can create a maximal independent subset. *)
5.3926 -
5.3927 -lemma maximal_independent_subset_extend:
5.3928 - assumes sv: "(S::(real^'n::finite) set) \<subseteq> V" and iS: "independent S"
5.3929 - shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
5.3930 - using sv iS
5.3931 -proof(induct d\<equiv> "CARD('n) - card S" arbitrary: S rule: nat_less_induct)
5.3932 - fix n and S:: "(real^'n) set"
5.3933 - assume H: "\<forall>m<n. \<forall>S \<subseteq> V. independent S \<longrightarrow> m = CARD('n) - card S \<longrightarrow>
5.3934 - (\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B)"
5.3935 - and sv: "S \<subseteq> V" and i: "independent S" and n: "n = CARD('n) - card S"
5.3936 - let ?P = "\<lambda>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
5.3937 - let ?ths = "\<exists>x. ?P x"
5.3938 - let ?d = "CARD('n)"
5.3939 - {assume "V \<subseteq> span S"
5.3940 - then have ?ths using sv i by blast }
5.3941 - moreover
5.3942 - {assume VS: "\<not> V \<subseteq> span S"
5.3943 - from VS obtain a where a: "a \<in> V" "a \<notin> span S" by blast
5.3944 - from a have aS: "a \<notin> S" by (auto simp add: span_superset)
5.3945 - have th0: "insert a S \<subseteq> V" using a sv by blast
5.3946 - from independent_insert[of a S] i a
5.3947 - have th1: "independent (insert a S)" by auto
5.3948 - have mlt: "?d - card (insert a S) < n"
5.3949 - using aS a n independent_bound[OF th1]
5.3950 - by auto
5.3951 -
5.3952 - from H[rule_format, OF mlt th0 th1 refl]
5.3953 - obtain B where B: "insert a S \<subseteq> B" "B \<subseteq> V" "independent B" " V \<subseteq> span B"
5.3954 - by blast
5.3955 - from B have "?P B" by auto
5.3956 - then have ?ths by blast}
5.3957 - ultimately show ?ths by blast
5.3958 -qed
5.3959 -
5.3960 -lemma maximal_independent_subset:
5.3961 - "\<exists>(B:: (real ^'n::finite) set). B\<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
5.3962 - by (metis maximal_independent_subset_extend[of "{}:: (real ^'n) set"] empty_subsetI independent_empty)
5.3963 -
5.3964 -(* Notion of dimension. *)
5.3965 -
5.3966 -definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n))"
5.3967 -
5.3968 -lemma basis_exists: "\<exists>B. (B :: (real ^'n::finite) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize dim V)"
5.3969 -unfolding dim_def some_eq_ex[of "\<lambda>n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n)"]
5.3970 -unfolding hassize_def
5.3971 -using maximal_independent_subset[of V] independent_bound
5.3972 -by auto
5.3973 -
5.3974 -(* Consequences of independence or spanning for cardinality. *)
5.3975 -
5.3976 -lemma independent_card_le_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B \<le> dim V"
5.3977 -by (metis basis_exists[of V] independent_span_bound[where ?'a=real] hassize_def subset_trans)
5.3978 -
5.3979 -lemma span_card_ge_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
5.3980 - by (metis basis_exists[of V] independent_span_bound hassize_def subset_trans)
5.3981 -
5.3982 -lemma basis_card_eq_dim:
5.3983 - "B \<subseteq> (V:: (real ^'n::finite) set) \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
5.3984 - by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_mono)
5.3985 -
5.3986 -lemma dim_unique: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> B hassize n \<Longrightarrow> dim V = n"
5.3987 - by (metis basis_card_eq_dim hassize_def)
5.3988 -
5.3989 -(* More lemmas about dimension. *)
5.3990 -
5.3991 -lemma dim_univ: "dim (UNIV :: (real^'n::finite) set) = CARD('n)"
5.3992 - apply (rule dim_unique[of "{basis i |i. i\<in> (UNIV :: 'n set)}"])
5.3993 - by (auto simp only: span_stdbasis has_size_stdbasis independent_stdbasis)
5.3994 -
5.3995 -lemma dim_subset:
5.3996 - "(S:: (real ^'n::finite) set) \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
5.3997 - using basis_exists[of T] basis_exists[of S]
5.3998 - by (metis independent_span_bound[where ?'a = real and ?'n = 'n] subset_eq hassize_def)
5.3999 -
5.4000 -lemma dim_subset_univ: "dim (S:: (real^'n::finite) set) \<le> CARD('n)"
5.4001 - by (metis dim_subset subset_UNIV dim_univ)
5.4002 -
5.4003 -(* Converses to those. *)
5.4004 -
5.4005 -lemma card_ge_dim_independent:
5.4006 - assumes BV:"(B::(real ^'n::finite) set) \<subseteq> V" and iB:"independent B" and dVB:"dim V \<le> card B"
5.4007 - shows "V \<subseteq> span B"
5.4008 -proof-
5.4009 - {fix a assume aV: "a \<in> V"
5.4010 - {assume aB: "a \<notin> span B"
5.4011 - then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert)
5.4012 - from aV BV have th0: "insert a B \<subseteq> V" by blast
5.4013 - from aB have "a \<notin>B" by (auto simp add: span_superset)
5.4014 - with independent_card_le_dim[OF th0 iaB] dVB have False by auto}
5.4015 - then have "a \<in> span B" by blast}
5.4016 - then show ?thesis by blast
5.4017 -qed
5.4018 -
5.4019 -lemma card_le_dim_spanning:
5.4020 - assumes BV: "(B:: (real ^'n::finite) set) \<subseteq> V" and VB: "V \<subseteq> span B"
5.4021 - and fB: "finite B" and dVB: "dim V \<ge> card B"
5.4022 - shows "independent B"
5.4023 -proof-
5.4024 - {fix a assume a: "a \<in> B" "a \<in> span (B -{a})"
5.4025 - from a fB have c0: "card B \<noteq> 0" by auto
5.4026 - from a fB have cb: "card (B -{a}) = card B - 1" by auto
5.4027 - from BV a have th0: "B -{a} \<subseteq> V" by blast
5.4028 - {fix x assume x: "x \<in> V"
5.4029 - from a have eq: "insert a (B -{a}) = B" by blast
5.4030 - from x VB have x': "x \<in> span B" by blast
5.4031 - from span_trans[OF a(2), unfolded eq, OF x']
5.4032 - have "x \<in> span (B -{a})" . }
5.4033 - then have th1: "V \<subseteq> span (B -{a})" by blast
5.4034 - have th2: "finite (B -{a})" using fB by auto
5.4035 - from span_card_ge_dim[OF th0 th1 th2]
5.4036 - have c: "dim V \<le> card (B -{a})" .
5.4037 - from c c0 dVB cb have False by simp}
5.4038 - then show ?thesis unfolding dependent_def by blast
5.4039 -qed
5.4040 -
5.4041 -lemma card_eq_dim: "(B:: (real ^'n::finite) set) \<subseteq> V \<Longrightarrow> B hassize dim V \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
5.4042 - by (metis hassize_def order_eq_iff card_le_dim_spanning
5.4043 - card_ge_dim_independent)
5.4044 -
5.4045 -(* ------------------------------------------------------------------------- *)
5.4046 -(* More general size bound lemmas. *)
5.4047 -(* ------------------------------------------------------------------------- *)
5.4048 -
5.4049 -lemma independent_bound_general:
5.4050 - "independent (S:: (real^'n::finite) set) \<Longrightarrow> finite S \<and> card S \<le> dim S"
5.4051 - by (metis independent_card_le_dim independent_bound subset_refl)
5.4052 -
5.4053 -lemma dependent_biggerset_general: "(finite (S:: (real^'n::finite) set) \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
5.4054 - using independent_bound_general[of S] by (metis linorder_not_le)
5.4055 -
5.4056 -lemma dim_span: "dim (span (S:: (real ^'n::finite) set)) = dim S"
5.4057 -proof-
5.4058 - have th0: "dim S \<le> dim (span S)"
5.4059 - by (auto simp add: subset_eq intro: dim_subset span_superset)
5.4060 - from basis_exists[of S]
5.4061 - obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
5.4062 - from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
5.4063 - have bSS: "B \<subseteq> span S" using B(1) by (metis subset_eq span_inc)
5.4064 - have sssB: "span S \<subseteq> span B" using span_mono[OF B(3)] by (simp add: span_span)
5.4065 - from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
5.4066 - using fB(2) by arith
5.4067 -qed
5.4068 -
5.4069 -lemma subset_le_dim: "(S:: (real ^'n::finite) set) \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
5.4070 - by (metis dim_span dim_subset)
5.4071 -
5.4072 -lemma span_eq_dim: "span (S:: (real ^'n::finite) set) = span T ==> dim S = dim T"
5.4073 - by (metis dim_span)
5.4074 -
5.4075 -lemma spans_image:
5.4076 - assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and VB: "V \<subseteq> span B"
5.4077 - shows "f ` V \<subseteq> span (f ` B)"
5.4078 - unfolding span_linear_image[OF lf]
5.4079 - by (metis VB image_mono)
5.4080 -
5.4081 -lemma dim_image_le:
5.4082 - fixes f :: "real^'n::finite \<Rightarrow> real^'m::finite"
5.4083 - assumes lf: "linear f" shows "dim (f ` S) \<le> dim (S:: (real ^'n::finite) set)"
5.4084 -proof-
5.4085 - from basis_exists[of S] obtain B where
5.4086 - B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
5.4087 - from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
5.4088 - have "dim (f ` S) \<le> card (f ` B)"
5.4089 - apply (rule span_card_ge_dim)
5.4090 - using lf B fB by (auto simp add: span_linear_image spans_image subset_image_iff)
5.4091 - also have "\<dots> \<le> dim S" using card_image_le[OF fB(1)] fB by simp
5.4092 - finally show ?thesis .
5.4093 -qed
5.4094 -
5.4095 -(* Relation between bases and injectivity/surjectivity of map. *)
5.4096 -
5.4097 -lemma spanning_surjective_image:
5.4098 - assumes us: "UNIV \<subseteq> span (S:: ('a::semiring_1 ^'n) set)"
5.4099 - and lf: "linear f" and sf: "surj f"
5.4100 - shows "UNIV \<subseteq> span (f ` S)"
5.4101 -proof-
5.4102 - have "UNIV \<subseteq> f ` UNIV" using sf by (auto simp add: surj_def)
5.4103 - also have " \<dots> \<subseteq> span (f ` S)" using spans_image[OF lf us] .
5.4104 -finally show ?thesis .
5.4105 -qed
5.4106 -
5.4107 -lemma independent_injective_image:
5.4108 - assumes iS: "independent (S::('a::semiring_1^'n) set)" and lf: "linear f" and fi: "inj f"
5.4109 - shows "independent (f ` S)"
5.4110 -proof-
5.4111 - {fix a assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
5.4112 - have eq: "f ` S - {f a} = f ` (S - {a})" using fi
5.4113 - by (auto simp add: inj_on_def)
5.4114 - from a have "f a \<in> f ` span (S -{a})"
5.4115 - unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
5.4116 - hence "a \<in> span (S -{a})" using fi by (auto simp add: inj_on_def)
5.4117 - with a(1) iS have False by (simp add: dependent_def) }
5.4118 - then show ?thesis unfolding dependent_def by blast
5.4119 -qed
5.4120 -
5.4121 -(* ------------------------------------------------------------------------- *)
5.4122 -(* Picking an orthogonal replacement for a spanning set. *)
5.4123 -(* ------------------------------------------------------------------------- *)
5.4124 - (* FIXME : Move to some general theory ?*)
5.4125 -definition "pairwise R S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y\<in> S. x\<noteq>y \<longrightarrow> R x y)"
5.4126 -
5.4127 -lemma vector_sub_project_orthogonal: "(b::'a::ordered_field^'n::finite) \<bullet> (x - ((b \<bullet> x) / (b\<bullet>b)) *s b) = 0"
5.4128 - apply (cases "b = 0", simp)
5.4129 - apply (simp add: dot_rsub dot_rmult)
5.4130 - unfolding times_divide_eq_right[symmetric]
5.4131 - by (simp add: field_simps dot_eq_0)
5.4132 -
5.4133 -lemma basis_orthogonal:
5.4134 - fixes B :: "(real ^'n::finite) set"
5.4135 - assumes fB: "finite B"
5.4136 - shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
5.4137 - (is " \<exists>C. ?P B C")
5.4138 -proof(induct rule: finite_induct[OF fB])
5.4139 - case 1 thus ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def)
5.4140 -next
5.4141 - case (2 a B)
5.4142 - note fB = `finite B` and aB = `a \<notin> B`
5.4143 - from `\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C`
5.4144 - obtain C where C: "finite C" "card C \<le> card B"
5.4145 - "span C = span B" "pairwise orthogonal C" by blast
5.4146 - let ?a = "a - setsum (\<lambda>x. (x\<bullet>a / (x\<bullet>x)) *s x) C"
5.4147 - let ?C = "insert ?a C"
5.4148 - from C(1) have fC: "finite ?C" by simp
5.4149 - from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)" by (simp add: card_insert_if)
5.4150 - {fix x k
5.4151 - have th0: "\<And>(a::'b::comm_ring) b c. a - (b - c) = c + (a - b)" by (simp add: ring_simps)
5.4152 - have "x - k *s (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *s x)) \<in> span C \<longleftrightarrow> x - k *s a \<in> span C"
5.4153 - apply (simp only: vector_ssub_ldistrib th0)
5.4154 - apply (rule span_add_eq)
5.4155 - apply (rule span_mul)
5.4156 - apply (rule span_setsum[OF C(1)])
5.4157 - apply clarify
5.4158 - apply (rule span_mul)
5.4159 - by (rule span_superset)}
5.4160 - then have SC: "span ?C = span (insert a B)"
5.4161 - unfolding expand_set_eq span_breakdown_eq C(3)[symmetric] by auto
5.4162 - thm pairwise_def
5.4163 - {fix x y assume xC: "x \<in> ?C" and yC: "y \<in> ?C" and xy: "x \<noteq> y"
5.4164 - {assume xa: "x = ?a" and ya: "y = ?a"
5.4165 - have "orthogonal x y" using xa ya xy by blast}
5.4166 - moreover
5.4167 - {assume xa: "x = ?a" and ya: "y \<noteq> ?a" "y \<in> C"
5.4168 - from ya have Cy: "C = insert y (C - {y})" by blast
5.4169 - have fth: "finite (C - {y})" using C by simp
5.4170 - have "orthogonal x y"
5.4171 - using xa ya
5.4172 - unfolding orthogonal_def xa dot_lsub dot_rsub diff_eq_0_iff_eq
5.4173 - apply simp
5.4174 - apply (subst Cy)
5.4175 - using C(1) fth
5.4176 - apply (simp only: setsum_clauses)
5.4177 - thm dot_ladd
5.4178 - apply (auto simp add: dot_ladd dot_radd dot_lmult dot_rmult dot_eq_0 dot_sym[of y a] dot_lsum[OF fth])
5.4179 - apply (rule setsum_0')
5.4180 - apply clarsimp
5.4181 - apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
5.4182 - by auto}
5.4183 - moreover
5.4184 - {assume xa: "x \<noteq> ?a" "x \<in> C" and ya: "y = ?a"
5.4185 - from xa have Cx: "C = insert x (C - {x})" by blast
5.4186 - have fth: "finite (C - {x})" using C by simp
5.4187 - have "orthogonal x y"
5.4188 - using xa ya
5.4189 - unfolding orthogonal_def ya dot_rsub dot_lsub diff_eq_0_iff_eq
5.4190 - apply simp
5.4191 - apply (subst Cx)
5.4192 - using C(1) fth
5.4193 - apply (simp only: setsum_clauses)
5.4194 - apply (subst dot_sym[of x])
5.4195 - apply (auto simp add: dot_radd dot_rmult dot_eq_0 dot_sym[of x a] dot_rsum[OF fth])
5.4196 - apply (rule setsum_0')
5.4197 - apply clarsimp
5.4198 - apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
5.4199 - by auto}
5.4200 - moreover
5.4201 - {assume xa: "x \<in> C" and ya: "y \<in> C"
5.4202 - have "orthogonal x y" using xa ya xy C(4) unfolding pairwise_def by blast}
5.4203 - ultimately have "orthogonal x y" using xC yC by blast}
5.4204 - then have CPO: "pairwise orthogonal ?C" unfolding pairwise_def by blast
5.4205 - from fC cC SC CPO have "?P (insert a B) ?C" by blast
5.4206 - then show ?case by blast
5.4207 -qed
5.4208 -
5.4209 -lemma orthogonal_basis_exists:
5.4210 - fixes V :: "(real ^'n::finite) set"
5.4211 - shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (B hassize dim V) \<and> pairwise orthogonal B"
5.4212 -proof-
5.4213 - from basis_exists[of V] obtain B where B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "B hassize dim V" by blast
5.4214 - from B have fB: "finite B" "card B = dim V" by (simp_all add: hassize_def)
5.4215 - from basis_orthogonal[OF fB(1)] obtain C where
5.4216 - C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C" by blast
5.4217 - from C B
5.4218 - have CSV: "C \<subseteq> span V" by (metis span_inc span_mono subset_trans)
5.4219 - from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C" by (simp add: span_span)
5.4220 - from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
5.4221 - have iC: "independent C" by (simp add: dim_span)
5.4222 - from C fB have "card C \<le> dim V" by simp
5.4223 - moreover have "dim V \<le> card C" using span_card_ge_dim[OF CSV SVC C(1)]
5.4224 - by (simp add: dim_span)
5.4225 - ultimately have CdV: "C hassize dim V" unfolding hassize_def using C(1) by simp
5.4226 - from C B CSV CdV iC show ?thesis by auto
5.4227 -qed
5.4228 -
5.4229 -lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
5.4230 - by (metis set_eq_subset span_mono span_span span_inc) (* FIXME: slow *)
5.4231 -
5.4232 -(* ------------------------------------------------------------------------- *)
5.4233 -(* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *)
5.4234 -(* ------------------------------------------------------------------------- *)
5.4235 -
5.4236 -lemma span_not_univ_orthogonal:
5.4237 - assumes sU: "span S \<noteq> UNIV"
5.4238 - shows "\<exists>(a:: real ^'n::finite). a \<noteq>0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
5.4239 -proof-
5.4240 - from sU obtain a where a: "a \<notin> span S" by blast
5.4241 - from orthogonal_basis_exists obtain B where
5.4242 - B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "B hassize dim S" "pairwise orthogonal B"
5.4243 - by blast
5.4244 - from B have fB: "finite B" "card B = dim S" by (simp_all add: hassize_def)
5.4245 - from span_mono[OF B(2)] span_mono[OF B(3)]
5.4246 - have sSB: "span S = span B" by (simp add: span_span)
5.4247 - let ?a = "a - setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B"
5.4248 - have "setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B \<in> span S"
5.4249 - unfolding sSB
5.4250 - apply (rule span_setsum[OF fB(1)])
5.4251 - apply clarsimp
5.4252 - apply (rule span_mul)
5.4253 - by (rule span_superset)
5.4254 - with a have a0:"?a \<noteq> 0" by auto
5.4255 - have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
5.4256 - proof(rule span_induct')
5.4257 - show "subspace (\<lambda>x. ?a \<bullet> x = 0)"
5.4258 - by (auto simp add: subspace_def mem_def dot_radd dot_rmult)
5.4259 - next
5.4260 - {fix x assume x: "x \<in> B"
5.4261 - from x have B': "B = insert x (B - {x})" by blast
5.4262 - have fth: "finite (B - {x})" using fB by simp
5.4263 - have "?a \<bullet> x = 0"
5.4264 - apply (subst B') using fB fth
5.4265 - unfolding setsum_clauses(2)[OF fth]
5.4266 - apply simp
5.4267 - apply (clarsimp simp add: dot_lsub dot_ladd dot_lmult dot_lsum dot_eq_0)
5.4268 - apply (rule setsum_0', rule ballI)
5.4269 - unfolding dot_sym
5.4270 - by (auto simp add: x field_simps dot_eq_0 intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])}
5.4271 - then show "\<forall>x \<in> B. ?a \<bullet> x = 0" by blast
5.4272 - qed
5.4273 - with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"])
5.4274 -qed
5.4275 -
5.4276 -lemma span_not_univ_subset_hyperplane:
5.4277 - assumes SU: "span S \<noteq> (UNIV ::(real^'n::finite) set)"
5.4278 - shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
5.4279 - using span_not_univ_orthogonal[OF SU] by auto
5.4280 -
5.4281 -lemma lowdim_subset_hyperplane:
5.4282 - assumes d: "dim S < CARD('n::finite)"
5.4283 - shows "\<exists>(a::real ^'n::finite). a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
5.4284 -proof-
5.4285 - {assume "span S = UNIV"
5.4286 - hence "dim (span S) = dim (UNIV :: (real ^'n) set)" by simp
5.4287 - hence "dim S = CARD('n)" by (simp add: dim_span dim_univ)
5.4288 - with d have False by arith}
5.4289 - hence th: "span S \<noteq> UNIV" by blast
5.4290 - from span_not_univ_subset_hyperplane[OF th] show ?thesis .
5.4291 -qed
5.4292 -
5.4293 -(* We can extend a linear basis-basis injection to the whole set. *)
5.4294 -
5.4295 -lemma linear_indep_image_lemma:
5.4296 - assumes lf: "linear f" and fB: "finite B"
5.4297 - and ifB: "independent (f ` B)"
5.4298 - and fi: "inj_on f B" and xsB: "x \<in> span B"
5.4299 - and fx: "f (x::'a::field^'n) = 0"
5.4300 - shows "x = 0"
5.4301 - using fB ifB fi xsB fx
5.4302 -proof(induct arbitrary: x rule: finite_induct[OF fB])
5.4303 - case 1 thus ?case by (auto simp add: span_empty)
5.4304 -next
5.4305 - case (2 a b x)
5.4306 - have fb: "finite b" using "2.prems" by simp
5.4307 - have th0: "f ` b \<subseteq> f ` (insert a b)"
5.4308 - apply (rule image_mono) by blast
5.4309 - from independent_mono[ OF "2.prems"(2) th0]
5.4310 - have ifb: "independent (f ` b)" .
5.4311 - have fib: "inj_on f b"
5.4312 - apply (rule subset_inj_on [OF "2.prems"(3)])
5.4313 - by blast
5.4314 - from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
5.4315 - obtain k where k: "x - k*s a \<in> span (b -{a})" by blast
5.4316 - have "f (x - k*s a) \<in> span (f ` b)"
5.4317 - unfolding span_linear_image[OF lf]
5.4318 - apply (rule imageI)
5.4319 - using k span_mono[of "b-{a}" b] by blast
5.4320 - hence "f x - k*s f a \<in> span (f ` b)"
5.4321 - by (simp add: linear_sub[OF lf] linear_cmul[OF lf])
5.4322 - hence th: "-k *s f a \<in> span (f ` b)"
5.4323 - using "2.prems"(5) by (simp add: vector_smult_lneg)
5.4324 - {assume k0: "k = 0"
5.4325 - from k0 k have "x \<in> span (b -{a})" by simp
5.4326 - then have "x \<in> span b" using span_mono[of "b-{a}" b]
5.4327 - by blast}
5.4328 - moreover
5.4329 - {assume k0: "k \<noteq> 0"
5.4330 - from span_mul[OF th, of "- 1/ k"] k0
5.4331 - have th1: "f a \<in> span (f ` b)"
5.4332 - by (auto simp add: vector_smult_assoc)
5.4333 - from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
5.4334 - have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
5.4335 - from "2.prems"(2)[unfolded dependent_def bex_simps(10), rule_format, of "f a"]
5.4336 - have "f a \<notin> span (f ` b)" using tha
5.4337 - using "2.hyps"(2)
5.4338 - "2.prems"(3) by auto
5.4339 - with th1 have False by blast
5.4340 - then have "x \<in> span b" by blast}
5.4341 - ultimately have xsb: "x \<in> span b" by blast
5.4342 - from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)]
5.4343 - show "x = 0" .
5.4344 -qed
5.4345 -
5.4346 -(* We can extend a linear mapping from basis. *)
5.4347 -
5.4348 -lemma linear_independent_extend_lemma:
5.4349 - assumes fi: "finite B" and ib: "independent B"
5.4350 - shows "\<exists>g. (\<forall>x\<in> span B. \<forall>y\<in> span B. g ((x::'a::field^'n) + y) = g x + g y)
5.4351 - \<and> (\<forall>x\<in> span B. \<forall>c. g (c*s x) = c *s g x)
5.4352 - \<and> (\<forall>x\<in> B. g x = f x)"
5.4353 -using ib fi
5.4354 -proof(induct rule: finite_induct[OF fi])
5.4355 - case 1 thus ?case by (auto simp add: span_empty)
5.4356 -next
5.4357 - case (2 a b)
5.4358 - from "2.prems" "2.hyps" have ibf: "independent b" "finite b"
5.4359 - by (simp_all add: independent_insert)
5.4360 - from "2.hyps"(3)[OF ibf] obtain g where
5.4361 - g: "\<forall>x\<in>span b. \<forall>y\<in>span b. g (x + y) = g x + g y"
5.4362 - "\<forall>x\<in>span b. \<forall>c. g (c *s x) = c *s g x" "\<forall>x\<in>b. g x = f x" by blast
5.4363 - let ?h = "\<lambda>z. SOME k. (z - k *s a) \<in> span b"
5.4364 - {fix z assume z: "z \<in> span (insert a b)"
5.4365 - have th0: "z - ?h z *s a \<in> span b"
5.4366 - apply (rule someI_ex)
5.4367 - unfolding span_breakdown_eq[symmetric]
5.4368 - using z .
5.4369 - {fix k assume k: "z - k *s a \<in> span b"
5.4370 - have eq: "z - ?h z *s a - (z - k*s a) = (k - ?h z) *s a"
5.4371 - by (simp add: ring_simps vector_sadd_rdistrib[symmetric])
5.4372 - from span_sub[OF th0 k]
5.4373 - have khz: "(k - ?h z) *s a \<in> span b" by (simp add: eq)
5.4374 - {assume "k \<noteq> ?h z" hence k0: "k - ?h z \<noteq> 0" by simp
5.4375 - from k0 span_mul[OF khz, of "1 /(k - ?h z)"]
5.4376 - have "a \<in> span b" by (simp add: vector_smult_assoc)
5.4377 - with "2.prems"(1) "2.hyps"(2) have False
5.4378 - by (auto simp add: dependent_def)}
5.4379 - then have "k = ?h z" by blast}
5.4380 - with th0 have "z - ?h z *s a \<in> span b \<and> (\<forall>k. z - k *s a \<in> span b \<longrightarrow> k = ?h z)" by blast}
5.4381 - note h = this
5.4382 - let ?g = "\<lambda>z. ?h z *s f a + g (z - ?h z *s a)"
5.4383 - {fix x y assume x: "x \<in> span (insert a b)" and y: "y \<in> span (insert a b)"
5.4384 - have tha: "\<And>(x::'a^'n) y a k l. (x + y) - (k + l) *s a = (x - k *s a) + (y - l *s a)"
5.4385 - by (vector ring_simps)
5.4386 - have addh: "?h (x + y) = ?h x + ?h y"
5.4387 - apply (rule conjunct2[OF h, rule_format, symmetric])
5.4388 - apply (rule span_add[OF x y])
5.4389 - unfolding tha
5.4390 - by (metis span_add x y conjunct1[OF h, rule_format])
5.4391 - have "?g (x + y) = ?g x + ?g y"
5.4392 - unfolding addh tha
5.4393 - g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]]
5.4394 - by (simp add: vector_sadd_rdistrib)}
5.4395 - moreover
5.4396 - {fix x:: "'a^'n" and c:: 'a assume x: "x \<in> span (insert a b)"
5.4397 - have tha: "\<And>(x::'a^'n) c k a. c *s x - (c * k) *s a = c *s (x - k *s a)"
5.4398 - by (vector ring_simps)
5.4399 - have hc: "?h (c *s x) = c * ?h x"
5.4400 - apply (rule conjunct2[OF h, rule_format, symmetric])
5.4401 - apply (metis span_mul x)
5.4402 - by (metis tha span_mul x conjunct1[OF h])
5.4403 - have "?g (c *s x) = c*s ?g x"
5.4404 - unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]]
5.4405 - by (vector ring_simps)}
5.4406 - moreover
5.4407 - {fix x assume x: "x \<in> (insert a b)"
5.4408 - {assume xa: "x = a"
5.4409 - have ha1: "1 = ?h a"
5.4410 - apply (rule conjunct2[OF h, rule_format])
5.4411 - apply (metis span_superset insertI1)
5.4412 - using conjunct1[OF h, OF span_superset, OF insertI1]
5.4413 - by (auto simp add: span_0)
5.4414 -
5.4415 - from xa ha1[symmetric] have "?g x = f x"
5.4416 - apply simp
5.4417 - using g(2)[rule_format, OF span_0, of 0]
5.4418 - by simp}
5.4419 - moreover
5.4420 - {assume xb: "x \<in> b"
5.4421 - have h0: "0 = ?h x"
5.4422 - apply (rule conjunct2[OF h, rule_format])
5.4423 - apply (metis span_superset insertI1 xb x)
5.4424 - apply simp
5.4425 - apply (metis span_superset xb)
5.4426 - done
5.4427 - have "?g x = f x"
5.4428 - by (simp add: h0[symmetric] g(3)[rule_format, OF xb])}
5.4429 - ultimately have "?g x = f x" using x by blast }
5.4430 - ultimately show ?case apply - apply (rule exI[where x="?g"]) by blast
5.4431 -qed
5.4432 -
5.4433 -lemma linear_independent_extend:
5.4434 - assumes iB: "independent (B:: (real ^'n::finite) set)"
5.4435 - shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
5.4436 -proof-
5.4437 - from maximal_independent_subset_extend[of B UNIV] iB
5.4438 - obtain C where C: "B \<subseteq> C" "independent C" "\<And>x. x \<in> span C" by auto
5.4439 -
5.4440 - from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f]
5.4441 - obtain g where g: "(\<forall>x\<in> span C. \<forall>y\<in> span C. g (x + y) = g x + g y)
5.4442 - \<and> (\<forall>x\<in> span C. \<forall>c. g (c*s x) = c *s g x)
5.4443 - \<and> (\<forall>x\<in> C. g x = f x)" by blast
5.4444 - from g show ?thesis unfolding linear_def using C
5.4445 - apply clarsimp by blast
5.4446 -qed
5.4447 -
5.4448 -(* Can construct an isomorphism between spaces of same dimension. *)
5.4449 -
5.4450 -lemma card_le_inj: assumes fA: "finite A" and fB: "finite B"
5.4451 - and c: "card A \<le> card B" shows "(\<exists>f. f ` A \<subseteq> B \<and> inj_on f A)"
5.4452 -using fB c
5.4453 -proof(induct arbitrary: B rule: finite_induct[OF fA])
5.4454 - case 1 thus ?case by simp
5.4455 -next
5.4456 - case (2 x s t)
5.4457 - thus ?case
5.4458 - proof(induct rule: finite_induct[OF "2.prems"(1)])
5.4459 - case 1 then show ?case by simp
5.4460 - next
5.4461 - case (2 y t)
5.4462 - from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \<le> card t" by simp
5.4463 - from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where
5.4464 - f: "f ` s \<subseteq> t \<and> inj_on f s" by blast
5.4465 - from f "2.prems"(2) "2.hyps"(2) show ?case
5.4466 - apply -
5.4467 - apply (rule exI[where x = "\<lambda>z. if z = x then y else f z"])
5.4468 - by (auto simp add: inj_on_def)
5.4469 - qed
5.4470 -qed
5.4471 -
5.4472 -lemma card_subset_eq: assumes fB: "finite B" and AB: "A \<subseteq> B" and
5.4473 - c: "card A = card B"
5.4474 - shows "A = B"
5.4475 -proof-
5.4476 - from fB AB have fA: "finite A" by (auto intro: finite_subset)
5.4477 - from fA fB have fBA: "finite (B - A)" by auto
5.4478 - have e: "A \<inter> (B - A) = {}" by blast
5.4479 - have eq: "A \<union> (B - A) = B" using AB by blast
5.4480 - from card_Un_disjoint[OF fA fBA e, unfolded eq c]
5.4481 - have "card (B - A) = 0" by arith
5.4482 - hence "B - A = {}" unfolding card_eq_0_iff using fA fB by simp
5.4483 - with AB show "A = B" by blast
5.4484 -qed
5.4485 -
5.4486 -lemma subspace_isomorphism:
5.4487 - assumes s: "subspace (S:: (real ^'n::finite) set)"
5.4488 - and t: "subspace (T :: (real ^ 'm::finite) set)"
5.4489 - and d: "dim S = dim T"
5.4490 - shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
5.4491 -proof-
5.4492 - from basis_exists[of S] obtain B where
5.4493 - B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
5.4494 - from basis_exists[of T] obtain C where
5.4495 - C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "C hassize dim T" by blast
5.4496 - from B(4) C(4) card_le_inj[of B C] d obtain f where
5.4497 - f: "f ` B \<subseteq> C" "inj_on f B" unfolding hassize_def by auto
5.4498 - from linear_independent_extend[OF B(2)] obtain g where
5.4499 - g: "linear g" "\<forall>x\<in> B. g x = f x" by blast
5.4500 - from B(4) have fB: "finite B" by (simp add: hassize_def)
5.4501 - from C(4) have fC: "finite C" by (simp add: hassize_def)
5.4502 - from inj_on_iff_eq_card[OF fB, of f] f(2)
5.4503 - have "card (f ` B) = card B" by simp
5.4504 - with B(4) C(4) have ceq: "card (f ` B) = card C" using d
5.4505 - by (simp add: hassize_def)
5.4506 - have "g ` B = f ` B" using g(2)
5.4507 - by (auto simp add: image_iff)
5.4508 - also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
5.4509 - finally have gBC: "g ` B = C" .
5.4510 - have gi: "inj_on g B" using f(2) g(2)
5.4511 - by (auto simp add: inj_on_def)
5.4512 - note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
5.4513 - {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y"
5.4514 - from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
5.4515 - from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
5.4516 - have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
5.4517 - have "x=y" using g0[OF th1 th0] by simp }
5.4518 - then have giS: "inj_on g S"
5.4519 - unfolding inj_on_def by blast
5.4520 - from span_subspace[OF B(1,3) s]
5.4521 - have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
5.4522 - also have "\<dots> = span C" unfolding gBC ..
5.4523 - also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
5.4524 - finally have gS: "g ` S = T" .
5.4525 - from g(1) gS giS show ?thesis by blast
5.4526 -qed
5.4527 -
5.4528 -(* linear functions are equal on a subspace if they are on a spanning set. *)
5.4529 -
5.4530 -lemma subspace_kernel:
5.4531 - assumes lf: "linear (f::'a::semiring_1 ^'n \<Rightarrow> _)"
5.4532 - shows "subspace {x. f x = 0}"
5.4533 -apply (simp add: subspace_def)
5.4534 -by (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
5.4535 -
5.4536 -lemma linear_eq_0_span:
5.4537 - assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
5.4538 - shows "\<forall>x \<in> span B. f x = (0::'a::semiring_1 ^'n)"
5.4539 -proof
5.4540 - fix x assume x: "x \<in> span B"
5.4541 - let ?P = "\<lambda>x. f x = 0"
5.4542 - from subspace_kernel[OF lf] have "subspace ?P" unfolding Collect_def .
5.4543 - with x f0 span_induct[of B "?P" x] show "f x = 0" by blast
5.4544 -qed
5.4545 -
5.4546 -lemma linear_eq_0:
5.4547 - assumes lf: "linear f" and SB: "S \<subseteq> span B" and f0: "\<forall>x\<in>B. f x = 0"
5.4548 - shows "\<forall>x \<in> S. f x = (0::'a::semiring_1^'n)"
5.4549 - by (metis linear_eq_0_span[OF lf] subset_eq SB f0)
5.4550 -
5.4551 -lemma linear_eq:
5.4552 - assumes lf: "linear (f::'a::ring_1^'n \<Rightarrow> _)" and lg: "linear g" and S: "S \<subseteq> span B"
5.4553 - and fg: "\<forall> x\<in> B. f x = g x"
5.4554 - shows "\<forall>x\<in> S. f x = g x"
5.4555 -proof-
5.4556 - let ?h = "\<lambda>x. f x - g x"
5.4557 - from fg have fg': "\<forall>x\<in> B. ?h x = 0" by simp
5.4558 - from linear_eq_0[OF linear_compose_sub[OF lf lg] S fg']
5.4559 - show ?thesis by simp
5.4560 -qed
5.4561 -
5.4562 -lemma linear_eq_stdbasis:
5.4563 - assumes lf: "linear (f::'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite)" and lg: "linear g"
5.4564 - and fg: "\<forall>i. f (basis i) = g(basis i)"
5.4565 - shows "f = g"
5.4566 -proof-
5.4567 - let ?U = "UNIV :: 'm set"
5.4568 - let ?I = "{basis i:: 'a^'m|i. i \<in> ?U}"
5.4569 - {fix x assume x: "x \<in> (UNIV :: ('a^'m) set)"
5.4570 - from equalityD2[OF span_stdbasis]
5.4571 - have IU: " (UNIV :: ('a^'m) set) \<subseteq> span ?I" by blast
5.4572 - from linear_eq[OF lf lg IU] fg x
5.4573 - have "f x = g x" unfolding Collect_def Ball_def mem_def by metis}
5.4574 - then show ?thesis by (auto intro: ext)
5.4575 -qed
5.4576 -
5.4577 -(* Similar results for bilinear functions. *)
5.4578 -
5.4579 -lemma bilinear_eq:
5.4580 - assumes bf: "bilinear (f:: 'a::ring^'m \<Rightarrow> 'a^'n \<Rightarrow> 'a^'p)"
5.4581 - and bg: "bilinear g"
5.4582 - and SB: "S \<subseteq> span B" and TC: "T \<subseteq> span C"
5.4583 - and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
5.4584 - shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
5.4585 -proof-
5.4586 - let ?P = "\<lambda>x. \<forall>y\<in> span C. f x y = g x y"
5.4587 - from bf bg have sp: "subspace ?P"
5.4588 - unfolding bilinear_def linear_def subspace_def bf bg
5.4589 - by(auto simp add: span_0 mem_def bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf])
5.4590 -
5.4591 - have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
5.4592 - apply -
5.4593 - apply (rule ballI)
5.4594 - apply (rule span_induct[of B ?P])
5.4595 - defer
5.4596 - apply (rule sp)
5.4597 - apply assumption
5.4598 - apply (clarsimp simp add: Ball_def)
5.4599 - apply (rule_tac P="\<lambda>y. f xa y = g xa y" and S=C in span_induct)
5.4600 - using fg
5.4601 - apply (auto simp add: subspace_def)
5.4602 - using bf bg unfolding bilinear_def linear_def
5.4603 - by(auto simp add: span_0 mem_def bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf])
5.4604 - then show ?thesis using SB TC by (auto intro: ext)
5.4605 -qed
5.4606 -
5.4607 -lemma bilinear_eq_stdbasis:
5.4608 - assumes bf: "bilinear (f:: 'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite \<Rightarrow> 'a^'p)"
5.4609 - and bg: "bilinear g"
5.4610 - and fg: "\<forall>i j. f (basis i) (basis j) = g (basis i) (basis j)"
5.4611 - shows "f = g"
5.4612 -proof-
5.4613 - from fg have th: "\<forall>x \<in> {basis i| i. i\<in> (UNIV :: 'm set)}. \<forall>y\<in> {basis j |j. j \<in> (UNIV :: 'n set)}. f x y = g x y" by blast
5.4614 - from bilinear_eq[OF bf bg equalityD2[OF span_stdbasis] equalityD2[OF span_stdbasis] th] show ?thesis by (blast intro: ext)
5.4615 -qed
5.4616 -
5.4617 -(* Detailed theorems about left and right invertibility in general case. *)
5.4618 -
5.4619 -lemma left_invertible_transp:
5.4620 - "(\<exists>(B::'a^'n^'m). B ** transp (A::'a^'n^'m) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). A ** B = mat 1)"
5.4621 - by (metis matrix_transp_mul transp_mat transp_transp)
5.4622 -
5.4623 -lemma right_invertible_transp:
5.4624 - "(\<exists>(B::'a^'n^'m). transp (A::'a^'n^'m) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). B ** A = mat 1)"
5.4625 - by (metis matrix_transp_mul transp_mat transp_transp)
5.4626 -
5.4627 -lemma linear_injective_left_inverse:
5.4628 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and fi: "inj f"
5.4629 - shows "\<exists>g. linear g \<and> g o f = id"
5.4630 -proof-
5.4631 - from linear_independent_extend[OF independent_injective_image, OF independent_stdbasis, OF lf fi]
5.4632 - obtain h:: "real ^'m \<Rightarrow> real ^'n" where h: "linear h" " \<forall>x \<in> f ` {basis i|i. i \<in> (UNIV::'n set)}. h x = inv f x" by blast
5.4633 - from h(2)
5.4634 - have th: "\<forall>i. (h \<circ> f) (basis i) = id (basis i)"
5.4635 - using inv_o_cancel[OF fi, unfolded stupid_ext[symmetric] id_def o_def]
5.4636 - by auto
5.4637 -
5.4638 - from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th]
5.4639 - have "h o f = id" .
5.4640 - then show ?thesis using h(1) by blast
5.4641 -qed
5.4642 -
5.4643 -lemma linear_surjective_right_inverse:
5.4644 - assumes lf: "linear (f:: real ^'m::finite \<Rightarrow> real ^'n::finite)" and sf: "surj f"
5.4645 - shows "\<exists>g. linear g \<and> f o g = id"
5.4646 -proof-
5.4647 - from linear_independent_extend[OF independent_stdbasis]
5.4648 - obtain h:: "real ^'n \<Rightarrow> real ^'m" where
5.4649 - h: "linear h" "\<forall> x\<in> {basis i| i. i\<in> (UNIV :: 'n set)}. h x = inv f x" by blast
5.4650 - from h(2)
5.4651 - have th: "\<forall>i. (f o h) (basis i) = id (basis i)"
5.4652 - using sf
5.4653 - apply (auto simp add: surj_iff o_def stupid_ext[symmetric])
5.4654 - apply (erule_tac x="basis i" in allE)
5.4655 - by auto
5.4656 -
5.4657 - from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th]
5.4658 - have "f o h = id" .
5.4659 - then show ?thesis using h(1) by blast
5.4660 -qed
5.4661 -
5.4662 -lemma matrix_left_invertible_injective:
5.4663 -"(\<exists>B. (B::real^'m^'n) ** (A::real^'n::finite^'m::finite) = mat 1) \<longleftrightarrow> (\<forall>x y. A *v x = A *v y \<longrightarrow> x = y)"
5.4664 -proof-
5.4665 - {fix B:: "real^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y"
5.4666 - from xy have "B*v (A *v x) = B *v (A*v y)" by simp
5.4667 - hence "x = y"
5.4668 - unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid .}
5.4669 - moreover
5.4670 - {assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y"
5.4671 - hence i: "inj (op *v A)" unfolding inj_on_def by auto
5.4672 - from linear_injective_left_inverse[OF matrix_vector_mul_linear i]
5.4673 - obtain g where g: "linear g" "g o op *v A = id" by blast
5.4674 - have "matrix g ** A = mat 1"
5.4675 - unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
5.4676 - using g(2) by (simp add: o_def id_def stupid_ext)
5.4677 - then have "\<exists>B. (B::real ^'m^'n) ** A = mat 1" by blast}
5.4678 - ultimately show ?thesis by blast
5.4679 -qed
5.4680 -
5.4681 -lemma matrix_left_invertible_ker:
5.4682 - "(\<exists>B. (B::real ^'m::finite^'n::finite) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
5.4683 - unfolding matrix_left_invertible_injective
5.4684 - using linear_injective_0[OF matrix_vector_mul_linear, of A]
5.4685 - by (simp add: inj_on_def)
5.4686 -
5.4687 -lemma matrix_right_invertible_surjective:
5.4688 -"(\<exists>B. (A::real^'n::finite^'m::finite) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
5.4689 -proof-
5.4690 - {fix B :: "real ^'m^'n" assume AB: "A ** B = mat 1"
5.4691 - {fix x :: "real ^ 'm"
5.4692 - have "A *v (B *v x) = x"
5.4693 - by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB)}
5.4694 - hence "surj (op *v A)" unfolding surj_def by metis }
5.4695 - moreover
5.4696 - {assume sf: "surj (op *v A)"
5.4697 - from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf]
5.4698 - obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "op *v A o g = id"
5.4699 - by blast
5.4700 -
5.4701 - have "A ** (matrix g) = mat 1"
5.4702 - unfolding matrix_eq matrix_vector_mul_lid
5.4703 - matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
5.4704 - using g(2) unfolding o_def stupid_ext[symmetric] id_def
5.4705 - .
5.4706 - hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast
5.4707 - }
5.4708 - ultimately show ?thesis unfolding surj_def by blast
5.4709 -qed
5.4710 -
5.4711 -lemma matrix_left_invertible_independent_columns:
5.4712 - fixes A :: "real^'n::finite^'m::finite"
5.4713 - shows "(\<exists>(B::real ^'m^'n). B ** A = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
5.4714 - (is "?lhs \<longleftrightarrow> ?rhs")
5.4715 -proof-
5.4716 - let ?U = "UNIV :: 'n set"
5.4717 - {assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
5.4718 - {fix c i assume c: "setsum (\<lambda>i. c i *s column i A) ?U = 0"
5.4719 - and i: "i \<in> ?U"
5.4720 - let ?x = "\<chi> i. c i"
5.4721 - have th0:"A *v ?x = 0"
5.4722 - using c
5.4723 - unfolding matrix_mult_vsum Cart_eq
5.4724 - by auto
5.4725 - from k[rule_format, OF th0] i
5.4726 - have "c i = 0" by (vector Cart_eq)}
5.4727 - hence ?rhs by blast}
5.4728 - moreover
5.4729 - {assume H: ?rhs
5.4730 - {fix x assume x: "A *v x = 0"
5.4731 - let ?c = "\<lambda>i. ((x$i ):: real)"
5.4732 - from H[rule_format, of ?c, unfolded matrix_mult_vsum[symmetric], OF x]
5.4733 - have "x = 0" by vector}}
5.4734 - ultimately show ?thesis unfolding matrix_left_invertible_ker by blast
5.4735 -qed
5.4736 -
5.4737 -lemma matrix_right_invertible_independent_rows:
5.4738 - fixes A :: "real^'n::finite^'m::finite"
5.4739 - shows "(\<exists>(B::real^'m^'n). A ** B = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
5.4740 - unfolding left_invertible_transp[symmetric]
5.4741 - matrix_left_invertible_independent_columns
5.4742 - by (simp add: column_transp)
5.4743 -
5.4744 -lemma matrix_right_invertible_span_columns:
5.4745 - "(\<exists>(B::real ^'n::finite^'m::finite). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow> span (columns A) = UNIV" (is "?lhs = ?rhs")
5.4746 -proof-
5.4747 - let ?U = "UNIV :: 'm set"
5.4748 - have fU: "finite ?U" by simp
5.4749 - have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y)"
5.4750 - unfolding matrix_right_invertible_surjective matrix_mult_vsum surj_def
5.4751 - apply (subst eq_commute) ..
5.4752 - have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast
5.4753 - {assume h: ?lhs
5.4754 - {fix x:: "real ^'n"
5.4755 - from h[unfolded lhseq, rule_format, of x] obtain y:: "real ^'m"
5.4756 - where y: "setsum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
5.4757 - have "x \<in> span (columns A)"
5.4758 - unfolding y[symmetric]
5.4759 - apply (rule span_setsum[OF fU])
5.4760 - apply clarify
5.4761 - apply (rule span_mul)
5.4762 - apply (rule span_superset)
5.4763 - unfolding columns_def
5.4764 - by blast}
5.4765 - then have ?rhs unfolding rhseq by blast}
5.4766 - moreover
5.4767 - {assume h:?rhs
5.4768 - let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y"
5.4769 - {fix y have "?P y"
5.4770 - proof(rule span_induct_alt[of ?P "columns A"])
5.4771 - show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
5.4772 - apply (rule exI[where x=0])
5.4773 - by (simp add: zero_index vector_smult_lzero)
5.4774 - next
5.4775 - fix c y1 y2 assume y1: "y1 \<in> columns A" and y2: "?P y2"
5.4776 - from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
5.4777 - unfolding columns_def by blast
5.4778 - from y2 obtain x:: "real ^'m" where
5.4779 - x: "setsum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
5.4780 - let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m"
5.4781 - show "?P (c*s y1 + y2)"
5.4782 - proof(rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] cond_value_iff right_distrib cond_application_beta cong del: if_weak_cong)
5.4783 - fix j
5.4784 - have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
5.4785 - else (x$xa) * ((column xa A$j))) = (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))" using i(1)
5.4786 - by (simp add: ring_simps)
5.4787 - have "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
5.4788 - else (x$xa) * ((column xa A$j))) ?U = setsum (\<lambda>xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U"
5.4789 - apply (rule setsum_cong[OF refl])
5.4790 - using th by blast
5.4791 - also have "\<dots> = setsum (\<lambda>xa. if xa = i then c * ((column i A)$j) else 0) ?U + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
5.4792 - by (simp add: setsum_addf)
5.4793 - also have "\<dots> = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
5.4794 - unfolding setsum_delta[OF fU]
5.4795 - using i(1) by simp
5.4796 - finally show "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
5.4797 - else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
5.4798 - qed
5.4799 - next
5.4800 - show "y \<in> span (columns A)" unfolding h by blast
5.4801 - qed}
5.4802 - then have ?lhs unfolding lhseq ..}
5.4803 - ultimately show ?thesis by blast
5.4804 -qed
5.4805 -
5.4806 -lemma matrix_left_invertible_span_rows:
5.4807 - "(\<exists>(B::real^'m::finite^'n::finite). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
5.4808 - unfolding right_invertible_transp[symmetric]
5.4809 - unfolding columns_transp[symmetric]
5.4810 - unfolding matrix_right_invertible_span_columns
5.4811 - ..
5.4812 -
5.4813 -(* An injective map real^'n->real^'n is also surjective. *)
5.4814 -
5.4815 -lemma linear_injective_imp_surjective:
5.4816 - assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
5.4817 - shows "surj f"
5.4818 -proof-
5.4819 - let ?U = "UNIV :: (real ^'n) set"
5.4820 - from basis_exists[of ?U] obtain B
5.4821 - where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
5.4822 - by blast
5.4823 - from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
5.4824 - have th: "?U \<subseteq> span (f ` B)"
5.4825 - apply (rule card_ge_dim_independent)
5.4826 - apply blast
5.4827 - apply (rule independent_injective_image[OF B(2) lf fi])
5.4828 - apply (rule order_eq_refl)
5.4829 - apply (rule sym)
5.4830 - unfolding d
5.4831 - apply (rule card_image)
5.4832 - apply (rule subset_inj_on[OF fi])
5.4833 - by blast
5.4834 - from th show ?thesis
5.4835 - unfolding span_linear_image[OF lf] surj_def
5.4836 - using B(3) by blast
5.4837 -qed
5.4838 -
5.4839 -(* And vice versa. *)
5.4840 -
5.4841 -lemma surjective_iff_injective_gen:
5.4842 - assumes fS: "finite S" and fT: "finite T" and c: "card S = card T"
5.4843 - and ST: "f ` S \<subseteq> T"
5.4844 - shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S" (is "?lhs \<longleftrightarrow> ?rhs")
5.4845 -proof-
5.4846 - {assume h: "?lhs"
5.4847 - {fix x y assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y"
5.4848 - from x fS have S0: "card S \<noteq> 0" by auto
5.4849 - {assume xy: "x \<noteq> y"
5.4850 - have th: "card S \<le> card (f ` (S - {y}))"
5.4851 - unfolding c
5.4852 - apply (rule card_mono)
5.4853 - apply (rule finite_imageI)
5.4854 - using fS apply simp
5.4855 - using h xy x y f unfolding subset_eq image_iff
5.4856 - apply auto
5.4857 - apply (case_tac "xa = f x")
5.4858 - apply (rule bexI[where x=x])
5.4859 - apply auto
5.4860 - done
5.4861 - also have " \<dots> \<le> card (S -{y})"
5.4862 - apply (rule card_image_le)
5.4863 - using fS by simp
5.4864 - also have "\<dots> \<le> card S - 1" using y fS by simp
5.4865 - finally have False using S0 by arith }
5.4866 - then have "x = y" by blast}
5.4867 - then have ?rhs unfolding inj_on_def by blast}
5.4868 - moreover
5.4869 - {assume h: ?rhs
5.4870 - have "f ` S = T"
5.4871 - apply (rule card_subset_eq[OF fT ST])
5.4872 - unfolding card_image[OF h] using c .
5.4873 - then have ?lhs by blast}
5.4874 - ultimately show ?thesis by blast
5.4875 -qed
5.4876 -
5.4877 -lemma linear_surjective_imp_injective:
5.4878 - assumes lf: "linear (f::real ^'n::finite => real ^'n)" and sf: "surj f"
5.4879 - shows "inj f"
5.4880 -proof-
5.4881 - let ?U = "UNIV :: (real ^'n) set"
5.4882 - from basis_exists[of ?U] obtain B
5.4883 - where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
5.4884 - by blast
5.4885 - {fix x assume x: "x \<in> span B" and fx: "f x = 0"
5.4886 - from B(4) have fB: "finite B" by (simp add: hassize_def)
5.4887 - from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
5.4888 - have fBi: "independent (f ` B)"
5.4889 - apply (rule card_le_dim_spanning[of "f ` B" ?U])
5.4890 - apply blast
5.4891 - using sf B(3)
5.4892 - unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
5.4893 - apply blast
5.4894 - using fB apply (blast intro: finite_imageI)
5.4895 - unfolding d
5.4896 - apply (rule card_image_le)
5.4897 - apply (rule fB)
5.4898 - done
5.4899 - have th0: "dim ?U \<le> card (f ` B)"
5.4900 - apply (rule span_card_ge_dim)
5.4901 - apply blast
5.4902 - unfolding span_linear_image[OF lf]
5.4903 - apply (rule subset_trans[where B = "f ` UNIV"])
5.4904 - using sf unfolding surj_def apply blast
5.4905 - apply (rule image_mono)
5.4906 - apply (rule B(3))
5.4907 - apply (metis finite_imageI fB)
5.4908 - done
5.4909 -
5.4910 - moreover have "card (f ` B) \<le> card B"
5.4911 - by (rule card_image_le, rule fB)
5.4912 - ultimately have th1: "card B = card (f ` B)" unfolding d by arith
5.4913 - have fiB: "inj_on f B"
5.4914 - unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast
5.4915 - from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
5.4916 - have "x = 0" by blast}
5.4917 - note th = this
5.4918 - from th show ?thesis unfolding linear_injective_0[OF lf]
5.4919 - using B(3) by blast
5.4920 -qed
5.4921 -
5.4922 -(* Hence either is enough for isomorphism. *)
5.4923 -
5.4924 -lemma left_right_inverse_eq:
5.4925 - assumes fg: "f o g = id" and gh: "g o h = id"
5.4926 - shows "f = h"
5.4927 -proof-
5.4928 - have "f = f o (g o h)" unfolding gh by simp
5.4929 - also have "\<dots> = (f o g) o h" by (simp add: o_assoc)
5.4930 - finally show "f = h" unfolding fg by simp
5.4931 -qed
5.4932 -
5.4933 -lemma isomorphism_expand:
5.4934 - "f o g = id \<and> g o f = id \<longleftrightarrow> (\<forall>x. f(g x) = x) \<and> (\<forall>x. g(f x) = x)"
5.4935 - by (simp add: expand_fun_eq o_def id_def)
5.4936 -
5.4937 -lemma linear_injective_isomorphism:
5.4938 - assumes lf: "linear (f :: real^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
5.4939 - shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
5.4940 -unfolding isomorphism_expand[symmetric]
5.4941 -using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi]
5.4942 -by (metis left_right_inverse_eq)
5.4943 -
5.4944 -lemma linear_surjective_isomorphism:
5.4945 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and sf: "surj f"
5.4946 - shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
5.4947 -unfolding isomorphism_expand[symmetric]
5.4948 -using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
5.4949 -by (metis left_right_inverse_eq)
5.4950 -
5.4951 -(* Left and right inverses are the same for R^N->R^N. *)
5.4952 -
5.4953 -lemma linear_inverse_left:
5.4954 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and lf': "linear f'"
5.4955 - shows "f o f' = id \<longleftrightarrow> f' o f = id"
5.4956 -proof-
5.4957 - {fix f f':: "real ^'n \<Rightarrow> real ^'n"
5.4958 - assume lf: "linear f" "linear f'" and f: "f o f' = id"
5.4959 - from f have sf: "surj f"
5.4960 -
5.4961 - apply (auto simp add: o_def stupid_ext[symmetric] id_def surj_def)
5.4962 - by metis
5.4963 - from linear_surjective_isomorphism[OF lf(1) sf] lf f
5.4964 - have "f' o f = id" unfolding stupid_ext[symmetric] o_def id_def
5.4965 - by metis}
5.4966 - then show ?thesis using lf lf' by metis
5.4967 -qed
5.4968 -
5.4969 -(* Moreover, a one-sided inverse is automatically linear. *)
5.4970 -
5.4971 -lemma left_inverse_linear:
5.4972 - assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and gf: "g o f = id"
5.4973 - shows "linear g"
5.4974 -proof-
5.4975 - from gf have fi: "inj f" apply (auto simp add: inj_on_def o_def id_def stupid_ext[symmetric])
5.4976 - by metis
5.4977 - from linear_injective_isomorphism[OF lf fi]
5.4978 - obtain h:: "real ^'n \<Rightarrow> real ^'n" where
5.4979 - h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
5.4980 - have "h = g" apply (rule ext) using gf h(2,3)
5.4981 - apply (simp add: o_def id_def stupid_ext[symmetric])
5.4982 - by metis
5.4983 - with h(1) show ?thesis by blast
5.4984 -qed
5.4985 -
5.4986 -lemma right_inverse_linear:
5.4987 - assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and gf: "f o g = id"
5.4988 - shows "linear g"
5.4989 -proof-
5.4990 - from gf have fi: "surj f" apply (auto simp add: surj_def o_def id_def stupid_ext[symmetric])
5.4991 - by metis
5.4992 - from linear_surjective_isomorphism[OF lf fi]
5.4993 - obtain h:: "real ^'n \<Rightarrow> real ^'n" where
5.4994 - h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
5.4995 - have "h = g" apply (rule ext) using gf h(2,3)
5.4996 - apply (simp add: o_def id_def stupid_ext[symmetric])
5.4997 - by metis
5.4998 - with h(1) show ?thesis by blast
5.4999 -qed
5.5000 -
5.5001 -(* The same result in terms of square matrices. *)
5.5002 -
5.5003 -lemma matrix_left_right_inverse:
5.5004 - fixes A A' :: "real ^'n::finite^'n"
5.5005 - shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
5.5006 -proof-
5.5007 - {fix A A' :: "real ^'n^'n" assume AA': "A ** A' = mat 1"
5.5008 - have sA: "surj (op *v A)"
5.5009 - unfolding surj_def
5.5010 - apply clarify
5.5011 - apply (rule_tac x="(A' *v y)" in exI)
5.5012 - by (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid)
5.5013 - from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA]
5.5014 - obtain f' :: "real ^'n \<Rightarrow> real ^'n"
5.5015 - where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
5.5016 - have th: "matrix f' ** A = mat 1"
5.5017 - by (simp add: matrix_eq matrix_works[OF f'(1)] matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format])
5.5018 - hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
5.5019 - hence "matrix f' = A'" by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid)
5.5020 - hence "matrix f' ** A = A' ** A" by simp
5.5021 - hence "A' ** A = mat 1" by (simp add: th)}
5.5022 - then show ?thesis by blast
5.5023 -qed
5.5024 -
5.5025 -(* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *)
5.5026 -
5.5027 -definition "rowvector v = (\<chi> i j. (v$j))"
5.5028 -
5.5029 -definition "columnvector v = (\<chi> i j. (v$i))"
5.5030 -
5.5031 -lemma transp_columnvector:
5.5032 - "transp(columnvector v) = rowvector v"
5.5033 - by (simp add: transp_def rowvector_def columnvector_def Cart_eq)
5.5034 -
5.5035 -lemma transp_rowvector: "transp(rowvector v) = columnvector v"
5.5036 - by (simp add: transp_def columnvector_def rowvector_def Cart_eq)
5.5037 -
5.5038 -lemma dot_rowvector_columnvector:
5.5039 - "columnvector (A *v v) = A ** columnvector v"
5.5040 - by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def)
5.5041 -
5.5042 -lemma dot_matrix_product: "(x::'a::semiring_1^'n::finite) \<bullet> y = (((rowvector x ::'a^'n^1) ** (columnvector y :: 'a^1^'n))$1)$1"
5.5043 - by (vector matrix_matrix_mult_def rowvector_def columnvector_def dot_def)
5.5044 -
5.5045 -lemma dot_matrix_vector_mul:
5.5046 - fixes A B :: "real ^'n::finite ^'n" and x y :: "real ^'n"
5.5047 - shows "(A *v x) \<bullet> (B *v y) =
5.5048 - (((rowvector x :: real^'n^1) ** ((transp A ** B) ** (columnvector y :: real ^1^'n)))$1)$1"
5.5049 -unfolding dot_matrix_product transp_columnvector[symmetric]
5.5050 - dot_rowvector_columnvector matrix_transp_mul matrix_mul_assoc ..
5.5051 -
5.5052 -(* Infinity norm. *)
5.5053 -
5.5054 -definition "infnorm (x::real^'n::finite) = rsup {abs(x$i) |i. i\<in> (UNIV :: 'n set)}"
5.5055 -
5.5056 -lemma numseg_dimindex_nonempty: "\<exists>i. i \<in> (UNIV :: 'n set)"
5.5057 - by auto
5.5058 -
5.5059 -lemma infnorm_set_image:
5.5060 - "{abs(x$i) |i. i\<in> (UNIV :: 'n set)} =
5.5061 - (\<lambda>i. abs(x$i)) ` (UNIV :: 'n set)" by blast
5.5062 -
5.5063 -lemma infnorm_set_lemma:
5.5064 - shows "finite {abs((x::'a::abs ^'n::finite)$i) |i. i\<in> (UNIV :: 'n set)}"
5.5065 - and "{abs(x$i) |i. i\<in> (UNIV :: 'n::finite set)} \<noteq> {}"
5.5066 - unfolding infnorm_set_image
5.5067 - by (auto intro: finite_imageI)
5.5068 -
5.5069 -lemma infnorm_pos_le: "0 \<le> infnorm (x::real^'n::finite)"
5.5070 - unfolding infnorm_def
5.5071 - unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
5.5072 - unfolding infnorm_set_image
5.5073 - by auto
5.5074 -
5.5075 -lemma infnorm_triangle: "infnorm ((x::real^'n::finite) + y) \<le> infnorm x + infnorm y"
5.5076 -proof-
5.5077 - have th: "\<And>x y (z::real). x - y <= z \<longleftrightarrow> x - z <= y" by arith
5.5078 - have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
5.5079 - have th2: "\<And>x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith
5.5080 - show ?thesis
5.5081 - unfolding infnorm_def
5.5082 - unfolding rsup_finite_le_iff[ OF infnorm_set_lemma]
5.5083 - apply (subst diff_le_eq[symmetric])
5.5084 - unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
5.5085 - unfolding infnorm_set_image bex_simps
5.5086 - apply (subst th)
5.5087 - unfolding th1
5.5088 - unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
5.5089 -
5.5090 - unfolding infnorm_set_image ball_simps bex_simps
5.5091 - apply simp
5.5092 - apply (metis th2)
5.5093 - done
5.5094 -qed
5.5095 -
5.5096 -lemma infnorm_eq_0: "infnorm x = 0 \<longleftrightarrow> (x::real ^'n::finite) = 0"
5.5097 -proof-
5.5098 - have "infnorm x <= 0 \<longleftrightarrow> x = 0"
5.5099 - unfolding infnorm_def
5.5100 - unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
5.5101 - unfolding infnorm_set_image ball_simps
5.5102 - by vector
5.5103 - then show ?thesis using infnorm_pos_le[of x] by simp
5.5104 -qed
5.5105 -
5.5106 -lemma infnorm_0: "infnorm 0 = 0"
5.5107 - by (simp add: infnorm_eq_0)
5.5108 -
5.5109 -lemma infnorm_neg: "infnorm (- x) = infnorm x"
5.5110 - unfolding infnorm_def
5.5111 - apply (rule cong[of "rsup" "rsup"])
5.5112 - apply blast
5.5113 - apply (rule set_ext)
5.5114 - apply auto
5.5115 - done
5.5116 -
5.5117 -lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
5.5118 -proof-
5.5119 - have "y - x = - (x - y)" by simp
5.5120 - then show ?thesis by (metis infnorm_neg)
5.5121 -qed
5.5122 -
5.5123 -lemma real_abs_sub_infnorm: "\<bar> infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
5.5124 -proof-
5.5125 - have th: "\<And>(nx::real) n ny. nx <= n + ny \<Longrightarrow> ny <= n + nx ==> \<bar>nx - ny\<bar> <= n"
5.5126 - by arith
5.5127 - from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
5.5128 - have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
5.5129 - "infnorm y \<le> infnorm (x - y) + infnorm x"
5.5130 - by (simp_all add: ring_simps infnorm_neg diff_def[symmetric])
5.5131 - from th[OF ths] show ?thesis .
5.5132 -qed
5.5133 -
5.5134 -lemma real_abs_infnorm: " \<bar>infnorm x\<bar> = infnorm x"
5.5135 - using infnorm_pos_le[of x] by arith
5.5136 -
5.5137 -lemma component_le_infnorm:
5.5138 - shows "\<bar>x$i\<bar> \<le> infnorm (x::real^'n::finite)"
5.5139 -proof-
5.5140 - let ?U = "UNIV :: 'n set"
5.5141 - let ?S = "{\<bar>x$i\<bar> |i. i\<in> ?U}"
5.5142 - have fS: "finite ?S" unfolding image_Collect[symmetric]
5.5143 - apply (rule finite_imageI) unfolding Collect_def mem_def by simp
5.5144 - have S0: "?S \<noteq> {}" by blast
5.5145 - have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
5.5146 - from rsup_finite_in[OF fS S0] rsup_finite_Ub[OF fS S0]
5.5147 - show ?thesis unfolding infnorm_def isUb_def setle_def
5.5148 - unfolding infnorm_set_image ball_simps by auto
5.5149 -qed
5.5150 -
5.5151 -lemma infnorm_mul_lemma: "infnorm(a *s x) <= \<bar>a\<bar> * infnorm x"
5.5152 - apply (subst infnorm_def)
5.5153 - unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
5.5154 - unfolding infnorm_set_image ball_simps
5.5155 - apply (simp add: abs_mult)
5.5156 - apply (rule allI)
5.5157 - apply (cut_tac component_le_infnorm[of x])
5.5158 - apply (rule mult_mono)
5.5159 - apply auto
5.5160 - done
5.5161 -
5.5162 -lemma infnorm_mul: "infnorm(a *s x) = abs a * infnorm x"
5.5163 -proof-
5.5164 - {assume a0: "a = 0" hence ?thesis by (simp add: infnorm_0) }
5.5165 - moreover
5.5166 - {assume a0: "a \<noteq> 0"
5.5167 - from a0 have th: "(1/a) *s (a *s x) = x"
5.5168 - by (simp add: vector_smult_assoc)
5.5169 - from a0 have ap: "\<bar>a\<bar> > 0" by arith
5.5170 - from infnorm_mul_lemma[of "1/a" "a *s x"]
5.5171 - have "infnorm x \<le> 1/\<bar>a\<bar> * infnorm (a*s x)"
5.5172 - unfolding th by simp
5.5173 - with ap have "\<bar>a\<bar> * infnorm x \<le> \<bar>a\<bar> * (1/\<bar>a\<bar> * infnorm (a *s x))" by (simp add: field_simps)
5.5174 - then have "\<bar>a\<bar> * infnorm x \<le> infnorm (a*s x)"
5.5175 - using ap by (simp add: field_simps)
5.5176 - with infnorm_mul_lemma[of a x] have ?thesis by arith }
5.5177 - ultimately show ?thesis by blast
5.5178 -qed
5.5179 -
5.5180 -lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
5.5181 - using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
5.5182 -
5.5183 -(* Prove that it differs only up to a bound from Euclidean norm. *)
5.5184 -
5.5185 -lemma infnorm_le_norm: "infnorm x \<le> norm x"
5.5186 - unfolding infnorm_def rsup_finite_le_iff[OF infnorm_set_lemma]
5.5187 - unfolding infnorm_set_image ball_simps
5.5188 - by (metis component_le_norm)
5.5189 -lemma card_enum: "card {1 .. n} = n" by auto
5.5190 -lemma norm_le_infnorm: "norm(x) <= sqrt(real CARD('n)) * infnorm(x::real ^'n::finite)"
5.5191 -proof-
5.5192 - let ?d = "CARD('n)"
5.5193 - have "real ?d \<ge> 0" by simp
5.5194 - hence d2: "(sqrt (real ?d))^2 = real ?d"
5.5195 - by (auto intro: real_sqrt_pow2)
5.5196 - have th: "sqrt (real ?d) * infnorm x \<ge> 0"
5.5197 - by (simp add: zero_le_mult_iff real_sqrt_ge_0_iff infnorm_pos_le)
5.5198 - have th1: "x\<bullet>x \<le> (sqrt (real ?d) * infnorm x)^2"
5.5199 - unfolding power_mult_distrib d2
5.5200 - apply (subst power2_abs[symmetric])
5.5201 - unfolding real_of_nat_def dot_def power2_eq_square[symmetric]
5.5202 - apply (subst power2_abs[symmetric])
5.5203 - apply (rule setsum_bounded)
5.5204 - apply (rule power_mono)
5.5205 - unfolding abs_of_nonneg[OF infnorm_pos_le]
5.5206 - unfolding infnorm_def rsup_finite_ge_iff[OF infnorm_set_lemma]
5.5207 - unfolding infnorm_set_image bex_simps
5.5208 - apply blast
5.5209 - by (rule abs_ge_zero)
5.5210 - from real_le_lsqrt[OF dot_pos_le th th1]
5.5211 - show ?thesis unfolding real_vector_norm_def id_def .
5.5212 -qed
5.5213 -
5.5214 -(* Equality in Cauchy-Schwarz and triangle inequalities. *)
5.5215 -
5.5216 -lemma norm_cauchy_schwarz_eq: "(x::real ^'n::finite) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
5.5217 -proof-
5.5218 - {assume h: "x = 0"
5.5219 - hence ?thesis by simp}
5.5220 - moreover
5.5221 - {assume h: "y = 0"
5.5222 - hence ?thesis by simp}
5.5223 - moreover
5.5224 - {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
5.5225 - from dot_eq_0[of "norm y *s x - norm x *s y"]
5.5226 - have "?rhs \<longleftrightarrow> (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) - norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) = 0)"
5.5227 - using x y
5.5228 - unfolding dot_rsub dot_lsub dot_lmult dot_rmult
5.5229 - unfolding norm_pow_2[symmetric] power2_eq_square diff_eq_0_iff_eq apply (simp add: dot_sym)
5.5230 - apply (simp add: ring_simps)
5.5231 - apply metis
5.5232 - done
5.5233 - also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
5.5234 - by (simp add: ring_simps dot_sym)
5.5235 - also have "\<dots> \<longleftrightarrow> ?lhs" using x y
5.5236 - apply simp
5.5237 - by metis
5.5238 - finally have ?thesis by blast}
5.5239 - ultimately show ?thesis by blast
5.5240 -qed
5.5241 -
5.5242 -lemma norm_cauchy_schwarz_abs_eq:
5.5243 - fixes x y :: "real ^ 'n::finite"
5.5244 - shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow>
5.5245 - norm x *s y = norm y *s x \<or> norm(x) *s y = - norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
5.5246 -proof-
5.5247 - have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
5.5248 - have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
5.5249 - apply simp by vector
5.5250 - also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
5.5251 - (-x) \<bullet> y = norm x * norm y)"
5.5252 - unfolding norm_cauchy_schwarz_eq[symmetric]
5.5253 - unfolding norm_minus_cancel
5.5254 - norm_mul by blast
5.5255 - also have "\<dots> \<longleftrightarrow> ?lhs"
5.5256 - unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
5.5257 - by arith
5.5258 - finally show ?thesis ..
5.5259 -qed
5.5260 -
5.5261 -lemma norm_triangle_eq:
5.5262 - fixes x y :: "real ^ 'n::finite"
5.5263 - shows "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
5.5264 -proof-
5.5265 - {assume x: "x =0 \<or> y =0"
5.5266 - hence ?thesis by (cases "x=0", simp_all)}
5.5267 - moreover
5.5268 - {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
5.5269 - hence "norm x \<noteq> 0" "norm y \<noteq> 0"
5.5270 - by simp_all
5.5271 - hence n: "norm x > 0" "norm y > 0"
5.5272 - using norm_ge_zero[of x] norm_ge_zero[of y]
5.5273 - by arith+
5.5274 - have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
5.5275 - have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
5.5276 - apply (rule th) using n norm_ge_zero[of "x + y"]
5.5277 - by arith
5.5278 - also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
5.5279 - unfolding norm_cauchy_schwarz_eq[symmetric]
5.5280 - unfolding norm_pow_2 dot_ladd dot_radd
5.5281 - by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym ring_simps)
5.5282 - finally have ?thesis .}
5.5283 - ultimately show ?thesis by blast
5.5284 -qed
5.5285 -
5.5286 -(* Collinearity.*)
5.5287 -
5.5288 -definition "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *s u)"
5.5289 -
5.5290 -lemma collinear_empty: "collinear {}" by (simp add: collinear_def)
5.5291 -
5.5292 -lemma collinear_sing: "collinear {(x::'a::ring_1^'n)}"
5.5293 - apply (simp add: collinear_def)
5.5294 - apply (rule exI[where x=0])
5.5295 - by simp
5.5296 -
5.5297 -lemma collinear_2: "collinear {(x::'a::ring_1^'n),y}"
5.5298 - apply (simp add: collinear_def)
5.5299 - apply (rule exI[where x="x - y"])
5.5300 - apply auto
5.5301 - apply (rule exI[where x=0], simp)
5.5302 - apply (rule exI[where x=1], simp)
5.5303 - apply (rule exI[where x="- 1"], simp add: vector_sneg_minus1[symmetric])
5.5304 - apply (rule exI[where x=0], simp)
5.5305 - done
5.5306 -
5.5307 -lemma collinear_lemma: "collinear {(0::real^'n),x,y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *s x)" (is "?lhs \<longleftrightarrow> ?rhs")
5.5308 -proof-
5.5309 - {assume "x=0 \<or> y = 0" hence ?thesis
5.5310 - by (cases "x = 0", simp_all add: collinear_2 insert_commute)}
5.5311 - moreover
5.5312 - {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
5.5313 - {assume h: "?lhs"
5.5314 - then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *s u" unfolding collinear_def by blast
5.5315 - from u[rule_format, of x 0] u[rule_format, of y 0]
5.5316 - obtain cx and cy where
5.5317 - cx: "x = cx*s u" and cy: "y = cy*s u"
5.5318 - by auto
5.5319 - from cx x have cx0: "cx \<noteq> 0" by auto
5.5320 - from cy y have cy0: "cy \<noteq> 0" by auto
5.5321 - let ?d = "cy / cx"
5.5322 - from cx cy cx0 have "y = ?d *s x"
5.5323 - by (simp add: vector_smult_assoc)
5.5324 - hence ?rhs using x y by blast}
5.5325 - moreover
5.5326 - {assume h: "?rhs"
5.5327 - then obtain c where c: "y = c*s x" using x y by blast
5.5328 - have ?lhs unfolding collinear_def c
5.5329 - apply (rule exI[where x=x])
5.5330 - apply auto
5.5331 - apply (rule exI[where x="- 1"], simp only: vector_smult_lneg vector_smult_lid)
5.5332 - apply (rule exI[where x= "-c"], simp only: vector_smult_lneg)
5.5333 - apply (rule exI[where x=1], simp)
5.5334 - apply (rule exI[where x="1 - c"], simp add: vector_smult_lneg vector_sub_rdistrib)
5.5335 - apply (rule exI[where x="c - 1"], simp add: vector_smult_lneg vector_sub_rdistrib)
5.5336 - done}
5.5337 - ultimately have ?thesis by blast}
5.5338 - ultimately show ?thesis by blast
5.5339 -qed
5.5340 -
5.5341 -lemma norm_cauchy_schwarz_equal:
5.5342 - fixes x y :: "real ^ 'n::finite"
5.5343 - shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
5.5344 -unfolding norm_cauchy_schwarz_abs_eq
5.5345 -apply (cases "x=0", simp_all add: collinear_2)
5.5346 -apply (cases "y=0", simp_all add: collinear_2 insert_commute)
5.5347 -unfolding collinear_lemma
5.5348 -apply simp
5.5349 -apply (subgoal_tac "norm x \<noteq> 0")
5.5350 -apply (subgoal_tac "norm y \<noteq> 0")
5.5351 -apply (rule iffI)
5.5352 -apply (cases "norm x *s y = norm y *s x")
5.5353 -apply (rule exI[where x="(1/norm x) * norm y"])
5.5354 -apply (drule sym)
5.5355 -unfolding vector_smult_assoc[symmetric]
5.5356 -apply (simp add: vector_smult_assoc field_simps)
5.5357 -apply (rule exI[where x="(1/norm x) * - norm y"])
5.5358 -apply clarify
5.5359 -apply (drule sym)
5.5360 -unfolding vector_smult_assoc[symmetric]
5.5361 -apply (simp add: vector_smult_assoc field_simps)
5.5362 -apply (erule exE)
5.5363 -apply (erule ssubst)
5.5364 -unfolding vector_smult_assoc
5.5365 -unfolding norm_mul
5.5366 -apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
5.5367 -apply (case_tac "c <= 0", simp add: ring_simps)
5.5368 -apply (simp add: ring_simps)
5.5369 -apply (case_tac "c <= 0", simp add: ring_simps)
5.5370 -apply (simp add: ring_simps)
5.5371 -apply simp
5.5372 -apply simp
5.5373 -done
5.5374 -
5.5375 -end
6.1 --- a/src/HOL/Library/Finite_Cartesian_Product.thy Fri Oct 23 14:33:07 2009 +0200
6.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
6.3 @@ -1,95 +0,0 @@
6.4 -(* Title: HOL/Library/Finite_Cartesian_Product
6.5 - Author: Amine Chaieb, University of Cambridge
6.6 -*)
6.7 -
6.8 -header {* Definition of finite Cartesian product types. *}
6.9 -
6.10 -theory Finite_Cartesian_Product
6.11 -imports Main (*FIXME: ATP_Linkup is only needed for metis at a few places. We could dispense of that by changing the proofs.*)
6.12 -begin
6.13 -
6.14 -definition hassize (infixr "hassize" 12) where
6.15 - "(S hassize n) = (finite S \<and> card S = n)"
6.16 -
6.17 -lemma hassize_image_inj: assumes f: "inj_on f S" and S: "S hassize n"
6.18 - shows "f ` S hassize n"
6.19 - using f S card_image[OF f]
6.20 - by (simp add: hassize_def inj_on_def)
6.21 -
6.22 -
6.23 -subsection {* Finite Cartesian products, with indexing and lambdas. *}
6.24 -
6.25 -typedef (open Cart)
6.26 - ('a, 'b) "^" (infixl "^" 15)
6.27 - = "UNIV :: ('b \<Rightarrow> 'a) set"
6.28 - morphisms Cart_nth Cart_lambda ..
6.29 -
6.30 -notation Cart_nth (infixl "$" 90)
6.31 -
6.32 -notation (xsymbols) Cart_lambda (binder "\<chi>" 10)
6.33 -
6.34 -lemma stupid_ext: "(\<forall>x. f x = g x) \<longleftrightarrow> (f = g)"
6.35 - apply auto
6.36 - apply (rule ext)
6.37 - apply auto
6.38 - done
6.39 -
6.40 -lemma Cart_eq: "((x:: 'a ^ 'b) = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
6.41 - by (simp add: Cart_nth_inject [symmetric] expand_fun_eq)
6.42 -
6.43 -lemma Cart_lambda_beta [simp]: "Cart_lambda g $ i = g i"
6.44 - by (simp add: Cart_lambda_inverse)
6.45 -
6.46 -lemma Cart_lambda_unique:
6.47 - fixes f :: "'a ^ 'b"
6.48 - shows "(\<forall>i. f$i = g i) \<longleftrightarrow> Cart_lambda g = f"
6.49 - by (auto simp add: Cart_eq)
6.50 -
6.51 -lemma Cart_lambda_eta: "(\<chi> i. (g$i)) = g"
6.52 - by (simp add: Cart_eq)
6.53 -
6.54 -text{* A non-standard sum to "paste" Cartesian products. *}
6.55 -
6.56 -definition pastecart :: "'a ^ 'm \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ ('m + 'n)" where
6.57 - "pastecart f g = (\<chi> i. case i of Inl a \<Rightarrow> f$a | Inr b \<Rightarrow> g$b)"
6.58 -
6.59 -definition fstcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'm" where
6.60 - "fstcart f = (\<chi> i. (f$(Inl i)))"
6.61 -
6.62 -definition sndcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'n" where
6.63 - "sndcart f = (\<chi> i. (f$(Inr i)))"
6.64 -
6.65 -lemma nth_pastecart_Inl [simp]: "pastecart f g $ Inl a = f$a"
6.66 - unfolding pastecart_def by simp
6.67 -
6.68 -lemma nth_pastecart_Inr [simp]: "pastecart f g $ Inr b = g$b"
6.69 - unfolding pastecart_def by simp
6.70 -
6.71 -lemma nth_fstcart [simp]: "fstcart f $ i = f $ Inl i"
6.72 - unfolding fstcart_def by simp
6.73 -
6.74 -lemma nth_sndtcart [simp]: "sndcart f $ i = f $ Inr i"
6.75 - unfolding sndcart_def by simp
6.76 -
6.77 -lemma finite_sum_image: "(UNIV::('a + 'b) set) = range Inl \<union> range Inr"
6.78 -by (auto, case_tac x, auto)
6.79 -
6.80 -lemma fstcart_pastecart: "fstcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = x"
6.81 - by (simp add: Cart_eq)
6.82 -
6.83 -lemma sndcart_pastecart: "sndcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = y"
6.84 - by (simp add: Cart_eq)
6.85 -
6.86 -lemma pastecart_fst_snd: "pastecart (fstcart z) (sndcart z) = z"
6.87 - by (simp add: Cart_eq pastecart_def fstcart_def sndcart_def split: sum.split)
6.88 -
6.89 -lemma pastecart_eq: "(x = y) \<longleftrightarrow> (fstcart x = fstcart y) \<and> (sndcart x = sndcart y)"
6.90 - using pastecart_fst_snd[of x] pastecart_fst_snd[of y] by metis
6.91 -
6.92 -lemma forall_pastecart: "(\<forall>p. P p) \<longleftrightarrow> (\<forall>x y. P (pastecart x y))"
6.93 - by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
6.94 -
6.95 -lemma exists_pastecart: "(\<exists>p. P p) \<longleftrightarrow> (\<exists>x y. P (pastecart x y))"
6.96 - by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
6.97 -
6.98 -end
7.1 --- a/src/HOL/Library/Library.thy Fri Oct 23 14:33:07 2009 +0200
7.2 +++ b/src/HOL/Library/Library.thy Fri Oct 23 13:23:18 2009 +0200
7.3 @@ -14,9 +14,7 @@
7.4 Commutative_Ring
7.5 Continuity
7.6 ContNotDenum
7.7 - Convex_Euclidean_Space
7.8 Countable
7.9 - Determinants
7.10 Diagonalize
7.11 Efficient_Nat
7.12 Enum
7.13 @@ -54,7 +52,6 @@
7.14 RBT
7.15 State_Monad
7.16 Sum_Of_Squares
7.17 - Topology_Euclidean_Space
7.18 Univ_Poly
7.19 While_Combinator
7.20 Word
8.1 --- a/src/HOL/Library/Topology_Euclidean_Space.thy Fri Oct 23 14:33:07 2009 +0200
8.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
8.3 @@ -1,6027 +0,0 @@
8.4 -(* Title: HOL/Library/Topology_Euclidian_Space.thy
8.5 - Author: Amine Chaieb, University of Cambridge
8.6 - Author: Robert Himmelmann, TU Muenchen
8.7 -*)
8.8 -
8.9 -header {* Elementary topology in Euclidean space. *}
8.10 -
8.11 -theory Topology_Euclidean_Space
8.12 -imports SEQ Euclidean_Space Product_Vector
8.13 -begin
8.14 -
8.15 -declare fstcart_pastecart[simp] sndcart_pastecart[simp]
8.16 -
8.17 -subsection{* General notion of a topology *}
8.18 -
8.19 -definition "istopology L \<longleftrightarrow> {} \<in> L \<and> (\<forall>S \<in>L. \<forall>T \<in>L. S \<inter> T \<in> L) \<and> (\<forall>K. K \<subseteq>L \<longrightarrow> \<Union> K \<in> L)"
8.20 -typedef (open) 'a topology = "{L::('a set) set. istopology L}"
8.21 - morphisms "openin" "topology"
8.22 - unfolding istopology_def by blast
8.23 -
8.24 -lemma istopology_open_in[intro]: "istopology(openin U)"
8.25 - using openin[of U] by blast
8.26 -
8.27 -lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
8.28 - using topology_inverse[unfolded mem_def Collect_def] .
8.29 -
8.30 -lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
8.31 - using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
8.32 -
8.33 -lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
8.34 -proof-
8.35 - {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
8.36 - moreover
8.37 - {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
8.38 - hence "openin T1 = openin T2" by (metis mem_def set_ext)
8.39 - hence "topology (openin T1) = topology (openin T2)" by simp
8.40 - hence "T1 = T2" unfolding openin_inverse .}
8.41 - ultimately show ?thesis by blast
8.42 -qed
8.43 -
8.44 -text{* Infer the "universe" from union of all sets in the topology. *}
8.45 -
8.46 -definition "topspace T = \<Union>{S. openin T S}"
8.47 -
8.48 -subsection{* Main properties of open sets *}
8.49 -
8.50 -lemma openin_clauses:
8.51 - fixes U :: "'a topology"
8.52 - shows "openin U {}"
8.53 - "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
8.54 - "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
8.55 - using openin[of U] unfolding istopology_def Collect_def mem_def
8.56 - by (metis mem_def subset_eq)+
8.57 -
8.58 -lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
8.59 - unfolding topspace_def by blast
8.60 -lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
8.61 -
8.62 -lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
8.63 - by (simp add: openin_clauses)
8.64 -
8.65 -lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
8.66 -
8.67 -lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
8.68 - using openin_Union[of "{S,T}" U] by auto
8.69 -
8.70 -lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
8.71 -
8.72 -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")
8.73 -proof-
8.74 - {assume ?lhs then have ?rhs by auto }
8.75 - moreover
8.76 - {assume H: ?rhs
8.77 - then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
8.78 - unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
8.79 - from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
8.80 - have "\<Union> t`S = S" using t by auto
8.81 - with openin_Union[OF th0] have "openin U S" by simp }
8.82 - ultimately show ?thesis by blast
8.83 -qed
8.84 -
8.85 -subsection{* Closed sets *}
8.86 -
8.87 -definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
8.88 -
8.89 -lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
8.90 -lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
8.91 -lemma closedin_topspace[intro,simp]:
8.92 - "closedin U (topspace U)" by (simp add: closedin_def)
8.93 -lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
8.94 - by (auto simp add: Diff_Un closedin_def)
8.95 -
8.96 -lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
8.97 -lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
8.98 - shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
8.99 -
8.100 -lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
8.101 - using closedin_Inter[of "{S,T}" U] by auto
8.102 -
8.103 -lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
8.104 -lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
8.105 - apply (auto simp add: closedin_def Diff_Diff_Int inf_absorb2)
8.106 - apply (metis openin_subset subset_eq)
8.107 - done
8.108 -
8.109 -lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
8.110 - by (simp add: openin_closedin_eq)
8.111 -
8.112 -lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
8.113 -proof-
8.114 - have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
8.115 - by (auto simp add: topspace_def openin_subset)
8.116 - then show ?thesis using oS cT by (auto simp add: closedin_def)
8.117 -qed
8.118 -
8.119 -lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
8.120 -proof-
8.121 - have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
8.122 - by (auto simp add: topspace_def )
8.123 - then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
8.124 -qed
8.125 -
8.126 -subsection{* Subspace topology. *}
8.127 -
8.128 -definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
8.129 -
8.130 -lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
8.131 -proof-
8.132 - have "{} \<in> ?L" by blast
8.133 - {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
8.134 - 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
8.135 - have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
8.136 - then have "A \<inter> B \<in> ?L" by blast}
8.137 - moreover
8.138 - {fix K assume K: "K \<subseteq> ?L"
8.139 - have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
8.140 - apply (rule set_ext)
8.141 - apply (simp add: Ball_def image_iff)
8.142 - by (metis mem_def)
8.143 - from K[unfolded th0 subset_image_iff]
8.144 - obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
8.145 - have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
8.146 - moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
8.147 - ultimately have "\<Union>K \<in> ?L" by blast}
8.148 - ultimately show ?thesis unfolding istopology_def by blast
8.149 -qed
8.150 -
8.151 -lemma openin_subtopology:
8.152 - "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
8.153 - unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
8.154 - by (auto simp add: Collect_def)
8.155 -
8.156 -lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
8.157 - by (auto simp add: topspace_def openin_subtopology)
8.158 -
8.159 -lemma closedin_subtopology:
8.160 - "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
8.161 - unfolding closedin_def topspace_subtopology
8.162 - apply (simp add: openin_subtopology)
8.163 - apply (rule iffI)
8.164 - apply clarify
8.165 - apply (rule_tac x="topspace U - T" in exI)
8.166 - by auto
8.167 -
8.168 -lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
8.169 - unfolding openin_subtopology
8.170 - apply (rule iffI, clarify)
8.171 - apply (frule openin_subset[of U]) apply blast
8.172 - apply (rule exI[where x="topspace U"])
8.173 - by auto
8.174 -
8.175 -lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
8.176 - shows "subtopology U V = U"
8.177 -proof-
8.178 - {fix S
8.179 - {fix T assume T: "openin U T" "S = T \<inter> V"
8.180 - from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
8.181 - have "openin U S" unfolding eq using T by blast}
8.182 - moreover
8.183 - {assume S: "openin U S"
8.184 - hence "\<exists>T. openin U T \<and> S = T \<inter> V"
8.185 - using openin_subset[OF S] UV by auto}
8.186 - ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
8.187 - then show ?thesis unfolding topology_eq openin_subtopology by blast
8.188 -qed
8.189 -
8.190 -
8.191 -lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
8.192 - by (simp add: subtopology_superset)
8.193 -
8.194 -lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
8.195 - by (simp add: subtopology_superset)
8.196 -
8.197 -subsection{* The universal Euclidean versions are what we use most of the time *}
8.198 -
8.199 -definition
8.200 - euclidean :: "'a::topological_space topology" where
8.201 - "euclidean = topology open"
8.202 -
8.203 -lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
8.204 - unfolding euclidean_def
8.205 - apply (rule cong[where x=S and y=S])
8.206 - apply (rule topology_inverse[symmetric])
8.207 - apply (auto simp add: istopology_def)
8.208 - by (auto simp add: mem_def subset_eq)
8.209 -
8.210 -lemma topspace_euclidean: "topspace euclidean = UNIV"
8.211 - apply (simp add: topspace_def)
8.212 - apply (rule set_ext)
8.213 - by (auto simp add: open_openin[symmetric])
8.214 -
8.215 -lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
8.216 - by (simp add: topspace_euclidean topspace_subtopology)
8.217 -
8.218 -lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
8.219 - by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
8.220 -
8.221 -lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
8.222 - by (simp add: open_openin openin_subopen[symmetric])
8.223 -
8.224 -subsection{* Open and closed balls. *}
8.225 -
8.226 -definition
8.227 - ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
8.228 - "ball x e = {y. dist x y < e}"
8.229 -
8.230 -definition
8.231 - cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
8.232 - "cball x e = {y. dist x y \<le> e}"
8.233 -
8.234 -lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
8.235 -lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
8.236 -
8.237 -lemma mem_ball_0 [simp]:
8.238 - fixes x :: "'a::real_normed_vector"
8.239 - shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
8.240 - by (simp add: dist_norm)
8.241 -
8.242 -lemma mem_cball_0 [simp]:
8.243 - fixes x :: "'a::real_normed_vector"
8.244 - shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
8.245 - by (simp add: dist_norm)
8.246 -
8.247 -lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
8.248 -lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
8.249 -lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
8.250 -lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
8.251 -lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
8.252 - by (simp add: expand_set_eq) arith
8.253 -
8.254 -lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
8.255 - by (simp add: expand_set_eq)
8.256 -
8.257 -subsection{* Topological properties of open balls *}
8.258 -
8.259 -lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
8.260 - "(a::real) - b < 0 \<longleftrightarrow> a < b"
8.261 - "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
8.262 -lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
8.263 - "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
8.264 -
8.265 -lemma open_ball[intro, simp]: "open (ball x e)"
8.266 - unfolding open_dist ball_def Collect_def Ball_def mem_def
8.267 - unfolding dist_commute
8.268 - apply clarify
8.269 - apply (rule_tac x="e - dist xa x" in exI)
8.270 - using dist_triangle_alt[where z=x]
8.271 - apply (clarsimp simp add: diff_less_iff)
8.272 - apply atomize
8.273 - apply (erule_tac x="y" in allE)
8.274 - apply (erule_tac x="xa" in allE)
8.275 - by arith
8.276 -
8.277 -lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
8.278 -lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
8.279 - unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
8.280 -
8.281 -lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
8.282 - by (metis open_contains_ball subset_eq centre_in_ball)
8.283 -
8.284 -lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
8.285 - unfolding mem_ball expand_set_eq
8.286 - apply (simp add: not_less)
8.287 - by (metis zero_le_dist order_trans dist_self)
8.288 -
8.289 -lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
8.290 -
8.291 -subsection{* Basic "localization" results are handy for connectedness. *}
8.292 -
8.293 -lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
8.294 - by (auto simp add: openin_subtopology open_openin[symmetric])
8.295 -
8.296 -lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
8.297 - by (auto simp add: openin_open)
8.298 -
8.299 -lemma open_openin_trans[trans]:
8.300 - "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
8.301 - by (metis Int_absorb1 openin_open_Int)
8.302 -
8.303 -lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
8.304 - by (auto simp add: openin_open)
8.305 -
8.306 -lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
8.307 - by (simp add: closedin_subtopology closed_closedin Int_ac)
8.308 -
8.309 -lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
8.310 - by (metis closedin_closed)
8.311 -
8.312 -lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
8.313 - apply (subgoal_tac "S \<inter> T = T" )
8.314 - apply auto
8.315 - apply (frule closedin_closed_Int[of T S])
8.316 - by simp
8.317 -
8.318 -lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
8.319 - by (auto simp add: closedin_closed)
8.320 -
8.321 -lemma openin_euclidean_subtopology_iff:
8.322 - fixes S U :: "'a::metric_space set"
8.323 - shows "openin (subtopology euclidean U) S
8.324 - \<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")
8.325 -proof-
8.326 - {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
8.327 - by (simp add: open_dist) blast}
8.328 - moreover
8.329 - {assume SU: "S \<subseteq> U" and H: "\<And>x. x \<in> S \<Longrightarrow> \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x' \<in> S"
8.330 - from H obtain d where d: "\<And>x . x\<in> S \<Longrightarrow> d x > 0 \<and> (\<forall>x' \<in> U. dist x' x < d x \<longrightarrow> x' \<in> S)"
8.331 - by metis
8.332 - let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
8.333 - have oT: "open ?T" by auto
8.334 - { fix x assume "x\<in>S"
8.335 - hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
8.336 - apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
8.337 - by (rule d [THEN conjunct1])
8.338 - hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
8.339 - moreover
8.340 - { fix y assume "y\<in>?T"
8.341 - then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
8.342 - then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
8.343 - assume "y\<in>U"
8.344 - hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
8.345 - ultimately have "S = ?T \<inter> U" by blast
8.346 - with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
8.347 - ultimately show ?thesis by blast
8.348 -qed
8.349 -
8.350 -text{* These "transitivity" results are handy too. *}
8.351 -
8.352 -lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
8.353 - \<Longrightarrow> openin (subtopology euclidean U) S"
8.354 - unfolding open_openin openin_open by blast
8.355 -
8.356 -lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
8.357 - by (auto simp add: openin_open intro: openin_trans)
8.358 -
8.359 -lemma closedin_trans[trans]:
8.360 - "closedin (subtopology euclidean T) S \<Longrightarrow>
8.361 - closedin (subtopology euclidean U) T
8.362 - ==> closedin (subtopology euclidean U) S"
8.363 - by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
8.364 -
8.365 -lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
8.366 - by (auto simp add: closedin_closed intro: closedin_trans)
8.367 -
8.368 -subsection{* Connectedness *}
8.369 -
8.370 -definition "connected S \<longleftrightarrow>
8.371 - ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
8.372 - \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
8.373 -
8.374 -lemma connected_local:
8.375 - "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
8.376 - openin (subtopology euclidean S) e1 \<and>
8.377 - openin (subtopology euclidean S) e2 \<and>
8.378 - S \<subseteq> e1 \<union> e2 \<and>
8.379 - e1 \<inter> e2 = {} \<and>
8.380 - ~(e1 = {}) \<and>
8.381 - ~(e2 = {}))"
8.382 -unfolding connected_def openin_open by (safe, blast+)
8.383 -
8.384 -lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
8.385 -proof-
8.386 -
8.387 - {assume "?lhs" hence ?rhs by blast }
8.388 - moreover
8.389 - {fix S assume H: "P S"
8.390 - have "S = UNIV - (UNIV - S)" by auto
8.391 - with H have "P (UNIV - (UNIV - S))" by metis }
8.392 - ultimately show ?thesis by metis
8.393 -qed
8.394 -
8.395 -lemma connected_clopen: "connected S \<longleftrightarrow>
8.396 - (\<forall>T. openin (subtopology euclidean S) T \<and>
8.397 - closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
8.398 -proof-
8.399 - have " \<not> connected S \<longleftrightarrow> (\<exists>e1 e2. open e1 \<and> open (UNIV - e2) \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
8.400 - unfolding connected_def openin_open closedin_closed
8.401 - apply (subst exists_diff) by blast
8.402 - hence th0: "connected S \<longleftrightarrow> \<not> (\<exists>e2 e1. closed e2 \<and> open e1 \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
8.403 - (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
8.404 -
8.405 - 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'))"
8.406 - (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
8.407 - unfolding connected_def openin_open closedin_closed by auto
8.408 - {fix e2
8.409 - {fix e1 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)"
8.410 - by auto}
8.411 - then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
8.412 - then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
8.413 - then show ?thesis unfolding th0 th1 by simp
8.414 -qed
8.415 -
8.416 -lemma connected_empty[simp, intro]: "connected {}"
8.417 - by (simp add: connected_def)
8.418 -
8.419 -subsection{* Hausdorff and other separation properties *}
8.420 -
8.421 -class t0_space =
8.422 - assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
8.423 -
8.424 -class t1_space =
8.425 - assumes t1_space: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<notin> U \<and> x \<notin> V \<and> y \<in> V"
8.426 -begin
8.427 -
8.428 -subclass t0_space
8.429 -proof
8.430 -qed (fast dest: t1_space)
8.431 -
8.432 -end
8.433 -
8.434 -text {* T2 spaces are also known as Hausdorff spaces. *}
8.435 -
8.436 -class t2_space =
8.437 - assumes hausdorff: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
8.438 -begin
8.439 -
8.440 -subclass t1_space
8.441 -proof
8.442 -qed (fast dest: hausdorff)
8.443 -
8.444 -end
8.445 -
8.446 -instance metric_space \<subseteq> t2_space
8.447 -proof
8.448 - fix x y :: "'a::metric_space"
8.449 - assume xy: "x \<noteq> y"
8.450 - let ?U = "ball x (dist x y / 2)"
8.451 - let ?V = "ball y (dist x y / 2)"
8.452 - have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
8.453 - ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
8.454 - have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
8.455 - using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
8.456 - by (auto simp add: expand_set_eq)
8.457 - then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
8.458 - by blast
8.459 -qed
8.460 -
8.461 -lemma separation_t2:
8.462 - fixes x y :: "'a::t2_space"
8.463 - shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
8.464 - using hausdorff[of x y] by blast
8.465 -
8.466 -lemma separation_t1:
8.467 - fixes x y :: "'a::t1_space"
8.468 - shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in>U \<and> y\<notin> U \<and> x\<notin>V \<and> y\<in>V)"
8.469 - using t1_space[of x y] by blast
8.470 -
8.471 -lemma separation_t0:
8.472 - fixes x y :: "'a::t0_space"
8.473 - shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
8.474 - using t0_space[of x y] by blast
8.475 -
8.476 -subsection{* Limit points *}
8.477 -
8.478 -definition
8.479 - islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
8.480 - (infixr "islimpt" 60) where
8.481 - "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
8.482 -
8.483 -lemma islimptI:
8.484 - assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
8.485 - shows "x islimpt S"
8.486 - using assms unfolding islimpt_def by auto
8.487 -
8.488 -lemma islimptE:
8.489 - assumes "x islimpt S" and "x \<in> T" and "open T"
8.490 - obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
8.491 - using assms unfolding islimpt_def by auto
8.492 -
8.493 -lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
8.494 -
8.495 -lemma islimpt_approachable:
8.496 - fixes x :: "'a::metric_space"
8.497 - shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
8.498 - unfolding islimpt_def
8.499 - apply auto
8.500 - apply(erule_tac x="ball x e" in allE)
8.501 - apply auto
8.502 - apply(rule_tac x=y in bexI)
8.503 - apply (auto simp add: dist_commute)
8.504 - apply (simp add: open_dist, drule (1) bspec)
8.505 - apply (clarify, drule spec, drule (1) mp, auto)
8.506 - done
8.507 -
8.508 -lemma islimpt_approachable_le:
8.509 - fixes x :: "'a::metric_space"
8.510 - shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
8.511 - unfolding islimpt_approachable
8.512 - using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
8.513 - by metis (* FIXME: VERY slow! *)
8.514 -
8.515 -class perfect_space =
8.516 - (* FIXME: perfect_space should inherit from topological_space *)
8.517 - assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
8.518 -
8.519 -lemma perfect_choose_dist:
8.520 - fixes x :: "'a::perfect_space"
8.521 - shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
8.522 -using islimpt_UNIV [of x]
8.523 -by (simp add: islimpt_approachable)
8.524 -
8.525 -instance real :: perfect_space
8.526 -apply default
8.527 -apply (rule islimpt_approachable [THEN iffD2])
8.528 -apply (clarify, rule_tac x="x + e/2" in bexI)
8.529 -apply (auto simp add: dist_norm)
8.530 -done
8.531 -
8.532 -instance "^" :: (perfect_space, finite) perfect_space
8.533 -proof
8.534 - fix x :: "'a ^ 'b"
8.535 - {
8.536 - fix e :: real assume "0 < e"
8.537 - def a \<equiv> "x $ undefined"
8.538 - have "a islimpt UNIV" by (rule islimpt_UNIV)
8.539 - with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
8.540 - unfolding islimpt_approachable by auto
8.541 - def y \<equiv> "Cart_lambda ((Cart_nth x)(undefined := b))"
8.542 - from `b \<noteq> a` have "y \<noteq> x"
8.543 - unfolding a_def y_def by (simp add: Cart_eq)
8.544 - from `dist b a < e` have "dist y x < e"
8.545 - unfolding dist_vector_def a_def y_def
8.546 - apply simp
8.547 - apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
8.548 - apply (subst setsum_diff1' [where a=undefined], simp, simp, simp)
8.549 - done
8.550 - from `y \<noteq> x` and `dist y x < e`
8.551 - have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
8.552 - }
8.553 - then show "x islimpt UNIV" unfolding islimpt_approachable by blast
8.554 -qed
8.555 -
8.556 -lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
8.557 - unfolding closed_def
8.558 - apply (subst open_subopen)
8.559 - apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
8.560 - by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
8.561 -
8.562 -lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
8.563 - unfolding islimpt_def by auto
8.564 -
8.565 -lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
8.566 -proof-
8.567 - let ?U = "UNIV :: 'n set"
8.568 - let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
8.569 - {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
8.570 - and xi: "x$i < 0"
8.571 - from xi have th0: "-x$i > 0" by arith
8.572 - from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
8.573 - have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
8.574 - have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
8.575 - have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
8.576 - apply (simp only: vector_component)
8.577 - by (rule th') auto
8.578 - have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
8.579 - apply (simp add: dist_norm) by norm
8.580 - from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
8.581 - then show ?thesis unfolding closed_limpt islimpt_approachable
8.582 - unfolding not_le[symmetric] by blast
8.583 -qed
8.584 -
8.585 -lemma finite_set_avoid:
8.586 - fixes a :: "'a::metric_space"
8.587 - assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
8.588 -proof(induct rule: finite_induct[OF fS])
8.589 - case 1 thus ?case apply auto by ferrack
8.590 -next
8.591 - case (2 x F)
8.592 - from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
8.593 - {assume "x = a" hence ?case using d by auto }
8.594 - moreover
8.595 - {assume xa: "x\<noteq>a"
8.596 - let ?d = "min d (dist a x)"
8.597 - have dp: "?d > 0" using xa d(1) using dist_nz by auto
8.598 - from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
8.599 - with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
8.600 - ultimately show ?case by blast
8.601 -qed
8.602 -
8.603 -lemma islimpt_finite:
8.604 - fixes S :: "'a::metric_space set"
8.605 - assumes fS: "finite S" shows "\<not> a islimpt S"
8.606 - unfolding islimpt_approachable
8.607 - using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
8.608 -
8.609 -lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
8.610 - apply (rule iffI)
8.611 - defer
8.612 - apply (metis Un_upper1 Un_upper2 islimpt_subset)
8.613 - unfolding islimpt_def
8.614 - apply (rule ccontr, clarsimp, rename_tac A B)
8.615 - apply (drule_tac x="A \<inter> B" in spec)
8.616 - apply (auto simp add: open_Int)
8.617 - done
8.618 -
8.619 -lemma discrete_imp_closed:
8.620 - fixes S :: "'a::metric_space set"
8.621 - assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
8.622 - shows "closed S"
8.623 -proof-
8.624 - {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
8.625 - from e have e2: "e/2 > 0" by arith
8.626 - from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
8.627 - let ?m = "min (e/2) (dist x y) "
8.628 - from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
8.629 - from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
8.630 - have th: "dist z y < e" using z y
8.631 - by (intro dist_triangle_lt [where z=x], simp)
8.632 - from d[rule_format, OF y(1) z(1) th] y z
8.633 - have False by (auto simp add: dist_commute)}
8.634 - then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
8.635 -qed
8.636 -
8.637 -subsection{* Interior of a Set *}
8.638 -definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
8.639 -
8.640 -lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
8.641 - apply (simp add: expand_set_eq interior_def)
8.642 - apply (subst (2) open_subopen) by (safe, blast+)
8.643 -
8.644 -lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
8.645 -
8.646 -lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
8.647 -
8.648 -lemma open_interior[simp, intro]: "open(interior S)"
8.649 - apply (simp add: interior_def)
8.650 - apply (subst open_subopen) by blast
8.651 -
8.652 -lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
8.653 -lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
8.654 -lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
8.655 -lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
8.656 -lemma interior_unique: "T \<subseteq> S \<Longrightarrow> open T \<Longrightarrow> (\<forall>T'. T' \<subseteq> S \<and> open T' \<longrightarrow> T' \<subseteq> T) \<Longrightarrow> interior S = T"
8.657 - by (metis equalityI interior_maximal interior_subset open_interior)
8.658 -lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
8.659 - apply (simp add: interior_def)
8.660 - by (metis open_contains_ball centre_in_ball open_ball subset_trans)
8.661 -
8.662 -lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
8.663 - by (metis interior_maximal interior_subset subset_trans)
8.664 -
8.665 -lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
8.666 - apply (rule equalityI, simp)
8.667 - apply (metis Int_lower1 Int_lower2 subset_interior)
8.668 - by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
8.669 -
8.670 -lemma interior_limit_point [intro]:
8.671 - fixes x :: "'a::perfect_space"
8.672 - assumes x: "x \<in> interior S" shows "x islimpt S"
8.673 -proof-
8.674 - from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
8.675 - unfolding mem_interior subset_eq Ball_def mem_ball by blast
8.676 - {
8.677 - fix d::real assume d: "d>0"
8.678 - let ?m = "min d e"
8.679 - have mde2: "0 < ?m" using e(1) d(1) by simp
8.680 - from perfect_choose_dist [OF mde2, of x]
8.681 - obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
8.682 - then have "dist y x < e" "dist y x < d" by simp_all
8.683 - from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
8.684 - have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
8.685 - using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
8.686 - }
8.687 - then show ?thesis unfolding islimpt_approachable by blast
8.688 -qed
8.689 -
8.690 -lemma interior_closed_Un_empty_interior:
8.691 - assumes cS: "closed S" and iT: "interior T = {}"
8.692 - shows "interior(S \<union> T) = interior S"
8.693 -proof
8.694 - show "interior S \<subseteq> interior (S\<union>T)"
8.695 - by (rule subset_interior, blast)
8.696 -next
8.697 - show "interior (S \<union> T) \<subseteq> interior S"
8.698 - proof
8.699 - fix x assume "x \<in> interior (S \<union> T)"
8.700 - then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
8.701 - unfolding interior_def by fast
8.702 - show "x \<in> interior S"
8.703 - proof (rule ccontr)
8.704 - assume "x \<notin> interior S"
8.705 - with `x \<in> R` `open R` obtain y where "y \<in> R - S"
8.706 - unfolding interior_def expand_set_eq by fast
8.707 - from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
8.708 - from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
8.709 - from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
8.710 - show "False" unfolding interior_def by fast
8.711 - qed
8.712 - qed
8.713 -qed
8.714 -
8.715 -
8.716 -subsection{* Closure of a Set *}
8.717 -
8.718 -definition "closure S = S \<union> {x | x. x islimpt S}"
8.719 -
8.720 -lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
8.721 -proof-
8.722 - { fix x
8.723 - have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
8.724 - proof
8.725 - let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
8.726 - assume "?lhs"
8.727 - hence *:"\<not> ?exT x"
8.728 - unfolding interior_def
8.729 - by simp
8.730 - { assume "\<not> ?rhs"
8.731 - hence False using *
8.732 - unfolding closure_def islimpt_def
8.733 - by blast
8.734 - }
8.735 - thus "?rhs"
8.736 - by blast
8.737 - next
8.738 - assume "?rhs" thus "?lhs"
8.739 - unfolding closure_def interior_def islimpt_def
8.740 - by blast
8.741 - qed
8.742 - }
8.743 - thus ?thesis
8.744 - by blast
8.745 -qed
8.746 -
8.747 -lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
8.748 -proof-
8.749 - { fix x
8.750 - have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
8.751 - unfolding interior_def closure_def islimpt_def
8.752 - by blast (* FIXME: VERY slow! *)
8.753 - }
8.754 - thus ?thesis
8.755 - by blast
8.756 -qed
8.757 -
8.758 -lemma closed_closure[simp, intro]: "closed (closure S)"
8.759 -proof-
8.760 - have "closed (UNIV - interior (UNIV -S))" by blast
8.761 - thus ?thesis using closure_interior[of S] by simp
8.762 -qed
8.763 -
8.764 -lemma closure_hull: "closure S = closed hull S"
8.765 -proof-
8.766 - have "S \<subseteq> closure S"
8.767 - unfolding closure_def
8.768 - by blast
8.769 - moreover
8.770 - have "closed (closure S)"
8.771 - using closed_closure[of S]
8.772 - by assumption
8.773 - moreover
8.774 - { fix t
8.775 - assume *:"S \<subseteq> t" "closed t"
8.776 - { fix x
8.777 - assume "x islimpt S"
8.778 - hence "x islimpt t" using *(1)
8.779 - using islimpt_subset[of x, of S, of t]
8.780 - by blast
8.781 - }
8.782 - with * have "closure S \<subseteq> t"
8.783 - unfolding closure_def
8.784 - using closed_limpt[of t]
8.785 - by auto
8.786 - }
8.787 - ultimately show ?thesis
8.788 - using hull_unique[of S, of "closure S", of closed]
8.789 - unfolding mem_def
8.790 - by simp
8.791 -qed
8.792 -
8.793 -lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
8.794 - unfolding closure_hull
8.795 - using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
8.796 - by (metis mem_def subset_eq)
8.797 -
8.798 -lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
8.799 - using closure_eq[of S]
8.800 - by simp
8.801 -
8.802 -lemma closure_closure[simp]: "closure (closure S) = closure S"
8.803 - unfolding closure_hull
8.804 - using hull_hull[of closed S]
8.805 - by assumption
8.806 -
8.807 -lemma closure_subset: "S \<subseteq> closure S"
8.808 - unfolding closure_hull
8.809 - using hull_subset[of S closed]
8.810 - by assumption
8.811 -
8.812 -lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
8.813 - unfolding closure_hull
8.814 - using hull_mono[of S T closed]
8.815 - by assumption
8.816 -
8.817 -lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
8.818 - using hull_minimal[of S T closed]
8.819 - unfolding closure_hull mem_def
8.820 - by simp
8.821 -
8.822 -lemma closure_unique: "S \<subseteq> T \<and> closed T \<and> (\<forall> T'. S \<subseteq> T' \<and> closed T' \<longrightarrow> T \<subseteq> T') \<Longrightarrow> closure S = T"
8.823 - using hull_unique[of S T closed]
8.824 - unfolding closure_hull mem_def
8.825 - by simp
8.826 -
8.827 -lemma closure_empty[simp]: "closure {} = {}"
8.828 - using closed_empty closure_closed[of "{}"]
8.829 - by simp
8.830 -
8.831 -lemma closure_univ[simp]: "closure UNIV = UNIV"
8.832 - using closure_closed[of UNIV]
8.833 - by simp
8.834 -
8.835 -lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
8.836 - using closure_empty closure_subset[of S]
8.837 - by blast
8.838 -
8.839 -lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
8.840 - using closure_eq[of S] closure_subset[of S]
8.841 - by simp
8.842 -
8.843 -lemma open_inter_closure_eq_empty:
8.844 - "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
8.845 - using open_subset_interior[of S "UNIV - T"]
8.846 - using interior_subset[of "UNIV - T"]
8.847 - unfolding closure_interior
8.848 - by auto
8.849 -
8.850 -lemma open_inter_closure_subset:
8.851 - "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
8.852 -proof
8.853 - fix x
8.854 - assume as: "open S" "x \<in> S \<inter> closure T"
8.855 - { assume *:"x islimpt T"
8.856 - have "x islimpt (S \<inter> T)"
8.857 - proof (rule islimptI)
8.858 - fix A
8.859 - assume "x \<in> A" "open A"
8.860 - with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
8.861 - by (simp_all add: open_Int)
8.862 - with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
8.863 - by (rule islimptE)
8.864 - hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
8.865 - by simp_all
8.866 - thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
8.867 - qed
8.868 - }
8.869 - then show "x \<in> closure (S \<inter> T)" using as
8.870 - unfolding closure_def
8.871 - by blast
8.872 -qed
8.873 -
8.874 -lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
8.875 -proof-
8.876 - have "S = UNIV - (UNIV - S)"
8.877 - by auto
8.878 - thus ?thesis
8.879 - unfolding closure_interior
8.880 - by auto
8.881 -qed
8.882 -
8.883 -lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
8.884 - unfolding closure_interior
8.885 - by blast
8.886 -
8.887 -subsection{* Frontier (aka boundary) *}
8.888 -
8.889 -definition "frontier S = closure S - interior S"
8.890 -
8.891 -lemma frontier_closed: "closed(frontier S)"
8.892 - by (simp add: frontier_def closed_Diff)
8.893 -
8.894 -lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
8.895 - by (auto simp add: frontier_def interior_closure)
8.896 -
8.897 -lemma frontier_straddle:
8.898 - fixes a :: "'a::metric_space"
8.899 - shows "a \<in> frontier S \<longleftrightarrow> (\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e))" (is "?lhs \<longleftrightarrow> ?rhs")
8.900 -proof
8.901 - assume "?lhs"
8.902 - { fix e::real
8.903 - assume "e > 0"
8.904 - let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
8.905 - { assume "a\<in>S"
8.906 - have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
8.907 - moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
8.908 - unfolding frontier_closures closure_def islimpt_def using `e>0`
8.909 - by (auto, erule_tac x="ball a e" in allE, auto)
8.910 - ultimately have ?rhse by auto
8.911 - }
8.912 - moreover
8.913 - { assume "a\<notin>S"
8.914 - hence ?rhse using `?lhs`
8.915 - unfolding frontier_closures closure_def islimpt_def
8.916 - using open_ball[of a e] `e > 0`
8.917 - by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
8.918 - }
8.919 - ultimately have ?rhse by auto
8.920 - }
8.921 - thus ?rhs by auto
8.922 -next
8.923 - assume ?rhs
8.924 - moreover
8.925 - { fix T assume "a\<notin>S" and
8.926 - as:"\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)" "a \<notin> S" "a \<in> T" "open T"
8.927 - from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
8.928 - then obtain e where "e>0" "ball a e \<subseteq> T" by auto
8.929 - then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
8.930 - have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
8.931 - using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
8.932 - }
8.933 - hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
8.934 - moreover
8.935 - { fix T assume "a \<in> T" "open T" "a\<in>S"
8.936 - then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
8.937 - obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
8.938 - hence "\<exists>y\<in>UNIV - S. y \<in> T \<and> y \<noteq> a" using balle `a\<in>S` unfolding ball_def by (rule_tac x=x in bexI)auto
8.939 - }
8.940 - hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
8.941 - ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
8.942 -qed
8.943 -
8.944 -lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
8.945 - by (metis frontier_def closure_closed Diff_subset)
8.946 -
8.947 -lemma frontier_empty: "frontier {} = {}"
8.948 - by (simp add: frontier_def closure_empty)
8.949 -
8.950 -lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
8.951 -proof-
8.952 - { assume "frontier S \<subseteq> S"
8.953 - hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
8.954 - hence "closed S" using closure_subset_eq by auto
8.955 - }
8.956 - thus ?thesis using frontier_subset_closed[of S] by auto
8.957 -qed
8.958 -
8.959 -lemma frontier_complement: "frontier(UNIV - S) = frontier S"
8.960 - by (auto simp add: frontier_def closure_complement interior_complement)
8.961 -
8.962 -lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
8.963 - using frontier_complement frontier_subset_eq[of "UNIV - S"]
8.964 - unfolding open_closed Compl_eq_Diff_UNIV by auto
8.965 -
8.966 -subsection{* Common nets and The "within" modifier for nets. *}
8.967 -
8.968 -definition
8.969 - at_infinity :: "'a::real_normed_vector net" where
8.970 - "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
8.971 -
8.972 -definition
8.973 - indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
8.974 - "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
8.975 -
8.976 -text{* Prove That They are all nets. *}
8.977 -
8.978 -lemma Rep_net_at_infinity:
8.979 - "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
8.980 -unfolding at_infinity_def
8.981 -apply (rule Abs_net_inverse')
8.982 -apply (rule image_nonempty, simp)
8.983 -apply (clarsimp, rename_tac r s)
8.984 -apply (rule_tac x="max r s" in exI, auto)
8.985 -done
8.986 -
8.987 -lemma within_UNIV: "net within UNIV = net"
8.988 - by (simp add: Rep_net_inject [symmetric] Rep_net_within)
8.989 -
8.990 -subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
8.991 -
8.992 -definition
8.993 - trivial_limit :: "'a net \<Rightarrow> bool" where
8.994 - "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
8.995 -
8.996 -lemma trivial_limit_within:
8.997 - shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
8.998 -proof
8.999 - assume "trivial_limit (at a within S)"
8.1000 - thus "\<not> a islimpt S"
8.1001 - unfolding trivial_limit_def
8.1002 - unfolding Rep_net_within Rep_net_at
8.1003 - unfolding islimpt_def
8.1004 - apply (clarsimp simp add: expand_set_eq)
8.1005 - apply (rename_tac T, rule_tac x=T in exI)
8.1006 - apply (clarsimp, drule_tac x=y in spec, simp)
8.1007 - done
8.1008 -next
8.1009 - assume "\<not> a islimpt S"
8.1010 - thus "trivial_limit (at a within S)"
8.1011 - unfolding trivial_limit_def
8.1012 - unfolding Rep_net_within Rep_net_at
8.1013 - unfolding islimpt_def
8.1014 - apply (clarsimp simp add: image_image)
8.1015 - apply (rule_tac x=T in image_eqI)
8.1016 - apply (auto simp add: expand_set_eq)
8.1017 - done
8.1018 -qed
8.1019 -
8.1020 -lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
8.1021 - using trivial_limit_within [of a UNIV]
8.1022 - by (simp add: within_UNIV)
8.1023 -
8.1024 -lemma trivial_limit_at:
8.1025 - fixes a :: "'a::perfect_space"
8.1026 - shows "\<not> trivial_limit (at a)"
8.1027 - by (simp add: trivial_limit_at_iff)
8.1028 -
8.1029 -lemma trivial_limit_at_infinity:
8.1030 - "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
8.1031 - (* FIXME: find a more appropriate type class *)
8.1032 - unfolding trivial_limit_def Rep_net_at_infinity
8.1033 - apply (clarsimp simp add: expand_set_eq)
8.1034 - apply (drule_tac x="scaleR r (sgn 1)" in spec)
8.1035 - apply (simp add: norm_sgn)
8.1036 - done
8.1037 -
8.1038 -lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
8.1039 - by (auto simp add: trivial_limit_def Rep_net_sequentially)
8.1040 -
8.1041 -subsection{* Some property holds "sufficiently close" to the limit point. *}
8.1042 -
8.1043 -lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
8.1044 - "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
8.1045 -unfolding eventually_at dist_nz by auto
8.1046 -
8.1047 -lemma eventually_at_infinity:
8.1048 - "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
8.1049 -unfolding eventually_def Rep_net_at_infinity by auto
8.1050 -
8.1051 -lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
8.1052 - (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
8.1053 -unfolding eventually_within eventually_at dist_nz by auto
8.1054 -
8.1055 -lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
8.1056 - (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
8.1057 -unfolding eventually_within
8.1058 -apply safe
8.1059 -apply (rule_tac x="d/2" in exI, simp)
8.1060 -apply (rule_tac x="d" in exI, simp)
8.1061 -done
8.1062 -
8.1063 -lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
8.1064 - unfolding eventually_def trivial_limit_def
8.1065 - using Rep_net_nonempty [of net] by auto
8.1066 -
8.1067 -lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
8.1068 - unfolding eventually_def trivial_limit_def
8.1069 - using Rep_net_nonempty [of net] by auto
8.1070 -
8.1071 -lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
8.1072 - unfolding trivial_limit_def eventually_def by auto
8.1073 -
8.1074 -lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
8.1075 - unfolding trivial_limit_def eventually_def by auto
8.1076 -
8.1077 -lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
8.1078 - apply (safe elim!: trivial_limit_eventually)
8.1079 - apply (simp add: eventually_False [symmetric])
8.1080 - done
8.1081 -
8.1082 -text{* Combining theorems for "eventually" *}
8.1083 -
8.1084 -lemma eventually_conjI:
8.1085 - "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
8.1086 - \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
8.1087 -by (rule eventually_conj)
8.1088 -
8.1089 -lemma eventually_rev_mono:
8.1090 - "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
8.1091 -using eventually_mono [of P Q] by fast
8.1092 -
8.1093 -lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
8.1094 - by (auto intro!: eventually_conjI elim: eventually_rev_mono)
8.1095 -
8.1096 -lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
8.1097 - by (auto simp add: eventually_False)
8.1098 -
8.1099 -lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
8.1100 - by (simp add: eventually_False)
8.1101 -
8.1102 -subsection{* Limits, defined as vacuously true when the limit is trivial. *}
8.1103 -
8.1104 - text{* Notation Lim to avoid collition with lim defined in analysis *}
8.1105 -definition
8.1106 - Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
8.1107 - "Lim net f = (THE l. (f ---> l) net)"
8.1108 -
8.1109 -lemma Lim:
8.1110 - "(f ---> l) net \<longleftrightarrow>
8.1111 - trivial_limit net \<or>
8.1112 - (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
8.1113 - unfolding tendsto_iff trivial_limit_eq by auto
8.1114 -
8.1115 -
8.1116 -text{* Show that they yield usual definitions in the various cases. *}
8.1117 -
8.1118 -lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
8.1119 - (\<forall>e>0. \<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> dist (f x) l < e)"
8.1120 - by (auto simp add: tendsto_iff eventually_within_le)
8.1121 -
8.1122 -lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
8.1123 - (\<forall>e >0. \<exists>d>0. \<forall>x \<in> S. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
8.1124 - by (auto simp add: tendsto_iff eventually_within)
8.1125 -
8.1126 -lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
8.1127 - (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
8.1128 - by (auto simp add: tendsto_iff eventually_at)
8.1129 -
8.1130 -lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
8.1131 - unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
8.1132 -
8.1133 -lemma Lim_at_infinity:
8.1134 - "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
8.1135 - by (auto simp add: tendsto_iff eventually_at_infinity)
8.1136 -
8.1137 -lemma Lim_sequentially:
8.1138 - "(S ---> l) sequentially \<longleftrightarrow>
8.1139 - (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
8.1140 - by (auto simp add: tendsto_iff eventually_sequentially)
8.1141 -
8.1142 -lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
8.1143 - unfolding Lim_sequentially LIMSEQ_def ..
8.1144 -
8.1145 -lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
8.1146 - by (rule topological_tendstoI, auto elim: eventually_rev_mono)
8.1147 -
8.1148 -text{* The expected monotonicity property. *}
8.1149 -
8.1150 -lemma Lim_within_empty: "(f ---> l) (net within {})"
8.1151 - unfolding tendsto_def Limits.eventually_within by simp
8.1152 -
8.1153 -lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
8.1154 - unfolding tendsto_def Limits.eventually_within
8.1155 - by (auto elim!: eventually_elim1)
8.1156 -
8.1157 -lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
8.1158 - shows "(f ---> l) (net within (S \<union> T))"
8.1159 - using assms unfolding tendsto_def Limits.eventually_within
8.1160 - apply clarify
8.1161 - apply (drule spec, drule (1) mp, drule (1) mp)
8.1162 - apply (drule spec, drule (1) mp, drule (1) mp)
8.1163 - apply (auto elim: eventually_elim2)
8.1164 - done
8.1165 -
8.1166 -lemma Lim_Un_univ:
8.1167 - "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
8.1168 - ==> (f ---> l) net"
8.1169 - by (metis Lim_Un within_UNIV)
8.1170 -
8.1171 -text{* Interrelations between restricted and unrestricted limits. *}
8.1172 -
8.1173 -lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
8.1174 - (* FIXME: rename *)
8.1175 - unfolding tendsto_def Limits.eventually_within
8.1176 - apply (clarify, drule spec, drule (1) mp, drule (1) mp)
8.1177 - by (auto elim!: eventually_elim1)
8.1178 -
8.1179 -lemma Lim_within_open:
8.1180 - fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
8.1181 - assumes"a \<in> S" "open S"
8.1182 - shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
8.1183 -proof
8.1184 - assume ?lhs
8.1185 - { fix A assume "open A" "l \<in> A"
8.1186 - with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
8.1187 - by (rule topological_tendstoD)
8.1188 - hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
8.1189 - unfolding Limits.eventually_within .
8.1190 - then obtain T where "open T" "a \<in> T" "\<forall>x\<in>T. x \<noteq> a \<longrightarrow> x \<in> S \<longrightarrow> f x \<in> A"
8.1191 - unfolding eventually_at_topological by fast
8.1192 - hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
8.1193 - using assms by auto
8.1194 - hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
8.1195 - by fast
8.1196 - hence "eventually (\<lambda>x. f x \<in> A) (at a)"
8.1197 - unfolding eventually_at_topological .
8.1198 - }
8.1199 - thus ?rhs by (rule topological_tendstoI)
8.1200 -next
8.1201 - assume ?rhs
8.1202 - thus ?lhs by (rule Lim_at_within)
8.1203 -qed
8.1204 -
8.1205 -text{* Another limit point characterization. *}
8.1206 -
8.1207 -lemma islimpt_sequential:
8.1208 - fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
8.1209 - shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
8.1210 - (is "?lhs = ?rhs")
8.1211 -proof
8.1212 - assume ?lhs
8.1213 - then obtain f where f:"\<forall>y. y>0 \<longrightarrow> f y \<in> S \<and> f y \<noteq> x \<and> dist (f y) x < y"
8.1214 - unfolding islimpt_approachable using choice[of "\<lambda>e y. e>0 \<longrightarrow> y\<in>S \<and> y\<noteq>x \<and> dist y x < e"] by auto
8.1215 - { fix n::nat
8.1216 - have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
8.1217 - }
8.1218 - moreover
8.1219 - { fix e::real assume "e>0"
8.1220 - hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
8.1221 - then obtain N::nat where "inverse (real (N + 1)) < e" by auto
8.1222 - hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
8.1223 - moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
8.1224 - ultimately have "\<exists>N::nat. \<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < e" apply(rule_tac x=N in exI) apply auto apply(erule_tac x=n in allE)+ by auto
8.1225 - }
8.1226 - hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
8.1227 - unfolding Lim_sequentially using f by auto
8.1228 - ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
8.1229 -next
8.1230 - assume ?rhs
8.1231 - then obtain f::"nat\<Rightarrow>'a" where f:"(\<forall>n. f n \<in> S - {x})" "(\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f n) x < e)" unfolding Lim_sequentially by auto
8.1232 - { fix e::real assume "e>0"
8.1233 - then obtain N where "dist (f N) x < e" using f(2) by auto
8.1234 - moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
8.1235 - ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
8.1236 - }
8.1237 - thus ?lhs unfolding islimpt_approachable by auto
8.1238 -qed
8.1239 -
8.1240 -text{* Basic arithmetical combining theorems for limits. *}
8.1241 -
8.1242 -lemma Lim_linear:
8.1243 - assumes "(f ---> l) net" "bounded_linear h"
8.1244 - shows "((\<lambda>x. h (f x)) ---> h l) net"
8.1245 -using `bounded_linear h` `(f ---> l) net`
8.1246 -by (rule bounded_linear.tendsto)
8.1247 -
8.1248 -lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
8.1249 - unfolding tendsto_def Limits.eventually_at_topological by fast
8.1250 -
8.1251 -lemma Lim_const: "((\<lambda>x. a) ---> a) net"
8.1252 - by (rule tendsto_const)
8.1253 -
8.1254 -lemma Lim_cmul:
8.1255 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1256 - shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
8.1257 - by (intro tendsto_intros)
8.1258 -
8.1259 -lemma Lim_neg:
8.1260 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1261 - shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
8.1262 - by (rule tendsto_minus)
8.1263 -
8.1264 -lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
8.1265 - "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
8.1266 - by (rule tendsto_add)
8.1267 -
8.1268 -lemma Lim_sub:
8.1269 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1270 - shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
8.1271 - by (rule tendsto_diff)
8.1272 -
8.1273 -lemma Lim_null:
8.1274 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1275 - shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
8.1276 -
8.1277 -lemma Lim_null_norm:
8.1278 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1279 - shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
8.1280 - by (simp add: Lim dist_norm)
8.1281 -
8.1282 -lemma Lim_null_comparison:
8.1283 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1284 - assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
8.1285 - shows "(f ---> 0) net"
8.1286 -proof(simp add: tendsto_iff, rule+)
8.1287 - fix e::real assume "0<e"
8.1288 - { fix x
8.1289 - assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
8.1290 - hence "dist (f x) 0 < e" by (simp add: dist_norm)
8.1291 - }
8.1292 - thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
8.1293 - using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
8.1294 - using eventually_mono[of "(\<lambda>x. norm (f x) \<le> g x \<and> dist (g x) 0 < e)" "(\<lambda>x. dist (f x) 0 < e)" net]
8.1295 - using assms `e>0` unfolding tendsto_iff by auto
8.1296 -qed
8.1297 -
8.1298 -lemma Lim_component:
8.1299 - fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
8.1300 - shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
8.1301 - unfolding tendsto_iff
8.1302 - apply (clarify)
8.1303 - apply (drule spec, drule (1) mp)
8.1304 - apply (erule eventually_elim1)
8.1305 - apply (erule le_less_trans [OF dist_nth_le])
8.1306 - done
8.1307 -
8.1308 -lemma Lim_transform_bound:
8.1309 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1310 - fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
8.1311 - assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
8.1312 - shows "(f ---> 0) net"
8.1313 -proof (rule tendstoI)
8.1314 - fix e::real assume "e>0"
8.1315 - { fix x
8.1316 - assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
8.1317 - hence "dist (f x) 0 < e" by (simp add: dist_norm)}
8.1318 - thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
8.1319 - using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
8.1320 - using eventually_mono[of "\<lambda>x. norm (f x) \<le> norm (g x) \<and> dist (g x) 0 < e" "\<lambda>x. dist (f x) 0 < e" net]
8.1321 - using assms `e>0` unfolding tendsto_iff by blast
8.1322 -qed
8.1323 -
8.1324 -text{* Deducing things about the limit from the elements. *}
8.1325 -
8.1326 -lemma Lim_in_closed_set:
8.1327 - assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
8.1328 - shows "l \<in> S"
8.1329 -proof (rule ccontr)
8.1330 - assume "l \<notin> S"
8.1331 - with `closed S` have "open (- S)" "l \<in> - S"
8.1332 - by (simp_all add: open_Compl)
8.1333 - with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
8.1334 - by (rule topological_tendstoD)
8.1335 - with assms(2) have "eventually (\<lambda>x. False) net"
8.1336 - by (rule eventually_elim2) simp
8.1337 - with assms(3) show "False"
8.1338 - by (simp add: eventually_False)
8.1339 -qed
8.1340 -
8.1341 -text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
8.1342 -
8.1343 -lemma Lim_dist_ubound:
8.1344 - assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
8.1345 - shows "dist a l <= e"
8.1346 -proof (rule ccontr)
8.1347 - assume "\<not> dist a l \<le> e"
8.1348 - then have "0 < dist a l - e" by simp
8.1349 - with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
8.1350 - by (rule tendstoD)
8.1351 - with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
8.1352 - by (rule eventually_conjI)
8.1353 - then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
8.1354 - using assms(1) eventually_happens by auto
8.1355 - hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
8.1356 - by (rule add_le_less_mono)
8.1357 - hence "dist a (f w) + dist (f w) l < dist a l"
8.1358 - by simp
8.1359 - also have "\<dots> \<le> dist a (f w) + dist (f w) l"
8.1360 - by (rule dist_triangle)
8.1361 - finally show False by simp
8.1362 -qed
8.1363 -
8.1364 -lemma Lim_norm_ubound:
8.1365 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1366 - assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
8.1367 - shows "norm(l) <= e"
8.1368 -proof (rule ccontr)
8.1369 - assume "\<not> norm l \<le> e"
8.1370 - then have "0 < norm l - e" by simp
8.1371 - with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
8.1372 - by (rule tendstoD)
8.1373 - with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
8.1374 - by (rule eventually_conjI)
8.1375 - then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
8.1376 - using assms(1) eventually_happens by auto
8.1377 - hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
8.1378 - hence "norm (f w - l) + norm (f w) < norm l" by simp
8.1379 - hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
8.1380 - thus False using `\<not> norm l \<le> e` by simp
8.1381 -qed
8.1382 -
8.1383 -lemma Lim_norm_lbound:
8.1384 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.1385 - assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
8.1386 - shows "e \<le> norm l"
8.1387 -proof (rule ccontr)
8.1388 - assume "\<not> e \<le> norm l"
8.1389 - then have "0 < e - norm l" by simp
8.1390 - with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
8.1391 - by (rule tendstoD)
8.1392 - with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
8.1393 - by (rule eventually_conjI)
8.1394 - then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
8.1395 - using assms(1) eventually_happens by auto
8.1396 - hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
8.1397 - hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
8.1398 - hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
8.1399 - thus False by simp
8.1400 -qed
8.1401 -
8.1402 -text{* Uniqueness of the limit, when nontrivial. *}
8.1403 -
8.1404 -lemma Lim_unique:
8.1405 - fixes f :: "'a \<Rightarrow> 'b::t2_space"
8.1406 - assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
8.1407 - shows "l = l'"
8.1408 -proof (rule ccontr)
8.1409 - assume "l \<noteq> l'"
8.1410 - obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
8.1411 - using hausdorff [OF `l \<noteq> l'`] by fast
8.1412 - have "eventually (\<lambda>x. f x \<in> U) net"
8.1413 - using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
8.1414 - moreover
8.1415 - have "eventually (\<lambda>x. f x \<in> V) net"
8.1416 - using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
8.1417 - ultimately
8.1418 - have "eventually (\<lambda>x. False) net"
8.1419 - proof (rule eventually_elim2)
8.1420 - fix x
8.1421 - assume "f x \<in> U" "f x \<in> V"
8.1422 - hence "f x \<in> U \<inter> V" by simp
8.1423 - with `U \<inter> V = {}` show "False" by simp
8.1424 - qed
8.1425 - with `\<not> trivial_limit net` show "False"
8.1426 - by (simp add: eventually_False)
8.1427 -qed
8.1428 -
8.1429 -lemma tendsto_Lim:
8.1430 - fixes f :: "'a \<Rightarrow> 'b::t2_space"
8.1431 - shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
8.1432 - unfolding Lim_def using Lim_unique[of net f] by auto
8.1433 -
8.1434 -text{* Limit under bilinear function *}
8.1435 -
8.1436 -lemma Lim_bilinear:
8.1437 - assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
8.1438 - shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
8.1439 -using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
8.1440 -by (rule bounded_bilinear.tendsto)
8.1441 -
8.1442 -text{* These are special for limits out of the same vector space. *}
8.1443 -
8.1444 -lemma Lim_within_id: "(id ---> a) (at a within s)"
8.1445 - unfolding tendsto_def Limits.eventually_within eventually_at_topological
8.1446 - by auto
8.1447 -
8.1448 -lemma Lim_at_id: "(id ---> a) (at a)"
8.1449 -apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
8.1450 -
8.1451 -lemma Lim_at_zero:
8.1452 - fixes a :: "'a::real_normed_vector"
8.1453 - fixes l :: "'b::topological_space"
8.1454 - shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
8.1455 -proof
8.1456 - assume "?lhs"
8.1457 - { fix S assume "open S" "l \<in> S"
8.1458 - with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
8.1459 - by (rule topological_tendstoD)
8.1460 - then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
8.1461 - unfolding Limits.eventually_at by fast
8.1462 - { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
8.1463 - hence "f (a + x) \<in> S" using d
8.1464 - apply(erule_tac x="x+a" in allE)
8.1465 - by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
8.1466 - }
8.1467 - hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
8.1468 - using d(1) by auto
8.1469 - hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
8.1470 - unfolding Limits.eventually_at .
8.1471 - }
8.1472 - thus "?rhs" by (rule topological_tendstoI)
8.1473 -next
8.1474 - assume "?rhs"
8.1475 - { fix S assume "open S" "l \<in> S"
8.1476 - with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
8.1477 - by (rule topological_tendstoD)
8.1478 - then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
8.1479 - unfolding Limits.eventually_at by fast
8.1480 - { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
8.1481 - hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
8.1482 - by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
8.1483 - }
8.1484 - hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
8.1485 - hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
8.1486 - }
8.1487 - thus "?lhs" by (rule topological_tendstoI)
8.1488 -qed
8.1489 -
8.1490 -text{* It's also sometimes useful to extract the limit point from the net. *}
8.1491 -
8.1492 -definition
8.1493 - netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
8.1494 - "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
8.1495 -
8.1496 -lemma netlimit_within:
8.1497 - assumes "\<not> trivial_limit (at a within S)"
8.1498 - shows "netlimit (at a within S) = a"
8.1499 -unfolding netlimit_def
8.1500 -apply (rule some_equality)
8.1501 -apply (rule Lim_at_within)
8.1502 -apply (rule Lim_ident_at)
8.1503 -apply (erule Lim_unique [OF assms])
8.1504 -apply (rule Lim_at_within)
8.1505 -apply (rule Lim_ident_at)
8.1506 -done
8.1507 -
8.1508 -lemma netlimit_at:
8.1509 - fixes a :: "'a::perfect_space"
8.1510 - shows "netlimit (at a) = a"
8.1511 - apply (subst within_UNIV[symmetric])
8.1512 - using netlimit_within[of a UNIV]
8.1513 - by (simp add: trivial_limit_at within_UNIV)
8.1514 -
8.1515 -text{* Transformation of limit. *}
8.1516 -
8.1517 -lemma Lim_transform:
8.1518 - fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
8.1519 - assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
8.1520 - shows "(g ---> l) net"
8.1521 -proof-
8.1522 - from assms have "((\<lambda>x. f x - g x - f x) ---> 0 - l) net" using Lim_sub[of "\<lambda>x. f x - g x" 0 net f l] by auto
8.1523 - thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
8.1524 -qed
8.1525 -
8.1526 -lemma Lim_transform_eventually:
8.1527 - "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
8.1528 - apply (rule topological_tendstoI)
8.1529 - apply (drule (2) topological_tendstoD)
8.1530 - apply (erule (1) eventually_elim2, simp)
8.1531 - done
8.1532 -
8.1533 -lemma Lim_transform_within:
8.1534 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1535 - assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
8.1536 - "(f ---> l) (at x within S)"
8.1537 - shows "(g ---> l) (at x within S)"
8.1538 - using assms(1,3) unfolding Lim_within
8.1539 - apply -
8.1540 - apply (clarify, rename_tac e)
8.1541 - apply (drule_tac x=e in spec, clarsimp, rename_tac r)
8.1542 - apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
8.1543 - apply (drule_tac x=y in bspec, assumption, clarsimp)
8.1544 - apply (simp add: assms(2))
8.1545 - done
8.1546 -
8.1547 -lemma Lim_transform_at:
8.1548 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1549 - shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
8.1550 - (f ---> l) (at x) ==> (g ---> l) (at x)"
8.1551 - apply (subst within_UNIV[symmetric])
8.1552 - using Lim_transform_within[of d UNIV x f g l]
8.1553 - by (auto simp add: within_UNIV)
8.1554 -
8.1555 -text{* Common case assuming being away from some crucial point like 0. *}
8.1556 -
8.1557 -lemma Lim_transform_away_within:
8.1558 - fixes a b :: "'a::metric_space"
8.1559 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1560 - assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
8.1561 - and "(f ---> l) (at a within S)"
8.1562 - shows "(g ---> l) (at a within S)"
8.1563 -proof-
8.1564 - have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
8.1565 - apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
8.1566 - thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
8.1567 -qed
8.1568 -
8.1569 -lemma Lim_transform_away_at:
8.1570 - fixes a b :: "'a::metric_space"
8.1571 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1572 - assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
8.1573 - and fl: "(f ---> l) (at a)"
8.1574 - shows "(g ---> l) (at a)"
8.1575 - using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
8.1576 - by (auto simp add: within_UNIV)
8.1577 -
8.1578 -text{* Alternatively, within an open set. *}
8.1579 -
8.1580 -lemma Lim_transform_within_open:
8.1581 - fixes a :: "'a::metric_space"
8.1582 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1583 - assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
8.1584 - shows "(g ---> l) (at a)"
8.1585 -proof-
8.1586 - from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
8.1587 - hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
8.1588 - unfolding ball_def subset_eq apply auto apply(erule_tac x=x' in allE) apply(erule_tac x=x' in ballE) by(auto simp add: dist_commute)
8.1589 - thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
8.1590 -qed
8.1591 -
8.1592 -text{* A congruence rule allowing us to transform limits assuming not at point. *}
8.1593 -
8.1594 -(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
8.1595 -
8.1596 -lemma Lim_cong_within[cong add]:
8.1597 - fixes a :: "'a::metric_space"
8.1598 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1599 - shows "(\<And>x. x \<noteq> a \<Longrightarrow> f x = g x) ==> ((\<lambda>x. f x) ---> l) (at a within S) \<longleftrightarrow> ((g ---> l) (at a within S))"
8.1600 - by (simp add: Lim_within dist_nz[symmetric])
8.1601 -
8.1602 -lemma Lim_cong_at[cong add]:
8.1603 - fixes a :: "'a::metric_space"
8.1604 - fixes l :: "'b::metric_space" (* TODO: generalize *)
8.1605 - shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
8.1606 - by (simp add: Lim_at dist_nz[symmetric])
8.1607 -
8.1608 -text{* Useful lemmas on closure and set of possible sequential limits.*}
8.1609 -
8.1610 -lemma closure_sequential:
8.1611 - fixes l :: "'a::metric_space" (* TODO: generalize *)
8.1612 - shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
8.1613 -proof
8.1614 - assume "?lhs" moreover
8.1615 - { assume "l \<in> S"
8.1616 - hence "?rhs" using Lim_const[of l sequentially] by auto
8.1617 - } moreover
8.1618 - { assume "l islimpt S"
8.1619 - hence "?rhs" unfolding islimpt_sequential by auto
8.1620 - } ultimately
8.1621 - show "?rhs" unfolding closure_def by auto
8.1622 -next
8.1623 - assume "?rhs"
8.1624 - thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
8.1625 -qed
8.1626 -
8.1627 -lemma closed_sequential_limits:
8.1628 - fixes S :: "'a::metric_space set"
8.1629 - shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
8.1630 - unfolding closed_limpt
8.1631 - using closure_sequential [where 'a='a] closure_closed [where 'a='a] closed_limpt [where 'a='a] islimpt_sequential [where 'a='a] mem_delete [where 'a='a]
8.1632 - by metis
8.1633 -
8.1634 -lemma closure_approachable:
8.1635 - fixes S :: "'a::metric_space set"
8.1636 - shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
8.1637 - apply (auto simp add: closure_def islimpt_approachable)
8.1638 - by (metis dist_self)
8.1639 -
8.1640 -lemma closed_approachable:
8.1641 - fixes S :: "'a::metric_space set"
8.1642 - shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
8.1643 - by (metis closure_closed closure_approachable)
8.1644 -
8.1645 -text{* Some other lemmas about sequences. *}
8.1646 -
8.1647 -lemma seq_offset:
8.1648 - fixes l :: "'a::metric_space" (* TODO: generalize *)
8.1649 - shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
8.1650 - apply (auto simp add: Lim_sequentially)
8.1651 - by (metis trans_le_add1 )
8.1652 -
8.1653 -lemma seq_offset_neg:
8.1654 - "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
8.1655 - apply (rule topological_tendstoI)
8.1656 - apply (drule (2) topological_tendstoD)
8.1657 - apply (simp only: eventually_sequentially)
8.1658 - apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
8.1659 - apply metis
8.1660 - by arith
8.1661 -
8.1662 -lemma seq_offset_rev:
8.1663 - "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
8.1664 - apply (rule topological_tendstoI)
8.1665 - apply (drule (2) topological_tendstoD)
8.1666 - apply (simp only: eventually_sequentially)
8.1667 - apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
8.1668 - by metis arith
8.1669 -
8.1670 -lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
8.1671 -proof-
8.1672 - { fix e::real assume "e>0"
8.1673 - hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
8.1674 - using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
8.1675 - by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
8.1676 - }
8.1677 - thus ?thesis unfolding Lim_sequentially dist_norm by simp
8.1678 -qed
8.1679 -
8.1680 -text{* More properties of closed balls. *}
8.1681 -
8.1682 -lemma closed_cball: "closed (cball x e)"
8.1683 -unfolding cball_def closed_def
8.1684 -unfolding Collect_neg_eq [symmetric] not_le
8.1685 -apply (clarsimp simp add: open_dist, rename_tac y)
8.1686 -apply (rule_tac x="dist x y - e" in exI, clarsimp)
8.1687 -apply (rename_tac x')
8.1688 -apply (cut_tac x=x and y=x' and z=y in dist_triangle)
8.1689 -apply simp
8.1690 -done
8.1691 -
8.1692 -lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
8.1693 -proof-
8.1694 - { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
8.1695 - hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
8.1696 - } moreover
8.1697 - { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
8.1698 - hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
8.1699 - } ultimately
8.1700 - show ?thesis unfolding open_contains_ball by auto
8.1701 -qed
8.1702 -
8.1703 -lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
8.1704 - by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
8.1705 -
8.1706 -lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
8.1707 - apply (simp add: interior_def, safe)
8.1708 - apply (force simp add: open_contains_cball)
8.1709 - apply (rule_tac x="ball x e" in exI)
8.1710 - apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
8.1711 - done
8.1712 -
8.1713 -lemma islimpt_ball:
8.1714 - fixes x y :: "'a::{real_normed_vector,perfect_space}"
8.1715 - shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
8.1716 -proof
8.1717 - assume "?lhs"
8.1718 - { assume "e \<le> 0"
8.1719 - hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
8.1720 - have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
8.1721 - }
8.1722 - hence "e > 0" by (metis not_less)
8.1723 - moreover
8.1724 - have "y \<in> cball x e" using closed_cball[of x e] islimpt_subset[of y "ball x e" "cball x e"] ball_subset_cball[of x e] `?lhs` unfolding closed_limpt by auto
8.1725 - ultimately show "?rhs" by auto
8.1726 -next
8.1727 - assume "?rhs" hence "e>0" by auto
8.1728 - { fix d::real assume "d>0"
8.1729 - have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
8.1730 - proof(cases "d \<le> dist x y")
8.1731 - case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
8.1732 - proof(cases "x=y")
8.1733 - case True hence False using `d \<le> dist x y` `d>0` by auto
8.1734 - thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
8.1735 - next
8.1736 - case False
8.1737 -
8.1738 - have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
8.1739 - = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
8.1740 - unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
8.1741 - also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
8.1742 - using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
8.1743 - unfolding scaleR_minus_left scaleR_one
8.1744 - by (auto simp add: norm_minus_commute)
8.1745 - also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
8.1746 - unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
8.1747 - unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
8.1748 - also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
8.1749 - finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
8.1750 -
8.1751 - moreover
8.1752 -
8.1753 - have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
8.1754 - using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
8.1755 - moreover
8.1756 - have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
8.1757 - using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
8.1758 - unfolding dist_norm by auto
8.1759 - ultimately show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by (rule_tac x="y - (d / (2*dist y x)) *\<^sub>R (y - x)" in bexI) auto
8.1760 - qed
8.1761 - next
8.1762 - case False hence "d > dist x y" by auto
8.1763 - show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
8.1764 - proof(cases "x=y")
8.1765 - case True
8.1766 - obtain z where **: "z \<noteq> y" "dist z y < min e d"
8.1767 - using perfect_choose_dist[of "min e d" y]
8.1768 - using `d > 0` `e>0` by auto
8.1769 - show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
8.1770 - unfolding `x = y`
8.1771 - using `z \<noteq> y` **
8.1772 - by (rule_tac x=z in bexI, auto simp add: dist_commute)
8.1773 - next
8.1774 - case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
8.1775 - using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
8.1776 - qed
8.1777 - qed }
8.1778 - thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
8.1779 -qed
8.1780 -
8.1781 -lemma closure_ball_lemma:
8.1782 - fixes x y :: "'a::real_normed_vector"
8.1783 - assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
8.1784 -proof (rule islimptI)
8.1785 - fix T assume "y \<in> T" "open T"
8.1786 - then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
8.1787 - unfolding open_dist by fast
8.1788 - (* choose point between x and y, within distance r of y. *)
8.1789 - def k \<equiv> "min 1 (r / (2 * dist x y))"
8.1790 - def z \<equiv> "y + scaleR k (x - y)"
8.1791 - have z_def2: "z = x + scaleR (1 - k) (y - x)"
8.1792 - unfolding z_def by (simp add: algebra_simps)
8.1793 - have "dist z y < r"
8.1794 - unfolding z_def k_def using `0 < r`
8.1795 - by (simp add: dist_norm min_def)
8.1796 - hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
8.1797 - have "dist x z < dist x y"
8.1798 - unfolding z_def2 dist_norm
8.1799 - apply (simp add: norm_minus_commute)
8.1800 - apply (simp only: dist_norm [symmetric])
8.1801 - apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
8.1802 - apply (rule mult_strict_right_mono)
8.1803 - apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
8.1804 - apply (simp add: zero_less_dist_iff `x \<noteq> y`)
8.1805 - done
8.1806 - hence "z \<in> ball x (dist x y)" by simp
8.1807 - have "z \<noteq> y"
8.1808 - unfolding z_def k_def using `x \<noteq> y` `0 < r`
8.1809 - by (simp add: min_def)
8.1810 - show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
8.1811 - using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
8.1812 - by fast
8.1813 -qed
8.1814 -
8.1815 -lemma closure_ball:
8.1816 - fixes x :: "'a::real_normed_vector"
8.1817 - shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
8.1818 -apply (rule equalityI)
8.1819 -apply (rule closure_minimal)
8.1820 -apply (rule ball_subset_cball)
8.1821 -apply (rule closed_cball)
8.1822 -apply (rule subsetI, rename_tac y)
8.1823 -apply (simp add: le_less [where 'a=real])
8.1824 -apply (erule disjE)
8.1825 -apply (rule subsetD [OF closure_subset], simp)
8.1826 -apply (simp add: closure_def)
8.1827 -apply clarify
8.1828 -apply (rule closure_ball_lemma)
8.1829 -apply (simp add: zero_less_dist_iff)
8.1830 -done
8.1831 -
8.1832 -(* In a trivial vector space, this fails for e = 0. *)
8.1833 -lemma interior_cball:
8.1834 - fixes x :: "'a::{real_normed_vector, perfect_space}"
8.1835 - shows "interior (cball x e) = ball x e"
8.1836 -proof(cases "e\<ge>0")
8.1837 - case False note cs = this
8.1838 - from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
8.1839 - { fix y assume "y \<in> cball x e"
8.1840 - hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
8.1841 - hence "cball x e = {}" by auto
8.1842 - hence "interior (cball x e) = {}" using interior_empty by auto
8.1843 - ultimately show ?thesis by blast
8.1844 -next
8.1845 - case True note cs = this
8.1846 - have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
8.1847 - { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
8.1848 - then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
8.1849 -
8.1850 - then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
8.1851 - using perfect_choose_dist [of d] by auto
8.1852 - have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
8.1853 - hence xa_cball:"xa \<in> cball x e" using as(1) by auto
8.1854 -
8.1855 - hence "y \<in> ball x e" proof(cases "x = y")
8.1856 - case True
8.1857 - hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
8.1858 - thus "y \<in> ball x e" using `x = y ` by simp
8.1859 - next
8.1860 - case False
8.1861 - have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
8.1862 - using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
8.1863 - hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
8.1864 - have "y - x \<noteq> 0" using `x \<noteq> y` by auto
8.1865 - hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
8.1866 - using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
8.1867 -
8.1868 - have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) x = norm (y + (d / (2 * norm (y - x))) *\<^sub>R y - (d / (2 * norm (y - x))) *\<^sub>R x - x)"
8.1869 - by (auto simp add: dist_norm algebra_simps)
8.1870 - also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
8.1871 - by (auto simp add: algebra_simps)
8.1872 - also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
8.1873 - using ** by auto
8.1874 - also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
8.1875 - finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
8.1876 - thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
8.1877 - qed }
8.1878 - hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
8.1879 - ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
8.1880 -qed
8.1881 -
8.1882 -lemma frontier_ball:
8.1883 - fixes a :: "'a::real_normed_vector"
8.1884 - shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
8.1885 - apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
8.1886 - apply (simp add: expand_set_eq)
8.1887 - by arith
8.1888 -
8.1889 -lemma frontier_cball:
8.1890 - fixes a :: "'a::{real_normed_vector, perfect_space}"
8.1891 - shows "frontier(cball a e) = {x. dist a x = e}"
8.1892 - apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
8.1893 - apply (simp add: expand_set_eq)
8.1894 - by arith
8.1895 -
8.1896 -lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
8.1897 - apply (simp add: expand_set_eq not_le)
8.1898 - by (metis zero_le_dist dist_self order_less_le_trans)
8.1899 -lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
8.1900 -
8.1901 -lemma cball_eq_sing:
8.1902 - fixes x :: "'a::perfect_space"
8.1903 - shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
8.1904 -proof (rule linorder_cases)
8.1905 - assume e: "0 < e"
8.1906 - obtain a where "a \<noteq> x" "dist a x < e"
8.1907 - using perfect_choose_dist [OF e] by auto
8.1908 - hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
8.1909 - with e show ?thesis by (auto simp add: expand_set_eq)
8.1910 -qed auto
8.1911 -
8.1912 -lemma cball_sing:
8.1913 - fixes x :: "'a::metric_space"
8.1914 - shows "e = 0 ==> cball x e = {x}"
8.1915 - by (auto simp add: expand_set_eq)
8.1916 -
8.1917 -text{* For points in the interior, localization of limits makes no difference. *}
8.1918 -
8.1919 -lemma eventually_within_interior:
8.1920 - assumes "x \<in> interior S"
8.1921 - shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
8.1922 -proof-
8.1923 - from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
8.1924 - unfolding interior_def by fast
8.1925 - { assume "?lhs"
8.1926 - then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
8.1927 - unfolding Limits.eventually_within Limits.eventually_at_topological
8.1928 - by auto
8.1929 - with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
8.1930 - by auto
8.1931 - then have "?rhs"
8.1932 - unfolding Limits.eventually_at_topological by auto
8.1933 - } moreover
8.1934 - { assume "?rhs" hence "?lhs"
8.1935 - unfolding Limits.eventually_within
8.1936 - by (auto elim: eventually_elim1)
8.1937 - } ultimately
8.1938 - show "?thesis" ..
8.1939 -qed
8.1940 -
8.1941 -lemma lim_within_interior:
8.1942 - "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
8.1943 - unfolding tendsto_def by (simp add: eventually_within_interior)
8.1944 -
8.1945 -lemma netlimit_within_interior:
8.1946 - fixes x :: "'a::{perfect_space, real_normed_vector}"
8.1947 - (* FIXME: generalize to perfect_space *)
8.1948 - assumes "x \<in> interior S"
8.1949 - shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
8.1950 -proof-
8.1951 - from assms obtain e::real where e:"e>0" "ball x e \<subseteq> S" using open_interior[of S] unfolding open_contains_ball using interior_subset[of S] by auto
8.1952 - hence "\<not> trivial_limit (at x within S)" using islimpt_subset[of x "ball x e" S] unfolding trivial_limit_within islimpt_ball centre_in_cball by auto
8.1953 - thus ?thesis using netlimit_within by auto
8.1954 -qed
8.1955 -
8.1956 -subsection{* Boundedness. *}
8.1957 -
8.1958 - (* FIXME: This has to be unified with BSEQ!! *)
8.1959 -definition
8.1960 - bounded :: "'a::metric_space set \<Rightarrow> bool" where
8.1961 - "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
8.1962 -
8.1963 -lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
8.1964 -unfolding bounded_def
8.1965 -apply safe
8.1966 -apply (rule_tac x="dist a x + e" in exI, clarify)
8.1967 -apply (drule (1) bspec)
8.1968 -apply (erule order_trans [OF dist_triangle add_left_mono])
8.1969 -apply auto
8.1970 -done
8.1971 -
8.1972 -lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
8.1973 -unfolding bounded_any_center [where a=0]
8.1974 -by (simp add: dist_norm)
8.1975 -
8.1976 -lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
8.1977 -lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
8.1978 - by (metis bounded_def subset_eq)
8.1979 -
8.1980 -lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
8.1981 - by (metis bounded_subset interior_subset)
8.1982 -
8.1983 -lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
8.1984 -proof-
8.1985 - from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
8.1986 - { fix y assume "y \<in> closure S"
8.1987 - then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
8.1988 - unfolding closure_sequential by auto
8.1989 - have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
8.1990 - hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
8.1991 - by (rule eventually_mono, simp add: f(1))
8.1992 - have "dist x y \<le> a"
8.1993 - apply (rule Lim_dist_ubound [of sequentially f])
8.1994 - apply (rule trivial_limit_sequentially)
8.1995 - apply (rule f(2))
8.1996 - apply fact
8.1997 - done
8.1998 - }
8.1999 - thus ?thesis unfolding bounded_def by auto
8.2000 -qed
8.2001 -
8.2002 -lemma bounded_cball[simp,intro]: "bounded (cball x e)"
8.2003 - apply (simp add: bounded_def)
8.2004 - apply (rule_tac x=x in exI)
8.2005 - apply (rule_tac x=e in exI)
8.2006 - apply auto
8.2007 - done
8.2008 -
8.2009 -lemma bounded_ball[simp,intro]: "bounded(ball x e)"
8.2010 - by (metis ball_subset_cball bounded_cball bounded_subset)
8.2011 -
8.2012 -lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
8.2013 -proof-
8.2014 - { fix a F assume as:"bounded F"
8.2015 - then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
8.2016 - hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
8.2017 - hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
8.2018 - }
8.2019 - thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
8.2020 -qed
8.2021 -
8.2022 -lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
8.2023 - apply (auto simp add: bounded_def)
8.2024 - apply (rename_tac x y r s)
8.2025 - apply (rule_tac x=x in exI)
8.2026 - apply (rule_tac x="max r (dist x y + s)" in exI)
8.2027 - apply (rule ballI, rename_tac z, safe)
8.2028 - apply (drule (1) bspec, simp)
8.2029 - apply (drule (1) bspec)
8.2030 - apply (rule min_max.le_supI2)
8.2031 - apply (erule order_trans [OF dist_triangle add_left_mono])
8.2032 - done
8.2033 -
8.2034 -lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
8.2035 - by (induct rule: finite_induct[of F], auto)
8.2036 -
8.2037 -lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
8.2038 - apply (simp add: bounded_iff)
8.2039 - apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
8.2040 - by metis arith
8.2041 -
8.2042 -lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
8.2043 - by (metis Int_lower1 Int_lower2 bounded_subset)
8.2044 -
8.2045 -lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
8.2046 -apply (metis Diff_subset bounded_subset)
8.2047 -done
8.2048 -
8.2049 -lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
8.2050 - by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
8.2051 -
8.2052 -lemma not_bounded_UNIV[simp, intro]:
8.2053 - "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
8.2054 -proof(auto simp add: bounded_pos not_le)
8.2055 - obtain x :: 'a where "x \<noteq> 0"
8.2056 - using perfect_choose_dist [OF zero_less_one] by fast
8.2057 - fix b::real assume b: "b >0"
8.2058 - have b1: "b +1 \<ge> 0" using b by simp
8.2059 - with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
8.2060 - by (simp add: norm_sgn)
8.2061 - then show "\<exists>x::'a. b < norm x" ..
8.2062 -qed
8.2063 -
8.2064 -lemma bounded_linear_image:
8.2065 - assumes "bounded S" "bounded_linear f"
8.2066 - shows "bounded(f ` S)"
8.2067 -proof-
8.2068 - from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
8.2069 - from assms(2) obtain B where B:"B>0" "\<forall>x. norm (f x) \<le> B * norm x" using bounded_linear.pos_bounded by (auto simp add: mult_ac)
8.2070 - { fix x assume "x\<in>S"
8.2071 - hence "norm x \<le> b" using b by auto
8.2072 - hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
8.2073 - by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
8.2074 - }
8.2075 - thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
8.2076 - using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
8.2077 -qed
8.2078 -
8.2079 -lemma bounded_scaling:
8.2080 - fixes S :: "'a::real_normed_vector set"
8.2081 - shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
8.2082 - apply (rule bounded_linear_image, assumption)
8.2083 - apply (rule scaleR.bounded_linear_right)
8.2084 - done
8.2085 -
8.2086 -lemma bounded_translation:
8.2087 - fixes S :: "'a::real_normed_vector set"
8.2088 - assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
8.2089 -proof-
8.2090 - from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
8.2091 - { fix x assume "x\<in>S"
8.2092 - hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
8.2093 - }
8.2094 - thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
8.2095 - by (auto intro!: add exI[of _ "b + norm a"])
8.2096 -qed
8.2097 -
8.2098 -
8.2099 -text{* Some theorems on sups and infs using the notion "bounded". *}
8.2100 -
8.2101 -lemma bounded_real:
8.2102 - fixes S :: "real set"
8.2103 - shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
8.2104 - by (simp add: bounded_iff)
8.2105 -
8.2106 -lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
8.2107 - shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
8.2108 -proof
8.2109 - fix x assume "x\<in>S"
8.2110 - from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
8.2111 - hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
8.2112 - thus "x \<le> rsup S" using rsup[OF `S\<noteq>{}`] using assms(1)[unfolded bounded_real] using isLubD2[of UNIV S "rsup S" x] using `x\<in>S` by auto
8.2113 -next
8.2114 - show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
8.2115 - using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
8.2116 - apply (auto simp add: bounded_real)
8.2117 - by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
8.2118 -qed
8.2119 -
8.2120 -lemma rsup_insert: assumes "bounded S"
8.2121 - shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
8.2122 -proof(cases "S={}")
8.2123 - case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
8.2124 -next
8.2125 - let ?S = "insert x S"
8.2126 - case False
8.2127 - hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
8.2128 - hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
8.2129 - hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
8.2130 - moreover
8.2131 - have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
8.2132 - { fix y assume as:"isUb UNIV (insert x S) y"
8.2133 - hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
8.2134 - unfolding setle_def by auto }
8.2135 - hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
8.2136 - hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
8.2137 - ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
8.2138 -qed
8.2139 -
8.2140 -lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
8.2141 - apply (rule rsup_insert)
8.2142 - apply (rule finite_imp_bounded)
8.2143 - by simp
8.2144 -
8.2145 -lemma bounded_has_rinf:
8.2146 - assumes "bounded S" "S \<noteq> {}"
8.2147 - shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
8.2148 -proof
8.2149 - fix x assume "x\<in>S"
8.2150 - from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
8.2151 - hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
8.2152 - thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
8.2153 -next
8.2154 - show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
8.2155 - using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
8.2156 - apply (auto simp add: bounded_real)
8.2157 - by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
8.2158 -qed
8.2159 -
8.2160 -(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
8.2161 -lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
8.2162 - apply (frule isGlb_isLb)
8.2163 - apply (frule_tac x = y in isGlb_isLb)
8.2164 - apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
8.2165 - done
8.2166 -
8.2167 -lemma rinf_insert: assumes "bounded S"
8.2168 - shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
8.2169 -proof(cases "S={}")
8.2170 - case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
8.2171 -next
8.2172 - let ?S = "insert x S"
8.2173 - case False
8.2174 - hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
8.2175 - hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
8.2176 - hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
8.2177 - moreover
8.2178 - have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
8.2179 - { fix y assume as:"isLb UNIV (insert x S) y"
8.2180 - hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
8.2181 - unfolding setge_def by auto }
8.2182 - hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
8.2183 - hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
8.2184 - ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
8.2185 -qed
8.2186 -
8.2187 -lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
8.2188 - by (rule rinf_insert, rule finite_imp_bounded, simp)
8.2189 -
8.2190 -subsection{* Compactness (the definition is the one based on convegent subsequences). *}
8.2191 -
8.2192 -definition
8.2193 - compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
8.2194 - "compact S \<longleftrightarrow>
8.2195 - (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
8.2196 - (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
8.2197 -
8.2198 -text {*
8.2199 - A metric space (or topological vector space) is said to have the
8.2200 - Heine-Borel property if every closed and bounded subset is compact.
8.2201 -*}
8.2202 -
8.2203 -class heine_borel =
8.2204 - assumes bounded_imp_convergent_subsequence:
8.2205 - "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
8.2206 - \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
8.2207 -
8.2208 -lemma bounded_closed_imp_compact:
8.2209 - fixes s::"'a::heine_borel set"
8.2210 - assumes "bounded s" and "closed s" shows "compact s"
8.2211 -proof (unfold compact_def, clarify)
8.2212 - fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
8.2213 - obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
8.2214 - using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
8.2215 - from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
8.2216 - have "l \<in> s" using `closed s` fr l
8.2217 - unfolding closed_sequential_limits by blast
8.2218 - show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
8.2219 - using `l \<in> s` r l by blast
8.2220 -qed
8.2221 -
8.2222 -lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
8.2223 -proof(induct n)
8.2224 - show "0 \<le> r 0" by auto
8.2225 -next
8.2226 - fix n assume "n \<le> r n"
8.2227 - moreover have "r n < r (Suc n)"
8.2228 - using assms [unfolded subseq_def] by auto
8.2229 - ultimately show "Suc n \<le> r (Suc n)" by auto
8.2230 -qed
8.2231 -
8.2232 -lemma eventually_subseq:
8.2233 - assumes r: "subseq r"
8.2234 - shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
8.2235 -unfolding eventually_sequentially
8.2236 -by (metis subseq_bigger [OF r] le_trans)
8.2237 -
8.2238 -lemma lim_subseq:
8.2239 - "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
8.2240 -unfolding tendsto_def eventually_sequentially o_def
8.2241 -by (metis subseq_bigger le_trans)
8.2242 -
8.2243 -lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
8.2244 - unfolding Ex1_def
8.2245 - apply (rule_tac x="nat_rec e f" in exI)
8.2246 - apply (rule conjI)+
8.2247 -apply (rule def_nat_rec_0, simp)
8.2248 -apply (rule allI, rule def_nat_rec_Suc, simp)
8.2249 -apply (rule allI, rule impI, rule ext)
8.2250 -apply (erule conjE)
8.2251 -apply (induct_tac x)
8.2252 -apply (simp add: nat_rec_0)
8.2253 -apply (erule_tac x="n" in allE)
8.2254 -apply (simp)
8.2255 -done
8.2256 -
8.2257 -lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
8.2258 - assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
8.2259 - shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
8.2260 -proof-
8.2261 - have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
8.2262 - then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
8.2263 - { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
8.2264 - { fix n::nat
8.2265 - obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
8.2266 - have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
8.2267 - with n have "s N \<le> t - e" using `e>0` by auto
8.2268 - hence "s n \<le> t - e" using assms(1)[unfolded incseq_def, THEN spec[where x=n], THEN spec[where x=N]] using `n\<le>N` by auto }
8.2269 - hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
8.2270 - hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
8.2271 - thus ?thesis by blast
8.2272 -qed
8.2273 -
8.2274 -lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
8.2275 - assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
8.2276 - shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
8.2277 - using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
8.2278 - unfolding monoseq_def incseq_def
8.2279 - apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
8.2280 - unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
8.2281 -
8.2282 -lemma compact_real_lemma:
8.2283 - assumes "\<forall>n::nat. abs(s n) \<le> b"
8.2284 - shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
8.2285 -proof-
8.2286 - obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
8.2287 - using seq_monosub[of s] by auto
8.2288 - thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
8.2289 - unfolding tendsto_iff dist_norm eventually_sequentially by auto
8.2290 -qed
8.2291 -
8.2292 -instance real :: heine_borel
8.2293 -proof
8.2294 - fix s :: "real set" and f :: "nat \<Rightarrow> real"
8.2295 - assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
8.2296 - then obtain b where b: "\<forall>n. abs (f n) \<le> b"
8.2297 - unfolding bounded_iff by auto
8.2298 - obtain l :: real and r :: "nat \<Rightarrow> nat" where
8.2299 - r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
8.2300 - using compact_real_lemma [OF b] by auto
8.2301 - thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
8.2302 - by auto
8.2303 -qed
8.2304 -
8.2305 -lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
8.2306 -unfolding bounded_def
8.2307 -apply clarify
8.2308 -apply (rule_tac x="x $ i" in exI)
8.2309 -apply (rule_tac x="e" in exI)
8.2310 -apply clarify
8.2311 -apply (rule order_trans [OF dist_nth_le], simp)
8.2312 -done
8.2313 -
8.2314 -lemma compact_lemma:
8.2315 - fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
8.2316 - assumes "bounded s" and "\<forall>n. f n \<in> s"
8.2317 - shows "\<forall>d.
8.2318 - \<exists>l r. subseq r \<and>
8.2319 - (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
8.2320 -proof
8.2321 - fix d::"'n set" have "finite d" by simp
8.2322 - thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
8.2323 - (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
8.2324 - proof(induct d) case empty thus ?case unfolding subseq_def by auto
8.2325 - next case (insert k d)
8.2326 - have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
8.2327 - obtain l1::"'a^'n" and r1 where r1:"subseq r1" and lr1:"\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially"
8.2328 - using insert(3) by auto
8.2329 - have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
8.2330 - obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
8.2331 - using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
8.2332 - def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
8.2333 - using r1 and r2 unfolding r_def o_def subseq_def by auto
8.2334 - moreover
8.2335 - def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
8.2336 - { fix e::real assume "e>0"
8.2337 - from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
8.2338 - from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
8.2339 - from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
8.2340 - by (rule eventually_subseq)
8.2341 - have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
8.2342 - using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
8.2343 - }
8.2344 - ultimately show ?case by auto
8.2345 - qed
8.2346 -qed
8.2347 -
8.2348 -instance "^" :: (heine_borel, finite) heine_borel
8.2349 -proof
8.2350 - fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
8.2351 - assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
8.2352 - then obtain l r where r: "subseq r"
8.2353 - and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
8.2354 - using compact_lemma [OF s f] by blast
8.2355 - let ?d = "UNIV::'b set"
8.2356 - { fix e::real assume "e>0"
8.2357 - hence "0 < e / (real_of_nat (card ?d))"
8.2358 - using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
8.2359 - with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
8.2360 - by simp
8.2361 - moreover
8.2362 - { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
8.2363 - have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
8.2364 - unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
8.2365 - also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
8.2366 - by (rule setsum_strict_mono) (simp_all add: n)
8.2367 - finally have "dist (f (r n)) l < e" by simp
8.2368 - }
8.2369 - ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
8.2370 - by (rule eventually_elim1)
8.2371 - }
8.2372 - hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
8.2373 - with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
8.2374 -qed
8.2375 -
8.2376 -lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
8.2377 -unfolding bounded_def
8.2378 -apply clarify
8.2379 -apply (rule_tac x="a" in exI)
8.2380 -apply (rule_tac x="e" in exI)
8.2381 -apply clarsimp
8.2382 -apply (drule (1) bspec)
8.2383 -apply (simp add: dist_Pair_Pair)
8.2384 -apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
8.2385 -done
8.2386 -
8.2387 -lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
8.2388 -unfolding bounded_def
8.2389 -apply clarify
8.2390 -apply (rule_tac x="b" in exI)
8.2391 -apply (rule_tac x="e" in exI)
8.2392 -apply clarsimp
8.2393 -apply (drule (1) bspec)
8.2394 -apply (simp add: dist_Pair_Pair)
8.2395 -apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
8.2396 -done
8.2397 -
8.2398 -instance "*" :: (heine_borel, heine_borel) heine_borel
8.2399 -proof
8.2400 - fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
8.2401 - assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
8.2402 - from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
8.2403 - from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
8.2404 - obtain l1 r1 where r1: "subseq r1"
8.2405 - and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
8.2406 - using bounded_imp_convergent_subsequence [OF s1 f1]
8.2407 - unfolding o_def by fast
8.2408 - from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
8.2409 - from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
8.2410 - obtain l2 r2 where r2: "subseq r2"
8.2411 - and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
8.2412 - using bounded_imp_convergent_subsequence [OF s2 f2]
8.2413 - unfolding o_def by fast
8.2414 - have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
8.2415 - using lim_subseq [OF r2 l1] unfolding o_def .
8.2416 - have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
8.2417 - using tendsto_Pair [OF l1' l2] unfolding o_def by simp
8.2418 - have r: "subseq (r1 \<circ> r2)"
8.2419 - using r1 r2 unfolding subseq_def by simp
8.2420 - show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
8.2421 - using l r by fast
8.2422 -qed
8.2423 -
8.2424 -subsection{* Completeness. *}
8.2425 -
8.2426 -lemma cauchy_def:
8.2427 - "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
8.2428 -unfolding Cauchy_def by blast
8.2429 -
8.2430 -definition
8.2431 - complete :: "'a::metric_space set \<Rightarrow> bool" where
8.2432 - "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
8.2433 - --> (\<exists>l \<in> s. (f ---> l) sequentially))"
8.2434 -
8.2435 -lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
8.2436 -proof-
8.2437 - { assume ?rhs
8.2438 - { fix e::real
8.2439 - assume "e>0"
8.2440 - with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
8.2441 - by (erule_tac x="e/2" in allE) auto
8.2442 - { fix n m
8.2443 - assume nm:"N \<le> m \<and> N \<le> n"
8.2444 - hence "dist (s m) (s n) < e" using N
8.2445 - using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
8.2446 - by blast
8.2447 - }
8.2448 - hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
8.2449 - by blast
8.2450 - }
8.2451 - hence ?lhs
8.2452 - unfolding cauchy_def
8.2453 - by blast
8.2454 - }
8.2455 - thus ?thesis
8.2456 - unfolding cauchy_def
8.2457 - using dist_triangle_half_l
8.2458 - by blast
8.2459 -qed
8.2460 -
8.2461 -lemma convergent_imp_cauchy:
8.2462 - "(s ---> l) sequentially ==> Cauchy s"
8.2463 -proof(simp only: cauchy_def, rule, rule)
8.2464 - fix e::real assume "e>0" "(s ---> l) sequentially"
8.2465 - then obtain N::nat where N:"\<forall>n\<ge>N. dist (s n) l < e/2" unfolding Lim_sequentially by(erule_tac x="e/2" in allE) auto
8.2466 - thus "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e" using dist_triangle_half_l[of _ l e _] by (rule_tac x=N in exI) auto
8.2467 -qed
8.2468 -
8.2469 -lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
8.2470 -proof-
8.2471 - from assms obtain N::nat where "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < 1" unfolding cauchy_def apply(erule_tac x= 1 in allE) by auto
8.2472 - hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
8.2473 - moreover
8.2474 - have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
8.2475 - then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
8.2476 - unfolding bounded_any_center [where a="s N"] by auto
8.2477 - ultimately show "?thesis"
8.2478 - unfolding bounded_any_center [where a="s N"]
8.2479 - apply(rule_tac x="max a 1" in exI) apply auto
8.2480 - apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
8.2481 -qed
8.2482 -
8.2483 -lemma compact_imp_complete: assumes "compact s" shows "complete s"
8.2484 -proof-
8.2485 - { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
8.2486 - from as(1) obtain l r where lr: "l\<in>s" "subseq r" "((f \<circ> r) ---> l) sequentially" using assms unfolding compact_def by blast
8.2487 -
8.2488 - note lr' = subseq_bigger [OF lr(2)]
8.2489 -
8.2490 - { fix e::real assume "e>0"
8.2491 - from as(2) obtain N where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (f m) (f n) < e/2" unfolding cauchy_def using `e>0` apply (erule_tac x="e/2" in allE) by auto
8.2492 - from lr(3)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] obtain M where M:"\<forall>n\<ge>M. dist ((f \<circ> r) n) l < e/2" using `e>0` by auto
8.2493 - { fix n::nat assume n:"n \<ge> max N M"
8.2494 - have "dist ((f \<circ> r) n) l < e/2" using n M by auto
8.2495 - moreover have "r n \<ge> N" using lr'[of n] n by auto
8.2496 - hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
8.2497 - ultimately have "dist (f n) l < e" using dist_triangle_half_r[of "f (r n)" "f n" e l] by (auto simp add: dist_commute) }
8.2498 - hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
8.2499 - hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
8.2500 - thus ?thesis unfolding complete_def by auto
8.2501 -qed
8.2502 -
8.2503 -instance heine_borel < complete_space
8.2504 -proof
8.2505 - fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
8.2506 - hence "bounded (range f)" unfolding image_def
8.2507 - using cauchy_imp_bounded [of f] by auto
8.2508 - hence "compact (closure (range f))"
8.2509 - using bounded_closed_imp_compact [of "closure (range f)"] by auto
8.2510 - hence "complete (closure (range f))"
8.2511 - using compact_imp_complete by auto
8.2512 - moreover have "\<forall>n. f n \<in> closure (range f)"
8.2513 - using closure_subset [of "range f"] by auto
8.2514 - ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
8.2515 - using `Cauchy f` unfolding complete_def by auto
8.2516 - then show "convergent f"
8.2517 - unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
8.2518 -qed
8.2519 -
8.2520 -lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
8.2521 -proof(simp add: complete_def, rule, rule)
8.2522 - fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
8.2523 - hence "convergent f" by (rule Cauchy_convergent)
8.2524 - hence "\<exists>l. f ----> l" unfolding convergent_def .
8.2525 - thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
8.2526 -qed
8.2527 -
8.2528 -lemma complete_imp_closed: assumes "complete s" shows "closed s"
8.2529 -proof -
8.2530 - { fix x assume "x islimpt s"
8.2531 - then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
8.2532 - unfolding islimpt_sequential by auto
8.2533 - then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
8.2534 - using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
8.2535 - hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
8.2536 - }
8.2537 - thus "closed s" unfolding closed_limpt by auto
8.2538 -qed
8.2539 -
8.2540 -lemma complete_eq_closed:
8.2541 - fixes s :: "'a::complete_space set"
8.2542 - shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
8.2543 -proof
8.2544 - assume ?lhs thus ?rhs by (rule complete_imp_closed)
8.2545 -next
8.2546 - assume ?rhs
8.2547 - { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
8.2548 - then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
8.2549 - hence "\<exists>l\<in>s. (f ---> l) sequentially" using `?rhs`[unfolded closed_sequential_limits, THEN spec[where x=f], THEN spec[where x=l]] using as(1) by auto }
8.2550 - thus ?lhs unfolding complete_def by auto
8.2551 -qed
8.2552 -
8.2553 -lemma convergent_eq_cauchy:
8.2554 - fixes s :: "nat \<Rightarrow> 'a::complete_space"
8.2555 - shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
8.2556 -proof
8.2557 - assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
8.2558 - thus ?rhs using convergent_imp_cauchy by auto
8.2559 -next
8.2560 - assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
8.2561 -qed
8.2562 -
8.2563 -lemma convergent_imp_bounded:
8.2564 - fixes s :: "nat \<Rightarrow> 'a::metric_space"
8.2565 - shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
8.2566 - using convergent_imp_cauchy[of s]
8.2567 - using cauchy_imp_bounded[of s]
8.2568 - unfolding image_def
8.2569 - by auto
8.2570 -
8.2571 -subsection{* Total boundedness. *}
8.2572 -
8.2573 -fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
8.2574 - "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
8.2575 -declare helper_1.simps[simp del]
8.2576 -
8.2577 -lemma compact_imp_totally_bounded:
8.2578 - assumes "compact s"
8.2579 - shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
8.2580 -proof(rule, rule, rule ccontr)
8.2581 - fix e::real assume "e>0" and assm:"\<not> (\<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k)"
8.2582 - def x \<equiv> "helper_1 s e"
8.2583 - { fix n
8.2584 - have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
8.2585 - proof(induct_tac rule:nat_less_induct)
8.2586 - fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
8.2587 - assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
8.2588 - have "\<not> s \<subseteq> (\<Union>x\<in>x ` {0..<n}. ball x e)" using assm apply simp apply(erule_tac x="x ` {0 ..< n}" in allE) using as by auto
8.2589 - then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
8.2590 - have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
8.2591 - apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
8.2592 - thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
8.2593 - qed }
8.2594 - hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
8.2595 - then obtain l r where "l\<in>s" and r:"subseq r" and "((x \<circ> r) ---> l) sequentially" using assms(1)[unfolded compact_def, THEN spec[where x=x]] by auto
8.2596 - from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
8.2597 - then obtain N::nat where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist ((x \<circ> r) m) ((x \<circ> r) n) < e" unfolding cauchy_def using `e>0` by auto
8.2598 - show False
8.2599 - using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
8.2600 - using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
8.2601 - using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
8.2602 -qed
8.2603 -
8.2604 -subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
8.2605 -
8.2606 -lemma heine_borel_lemma: fixes s::"'a::metric_space set"
8.2607 - assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
8.2608 - shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
8.2609 -proof(rule ccontr)
8.2610 - assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
8.2611 - hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
8.2612 - { fix n::nat
8.2613 - have "1 / real (n + 1) > 0" by auto
8.2614 - hence "\<exists>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> (ball x (inverse (real (n+1))) \<subseteq> xa))" using cont unfolding Bex_def by auto }
8.2615 - hence "\<forall>n::nat. \<exists>x. x \<in> s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)" by auto
8.2616 - then obtain f where f:"\<forall>n::nat. f n \<in> s \<and> (\<forall>xa\<in>t. \<not> ball (f n) (inverse (real (n + 1))) \<subseteq> xa)"
8.2617 - using choice[of "\<lambda>n::nat. \<lambda>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)"] by auto
8.2618 -
8.2619 - then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
8.2620 - using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
8.2621 -
8.2622 - obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
8.2623 - then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
8.2624 - using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
8.2625 -
8.2626 - then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
8.2627 - using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
8.2628 -
8.2629 - obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
8.2630 - have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
8.2631 - apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
8.2632 - using subseq_bigger[OF r, of "N1 + N2"] by auto
8.2633 -
8.2634 - def x \<equiv> "(f (r (N1 + N2)))"
8.2635 - have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
8.2636 - using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
8.2637 - have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
8.2638 - then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
8.2639 -
8.2640 - have "dist x l < e/2" using N1 unfolding x_def o_def by auto
8.2641 - hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
8.2642 -
8.2643 - thus False using e and `y\<notin>b` by auto
8.2644 -qed
8.2645 -
8.2646 -lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
8.2647 - \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
8.2648 -proof clarify
8.2649 - fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
8.2650 - then obtain e::real where "e>0" and "\<forall>x\<in>s. \<exists>b\<in>f. ball x e \<subseteq> b" using heine_borel_lemma[of s f] by auto
8.2651 - hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
8.2652 - hence "\<exists>bb. \<forall>x\<in>s. bb x \<in>f \<and> ball x e \<subseteq> bb x" using bchoice[of s "\<lambda>x b. b\<in>f \<and> ball x e \<subseteq> b"] by auto
8.2653 - then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
8.2654 -
8.2655 - from `compact s` have "\<exists> k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" using compact_imp_totally_bounded[of s] `e>0` by auto
8.2656 - then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
8.2657 -
8.2658 - have "finite (bb ` k)" using k(1) by auto
8.2659 - moreover
8.2660 - { fix x assume "x\<in>s"
8.2661 - hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
8.2662 - hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
8.2663 - hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
8.2664 - }
8.2665 - ultimately show "\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f'" using bb k(2) by (rule_tac x="bb ` k" in exI) auto
8.2666 -qed
8.2667 -
8.2668 -subsection{* Bolzano-Weierstrass property. *}
8.2669 -
8.2670 -lemma heine_borel_imp_bolzano_weierstrass:
8.2671 - assumes "\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f) --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f'))"
8.2672 - "infinite t" "t \<subseteq> s"
8.2673 - shows "\<exists>x \<in> s. x islimpt t"
8.2674 -proof(rule ccontr)
8.2675 - assume "\<not> (\<exists>x \<in> s. x islimpt t)"
8.2676 - then obtain f where f:"\<forall>x\<in>s. x \<in> f x \<and> open (f x) \<and> (\<forall>y\<in>t. y \<in> f x \<longrightarrow> y = x)" unfolding islimpt_def
8.2677 - using bchoice[of s "\<lambda> x T. x \<in> T \<and> open T \<and> (\<forall>y\<in>t. y \<in> T \<longrightarrow> y = x)"] by auto
8.2678 - obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
8.2679 - using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
8.2680 - from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
8.2681 - { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
8.2682 - hence "x \<in> f x" "y \<in> f x \<longrightarrow> y = x" using f[THEN bspec[where x=x]] and `t\<subseteq>s` by auto
8.2683 - hence "x = y" using `f x = f y` and f[THEN bspec[where x=y]] and `y\<in>t` and `t\<subseteq>s` by auto }
8.2684 - hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
8.2685 - moreover
8.2686 - { fix x assume "x\<in>t" "f x \<notin> g"
8.2687 - from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
8.2688 - then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
8.2689 - hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
8.2690 - hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
8.2691 - hence "f ` t \<subseteq> g" by auto
8.2692 - ultimately show False using g(2) using finite_subset by auto
8.2693 -qed
8.2694 -
8.2695 -subsection{* Complete the chain of compactness variants. *}
8.2696 -
8.2697 -primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
8.2698 - "helper_2 beyond 0 = beyond 0" |
8.2699 - "helper_2 beyond (Suc n) = beyond (dist undefined (helper_2 beyond n) + 1 )"
8.2700 -
8.2701 -lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
8.2702 - assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
8.2703 - shows "bounded s"
8.2704 -proof(rule ccontr)
8.2705 - assume "\<not> bounded s"
8.2706 - then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist undefined (beyond a) \<le> a"
8.2707 - unfolding bounded_any_center [where a=undefined]
8.2708 - apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist undefined x \<le> a"] by auto
8.2709 - hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist undefined (beyond a) > a"
8.2710 - unfolding linorder_not_le by auto
8.2711 - def x \<equiv> "helper_2 beyond"
8.2712 -
8.2713 - { fix m n ::nat assume "m<n"
8.2714 - hence "dist undefined (x m) + 1 < dist undefined (x n)"
8.2715 - proof(induct n)
8.2716 - case 0 thus ?case by auto
8.2717 - next
8.2718 - case (Suc n)
8.2719 - have *:"dist undefined (x n) + 1 < dist undefined (x (Suc n))"
8.2720 - unfolding x_def and helper_2.simps
8.2721 - using beyond(2)[of "dist undefined (helper_2 beyond n) + 1"] by auto
8.2722 - thus ?case proof(cases "m < n")
8.2723 - case True thus ?thesis using Suc and * by auto
8.2724 - next
8.2725 - case False hence "m = n" using Suc(2) by auto
8.2726 - thus ?thesis using * by auto
8.2727 - qed
8.2728 - qed } note * = this
8.2729 - { fix m n ::nat assume "m\<noteq>n"
8.2730 - have "1 < dist (x m) (x n)"
8.2731 - proof(cases "m<n")
8.2732 - case True
8.2733 - hence "1 < dist undefined (x n) - dist undefined (x m)" using *[of m n] by auto
8.2734 - thus ?thesis using dist_triangle [of undefined "x n" "x m"] by arith
8.2735 - next
8.2736 - case False hence "n<m" using `m\<noteq>n` by auto
8.2737 - hence "1 < dist undefined (x m) - dist undefined (x n)" using *[of n m] by auto
8.2738 - thus ?thesis using dist_triangle2 [of undefined "x m" "x n"] by arith
8.2739 - qed } note ** = this
8.2740 - { fix a b assume "x a = x b" "a \<noteq> b"
8.2741 - hence False using **[of a b] by auto }
8.2742 - hence "inj x" unfolding inj_on_def by auto
8.2743 - moreover
8.2744 - { fix n::nat
8.2745 - have "x n \<in> s"
8.2746 - proof(cases "n = 0")
8.2747 - case True thus ?thesis unfolding x_def using beyond by auto
8.2748 - next
8.2749 - case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
8.2750 - thus ?thesis unfolding x_def using beyond by auto
8.2751 - qed }
8.2752 - ultimately have "infinite (range x) \<and> range x \<subseteq> s" unfolding x_def using range_inj_infinite[of "helper_2 beyond"] using beyond(1) by auto
8.2753 -
8.2754 - then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
8.2755 - then obtain y where "x y \<noteq> l" and y:"dist (x y) l < 1/2" unfolding islimpt_approachable apply(erule_tac x="1/2" in allE) by auto
8.2756 - then obtain z where "x z \<noteq> l" and z:"dist (x z) l < dist (x y) l" using l[unfolded islimpt_approachable, THEN spec[where x="dist (x y) l"]]
8.2757 - unfolding dist_nz by auto
8.2758 - show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
8.2759 -qed
8.2760 -
8.2761 -lemma sequence_infinite_lemma:
8.2762 - fixes l :: "'a::metric_space" (* TODO: generalize *)
8.2763 - assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
8.2764 - shows "infinite {y. (\<exists> n. y = f n)}"
8.2765 -proof(rule ccontr)
8.2766 - let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
8.2767 - assume "\<not> infinite {y. \<exists>n. y = f n}"
8.2768 - hence **:"finite ?A" "?A \<noteq> {}" by auto
8.2769 - obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
8.2770 - have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
8.2771 - then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
8.2772 - moreover have "dist (f N) l \<in> ?A" by auto
8.2773 - ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
8.2774 -qed
8.2775 -
8.2776 -lemma sequence_unique_limpt:
8.2777 - fixes l :: "'a::metric_space" (* TODO: generalize *)
8.2778 - assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
8.2779 - shows "l' = l"
8.2780 -proof(rule ccontr)
8.2781 - def e \<equiv> "dist l' l"
8.2782 - assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
8.2783 - then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
8.2784 - using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
8.2785 - def d \<equiv> "Min (insert (e/2) ((\<lambda>n. if dist (f n) l' = 0 then e/2 else dist (f n) l') ` {0 .. N}))"
8.2786 - have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
8.2787 - obtain k where k:"f k \<noteq> l'" "dist (f k) l' < d" using `d>0` and assms(3)[unfolded islimpt_approachable, THEN spec[where x="d"]] by auto
8.2788 - have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
8.2789 - by force
8.2790 - hence "dist l' l < e" using N[THEN spec[where x=k]] using k(2)[unfolded d_def] and dist_triangle_half_r[of "f k" l' e l] by auto
8.2791 - thus False unfolding e_def by auto
8.2792 -qed
8.2793 -
8.2794 -lemma bolzano_weierstrass_imp_closed:
8.2795 - fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
8.2796 - assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
8.2797 - shows "closed s"
8.2798 -proof-
8.2799 - { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
8.2800 - hence "l \<in> s"
8.2801 - proof(cases "\<forall>n. x n \<noteq> l")
8.2802 - case False thus "l\<in>s" using as(1) by auto
8.2803 - next
8.2804 - case True note cas = this
8.2805 - with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
8.2806 - then obtain l' where "l'\<in>s" "l' islimpt {y. \<exists>n. y = x n}" using assms[THEN spec[where x="{y. \<exists>n. y = x n}"]] as(1) by auto
8.2807 - thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
8.2808 - qed }
8.2809 - thus ?thesis unfolding closed_sequential_limits by fast
8.2810 -qed
8.2811 -
8.2812 -text{* Hence express everything as an equivalence. *}
8.2813 -
8.2814 -lemma compact_eq_heine_borel:
8.2815 - fixes s :: "'a::heine_borel set"
8.2816 - shows "compact s \<longleftrightarrow>
8.2817 - (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
8.2818 - --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))" (is "?lhs = ?rhs")
8.2819 -proof
8.2820 - assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
8.2821 -next
8.2822 - assume ?rhs
8.2823 - hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
8.2824 - by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
8.2825 - thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
8.2826 -qed
8.2827 -
8.2828 -lemma compact_eq_bolzano_weierstrass:
8.2829 - fixes s :: "'a::heine_borel set"
8.2830 - shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
8.2831 -proof
8.2832 - assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
8.2833 -next
8.2834 - assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
8.2835 -qed
8.2836 -
8.2837 -lemma compact_eq_bounded_closed:
8.2838 - fixes s :: "'a::heine_borel set"
8.2839 - shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
8.2840 -proof
8.2841 - assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
8.2842 -next
8.2843 - assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
8.2844 -qed
8.2845 -
8.2846 -lemma compact_imp_bounded:
8.2847 - fixes s :: "'a::metric_space set"
8.2848 - shows "compact s ==> bounded s"
8.2849 -proof -
8.2850 - assume "compact s"
8.2851 - hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
8.2852 - by (rule compact_imp_heine_borel)
8.2853 - hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
8.2854 - using heine_borel_imp_bolzano_weierstrass[of s] by auto
8.2855 - thus "bounded s"
8.2856 - by (rule bolzano_weierstrass_imp_bounded)
8.2857 -qed
8.2858 -
8.2859 -lemma compact_imp_closed:
8.2860 - fixes s :: "'a::metric_space set"
8.2861 - shows "compact s ==> closed s"
8.2862 -proof -
8.2863 - assume "compact s"
8.2864 - hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
8.2865 - by (rule compact_imp_heine_borel)
8.2866 - hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
8.2867 - using heine_borel_imp_bolzano_weierstrass[of s] by auto
8.2868 - thus "closed s"
8.2869 - by (rule bolzano_weierstrass_imp_closed)
8.2870 -qed
8.2871 -
8.2872 -text{* In particular, some common special cases. *}
8.2873 -
8.2874 -lemma compact_empty[simp]:
8.2875 - "compact {}"
8.2876 - unfolding compact_def
8.2877 - by simp
8.2878 -
8.2879 -(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
8.2880 -
8.2881 - (* FIXME : Rename *)
8.2882 -lemma compact_union[intro]:
8.2883 - fixes s t :: "'a::heine_borel set"
8.2884 - shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
8.2885 - unfolding compact_eq_bounded_closed
8.2886 - using bounded_Un[of s t]
8.2887 - using closed_Un[of s t]
8.2888 - by simp
8.2889 -
8.2890 -lemma compact_inter[intro]:
8.2891 - fixes s t :: "'a::heine_borel set"
8.2892 - shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
8.2893 - unfolding compact_eq_bounded_closed
8.2894 - using bounded_Int[of s t]
8.2895 - using closed_Int[of s t]
8.2896 - by simp
8.2897 -
8.2898 -lemma compact_inter_closed[intro]:
8.2899 - fixes s t :: "'a::heine_borel set"
8.2900 - shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
8.2901 - unfolding compact_eq_bounded_closed
8.2902 - using closed_Int[of s t]
8.2903 - using bounded_subset[of "s \<inter> t" s]
8.2904 - by blast
8.2905 -
8.2906 -lemma closed_inter_compact[intro]:
8.2907 - fixes s t :: "'a::heine_borel set"
8.2908 - shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
8.2909 -proof-
8.2910 - assume "closed s" "compact t"
8.2911 - moreover
8.2912 - have "s \<inter> t = t \<inter> s" by auto ultimately
8.2913 - show ?thesis
8.2914 - using compact_inter_closed[of t s]
8.2915 - by auto
8.2916 -qed
8.2917 -
8.2918 -lemma closed_sing [simp]:
8.2919 - fixes a :: "'a::metric_space"
8.2920 - shows "closed {a}"
8.2921 - apply (clarsimp simp add: closed_def open_dist)
8.2922 - apply (rule ccontr)
8.2923 - apply (drule_tac x="dist x a" in spec)
8.2924 - apply (simp add: dist_nz dist_commute)
8.2925 - done
8.2926 -
8.2927 -lemma finite_imp_closed:
8.2928 - fixes s :: "'a::metric_space set"
8.2929 - shows "finite s ==> closed s"
8.2930 -proof (induct set: finite)
8.2931 - case empty show "closed {}" by simp
8.2932 -next
8.2933 - case (insert x F)
8.2934 - hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
8.2935 - thus "closed (insert x F)" by simp
8.2936 -qed
8.2937 -
8.2938 -lemma finite_imp_compact:
8.2939 - fixes s :: "'a::heine_borel set"
8.2940 - shows "finite s ==> compact s"
8.2941 - unfolding compact_eq_bounded_closed
8.2942 - using finite_imp_closed finite_imp_bounded
8.2943 - by blast
8.2944 -
8.2945 -lemma compact_sing [simp]: "compact {a}"
8.2946 - unfolding compact_def o_def subseq_def
8.2947 - by (auto simp add: tendsto_const)
8.2948 -
8.2949 -lemma compact_cball[simp]:
8.2950 - fixes x :: "'a::heine_borel"
8.2951 - shows "compact(cball x e)"
8.2952 - using compact_eq_bounded_closed bounded_cball closed_cball
8.2953 - by blast
8.2954 -
8.2955 -lemma compact_frontier_bounded[intro]:
8.2956 - fixes s :: "'a::heine_borel set"
8.2957 - shows "bounded s ==> compact(frontier s)"
8.2958 - unfolding frontier_def
8.2959 - using compact_eq_bounded_closed
8.2960 - by blast
8.2961 -
8.2962 -lemma compact_frontier[intro]:
8.2963 - fixes s :: "'a::heine_borel set"
8.2964 - shows "compact s ==> compact (frontier s)"
8.2965 - using compact_eq_bounded_closed compact_frontier_bounded
8.2966 - by blast
8.2967 -
8.2968 -lemma frontier_subset_compact:
8.2969 - fixes s :: "'a::heine_borel set"
8.2970 - shows "compact s ==> frontier s \<subseteq> s"
8.2971 - using frontier_subset_closed compact_eq_bounded_closed
8.2972 - by blast
8.2973 -
8.2974 -lemma open_delete:
8.2975 - fixes s :: "'a::metric_space set"
8.2976 - shows "open s ==> open(s - {x})"
8.2977 - using open_Diff[of s "{x}"] closed_sing
8.2978 - by blast
8.2979 -
8.2980 -text{* Finite intersection property. I could make it an equivalence in fact. *}
8.2981 -
8.2982 -lemma compact_imp_fip:
8.2983 - fixes s :: "'a::heine_borel set"
8.2984 - assumes "compact s" "\<forall>t \<in> f. closed t"
8.2985 - "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
8.2986 - shows "s \<inter> (\<Inter> f) \<noteq> {}"
8.2987 -proof
8.2988 - assume as:"s \<inter> (\<Inter> f) = {}"
8.2989 - hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
8.2990 - moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
8.2991 - ultimately obtain f' where f':"f' \<subseteq> op - UNIV ` f" "finite f'" "s \<subseteq> \<Union>f'" using assms(1)[unfolded compact_eq_heine_borel, THEN spec[where x="(\<lambda>t. UNIV - t) ` f"]] by auto
8.2992 - hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
8.2993 - hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
8.2994 - thus False using f'(3) unfolding subset_eq and Union_iff by blast
8.2995 -qed
8.2996 -
8.2997 -subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
8.2998 -
8.2999 -lemma bounded_closed_nest:
8.3000 - assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
8.3001 - "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
8.3002 - shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
8.3003 -proof-
8.3004 - from assms(2) obtain x where x:"\<forall>n::nat. x n \<in> s n" using choice[of "\<lambda>n x. x\<in> s n"] by auto
8.3005 - from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
8.3006 -
8.3007 - then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
8.3008 - unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
8.3009 -
8.3010 - { fix n::nat
8.3011 - { fix e::real assume "e>0"
8.3012 - with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
8.3013 - hence "dist ((x \<circ> r) (max N n)) l < e" by auto
8.3014 - moreover
8.3015 - have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
8.3016 - hence "(x \<circ> r) (max N n) \<in> s n"
8.3017 - using x apply(erule_tac x=n in allE)
8.3018 - using x apply(erule_tac x="r (max N n)" in allE)
8.3019 - using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
8.3020 - ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
8.3021 - }
8.3022 - hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
8.3023 - }
8.3024 - thus ?thesis by auto
8.3025 -qed
8.3026 -
8.3027 -text{* Decreasing case does not even need compactness, just completeness. *}
8.3028 -
8.3029 -lemma decreasing_closed_nest:
8.3030 - assumes "\<forall>n. closed(s n)"
8.3031 - "\<forall>n. (s n \<noteq> {})"
8.3032 - "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
8.3033 - "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
8.3034 - shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
8.3035 -proof-
8.3036 - have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
8.3037 - hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
8.3038 - then obtain t where t: "\<forall>n. t n \<in> s n" by auto
8.3039 - { fix e::real assume "e>0"
8.3040 - then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
8.3041 - { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
8.3042 - hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
8.3043 - hence "dist (t m) (t n) < e" using N by auto
8.3044 - }
8.3045 - hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
8.3046 - }
8.3047 - hence "Cauchy t" unfolding cauchy_def by auto
8.3048 - then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
8.3049 - { fix n::nat
8.3050 - { fix e::real assume "e>0"
8.3051 - then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
8.3052 - have "t (max n N) \<in> s n" using assms(3) unfolding subset_eq apply(erule_tac x=n in allE) apply (erule_tac x="max n N" in allE) using t by auto
8.3053 - hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
8.3054 - }
8.3055 - hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
8.3056 - }
8.3057 - then show ?thesis by auto
8.3058 -qed
8.3059 -
8.3060 -text{* Strengthen it to the intersection actually being a singleton. *}
8.3061 -
8.3062 -lemma decreasing_closed_nest_sing:
8.3063 - assumes "\<forall>n. closed(s n)"
8.3064 - "\<forall>n. s n \<noteq> {}"
8.3065 - "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
8.3066 - "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
8.3067 - shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
8.3068 -proof-
8.3069 - obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
8.3070 - { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
8.3071 - { fix e::real assume "e>0"
8.3072 - hence "dist a b < e" using assms(4 )using b using a by blast
8.3073 - }
8.3074 - hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
8.3075 - }
8.3076 - with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
8.3077 - thus ?thesis by auto
8.3078 -qed
8.3079 -
8.3080 -text{* Cauchy-type criteria for uniform convergence. *}
8.3081 -
8.3082 -lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
8.3083 - "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
8.3084 - (\<forall>e>0. \<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e)" (is "?lhs = ?rhs")
8.3085 -proof(rule)
8.3086 - assume ?lhs
8.3087 - then obtain l where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e" by auto
8.3088 - { fix e::real assume "e>0"
8.3089 - then obtain N::nat where N:"\<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e / 2" using l[THEN spec[where x="e/2"]] by auto
8.3090 - { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
8.3091 - hence "dist (s m x) (s n x) < e"
8.3092 - using N[THEN spec[where x=m], THEN spec[where x=x]]
8.3093 - using N[THEN spec[where x=n], THEN spec[where x=x]]
8.3094 - using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
8.3095 - hence "\<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e" by auto }
8.3096 - thus ?rhs by auto
8.3097 -next
8.3098 - assume ?rhs
8.3099 - hence "\<forall>x. P x \<longrightarrow> Cauchy (\<lambda>n. s n x)" unfolding cauchy_def apply auto by (erule_tac x=e in allE)auto
8.3100 - then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
8.3101 - using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
8.3102 - { fix e::real assume "e>0"
8.3103 - then obtain N where N:"\<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x \<longrightarrow> dist (s m x) (s n x) < e/2"
8.3104 - using `?rhs`[THEN spec[where x="e/2"]] by auto
8.3105 - { fix x assume "P x"
8.3106 - then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
8.3107 - using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
8.3108 - fix n::nat assume "n\<ge>N"
8.3109 - hence "dist(s n x)(l x) < e" using `P x`and N[THEN spec[where x=n], THEN spec[where x="N+M"], THEN spec[where x=x]]
8.3110 - using M[THEN spec[where x="N+M"]] and dist_triangle_half_l[of "s n x" "s (N+M) x" e "l x"] by (auto simp add: dist_commute) }
8.3111 - hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
8.3112 - thus ?lhs by auto
8.3113 -qed
8.3114 -
8.3115 -lemma uniformly_cauchy_imp_uniformly_convergent:
8.3116 - fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
8.3117 - assumes "\<forall>e>0.\<exists>N. \<forall>m (n::nat) x. N \<le> m \<and> N \<le> n \<and> P x --> dist(s m x)(s n x) < e"
8.3118 - "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
8.3119 - shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
8.3120 -proof-
8.3121 - obtain l' where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l' x) < e"
8.3122 - using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
8.3123 - moreover
8.3124 - { fix x assume "P x"
8.3125 - hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
8.3126 - using l and assms(2) unfolding Lim_sequentially by blast }
8.3127 - ultimately show ?thesis by auto
8.3128 -qed
8.3129 -
8.3130 -subsection{* Define continuity over a net to take in restrictions of the set. *}
8.3131 -
8.3132 -definition
8.3133 - continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
8.3134 - "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
8.3135 -
8.3136 -lemma continuous_trivial_limit:
8.3137 - "trivial_limit net ==> continuous net f"
8.3138 - unfolding continuous_def tendsto_def trivial_limit_eq by auto
8.3139 -
8.3140 -lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
8.3141 - unfolding continuous_def
8.3142 - unfolding tendsto_def
8.3143 - using netlimit_within[of x s]
8.3144 - by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
8.3145 -
8.3146 -lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
8.3147 - using continuous_within [of x UNIV f] by (simp add: within_UNIV)
8.3148 -
8.3149 -lemma continuous_at_within:
8.3150 - assumes "continuous (at x) f" shows "continuous (at x within s) f"
8.3151 - using assms unfolding continuous_at continuous_within
8.3152 - by (rule Lim_at_within)
8.3153 -
8.3154 -text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
8.3155 -
8.3156 -lemma continuous_within_eps_delta:
8.3157 - "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. \<forall>x'\<in> s. dist x' x < d --> dist (f x') (f x) < e)"
8.3158 - unfolding continuous_within and Lim_within
8.3159 - apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
8.3160 -
8.3161 -lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
8.3162 - \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
8.3163 - using continuous_within_eps_delta[of x UNIV f]
8.3164 - unfolding within_UNIV by blast
8.3165 -
8.3166 -text{* Versions in terms of open balls. *}
8.3167 -
8.3168 -lemma continuous_within_ball:
8.3169 - "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
8.3170 - f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
8.3171 -proof
8.3172 - assume ?lhs
8.3173 - { fix e::real assume "e>0"
8.3174 - then obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
8.3175 - using `?lhs`[unfolded continuous_within Lim_within] by auto
8.3176 - { fix y assume "y\<in>f ` (ball x d \<inter> s)"
8.3177 - hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
8.3178 - apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
8.3179 - }
8.3180 - hence "\<exists>d>0. f ` (ball x d \<inter> s) \<subseteq> ball (f x) e" using `d>0` unfolding subset_eq ball_def by (auto simp add: dist_commute) }
8.3181 - thus ?rhs by auto
8.3182 -next
8.3183 - assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
8.3184 - apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
8.3185 -qed
8.3186 -
8.3187 -lemma continuous_at_ball:
8.3188 - "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
8.3189 -proof
8.3190 - assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
8.3191 - apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x=xa in allE) apply (auto simp add: dist_commute dist_nz)
8.3192 - unfolding dist_nz[THEN sym] by auto
8.3193 -next
8.3194 - assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
8.3195 - apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x="f xa" in allE) by (auto simp add: dist_commute dist_nz)
8.3196 -qed
8.3197 -
8.3198 -text{* For setwise continuity, just start from the epsilon-delta definitions. *}
8.3199 -
8.3200 -definition
8.3201 - continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
8.3202 - "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d::real>0. \<forall>x' \<in> s. dist x' x < d --> dist (f x') (f x) < e)"
8.3203 -
8.3204 -
8.3205 -definition
8.3206 - uniformly_continuous_on ::
8.3207 - "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
8.3208 - "uniformly_continuous_on s f \<longleftrightarrow>
8.3209 - (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
8.3210 - --> dist (f x') (f x) < e)"
8.3211 -
8.3212 -text{* Some simple consequential lemmas. *}
8.3213 -
8.3214 -lemma uniformly_continuous_imp_continuous:
8.3215 - " uniformly_continuous_on s f ==> continuous_on s f"
8.3216 - unfolding uniformly_continuous_on_def continuous_on_def by blast
8.3217 -
8.3218 -lemma continuous_at_imp_continuous_within:
8.3219 - "continuous (at x) f ==> continuous (at x within s) f"
8.3220 - unfolding continuous_within continuous_at using Lim_at_within by auto
8.3221 -
8.3222 -lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
8.3223 - shows "continuous_on s f"
8.3224 -proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
8.3225 - fix x and e::real assume "x\<in>s" "e>0"
8.3226 - hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
8.3227 - then obtain d where d:"d>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" unfolding eventually_at by auto
8.3228 - { fix x' assume "\<not> 0 < dist x' x"
8.3229 - hence "x=x'"
8.3230 - using dist_nz[of x' x] by auto
8.3231 - hence "dist (f x') (f x) < e" using `e>0` by auto
8.3232 - }
8.3233 - thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
8.3234 -qed
8.3235 -
8.3236 -lemma continuous_on_eq_continuous_within:
8.3237 - "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
8.3238 -proof
8.3239 - assume ?rhs
8.3240 - { fix x assume "x\<in>s"
8.3241 - fix e::real assume "e>0"
8.3242 - assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
8.3243 - then obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" by auto
8.3244 - { fix x' assume as:"x'\<in>s" "dist x' x < d"
8.3245 - hence "dist (f x') (f x) < e" using `e>0` d `x'\<in>s` dist_eq_0_iff[of x' x] zero_le_dist[of x' x] as(2) by (metis dist_eq_0_iff dist_nz) }
8.3246 - hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
8.3247 - }
8.3248 - thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
8.3249 -next
8.3250 - assume ?lhs
8.3251 - thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
8.3252 -qed
8.3253 -
8.3254 -lemma continuous_on:
8.3255 - "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
8.3256 - by (auto simp add: continuous_on_eq_continuous_within continuous_within)
8.3257 -
8.3258 -lemma continuous_on_eq_continuous_at:
8.3259 - "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
8.3260 - by (auto simp add: continuous_on continuous_at Lim_within_open)
8.3261 -
8.3262 -lemma continuous_within_subset:
8.3263 - "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
8.3264 - ==> continuous (at x within t) f"
8.3265 - unfolding continuous_within by(metis Lim_within_subset)
8.3266 -
8.3267 -lemma continuous_on_subset:
8.3268 - "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
8.3269 - unfolding continuous_on by (metis subset_eq Lim_within_subset)
8.3270 -
8.3271 -lemma continuous_on_interior:
8.3272 - "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
8.3273 -unfolding interior_def
8.3274 -apply simp
8.3275 -by (meson continuous_on_eq_continuous_at continuous_on_subset)
8.3276 -
8.3277 -lemma continuous_on_eq:
8.3278 - "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
8.3279 - ==> continuous_on s g"
8.3280 - by (simp add: continuous_on_def)
8.3281 -
8.3282 -text{* Characterization of various kinds of continuity in terms of sequences. *}
8.3283 -
8.3284 -(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
8.3285 -lemma continuous_within_sequentially:
8.3286 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
8.3287 - shows "continuous (at a within s) f \<longleftrightarrow>
8.3288 - (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
8.3289 - --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
8.3290 -proof
8.3291 - assume ?lhs
8.3292 - { fix x::"nat \<Rightarrow> 'a" assume x:"\<forall>n. x n \<in> s" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (x n) a < e"
8.3293 - fix e::real assume "e>0"
8.3294 - from `?lhs` obtain d where "d>0" and d:"\<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e" unfolding continuous_within Lim_within using `e>0` by auto
8.3295 - from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
8.3296 - hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
8.3297 - apply(rule_tac x=N in exI) using N d apply auto using x(1)
8.3298 - apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
8.3299 - apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
8.3300 - }
8.3301 - thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
8.3302 -next
8.3303 - assume ?rhs
8.3304 - { fix e::real assume "e>0"
8.3305 - assume "\<not> (\<exists>d>0. \<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e)"
8.3306 - hence "\<forall>d. \<exists>x. d>0 \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)" by blast
8.3307 - then obtain x where x:"\<forall>d>0. x d \<in> s \<and> (0 < dist (x d) a \<and> dist (x d) a < d \<and> \<not> dist (f (x d)) (f a) < e)"
8.3308 - using choice[of "\<lambda>d x.0<d \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)"] by auto
8.3309 - { fix d::real assume "d>0"
8.3310 - hence "\<exists>N::nat. inverse (real (N + 1)) < d" using real_arch_inv[of d] by (auto, rule_tac x="n - 1" in exI)auto
8.3311 - then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
8.3312 - { fix n::nat assume n:"n\<ge>N"
8.3313 - hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
8.3314 - moreover have "inverse (real (n + 1)) < d" using N n by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
8.3315 - ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
8.3316 - }
8.3317 - hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
8.3318 - }
8.3319 - hence "(\<forall>n::nat. x (inverse (real (n + 1))) \<in> s) \<and> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < e)" using x by auto
8.3320 - hence "\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (f (x (inverse (real (n + 1))))) (f a) < e" using `?rhs`[THEN spec[where x="\<lambda>n::nat. x (inverse (real (n+1)))"], unfolded Lim_sequentially] by auto
8.3321 - hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
8.3322 - }
8.3323 - thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
8.3324 -qed
8.3325 -
8.3326 -lemma continuous_at_sequentially:
8.3327 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
8.3328 - shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
8.3329 - --> ((f o x) ---> f a) sequentially)"
8.3330 - using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
8.3331 -
8.3332 -lemma continuous_on_sequentially:
8.3333 - "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
8.3334 - --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
8.3335 -proof
8.3336 - assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
8.3337 -next
8.3338 - assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
8.3339 -qed
8.3340 -
8.3341 -lemma uniformly_continuous_on_sequentially:
8.3342 - fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
8.3343 - shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
8.3344 - ((\<lambda>n. x n - y n) ---> 0) sequentially
8.3345 - \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
8.3346 -proof
8.3347 - assume ?lhs
8.3348 - { fix x y assume x:"\<forall>n. x n \<in> s" and y:"\<forall>n. y n \<in> s" and xy:"((\<lambda>n. x n - y n) ---> 0) sequentially"
8.3349 - { fix e::real assume "e>0"
8.3350 - then obtain d where "d>0" and d:"\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
8.3351 - using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
8.3352 - obtain N where N:"\<forall>n\<ge>N. norm (x n - y n - 0) < d" using xy[unfolded Lim_sequentially dist_norm] and `d>0` by auto
8.3353 - { fix n assume "n\<ge>N"
8.3354 - hence "norm (f (x n) - f (y n) - 0) < e"
8.3355 - using N[THEN spec[where x=n]] using d[THEN bspec[where x="x n"], THEN bspec[where x="y n"]] using x and y
8.3356 - unfolding dist_commute and dist_norm by simp }
8.3357 - hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
8.3358 - hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
8.3359 - thus ?rhs by auto
8.3360 -next
8.3361 - assume ?rhs
8.3362 - { assume "\<not> ?lhs"
8.3363 - then obtain e where "e>0" "\<forall>d>0. \<exists>x\<in>s. \<exists>x'\<in>s. dist x' x < d \<and> \<not> dist (f x') (f x) < e" unfolding uniformly_continuous_on_def by auto
8.3364 - then obtain fa where fa:"\<forall>x. 0 < x \<longrightarrow> fst (fa x) \<in> s \<and> snd (fa x) \<in> s \<and> dist (fst (fa x)) (snd (fa x)) < x \<and> \<not> dist (f (fst (fa x))) (f (snd (fa x))) < e"
8.3365 - using choice[of "\<lambda>d x. d>0 \<longrightarrow> fst x \<in> s \<and> snd x \<in> s \<and> dist (snd x) (fst x) < d \<and> \<not> dist (f (snd x)) (f (fst x)) < e"] unfolding Bex_def
8.3366 - by (auto simp add: dist_commute)
8.3367 - def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
8.3368 - def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
8.3369 - have xyn:"\<forall>n. x n \<in> s \<and> y n \<in> s" and xy0:"\<forall>n. dist (x n) (y n) < inverse (real n + 1)" and fxy:"\<forall>n. \<not> dist (f (x n)) (f (y n)) < e"
8.3370 - unfolding x_def and y_def using fa by auto
8.3371 - have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
8.3372 - have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
8.3373 - { fix e::real assume "e>0"
8.3374 - then obtain N::nat where "N \<noteq> 0" and N:"0 < inverse (real N) \<and> inverse (real N) < e" unfolding real_arch_inv[of e] by auto
8.3375 - { fix n::nat assume "n\<ge>N"
8.3376 - hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
8.3377 - also have "\<dots> < e" using N by auto
8.3378 - finally have "inverse (real n + 1) < e" by auto
8.3379 - hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
8.3380 - hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
8.3381 - hence "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f (x n) - f (y n)) 0 < e" using `?rhs`[THEN spec[where x=x], THEN spec[where x=y]] and xyn unfolding Lim_sequentially by auto
8.3382 - hence False unfolding 2 using fxy and `e>0` by auto }
8.3383 - thus ?lhs unfolding uniformly_continuous_on_def by blast
8.3384 -qed
8.3385 -
8.3386 -text{* The usual transformation theorems. *}
8.3387 -
8.3388 -lemma continuous_transform_within:
8.3389 - fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
8.3390 - assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
8.3391 - "continuous (at x within s) f"
8.3392 - shows "continuous (at x within s) g"
8.3393 -proof-
8.3394 - { fix e::real assume "e>0"
8.3395 - then obtain d' where d':"d'>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(4) unfolding continuous_within Lim_within by auto
8.3396 - { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
8.3397 - hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
8.3398 - hence "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
8.3399 - hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto }
8.3400 - hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
8.3401 - thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
8.3402 -qed
8.3403 -
8.3404 -lemma continuous_transform_at:
8.3405 - fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
8.3406 - assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
8.3407 - "continuous (at x) f"
8.3408 - shows "continuous (at x) g"
8.3409 -proof-
8.3410 - { fix e::real assume "e>0"
8.3411 - then obtain d' where d':"d'>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(3) unfolding continuous_at Lim_at by auto
8.3412 - { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
8.3413 - hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
8.3414 - }
8.3415 - hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
8.3416 - hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto
8.3417 - }
8.3418 - hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
8.3419 - thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
8.3420 -qed
8.3421 -
8.3422 -text{* Combination results for pointwise continuity. *}
8.3423 -
8.3424 -lemma continuous_const: "continuous net (\<lambda>x. c)"
8.3425 - by (auto simp add: continuous_def Lim_const)
8.3426 -
8.3427 -lemma continuous_cmul:
8.3428 - fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
8.3429 - shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
8.3430 - by (auto simp add: continuous_def Lim_cmul)
8.3431 -
8.3432 -lemma continuous_neg:
8.3433 - fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
8.3434 - shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
8.3435 - by (auto simp add: continuous_def Lim_neg)
8.3436 -
8.3437 -lemma continuous_add:
8.3438 - fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
8.3439 - shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
8.3440 - by (auto simp add: continuous_def Lim_add)
8.3441 -
8.3442 -lemma continuous_sub:
8.3443 - fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
8.3444 - shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
8.3445 - by (auto simp add: continuous_def Lim_sub)
8.3446 -
8.3447 -text{* Same thing for setwise continuity. *}
8.3448 -
8.3449 -lemma continuous_on_const:
8.3450 - "continuous_on s (\<lambda>x. c)"
8.3451 - unfolding continuous_on_eq_continuous_within using continuous_const by blast
8.3452 -
8.3453 -lemma continuous_on_cmul:
8.3454 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3455 - shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
8.3456 - unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
8.3457 -
8.3458 -lemma continuous_on_neg:
8.3459 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3460 - shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
8.3461 - unfolding continuous_on_eq_continuous_within using continuous_neg by blast
8.3462 -
8.3463 -lemma continuous_on_add:
8.3464 - fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3465 - shows "continuous_on s f \<Longrightarrow> continuous_on s g
8.3466 - \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
8.3467 - unfolding continuous_on_eq_continuous_within using continuous_add by blast
8.3468 -
8.3469 -lemma continuous_on_sub:
8.3470 - fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3471 - shows "continuous_on s f \<Longrightarrow> continuous_on s g
8.3472 - \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
8.3473 - unfolding continuous_on_eq_continuous_within using continuous_sub by blast
8.3474 -
8.3475 -text{* Same thing for uniform continuity, using sequential formulations. *}
8.3476 -
8.3477 -lemma uniformly_continuous_on_const:
8.3478 - "uniformly_continuous_on s (\<lambda>x. c)"
8.3479 - unfolding uniformly_continuous_on_def by simp
8.3480 -
8.3481 -lemma uniformly_continuous_on_cmul:
8.3482 - fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
8.3483 - (* FIXME: generalize 'a to metric_space *)
8.3484 - assumes "uniformly_continuous_on s f"
8.3485 - shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
8.3486 -proof-
8.3487 - { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
8.3488 - hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
8.3489 - using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
8.3490 - unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
8.3491 - }
8.3492 - thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
8.3493 -qed
8.3494 -
8.3495 -lemma dist_minus:
8.3496 - fixes x y :: "'a::real_normed_vector"
8.3497 - shows "dist (- x) (- y) = dist x y"
8.3498 - unfolding dist_norm minus_diff_minus norm_minus_cancel ..
8.3499 -
8.3500 -lemma uniformly_continuous_on_neg:
8.3501 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3502 - shows "uniformly_continuous_on s f
8.3503 - ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
8.3504 - unfolding uniformly_continuous_on_def dist_minus .
8.3505 -
8.3506 -lemma uniformly_continuous_on_add:
8.3507 - fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
8.3508 - assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
8.3509 - shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
8.3510 -proof-
8.3511 - { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
8.3512 - "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
8.3513 - hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
8.3514 - using Lim_add[of "\<lambda> n. f (x n) - f (y n)" 0 sequentially "\<lambda> n. g (x n) - g (y n)" 0] by auto
8.3515 - hence "((\<lambda>n. f (x n) + g (x n) - (f (y n) + g (y n))) ---> 0) sequentially" unfolding Lim_sequentially and add_diff_add [symmetric] by auto }
8.3516 - thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
8.3517 -qed
8.3518 -
8.3519 -lemma uniformly_continuous_on_sub:
8.3520 - fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
8.3521 - shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
8.3522 - ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
8.3523 - unfolding ab_diff_minus
8.3524 - using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
8.3525 - using uniformly_continuous_on_neg[of s g] by auto
8.3526 -
8.3527 -text{* Identity function is continuous in every sense. *}
8.3528 -
8.3529 -lemma continuous_within_id:
8.3530 - "continuous (at a within s) (\<lambda>x. x)"
8.3531 - unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
8.3532 -
8.3533 -lemma continuous_at_id:
8.3534 - "continuous (at a) (\<lambda>x. x)"
8.3535 - unfolding continuous_at by (rule Lim_ident_at)
8.3536 -
8.3537 -lemma continuous_on_id:
8.3538 - "continuous_on s (\<lambda>x. x)"
8.3539 - unfolding continuous_on Lim_within by auto
8.3540 -
8.3541 -lemma uniformly_continuous_on_id:
8.3542 - "uniformly_continuous_on s (\<lambda>x. x)"
8.3543 - unfolding uniformly_continuous_on_def by auto
8.3544 -
8.3545 -text{* Continuity of all kinds is preserved under composition. *}
8.3546 -
8.3547 -lemma continuous_within_compose:
8.3548 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3549 - fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
8.3550 - assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
8.3551 - shows "continuous (at x within s) (g o f)"
8.3552 -proof-
8.3553 - { fix e::real assume "e>0"
8.3554 - with assms(2)[unfolded continuous_within Lim_within] obtain d where "d>0" and d:"\<forall>xa\<in>f ` s. 0 < dist xa (f x) \<and> dist xa (f x) < d \<longrightarrow> dist (g xa) (g (f x)) < e" by auto
8.3555 - from assms(1)[unfolded continuous_within Lim_within] obtain d' where "d'>0" and d':"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < d" using `d>0` by auto
8.3556 - { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
8.3557 - hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
8.3558 - hence "dist (g (f y)) (g (f x)) < e" using as(1) d[THEN bspec[where x="f y"]] unfolding dist_nz[THEN sym] using `e>0` by auto }
8.3559 - hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (g (f xa)) (g (f x)) < e" using `d'>0` by auto }
8.3560 - thus ?thesis unfolding continuous_within Lim_within by auto
8.3561 -qed
8.3562 -
8.3563 -lemma continuous_at_compose:
8.3564 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3565 - fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
8.3566 - assumes "continuous (at x) f" "continuous (at (f x)) g"
8.3567 - shows "continuous (at x) (g o f)"
8.3568 -proof-
8.3569 - have " continuous (at (f x) within range f) g" using assms(2) using continuous_within_subset[of "f x" UNIV g "range f", unfolded within_UNIV] by auto
8.3570 - thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
8.3571 -qed
8.3572 -
8.3573 -lemma continuous_on_compose:
8.3574 - "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
8.3575 - unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
8.3576 -
8.3577 -lemma uniformly_continuous_on_compose:
8.3578 - assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
8.3579 - shows "uniformly_continuous_on s (g o f)"
8.3580 -proof-
8.3581 - { fix e::real assume "e>0"
8.3582 - then obtain d where "d>0" and d:"\<forall>x\<in>f ` s. \<forall>x'\<in>f ` s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using assms(2) unfolding uniformly_continuous_on_def by auto
8.3583 - obtain d' where "d'>0" "\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d' \<longrightarrow> dist (f x') (f x) < d" using `d>0` using assms(1) unfolding uniformly_continuous_on_def by auto
8.3584 - hence "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist ((g \<circ> f) x') ((g \<circ> f) x) < e" using `d>0` using d by auto }
8.3585 - thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
8.3586 -qed
8.3587 -
8.3588 -text{* Continuity in terms of open preimages. *}
8.3589 -
8.3590 -lemma continuous_at_open:
8.3591 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3592 - shows "continuous (at x) f \<longleftrightarrow> (\<forall>t. open t \<and> f x \<in> t --> (\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x' \<in> s. (f x') \<in> t)))" (is "?lhs = ?rhs")
8.3593 -proof
8.3594 - assume ?lhs
8.3595 - { fix t assume as: "open t" "f x \<in> t"
8.3596 - then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
8.3597 -
8.3598 - obtain d where "d>0" and d:"\<forall>y. 0 < dist y x \<and> dist y x < d \<longrightarrow> dist (f y) (f x) < e" using `e>0` using `?lhs`[unfolded continuous_at Lim_at open_dist] by auto
8.3599 -
8.3600 - have "open (ball x d)" using open_ball by auto
8.3601 - moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
8.3602 - moreover
8.3603 - { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
8.3604 - using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
8.3605 - unfolding mem_ball apply (auto simp add: dist_commute)
8.3606 - unfolding dist_nz[THEN sym] using as(2) by auto }
8.3607 - hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
8.3608 - ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
8.3609 - apply(rule_tac x="ball x d" in exI) by simp }
8.3610 - thus ?rhs by auto
8.3611 -next
8.3612 - assume ?rhs
8.3613 - { fix e::real assume "e>0"
8.3614 - then obtain s where s: "open s" "x \<in> s" "\<forall>x'\<in>s. f x' \<in> ball (f x) e" using `?rhs`[unfolded continuous_at Lim_at, THEN spec[where x="ball (f x) e"]]
8.3615 - unfolding centre_in_ball[of "f x" e, THEN sym] by auto
8.3616 - then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
8.3617 - { fix y assume "0 < dist y x \<and> dist y x < d"
8.3618 - hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
8.3619 - using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
8.3620 - hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `d>0` by auto }
8.3621 - thus ?lhs unfolding continuous_at Lim_at by auto
8.3622 -qed
8.3623 -
8.3624 -lemma continuous_on_open:
8.3625 - "continuous_on s f \<longleftrightarrow>
8.3626 - (\<forall>t. openin (subtopology euclidean (f ` s)) t
8.3627 - --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
8.3628 -proof
8.3629 - assume ?lhs
8.3630 - { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
8.3631 - have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
8.3632 - moreover
8.3633 - { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
8.3634 - then obtain e where e: "e>0" "\<forall>x'\<in>f ` s. dist x' (f x) < e \<longrightarrow> x' \<in> t" using as[unfolded openin_euclidean_subtopology_iff, THEN conjunct2, THEN bspec[where x="f x"]] by auto
8.3635 - from this(1) obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `?lhs`[unfolded continuous_on Lim_within, THEN bspec[where x=x]] using as' by auto
8.3636 - have "\<exists>e>0. \<forall>x'\<in>s. dist x' x < e \<longrightarrow> x' \<in> {x \<in> s. f x \<in> t}" using d e unfolding dist_nz[THEN sym] by (rule_tac x=d in exI, auto) }
8.3637 - ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
8.3638 - thus ?rhs unfolding continuous_on Lim_within using openin by auto
8.3639 -next
8.3640 - assume ?rhs
8.3641 - { fix e::real and x assume "x\<in>s" "e>0"
8.3642 - { fix xa x' assume "dist (f xa) (f x) < e" "xa \<in> s" "x' \<in> s" "dist (f xa) (f x') < e - dist (f xa) (f x)"
8.3643 - hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
8.3644 - by (auto simp add: dist_commute) }
8.3645 - hence "ball (f x) e \<inter> f ` s \<subseteq> f ` s \<and> (\<forall>xa\<in>ball (f x) e \<inter> f ` s. \<exists>ea>0. \<forall>x'\<in>f ` s. dist x' xa < ea \<longrightarrow> x' \<in> ball (f x) e \<inter> f ` s)" apply auto
8.3646 - apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
8.3647 - hence "\<forall>xa\<in>{xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}. \<exists>ea>0. \<forall>x'\<in>s. dist x' xa < ea \<longrightarrow> x' \<in> {xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}"
8.3648 - using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
8.3649 - hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" apply(erule_tac x=x in ballE) apply auto using `e>0` `x\<in>s` by (auto simp add: dist_commute) }
8.3650 - thus ?lhs unfolding continuous_on Lim_within by auto
8.3651 -qed
8.3652 -
8.3653 -(* ------------------------------------------------------------------------- *)
8.3654 -(* Similarly in terms of closed sets. *)
8.3655 -(* ------------------------------------------------------------------------- *)
8.3656 -
8.3657 -lemma continuous_on_closed:
8.3658 - "continuous_on s f \<longleftrightarrow> (\<forall>t. closedin (subtopology euclidean (f ` s)) t --> closedin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
8.3659 -proof
8.3660 - assume ?lhs
8.3661 - { fix t
8.3662 - have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
8.3663 - have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
8.3664 - assume as:"closedin (subtopology euclidean (f ` s)) t"
8.3665 - hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
8.3666 - hence "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?lhs`[unfolded continuous_on_open, THEN spec[where x="(f ` s) - t"]]
8.3667 - unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
8.3668 - thus ?rhs by auto
8.3669 -next
8.3670 - assume ?rhs
8.3671 - { fix t
8.3672 - have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
8.3673 - assume as:"openin (subtopology euclidean (f ` s)) t"
8.3674 - hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
8.3675 - unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
8.3676 - thus ?lhs unfolding continuous_on_open by auto
8.3677 -qed
8.3678 -
8.3679 -text{* Half-global and completely global cases. *}
8.3680 -
8.3681 -lemma continuous_open_in_preimage:
8.3682 - assumes "continuous_on s f" "open t"
8.3683 - shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
8.3684 -proof-
8.3685 - have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
8.3686 - have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
8.3687 - using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
8.3688 - thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
8.3689 -qed
8.3690 -
8.3691 -lemma continuous_closed_in_preimage:
8.3692 - assumes "continuous_on s f" "closed t"
8.3693 - shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
8.3694 -proof-
8.3695 - have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
8.3696 - have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
8.3697 - using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
8.3698 - thus ?thesis
8.3699 - using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
8.3700 -qed
8.3701 -
8.3702 -lemma continuous_open_preimage:
8.3703 - assumes "continuous_on s f" "open s" "open t"
8.3704 - shows "open {x \<in> s. f x \<in> t}"
8.3705 -proof-
8.3706 - obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
8.3707 - using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
8.3708 - thus ?thesis using open_Int[of s T, OF assms(2)] by auto
8.3709 -qed
8.3710 -
8.3711 -lemma continuous_closed_preimage:
8.3712 - assumes "continuous_on s f" "closed s" "closed t"
8.3713 - shows "closed {x \<in> s. f x \<in> t}"
8.3714 -proof-
8.3715 - obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
8.3716 - using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
8.3717 - thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
8.3718 -qed
8.3719 -
8.3720 -lemma continuous_open_preimage_univ:
8.3721 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3722 - shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
8.3723 - using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
8.3724 -
8.3725 -lemma continuous_closed_preimage_univ:
8.3726 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3727 - shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
8.3728 - using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
8.3729 -
8.3730 -lemma continuous_open_vimage:
8.3731 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3732 - shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
8.3733 - unfolding vimage_def by (rule continuous_open_preimage_univ)
8.3734 -
8.3735 -lemma continuous_closed_vimage:
8.3736 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3737 - shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
8.3738 - unfolding vimage_def by (rule continuous_closed_preimage_univ)
8.3739 -
8.3740 -text{* Equality of continuous functions on closure and related results. *}
8.3741 -
8.3742 -lemma continuous_closed_in_preimage_constant:
8.3743 - "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
8.3744 - using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
8.3745 -
8.3746 -lemma continuous_closed_preimage_constant:
8.3747 - "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
8.3748 - using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
8.3749 -
8.3750 -lemma continuous_constant_on_closure:
8.3751 - assumes "continuous_on (closure s) f"
8.3752 - "\<forall>x \<in> s. f x = a"
8.3753 - shows "\<forall>x \<in> (closure s). f x = a"
8.3754 - using continuous_closed_preimage_constant[of "closure s" f a]
8.3755 - assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
8.3756 -
8.3757 -lemma image_closure_subset:
8.3758 - assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
8.3759 - shows "f ` (closure s) \<subseteq> t"
8.3760 -proof-
8.3761 - have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
8.3762 - moreover have "closed {x \<in> closure s. f x \<in> t}"
8.3763 - using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
8.3764 - ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
8.3765 - using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
8.3766 - thus ?thesis by auto
8.3767 -qed
8.3768 -
8.3769 -lemma continuous_on_closure_norm_le:
8.3770 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.3771 - assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
8.3772 - shows "norm(f x) \<le> b"
8.3773 -proof-
8.3774 - have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
8.3775 - show ?thesis
8.3776 - using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
8.3777 - unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
8.3778 -qed
8.3779 -
8.3780 -text{* Making a continuous function avoid some value in a neighbourhood. *}
8.3781 -
8.3782 -lemma continuous_within_avoid:
8.3783 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3784 - assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
8.3785 - shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
8.3786 -proof-
8.3787 - obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < dist (f x) a"
8.3788 - using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
8.3789 - { fix y assume " y\<in>s" "dist x y < d"
8.3790 - hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
8.3791 - apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
8.3792 - thus ?thesis using `d>0` by auto
8.3793 -qed
8.3794 -
8.3795 -lemma continuous_at_avoid:
8.3796 - fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
8.3797 - assumes "continuous (at x) f" "f x \<noteq> a"
8.3798 - shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
8.3799 -using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
8.3800 -
8.3801 -lemma continuous_on_avoid:
8.3802 - assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
8.3803 - shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
8.3804 -using assms(1)[unfolded continuous_on_eq_continuous_within, THEN bspec[where x=x], OF assms(2)] continuous_within_avoid[of x s f a] assms(2,3) by auto
8.3805 -
8.3806 -lemma continuous_on_open_avoid:
8.3807 - assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
8.3808 - shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
8.3809 -using assms(1)[unfolded continuous_on_eq_continuous_at[OF assms(2)], THEN bspec[where x=x], OF assms(3)] continuous_at_avoid[of x f a] assms(3,4) by auto
8.3810 -
8.3811 -text{* Proving a function is constant by proving open-ness of level set. *}
8.3812 -
8.3813 -lemma continuous_levelset_open_in_cases:
8.3814 - "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
8.3815 - openin (subtopology euclidean s) {x \<in> s. f x = a}
8.3816 - ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
8.3817 -unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
8.3818 -
8.3819 -lemma continuous_levelset_open_in:
8.3820 - "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
8.3821 - openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
8.3822 - (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
8.3823 -using continuous_levelset_open_in_cases[of s f ]
8.3824 -by meson
8.3825 -
8.3826 -lemma continuous_levelset_open:
8.3827 - assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
8.3828 - shows "\<forall>x \<in> s. f x = a"
8.3829 -using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
8.3830 -
8.3831 -text{* Some arithmetical combinations (more to prove). *}
8.3832 -
8.3833 -lemma open_scaling[intro]:
8.3834 - fixes s :: "'a::real_normed_vector set"
8.3835 - assumes "c \<noteq> 0" "open s"
8.3836 - shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
8.3837 -proof-
8.3838 - { fix x assume "x \<in> s"
8.3839 - then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> s" using assms(2)[unfolded open_dist, THEN bspec[where x=x]] by auto
8.3840 - have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
8.3841 - moreover
8.3842 - { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
8.3843 - hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
8.3844 - using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
8.3845 - assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
8.3846 - hence "y \<in> op *\<^sub>R c ` s" using rev_image_eqI[of "(1 / c) *\<^sub>R y" s y "op *\<^sub>R c"] e[THEN spec[where x="(1 / c) *\<^sub>R y"]] assms(1) unfolding dist_norm scaleR_scaleR by auto }
8.3847 - ultimately have "\<exists>e>0. \<forall>x'. dist x' (c *\<^sub>R x) < e \<longrightarrow> x' \<in> op *\<^sub>R c ` s" apply(rule_tac x="e * abs c" in exI) by auto }
8.3848 - thus ?thesis unfolding open_dist by auto
8.3849 -qed
8.3850 -
8.3851 -lemma minus_image_eq_vimage:
8.3852 - fixes A :: "'a::ab_group_add set"
8.3853 - shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
8.3854 - by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
8.3855 -
8.3856 -lemma open_negations:
8.3857 - fixes s :: "'a::real_normed_vector set"
8.3858 - shows "open s ==> open ((\<lambda> x. -x) ` s)"
8.3859 - unfolding scaleR_minus1_left [symmetric]
8.3860 - by (rule open_scaling, auto)
8.3861 -
8.3862 -lemma open_translation:
8.3863 - fixes s :: "'a::real_normed_vector set"
8.3864 - assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
8.3865 -proof-
8.3866 - { fix x have "continuous (at x) (\<lambda>x. x - a)" using continuous_sub[of "at x" "\<lambda>x. x" "\<lambda>x. a"] continuous_at_id[of x] continuous_const[of "at x" a] by auto }
8.3867 - moreover have "{x. x - a \<in> s} = op + a ` s" apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
8.3868 - ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
8.3869 -qed
8.3870 -
8.3871 -lemma open_affinity:
8.3872 - fixes s :: "'a::real_normed_vector set"
8.3873 - assumes "open s" "c \<noteq> 0"
8.3874 - shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
8.3875 -proof-
8.3876 - have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
8.3877 - have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
8.3878 - thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
8.3879 -qed
8.3880 -
8.3881 -lemma interior_translation:
8.3882 - fixes s :: "'a::real_normed_vector set"
8.3883 - shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
8.3884 -proof (rule set_ext, rule)
8.3885 - fix x assume "x \<in> interior (op + a ` s)"
8.3886 - then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
8.3887 - hence "ball (x - a) e \<subseteq> s" unfolding subset_eq Ball_def mem_ball dist_norm apply auto apply(erule_tac x="a + xa" in allE) unfolding ab_group_add_class.diff_diff_eq[THEN sym] by auto
8.3888 - thus "x \<in> op + a ` interior s" unfolding image_iff apply(rule_tac x="x - a" in bexI) unfolding mem_interior using `e > 0` by auto
8.3889 -next
8.3890 - fix x assume "x \<in> op + a ` interior s"
8.3891 - then obtain y e where "e>0" and e:"ball y e \<subseteq> s" and y:"x = a + y" unfolding image_iff Bex_def mem_interior by auto
8.3892 - { fix z have *:"a + y - z = y + a - z" by auto
8.3893 - assume "z\<in>ball x e"
8.3894 - hence "z - a \<in> s" using e[unfolded subset_eq, THEN bspec[where x="z - a"]] unfolding mem_ball dist_norm y ab_group_add_class.diff_diff_eq2 * by auto
8.3895 - hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
8.3896 - hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
8.3897 - thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
8.3898 -qed
8.3899 -
8.3900 -subsection {* Preservation of compactness and connectedness under continuous function. *}
8.3901 -
8.3902 -lemma compact_continuous_image:
8.3903 - assumes "continuous_on s f" "compact s"
8.3904 - shows "compact(f ` s)"
8.3905 -proof-
8.3906 - { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
8.3907 - then obtain y where y:"\<forall>n. y n \<in> s \<and> x n = f (y n)" unfolding image_iff Bex_def using choice[of "\<lambda>n xa. xa \<in> s \<and> x n = f xa"] by auto
8.3908 - then obtain l r where "l\<in>s" and r:"subseq r" and lr:"((y \<circ> r) ---> l) sequentially" using assms(2)[unfolded compact_def, THEN spec[where x=y]] by auto
8.3909 - { fix e::real assume "e>0"
8.3910 - then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' l < d \<longrightarrow> dist (f x') (f l) < e" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=l], OF `l\<in>s`] by auto
8.3911 - then obtain N::nat where N:"\<forall>n\<ge>N. dist ((y \<circ> r) n) l < d" using lr[unfolded Lim_sequentially, THEN spec[where x=d]] by auto
8.3912 - { fix n::nat assume "n\<ge>N" hence "dist ((x \<circ> r) n) (f l) < e" using N[THEN spec[where x=n]] d[THEN bspec[where x="y (r n)"]] y[THEN spec[where x="r n"]] by auto }
8.3913 - hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
8.3914 - hence "\<exists>l\<in>f ` s. \<exists>r. subseq r \<and> ((x \<circ> r) ---> l) sequentially" unfolding Lim_sequentially using r lr `l\<in>s` by auto }
8.3915 - thus ?thesis unfolding compact_def by auto
8.3916 -qed
8.3917 -
8.3918 -lemma connected_continuous_image:
8.3919 - assumes "continuous_on s f" "connected s"
8.3920 - shows "connected(f ` s)"
8.3921 -proof-
8.3922 - { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
8.3923 - have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
8.3924 - using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
8.3925 - using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
8.3926 - using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
8.3927 - hence False using as(1,2)
8.3928 - using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
8.3929 - thus ?thesis unfolding connected_clopen by auto
8.3930 -qed
8.3931 -
8.3932 -text{* Continuity implies uniform continuity on a compact domain. *}
8.3933 -
8.3934 -lemma compact_uniformly_continuous:
8.3935 - assumes "continuous_on s f" "compact s"
8.3936 - shows "uniformly_continuous_on s f"
8.3937 -proof-
8.3938 - { fix x assume x:"x\<in>s"
8.3939 - hence "\<forall>xa. \<exists>y. 0 < xa \<longrightarrow> (y > 0 \<and> (\<forall>x'\<in>s. dist x' x < y \<longrightarrow> dist (f x') (f x) < xa))" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=x]] by auto
8.3940 - hence "\<exists>fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)" using choice[of "\<lambda>e d. e>0 \<longrightarrow> d>0 \<and>(\<forall>x'\<in>s. (dist x' x < d \<longrightarrow> dist (f x') (f x) < e))"] by auto }
8.3941 - then have "\<forall>x\<in>s. \<exists>y. \<forall>xa. 0 < xa \<longrightarrow> (\<forall>x'\<in>s. y xa > 0 \<and> (dist x' x < y xa \<longrightarrow> dist (f x') (f x) < xa))" by auto
8.3942 - then obtain d where d:"\<forall>e>0. \<forall>x\<in>s. \<forall>x'\<in>s. d x e > 0 \<and> (dist x' x < d x e \<longrightarrow> dist (f x') (f x) < e)"
8.3943 - using bchoice[of s "\<lambda>x fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)"] by blast
8.3944 -
8.3945 - { fix e::real assume "e>0"
8.3946 -
8.3947 - { fix x assume "x\<in>s" hence "x \<in> ball x (d x (e / 2))" unfolding centre_in_ball using d[THEN spec[where x="e/2"]] using `e>0` by auto }
8.3948 - hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
8.3949 - moreover
8.3950 - { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
8.3951 - ultimately obtain ea where "ea>0" and ea:"\<forall>x\<in>s. \<exists>b\<in>{ball x (d x (e / 2)) |x. x \<in> s}. ball x ea \<subseteq> b" using heine_borel_lemma[OF assms(2), of "{ball x (d x (e / 2)) | x. x\<in>s }"] by auto
8.3952 -
8.3953 - { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
8.3954 - obtain z where "z\<in>s" and z:"ball x ea \<subseteq> ball z (d z (e / 2))" using ea[THEN bspec[where x=x]] and `x\<in>s` by auto
8.3955 - hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
8.3956 - hence "dist (f z) (f x) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `x\<in>s` and `z\<in>s`
8.3957 - by (auto simp add: dist_commute)
8.3958 - moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
8.3959 - by (auto simp add: dist_commute)
8.3960 - hence "dist (f z) (f y) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `y\<in>s` and `z\<in>s`
8.3961 - by (auto simp add: dist_commute)
8.3962 - ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
8.3963 - by (auto simp add: dist_commute) }
8.3964 - then have "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `ea>0` by auto }
8.3965 - thus ?thesis unfolding uniformly_continuous_on_def by auto
8.3966 -qed
8.3967 -
8.3968 -text{* Continuity of inverse function on compact domain. *}
8.3969 -
8.3970 -lemma continuous_on_inverse:
8.3971 - fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
8.3972 - (* TODO: can this be generalized more? *)
8.3973 - assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
8.3974 - shows "continuous_on (f ` s) g"
8.3975 -proof-
8.3976 - have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
8.3977 - { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
8.3978 - then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
8.3979 - have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
8.3980 - unfolding T(2) and Int_left_absorb by auto
8.3981 - moreover have "compact (s \<inter> T)"
8.3982 - using assms(2) unfolding compact_eq_bounded_closed
8.3983 - using bounded_subset[of s "s \<inter> T"] and T(1) by auto
8.3984 - ultimately have "closed (f ` t)" using T(1) unfolding T(2)
8.3985 - using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
8.3986 - moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
8.3987 - ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
8.3988 - unfolding closedin_closed by auto }
8.3989 - thus ?thesis unfolding continuous_on_closed by auto
8.3990 -qed
8.3991 -
8.3992 -subsection{* A uniformly convergent limit of continuous functions is continuous. *}
8.3993 -
8.3994 -lemma norm_triangle_lt:
8.3995 - fixes x y :: "'a::real_normed_vector"
8.3996 - shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
8.3997 -by (rule le_less_trans [OF norm_triangle_ineq])
8.3998 -
8.3999 -lemma continuous_uniform_limit:
8.4000 - fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
8.4001 - assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
8.4002 - "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
8.4003 - shows "continuous_on s g"
8.4004 -proof-
8.4005 - { fix x and e::real assume "x\<in>s" "e>0"
8.4006 - have "eventually (\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3) net" using `e>0` assms(3)[THEN spec[where x="e/3"]] by auto
8.4007 - then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
8.4008 - using eventually_and[of "(\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3)" "(\<lambda>n. continuous_on s (f n))" net] assms(1,2) eventually_happens by blast
8.4009 - have "e / 3 > 0" using `e>0` by auto
8.4010 - then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f n x') (f n x) < e / 3"
8.4011 - using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
8.4012 - { fix y assume "y\<in>s" "dist y x < d"
8.4013 - hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
8.4014 - hence "norm (f n y - g x) < 2 * e / 3" using norm_triangle_lt[of "f n y - f n x" "f n x - g x" "2*e/3"]
8.4015 - using n(1)[THEN bspec[where x=x], OF `x\<in>s`] unfolding dist_norm unfolding ab_group_add_class.ab_diff_minus by auto
8.4016 - hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
8.4017 - unfolding norm_minus_cancel[of "f n y - g y", THEN sym] using norm_triangle_lt[of "f n y - g x" "g y - f n y" e] by (auto simp add: uminus_add_conv_diff) }
8.4018 - hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
8.4019 - thus ?thesis unfolding continuous_on_def by auto
8.4020 -qed
8.4021 -
8.4022 -subsection{* Topological properties of linear functions. *}
8.4023 -
8.4024 -lemma linear_lim_0:
8.4025 - assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
8.4026 -proof-
8.4027 - interpret f: bounded_linear f by fact
8.4028 - have "(f ---> f 0) (at 0)"
8.4029 - using tendsto_ident_at by (rule f.tendsto)
8.4030 - thus ?thesis unfolding f.zero .
8.4031 -qed
8.4032 -
8.4033 -lemma linear_continuous_at:
8.4034 - assumes "bounded_linear f" shows "continuous (at a) f"
8.4035 - unfolding continuous_at using assms
8.4036 - apply (rule bounded_linear.tendsto)
8.4037 - apply (rule tendsto_ident_at)
8.4038 - done
8.4039 -
8.4040 -lemma linear_continuous_within:
8.4041 - shows "bounded_linear f ==> continuous (at x within s) f"
8.4042 - using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
8.4043 -
8.4044 -lemma linear_continuous_on:
8.4045 - shows "bounded_linear f ==> continuous_on s f"
8.4046 - using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
8.4047 -
8.4048 -text{* Also bilinear functions, in composition form. *}
8.4049 -
8.4050 -lemma bilinear_continuous_at_compose:
8.4051 - shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
8.4052 - ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
8.4053 - unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
8.4054 -
8.4055 -lemma bilinear_continuous_within_compose:
8.4056 - shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
8.4057 - ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
8.4058 - unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
8.4059 -
8.4060 -lemma bilinear_continuous_on_compose:
8.4061 - shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
8.4062 - ==> continuous_on s (\<lambda>x. h (f x) (g x))"
8.4063 - unfolding continuous_on_eq_continuous_within apply auto apply(erule_tac x=x in ballE) apply auto apply(erule_tac x=x in ballE) apply auto
8.4064 - using bilinear_continuous_within_compose[of _ s f g h] by auto
8.4065 -
8.4066 -subsection{* Topological stuff lifted from and dropped to R *}
8.4067 -
8.4068 -
8.4069 -lemma open_real:
8.4070 - fixes s :: "real set" shows
8.4071 - "open s \<longleftrightarrow>
8.4072 - (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
8.4073 - unfolding open_dist dist_norm by simp
8.4074 -
8.4075 -lemma islimpt_approachable_real:
8.4076 - fixes s :: "real set"
8.4077 - shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
8.4078 - unfolding islimpt_approachable dist_norm by simp
8.4079 -
8.4080 -lemma closed_real:
8.4081 - fixes s :: "real set"
8.4082 - shows "closed s \<longleftrightarrow>
8.4083 - (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
8.4084 - --> x \<in> s)"
8.4085 - unfolding closed_limpt islimpt_approachable dist_norm by simp
8.4086 -
8.4087 -lemma continuous_at_real_range:
8.4088 - fixes f :: "'a::real_normed_vector \<Rightarrow> real"
8.4089 - shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
8.4090 - \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
8.4091 - unfolding continuous_at unfolding Lim_at
8.4092 - unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
8.4093 - apply(erule_tac x=e in allE) apply auto apply (rule_tac x=d in exI) apply auto apply (erule_tac x=x' in allE) apply auto
8.4094 - apply(erule_tac x=e in allE) by auto
8.4095 -
8.4096 -lemma continuous_on_real_range:
8.4097 - fixes f :: "'a::real_normed_vector \<Rightarrow> real"
8.4098 - shows "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d>0. (\<forall>x' \<in> s. norm(x' - x) < d --> abs(f x' - f x) < e))"
8.4099 - unfolding continuous_on_def dist_norm by simp
8.4100 -
8.4101 -lemma continuous_at_norm: "continuous (at x) norm"
8.4102 - unfolding continuous_at by (intro tendsto_intros)
8.4103 -
8.4104 -lemma continuous_on_norm: "continuous_on s norm"
8.4105 -unfolding continuous_on by (intro ballI tendsto_intros)
8.4106 -
8.4107 -lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
8.4108 -unfolding continuous_at by (intro tendsto_intros)
8.4109 -
8.4110 -lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
8.4111 -unfolding continuous_on by (intro ballI tendsto_intros)
8.4112 -
8.4113 -lemma continuous_at_infnorm: "continuous (at x) infnorm"
8.4114 - unfolding continuous_at Lim_at o_def unfolding dist_norm
8.4115 - apply auto apply (rule_tac x=e in exI) apply auto
8.4116 - using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
8.4117 -
8.4118 -text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
8.4119 -
8.4120 -lemma compact_attains_sup:
8.4121 - fixes s :: "real set"
8.4122 - assumes "compact s" "s \<noteq> {}"
8.4123 - shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
8.4124 -proof-
8.4125 - from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
8.4126 - { fix e::real assume as: "\<forall>x\<in>s. x \<le> rsup s" "rsup s \<notin> s" "0 < e" "\<forall>x'\<in>s. x' = rsup s \<or> \<not> rsup s - x' < e"
8.4127 - have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
8.4128 - moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
8.4129 - ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
8.4130 - thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
8.4131 - apply(rule_tac x="rsup s" in bexI) by auto
8.4132 -qed
8.4133 -
8.4134 -lemma compact_attains_inf:
8.4135 - fixes s :: "real set"
8.4136 - assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
8.4137 -proof-
8.4138 - from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
8.4139 - { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
8.4140 - "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
8.4141 - have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
8.4142 - moreover
8.4143 - { fix x assume "x \<in> s"
8.4144 - hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
8.4145 - have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
8.4146 - hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
8.4147 - ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
8.4148 - thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
8.4149 - apply(rule_tac x="rinf s" in bexI) by auto
8.4150 -qed
8.4151 -
8.4152 -lemma continuous_attains_sup:
8.4153 - fixes f :: "'a::metric_space \<Rightarrow> real"
8.4154 - shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
8.4155 - ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
8.4156 - using compact_attains_sup[of "f ` s"]
8.4157 - using compact_continuous_image[of s f] by auto
8.4158 -
8.4159 -lemma continuous_attains_inf:
8.4160 - fixes f :: "'a::metric_space \<Rightarrow> real"
8.4161 - shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
8.4162 - \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
8.4163 - using compact_attains_inf[of "f ` s"]
8.4164 - using compact_continuous_image[of s f] by auto
8.4165 -
8.4166 -lemma distance_attains_sup:
8.4167 - assumes "compact s" "s \<noteq> {}"
8.4168 - shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
8.4169 -proof (rule continuous_attains_sup [OF assms])
8.4170 - { fix x assume "x\<in>s"
8.4171 - have "(dist a ---> dist a x) (at x within s)"
8.4172 - by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
8.4173 - }
8.4174 - thus "continuous_on s (dist a)"
8.4175 - unfolding continuous_on ..
8.4176 -qed
8.4177 -
8.4178 -text{* For *minimal* distance, we only need closure, not compactness. *}
8.4179 -
8.4180 -lemma distance_attains_inf:
8.4181 - fixes a :: "'a::heine_borel"
8.4182 - assumes "closed s" "s \<noteq> {}"
8.4183 - shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
8.4184 -proof-
8.4185 - from assms(2) obtain b where "b\<in>s" by auto
8.4186 - let ?B = "cball a (dist b a) \<inter> s"
8.4187 - have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
8.4188 - hence "?B \<noteq> {}" by auto
8.4189 - moreover
8.4190 - { fix x assume "x\<in>?B"
8.4191 - fix e::real assume "e>0"
8.4192 - { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
8.4193 - from as have "\<bar>dist a x' - dist a x\<bar> < e"
8.4194 - unfolding abs_less_iff minus_diff_eq
8.4195 - using dist_triangle2 [of a x' x]
8.4196 - using dist_triangle [of a x x']
8.4197 - by arith
8.4198 - }
8.4199 - hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
8.4200 - using `e>0` by auto
8.4201 - }
8.4202 - hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
8.4203 - unfolding continuous_on Lim_within dist_norm real_norm_def
8.4204 - by fast
8.4205 - moreover have "compact ?B"
8.4206 - using compact_cball[of a "dist b a"]
8.4207 - unfolding compact_eq_bounded_closed
8.4208 - using bounded_Int and closed_Int and assms(1) by auto
8.4209 - ultimately obtain x where "x\<in>cball a (dist b a) \<inter> s" "\<forall>y\<in>cball a (dist b a) \<inter> s. dist a x \<le> dist a y"
8.4210 - using continuous_attains_inf[of ?B "dist a"] by fastsimp
8.4211 - thus ?thesis by fastsimp
8.4212 -qed
8.4213 -
8.4214 -subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
8.4215 -
8.4216 -lemma Lim_mul:
8.4217 - fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
8.4218 - assumes "(c ---> d) net" "(f ---> l) net"
8.4219 - shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
8.4220 - using assms by (rule scaleR.tendsto)
8.4221 -
8.4222 -lemma Lim_vmul:
8.4223 - fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
8.4224 - shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
8.4225 - by (intro tendsto_intros)
8.4226 -
8.4227 -lemma continuous_vmul:
8.4228 - fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
8.4229 - shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
8.4230 - unfolding continuous_def using Lim_vmul[of c] by auto
8.4231 -
8.4232 -lemma continuous_mul:
8.4233 - fixes c :: "'a::metric_space \<Rightarrow> real"
8.4234 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.4235 - shows "continuous net c \<Longrightarrow> continuous net f
8.4236 - ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
8.4237 - unfolding continuous_def by (intro tendsto_intros)
8.4238 -
8.4239 -lemma continuous_on_vmul:
8.4240 - fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
8.4241 - shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
8.4242 - unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
8.4243 -
8.4244 -lemma continuous_on_mul:
8.4245 - fixes c :: "'a::metric_space \<Rightarrow> real"
8.4246 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
8.4247 - shows "continuous_on s c \<Longrightarrow> continuous_on s f
8.4248 - ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
8.4249 - unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
8.4250 -
8.4251 -text{* And so we have continuity of inverse. *}
8.4252 -
8.4253 -lemma Lim_inv:
8.4254 - fixes f :: "'a \<Rightarrow> real"
8.4255 - assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
8.4256 - shows "((inverse o f) ---> inverse l) net"
8.4257 - unfolding o_def using assms by (rule tendsto_inverse)
8.4258 -
8.4259 -lemma continuous_inv:
8.4260 - fixes f :: "'a::metric_space \<Rightarrow> real"
8.4261 - shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
8.4262 - ==> continuous net (inverse o f)"
8.4263 - unfolding continuous_def using Lim_inv by auto
8.4264 -
8.4265 -lemma continuous_at_within_inv:
8.4266 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
8.4267 - assumes "continuous (at a within s) f" "f a \<noteq> 0"
8.4268 - shows "continuous (at a within s) (inverse o f)"
8.4269 - using assms unfolding continuous_within o_def
8.4270 - by (intro tendsto_intros)
8.4271 -
8.4272 -lemma continuous_at_inv:
8.4273 - fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
8.4274 - shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
8.4275 - ==> continuous (at a) (inverse o f) "
8.4276 - using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
8.4277 -
8.4278 -subsection{* Preservation properties for pasted sets. *}
8.4279 -
8.4280 -lemma bounded_pastecart:
8.4281 - fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
8.4282 - assumes "bounded s" "bounded t"
8.4283 - shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
8.4284 -proof-
8.4285 - obtain a b where ab:"\<forall>x\<in>s. norm x \<le> a" "\<forall>x\<in>t. norm x \<le> b" using assms[unfolded bounded_iff] by auto
8.4286 - { fix x y assume "x\<in>s" "y\<in>t"
8.4287 - hence "norm x \<le> a" "norm y \<le> b" using ab by auto
8.4288 - hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
8.4289 - thus ?thesis unfolding bounded_iff by auto
8.4290 -qed
8.4291 -
8.4292 -lemma bounded_Times:
8.4293 - assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
8.4294 -proof-
8.4295 - obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
8.4296 - using assms [unfolded bounded_def] by auto
8.4297 - then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
8.4298 - by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
8.4299 - thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
8.4300 -qed
8.4301 -
8.4302 -lemma closed_pastecart:
8.4303 - fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
8.4304 - assumes "closed s" "closed t"
8.4305 - shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
8.4306 -proof-
8.4307 - { fix x l assume as:"\<forall>n::nat. x n \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" "(x ---> l) sequentially"
8.4308 - { fix n::nat have "fstcart (x n) \<in> s" "sndcart (x n) \<in> t" using as(1)[THEN spec[where x=n]] by auto } note * = this
8.4309 - moreover
8.4310 - { fix e::real assume "e>0"
8.4311 - then obtain N::nat where N:"\<forall>n\<ge>N. dist (x n) l < e" using as(2)[unfolded Lim_sequentially, THEN spec[where x=e]] by auto
8.4312 - { fix n::nat assume "n\<ge>N"
8.4313 - hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
8.4314 - using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
8.4315 - hence "\<exists>N. \<forall>n\<ge>N. dist (fstcart (x n)) (fstcart l) < e" "\<exists>N. \<forall>n\<ge>N. dist (sndcart (x n)) (sndcart l) < e" by auto }
8.4316 - ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
8.4317 - using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
8.4318 - using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
8.4319 - unfolding Lim_sequentially by auto
8.4320 - hence "l \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" using pastecart_fst_snd[THEN sym, of l] by auto }
8.4321 - thus ?thesis unfolding closed_sequential_limits by auto
8.4322 -qed
8.4323 -
8.4324 -lemma compact_pastecart:
8.4325 - fixes s t :: "(real ^ _) set"
8.4326 - shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
8.4327 - unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
8.4328 -
8.4329 -lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
8.4330 -by (induct x) simp
8.4331 -
8.4332 -lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
8.4333 -unfolding compact_def
8.4334 -apply clarify
8.4335 -apply (drule_tac x="fst \<circ> f" in spec)
8.4336 -apply (drule mp, simp add: mem_Times_iff)
8.4337 -apply (clarify, rename_tac l1 r1)
8.4338 -apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
8.4339 -apply (drule mp, simp add: mem_Times_iff)
8.4340 -apply (clarify, rename_tac l2 r2)
8.4341 -apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
8.4342 -apply (rule_tac x="r1 \<circ> r2" in exI)
8.4343 -apply (rule conjI, simp add: subseq_def)
8.4344 -apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
8.4345 -apply (drule (1) tendsto_Pair) back
8.4346 -apply (simp add: o_def)
8.4347 -done
8.4348 -
8.4349 -text{* Hence some useful properties follow quite easily. *}
8.4350 -
8.4351 -lemma compact_scaling:
8.4352 - fixes s :: "'a::real_normed_vector set"
8.4353 - assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
8.4354 -proof-
8.4355 - let ?f = "\<lambda>x. scaleR c x"
8.4356 - have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
8.4357 - show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
8.4358 - using linear_continuous_at[OF *] assms by auto
8.4359 -qed
8.4360 -
8.4361 -lemma compact_negations:
8.4362 - fixes s :: "'a::real_normed_vector set"
8.4363 - assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
8.4364 - using compact_scaling [OF assms, of "- 1"] by auto
8.4365 -
8.4366 -lemma compact_sums:
8.4367 - fixes s t :: "'a::real_normed_vector set"
8.4368 - assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
8.4369 -proof-
8.4370 - have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
8.4371 - apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
8.4372 - have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
8.4373 - unfolding continuous_on by (rule ballI) (intro tendsto_intros)
8.4374 - thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
8.4375 -qed
8.4376 -
8.4377 -lemma compact_differences:
8.4378 - fixes s t :: "'a::real_normed_vector set"
8.4379 - assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
8.4380 -proof-
8.4381 - have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
8.4382 - apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
8.4383 - thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
8.4384 -qed
8.4385 -
8.4386 -lemma compact_translation:
8.4387 - fixes s :: "'a::real_normed_vector set"
8.4388 - assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
8.4389 -proof-
8.4390 - have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
8.4391 - thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
8.4392 -qed
8.4393 -
8.4394 -lemma compact_affinity:
8.4395 - fixes s :: "'a::real_normed_vector set"
8.4396 - assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
8.4397 -proof-
8.4398 - have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
8.4399 - thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
8.4400 -qed
8.4401 -
8.4402 -text{* Hence we get the following. *}
8.4403 -
8.4404 -lemma compact_sup_maxdistance:
8.4405 - fixes s :: "'a::real_normed_vector set"
8.4406 - assumes "compact s" "s \<noteq> {}"
8.4407 - shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
8.4408 -proof-
8.4409 - have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
8.4410 - then obtain x where x:"x\<in>{x - y |x y. x \<in> s \<and> y \<in> s}" "\<forall>y\<in>{x - y |x y. x \<in> s \<and> y \<in> s}. norm y \<le> norm x"
8.4411 - using compact_differences[OF assms(1) assms(1)]
8.4412 - using distance_attains_sup[where 'a="'a", unfolded dist_norm, of "{x - y | x y . x\<in>s \<and> y\<in>s}" 0] by(auto simp add: norm_minus_cancel)
8.4413 - from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
8.4414 - thus ?thesis using x(2)[unfolded `x = a - b`] by blast
8.4415 -qed
8.4416 -
8.4417 -text{* We can state this in terms of diameter of a set. *}
8.4418 -
8.4419 -definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
8.4420 - (* TODO: generalize to class metric_space *)
8.4421 -
8.4422 -lemma diameter_bounded:
8.4423 - assumes "bounded s"
8.4424 - shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
8.4425 - "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
8.4426 -proof-
8.4427 - let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
8.4428 - obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
8.4429 - { fix x y assume "x \<in> s" "y \<in> s"
8.4430 - hence "norm (x - y) \<le> 2 * a" using norm_triangle_ineq[of x "-y", unfolded norm_minus_cancel] a[THEN bspec[where x=x]] a[THEN bspec[where x=y]] by (auto simp add: ring_simps) }
8.4431 - note * = this
8.4432 - { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
8.4433 - have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
8.4434 - have "norm(x - y) \<le> diameter s" unfolding diameter_def using `s\<noteq>{}` *[OF `x\<in>s` `y\<in>s`] `x\<in>s` `y\<in>s` isLubD1[OF lub] unfolding setle_def by auto }
8.4435 - moreover
8.4436 - { fix d::real assume "d>0" "d < diameter s"
8.4437 - hence "s\<noteq>{}" unfolding diameter_def by auto
8.4438 - hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
8.4439 - have "\<exists>d' \<in> ?D. d' > d"
8.4440 - proof(rule ccontr)
8.4441 - assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
8.4442 - hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
8.4443 - hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
8.4444 - thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
8.4445 - qed
8.4446 - hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
8.4447 - ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
8.4448 - "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
8.4449 -qed
8.4450 -
8.4451 -lemma diameter_bounded_bound:
8.4452 - "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
8.4453 - using diameter_bounded by blast
8.4454 -
8.4455 -lemma diameter_compact_attained:
8.4456 - fixes s :: "'a::real_normed_vector set"
8.4457 - assumes "compact s" "s \<noteq> {}"
8.4458 - shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
8.4459 -proof-
8.4460 - have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
8.4461 - then obtain x y where xys:"x\<in>s" "y\<in>s" and xy:"\<forall>u\<in>s. \<forall>v\<in>s. norm (u - v) \<le> norm (x - y)" using compact_sup_maxdistance[OF assms] by auto
8.4462 - hence "diameter s \<le> norm (x - y)" using rsup_le[of "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}" "norm (x - y)"]
8.4463 - unfolding setle_def and diameter_def by auto
8.4464 - thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
8.4465 -qed
8.4466 -
8.4467 -text{* Related results with closure as the conclusion. *}
8.4468 -
8.4469 -lemma closed_scaling:
8.4470 - fixes s :: "'a::real_normed_vector set"
8.4471 - assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
8.4472 -proof(cases "s={}")
8.4473 - case True thus ?thesis by auto
8.4474 -next
8.4475 - case False
8.4476 - show ?thesis
8.4477 - proof(cases "c=0")
8.4478 - have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
8.4479 - case True thus ?thesis apply auto unfolding * using closed_sing by auto
8.4480 - next
8.4481 - case False
8.4482 - { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
8.4483 - { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
8.4484 - using as(1)[THEN spec[where x=n]]
8.4485 - using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
8.4486 - }
8.4487 - moreover
8.4488 - { fix e::real assume "e>0"
8.4489 - hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
8.4490 - then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
8.4491 - using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
8.4492 - hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
8.4493 - unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
8.4494 - using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
8.4495 - hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
8.4496 - ultimately have "l \<in> scaleR c ` s"
8.4497 - using assms[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. scaleR (1/c) (x n)"], THEN spec[where x="scaleR (1/c) l"]]
8.4498 - unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
8.4499 - thus ?thesis unfolding closed_sequential_limits by fast
8.4500 - qed
8.4501 -qed
8.4502 -
8.4503 -lemma closed_negations:
8.4504 - fixes s :: "'a::real_normed_vector set"
8.4505 - assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
8.4506 - using closed_scaling[OF assms, of "- 1"] by simp
8.4507 -
8.4508 -lemma compact_closed_sums:
8.4509 - fixes s :: "'a::real_normed_vector set"
8.4510 - assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
8.4511 -proof-
8.4512 - let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
8.4513 - { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
8.4514 - from as(1) obtain f where f:"\<forall>n. x n = fst (f n) + snd (f n)" "\<forall>n. fst (f n) \<in> s" "\<forall>n. snd (f n) \<in> t"
8.4515 - using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
8.4516 - obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
8.4517 - using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
8.4518 - have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
8.4519 - using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
8.4520 - hence "l - l' \<in> t"
8.4521 - using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
8.4522 - using f(3) by auto
8.4523 - hence "l \<in> ?S" using `l' \<in> s` apply auto apply(rule_tac x=l' in exI) apply(rule_tac x="l - l'" in exI) by auto
8.4524 - }
8.4525 - thus ?thesis unfolding closed_sequential_limits by fast
8.4526 -qed
8.4527 -
8.4528 -lemma closed_compact_sums:
8.4529 - fixes s t :: "'a::real_normed_vector set"
8.4530 - assumes "closed s" "compact t"
8.4531 - shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
8.4532 -proof-
8.4533 - have "{x + y |x y. x \<in> t \<and> y \<in> s} = {x + y |x y. x \<in> s \<and> y \<in> t}" apply auto
8.4534 - apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
8.4535 - thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
8.4536 -qed
8.4537 -
8.4538 -lemma compact_closed_differences:
8.4539 - fixes s t :: "'a::real_normed_vector set"
8.4540 - assumes "compact s" "closed t"
8.4541 - shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
8.4542 -proof-
8.4543 - have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
8.4544 - apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
8.4545 - thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
8.4546 -qed
8.4547 -
8.4548 -lemma closed_compact_differences:
8.4549 - fixes s t :: "'a::real_normed_vector set"
8.4550 - assumes "closed s" "compact t"
8.4551 - shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
8.4552 -proof-
8.4553 - have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
8.4554 - apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
8.4555 - thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
8.4556 -qed
8.4557 -
8.4558 -lemma closed_translation:
8.4559 - fixes a :: "'a::real_normed_vector"
8.4560 - assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
8.4561 -proof-
8.4562 - have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
8.4563 - thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
8.4564 -qed
8.4565 -
8.4566 -lemma translation_UNIV:
8.4567 - fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
8.4568 - apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
8.4569 -
8.4570 -lemma translation_diff:
8.4571 - fixes a :: "'a::ab_group_add"
8.4572 - shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
8.4573 - by auto
8.4574 -
8.4575 -lemma closure_translation:
8.4576 - fixes a :: "'a::real_normed_vector"
8.4577 - shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
8.4578 -proof-
8.4579 - have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
8.4580 - apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
8.4581 - show ?thesis unfolding closure_interior translation_diff translation_UNIV
8.4582 - using interior_translation[of a "UNIV - s"] unfolding * by auto
8.4583 -qed
8.4584 -
8.4585 -lemma frontier_translation:
8.4586 - fixes a :: "'a::real_normed_vector"
8.4587 - shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
8.4588 - unfolding frontier_def translation_diff interior_translation closure_translation by auto
8.4589 -
8.4590 -subsection{* Separation between points and sets. *}
8.4591 -
8.4592 -lemma separate_point_closed:
8.4593 - fixes s :: "'a::heine_borel set"
8.4594 - shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
8.4595 -proof(cases "s = {}")
8.4596 - case True
8.4597 - thus ?thesis by(auto intro!: exI[where x=1])
8.4598 -next
8.4599 - case False
8.4600 - assume "closed s" "a \<notin> s"
8.4601 - then obtain x where "x\<in>s" "\<forall>y\<in>s. dist a x \<le> dist a y" using `s \<noteq> {}` distance_attains_inf [of s a] by blast
8.4602 - with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
8.4603 -qed
8.4604 -
8.4605 -lemma separate_compact_closed:
8.4606 - fixes s t :: "'a::{heine_borel, real_normed_vector} set"
8.4607 - (* TODO: does this generalize to heine_borel? *)
8.4608 - assumes "compact s" and "closed t" and "s \<inter> t = {}"
8.4609 - shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
8.4610 -proof-
8.4611 - have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
8.4612 - then obtain d where "d>0" and d:"\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. d \<le> dist 0 x"
8.4613 - using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
8.4614 - { fix x y assume "x\<in>s" "y\<in>t"
8.4615 - hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
8.4616 - hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
8.4617 - by (auto simp add: dist_commute)
8.4618 - hence "d \<le> dist x y" unfolding dist_norm by auto }
8.4619 - thus ?thesis using `d>0` by auto
8.4620 -qed
8.4621 -
8.4622 -lemma separate_closed_compact:
8.4623 - fixes s t :: "'a::{heine_borel, real_normed_vector} set"
8.4624 - assumes "closed s" and "compact t" and "s \<inter> t = {}"
8.4625 - shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
8.4626 -proof-
8.4627 - have *:"t \<inter> s = {}" using assms(3) by auto
8.4628 - show ?thesis using separate_compact_closed[OF assms(2,1) *]
8.4629 - apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
8.4630 - by (auto simp add: dist_commute)
8.4631 -qed
8.4632 -
8.4633 -(* A cute way of denoting open and closed intervals using overloading. *)
8.4634 -
8.4635 -lemma interval: fixes a :: "'a::ord^'n::finite" shows
8.4636 - "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
8.4637 - "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
8.4638 - by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
8.4639 -
8.4640 -lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
8.4641 - "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
8.4642 - "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
8.4643 - using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
8.4644 -
8.4645 -lemma mem_interval_1: fixes x :: "real^1" shows
8.4646 - "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
8.4647 - "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
8.4648 -by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
8.4649 -
8.4650 -lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
8.4651 - "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
8.4652 - "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
8.4653 -proof-
8.4654 - { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
8.4655 - hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
8.4656 - hence "a$i < b$i" by auto
8.4657 - hence False using as by auto }
8.4658 - moreover
8.4659 - { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
8.4660 - let ?x = "(1/2) *\<^sub>R (a + b)"
8.4661 - { fix i
8.4662 - have "a$i < b$i" using as[THEN spec[where x=i]] by auto
8.4663 - hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
8.4664 - unfolding vector_smult_component and vector_add_component
8.4665 - by (auto simp add: less_divide_eq_number_of1) }
8.4666 - hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
8.4667 - ultimately show ?th1 by blast
8.4668 -
8.4669 - { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
8.4670 - hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
8.4671 - hence "a$i \<le> b$i" by auto
8.4672 - hence False using as by auto }
8.4673 - moreover
8.4674 - { assume as:"\<forall>i. \<not> (b$i < a$i)"
8.4675 - let ?x = "(1/2) *\<^sub>R (a + b)"
8.4676 - { fix i
8.4677 - have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
8.4678 - hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
8.4679 - unfolding vector_smult_component and vector_add_component
8.4680 - by (auto simp add: less_divide_eq_number_of1) }
8.4681 - hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
8.4682 - ultimately show ?th2 by blast
8.4683 -qed
8.4684 -
8.4685 -lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
8.4686 - "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
8.4687 - "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
8.4688 - unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
8.4689 -
8.4690 -lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
8.4691 - "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
8.4692 - "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
8.4693 - "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
8.4694 - "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
8.4695 - unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
8.4696 - by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
8.4697 -
8.4698 -lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
8.4699 - "{a .. a} = {a} \<and> {a<..<a} = {}"
8.4700 -apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
8.4701 -apply (simp add: order_eq_iff)
8.4702 -apply (auto simp add: not_less less_imp_le)
8.4703 -done
8.4704 -
8.4705 -lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
8.4706 - "{a<..<b} \<subseteq> {a .. b}"
8.4707 -proof(simp add: subset_eq, rule)
8.4708 - fix x
8.4709 - assume x:"x \<in>{a<..<b}"
8.4710 - { fix i
8.4711 - have "a $ i \<le> x $ i"
8.4712 - using x order_less_imp_le[of "a$i" "x$i"]
8.4713 - by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
8.4714 - }
8.4715 - moreover
8.4716 - { fix i
8.4717 - have "x $ i \<le> b $ i"
8.4718 - using x order_less_imp_le[of "x$i" "b$i"]
8.4719 - by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
8.4720 - }
8.4721 - ultimately
8.4722 - show "a \<le> x \<and> x \<le> b"
8.4723 - by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
8.4724 -qed
8.4725 -
8.4726 -lemma subset_interval: fixes a :: "real^'n::finite" shows
8.4727 - "{c .. d} \<subseteq> {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
8.4728 - "{c .. d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i \<le> d$i) --> (\<forall>i. a$i < c$i \<and> d$i < b$i)" (is ?th2) and
8.4729 - "{c<..<d} \<subseteq> {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
8.4730 - "{c<..<d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i < d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th4)
8.4731 -proof-
8.4732 - show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
8.4733 - show ?th2 unfolding subset_eq and Ball_def and mem_interval by (auto intro: le_less_trans less_le_trans order_trans less_imp_le)
8.4734 - { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
8.4735 - hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
8.4736 - fix i
8.4737 - (** TODO combine the following two parts as done in the HOL_light version. **)
8.4738 - { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
8.4739 - assume as2: "a$i > c$i"
8.4740 - { fix j
8.4741 - have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
8.4742 - apply(cases "j=i") using as(2)[THEN spec[where x=j]]
8.4743 - by (auto simp add: less_divide_eq_number_of1 as2) }
8.4744 - hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
8.4745 - moreover
8.4746 - have "?x\<notin>{a .. b}"
8.4747 - unfolding mem_interval apply auto apply(rule_tac x=i in exI)
8.4748 - using as(2)[THEN spec[where x=i]] and as2
8.4749 - by (auto simp add: less_divide_eq_number_of1)
8.4750 - ultimately have False using as by auto }
8.4751 - hence "a$i \<le> c$i" by(rule ccontr)auto
8.4752 - moreover
8.4753 - { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
8.4754 - assume as2: "b$i < d$i"
8.4755 - { fix j
8.4756 - have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
8.4757 - apply(cases "j=i") using as(2)[THEN spec[where x=j]]
8.4758 - by (auto simp add: less_divide_eq_number_of1 as2) }
8.4759 - hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
8.4760 - moreover
8.4761 - have "?x\<notin>{a .. b}"
8.4762 - unfolding mem_interval apply auto apply(rule_tac x=i in exI)
8.4763 - using as(2)[THEN spec[where x=i]] and as2
8.4764 - by (auto simp add: less_divide_eq_number_of1)
8.4765 - ultimately have False using as by auto }
8.4766 - hence "b$i \<ge> d$i" by(rule ccontr)auto
8.4767 - ultimately
8.4768 - have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
8.4769 - } note part1 = this
8.4770 - thus ?th3 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
8.4771 - { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
8.4772 - fix i
8.4773 - from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
8.4774 - hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
8.4775 - thus ?th4 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
8.4776 -qed
8.4777 -
8.4778 -lemma disjoint_interval: fixes a::"real^'n::finite" shows
8.4779 - "{a .. b} \<inter> {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
8.4780 - "{a .. b} \<inter> {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
8.4781 - "{a<..<b} \<inter> {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
8.4782 - "{a<..<b} \<inter> {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)
8.4783 -proof-
8.4784 - let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
8.4785 - show ?th1 ?th2 ?th3 ?th4
8.4786 - unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
8.4787 - apply (auto elim!: allE[where x="?z"])
8.4788 - apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
8.4789 - done
8.4790 -qed
8.4791 -
8.4792 -lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
8.4793 - "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
8.4794 - unfolding expand_set_eq and Int_iff and mem_interval
8.4795 - by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
8.4796 -
8.4797 -(* Moved interval_open_subset_closed a bit upwards *)
8.4798 -
8.4799 -lemma open_interval_lemma: fixes x :: "real" shows
8.4800 - "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
8.4801 - by(rule_tac x="min (x - a) (b - x)" in exI, auto)
8.4802 -
8.4803 -lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
8.4804 -proof-
8.4805 - { fix x assume x:"x\<in>{a<..<b}"
8.4806 - { fix i
8.4807 - have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
8.4808 - using x[unfolded mem_interval, THEN spec[where x=i]]
8.4809 - using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
8.4810 -
8.4811 - hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
8.4812 - then obtain d where d:"\<forall>i. 0 < d i \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d i \<longrightarrow> a $ i < x' \<and> x' < b $ i)"
8.4813 - using bchoice[of "UNIV" "\<lambda>i d. d>0 \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d \<longrightarrow> a $ i < x' \<and> x' < b $ i)"] by auto
8.4814 -
8.4815 - let ?d = "Min (range d)"
8.4816 - have **:"finite (range d)" "range d \<noteq> {}" by auto
8.4817 - have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
8.4818 - moreover
8.4819 - { fix x' assume as:"dist x' x < ?d"
8.4820 - { fix i
8.4821 - have "\<bar>x'$i - x $ i\<bar> < d i"
8.4822 - using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
8.4823 - unfolding vector_minus_component and Min_gr_iff[OF **] by auto
8.4824 - hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
8.4825 - hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
8.4826 - ultimately have "\<exists>e>0. \<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a<..<b}" by (auto, rule_tac x="?d" in exI, simp)
8.4827 - }
8.4828 - thus ?thesis unfolding open_dist using open_interval_lemma by auto
8.4829 -qed
8.4830 -
8.4831 -lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
8.4832 -proof-
8.4833 - { fix x i assume as:"\<forall>e>0. \<exists>x'\<in>{a..b}. x' \<noteq> x \<and> dist x' x < e"(* and xab:"a$i > x$i \<or> b$i < x$i"*)
8.4834 - { assume xa:"a$i > x$i"
8.4835 - with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < a$i - x$i" by(erule_tac x="a$i - x$i" in allE)auto
8.4836 - hence False unfolding mem_interval and dist_norm
8.4837 - using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
8.4838 - } hence "a$i \<le> x$i" by(rule ccontr)auto
8.4839 - moreover
8.4840 - { assume xb:"b$i < x$i"
8.4841 - with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < x$i - b$i" by(erule_tac x="x$i - b$i" in allE)auto
8.4842 - hence False unfolding mem_interval and dist_norm
8.4843 - using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
8.4844 - } hence "x$i \<le> b$i" by(rule ccontr)auto
8.4845 - ultimately
8.4846 - have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
8.4847 - thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
8.4848 -qed
8.4849 -
8.4850 -lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
8.4851 - "interior {a .. b} = {a<..<b}" (is "?L = ?R")
8.4852 -proof(rule subset_antisym)
8.4853 - show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
8.4854 -next
8.4855 - { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
8.4856 - then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
8.4857 - then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a..b}" unfolding open_dist and subset_eq by auto
8.4858 - { fix i
8.4859 - have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
8.4860 - "dist (x + (e / 2) *\<^sub>R basis i) x < e"
8.4861 - unfolding dist_norm apply auto
8.4862 - unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
8.4863 - hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
8.4864 - "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
8.4865 - using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
8.4866 - and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
8.4867 - unfolding mem_interval by (auto elim!: allE[where x=i])
8.4868 - hence "a $ i < x $ i" and "x $ i < b $ i"
8.4869 - unfolding vector_minus_component and vector_add_component
8.4870 - unfolding vector_smult_component and basis_component using `e>0` by auto }
8.4871 - hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
8.4872 - thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
8.4873 -qed
8.4874 -
8.4875 -lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
8.4876 - "bounded {a .. b}"
8.4877 -proof-
8.4878 - let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
8.4879 - { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
8.4880 - { fix i
8.4881 - have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
8.4882 - hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
8.4883 - hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
8.4884 - thus ?thesis unfolding interval and bounded_iff by auto
8.4885 -qed
8.4886 -
8.4887 -lemma bounded_interval: fixes a :: "real^'n::finite" shows
8.4888 - "bounded {a .. b} \<and> bounded {a<..<b}"
8.4889 - using bounded_closed_interval[of a b]
8.4890 - using interval_open_subset_closed[of a b]
8.4891 - using bounded_subset[of "{a..b}" "{a<..<b}"]
8.4892 - by simp
8.4893 -
8.4894 -lemma not_interval_univ: fixes a :: "real^'n::finite" shows
8.4895 - "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
8.4896 - using bounded_interval[of a b]
8.4897 - by auto
8.4898 -
8.4899 -lemma compact_interval: fixes a :: "real^'n::finite" shows
8.4900 - "compact {a .. b}"
8.4901 - using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
8.4902 -
8.4903 -lemma open_interval_midpoint: fixes a :: "real^'n::finite"
8.4904 - assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
8.4905 -proof-
8.4906 - { fix i
8.4907 - have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
8.4908 - using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
8.4909 - unfolding vector_smult_component and vector_add_component
8.4910 - by(auto simp add: less_divide_eq_number_of1) }
8.4911 - thus ?thesis unfolding mem_interval by auto
8.4912 -qed
8.4913 -
8.4914 -lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
8.4915 - assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
8.4916 - shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
8.4917 -proof-
8.4918 - { fix i
8.4919 - have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
8.4920 - also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
8.4921 - using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
8.4922 - using x unfolding mem_interval apply simp
8.4923 - using y unfolding mem_interval apply simp
8.4924 - done
8.4925 - finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
8.4926 - moreover {
8.4927 - have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
8.4928 - also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
8.4929 - using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
8.4930 - using x unfolding mem_interval apply simp
8.4931 - using y unfolding mem_interval apply simp
8.4932 - done
8.4933 - finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
8.4934 - } ultimately have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i \<and> (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto }
8.4935 - thus ?thesis unfolding mem_interval by auto
8.4936 -qed
8.4937 -
8.4938 -lemma closure_open_interval: fixes a :: "real^'n::finite"
8.4939 - assumes "{a<..<b} \<noteq> {}"
8.4940 - shows "closure {a<..<b} = {a .. b}"
8.4941 -proof-
8.4942 - have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
8.4943 - let ?c = "(1 / 2) *\<^sub>R (a + b)"
8.4944 - { fix x assume as:"x \<in> {a .. b}"
8.4945 - def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
8.4946 - { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
8.4947 - have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
8.4948 - have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
8.4949 - x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
8.4950 - by (auto simp add: algebra_simps)
8.4951 - hence "f n < b" and "a < f n" using open_closed_interval_convex[OF open_interval_midpoint[OF assms] as *] unfolding f_def by auto
8.4952 - hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
8.4953 - moreover
8.4954 - { assume "\<not> (f ---> x) sequentially"
8.4955 - { fix e::real assume "e>0"
8.4956 - hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
8.4957 - then obtain N::nat where "inverse (real (N + 1)) < e" by auto
8.4958 - hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
8.4959 - hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
8.4960 - hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
8.4961 - unfolding Lim_sequentially by(auto simp add: dist_norm)
8.4962 - hence "(f ---> x) sequentially" unfolding f_def
8.4963 - using Lim_add[OF Lim_const, of "\<lambda>n::nat. (inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x)" 0 sequentially x]
8.4964 - using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
8.4965 - ultimately have "x \<in> closure {a<..<b}"
8.4966 - using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
8.4967 - thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
8.4968 -qed
8.4969 -
8.4970 -lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
8.4971 - assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
8.4972 -proof-
8.4973 - obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
8.4974 - def a \<equiv> "(\<chi> i. b+1)::real^'n"
8.4975 - { fix x assume "x\<in>s"
8.4976 - fix i
8.4977 - have "(-a)$i < x$i" and "x$i < a$i" using b[THEN bspec[where x=x], OF `x\<in>s`] and component_le_norm[of x i]
8.4978 - unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
8.4979 - }
8.4980 - thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
8.4981 -qed
8.4982 -
8.4983 -lemma bounded_subset_open_interval:
8.4984 - fixes s :: "(real ^ 'n::finite) set"
8.4985 - shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
8.4986 - by (auto dest!: bounded_subset_open_interval_symmetric)
8.4987 -
8.4988 -lemma bounded_subset_closed_interval_symmetric:
8.4989 - fixes s :: "(real ^ 'n::finite) set"
8.4990 - assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
8.4991 -proof-
8.4992 - obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
8.4993 - thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
8.4994 -qed
8.4995 -
8.4996 -lemma bounded_subset_closed_interval:
8.4997 - fixes s :: "(real ^ 'n::finite) set"
8.4998 - shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
8.4999 - using bounded_subset_closed_interval_symmetric[of s] by auto
8.5000 -
8.5001 -lemma frontier_closed_interval:
8.5002 - fixes a b :: "real ^ _"
8.5003 - shows "frontier {a .. b} = {a .. b} - {a<..<b}"
8.5004 - unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
8.5005 -
8.5006 -lemma frontier_open_interval:
8.5007 - fixes a b :: "real ^ _"
8.5008 - shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
8.5009 -proof(cases "{a<..<b} = {}")
8.5010 - case True thus ?thesis using frontier_empty by auto
8.5011 -next
8.5012 - case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
8.5013 -qed
8.5014 -
8.5015 -lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
8.5016 - assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
8.5017 - unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
8.5018 -
8.5019 -
8.5020 -(* Some special cases for intervals in R^1. *)
8.5021 -
8.5022 -lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
8.5023 - by (metis num1_eq_iff)
8.5024 -
8.5025 -lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
8.5026 - by auto (metis num1_eq_iff)
8.5027 -
8.5028 -lemma interval_cases_1: fixes x :: "real^1" shows
8.5029 - "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
8.5030 - by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
8.5031 -
8.5032 -lemma in_interval_1: fixes x :: "real^1" shows
8.5033 - "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
8.5034 - (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
8.5035 -by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
8.5036 -
8.5037 -lemma interval_eq_empty_1: fixes a :: "real^1" shows
8.5038 - "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
8.5039 - "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
8.5040 - unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
8.5041 -
8.5042 -lemma subset_interval_1: fixes a :: "real^1" shows
8.5043 - "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
8.5044 - dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
8.5045 - "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
8.5046 - dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
8.5047 - "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
8.5048 - dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
8.5049 - "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
8.5050 - dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
8.5051 - unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
8.5052 -
8.5053 -lemma eq_interval_1: fixes a :: "real^1" shows
8.5054 - "{a .. b} = {c .. d} \<longleftrightarrow>
8.5055 - dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
8.5056 - dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
8.5057 -using set_eq_subset[of "{a .. b}" "{c .. d}"]
8.5058 -using subset_interval_1(1)[of a b c d]
8.5059 -using subset_interval_1(1)[of c d a b]
8.5060 -by auto (* FIXME: slow *)
8.5061 -
8.5062 -lemma disjoint_interval_1: fixes a :: "real^1" shows
8.5063 - "{a .. b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b < dest_vec1 c \<or> dest_vec1 d < dest_vec1 a"
8.5064 - "{a .. b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
8.5065 - "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
8.5066 - "{a<..<b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
8.5067 - unfolding disjoint_interval and dest_vec1_def ex_1 by auto
8.5068 -
8.5069 -lemma open_closed_interval_1: fixes a :: "real^1" shows
8.5070 - "{a<..<b} = {a .. b} - {a, b}"
8.5071 - unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
8.5072 -
8.5073 -lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
8.5074 - unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
8.5075 -
8.5076 -(* Some stuff for half-infinite intervals too; FIXME: notation? *)
8.5077 -
8.5078 -lemma closed_interval_left: fixes b::"real^'n::finite"
8.5079 - shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
8.5080 -proof-
8.5081 - { fix i
8.5082 - fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. x $ i \<le> b $ i}. x' \<noteq> x \<and> dist x' x < e"
8.5083 - { assume "x$i > b$i"
8.5084 - then obtain y where "y $ i \<le> b $ i" "y \<noteq> x" "dist y x < x$i - b$i" using x[THEN spec[where x="x$i - b$i"]] by auto
8.5085 - hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
8.5086 - hence "x$i \<le> b$i" by(rule ccontr)auto }
8.5087 - thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
8.5088 -qed
8.5089 -
8.5090 -lemma closed_interval_right: fixes a::"real^'n::finite"
8.5091 - shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
8.5092 -proof-
8.5093 - { fix i
8.5094 - fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. a $ i \<le> x $ i}. x' \<noteq> x \<and> dist x' x < e"
8.5095 - { assume "a$i > x$i"
8.5096 - then obtain y where "a $ i \<le> y $ i" "y \<noteq> x" "dist y x < a$i - x$i" using x[THEN spec[where x="a$i - x$i"]] by auto
8.5097 - hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
8.5098 - hence "a$i \<le> x$i" by(rule ccontr)auto }
8.5099 - thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
8.5100 -qed
8.5101 -
8.5102 -subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
8.5103 -
8.5104 -definition "is_interval s \<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)"
8.5105 -
8.5106 -lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
8.5107 - have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
8.5108 - show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
8.5109 - by(meson real_le_trans le_less_trans less_le_trans *)+ qed
8.5110 -
8.5111 -lemma is_interval_empty:
8.5112 - "is_interval {}"
8.5113 - unfolding is_interval_def
8.5114 - by simp
8.5115 -
8.5116 -lemma is_interval_univ:
8.5117 - "is_interval UNIV"
8.5118 - unfolding is_interval_def
8.5119 - by simp
8.5120 -
8.5121 -subsection{* Closure of halfspaces and hyperplanes. *}
8.5122 -
8.5123 -lemma Lim_inner:
8.5124 - assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
8.5125 - by (intro tendsto_intros assms)
8.5126 -
8.5127 -lemma continuous_at_inner: "continuous (at x) (inner a)"
8.5128 - unfolding continuous_at by (intro tendsto_intros)
8.5129 -
8.5130 -lemma continuous_on_inner:
8.5131 - fixes s :: "'a::real_inner set"
8.5132 - shows "continuous_on s (inner a)"
8.5133 - unfolding continuous_on by (rule ballI) (intro tendsto_intros)
8.5134 -
8.5135 -lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
8.5136 -proof-
8.5137 - have "\<forall>x. continuous (at x) (inner a)"
8.5138 - unfolding continuous_at by (rule allI) (intro tendsto_intros)
8.5139 - hence "closed (inner a -` {..b})"
8.5140 - using closed_real_atMost by (rule continuous_closed_vimage)
8.5141 - moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
8.5142 - ultimately show ?thesis by simp
8.5143 -qed
8.5144 -
8.5145 -lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
8.5146 - using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
8.5147 -
8.5148 -lemma closed_hyperplane: "closed {x. inner a x = b}"
8.5149 -proof-
8.5150 - have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
8.5151 - thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
8.5152 -qed
8.5153 -
8.5154 -lemma closed_halfspace_component_le:
8.5155 - shows "closed {x::real^'n::finite. x$i \<le> a}"
8.5156 - using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
8.5157 -
8.5158 -lemma closed_halfspace_component_ge:
8.5159 - shows "closed {x::real^'n::finite. x$i \<ge> a}"
8.5160 - using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
8.5161 -
8.5162 -text{* Openness of halfspaces. *}
8.5163 -
8.5164 -lemma open_halfspace_lt: "open {x. inner a x < b}"
8.5165 -proof-
8.5166 - have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
8.5167 - thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
8.5168 -qed
8.5169 -
8.5170 -lemma open_halfspace_gt: "open {x. inner a x > b}"
8.5171 -proof-
8.5172 - have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
8.5173 - thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
8.5174 -qed
8.5175 -
8.5176 -lemma open_halfspace_component_lt:
8.5177 - shows "open {x::real^'n::finite. x$i < a}"
8.5178 - using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
8.5179 -
8.5180 -lemma open_halfspace_component_gt:
8.5181 - shows "open {x::real^'n::finite. x$i > a}"
8.5182 - using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
8.5183 -
8.5184 -text{* This gives a simple derivation of limit component bounds. *}
8.5185 -
8.5186 -lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
8.5187 - assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
8.5188 - shows "l$i \<le> b"
8.5189 -proof-
8.5190 - { fix x have "x \<in> {x::real^'n. inner (basis i) x \<le> b} \<longleftrightarrow> x$i \<le> b" unfolding inner_basis by auto } note * = this
8.5191 - show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
8.5192 - using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
8.5193 -qed
8.5194 -
8.5195 -lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
8.5196 - assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
8.5197 - shows "b \<le> l$i"
8.5198 -proof-
8.5199 - { fix x have "x \<in> {x::real^'n. inner (basis i) x \<ge> b} \<longleftrightarrow> x$i \<ge> b" unfolding inner_basis by auto } note * = this
8.5200 - show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
8.5201 - using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
8.5202 -qed
8.5203 -
8.5204 -lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
8.5205 - assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
8.5206 - shows "l$i = b"
8.5207 - using ev[unfolded order_eq_iff eventually_and] using Lim_component_ge[OF net, of b i] and Lim_component_le[OF net, of i b] by auto
8.5208 -
8.5209 -lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
8.5210 - "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
8.5211 - using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
8.5212 -
8.5213 -lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
8.5214 - "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
8.5215 - using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
8.5216 -
8.5217 -text{* Limits relative to a union. *}
8.5218 -
8.5219 -lemma eventually_within_Un:
8.5220 - "eventually P (net within (s \<union> t)) \<longleftrightarrow>
8.5221 - eventually P (net within s) \<and> eventually P (net within t)"
8.5222 - unfolding Limits.eventually_within
8.5223 - by (auto elim!: eventually_rev_mp)
8.5224 -
8.5225 -lemma Lim_within_union:
8.5226 - "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
8.5227 - (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
8.5228 - unfolding tendsto_def
8.5229 - by (auto simp add: eventually_within_Un)
8.5230 -
8.5231 -lemma continuous_on_union:
8.5232 - assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
8.5233 - shows "continuous_on (s \<union> t) f"
8.5234 - using assms unfolding continuous_on unfolding Lim_within_union
8.5235 - unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
8.5236 -
8.5237 -lemma continuous_on_cases:
8.5238 - assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
8.5239 - "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
8.5240 - shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
8.5241 -proof-
8.5242 - let ?h = "(\<lambda>x. if P x then f x else g x)"
8.5243 - have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
8.5244 - hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
8.5245 - moreover
8.5246 - have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
8.5247 - hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
8.5248 - ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
8.5249 -qed
8.5250 -
8.5251 -
8.5252 -text{* Some more convenient intermediate-value theorem formulations. *}
8.5253 -
8.5254 -lemma connected_ivt_hyperplane:
8.5255 - assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
8.5256 - shows "\<exists>z \<in> s. inner a z = b"
8.5257 -proof(rule ccontr)
8.5258 - assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
8.5259 - let ?A = "{x. inner a x < b}"
8.5260 - let ?B = "{x. inner a x > b}"
8.5261 - have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
8.5262 - moreover have "?A \<inter> ?B = {}" by auto
8.5263 - moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
8.5264 - ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
8.5265 -qed
8.5266 -
8.5267 -lemma connected_ivt_component: fixes x::"real^'n::finite" shows
8.5268 - "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)"
8.5269 - using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
8.5270 -
8.5271 -text{* Also more convenient formulations of monotone convergence. *}
8.5272 -
8.5273 -lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
8.5274 - assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
8.5275 - shows "\<exists>l. (s ---> l) sequentially"
8.5276 -proof-
8.5277 - obtain a where a:"\<forall>n. \<bar>dest_vec1 (s n)\<bar> \<le> a" using assms(1)[unfolded bounded_iff abs_dest_vec1] by auto
8.5278 - { fix m::nat
8.5279 - have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
8.5280 - apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
8.5281 - hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
8.5282 - then obtain l where "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<bar>dest_vec1 (s n) - l\<bar> < e" using convergent_bounded_monotone[OF a] unfolding monoseq_def by auto
8.5283 - thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
8.5284 - unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
8.5285 -qed
8.5286 -
8.5287 -subsection{* Basic homeomorphism definitions. *}
8.5288 -
8.5289 -definition "homeomorphism s t f g \<equiv>
8.5290 - (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
8.5291 - (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
8.5292 -
8.5293 -definition
8.5294 - homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
8.5295 - (infixr "homeomorphic" 60) where
8.5296 - homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
8.5297 -
8.5298 -lemma homeomorphic_refl: "s homeomorphic s"
8.5299 - unfolding homeomorphic_def
8.5300 - unfolding homeomorphism_def
8.5301 - using continuous_on_id
8.5302 - apply(rule_tac x = "(\<lambda>x. x)" in exI)
8.5303 - apply(rule_tac x = "(\<lambda>x. x)" in exI)
8.5304 - by blast
8.5305 -
8.5306 -lemma homeomorphic_sym:
8.5307 - "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
8.5308 -unfolding homeomorphic_def
8.5309 -unfolding homeomorphism_def
8.5310 -by blast (* FIXME: slow *)
8.5311 -
8.5312 -lemma homeomorphic_trans:
8.5313 - assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
8.5314 -proof-
8.5315 - obtain f1 g1 where fg1:"\<forall>x\<in>s. g1 (f1 x) = x" "f1 ` s = t" "continuous_on s f1" "\<forall>y\<in>t. f1 (g1 y) = y" "g1 ` t = s" "continuous_on t g1"
8.5316 - using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
8.5317 - obtain f2 g2 where fg2:"\<forall>x\<in>t. g2 (f2 x) = x" "f2 ` t = u" "continuous_on t f2" "\<forall>y\<in>u. f2 (g2 y) = y" "g2 ` u = t" "continuous_on u g2"
8.5318 - using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
8.5319 -
8.5320 - { fix x assume "x\<in>s" hence "(g1 \<circ> g2) ((f2 \<circ> f1) x) = x" using fg1(1)[THEN bspec[where x=x]] and fg2(1)[THEN bspec[where x="f1 x"]] and fg1(2) by auto }
8.5321 - moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
8.5322 - moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
8.5323 - moreover { fix y assume "y\<in>u" hence "(f2 \<circ> f1) ((g1 \<circ> g2) y) = y" using fg2(4)[THEN bspec[where x=y]] and fg1(4)[THEN bspec[where x="g2 y"]] and fg2(5) by auto }
8.5324 - moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
8.5325 - moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
8.5326 - ultimately show ?thesis unfolding homeomorphic_def homeomorphism_def apply(rule_tac x="f2 \<circ> f1" in exI) apply(rule_tac x="g1 \<circ> g2" in exI) by auto
8.5327 -qed
8.5328 -
8.5329 -lemma homeomorphic_minimal:
8.5330 - "s homeomorphic t \<longleftrightarrow>
8.5331 - (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
8.5332 - (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
8.5333 - continuous_on s f \<and> continuous_on t g)"
8.5334 -unfolding homeomorphic_def homeomorphism_def
8.5335 -apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
8.5336 -apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
8.5337 -unfolding image_iff
8.5338 -apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
8.5339 -apply auto apply(rule_tac x="g x" in bexI) apply auto
8.5340 -apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
8.5341 -apply auto apply(rule_tac x="f x" in bexI) by auto
8.5342 -
8.5343 -subsection{* Relatively weak hypotheses if a set is compact. *}
8.5344 -
8.5345 -definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
8.5346 -
8.5347 -lemma assumes "inj_on f s" "x\<in>s"
8.5348 - shows "inv_on f s (f x) = x"
8.5349 - using assms unfolding inj_on_def inv_on_def by auto
8.5350 -
8.5351 -lemma homeomorphism_compact:
8.5352 - fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
8.5353 - (* class constraint due to continuous_on_inverse *)
8.5354 - assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
8.5355 - shows "\<exists>g. homeomorphism s t f g"
8.5356 -proof-
8.5357 - def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
8.5358 - have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
8.5359 - { fix y assume "y\<in>t"
8.5360 - then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
8.5361 - hence "g (f x) = x" using g by auto
8.5362 - hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
8.5363 - hence g':"\<forall>x\<in>t. f (g x) = x" by auto
8.5364 - moreover
8.5365 - { fix x
8.5366 - have "x\<in>s \<Longrightarrow> x \<in> g ` t" using g[THEN bspec[where x=x]] unfolding image_iff using assms(3) by(auto intro!: bexI[where x="f x"])
8.5367 - moreover
8.5368 - { assume "x\<in>g ` t"
8.5369 - then obtain y where y:"y\<in>t" "g y = x" by auto
8.5370 - then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
8.5371 - hence "x \<in> s" unfolding g_def using someI2[of "\<lambda>b. b\<in>s \<and> f b = y" x' "\<lambda>x. x\<in>s"] unfolding y(2)[THEN sym] and g_def by auto }
8.5372 - ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
8.5373 - hence "g ` t = s" by auto
8.5374 - ultimately
8.5375 - show ?thesis unfolding homeomorphism_def homeomorphic_def
8.5376 - apply(rule_tac x=g in exI) using g and assms(3) and continuous_on_inverse[OF assms(2,1), of g, unfolded assms(3)] and assms(2) by auto
8.5377 -qed
8.5378 -
8.5379 -lemma homeomorphic_compact:
8.5380 - fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
8.5381 - (* class constraint due to continuous_on_inverse *)
8.5382 - shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
8.5383 - \<Longrightarrow> s homeomorphic t"
8.5384 - unfolding homeomorphic_def by(metis homeomorphism_compact)
8.5385 -
8.5386 -text{* Preservation of topological properties. *}
8.5387 -
8.5388 -lemma homeomorphic_compactness:
8.5389 - "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
8.5390 -unfolding homeomorphic_def homeomorphism_def
8.5391 -by (metis compact_continuous_image)
8.5392 -
8.5393 -text{* Results on translation, scaling etc. *}
8.5394 -
8.5395 -lemma homeomorphic_scaling:
8.5396 - fixes s :: "'a::real_normed_vector set"
8.5397 - assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
8.5398 - unfolding homeomorphic_minimal
8.5399 - apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
8.5400 - apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
8.5401 - using assms apply auto
8.5402 - using continuous_on_cmul[OF continuous_on_id] by auto
8.5403 -
8.5404 -lemma homeomorphic_translation:
8.5405 - fixes s :: "'a::real_normed_vector set"
8.5406 - shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
8.5407 - unfolding homeomorphic_minimal
8.5408 - apply(rule_tac x="\<lambda>x. a + x" in exI)
8.5409 - apply(rule_tac x="\<lambda>x. -a + x" in exI)
8.5410 - using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
8.5411 -
8.5412 -lemma homeomorphic_affinity:
8.5413 - fixes s :: "'a::real_normed_vector set"
8.5414 - assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
8.5415 -proof-
8.5416 - have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
8.5417 - show ?thesis
8.5418 - using homeomorphic_trans
8.5419 - using homeomorphic_scaling[OF assms, of s]
8.5420 - using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
8.5421 -qed
8.5422 -
8.5423 -lemma homeomorphic_balls:
8.5424 - fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
8.5425 - assumes "0 < d" "0 < e"
8.5426 - shows "(ball a d) homeomorphic (ball b e)" (is ?th)
8.5427 - "(cball a d) homeomorphic (cball b e)" (is ?cth)
8.5428 -proof-
8.5429 - have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
8.5430 - show ?th unfolding homeomorphic_minimal
8.5431 - apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
8.5432 - apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
8.5433 - using assms apply (auto simp add: dist_commute)
8.5434 - unfolding dist_norm
8.5435 - apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
8.5436 - unfolding continuous_on
8.5437 - by (intro ballI tendsto_intros, simp, assumption)+
8.5438 -next
8.5439 - have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
8.5440 - show ?cth unfolding homeomorphic_minimal
8.5441 - apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
8.5442 - apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
8.5443 - using assms apply (auto simp add: dist_commute)
8.5444 - unfolding dist_norm
8.5445 - apply (auto simp add: pos_divide_le_eq)
8.5446 - unfolding continuous_on
8.5447 - by (intro ballI tendsto_intros, simp, assumption)+
8.5448 -qed
8.5449 -
8.5450 -text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
8.5451 -
8.5452 -lemma cauchy_isometric:
8.5453 - fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
8.5454 - assumes e:"0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and xs:"\<forall>n::nat. x n \<in> s" and cf:"Cauchy(f o x)"
8.5455 - shows "Cauchy x"
8.5456 -proof-
8.5457 - interpret f: bounded_linear f by fact
8.5458 - { fix d::real assume "d>0"
8.5459 - then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
8.5460 - using cf[unfolded cauchy o_def dist_norm, THEN spec[where x="e*d"]] and e and mult_pos_pos[of e d] by auto
8.5461 - { fix n assume "n\<ge>N"
8.5462 - hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
8.5463 - moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
8.5464 - using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
8.5465 - using normf[THEN bspec[where x="x n - x N"]] by auto
8.5466 - ultimately have "norm (x n - x N) < d" using `e>0`
8.5467 - using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
8.5468 - hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
8.5469 - thus ?thesis unfolding cauchy and dist_norm by auto
8.5470 -qed
8.5471 -
8.5472 -lemma complete_isometric_image:
8.5473 - fixes f :: "real ^ _ \<Rightarrow> real ^ _"
8.5474 - assumes "0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and cs:"complete s"
8.5475 - shows "complete(f ` s)"
8.5476 -proof-
8.5477 - { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
8.5478 - then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
8.5479 - using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
8.5480 - hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
8.5481 - hence "f \<circ> x = g" unfolding expand_fun_eq by auto
8.5482 - then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
8.5483 - using cs[unfolded complete_def, THEN spec[where x="x"]]
8.5484 - using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
8.5485 - hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
8.5486 - using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
8.5487 - unfolding `f \<circ> x = g` by auto }
8.5488 - thus ?thesis unfolding complete_def by auto
8.5489 -qed
8.5490 -
8.5491 -lemma dist_0_norm:
8.5492 - fixes x :: "'a::real_normed_vector"
8.5493 - shows "dist 0 x = norm x"
8.5494 -unfolding dist_norm by simp
8.5495 -
8.5496 -lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
8.5497 - assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
8.5498 - shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
8.5499 -proof(cases "s \<subseteq> {0::real^'m}")
8.5500 - case True
8.5501 - { fix x assume "x \<in> s"
8.5502 - hence "x = 0" using True by auto
8.5503 - hence "norm x \<le> norm (f x)" by auto }
8.5504 - thus ?thesis by(auto intro!: exI[where x=1])
8.5505 -next
8.5506 - interpret f: bounded_linear f by fact
8.5507 - case False
8.5508 - then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
8.5509 - from False have "s \<noteq> {}" by auto
8.5510 - let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
8.5511 - let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
8.5512 - let ?S'' = "{x::real^'m. norm x = norm a}"
8.5513 -
8.5514 - have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
8.5515 - hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
8.5516 - moreover have "?S' = s \<inter> ?S''" by auto
8.5517 - ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
8.5518 - moreover have *:"f ` ?S' = ?S" by auto
8.5519 - ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
8.5520 - hence "closed ?S" using compact_imp_closed by auto
8.5521 - moreover have "?S \<noteq> {}" using a by auto
8.5522 - 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
8.5523 - 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 *[THEN sym] unfolding image_iff by auto
8.5524 -
8.5525 - let ?e = "norm (f b) / norm b"
8.5526 - have "norm b > 0" using ba and a and norm_ge_zero by auto
8.5527 - moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
8.5528 - ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
8.5529 - moreover
8.5530 - { fix x assume "x\<in>s"
8.5531 - hence "norm (f b) / norm b * norm x \<le> norm (f x)"
8.5532 - proof(cases "x=0")
8.5533 - case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
8.5534 - next
8.5535 - case False
8.5536 - hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
8.5537 - have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
8.5538 - hence "(norm a / norm x) *\<^sub>R x \<in> {x \<in> s. norm x = norm a}" using `x\<in>s` and `x\<noteq>0` by auto
8.5539 - thus "norm (f b) / norm b * norm x \<le> norm (f x)" using b[THEN bspec[where x="(norm a / norm x) *\<^sub>R x"]]
8.5540 - unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
8.5541 - by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
8.5542 - qed }
8.5543 - ultimately
8.5544 - show ?thesis by auto
8.5545 -qed
8.5546 -
8.5547 -lemma closed_injective_image_subspace:
8.5548 - fixes f :: "real ^ _ \<Rightarrow> real ^ _"
8.5549 - assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
8.5550 - shows "closed(f ` s)"
8.5551 -proof-
8.5552 - 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
8.5553 - show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
8.5554 - unfolding complete_eq_closed[THEN sym] by auto
8.5555 -qed
8.5556 -
8.5557 -subsection{* Some properties of a canonical subspace. *}
8.5558 -
8.5559 -lemma subspace_substandard:
8.5560 - "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
8.5561 - unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
8.5562 -
8.5563 -lemma closed_substandard:
8.5564 - "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
8.5565 -proof-
8.5566 - let ?D = "{i. P i}"
8.5567 - let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
8.5568 - { fix x
8.5569 - { assume "x\<in>?A"
8.5570 - hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
8.5571 - hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
8.5572 - moreover
8.5573 - { assume x:"x\<in>\<Inter>?Bs"
8.5574 - { fix i assume i:"i \<in> ?D"
8.5575 - then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
8.5576 - hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
8.5577 - hence "x\<in>?A" by auto }
8.5578 - ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
8.5579 - hence "?A = \<Inter> ?Bs" by auto
8.5580 - thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
8.5581 -qed
8.5582 -
8.5583 -lemma dim_substandard:
8.5584 - shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
8.5585 -proof-
8.5586 - let ?D = "UNIV::'n set"
8.5587 - let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
8.5588 -
8.5589 - let ?bas = "basis::'n \<Rightarrow> real^'n"
8.5590 -
8.5591 - have "?B \<subseteq> ?A" by auto
8.5592 -
8.5593 - moreover
8.5594 - { fix x::"real^'n" assume "x\<in>?A"
8.5595 - with finite[of d]
8.5596 - have "x\<in> span ?B"
8.5597 - proof(induct d arbitrary: x)
8.5598 - case empty hence "x=0" unfolding Cart_eq by auto
8.5599 - thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
8.5600 - next
8.5601 - case (insert k F)
8.5602 - hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
8.5603 - have **:"F \<subseteq> insert k F" by auto
8.5604 - def y \<equiv> "x - x$k *\<^sub>R basis k"
8.5605 - have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
8.5606 - { fix i assume i':"i \<notin> F"
8.5607 - hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
8.5608 - and vector_smult_component and basis_component
8.5609 - using *[THEN spec[where x=i]] by auto }
8.5610 - hence "y \<in> span (basis ` (insert k F))" using insert(3)
8.5611 - using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
8.5612 - using image_mono[OF **, of basis] by auto
8.5613 - moreover
8.5614 - have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
8.5615 - hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
8.5616 - using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
8.5617 - ultimately
8.5618 - have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
8.5619 - using span_add by auto
8.5620 - thus ?case using y by auto
8.5621 - qed
8.5622 - }
8.5623 - hence "?A \<subseteq> span ?B" by auto
8.5624 -
8.5625 - moreover
8.5626 - { fix x assume "x \<in> ?B"
8.5627 - hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
8.5628 - hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
8.5629 -
8.5630 - moreover
8.5631 - have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
8.5632 - hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
8.5633 - have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
8.5634 -
8.5635 - ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
8.5636 -qed
8.5637 -
8.5638 -text{* Hence closure and completeness of all subspaces. *}
8.5639 -
8.5640 -lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
8.5641 -apply (induct n)
8.5642 -apply (rule_tac x="{}" in exI, simp)
8.5643 -apply clarsimp
8.5644 -apply (subgoal_tac "\<exists>x. x \<notin> A")
8.5645 -apply (erule exE)
8.5646 -apply (rule_tac x="insert x A" in exI, simp)
8.5647 -apply (subgoal_tac "A \<noteq> UNIV", auto)
8.5648 -done
8.5649 -
8.5650 -lemma closed_subspace: fixes s::"(real^'n::finite) set"
8.5651 - assumes "subspace s" shows "closed s"
8.5652 -proof-
8.5653 - have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
8.5654 - then obtain d::"'n set" where t: "card d = dim s"
8.5655 - using closed_subspace_lemma by auto
8.5656 - let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
8.5657 - obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
8.5658 - using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
8.5659 - using dim_substandard[of d] and t by auto
8.5660 - interpret f: bounded_linear f by fact
8.5661 - have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
8.5662 - by(erule_tac x=0 in ballE) auto
8.5663 - moreover have "closed ?t" using closed_substandard .
8.5664 - moreover have "subspace ?t" using subspace_substandard .
8.5665 - ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
8.5666 - unfolding f(2) using f(1) by auto
8.5667 -qed
8.5668 -
8.5669 -lemma complete_subspace:
8.5670 - fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
8.5671 - using complete_eq_closed closed_subspace
8.5672 - by auto
8.5673 -
8.5674 -lemma dim_closure:
8.5675 - fixes s :: "(real ^ _) set"
8.5676 - shows "dim(closure s) = dim s" (is "?dc = ?d")
8.5677 -proof-
8.5678 - have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
8.5679 - using closed_subspace[OF subspace_span, of s]
8.5680 - using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
8.5681 - thus ?thesis using dim_subset[OF closure_subset, of s] by auto
8.5682 -qed
8.5683 -
8.5684 -text{* Affine transformations of intervals. *}
8.5685 -
8.5686 -lemma affinity_inverses:
8.5687 - assumes m0: "m \<noteq> (0::'a::field)"
8.5688 - shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
8.5689 - "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
8.5690 - using m0
8.5691 -apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
8.5692 -by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
8.5693 -
8.5694 -lemma real_affinity_le:
8.5695 - "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
8.5696 - by (simp add: field_simps inverse_eq_divide)
8.5697 -
8.5698 -lemma real_le_affinity:
8.5699 - "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
8.5700 - by (simp add: field_simps inverse_eq_divide)
8.5701 -
8.5702 -lemma real_affinity_lt:
8.5703 - "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
8.5704 - by (simp add: field_simps inverse_eq_divide)
8.5705 -
8.5706 -lemma real_lt_affinity:
8.5707 - "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
8.5708 - by (simp add: field_simps inverse_eq_divide)
8.5709 -
8.5710 -lemma real_affinity_eq:
8.5711 - "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
8.5712 - by (simp add: field_simps inverse_eq_divide)
8.5713 -
8.5714 -lemma real_eq_affinity:
8.5715 - "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
8.5716 - by (simp add: field_simps inverse_eq_divide)
8.5717 -
8.5718 -lemma vector_affinity_eq:
8.5719 - assumes m0: "(m::'a::field) \<noteq> 0"
8.5720 - shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
8.5721 -proof
8.5722 - assume h: "m *s x + c = y"
8.5723 - hence "m *s x = y - c" by (simp add: ring_simps)
8.5724 - hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
8.5725 - then show "x = inverse m *s y + - (inverse m *s c)"
8.5726 - using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
8.5727 -next
8.5728 - assume h: "x = inverse m *s y + - (inverse m *s c)"
8.5729 - show "m *s x + c = y" unfolding h diff_minus[symmetric]
8.5730 - using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
8.5731 -qed
8.5732 -
8.5733 -lemma vector_eq_affinity:
8.5734 - "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
8.5735 - using vector_affinity_eq[where m=m and x=x and y=y and c=c]
8.5736 - by metis
8.5737 -
8.5738 -lemma image_affinity_interval: fixes m::real
8.5739 - fixes a b c :: "real^'n::finite"
8.5740 - shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
8.5741 - (if {a .. b} = {} then {}
8.5742 - else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
8.5743 - else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
8.5744 -proof(cases "m=0")
8.5745 - { fix x assume "x \<le> c" "c \<le> x"
8.5746 - hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
8.5747 - moreover case True
8.5748 - moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
8.5749 - ultimately show ?thesis by auto
8.5750 -next
8.5751 - case False
8.5752 - { fix y assume "a \<le> y" "y \<le> b" "m > 0"
8.5753 - hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
8.5754 - unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
8.5755 - } moreover
8.5756 - { fix y assume "a \<le> y" "y \<le> b" "m < 0"
8.5757 - hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
8.5758 - unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
8.5759 - } moreover
8.5760 - { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
8.5761 - hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
8.5762 - unfolding image_iff Bex_def mem_interval vector_less_eq_def
8.5763 - apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
8.5764 - intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
8.5765 - by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
8.5766 - } moreover
8.5767 - { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
8.5768 - hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
8.5769 - unfolding image_iff Bex_def mem_interval vector_less_eq_def
8.5770 - apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
8.5771 - intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
8.5772 - by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
8.5773 - }
8.5774 - ultimately show ?thesis using False by auto
8.5775 -qed
8.5776 -
8.5777 -lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
8.5778 - (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
8.5779 - using image_affinity_interval[of m 0 a b] by auto
8.5780 -
8.5781 -subsection{* Banach fixed point theorem (not really topological...) *}
8.5782 -
8.5783 -lemma banach_fix:
8.5784 - assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
8.5785 - lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
8.5786 - shows "\<exists>! x\<in>s. (f x = x)"
8.5787 -proof-
8.5788 - have "1 - c > 0" using c by auto
8.5789 -
8.5790 - from s(2) obtain z0 where "z0 \<in> s" by auto
8.5791 - def z \<equiv> "\<lambda>n. (f ^^ n) z0"
8.5792 - { fix n::nat
8.5793 - have "z n \<in> s" unfolding z_def
8.5794 - proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
8.5795 - next case Suc thus ?case using f by auto qed }
8.5796 - note z_in_s = this
8.5797 -
8.5798 - def d \<equiv> "dist (z 0) (z 1)"
8.5799 -
8.5800 - have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
8.5801 - { fix n::nat
8.5802 - have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
8.5803 - proof(induct n)
8.5804 - case 0 thus ?case unfolding d_def by auto
8.5805 - next
8.5806 - case (Suc m)
8.5807 - hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
8.5808 - using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
8.5809 - thus ?case using lipschitz[THEN bspec[where x="z m"], OF z_in_s, THEN bspec[where x="z (Suc m)"], OF z_in_s]
8.5810 - unfolding fzn and mult_le_cancel_left by auto
8.5811 - qed
8.5812 - } note cf_z = this
8.5813 -
8.5814 - { fix n m::nat
8.5815 - have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
8.5816 - proof(induct n)
8.5817 - case 0 show ?case by auto
8.5818 - next
8.5819 - case (Suc k)
8.5820 - have "(1 - c) * dist (z m) (z (m + Suc k)) \<le> (1 - c) * (dist (z m) (z (m + k)) + dist (z (m + k)) (z (Suc (m + k))))"
8.5821 - using dist_triangle and c by(auto simp add: dist_triangle)
8.5822 - also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
8.5823 - using cf_z[of "m + k"] and c by auto
8.5824 - also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
8.5825 - using Suc by (auto simp add: ring_simps)
8.5826 - also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
8.5827 - unfolding power_add by (auto simp add: ring_simps)
8.5828 - also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
8.5829 - using c by (auto simp add: ring_simps)
8.5830 - finally show ?case by auto
8.5831 - qed
8.5832 - } note cf_z2 = this
8.5833 - { fix e::real assume "e>0"
8.5834 - hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
8.5835 - proof(cases "d = 0")
8.5836 - case True
8.5837 - hence "\<And>n. z n = z0" using cf_z2[of 0] and c unfolding z_def by (auto simp add: pos_prod_le[OF `1 - c > 0`])
8.5838 - thus ?thesis using `e>0` by auto
8.5839 - next
8.5840 - case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
8.5841 - by (metis False d_def real_less_def)
8.5842 - hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
8.5843 - using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
8.5844 - then obtain N where N:"c ^ N < e * (1 - c) / d" using real_arch_pow_inv[of "e * (1 - c) / d" c] and c by auto
8.5845 - { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
8.5846 - have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
8.5847 - have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
8.5848 - hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
8.5849 - using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
8.5850 - using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
8.5851 - using `0 < 1 - c` by auto
8.5852 -
8.5853 - have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
8.5854 - using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
8.5855 - by (auto simp add: real_mult_commute dist_commute)
8.5856 - also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
8.5857 - using mult_right_mono[OF * order_less_imp_le[OF **]]
8.5858 - unfolding real_mult_assoc by auto
8.5859 - also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
8.5860 - using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
8.5861 - also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
8.5862 - also have "\<dots> \<le> e" using c and `1 - c ^ (m - n) > 0` and `e>0` using mult_right_le_one_le[of e "1 - c ^ (m - n)"] by auto
8.5863 - finally have "dist (z m) (z n) < e" by auto
8.5864 - } note * = this
8.5865 - { fix m n::nat assume as:"N\<le>m" "N\<le>n"
8.5866 - hence "dist (z n) (z m) < e"
8.5867 - proof(cases "n = m")
8.5868 - case True thus ?thesis using `e>0` by auto
8.5869 - next
8.5870 - case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
8.5871 - qed }
8.5872 - thus ?thesis by auto
8.5873 - qed
8.5874 - }
8.5875 - hence "Cauchy z" unfolding cauchy_def by auto
8.5876 - then obtain x where "x\<in>s" and x:"(z ---> x) sequentially" using s(1)[unfolded compact_def complete_def, THEN spec[where x=z]] and z_in_s by auto
8.5877 -
8.5878 - def e \<equiv> "dist (f x) x"
8.5879 - have "e = 0" proof(rule ccontr)
8.5880 - assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
8.5881 - by (metis dist_eq_0_iff dist_nz e_def)
8.5882 - then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
8.5883 - using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
8.5884 - hence N':"dist (z N) x < e / 2" by auto
8.5885 -
8.5886 - have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
8.5887 - using zero_le_dist[of "z N" x] and c
8.5888 - by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
8.5889 - have "dist (f (z N)) (f x) \<le> c * dist (z N) x" using lipschitz[THEN bspec[where x="z N"], THEN bspec[where x=x]]
8.5890 - using z_in_s[of N] `x\<in>s` using c by auto
8.5891 - also have "\<dots> < e / 2" using N' and c using * by auto
8.5892 - finally show False unfolding fzn
8.5893 - using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
8.5894 - unfolding e_def by auto
8.5895 - qed
8.5896 - hence "f x = x" unfolding e_def by auto
8.5897 - moreover
8.5898 - { fix y assume "f y = y" "y\<in>s"
8.5899 - hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
8.5900 - using `x\<in>s` and `f x = x` by auto
8.5901 - hence "dist x y = 0" unfolding mult_le_cancel_right1
8.5902 - using c and zero_le_dist[of x y] by auto
8.5903 - hence "y = x" by auto
8.5904 - }
8.5905 - ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
8.5906 -qed
8.5907 -
8.5908 -subsection{* Edelstein fixed point theorem. *}
8.5909 -
8.5910 -lemma edelstein_fix:
8.5911 - fixes s :: "'a::real_normed_vector set"
8.5912 - assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
8.5913 - and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
8.5914 - shows "\<exists>! x\<in>s. g x = x"
8.5915 -proof(cases "\<exists>x\<in>s. g x \<noteq> x")
8.5916 - obtain x where "x\<in>s" using s(2) by auto
8.5917 - case False hence g:"\<forall>x\<in>s. g x = x" by auto
8.5918 - { fix y assume "y\<in>s"
8.5919 - hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
8.5920 - unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
8.5921 - unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
8.5922 - thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
8.5923 -next
8.5924 - case True
8.5925 - then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
8.5926 - { fix x y assume "x \<in> s" "y \<in> s"
8.5927 - hence "dist (g x) (g y) \<le> dist x y"
8.5928 - using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
8.5929 - def y \<equiv> "g x"
8.5930 - have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
8.5931 - def f \<equiv> "\<lambda>n. g ^^ n"
8.5932 - have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
8.5933 - have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
8.5934 - { fix n::nat and z assume "z\<in>s"
8.5935 - have "f n z \<in> s" unfolding f_def
8.5936 - proof(induct n)
8.5937 - case 0 thus ?case using `z\<in>s` by simp
8.5938 - next
8.5939 - case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
8.5940 - qed } note fs = this
8.5941 - { fix m n ::nat assume "m\<le>n"
8.5942 - fix w z assume "w\<in>s" "z\<in>s"
8.5943 - have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
8.5944 - proof(induct n)
8.5945 - case 0 thus ?case by auto
8.5946 - next
8.5947 - case (Suc n)
8.5948 - thus ?case proof(cases "m\<le>n")
8.5949 - case True thus ?thesis using Suc(1)
8.5950 - using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
8.5951 - next
8.5952 - case False hence mn:"m = Suc n" using Suc(2) by simp
8.5953 - show ?thesis unfolding mn by auto
8.5954 - qed
8.5955 - qed } note distf = this
8.5956 -
8.5957 - def h \<equiv> "\<lambda>n. (f n x, f n y)"
8.5958 - let ?s2 = "s \<times> s"
8.5959 - obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
8.5960 - using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
8.5961 - using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
8.5962 - def a \<equiv> "fst l" def b \<equiv> "snd l"
8.5963 - have lab:"l = (a, b)" unfolding a_def b_def by simp
8.5964 - have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
8.5965 -
8.5966 - have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
8.5967 - and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
8.5968 - using lr
8.5969 - unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
8.5970 -
8.5971 - { fix n::nat
8.5972 - have *:"\<And>fx fy (x::'a) y. dist fx fy \<le> dist x y \<Longrightarrow> \<not> (dist (fx - fy) (a - b) < dist a b - dist x y)" unfolding dist_norm by norm
8.5973 - { fix x y :: 'a
8.5974 - have "dist (-x) (-y) = dist x y" unfolding dist_norm
8.5975 - using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
8.5976 -
8.5977 - { assume as:"dist a b > dist (f n x) (f n y)"
8.5978 - then obtain Na Nb where "\<forall>m\<ge>Na. dist (f (r m) x) a < (dist a b - dist (f n x) (f n y)) / 2"
8.5979 - and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
8.5980 - using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
8.5981 - hence "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) < dist a b - dist (f n x) (f n y)"
8.5982 - apply(erule_tac x="Na+Nb+n" in allE)
8.5983 - apply(erule_tac x="Na+Nb+n" in allE) apply simp
8.5984 - using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
8.5985 - "-b" "- f (r (Na + Nb + n)) y"]
8.5986 - unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
8.5987 - moreover
8.5988 - have "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) \<ge> dist a b - dist (f n x) (f n y)"
8.5989 - using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
8.5990 - using subseq_bigger[OF r, of "Na+Nb+n"]
8.5991 - using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
8.5992 - ultimately have False by simp
8.5993 - }
8.5994 - hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
8.5995 - note ab_fn = this
8.5996 -
8.5997 - have [simp]:"a = b" proof(rule ccontr)
8.5998 - def e \<equiv> "dist a b - dist (g a) (g b)"
8.5999 - assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
8.6000 - hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
8.6001 - using lima limb unfolding Lim_sequentially
8.6002 - apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
8.6003 - then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
8.6004 - have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
8.6005 - using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
8.6006 - moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
8.6007 - using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
8.6008 - ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
8.6009 - thus False unfolding e_def using ab_fn[of "Suc n"] by norm
8.6010 - qed
8.6011 -
8.6012 - have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
8.6013 - { fix x y assume "x\<in>s" "y\<in>s" moreover
8.6014 - fix e::real assume "e>0" ultimately
8.6015 - have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
8.6016 - hence "continuous_on s g" unfolding continuous_on_def by auto
8.6017 -
8.6018 - hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
8.6019 - apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
8.6020 - using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
8.6021 - hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
8.6022 - unfolding `a=b` and o_assoc by auto
8.6023 - moreover
8.6024 - { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
8.6025 - hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
8.6026 - using `g a = a` and `a\<in>s` by auto }
8.6027 - ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
8.6028 -qed
8.6029 -
8.6030 -end
9.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
9.3 @@ -0,0 +1,3371 @@
9.4 +(* Title: HOL/Library/Convex_Euclidean_Space.thy
9.5 + Author: Robert Himmelmann, TU Muenchen
9.6 +*)
9.7 +
9.8 +header {* Convex sets, functions and related things. *}
9.9 +
9.10 +theory Convex_Euclidean_Space
9.11 +imports Topology_Euclidean_Space
9.12 +begin
9.13 +
9.14 +
9.15 +(* ------------------------------------------------------------------------- *)
9.16 +(* To be moved elsewhere *)
9.17 +(* ------------------------------------------------------------------------- *)
9.18 +
9.19 +declare vector_add_ldistrib[simp] vector_ssub_ldistrib[simp] vector_smult_assoc[simp] vector_smult_rneg[simp]
9.20 +declare vector_sadd_rdistrib[simp] vector_sub_rdistrib[simp]
9.21 +declare dot_ladd[simp] dot_radd[simp] dot_lsub[simp] dot_rsub[simp]
9.22 +declare dot_lmult[simp] dot_rmult[simp] dot_lneg[simp] dot_rneg[simp]
9.23 +declare UNIV_1[simp]
9.24 +
9.25 +term "(x::real^'n \<Rightarrow> real) 0"
9.26 +
9.27 +lemma dim1in[intro]:"Suc 0 \<in> {1::nat .. CARD(1)}" by auto
9.28 +
9.29 +lemmas vector_component_simps = vector_minus_component vector_smult_component vector_add_component vector_less_eq_def Cart_lambda_beta dest_vec1_def basis_component vector_uminus_component
9.30 +
9.31 +lemmas continuous_intros = continuous_add continuous_vmul continuous_cmul continuous_const continuous_sub continuous_at_id continuous_within_id
9.32 +
9.33 +lemmas continuous_on_intros = continuous_on_add continuous_on_const continuous_on_id continuous_on_compose continuous_on_cmul continuous_on_neg continuous_on_sub
9.34 + uniformly_continuous_on_add uniformly_continuous_on_const uniformly_continuous_on_id uniformly_continuous_on_compose uniformly_continuous_on_cmul uniformly_continuous_on_neg uniformly_continuous_on_sub
9.35 +
9.36 +lemma dest_vec1_simps[simp]: fixes a::"real^1"
9.37 + shows "a$1 = 0 \<longleftrightarrow> a = 0" (*"a \<le> 1 \<longleftrightarrow> dest_vec1 a \<le> 1" "0 \<le> a \<longleftrightarrow> 0 \<le> dest_vec1 a"*)
9.38 + "a \<le> b \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 b" "dest_vec1 (1::real^1) = 1"
9.39 + by(auto simp add:vector_component_simps all_1 Cart_eq)
9.40 +
9.41 +lemma nequals0I:"x\<in>A \<Longrightarrow> A \<noteq> {}" by auto
9.42 +
9.43 +lemma norm_not_0:"(x::real^'n::finite)\<noteq>0 \<Longrightarrow> norm x \<noteq> 0" by auto
9.44 +
9.45 +lemma setsum_delta_notmem: assumes "x\<notin>s"
9.46 + shows "setsum (\<lambda>y. if (y = x) then P x else Q y) s = setsum Q s"
9.47 + "setsum (\<lambda>y. if (x = y) then P x else Q y) s = setsum Q s"
9.48 + "setsum (\<lambda>y. if (y = x) then P y else Q y) s = setsum Q s"
9.49 + "setsum (\<lambda>y. if (x = y) then P y else Q y) s = setsum Q s"
9.50 + apply(rule_tac [!] setsum_cong2) using assms by auto
9.51 +
9.52 +lemma setsum_delta'':
9.53 + fixes s::"'a::real_vector set" assumes "finite s"
9.54 + shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
9.55 +proof-
9.56 + have *:"\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)" by auto
9.57 + show ?thesis unfolding * using setsum_delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
9.58 +qed
9.59 +
9.60 +lemma not_disjointI:"x\<in>A \<Longrightarrow> x\<in>B \<Longrightarrow> A \<inter> B \<noteq> {}" by blast
9.61 +
9.62 +lemma if_smult:"(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)" by auto
9.63 +
9.64 +lemma mem_interval_1: fixes x :: "real^1" shows
9.65 + "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
9.66 + "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
9.67 +by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def all_1)
9.68 +
9.69 +lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
9.70 + (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
9.71 + using image_affinity_interval[of m 0 a b] by auto
9.72 +
9.73 +lemma dest_vec1_inverval:
9.74 + "dest_vec1 ` {a .. b} = {dest_vec1 a .. dest_vec1 b}"
9.75 + "dest_vec1 ` {a<.. b} = {dest_vec1 a<.. dest_vec1 b}"
9.76 + "dest_vec1 ` {a ..<b} = {dest_vec1 a ..<dest_vec1 b}"
9.77 + "dest_vec1 ` {a<..<b} = {dest_vec1 a<..<dest_vec1 b}"
9.78 + apply(rule_tac [!] equalityI)
9.79 + unfolding subset_eq Ball_def Bex_def mem_interval_1 image_iff
9.80 + apply(rule_tac [!] allI)apply(rule_tac [!] impI)
9.81 + apply(rule_tac[2] x="vec1 x" in exI)apply(rule_tac[4] x="vec1 x" in exI)
9.82 + apply(rule_tac[6] x="vec1 x" in exI)apply(rule_tac[8] x="vec1 x" in exI)
9.83 + by (auto simp add: vector_less_def vector_less_eq_def all_1 dest_vec1_def
9.84 + vec1_dest_vec1[unfolded dest_vec1_def One_nat_def])
9.85 +
9.86 +lemma dest_vec1_setsum: assumes "finite S"
9.87 + shows " dest_vec1 (setsum f S) = setsum (\<lambda>x. dest_vec1 (f x)) S"
9.88 + using dest_vec1_sum[OF assms] by auto
9.89 +
9.90 +lemma dist_triangle_eq:
9.91 + fixes x y z :: "real ^ _"
9.92 + shows "dist x z = dist x y + dist y z \<longleftrightarrow> norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
9.93 +proof- have *:"x - y + (y - z) = x - z" by auto
9.94 + show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded smult_conv_scaleR *]
9.95 + by(auto simp add:norm_minus_commute) qed
9.96 +
9.97 +lemma norm_eqI:"x = y \<Longrightarrow> norm x = norm y" by auto
9.98 +lemma norm_minus_eqI:"(x::real^'n::finite) = - y \<Longrightarrow> norm x = norm y" by auto
9.99 +
9.100 +lemma Min_grI: assumes "finite A" "A \<noteq> {}" "\<forall>a\<in>A. x < a" shows "x < Min A"
9.101 + unfolding Min_gr_iff[OF assms(1,2)] using assms(3) by auto
9.102 +
9.103 +lemma dimindex_ge_1:"CARD(_::finite) \<ge> 1"
9.104 + using one_le_card_finite by auto
9.105 +
9.106 +lemma real_dimindex_ge_1:"real (CARD('n::finite)) \<ge> 1"
9.107 + by(metis dimindex_ge_1 linorder_not_less real_eq_of_nat real_le_trans real_of_nat_1 real_of_nat_le_iff)
9.108 +
9.109 +lemma real_dimindex_gt_0:"real (CARD('n::finite)) > 0" apply(rule less_le_trans[OF _ real_dimindex_ge_1]) by auto
9.110 +
9.111 +subsection {* Affine set and affine hull.*}
9.112 +
9.113 +definition
9.114 + affine :: "'a::real_vector set \<Rightarrow> bool" where
9.115 + "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
9.116 +
9.117 +lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
9.118 +proof- have *:"\<And>u v ::real. u + v = 1 \<longleftrightarrow> v = 1 - u" by auto
9.119 + { fix x y assume "x\<in>s" "y\<in>s"
9.120 + hence "(\<forall>u v::real. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s) \<longleftrightarrow> (\<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)" apply auto
9.121 + apply(erule_tac[!] x="1 - u" in allE) unfolding * by auto }
9.122 + thus ?thesis unfolding affine_def by auto qed
9.123 +
9.124 +lemma affine_empty[intro]: "affine {}"
9.125 + unfolding affine_def by auto
9.126 +
9.127 +lemma affine_sing[intro]: "affine {x}"
9.128 + unfolding affine_alt by (auto simp add: scaleR_left_distrib [symmetric])
9.129 +
9.130 +lemma affine_UNIV[intro]: "affine UNIV"
9.131 + unfolding affine_def by auto
9.132 +
9.133 +lemma affine_Inter: "(\<forall>s\<in>f. affine s) \<Longrightarrow> affine (\<Inter> f)"
9.134 + unfolding affine_def by auto
9.135 +
9.136 +lemma affine_Int: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
9.137 + unfolding affine_def by auto
9.138 +
9.139 +lemma affine_affine_hull: "affine(affine hull s)"
9.140 + unfolding hull_def using affine_Inter[of "{t \<in> affine. s \<subseteq> t}"]
9.141 + unfolding mem_def by auto
9.142 +
9.143 +lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
9.144 +proof-
9.145 + { fix f assume "f \<subseteq> affine"
9.146 + hence "affine (\<Inter>f)" using affine_Inter[of f] unfolding subset_eq mem_def by auto }
9.147 + thus ?thesis using hull_eq[unfolded mem_def, of affine s] by auto
9.148 +qed
9.149 +
9.150 +lemma setsum_restrict_set'': assumes "finite A"
9.151 + shows "setsum f {x \<in> A. P x} = (\<Sum>x\<in>A. if P x then f x else 0)"
9.152 + unfolding mem_def[of _ P, symmetric] unfolding setsum_restrict_set'[OF assms] ..
9.153 +
9.154 +subsection {* Some explicit formulations (from Lars Schewe). *}
9.155 +
9.156 +lemma affine: fixes V::"'a::real_vector set"
9.157 + shows "affine V \<longleftrightarrow> (\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (setsum (\<lambda>x. (u x) *\<^sub>R x)) s \<in> V)"
9.158 +unfolding affine_def apply rule apply(rule, rule, rule) apply(erule conjE)+
9.159 +defer apply(rule, rule, rule, rule, rule) proof-
9.160 + fix x y u v assume as:"x \<in> V" "y \<in> V" "u + v = (1::real)"
9.161 + "\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
9.162 + thus "u *\<^sub>R x + v *\<^sub>R y \<in> V" apply(cases "x=y")
9.163 + using as(4)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>w. if w = x then u else v"]] and as(1-3)
9.164 + by(auto simp add: scaleR_left_distrib[THEN sym])
9.165 +next
9.166 + fix s u assume as:"\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
9.167 + "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = (1::real)"
9.168 + def n \<equiv> "card s"
9.169 + have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
9.170 + thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" proof(auto simp only: disjE)
9.171 + assume "card s = 2" hence "card s = Suc (Suc 0)" by auto
9.172 + then obtain a b where "s = {a, b}" unfolding card_Suc_eq by auto
9.173 + thus ?thesis using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
9.174 + by(auto simp add: setsum_clauses(2))
9.175 + next assume "card s > 2" thus ?thesis using as and n_def proof(induct n arbitrary: u s)
9.176 + case (Suc n) fix s::"'a set" and u::"'a \<Rightarrow> real"
9.177 + assume IA:"\<And>u s. \<lbrakk>2 < card s; \<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V; finite s;
9.178 + s \<noteq> {}; s \<subseteq> V; setsum u s = 1; n \<equiv> card s \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" and
9.179 + as:"Suc n \<equiv> card s" "2 < card s" "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
9.180 + "finite s" "s \<noteq> {}" "s \<subseteq> V" "setsum u s = 1"
9.181 + have "\<exists>x\<in>s. u x \<noteq> 1" proof(rule_tac ccontr)
9.182 + assume " \<not> (\<exists>x\<in>s. u x \<noteq> 1)" hence "setsum u s = real_of_nat (card s)" unfolding card_eq_setsum by auto
9.183 + thus False using as(7) and `card s > 2` by (metis Numeral1_eq1_nat less_0_number_of less_int_code(15)
9.184 + less_nat_number_of not_less_iff_gr_or_eq of_nat_1 of_nat_eq_iff pos2 rel_simps(4)) qed
9.185 + then obtain x where x:"x\<in>s" "u x \<noteq> 1" by auto
9.186 +
9.187 + have c:"card (s - {x}) = card s - 1" apply(rule card_Diff_singleton) using `x\<in>s` as(4) by auto
9.188 + have *:"s = insert x (s - {x})" "finite (s - {x})" using `x\<in>s` and as(4) by auto
9.189 + have **:"setsum u (s - {x}) = 1 - u x"
9.190 + using setsum_clauses(2)[OF *(2), of u x, unfolded *(1)[THEN sym] as(7)] by auto
9.191 + have ***:"inverse (1 - u x) * setsum u (s - {x}) = 1" unfolding ** using `u x \<noteq> 1` by auto
9.192 + have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V" proof(cases "card (s - {x}) > 2")
9.193 + case True hence "s - {x} \<noteq> {}" "card (s - {x}) = n" unfolding c and as(1)[symmetric] proof(rule_tac ccontr)
9.194 + assume "\<not> s - {x} \<noteq> {}" hence "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp
9.195 + thus False using True by auto qed auto
9.196 + thus ?thesis apply(rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
9.197 + unfolding setsum_right_distrib[THEN sym] using as and *** and True by auto
9.198 + next case False hence "card (s - {x}) = Suc (Suc 0)" using as(2) and c by auto
9.199 + then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b" unfolding card_Suc_eq by auto
9.200 + thus ?thesis using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
9.201 + using *** *(2) and `s \<subseteq> V` unfolding setsum_right_distrib by(auto simp add: setsum_clauses(2)) qed
9.202 + thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V" unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric]
9.203 + apply(subst *) unfolding setsum_clauses(2)[OF *(2)]
9.204 + using as(3)[THEN bspec[where x=x], THEN bspec[where x="(inverse (1 - u x)) *\<^sub>R (\<Sum>xa\<in>s - {x}. u xa *\<^sub>R xa)"],
9.205 + THEN spec[where x="u x"], THEN spec[where x="1 - u x"]] and rev_subsetD[OF `x\<in>s` `s\<subseteq>V`] and `u x \<noteq> 1` by auto
9.206 + qed auto
9.207 + next assume "card s = 1" then obtain a where "s={a}" by(auto simp add: card_Suc_eq)
9.208 + thus ?thesis using as(4,5) by simp
9.209 + qed(insert `s\<noteq>{}` `finite s`, auto)
9.210 +qed
9.211 +
9.212 +lemma affine_hull_explicit:
9.213 + "affine hull p = {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> setsum (\<lambda>v. (u v) *\<^sub>R v) s = y}"
9.214 + apply(rule hull_unique) apply(subst subset_eq) prefer 3 apply rule unfolding mem_Collect_eq and mem_def[of _ affine]
9.215 + apply (erule exE)+ apply(erule conjE)+ prefer 2 apply rule proof-
9.216 + fix x assume "x\<in>p" thus "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.217 + apply(rule_tac x="{x}" in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
9.218 +next
9.219 + fix t x s u assume as:"p \<subseteq> t" "affine t" "finite s" "s \<noteq> {}" "s \<subseteq> p" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.220 + thus "x \<in> t" using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]] by auto
9.221 +next
9.222 + show "affine {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y}" unfolding affine_def
9.223 + apply(rule,rule,rule,rule,rule) unfolding mem_Collect_eq proof-
9.224 + fix u v ::real assume uv:"u + v = 1"
9.225 + fix x assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.226 + then obtain sx ux where x:"finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "setsum ux sx = 1" "(\<Sum>v\<in>sx. ux v *\<^sub>R v) = x" by auto
9.227 + fix y assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
9.228 + then obtain sy uy where y:"finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "setsum uy sy = 1" "(\<Sum>v\<in>sy. uy v *\<^sub>R v) = y" by auto
9.229 + have xy:"finite (sx \<union> sy)" using x(1) y(1) by auto
9.230 + have **:"(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy" by auto
9.231 + show "\<exists>s ua. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> setsum ua s = 1 \<and> (\<Sum>v\<in>s. ua v *\<^sub>R v) = u *\<^sub>R x + v *\<^sub>R y"
9.232 + apply(rule_tac x="sx \<union> sy" in exI)
9.233 + apply(rule_tac x="\<lambda>a. (if a\<in>sx then u * ux a else 0) + (if a\<in>sy then v * uy a else 0)" in exI)
9.234 + unfolding scaleR_left_distrib setsum_addf if_smult scaleR_zero_left ** setsum_restrict_set[OF xy, THEN sym]
9.235 + unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and setsum_right_distrib[THEN sym]
9.236 + unfolding x y using x(1-3) y(1-3) uv by simp qed qed
9.237 +
9.238 +lemma affine_hull_finite:
9.239 + assumes "finite s"
9.240 + shows "affine hull s = {y. \<exists>u. setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
9.241 + unfolding affine_hull_explicit and expand_set_eq and mem_Collect_eq apply (rule,rule)
9.242 + apply(erule exE)+ apply(erule conjE)+ defer apply(erule exE) apply(erule conjE) proof-
9.243 + fix x u assume "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.244 + thus "\<exists>sa u. finite sa \<and> \<not> (\<forall>x. (x \<in> sa) = (x \<in> {})) \<and> sa \<subseteq> s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = x"
9.245 + apply(rule_tac x=s in exI, rule_tac x=u in exI) using assms by auto
9.246 +next
9.247 + fix x t u assume "t \<subseteq> s" hence *:"s \<inter> t = t" by auto
9.248 + assume "finite t" "\<not> (\<forall>x. (x \<in> t) = (x \<in> {}))" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
9.249 + thus "\<exists>u. setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x" apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
9.250 + unfolding if_smult scaleR_zero_left and setsum_restrict_set[OF assms, THEN sym] and * by auto qed
9.251 +
9.252 +subsection {* Stepping theorems and hence small special cases. *}
9.253 +
9.254 +lemma affine_hull_empty[simp]: "affine hull {} = {}"
9.255 + apply(rule hull_unique) unfolding mem_def by auto
9.256 +
9.257 +lemma affine_hull_finite_step:
9.258 + fixes y :: "'a::real_vector"
9.259 + shows "(\<exists>u. setsum u {} = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
9.260 + "finite s \<Longrightarrow> (\<exists>u. setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y) \<longleftrightarrow>
9.261 + (\<exists>v u. setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?as \<Longrightarrow> (?lhs = ?rhs)")
9.262 +proof-
9.263 + show ?th1 by simp
9.264 + assume ?as
9.265 + { assume ?lhs
9.266 + then obtain u where u:"setsum u (insert a s) = w \<and> (\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
9.267 + have ?rhs proof(cases "a\<in>s")
9.268 + case True hence *:"insert a s = s" by auto
9.269 + show ?thesis using u[unfolded *] apply(rule_tac x=0 in exI) by auto
9.270 + next
9.271 + case False thus ?thesis apply(rule_tac x="u a" in exI) using u and `?as` by auto
9.272 + qed } moreover
9.273 + { assume ?rhs
9.274 + then obtain v u where vu:"setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
9.275 + have *:"\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)" by auto
9.276 + have ?lhs proof(cases "a\<in>s")
9.277 + case True thus ?thesis
9.278 + apply(rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
9.279 + unfolding setsum_clauses(2)[OF `?as`] apply simp
9.280 + unfolding scaleR_left_distrib and setsum_addf
9.281 + unfolding vu and * and scaleR_zero_left
9.282 + by (auto simp add: setsum_delta[OF `?as`])
9.283 + next
9.284 + case False
9.285 + hence **:"\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
9.286 + "\<And>x. x \<in> s \<Longrightarrow> u x *\<^sub>R x = (if x = a then v *\<^sub>R x else u x *\<^sub>R x)" by auto
9.287 + from False show ?thesis
9.288 + apply(rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
9.289 + unfolding setsum_clauses(2)[OF `?as`] and * using vu
9.290 + using setsum_cong2[of s "\<lambda>x. u x *\<^sub>R x" "\<lambda>x. if x = a then v *\<^sub>R x else u x *\<^sub>R x", OF **(2)]
9.291 + using setsum_cong2[of s u "\<lambda>x. if x = a then v else u x", OF **(1)] by auto
9.292 + qed }
9.293 + ultimately show "?lhs = ?rhs" by blast
9.294 +qed
9.295 +
9.296 +lemma affine_hull_2:
9.297 + fixes a b :: "'a::real_vector"
9.298 + shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}" (is "?lhs = ?rhs")
9.299 +proof-
9.300 + have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
9.301 + "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
9.302 + have "?lhs = {y. \<exists>u. setsum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
9.303 + using affine_hull_finite[of "{a,b}"] by auto
9.304 + also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
9.305 + by(simp add: affine_hull_finite_step(2)[of "{b}" a])
9.306 + also have "\<dots> = ?rhs" unfolding * by auto
9.307 + finally show ?thesis by auto
9.308 +qed
9.309 +
9.310 +lemma affine_hull_3:
9.311 + fixes a b c :: "'a::real_vector"
9.312 + shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}" (is "?lhs = ?rhs")
9.313 +proof-
9.314 + have *:"\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
9.315 + "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
9.316 + show ?thesis apply(simp add: affine_hull_finite affine_hull_finite_step)
9.317 + unfolding * apply auto
9.318 + apply(rule_tac x=v in exI) apply(rule_tac x=va in exI) apply auto
9.319 + apply(rule_tac x=u in exI) by(auto intro!: exI)
9.320 +qed
9.321 +
9.322 +subsection {* Some relations between affine hull and subspaces. *}
9.323 +
9.324 +lemma affine_hull_insert_subset_span:
9.325 + fixes a :: "real ^ _"
9.326 + shows "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
9.327 + unfolding subset_eq Ball_def unfolding affine_hull_explicit span_explicit mem_Collect_eq smult_conv_scaleR
9.328 + apply(rule,rule) apply(erule exE)+ apply(erule conjE)+ proof-
9.329 + fix x t u assume as:"finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
9.330 + have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}" using as(3) by auto
9.331 + thus "\<exists>v. x = a + v \<and> (\<exists>S u. finite S \<and> S \<subseteq> {x - a |x. x \<in> s} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = v)"
9.332 + apply(rule_tac x="x - a" in exI)
9.333 + apply (rule conjI, simp)
9.334 + apply(rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
9.335 + apply(rule_tac x="\<lambda>x. u (x + a)" in exI)
9.336 + apply (rule conjI) using as(1) apply simp
9.337 + apply (erule conjI)
9.338 + using as(1)
9.339 + apply (simp add: setsum_reindex[unfolded inj_on_def] scaleR_right_diff_distrib setsum_subtractf scaleR_left.setsum[THEN sym] setsum_diff1 scaleR_left_diff_distrib)
9.340 + unfolding as by simp qed
9.341 +
9.342 +lemma affine_hull_insert_span:
9.343 + fixes a :: "real ^ _"
9.344 + assumes "a \<notin> s"
9.345 + shows "affine hull (insert a s) =
9.346 + {a + v | v . v \<in> span {x - a | x. x \<in> s}}"
9.347 + apply(rule, rule affine_hull_insert_subset_span) unfolding subset_eq Ball_def
9.348 + unfolding affine_hull_explicit and mem_Collect_eq proof(rule,rule,erule exE,erule conjE)
9.349 + fix y v assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
9.350 + then obtain t u where obt:"finite t" "t \<subseteq> {x - a |x. x \<in> s}" "a + (\<Sum>v\<in>t. u v *\<^sub>R v) = y" unfolding span_explicit smult_conv_scaleR by auto
9.351 + def f \<equiv> "(\<lambda>x. x + a) ` t"
9.352 + have f:"finite f" "f \<subseteq> s" "(\<Sum>v\<in>f. u (v - a) *\<^sub>R (v - a)) = y - a" unfolding f_def using obt
9.353 + by(auto simp add: setsum_reindex[unfolded inj_on_def])
9.354 + have *:"f \<inter> {a} = {}" "f \<inter> - {a} = f" using f(2) assms by auto
9.355 + show "\<exists>sa u. finite sa \<and> sa \<noteq> {} \<and> sa \<subseteq> insert a s \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
9.356 + apply(rule_tac x="insert a f" in exI)
9.357 + apply(rule_tac x="\<lambda>x. if x=a then 1 - setsum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
9.358 + using assms and f unfolding setsum_clauses(2)[OF f(1)] and if_smult
9.359 + unfolding setsum_cases[OF f(1), of "{a}", unfolded singleton_iff] and *
9.360 + by (auto simp add: setsum_subtractf scaleR_left.setsum algebra_simps) qed
9.361 +
9.362 +lemma affine_hull_span:
9.363 + fixes a :: "real ^ _"
9.364 + assumes "a \<in> s"
9.365 + shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
9.366 + using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
9.367 +
9.368 +subsection {* Convexity. *}
9.369 +
9.370 +definition
9.371 + convex :: "'a::real_vector set \<Rightarrow> bool" where
9.372 + "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
9.373 +
9.374 +lemma convex_alt: "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> ((1 - u) *\<^sub>R x + u *\<^sub>R y) \<in> s)"
9.375 +proof- have *:"\<And>u v::real. u + v = 1 \<longleftrightarrow> u = 1 - v" by auto
9.376 + show ?thesis unfolding convex_def apply auto
9.377 + apply(erule_tac x=x in ballE) apply(erule_tac x=y in ballE) apply(erule_tac x="1 - u" in allE)
9.378 + by (auto simp add: *) qed
9.379 +
9.380 +lemma mem_convex:
9.381 + assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
9.382 + shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
9.383 + using assms unfolding convex_alt by auto
9.384 +
9.385 +lemma convex_empty[intro]: "convex {}"
9.386 + unfolding convex_def by simp
9.387 +
9.388 +lemma convex_singleton[intro]: "convex {a}"
9.389 + unfolding convex_def by (auto simp add:scaleR_left_distrib[THEN sym])
9.390 +
9.391 +lemma convex_UNIV[intro]: "convex UNIV"
9.392 + unfolding convex_def by auto
9.393 +
9.394 +lemma convex_Inter: "(\<forall>s\<in>f. convex s) ==> convex(\<Inter> f)"
9.395 + unfolding convex_def by auto
9.396 +
9.397 +lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
9.398 + unfolding convex_def by auto
9.399 +
9.400 +lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
9.401 + unfolding convex_def apply auto
9.402 + unfolding inner_add inner_scaleR
9.403 + by (metis real_convex_bound_le)
9.404 +
9.405 +lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
9.406 +proof- have *:"{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}" by auto
9.407 + show ?thesis apply(unfold *) using convex_halfspace_le[of "-a" "-b"] by auto qed
9.408 +
9.409 +lemma convex_hyperplane: "convex {x. inner a x = b}"
9.410 +proof-
9.411 + have *:"{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}" by auto
9.412 + show ?thesis unfolding * apply(rule convex_Int)
9.413 + using convex_halfspace_le convex_halfspace_ge by auto
9.414 +qed
9.415 +
9.416 +lemma convex_halfspace_lt: "convex {x. inner a x < b}"
9.417 + unfolding convex_def
9.418 + by(auto simp add: real_convex_bound_lt inner_add)
9.419 +
9.420 +lemma convex_halfspace_gt: "convex {x. inner a x > b}"
9.421 + using convex_halfspace_lt[of "-a" "-b"] by auto
9.422 +
9.423 +lemma convex_positive_orthant: "convex {x::real^'n::finite. (\<forall>i. 0 \<le> x$i)}"
9.424 + unfolding convex_def apply auto apply(erule_tac x=i in allE)+
9.425 + apply(rule add_nonneg_nonneg) by(auto simp add: mult_nonneg_nonneg)
9.426 +
9.427 +subsection {* Explicit expressions for convexity in terms of arbitrary sums. *}
9.428 +
9.429 +lemma convex: "convex s \<longleftrightarrow>
9.430 + (\<forall>(k::nat) u x. (\<forall>i. 1\<le>i \<and> i\<le>k \<longrightarrow> 0 \<le> u i \<and> x i \<in>s) \<and> (setsum u {1..k} = 1)
9.431 + \<longrightarrow> setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
9.432 + unfolding convex_def apply rule apply(rule allI)+ defer apply(rule ballI)+ apply(rule allI)+ proof(rule,rule,rule,rule)
9.433 + fix x y u v assume as:"\<forall>(k::nat) u x. (\<forall>i. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R x i) \<in> s"
9.434 + "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
9.435 + show "u *\<^sub>R x + v *\<^sub>R y \<in> s" using as(1)[THEN spec[where x=2], THEN spec[where x="\<lambda>n. if n=1 then u else v"], THEN spec[where x="\<lambda>n. if n=1 then x else y"]] and as(2-)
9.436 + by (auto simp add: setsum_head_Suc)
9.437 +next
9.438 + fix k u x assume as:"\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s"
9.439 + show "(\<forall>i::nat. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R x i) \<in> s" apply(rule,erule conjE) proof(induct k arbitrary: u)
9.440 + case (Suc k) show ?case proof(cases "u (Suc k) = 1")
9.441 + case True hence "(\<Sum>i = Suc 0..k. u i *\<^sub>R x i) = 0" apply(rule_tac setsum_0') apply(rule ccontr) unfolding ball_simps apply(erule bexE) proof-
9.442 + fix i assume i:"i \<in> {Suc 0..k}" "u i *\<^sub>R x i \<noteq> 0"
9.443 + hence ui:"u i \<noteq> 0" by auto
9.444 + hence "setsum (\<lambda>k. if k=i then u i else 0) {1 .. k} \<le> setsum u {1 .. k}" apply(rule_tac setsum_mono) using Suc(2) by auto
9.445 + hence "setsum u {1 .. k} \<ge> u i" using i(1) by(auto simp add: setsum_delta)
9.446 + hence "setsum u {1 .. k} > 0" using ui apply(rule_tac less_le_trans[of _ "u i"]) using Suc(2)[THEN spec[where x=i]] and i(1) by auto
9.447 + thus False using Suc(3) unfolding setsum_cl_ivl_Suc and True by simp qed
9.448 + thus ?thesis unfolding setsum_cl_ivl_Suc using True and Suc(2) by auto
9.449 + next
9.450 + have *:"setsum u {1..k} = 1 - u (Suc k)" using Suc(3)[unfolded setsum_cl_ivl_Suc] by auto
9.451 + have **:"u (Suc k) \<le> 1" apply(rule ccontr) unfolding not_le using Suc(3) using setsum_nonneg[of "{1..k}" u] using Suc(2) by auto
9.452 + have ***:"\<And>i k. (u i / (1 - u (Suc k))) *\<^sub>R x i = (inverse (1 - u (Suc k))) *\<^sub>R (u i *\<^sub>R x i)" unfolding real_divide_def by (auto simp add: algebra_simps)
9.453 + case False hence nn:"1 - u (Suc k) \<noteq> 0" by auto
9.454 + have "(\<Sum>i = 1..k. (u i / (1 - u (Suc k))) *\<^sub>R x i) \<in> s" apply(rule Suc(1)) unfolding setsum_divide_distrib[THEN sym] and *
9.455 + apply(rule_tac allI) apply(rule,rule) apply(rule divide_nonneg_pos) using nn Suc(2) ** by auto
9.456 + hence "(1 - u (Suc k)) *\<^sub>R (\<Sum>i = 1..k. (u i / (1 - u (Suc k))) *\<^sub>R x i) + u (Suc k) *\<^sub>R x (Suc k) \<in> s"
9.457 + apply(rule as[THEN bspec, THEN bspec, THEN spec, THEN mp, THEN spec, THEN mp, THEN mp]) using Suc(2)[THEN spec[where x="Suc k"]] and ** by auto
9.458 + thus ?thesis unfolding setsum_cl_ivl_Suc and *** and scaleR_right.setsum [symmetric] using nn by auto qed qed auto qed
9.459 +
9.460 +
9.461 +lemma convex_explicit:
9.462 + fixes s :: "'a::real_vector set"
9.463 + shows "convex s \<longleftrightarrow>
9.464 + (\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) t \<in> s)"
9.465 + unfolding convex_def apply(rule,rule,rule) apply(subst imp_conjL,rule) defer apply(rule,rule,rule,rule,rule,rule,rule) proof-
9.466 + fix x y u v assume as:"\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
9.467 + show "u *\<^sub>R x + v *\<^sub>R y \<in> s" proof(cases "x=y")
9.468 + case True show ?thesis unfolding True and scaleR_left_distrib[THEN sym] using as(3,6) by auto next
9.469 + case False thus ?thesis using as(1)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>z. if z=x then u else v"]] and as(2-) by auto qed
9.470 +next
9.471 + fix t u assume asm:"\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s" "finite (t::'a set)"
9.472 + (*"finite t" "t \<subseteq> s" "\<forall>x\<in>t. (0::real) \<le> u x" "setsum u t = 1"*)
9.473 + from this(2) have "\<forall>u. t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" apply(induct_tac t rule:finite_induct)
9.474 + prefer 3 apply (rule,rule) apply(erule conjE)+ proof-
9.475 + fix x f u assume ind:"\<forall>u. f \<subseteq> s \<and> (\<forall>x\<in>f. 0 \<le> u x) \<and> setsum u f = 1 \<longrightarrow> (\<Sum>x\<in>f. u x *\<^sub>R x) \<in> s"
9.476 + assume as:"finite f" "x \<notin> f" "insert x f \<subseteq> s" "\<forall>x\<in>insert x f. 0 \<le> u x" "setsum u (insert x f) = (1::real)"
9.477 + show "(\<Sum>x\<in>insert x f. u x *\<^sub>R x) \<in> s" proof(cases "u x = 1")
9.478 + case True hence "setsum (\<lambda>x. u x *\<^sub>R x) f = 0" apply(rule_tac setsum_0') apply(rule ccontr) unfolding ball_simps apply(erule bexE) proof-
9.479 + fix y assume y:"y \<in> f" "u y *\<^sub>R y \<noteq> 0"
9.480 + hence uy:"u y \<noteq> 0" by auto
9.481 + hence "setsum (\<lambda>k. if k=y then u y else 0) f \<le> setsum u f" apply(rule_tac setsum_mono) using as(4) by auto
9.482 + hence "setsum u f \<ge> u y" using y(1) and as(1) by(auto simp add: setsum_delta)
9.483 + hence "setsum u f > 0" using uy apply(rule_tac less_le_trans[of _ "u y"]) using as(4) and y(1) by auto
9.484 + thus False using as(2,5) unfolding setsum_clauses(2)[OF as(1)] and True by auto qed
9.485 + thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2,3) unfolding True by auto
9.486 + next
9.487 + have *:"setsum u f = setsum u (insert x f) - u x" using as(2) unfolding setsum_clauses(2)[OF as(1)] by auto
9.488 + have **:"u x \<le> 1" apply(rule ccontr) unfolding not_le using as(5)[unfolded setsum_clauses(2)[OF as(1)]] and as(2)
9.489 + using setsum_nonneg[of f u] and as(4) by auto
9.490 + case False hence "inverse (1 - u x) *\<^sub>R (\<Sum>x\<in>f. u x *\<^sub>R x) \<in> s" unfolding scaleR_right.setsum and scaleR_scaleR
9.491 + apply(rule_tac ind[THEN spec, THEN mp]) apply rule defer apply rule apply rule apply(rule mult_nonneg_nonneg)
9.492 + unfolding setsum_right_distrib[THEN sym] and * using as and ** by auto
9.493 + hence "u x *\<^sub>R x + (1 - u x) *\<^sub>R ((inverse (1 - u x)) *\<^sub>R setsum (\<lambda>x. u x *\<^sub>R x) f) \<in>s"
9.494 + apply(rule_tac asm(1)[THEN bspec, THEN bspec, THEN spec, THEN mp, THEN spec, THEN mp, THEN mp]) using as and ** False by auto
9.495 + thus ?thesis unfolding setsum_clauses(2)[OF as(1)] using as(2) and False by auto qed
9.496 + qed auto thus "t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> setsum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" by auto
9.497 +qed
9.498 +
9.499 +lemma convex_finite: assumes "finite s"
9.500 + shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1
9.501 + \<longrightarrow> setsum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
9.502 + unfolding convex_explicit apply(rule, rule, rule) defer apply(rule,rule,rule)apply(erule conjE)+ proof-
9.503 + fix t u assume as:"\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> s" " finite t" "t \<subseteq> s" "\<forall>x\<in>t. 0 \<le> u x" "setsum u t = (1::real)"
9.504 + have *:"s \<inter> t = t" using as(3) by auto
9.505 + show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s" using as(1)[THEN spec[where x="\<lambda>x. if x\<in>t then u x else 0"]]
9.506 + unfolding if_smult and setsum_cases[OF assms] and * using as(2-) by auto
9.507 +qed (erule_tac x=s in allE, erule_tac x=u in allE, auto)
9.508 +
9.509 +subsection {* Cones. *}
9.510 +
9.511 +definition
9.512 + cone :: "'a::real_vector set \<Rightarrow> bool" where
9.513 + "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
9.514 +
9.515 +lemma cone_empty[intro, simp]: "cone {}"
9.516 + unfolding cone_def by auto
9.517 +
9.518 +lemma cone_univ[intro, simp]: "cone UNIV"
9.519 + unfolding cone_def by auto
9.520 +
9.521 +lemma cone_Inter[intro]: "(\<forall>s\<in>f. cone s) \<Longrightarrow> cone(\<Inter> f)"
9.522 + unfolding cone_def by auto
9.523 +
9.524 +subsection {* Conic hull. *}
9.525 +
9.526 +lemma cone_cone_hull: "cone (cone hull s)"
9.527 + unfolding hull_def using cone_Inter[of "{t \<in> conic. s \<subseteq> t}"]
9.528 + by (auto simp add: mem_def)
9.529 +
9.530 +lemma cone_hull_eq: "(cone hull s = s) \<longleftrightarrow> cone s"
9.531 + apply(rule hull_eq[unfolded mem_def])
9.532 + using cone_Inter unfolding subset_eq by (auto simp add: mem_def)
9.533 +
9.534 +subsection {* Affine dependence and consequential theorems (from Lars Schewe). *}
9.535 +
9.536 +definition
9.537 + affine_dependent :: "'a::real_vector set \<Rightarrow> bool" where
9.538 + "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> (affine hull (s - {x})))"
9.539 +
9.540 +lemma affine_dependent_explicit:
9.541 + "affine_dependent p \<longleftrightarrow>
9.542 + (\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and>
9.543 + (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
9.544 + unfolding affine_dependent_def affine_hull_explicit mem_Collect_eq apply(rule)
9.545 + apply(erule bexE,erule exE,erule exE) apply(erule conjE)+ defer apply(erule exE,erule exE) apply(erule conjE)+ apply(erule bexE)
9.546 +proof-
9.547 + fix x s u assume as:"x \<in> p" "finite s" "s \<noteq> {}" "s \<subseteq> p - {x}" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.548 + have "x\<notin>s" using as(1,4) by auto
9.549 + show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
9.550 + apply(rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
9.551 + unfolding if_smult and setsum_clauses(2)[OF as(2)] and setsum_delta_notmem[OF `x\<notin>s`] and as using as by auto
9.552 +next
9.553 + fix s u v assume as:"finite s" "s \<subseteq> p" "setsum u s = 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" "v \<in> s" "u v \<noteq> 0"
9.554 + have "s \<noteq> {v}" using as(3,6) by auto
9.555 + thus "\<exists>x\<in>p. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p - {x} \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.556 + apply(rule_tac x=v in bexI, rule_tac x="s - {v}" in exI, rule_tac x="\<lambda>x. - (1 / u v) * u x" in exI)
9.557 + unfolding scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] unfolding setsum_right_distrib[THEN sym] and setsum_diff1[OF as(1)] using as by auto
9.558 +qed
9.559 +
9.560 +lemma affine_dependent_explicit_finite:
9.561 + fixes s :: "'a::real_vector set" assumes "finite s"
9.562 + shows "affine_dependent s \<longleftrightarrow> (\<exists>u. setsum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = 0)"
9.563 + (is "?lhs = ?rhs")
9.564 +proof
9.565 + have *:"\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else (0::'a))" by auto
9.566 + assume ?lhs
9.567 + then obtain t u v where "finite t" "t \<subseteq> s" "setsum u t = 0" "v\<in>t" "u v \<noteq> 0" "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
9.568 + unfolding affine_dependent_explicit by auto
9.569 + thus ?rhs apply(rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
9.570 + apply auto unfolding * and setsum_restrict_set[OF assms, THEN sym]
9.571 + unfolding Int_absorb1[OF `t\<subseteq>s`] by auto
9.572 +next
9.573 + assume ?rhs
9.574 + then obtain u v where "setsum u s = 0" "v\<in>s" "u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" by auto
9.575 + thus ?lhs unfolding affine_dependent_explicit using assms by auto
9.576 +qed
9.577 +
9.578 +subsection {* A general lemma. *}
9.579 +
9.580 +lemma convex_connected:
9.581 + fixes s :: "'a::real_normed_vector set"
9.582 + assumes "convex s" shows "connected s"
9.583 +proof-
9.584 + { fix e1 e2 assume as:"open e1" "open e2" "e1 \<inter> e2 \<inter> s = {}" "s \<subseteq> e1 \<union> e2"
9.585 + assume "e1 \<inter> s \<noteq> {}" "e2 \<inter> s \<noteq> {}"
9.586 + then obtain x1 x2 where x1:"x1\<in>e1" "x1\<in>s" and x2:"x2\<in>e2" "x2\<in>s" by auto
9.587 + hence n:"norm (x1 - x2) > 0" unfolding zero_less_norm_iff using as(3) by auto
9.588 +
9.589 + { fix x e::real assume as:"0 \<le> x" "x \<le> 1" "0 < e"
9.590 + { fix y have *:"(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2) = (y - x) *\<^sub>R x1 - (y - x) *\<^sub>R x2"
9.591 + by (simp add: algebra_simps)
9.592 + assume "\<bar>y - x\<bar> < e / norm (x1 - x2)"
9.593 + hence "norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
9.594 + unfolding * and scaleR_right_diff_distrib[THEN sym]
9.595 + unfolding less_divide_eq using n by auto }
9.596 + hence "\<exists>d>0. \<forall>y. \<bar>y - x\<bar> < d \<longrightarrow> norm ((1 - x) *\<^sub>R x1 + x *\<^sub>R x2 - ((1 - y) *\<^sub>R x1 + y *\<^sub>R x2)) < e"
9.597 + apply(rule_tac x="e / norm (x1 - x2)" in exI) using as
9.598 + apply auto unfolding zero_less_divide_iff using n by simp } note * = this
9.599 +
9.600 + have "\<exists>x\<ge>0. x \<le> 1 \<and> (1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e1 \<and> (1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e2"
9.601 + apply(rule connected_real_lemma) apply (simp add: `x1\<in>e1` `x2\<in>e2` dist_commute)+
9.602 + using * apply(simp add: dist_norm)
9.603 + using as(1,2)[unfolded open_dist] apply simp
9.604 + using as(1,2)[unfolded open_dist] apply simp
9.605 + using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]] using x1 x2
9.606 + using as(3) by auto
9.607 + then obtain x where "x\<ge>0" "x\<le>1" "(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e1" "(1 - x) *\<^sub>R x1 + x *\<^sub>R x2 \<notin> e2" by auto
9.608 + hence False using as(4)
9.609 + using assms[unfolded convex_alt, THEN bspec[where x=x1], THEN bspec[where x=x2]]
9.610 + using x1(2) x2(2) by auto }
9.611 + thus ?thesis unfolding connected_def by auto
9.612 +qed
9.613 +
9.614 +subsection {* One rather trivial consequence. *}
9.615 +
9.616 +lemma connected_UNIV: "connected (UNIV :: 'a::real_normed_vector set)"
9.617 + by(simp add: convex_connected convex_UNIV)
9.618 +
9.619 +subsection {* Convex functions into the reals. *}
9.620 +
9.621 +definition
9.622 + convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool" where
9.623 + "convex_on s f \<longleftrightarrow>
9.624 + (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y)"
9.625 +
9.626 +lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
9.627 + unfolding convex_on_def by auto
9.628 +
9.629 +lemma convex_add:
9.630 + assumes "convex_on s f" "convex_on s g"
9.631 + shows "convex_on s (\<lambda>x. f x + g x)"
9.632 +proof-
9.633 + { fix x y assume "x\<in>s" "y\<in>s" moreover
9.634 + fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
9.635 + ultimately have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> (u * f x + v * f y) + (u * g x + v * g y)"
9.636 + using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
9.637 + using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
9.638 + apply - apply(rule add_mono) by auto
9.639 + hence "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> u * (f x + g x) + v * (f y + g y)" by (simp add: ring_simps) }
9.640 + thus ?thesis unfolding convex_on_def by auto
9.641 +qed
9.642 +
9.643 +lemma convex_cmul:
9.644 + assumes "0 \<le> (c::real)" "convex_on s f"
9.645 + shows "convex_on s (\<lambda>x. c * f x)"
9.646 +proof-
9.647 + have *:"\<And>u c fx v fy ::real. u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)" by (simp add: ring_simps)
9.648 + show ?thesis using assms(2) and mult_mono1[OF _ assms(1)] unfolding convex_on_def and * by auto
9.649 +qed
9.650 +
9.651 +lemma convex_lower:
9.652 + assumes "convex_on s f" "x\<in>s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = 1"
9.653 + shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
9.654 +proof-
9.655 + let ?m = "max (f x) (f y)"
9.656 + have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)" apply(rule add_mono)
9.657 + using assms(4,5) by(auto simp add: mult_mono1)
9.658 + also have "\<dots> = max (f x) (f y)" using assms(6) unfolding distrib[THEN sym] by auto
9.659 + finally show ?thesis using assms(1)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x=u]]
9.660 + using assms(2-6) by auto
9.661 +qed
9.662 +
9.663 +lemma convex_local_global_minimum:
9.664 + fixes s :: "'a::real_normed_vector set"
9.665 + assumes "0<e" "convex_on s f" "ball x e \<subseteq> s" "\<forall>y\<in>ball x e. f x \<le> f y"
9.666 + shows "\<forall>y\<in>s. f x \<le> f y"
9.667 +proof(rule ccontr)
9.668 + have "x\<in>s" using assms(1,3) by auto
9.669 + assume "\<not> (\<forall>y\<in>s. f x \<le> f y)"
9.670 + then obtain y where "y\<in>s" and y:"f x > f y" by auto
9.671 + hence xy:"0 < dist x y" by (auto simp add: dist_nz[THEN sym])
9.672 +
9.673 + then obtain u where "0 < u" "u \<le> 1" and u:"u < e / dist x y"
9.674 + using real_lbound_gt_zero[of 1 "e / dist x y"] using xy `e>0` and divide_pos_pos[of e "dist x y"] by auto
9.675 + hence "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \<le> (1-u) * f x + u * f y" using `x\<in>s` `y\<in>s`
9.676 + using assms(2)[unfolded convex_on_def, THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x="1-u"]] by auto
9.677 + moreover
9.678 + have *:"x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)" by (simp add: algebra_simps)
9.679 + have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> ball x e" unfolding mem_ball dist_norm unfolding * and norm_scaleR and abs_of_pos[OF `0<u`] unfolding dist_norm[THEN sym]
9.680 + using u unfolding pos_less_divide_eq[OF xy] by auto
9.681 + hence "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)" using assms(4) by auto
9.682 + ultimately show False using mult_strict_left_mono[OF y `u>0`] unfolding left_diff_distrib by auto
9.683 +qed
9.684 +
9.685 +lemma convex_distance:
9.686 + fixes s :: "'a::real_normed_vector set"
9.687 + shows "convex_on s (\<lambda>x. dist a x)"
9.688 +proof(auto simp add: convex_on_def dist_norm)
9.689 + fix x y assume "x\<in>s" "y\<in>s"
9.690 + fix u v ::real assume "0 \<le> u" "0 \<le> v" "u + v = 1"
9.691 + have "a = u *\<^sub>R a + v *\<^sub>R a" unfolding scaleR_left_distrib[THEN sym] and `u+v=1` by simp
9.692 + hence *:"a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
9.693 + by (auto simp add: algebra_simps)
9.694 + show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
9.695 + unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
9.696 + using `0 \<le> u` `0 \<le> v` by auto
9.697 +qed
9.698 +
9.699 +subsection {* Arithmetic operations on sets preserve convexity. *}
9.700 +
9.701 +lemma convex_scaling: "convex s \<Longrightarrow> convex ((\<lambda>x. c *\<^sub>R x) ` s)"
9.702 + unfolding convex_def and image_iff apply auto
9.703 + apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by (auto simp add: algebra_simps)
9.704 +
9.705 +lemma convex_negations: "convex s \<Longrightarrow> convex ((\<lambda>x. -x)` s)"
9.706 + unfolding convex_def and image_iff apply auto
9.707 + apply (rule_tac x="u *\<^sub>R x+v *\<^sub>R y" in bexI) by auto
9.708 +
9.709 +lemma convex_sums:
9.710 + assumes "convex s" "convex t"
9.711 + shows "convex {x + y| x y. x \<in> s \<and> y \<in> t}"
9.712 +proof(auto simp add: convex_def image_iff scaleR_right_distrib)
9.713 + fix xa xb ya yb assume xy:"xa\<in>s" "xb\<in>s" "ya\<in>t" "yb\<in>t"
9.714 + fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
9.715 + show "\<exists>x y. u *\<^sub>R xa + u *\<^sub>R ya + (v *\<^sub>R xb + v *\<^sub>R yb) = x + y \<and> x \<in> s \<and> y \<in> t"
9.716 + apply(rule_tac x="u *\<^sub>R xa + v *\<^sub>R xb" in exI) apply(rule_tac x="u *\<^sub>R ya + v *\<^sub>R yb" in exI)
9.717 + using assms(1)[unfolded convex_def, THEN bspec[where x=xa], THEN bspec[where x=xb]]
9.718 + using assms(2)[unfolded convex_def, THEN bspec[where x=ya], THEN bspec[where x=yb]]
9.719 + using uv xy by auto
9.720 +qed
9.721 +
9.722 +lemma convex_differences:
9.723 + assumes "convex s" "convex t"
9.724 + shows "convex {x - y| x y. x \<in> s \<and> y \<in> t}"
9.725 +proof-
9.726 + have "{x - y| x y. x \<in> s \<and> y \<in> t} = {x + y |x y. x \<in> s \<and> y \<in> uminus ` t}" unfolding image_iff apply auto
9.727 + apply(rule_tac x=xa in exI) apply(rule_tac x="-y" in exI) apply simp
9.728 + apply(rule_tac x=xa in exI) apply(rule_tac x=xb in exI) by simp
9.729 + thus ?thesis using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
9.730 +qed
9.731 +
9.732 +lemma convex_translation: assumes "convex s" shows "convex ((\<lambda>x. a + x) ` s)"
9.733 +proof- have "{a + y |y. y \<in> s} = (\<lambda>x. a + x) ` s" by auto
9.734 + thus ?thesis using convex_sums[OF convex_singleton[of a] assms] by auto qed
9.735 +
9.736 +lemma convex_affinity: assumes "convex s" shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` s)"
9.737 +proof- have "(\<lambda>x. a + c *\<^sub>R x) ` s = op + a ` op *\<^sub>R c ` s" by auto
9.738 + thus ?thesis using convex_translation[OF convex_scaling[OF assms], of a c] by auto qed
9.739 +
9.740 +lemma convex_linear_image:
9.741 + assumes c:"convex s" and l:"bounded_linear f"
9.742 + shows "convex(f ` s)"
9.743 +proof(auto simp add: convex_def)
9.744 + interpret f: bounded_linear f by fact
9.745 + fix x y assume xy:"x \<in> s" "y \<in> s"
9.746 + fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
9.747 + show "u *\<^sub>R f x + v *\<^sub>R f y \<in> f ` s" unfolding image_iff
9.748 + apply(rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in bexI)
9.749 + unfolding f.add f.scaleR
9.750 + using c[unfolded convex_def] xy uv by auto
9.751 +qed
9.752 +
9.753 +subsection {* Balls, being convex, are connected. *}
9.754 +
9.755 +lemma convex_ball:
9.756 + fixes x :: "'a::real_normed_vector"
9.757 + shows "convex (ball x e)"
9.758 +proof(auto simp add: convex_def)
9.759 + fix y z assume yz:"dist x y < e" "dist x z < e"
9.760 + fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
9.761 + have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
9.762 + using convex_distance[of "ball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
9.763 + thus "dist x (u *\<^sub>R y + v *\<^sub>R z) < e" using real_convex_bound_lt[OF yz uv] by auto
9.764 +qed
9.765 +
9.766 +lemma convex_cball:
9.767 + fixes x :: "'a::real_normed_vector"
9.768 + shows "convex(cball x e)"
9.769 +proof(auto simp add: convex_def Ball_def mem_cball)
9.770 + fix y z assume yz:"dist x y \<le> e" "dist x z \<le> e"
9.771 + fix u v ::real assume uv:" 0 \<le> u" "0 \<le> v" "u + v = 1"
9.772 + have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z" using uv yz
9.773 + using convex_distance[of "cball x e" x, unfolded convex_on_def, THEN bspec[where x=y], THEN bspec[where x=z]] by auto
9.774 + thus "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e" using real_convex_bound_le[OF yz uv] by auto
9.775 +qed
9.776 +
9.777 +lemma connected_ball:
9.778 + fixes x :: "'a::real_normed_vector"
9.779 + shows "connected (ball x e)"
9.780 + using convex_connected convex_ball by auto
9.781 +
9.782 +lemma connected_cball:
9.783 + fixes x :: "'a::real_normed_vector"
9.784 + shows "connected(cball x e)"
9.785 + using convex_connected convex_cball by auto
9.786 +
9.787 +subsection {* Convex hull. *}
9.788 +
9.789 +lemma convex_convex_hull: "convex(convex hull s)"
9.790 + unfolding hull_def using convex_Inter[of "{t\<in>convex. s\<subseteq>t}"]
9.791 + unfolding mem_def by auto
9.792 +
9.793 +lemma convex_hull_eq: "(convex hull s = s) \<longleftrightarrow> convex s" apply(rule hull_eq[unfolded mem_def])
9.794 + using convex_Inter[unfolded Ball_def mem_def] by auto
9.795 +
9.796 +lemma bounded_convex_hull:
9.797 + fixes s :: "'a::real_normed_vector set"
9.798 + assumes "bounded s" shows "bounded(convex hull s)"
9.799 +proof- from assms obtain B where B:"\<forall>x\<in>s. norm x \<le> B" unfolding bounded_iff by auto
9.800 + show ?thesis apply(rule bounded_subset[OF bounded_cball, of _ 0 B])
9.801 + unfolding subset_hull[unfolded mem_def, of convex, OF convex_cball]
9.802 + unfolding subset_eq mem_cball dist_norm using B by auto qed
9.803 +
9.804 +lemma finite_imp_bounded_convex_hull:
9.805 + fixes s :: "'a::real_normed_vector set"
9.806 + shows "finite s \<Longrightarrow> bounded(convex hull s)"
9.807 + using bounded_convex_hull finite_imp_bounded by auto
9.808 +
9.809 +subsection {* Stepping theorems for convex hulls of finite sets. *}
9.810 +
9.811 +lemma convex_hull_empty[simp]: "convex hull {} = {}"
9.812 + apply(rule hull_unique) unfolding mem_def by auto
9.813 +
9.814 +lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
9.815 + apply(rule hull_unique) unfolding mem_def by auto
9.816 +
9.817 +lemma convex_hull_insert:
9.818 + fixes s :: "'a::real_vector set"
9.819 + assumes "s \<noteq> {}"
9.820 + shows "convex hull (insert a s) = {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and>
9.821 + b \<in> (convex hull s) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}" (is "?xyz = ?hull")
9.822 + apply(rule,rule hull_minimal,rule) unfolding mem_def[of _ convex] and insert_iff prefer 3 apply rule proof-
9.823 + fix x assume x:"x = a \<or> x \<in> s"
9.824 + thus "x\<in>?hull" apply rule unfolding mem_Collect_eq apply(rule_tac x=1 in exI) defer
9.825 + apply(rule_tac x=0 in exI) using assms hull_subset[of s convex] by auto
9.826 +next
9.827 + fix x assume "x\<in>?hull"
9.828 + then obtain u v b where obt:"u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "x = u *\<^sub>R a + v *\<^sub>R b" by auto
9.829 + have "a\<in>convex hull insert a s" "b\<in>convex hull insert a s"
9.830 + using hull_mono[of s "insert a s" convex] hull_mono[of "{a}" "insert a s" convex] and obt(4) by auto
9.831 + thus "x\<in> convex hull insert a s" unfolding obt(5) using convex_convex_hull[of "insert a s", unfolded convex_def]
9.832 + apply(erule_tac x=a in ballE) apply(erule_tac x=b in ballE) apply(erule_tac x=u in allE) using obt by auto
9.833 +next
9.834 + show "convex ?hull" unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
9.835 + fix x y u v assume as:"(0::real) \<le> u" "0 \<le> v" "u + v = 1" "x\<in>?hull" "y\<in>?hull"
9.836 + from as(4) obtain u1 v1 b1 where obt1:"u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull s" "x = u1 *\<^sub>R a + v1 *\<^sub>R b1" by auto
9.837 + from as(5) obtain u2 v2 b2 where obt2:"u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull s" "y = u2 *\<^sub>R a + v2 *\<^sub>R b2" by auto
9.838 + have *:"\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp add: algebra_simps)
9.839 + have "\<exists>b \<in> convex hull s. u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"
9.840 + proof(cases "u * v1 + v * v2 = 0")
9.841 + have *:"\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x" by (auto simp add: algebra_simps)
9.842 + case True hence **:"u * v1 = 0" "v * v2 = 0" apply- apply(rule_tac [!] ccontr)
9.843 + using mult_nonneg_nonneg[OF `u\<ge>0` `v1\<ge>0`] mult_nonneg_nonneg[OF `v\<ge>0` `v2\<ge>0`] by auto
9.844 + hence "u * u1 + v * u2 = 1" using as(3) obt1(3) obt2(3) by auto
9.845 + thus ?thesis unfolding obt1(5) obt2(5) * using assms hull_subset[of s convex] by(auto simp add: ** scaleR_right_distrib)
9.846 + next
9.847 + have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
9.848 + also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)" using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
9.849 + also have "\<dots> = u * v1 + v * v2" by simp finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
9.850 + case False have "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2" apply -
9.851 + apply(rule add_nonneg_nonneg) prefer 4 apply(rule add_nonneg_nonneg) apply(rule_tac [!] mult_nonneg_nonneg)
9.852 + using as(1,2) obt1(1,2) obt2(1,2) by auto
9.853 + thus ?thesis unfolding obt1(5) obt2(5) unfolding * and ** using False
9.854 + apply(rule_tac x="((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2" in bexI) defer
9.855 + apply(rule convex_convex_hull[of s, unfolded convex_def, rule_format]) using obt1(4) obt2(4)
9.856 + unfolding add_divide_distrib[THEN sym] and real_0_le_divide_iff
9.857 + by (auto simp add: scaleR_left_distrib scaleR_right_distrib)
9.858 + qed note * = this
9.859 + have u1:"u1 \<le> 1" apply(rule ccontr) unfolding obt1(3)[THEN sym] and not_le using obt1(2) by auto
9.860 + have u2:"u2 \<le> 1" apply(rule ccontr) unfolding obt2(3)[THEN sym] and not_le using obt2(2) by auto
9.861 + have "u1 * u + u2 * v \<le> (max u1 u2) * u + (max u1 u2) * v" apply(rule add_mono)
9.862 + apply(rule_tac [!] mult_right_mono) using as(1,2) obt1(1,2) obt2(1,2) by auto
9.863 + also have "\<dots> \<le> 1" unfolding mult.add_right[THEN sym] and as(3) using u1 u2 by auto
9.864 + finally
9.865 + show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" unfolding mem_Collect_eq apply(rule_tac x="u * u1 + v * u2" in exI)
9.866 + apply(rule conjI) defer apply(rule_tac x="1 - u * u1 - v * u2" in exI) unfolding Bex_def
9.867 + using as(1,2) obt1(1,2) obt2(1,2) * by(auto intro!: mult_nonneg_nonneg add_nonneg_nonneg simp add: algebra_simps)
9.868 + qed
9.869 +qed
9.870 +
9.871 +
9.872 +subsection {* Explicit expression for convex hull. *}
9.873 +
9.874 +lemma convex_hull_indexed:
9.875 + fixes s :: "'a::real_vector set"
9.876 + shows "convex hull s = {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> s) \<and>
9.877 + (setsum u {1..k} = 1) \<and>
9.878 + (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} = y)}" (is "?xyz = ?hull")
9.879 + apply(rule hull_unique) unfolding mem_def[of _ convex] apply(rule) defer
9.880 + apply(subst convex_def) apply(rule,rule,rule,rule,rule,rule,rule)
9.881 +proof-
9.882 + fix x assume "x\<in>s"
9.883 + thus "x \<in> ?hull" unfolding mem_Collect_eq apply(rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI) by auto
9.884 +next
9.885 + fix t assume as:"s \<subseteq> t" "convex t"
9.886 + show "?hull \<subseteq> t" apply(rule) unfolding mem_Collect_eq apply(erule exE | erule conjE)+ proof-
9.887 + fix x k u y assume assm:"\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> s" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
9.888 + show "x\<in>t" unfolding assm(3)[THEN sym] apply(rule as(2)[unfolded convex, rule_format])
9.889 + using assm(1,2) as(1) by auto qed
9.890 +next
9.891 + fix x y u v assume uv:"0\<le>u" "0\<le>v" "u+v=(1::real)" and xy:"x\<in>?hull" "y\<in>?hull"
9.892 + from xy obtain k1 u1 x1 where x:"\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> s" "setsum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x" by auto
9.893 + from xy obtain k2 u2 x2 where y:"\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> s" "setsum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y" by auto
9.894 + have *:"\<And>P (x1::'a) x2 s1 s2 i.(if P i then s1 else s2) *\<^sub>R (if P i then x1 else x2) = (if P i then s1 *\<^sub>R x1 else s2 *\<^sub>R x2)"
9.895 + "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
9.896 + prefer 3 apply(rule,rule) unfolding image_iff apply(rule_tac x="x - k1" in bexI) by(auto simp add: not_le)
9.897 + have inj:"inj_on (\<lambda>i. i + k1) {1..k2}" unfolding inj_on_def by auto
9.898 + show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull" apply(rule)
9.899 + apply(rule_tac x="k1 + k2" in exI, rule_tac x="\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)" in exI)
9.900 + apply(rule_tac x="\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)" in exI) apply(rule,rule) defer apply(rule)
9.901 + unfolding * and setsum_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]] and setsum_reindex[OF inj] and o_def
9.902 + unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] setsum_right_distrib[THEN sym] proof-
9.903 + fix i assume i:"i \<in> {1..k1+k2}"
9.904 + show "0 \<le> (if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)) \<and> (if i \<in> {1..k1} then x1 i else x2 (i - k1)) \<in> s"
9.905 + proof(cases "i\<in>{1..k1}")
9.906 + case True thus ?thesis using mult_nonneg_nonneg[of u "u1 i"] and uv(1) x(1)[THEN bspec[where x=i]] by auto
9.907 + next def j \<equiv> "i - k1"
9.908 + case False with i have "j \<in> {1..k2}" unfolding j_def by auto
9.909 + thus ?thesis unfolding j_def[symmetric] using False
9.910 + using mult_nonneg_nonneg[of v "u2 j"] and uv(2) y(1)[THEN bspec[where x=j]] by auto qed
9.911 + qed(auto simp add: not_le x(2,3) y(2,3) uv(3))
9.912 +qed
9.913 +
9.914 +lemma convex_hull_finite:
9.915 + fixes s :: "'a::real_vector set"
9.916 + assumes "finite s"
9.917 + shows "convex hull s = {y. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and>
9.918 + setsum u s = 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y}" (is "?HULL = ?set")
9.919 +proof(rule hull_unique, auto simp add: mem_def[of _ convex] convex_def[of ?set])
9.920 + fix x assume "x\<in>s" thus " \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = x"
9.921 + apply(rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) apply auto
9.922 + unfolding setsum_delta'[OF assms] and setsum_delta''[OF assms] by auto
9.923 +next
9.924 + fix u v ::real assume uv:"0 \<le> u" "0 \<le> v" "u + v = 1"
9.925 + fix ux assume ux:"\<forall>x\<in>s. 0 \<le> ux x" "setsum ux s = (1::real)"
9.926 + fix uy assume uy:"\<forall>x\<in>s. 0 \<le> uy x" "setsum uy s = (1::real)"
9.927 + { fix x assume "x\<in>s"
9.928 + hence "0 \<le> u * ux x + v * uy x" using ux(1)[THEN bspec[where x=x]] uy(1)[THEN bspec[where x=x]] and uv(1,2)
9.929 + by (auto, metis add_nonneg_nonneg mult_nonneg_nonneg uv(1) uv(2)) }
9.930 + moreover have "(\<Sum>x\<in>s. u * ux x + v * uy x) = 1"
9.931 + unfolding setsum_addf and setsum_right_distrib[THEN sym] and ux(2) uy(2) using uv(3) by auto
9.932 + moreover have "(\<Sum>x\<in>s. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
9.933 + unfolding scaleR_left_distrib and setsum_addf and scaleR_scaleR[THEN sym] and scaleR_right.setsum [symmetric] by auto
9.934 + ultimately show "\<exists>uc. (\<forall>x\<in>s. 0 \<le> uc x) \<and> setsum uc s = 1 \<and> (\<Sum>x\<in>s. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
9.935 + apply(rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI) by auto
9.936 +next
9.937 + fix t assume t:"s \<subseteq> t" "convex t"
9.938 + fix u assume u:"\<forall>x\<in>s. 0 \<le> u x" "setsum u s = (1::real)"
9.939 + thus "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> t" using t(2)[unfolded convex_explicit, THEN spec[where x=s], THEN spec[where x=u]]
9.940 + using assms and t(1) by auto
9.941 +qed
9.942 +
9.943 +subsection {* Another formulation from Lars Schewe. *}
9.944 +
9.945 +lemma setsum_constant_scaleR:
9.946 + fixes y :: "'a::real_vector"
9.947 + shows "(\<Sum>x\<in>A. y) = of_nat (card A) *\<^sub>R y"
9.948 +apply (cases "finite A")
9.949 +apply (induct set: finite)
9.950 +apply (simp_all add: algebra_simps)
9.951 +done
9.952 +
9.953 +lemma convex_hull_explicit:
9.954 + fixes p :: "'a::real_vector set"
9.955 + shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and>
9.956 + (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}" (is "?lhs = ?rhs")
9.957 +proof-
9.958 + { fix x assume "x\<in>?lhs"
9.959 + then obtain k u y where obt:"\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> p" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
9.960 + unfolding convex_hull_indexed by auto
9.961 +
9.962 + have fin:"finite {1..k}" by auto
9.963 + have fin':"\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
9.964 + { fix j assume "j\<in>{1..k}"
9.965 + hence "y j \<in> p" "0 \<le> setsum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
9.966 + using obt(1)[THEN bspec[where x=j]] and obt(2) apply simp
9.967 + apply(rule setsum_nonneg) using obt(1) by auto }
9.968 + moreover
9.969 + have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v}) = 1"
9.970 + unfolding setsum_image_gen[OF fin, THEN sym] using obt(2) by auto
9.971 + moreover have "(\<Sum>v\<in>y ` {1..k}. setsum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
9.972 + using setsum_image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, THEN sym]
9.973 + unfolding scaleR_left.setsum using obt(3) by auto
9.974 + ultimately have "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
9.975 + apply(rule_tac x="y ` {1..k}" in exI)
9.976 + apply(rule_tac x="\<lambda>v. setsum u {i\<in>{1..k}. y i = v}" in exI) by auto
9.977 + hence "x\<in>?rhs" by auto }
9.978 + moreover
9.979 + { fix y assume "y\<in>?rhs"
9.980 + then obtain s u where obt:"finite s" "s \<subseteq> p" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
9.981 +
9.982 + obtain f where f:"inj_on f {1..card s}" "f ` {1..card s} = s" using ex_bij_betw_nat_finite_1[OF obt(1)] unfolding bij_betw_def by auto
9.983 +
9.984 + { fix i::nat assume "i\<in>{1..card s}"
9.985 + hence "f i \<in> s" apply(subst f(2)[THEN sym]) by auto
9.986 + hence "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto }
9.987 + moreover have *:"finite {1..card s}" by auto
9.988 + { fix y assume "y\<in>s"
9.989 + then obtain i where "i\<in>{1..card s}" "f i = y" using f using image_iff[of y f "{1..card s}"] by auto
9.990 + hence "{x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = {i}" apply auto using f(1)[unfolded inj_on_def] apply(erule_tac x=x in ballE) by auto
9.991 + hence "card {x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = 1" by auto
9.992 + hence "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x)) = u y"
9.993 + "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
9.994 + by (auto simp add: setsum_constant_scaleR) }
9.995 +
9.996 + hence "(\<Sum>x = 1..card s. u (f x)) = 1" "(\<Sum>i = 1..card s. u (f i) *\<^sub>R f i) = y"
9.997 + unfolding setsum_image_gen[OF *(1), of "\<lambda>x. u (f x) *\<^sub>R f x" f] and setsum_image_gen[OF *(1), of "\<lambda>x. u (f x)" f]
9.998 + unfolding f using setsum_cong2[of s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
9.999 + using setsum_cong2 [of s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x))" u] unfolding obt(4,5) by auto
9.1000 +
9.1001 + ultimately have "\<exists>k u x. (\<forall>i\<in>{1..k}. 0 \<le> u i \<and> x i \<in> p) \<and> setsum u {1..k} = 1 \<and> (\<Sum>i::nat = 1..k. u i *\<^sub>R x i) = y"
9.1002 + apply(rule_tac x="card s" in exI) apply(rule_tac x="u \<circ> f" in exI) apply(rule_tac x=f in exI) by fastsimp
9.1003 + hence "y \<in> ?lhs" unfolding convex_hull_indexed by auto }
9.1004 + ultimately show ?thesis unfolding expand_set_eq by blast
9.1005 +qed
9.1006 +
9.1007 +subsection {* A stepping theorem for that expansion. *}
9.1008 +
9.1009 +lemma convex_hull_finite_step:
9.1010 + fixes s :: "'a::real_vector set" assumes "finite s"
9.1011 + shows "(\<exists>u. (\<forall>x\<in>insert a s. 0 \<le> u x) \<and> setsum u (insert a s) = w \<and> setsum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y)
9.1012 + \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = w - v \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "?lhs = ?rhs")
9.1013 +proof(rule, case_tac[!] "a\<in>s")
9.1014 + assume "a\<in>s" hence *:"insert a s = s" by auto
9.1015 + assume ?lhs thus ?rhs unfolding * apply(rule_tac x=0 in exI) by auto
9.1016 +next
9.1017 + assume ?lhs then obtain u where u:"\<forall>x\<in>insert a s. 0 \<le> u x" "setsum u (insert a s) = w" "(\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y" by auto
9.1018 + assume "a\<notin>s" thus ?rhs apply(rule_tac x="u a" in exI) using u(1)[THEN bspec[where x=a]] apply simp
9.1019 + apply(rule_tac x=u in exI) using u[unfolded setsum_clauses(2)[OF assms]] and `a\<notin>s` by auto
9.1020 +next
9.1021 + assume "a\<in>s" hence *:"insert a s = s" by auto
9.1022 + have fin:"finite (insert a s)" using assms by auto
9.1023 + assume ?rhs then obtain v u where uv:"v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
9.1024 + show ?lhs apply(rule_tac x="\<lambda>x. (if a = x then v else 0) + u x" in exI) unfolding scaleR_left_distrib and setsum_addf and setsum_delta''[OF fin] and setsum_delta'[OF fin]
9.1025 + unfolding setsum_clauses(2)[OF assms] using uv and uv(2)[THEN bspec[where x=a]] and `a\<in>s` by auto
9.1026 +next
9.1027 + assume ?rhs then obtain v u where uv:"v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a" by auto
9.1028 + moreover assume "a\<notin>s" moreover have "(\<Sum>x\<in>s. if a = x then v else u x) = setsum u s" "(\<Sum>x\<in>s. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)"
9.1029 + apply(rule_tac setsum_cong2) defer apply(rule_tac setsum_cong2) using `a\<notin>s` by auto
9.1030 + ultimately show ?lhs apply(rule_tac x="\<lambda>x. if a = x then v else u x" in exI) unfolding setsum_clauses(2)[OF assms] by auto
9.1031 +qed
9.1032 +
9.1033 +subsection {* Hence some special cases. *}
9.1034 +
9.1035 +lemma convex_hull_2:
9.1036 + "convex hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1}"
9.1037 +proof- have *:"\<And>u. (\<forall>x\<in>{a, b}. 0 \<le> u x) \<longleftrightarrow> 0 \<le> u a \<and> 0 \<le> u b" by auto have **:"finite {b}" by auto
9.1038 +show ?thesis apply(simp add: convex_hull_finite) unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
9.1039 + apply auto apply(rule_tac x=v in exI) apply(rule_tac x="1 - v" in exI) apply simp
9.1040 + apply(rule_tac x=u in exI) apply simp apply(rule_tac x="\<lambda>x. v" in exI) by simp qed
9.1041 +
9.1042 +lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u. 0 \<le> u \<and> u \<le> 1}"
9.1043 + unfolding convex_hull_2 unfolding Collect_def
9.1044 +proof(rule ext) have *:"\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y" by auto
9.1045 + fix x show "(\<exists>v u. x = v *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> v \<and> 0 \<le> u \<and> v + u = 1) = (\<exists>u. x = a + u *\<^sub>R (b - a) \<and> 0 \<le> u \<and> u \<le> 1)"
9.1046 + unfolding * apply auto apply(rule_tac[!] x=u in exI) by (auto simp add: algebra_simps) qed
9.1047 +
9.1048 +lemma convex_hull_3:
9.1049 + "convex hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c | u v w. 0 \<le> u \<and> 0 \<le> v \<and> 0 \<le> w \<and> u + v + w = 1}"
9.1050 +proof-
9.1051 + have fin:"finite {a,b,c}" "finite {b,c}" "finite {c}" by auto
9.1052 + have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
9.1053 + "\<And>x y z ::real^'n. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by (auto simp add: ring_simps)
9.1054 + show ?thesis unfolding convex_hull_finite[OF fin(1)] and Collect_def and convex_hull_finite_step[OF fin(2)] and *
9.1055 + unfolding convex_hull_finite_step[OF fin(3)] apply(rule ext) apply simp apply auto
9.1056 + apply(rule_tac x=va in exI) apply (rule_tac x="u c" in exI) apply simp
9.1057 + apply(rule_tac x="1 - v - w" in exI) apply simp apply(rule_tac x=v in exI) apply simp apply(rule_tac x="\<lambda>x. w" in exI) by simp qed
9.1058 +
9.1059 +lemma convex_hull_3_alt:
9.1060 + "convex hull {a,b,c} = {a + u *\<^sub>R (b - a) + v *\<^sub>R (c - a) | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v \<le> 1}"
9.1061 +proof- have *:"\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z" by auto
9.1062 + show ?thesis unfolding convex_hull_3 apply (auto simp add: *) apply(rule_tac x=v in exI) apply(rule_tac x=w in exI) apply (simp add: algebra_simps)
9.1063 + apply(rule_tac x=u in exI) apply(rule_tac x=v in exI) by (simp add: algebra_simps) qed
9.1064 +
9.1065 +subsection {* Relations among closure notions and corresponding hulls. *}
9.1066 +
9.1067 +text {* TODO: Generalize linear algebra concepts defined in @{text
9.1068 +Euclidean_Space.thy} so that we can generalize these lemmas. *}
9.1069 +
9.1070 +lemma subspace_imp_affine:
9.1071 + fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> affine s"
9.1072 + unfolding subspace_def affine_def smult_conv_scaleR by auto
9.1073 +
9.1074 +lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
9.1075 + unfolding affine_def convex_def by auto
9.1076 +
9.1077 +lemma subspace_imp_convex:
9.1078 + fixes s :: "(real ^ _) set" shows "subspace s \<Longrightarrow> convex s"
9.1079 + using subspace_imp_affine affine_imp_convex by auto
9.1080 +
9.1081 +lemma affine_hull_subset_span:
9.1082 + fixes s :: "(real ^ _) set" shows "(affine hull s) \<subseteq> (span s)"
9.1083 + unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
9.1084 + using subspace_imp_affine by auto
9.1085 +
9.1086 +lemma convex_hull_subset_span:
9.1087 + fixes s :: "(real ^ _) set" shows "(convex hull s) \<subseteq> (span s)"
9.1088 + unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
9.1089 + using subspace_imp_convex by auto
9.1090 +
9.1091 +lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
9.1092 + unfolding span_def apply(rule hull_antimono) unfolding subset_eq Ball_def mem_def
9.1093 + using affine_imp_convex by auto
9.1094 +
9.1095 +lemma affine_dependent_imp_dependent:
9.1096 + fixes s :: "(real ^ _) set" shows "affine_dependent s \<Longrightarrow> dependent s"
9.1097 + unfolding affine_dependent_def dependent_def
9.1098 + using affine_hull_subset_span by auto
9.1099 +
9.1100 +lemma dependent_imp_affine_dependent:
9.1101 + fixes s :: "(real ^ _) set"
9.1102 + assumes "dependent {x - a| x . x \<in> s}" "a \<notin> s"
9.1103 + shows "affine_dependent (insert a s)"
9.1104 +proof-
9.1105 + from assms(1)[unfolded dependent_explicit smult_conv_scaleR] obtain S u v
9.1106 + where obt:"finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" by auto
9.1107 + def t \<equiv> "(\<lambda>x. x + a) ` S"
9.1108 +
9.1109 + have inj:"inj_on (\<lambda>x. x + a) S" unfolding inj_on_def by auto
9.1110 + have "0\<notin>S" using obt(2) assms(2) unfolding subset_eq by auto
9.1111 + have fin:"finite t" and "t\<subseteq>s" unfolding t_def using obt(1,2) by auto
9.1112 +
9.1113 + hence "finite (insert a t)" and "insert a t \<subseteq> insert a s" by auto
9.1114 + moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
9.1115 + apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
9.1116 + have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
9.1117 + unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` apply auto unfolding * by auto
9.1118 + moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
9.1119 + apply(rule_tac x="v + a" in bexI) using obt(3,4) and `0\<notin>S` unfolding t_def by auto
9.1120 + moreover have *:"\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
9.1121 + apply(rule setsum_cong2) using `a\<notin>s` `t\<subseteq>s` by auto
9.1122 + have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
9.1123 + unfolding scaleR_left.setsum unfolding t_def and setsum_reindex[OF inj] and o_def
9.1124 + using obt(5) by (auto simp add: setsum_addf scaleR_right_distrib)
9.1125 + hence "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
9.1126 + unfolding setsum_clauses(2)[OF fin] using `a\<notin>s` `t\<subseteq>s` by (auto simp add: * vector_smult_lneg)
9.1127 + ultimately show ?thesis unfolding affine_dependent_explicit
9.1128 + apply(rule_tac x="insert a t" in exI) by auto
9.1129 +qed
9.1130 +
9.1131 +lemma convex_cone:
9.1132 + "convex s \<and> cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. (x + y) \<in> s) \<and> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)" (is "?lhs = ?rhs")
9.1133 +proof-
9.1134 + { fix x y assume "x\<in>s" "y\<in>s" and ?lhs
9.1135 + hence "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s" unfolding cone_def by auto
9.1136 + hence "x + y \<in> s" using `?lhs`[unfolded convex_def, THEN conjunct1]
9.1137 + apply(erule_tac x="2*\<^sub>R x" in ballE) apply(erule_tac x="2*\<^sub>R y" in ballE)
9.1138 + apply(erule_tac x="1/2" in allE) apply simp apply(erule_tac x="1/2" in allE) by auto }
9.1139 + thus ?thesis unfolding convex_def cone_def by blast
9.1140 +qed
9.1141 +
9.1142 +lemma affine_dependent_biggerset: fixes s::"(real^'n::finite) set"
9.1143 + assumes "finite s" "card s \<ge> CARD('n) + 2"
9.1144 + shows "affine_dependent s"
9.1145 +proof-
9.1146 + have "s\<noteq>{}" using assms by auto then obtain a where "a\<in>s" by auto
9.1147 + have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
9.1148 + have "card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
9.1149 + apply(rule card_image) unfolding inj_on_def by auto
9.1150 + also have "\<dots> > CARD('n)" using assms(2)
9.1151 + unfolding card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
9.1152 + finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
9.1153 + apply(rule dependent_imp_affine_dependent)
9.1154 + apply(rule dependent_biggerset) by auto qed
9.1155 +
9.1156 +lemma affine_dependent_biggerset_general:
9.1157 + assumes "finite (s::(real^'n::finite) set)" "card s \<ge> dim s + 2"
9.1158 + shows "affine_dependent s"
9.1159 +proof-
9.1160 + from assms(2) have "s \<noteq> {}" by auto
9.1161 + then obtain a where "a\<in>s" by auto
9.1162 + have *:"{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})" by auto
9.1163 + have **:"card {x - a |x. x \<in> s - {a}} = card (s - {a})" unfolding *
9.1164 + apply(rule card_image) unfolding inj_on_def by auto
9.1165 + have "dim {x - a |x. x \<in> s - {a}} \<le> dim s"
9.1166 + apply(rule subset_le_dim) unfolding subset_eq
9.1167 + using `a\<in>s` by (auto simp add:span_superset span_sub)
9.1168 + also have "\<dots> < dim s + 1" by auto
9.1169 + also have "\<dots> \<le> card (s - {a})" using assms
9.1170 + using card_Diff_singleton[OF assms(1) `a\<in>s`] by auto
9.1171 + finally show ?thesis apply(subst insert_Diff[OF `a\<in>s`, THEN sym])
9.1172 + apply(rule dependent_imp_affine_dependent) apply(rule dependent_biggerset_general) unfolding ** by auto qed
9.1173 +
9.1174 +subsection {* Caratheodory's theorem. *}
9.1175 +
9.1176 +lemma convex_hull_caratheodory: fixes p::"(real^'n::finite) set"
9.1177 + shows "convex hull p = {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and>
9.1178 + (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> setsum (\<lambda>v. u v *\<^sub>R v) s = y}"
9.1179 + unfolding convex_hull_explicit expand_set_eq mem_Collect_eq
9.1180 +proof(rule,rule)
9.1181 + fix y let ?P = "\<lambda>n. \<exists>s u. finite s \<and> card s = n \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
9.1182 + assume "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
9.1183 + then obtain N where "?P N" by auto
9.1184 + hence "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n" apply(rule_tac ex_least_nat_le) by auto
9.1185 + then obtain n where "?P n" and smallest:"\<forall>k<n. \<not> ?P k" by blast
9.1186 + then obtain s u where obt:"finite s" "card s = n" "s\<subseteq>p" "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
9.1187 +
9.1188 + have "card s \<le> CARD('n) + 1" proof(rule ccontr, simp only: not_le)
9.1189 + assume "CARD('n) + 1 < card s"
9.1190 + hence "affine_dependent s" using affine_dependent_biggerset[OF obt(1)] by auto
9.1191 + then obtain w v where wv:"setsum w s = 0" "v\<in>s" "w v \<noteq> 0" "(\<Sum>v\<in>s. w v *\<^sub>R v) = 0"
9.1192 + using affine_dependent_explicit_finite[OF obt(1)] by auto
9.1193 + def i \<equiv> "(\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}" def t \<equiv> "Min i"
9.1194 + have "\<exists>x\<in>s. w x < 0" proof(rule ccontr, simp add: not_less)
9.1195 + assume as:"\<forall>x\<in>s. 0 \<le> w x"
9.1196 + hence "setsum w (s - {v}) \<ge> 0" apply(rule_tac setsum_nonneg) by auto
9.1197 + hence "setsum w s > 0" unfolding setsum_diff1'[OF obt(1) `v\<in>s`]
9.1198 + using as[THEN bspec[where x=v]] and `v\<in>s` using `w v \<noteq> 0` by auto
9.1199 + thus False using wv(1) by auto
9.1200 + qed hence "i\<noteq>{}" unfolding i_def by auto
9.1201 +
9.1202 + hence "t \<ge> 0" using Min_ge_iff[of i 0 ] and obt(1) unfolding t_def i_def
9.1203 + using obt(4)[unfolded le_less] apply auto unfolding divide_le_0_iff by auto
9.1204 + have t:"\<forall>v\<in>s. u v + t * w v \<ge> 0" proof
9.1205 + fix v assume "v\<in>s" hence v:"0\<le>u v" using obt(4)[THEN bspec[where x=v]] by auto
9.1206 + show"0 \<le> u v + t * w v" proof(cases "w v < 0")
9.1207 + case False thus ?thesis apply(rule_tac add_nonneg_nonneg)
9.1208 + using v apply simp apply(rule mult_nonneg_nonneg) using `t\<ge>0` by auto next
9.1209 + case True hence "t \<le> u v / (- w v)" using `v\<in>s`
9.1210 + unfolding t_def i_def apply(rule_tac Min_le) using obt(1) by auto
9.1211 + thus ?thesis unfolding real_0_le_add_iff
9.1212 + using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[THEN sym]]] by auto
9.1213 + qed qed
9.1214 +
9.1215 + obtain a where "a\<in>s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
9.1216 + using Min_in[OF _ `i\<noteq>{}`] and obt(1) unfolding i_def t_def by auto
9.1217 + hence a:"a\<in>s" "u a + t * w a = 0" by auto
9.1218 + have *:"\<And>f. setsum f (s - {a}) = setsum f s - ((f a)::'a::ring)" unfolding setsum_diff1'[OF obt(1) `a\<in>s`] by auto
9.1219 + have "(\<Sum>v\<in>s. u v + t * w v) = 1"
9.1220 + unfolding setsum_addf wv(1) setsum_right_distrib[THEN sym] obt(5) by auto
9.1221 + moreover have "(\<Sum>v\<in>s. u v *\<^sub>R v + (t * w v) *\<^sub>R v) - (u a *\<^sub>R a + (t * w a) *\<^sub>R a) = y"
9.1222 + unfolding setsum_addf obt(6) scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] wv(4)
9.1223 + using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]]
9.1224 + by (simp add: vector_smult_lneg)
9.1225 + ultimately have "?P (n - 1)" apply(rule_tac x="(s - {a})" in exI)
9.1226 + apply(rule_tac x="\<lambda>v. u v + t * w v" in exI) using obt(1-3) and t and a by (auto simp add: * scaleR_left_distrib)
9.1227 + thus False using smallest[THEN spec[where x="n - 1"]] by auto qed
9.1228 + thus "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1
9.1229 + \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y" using obt by auto
9.1230 +qed auto
9.1231 +
9.1232 +lemma caratheodory:
9.1233 + "convex hull p = {x::real^'n::finite. \<exists>s. finite s \<and> s \<subseteq> p \<and>
9.1234 + card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s}"
9.1235 + unfolding expand_set_eq apply(rule, rule) unfolding mem_Collect_eq proof-
9.1236 + fix x assume "x \<in> convex hull p"
9.1237 + then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1"
9.1238 + "\<forall>x\<in>s. 0 \<le> u x" "setsum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"unfolding convex_hull_caratheodory by auto
9.1239 + thus "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
9.1240 + apply(rule_tac x=s in exI) using hull_subset[of s convex]
9.1241 + using convex_convex_hull[unfolded convex_explicit, of s, THEN spec[where x=s], THEN spec[where x=u]] by auto
9.1242 +next
9.1243 + fix x assume "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> CARD('n) + 1 \<and> x \<in> convex hull s"
9.1244 + then obtain s where "finite s" "s \<subseteq> p" "card s \<le> CARD('n) + 1" "x \<in> convex hull s" by auto
9.1245 + thus "x \<in> convex hull p" using hull_mono[OF `s\<subseteq>p`] by auto
9.1246 +qed
9.1247 +
9.1248 +subsection {* Openness and compactness are preserved by convex hull operation. *}
9.1249 +
9.1250 +lemma open_convex_hull:
9.1251 + fixes s :: "'a::real_normed_vector set"
9.1252 + assumes "open s"
9.1253 + shows "open(convex hull s)"
9.1254 + unfolding open_contains_cball convex_hull_explicit unfolding mem_Collect_eq ball_simps(10)
9.1255 +proof(rule, rule) fix a
9.1256 + assume "\<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = a"
9.1257 + then obtain t u where obt:"finite t" "t\<subseteq>s" "\<forall>x\<in>t. 0 \<le> u x" "setsum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = a" by auto
9.1258 +
9.1259 + from assms[unfolded open_contains_cball] obtain b where b:"\<forall>x\<in>s. 0 < b x \<and> cball x (b x) \<subseteq> s"
9.1260 + using bchoice[of s "\<lambda>x e. e>0 \<and> cball x e \<subseteq> s"] by auto
9.1261 + have "b ` t\<noteq>{}" unfolding i_def using obt by auto def i \<equiv> "b ` t"
9.1262 +
9.1263 + show "\<exists>e>0. cball a e \<subseteq> {y. \<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y}"
9.1264 + apply(rule_tac x="Min i" in exI) unfolding subset_eq apply rule defer apply rule unfolding mem_Collect_eq
9.1265 + proof-
9.1266 + show "0 < Min i" unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] `b \` t\<noteq>{}`]
9.1267 + using b apply simp apply rule apply(erule_tac x=x in ballE) using `t\<subseteq>s` by auto
9.1268 + next fix y assume "y \<in> cball a (Min i)"
9.1269 + hence y:"norm (a - y) \<le> Min i" unfolding dist_norm[THEN sym] by auto
9.1270 + { fix x assume "x\<in>t"
9.1271 + hence "Min i \<le> b x" unfolding i_def apply(rule_tac Min_le) using obt(1) by auto
9.1272 + hence "x + (y - a) \<in> cball x (b x)" using y unfolding mem_cball dist_norm by auto
9.1273 + moreover from `x\<in>t` have "x\<in>s" using obt(2) by auto
9.1274 + ultimately have "x + (y - a) \<in> s" using y and b[THEN bspec[where x=x]] unfolding subset_eq by auto }
9.1275 + moreover
9.1276 + have *:"inj_on (\<lambda>v. v + (y - a)) t" unfolding inj_on_def by auto
9.1277 + have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a))) = 1"
9.1278 + unfolding setsum_reindex[OF *] o_def using obt(4) by auto
9.1279 + moreover have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a)) *\<^sub>R v) = y"
9.1280 + unfolding setsum_reindex[OF *] o_def using obt(4,5)
9.1281 + by (simp add: setsum_addf setsum_subtractf scaleR_left.setsum[THEN sym] scaleR_right_distrib)
9.1282 + ultimately show "\<exists>sa u. finite sa \<and> (\<forall>x\<in>sa. x \<in> s) \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> setsum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
9.1283 + apply(rule_tac x="(\<lambda>v. v + (y - a)) ` t" in exI) apply(rule_tac x="\<lambda>v. u (v - (y - a))" in exI)
9.1284 + using obt(1, 3) by auto
9.1285 + qed
9.1286 +qed
9.1287 +
9.1288 +lemma open_dest_vec1_vimage: "open S \<Longrightarrow> open (dest_vec1 -` S)"
9.1289 +unfolding open_vector_def all_1
9.1290 +by (auto simp add: dest_vec1_def)
9.1291 +
9.1292 +lemma tendsto_dest_vec1 [tendsto_intros]:
9.1293 + "(f ---> l) net \<Longrightarrow> ((\<lambda>x. dest_vec1 (f x)) ---> dest_vec1 l) net"
9.1294 + unfolding tendsto_def
9.1295 + apply clarify
9.1296 + apply (drule_tac x="dest_vec1 -` S" in spec)
9.1297 + apply (simp add: open_dest_vec1_vimage)
9.1298 + done
9.1299 +
9.1300 +lemma continuous_dest_vec1: "continuous net f \<Longrightarrow> continuous net (\<lambda>x. dest_vec1 (f x))"
9.1301 + unfolding continuous_def by (rule tendsto_dest_vec1)
9.1302 +
9.1303 +(* TODO: move *)
9.1304 +lemma compact_real_interval:
9.1305 + fixes a b :: real shows "compact {a..b}"
9.1306 +proof -
9.1307 + have "continuous_on {vec1 a .. vec1 b} dest_vec1"
9.1308 + unfolding continuous_on
9.1309 + by (simp add: tendsto_dest_vec1 Lim_at_within Lim_ident_at)
9.1310 + moreover have "compact {vec1 a .. vec1 b}" by (rule compact_interval)
9.1311 + ultimately have "compact (dest_vec1 ` {vec1 a .. vec1 b})"
9.1312 + by (rule compact_continuous_image)
9.1313 + also have "dest_vec1 ` {vec1 a .. vec1 b} = {a..b}"
9.1314 + by (auto simp add: image_def Bex_def exists_vec1)
9.1315 + finally show ?thesis .
9.1316 +qed
9.1317 +
9.1318 +lemma compact_convex_combinations:
9.1319 + fixes s t :: "'a::real_normed_vector set"
9.1320 + assumes "compact s" "compact t"
9.1321 + 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}"
9.1322 +proof-
9.1323 + let ?X = "{0..1} \<times> s \<times> t"
9.1324 + let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
9.1325 + 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"
9.1326 + apply(rule set_ext) unfolding image_iff mem_Collect_eq
9.1327 + apply rule apply auto
9.1328 + apply (rule_tac x=u in rev_bexI, simp)
9.1329 + apply (erule rev_bexI, erule rev_bexI, simp)
9.1330 + by auto
9.1331 + have "continuous_on ({0..1} \<times> s \<times> t)
9.1332 + (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
9.1333 + unfolding continuous_on by (rule ballI) (intro tendsto_intros)
9.1334 + thus ?thesis unfolding *
9.1335 + apply (rule compact_continuous_image)
9.1336 + apply (intro compact_Times compact_real_interval assms)
9.1337 + done
9.1338 +qed
9.1339 +
9.1340 +lemma compact_convex_hull: fixes s::"(real^'n::finite) set"
9.1341 + assumes "compact s" shows "compact(convex hull s)"
9.1342 +proof(cases "s={}")
9.1343 + case True thus ?thesis using compact_empty by simp
9.1344 +next
9.1345 + case False then obtain w where "w\<in>s" by auto
9.1346 + show ?thesis unfolding caratheodory[of s]
9.1347 + proof(induct "CARD('n) + 1")
9.1348 + have *:"{x.\<exists>sa. finite sa \<and> sa \<subseteq> s \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
9.1349 + using compact_empty by (auto simp add: convex_hull_empty)
9.1350 + case 0 thus ?case unfolding * by simp
9.1351 + next
9.1352 + case (Suc n)
9.1353 + show ?case proof(cases "n=0")
9.1354 + 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"
9.1355 + unfolding expand_set_eq and mem_Collect_eq proof(rule, rule)
9.1356 + fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
9.1357 + then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
9.1358 + show "x\<in>s" proof(cases "card t = 0")
9.1359 + case True thus ?thesis using t(4) unfolding card_0_eq[OF t(1)] by(simp add: convex_hull_empty)
9.1360 + next
9.1361 + case False hence "card t = Suc 0" using t(3) `n=0` by auto
9.1362 + then obtain a where "t = {a}" unfolding card_Suc_eq by auto
9.1363 + thus ?thesis using t(2,4) by (simp add: convex_hull_singleton)
9.1364 + qed
9.1365 + next
9.1366 + fix x assume "x\<in>s"
9.1367 + thus "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
9.1368 + apply(rule_tac x="{x}" in exI) unfolding convex_hull_singleton by auto
9.1369 + qed thus ?thesis using assms by simp
9.1370 + next
9.1371 + case False have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} =
9.1372 + { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
9.1373 + 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}}"
9.1374 + unfolding expand_set_eq and mem_Collect_eq proof(rule,rule)
9.1375 + fix x assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
9.1376 + 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)"
9.1377 + then obtain u v c t where obt:"x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
9.1378 + "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
9.1379 + moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u t"
9.1380 + apply(rule mem_convex) using obt(2) and convex_convex_hull and hull_subset[of "insert u t" convex]
9.1381 + using obt(7) and hull_mono[of t "insert u t"] by auto
9.1382 + ultimately show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
9.1383 + apply(rule_tac x="insert u t" in exI) by (auto simp add: card_insert_if)
9.1384 + next
9.1385 + fix x assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
9.1386 + then obtain t where t:"finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t" by auto
9.1387 + let ?P = "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
9.1388 + 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)"
9.1389 + show ?P proof(cases "card t = Suc n")
9.1390 + case False hence "card t \<le> n" using t(3) by auto
9.1391 + thus ?P apply(rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI) using `w\<in>s` and t
9.1392 + by(auto intro!: exI[where x=t])
9.1393 + next
9.1394 + case True then obtain a u where au:"t = insert a u" "a\<notin>u" apply(drule_tac card_eq_SucD) by auto
9.1395 + show ?P proof(cases "u={}")
9.1396 + case True hence "x=a" using t(4)[unfolded au] by auto
9.1397 + show ?P unfolding `x=a` apply(rule_tac x=a in exI, rule_tac x=a in exI, rule_tac x=1 in exI)
9.1398 + using t and `n\<noteq>0` unfolding au by(auto intro!: exI[where x="{a}"] simp add: convex_hull_singleton)
9.1399 + next
9.1400 + 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"
9.1401 + using t(4)[unfolded au convex_hull_insert[OF False]] by auto
9.1402 + have *:"1 - vx = ux" using obt(3) by auto
9.1403 + show ?P apply(rule_tac x=a in exI, rule_tac x=b in exI, rule_tac x=vx in exI)
9.1404 + using obt and t(1-3) unfolding au and * using card_insert_disjoint[OF _ au(2)]
9.1405 + by(auto intro!: exI[where x=u])
9.1406 + qed
9.1407 + qed
9.1408 + qed
9.1409 + thus ?thesis using compact_convex_combinations[OF assms Suc] by simp
9.1410 + qed
9.1411 + qed
9.1412 +qed
9.1413 +
9.1414 +lemma finite_imp_compact_convex_hull:
9.1415 + fixes s :: "(real ^ _) set"
9.1416 + shows "finite s \<Longrightarrow> compact(convex hull s)"
9.1417 + apply(drule finite_imp_compact, drule compact_convex_hull) by assumption
9.1418 +
9.1419 +subsection {* Extremal points of a simplex are some vertices. *}
9.1420 +
9.1421 +lemma dist_increases_online:
9.1422 + fixes a b d :: "'a::real_inner"
9.1423 + assumes "d \<noteq> 0"
9.1424 + shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
9.1425 +proof(cases "inner a d - inner b d > 0")
9.1426 + case True hence "0 < inner d d + (inner a d * 2 - inner b d * 2)"
9.1427 + apply(rule_tac add_pos_pos) using assms by auto
9.1428 + thus ?thesis apply(rule_tac disjI2) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
9.1429 + by (simp add: algebra_simps inner_commute)
9.1430 +next
9.1431 + case False hence "0 < inner d d + (inner b d * 2 - inner a d * 2)"
9.1432 + apply(rule_tac add_pos_nonneg) using assms by auto
9.1433 + thus ?thesis apply(rule_tac disjI1) unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
9.1434 + by (simp add: algebra_simps inner_commute)
9.1435 +qed
9.1436 +
9.1437 +lemma norm_increases_online:
9.1438 + fixes d :: "'a::real_inner"
9.1439 + shows "d \<noteq> 0 \<Longrightarrow> norm(a + d) > norm a \<or> norm(a - d) > norm a"
9.1440 + using dist_increases_online[of d a 0] unfolding dist_norm by auto
9.1441 +
9.1442 +lemma simplex_furthest_lt:
9.1443 + fixes s::"'a::real_inner set" assumes "finite s"
9.1444 + shows "\<forall>x \<in> (convex hull s). x \<notin> s \<longrightarrow> (\<exists>y\<in>(convex hull s). norm(x - a) < norm(y - a))"
9.1445 +proof(induct_tac rule: finite_induct[of s])
9.1446 + 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))"
9.1447 + 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))"
9.1448 + proof(rule,rule,cases "s = {}")
9.1449 + case False fix y assume y:"y \<in> convex hull insert x s" "y \<notin> insert x s"
9.1450 + 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"
9.1451 + using y(1)[unfolded convex_hull_insert[OF False]] by auto
9.1452 + show "\<exists>z\<in>convex hull insert x s. norm (y - a) < norm (z - a)"
9.1453 + proof(cases "y\<in>convex hull s")
9.1454 + case True then obtain z where "z\<in>convex hull s" "norm (y - a) < norm (z - a)"
9.1455 + using as(3)[THEN bspec[where x=y]] and y(2) by auto
9.1456 + thus ?thesis apply(rule_tac x=z in bexI) unfolding convex_hull_insert[OF False] by auto
9.1457 + next
9.1458 + case False show ?thesis using obt(3) proof(cases "u=0", case_tac[!] "v=0")
9.1459 + assume "u=0" "v\<noteq>0" hence "y = b" using obt by auto
9.1460 + thus ?thesis using False and obt(4) by auto
9.1461 + next
9.1462 + assume "u\<noteq>0" "v=0" hence "y = x" using obt by auto
9.1463 + thus ?thesis using y(2) by auto
9.1464 + next
9.1465 + assume "u\<noteq>0" "v\<noteq>0"
9.1466 + then obtain w where w:"w>0" "w<u" "w<v" using real_lbound_gt_zero[of u v] and obt(1,2) by auto
9.1467 + have "x\<noteq>b" proof(rule ccontr)
9.1468 + assume "\<not> x\<noteq>b" hence "y=b" unfolding obt(5)
9.1469 + using obt(3) by(auto simp add: scaleR_left_distrib[THEN sym])
9.1470 + thus False using obt(4) and False by simp qed
9.1471 + hence *:"w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
9.1472 + show ?thesis using dist_increases_online[OF *, of a y]
9.1473 + proof(erule_tac disjE)
9.1474 + assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
9.1475 + hence "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
9.1476 + unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
9.1477 + moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x s"
9.1478 + unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
9.1479 + apply(rule_tac x="u + w" in exI) apply rule defer
9.1480 + apply(rule_tac x="v - w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
9.1481 + ultimately show ?thesis by auto
9.1482 + next
9.1483 + assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
9.1484 + hence "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
9.1485 + unfolding dist_commute[of a] unfolding dist_norm obt(5) by (simp add: algebra_simps)
9.1486 + moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x s"
9.1487 + unfolding convex_hull_insert[OF `s\<noteq>{}`] and mem_Collect_eq
9.1488 + apply(rule_tac x="u - w" in exI) apply rule defer
9.1489 + apply(rule_tac x="v + w" in exI) using `u\<ge>0` and w and obt(3,4) by auto
9.1490 + ultimately show ?thesis by auto
9.1491 + qed
9.1492 + qed auto
9.1493 + qed
9.1494 + qed auto
9.1495 +qed (auto simp add: assms)
9.1496 +
9.1497 +lemma simplex_furthest_le:
9.1498 + fixes s :: "(real ^ _) set"
9.1499 + assumes "finite s" "s \<noteq> {}"
9.1500 + shows "\<exists>y\<in>s. \<forall>x\<in>(convex hull s). norm(x - a) \<le> norm(y - a)"
9.1501 +proof-
9.1502 + have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
9.1503 + then obtain x where x:"x\<in>convex hull s" "\<forall>y\<in>convex hull s. norm (y - a) \<le> norm (x - a)"
9.1504 + using distance_attains_sup[OF finite_imp_compact_convex_hull[OF assms(1)], of a]
9.1505 + unfolding dist_commute[of a] unfolding dist_norm by auto
9.1506 + thus ?thesis proof(cases "x\<in>s")
9.1507 + case False then obtain y where "y\<in>convex hull s" "norm (x - a) < norm (y - a)"
9.1508 + using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1) by auto
9.1509 + thus ?thesis using x(2)[THEN bspec[where x=y]] by auto
9.1510 + qed auto
9.1511 +qed
9.1512 +
9.1513 +lemma simplex_furthest_le_exists:
9.1514 + fixes s :: "(real ^ _) set"
9.1515 + shows "finite s \<Longrightarrow> (\<forall>x\<in>(convex hull s). \<exists>y\<in>s. norm(x - a) \<le> norm(y - a))"
9.1516 + using simplex_furthest_le[of s] by (cases "s={}")auto
9.1517 +
9.1518 +lemma simplex_extremal_le:
9.1519 + fixes s :: "(real ^ _) set"
9.1520 + assumes "finite s" "s \<noteq> {}"
9.1521 + 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)"
9.1522 +proof-
9.1523 + have "convex hull s \<noteq> {}" using hull_subset[of s convex] and assms(2) by auto
9.1524 + then obtain u v where obt:"u\<in>convex hull s" "v\<in>convex hull s"
9.1525 + "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull s. norm (x - y) \<le> norm (u - v)"
9.1526 + using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]] by auto
9.1527 + thus ?thesis proof(cases "u\<notin>s \<or> v\<notin>s", erule_tac disjE)
9.1528 + assume "u\<notin>s" then obtain y where "y\<in>convex hull s" "norm (u - v) < norm (y - v)"
9.1529 + using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1) by auto
9.1530 + thus ?thesis using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2) by auto
9.1531 + next
9.1532 + assume "v\<notin>s" then obtain y where "y\<in>convex hull s" "norm (v - u) < norm (y - u)"
9.1533 + using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2) by auto
9.1534 + thus ?thesis using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
9.1535 + by (auto simp add: norm_minus_commute)
9.1536 + qed auto
9.1537 +qed
9.1538 +
9.1539 +lemma simplex_extremal_le_exists:
9.1540 + fixes s :: "(real ^ _) set"
9.1541 + shows "finite s \<Longrightarrow> x \<in> convex hull s \<Longrightarrow> y \<in> convex hull s
9.1542 + \<Longrightarrow> (\<exists>u\<in>s. \<exists>v\<in>s. norm(x - y) \<le> norm(u - v))"
9.1543 + using convex_hull_empty simplex_extremal_le[of s] by(cases "s={}")auto
9.1544 +
9.1545 +subsection {* Closest point of a convex set is unique, with a continuous projection. *}
9.1546 +
9.1547 +definition
9.1548 + closest_point :: "(real ^ 'n::finite) set \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
9.1549 + "closest_point s a = (SOME x. x \<in> s \<and> (\<forall>y\<in>s. dist a x \<le> dist a y))"
9.1550 +
9.1551 +lemma closest_point_exists:
9.1552 + assumes "closed s" "s \<noteq> {}"
9.1553 + shows "closest_point s a \<in> s" "\<forall>y\<in>s. dist a (closest_point s a) \<le> dist a y"
9.1554 + unfolding closest_point_def apply(rule_tac[!] someI2_ex)
9.1555 + using distance_attains_inf[OF assms(1,2), of a] by auto
9.1556 +
9.1557 +lemma closest_point_in_set:
9.1558 + "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s a) \<in> s"
9.1559 + by(meson closest_point_exists)
9.1560 +
9.1561 +lemma closest_point_le:
9.1562 + "closed s \<Longrightarrow> x \<in> s \<Longrightarrow> dist a (closest_point s a) \<le> dist a x"
9.1563 + using closest_point_exists[of s] by auto
9.1564 +
9.1565 +lemma closest_point_self:
9.1566 + assumes "x \<in> s" shows "closest_point s x = x"
9.1567 + unfolding closest_point_def apply(rule some1_equality, rule ex1I[of _ x])
9.1568 + using assms by auto
9.1569 +
9.1570 +lemma closest_point_refl:
9.1571 + "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> (closest_point s x = x \<longleftrightarrow> x \<in> s)"
9.1572 + using closest_point_in_set[of s x] closest_point_self[of x s] by auto
9.1573 +
9.1574 +(* TODO: move *)
9.1575 +lemma norm_lt: "norm x < norm y \<longleftrightarrow> inner x x < inner y y"
9.1576 + unfolding norm_eq_sqrt_inner by simp
9.1577 +
9.1578 +(* TODO: move *)
9.1579 +lemma norm_le: "norm x \<le> norm y \<longleftrightarrow> inner x x \<le> inner y y"
9.1580 + unfolding norm_eq_sqrt_inner by simp
9.1581 +
9.1582 +lemma closer_points_lemma: fixes y::"real^'n::finite"
9.1583 + assumes "inner y z > 0"
9.1584 + shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
9.1585 +proof- have z:"inner z z > 0" unfolding inner_gt_zero_iff using assms by auto
9.1586 + thus ?thesis using assms apply(rule_tac x="inner y z / inner z z" in exI) apply(rule) defer proof(rule+)
9.1587 + fix v assume "0<v" "v \<le> inner y z / inner z z"
9.1588 + thus "norm (v *\<^sub>R z - y) < norm y" unfolding norm_lt using z and assms
9.1589 + by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ `0<v`])
9.1590 + qed(rule divide_pos_pos, auto) qed
9.1591 +
9.1592 +lemma closer_point_lemma:
9.1593 + fixes x y z :: "real ^ 'n::finite"
9.1594 + assumes "inner (y - x) (z - x) > 0"
9.1595 + shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
9.1596 +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)"
9.1597 + using closer_points_lemma[OF assms] by auto
9.1598 + show ?thesis apply(rule_tac x="min u 1" in exI) using u[THEN spec[where x="min u 1"]] and `u>0`
9.1599 + unfolding dist_norm by(auto simp add: norm_minus_commute field_simps) qed
9.1600 +
9.1601 +lemma any_closest_point_dot:
9.1602 + fixes s :: "(real ^ _) set"
9.1603 + assumes "convex s" "closed s" "x \<in> s" "y \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
9.1604 + shows "inner (a - x) (y - x) \<le> 0"
9.1605 +proof(rule ccontr) assume "\<not> inner (a - x) (y - x) \<le> 0"
9.1606 + 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
9.1607 + let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y" have "?z \<in> s" using mem_convex[OF assms(1,3,4), of u] using u by auto
9.1608 + thus False using assms(5)[THEN bspec[where x="?z"]] and u(3) by (auto simp add: dist_commute algebra_simps) qed
9.1609 +
9.1610 +(* TODO: move *)
9.1611 +lemma norm_le_square: "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
9.1612 +proof -
9.1613 + have "norm x \<le> a \<longleftrightarrow> 0 \<le> a \<and> norm x \<le> a"
9.1614 + using norm_ge_zero [of x] by arith
9.1615 + also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> (norm x)\<twosuperior> \<le> a\<twosuperior>"
9.1616 + by (auto intro: power_mono dest: power2_le_imp_le)
9.1617 + also have "\<dots> \<longleftrightarrow> 0 \<le> a \<and> inner x x \<le> a\<twosuperior>"
9.1618 + unfolding power2_norm_eq_inner ..
9.1619 + finally show ?thesis .
9.1620 +qed
9.1621 +
9.1622 +lemma any_closest_point_unique:
9.1623 + fixes s :: "(real ^ _) set"
9.1624 + assumes "convex s" "closed s" "x \<in> s" "y \<in> s"
9.1625 + "\<forall>z\<in>s. dist a x \<le> dist a z" "\<forall>z\<in>s. dist a y \<le> dist a z"
9.1626 + 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)]
9.1627 + unfolding norm_pths(1) and norm_le_square
9.1628 + by (auto simp add: algebra_simps)
9.1629 +
9.1630 +lemma closest_point_unique:
9.1631 + assumes "convex s" "closed s" "x \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
9.1632 + shows "x = closest_point s a"
9.1633 + using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point s a"]
9.1634 + using closest_point_exists[OF assms(2)] and assms(3) by auto
9.1635 +
9.1636 +lemma closest_point_dot:
9.1637 + assumes "convex s" "closed s" "x \<in> s"
9.1638 + shows "inner (a - closest_point s a) (x - closest_point s a) \<le> 0"
9.1639 + apply(rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
9.1640 + using closest_point_exists[OF assms(2)] and assms(3) by auto
9.1641 +
9.1642 +lemma closest_point_lt:
9.1643 + assumes "convex s" "closed s" "x \<in> s" "x \<noteq> closest_point s a"
9.1644 + shows "dist a (closest_point s a) < dist a x"
9.1645 + apply(rule ccontr) apply(rule_tac notE[OF assms(4)])
9.1646 + apply(rule closest_point_unique[OF assms(1-3), of a])
9.1647 + using closest_point_le[OF assms(2), of _ a] by fastsimp
9.1648 +
9.1649 +lemma closest_point_lipschitz:
9.1650 + assumes "convex s" "closed s" "s \<noteq> {}"
9.1651 + shows "dist (closest_point s x) (closest_point s y) \<le> dist x y"
9.1652 +proof-
9.1653 + have "inner (x - closest_point s x) (closest_point s y - closest_point s x) \<le> 0"
9.1654 + "inner (y - closest_point s y) (closest_point s x - closest_point s y) \<le> 0"
9.1655 + apply(rule_tac[!] any_closest_point_dot[OF assms(1-2)])
9.1656 + using closest_point_exists[OF assms(2-3)] by auto
9.1657 + thus ?thesis unfolding dist_norm and norm_le
9.1658 + using inner_ge_zero[of "(x - closest_point s x) - (y - closest_point s y)"]
9.1659 + by (simp add: inner_add inner_diff inner_commute) qed
9.1660 +
9.1661 +lemma continuous_at_closest_point:
9.1662 + assumes "convex s" "closed s" "s \<noteq> {}"
9.1663 + shows "continuous (at x) (closest_point s)"
9.1664 + unfolding continuous_at_eps_delta
9.1665 + using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
9.1666 +
9.1667 +lemma continuous_on_closest_point:
9.1668 + assumes "convex s" "closed s" "s \<noteq> {}"
9.1669 + shows "continuous_on t (closest_point s)"
9.1670 + apply(rule continuous_at_imp_continuous_on) using continuous_at_closest_point[OF assms] by auto
9.1671 +
9.1672 +subsection {* Various point-to-set separating/supporting hyperplane theorems. *}
9.1673 +
9.1674 +lemma supporting_hyperplane_closed_point:
9.1675 + fixes s :: "(real ^ _) set"
9.1676 + assumes "convex s" "closed s" "s \<noteq> {}" "z \<notin> s"
9.1677 + 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)"
9.1678 +proof-
9.1679 + from distance_attains_inf[OF assms(2-3)] obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x" by auto
9.1680 + show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) y" in exI, rule_tac x=y in bexI)
9.1681 + apply rule defer apply rule defer apply(rule, rule ccontr) using `y\<in>s` proof-
9.1682 + show "inner (y - z) z < inner (y - z) y" apply(subst diff_less_iff(1)[THEN sym])
9.1683 + unfolding inner_diff_right[THEN sym] and inner_gt_zero_iff using `y\<in>s` `z\<notin>s` by auto
9.1684 + next
9.1685 + fix x assume "x\<in>s" have *:"\<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
9.1686 + using assms(1)[unfolded convex_alt] and y and `x\<in>s` and `y\<in>s` by auto
9.1687 + assume "\<not> inner (y - z) y \<le> inner (y - z) x" then obtain v where
9.1688 + "v>0" "v\<le>1" "dist (y + v *\<^sub>R (x - y)) z < dist y z" using closer_point_lemma[of z y x] apply - by (auto simp add: inner_diff)
9.1689 + thus False using *[THEN spec[where x=v]] by(auto simp add: dist_commute algebra_simps)
9.1690 + qed auto
9.1691 +qed
9.1692 +
9.1693 +lemma separating_hyperplane_closed_point:
9.1694 + fixes s :: "(real ^ _) set"
9.1695 + assumes "convex s" "closed s" "z \<notin> s"
9.1696 + shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>s. inner a x > b)"
9.1697 +proof(cases "s={}")
9.1698 + case True thus ?thesis apply(rule_tac x="-z" in exI, rule_tac x=1 in exI)
9.1699 + using less_le_trans[OF _ inner_ge_zero[of z]] by auto
9.1700 +next
9.1701 + case False obtain y where "y\<in>s" and y:"\<forall>x\<in>s. dist z y \<le> dist z x"
9.1702 + using distance_attains_inf[OF assms(2) False] by auto
9.1703 + show ?thesis apply(rule_tac x="y - z" in exI, rule_tac x="inner (y - z) z + (norm(y - z))\<twosuperior> / 2" in exI)
9.1704 + apply rule defer apply rule proof-
9.1705 + fix x assume "x\<in>s"
9.1706 + have "\<not> 0 < inner (z - y) (x - y)" apply(rule_tac notI) proof(drule closer_point_lemma)
9.1707 + assume "\<exists>u>0. u \<le> 1 \<and> dist (y + u *\<^sub>R (x - y)) z < dist y z"
9.1708 + then obtain u where "u>0" "u\<le>1" "dist (y + u *\<^sub>R (x - y)) z < dist y z" by auto
9.1709 + thus False using y[THEN bspec[where x="y + u *\<^sub>R (x - y)"]]
9.1710 + using assms(1)[unfolded convex_alt, THEN bspec[where x=y]]
9.1711 + using `x\<in>s` `y\<in>s` by (auto simp add: dist_commute algebra_simps) qed
9.1712 + moreover have "0 < norm (y - z) ^ 2" using `y\<in>s` `z\<notin>s` by auto
9.1713 + hence "0 < inner (y - z) (y - z)" unfolding power2_norm_eq_inner by simp
9.1714 + ultimately show "inner (y - z) z + (norm (y - z))\<twosuperior> / 2 < inner (y - z) x"
9.1715 + unfolding power2_norm_eq_inner and not_less by (auto simp add: field_simps inner_commute inner_diff)
9.1716 + qed(insert `y\<in>s` `z\<notin>s`, auto)
9.1717 +qed
9.1718 +
9.1719 +lemma separating_hyperplane_closed_0:
9.1720 + assumes "convex (s::(real^'n::finite) set)" "closed s" "0 \<notin> s"
9.1721 + shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>s. inner a x > b)"
9.1722 + proof(cases "s={}") guess a using UNIV_witness[where 'a='n] ..
9.1723 + case True have "norm ((basis a)::real^'n::finite) = 1"
9.1724 + using norm_basis and dimindex_ge_1 by auto
9.1725 + thus ?thesis apply(rule_tac x="basis a" in exI, rule_tac x=1 in exI) using True by auto
9.1726 +next case False thus ?thesis using False using separating_hyperplane_closed_point[OF assms]
9.1727 + apply - apply(erule exE)+ unfolding dot_rzero apply(rule_tac x=a in exI, rule_tac x=b in exI) by auto qed
9.1728 +
9.1729 +subsection {* Now set-to-set for closed/compact sets. *}
9.1730 +
9.1731 +lemma separating_hyperplane_closed_compact:
9.1732 + assumes "convex (s::(real^'n::finite) set)" "closed s" "convex t" "compact t" "t \<noteq> {}" "s \<inter> t = {}"
9.1733 + shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
9.1734 +proof(cases "s={}")
9.1735 + case True
9.1736 + 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
9.1737 + obtain z::"real^'n" where z:"norm z = b + 1" using vector_choose_size[of "b + 1"] and b(1) by auto
9.1738 + hence "z\<notin>t" using b(2)[THEN bspec[where x=z]] by auto
9.1739 + then obtain a b where ab:"inner a z < b" "\<forall>x\<in>t. b < inner a x"
9.1740 + using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z] by auto
9.1741 + thus ?thesis using True by auto
9.1742 +next
9.1743 + case False then obtain y where "y\<in>s" by auto
9.1744 + obtain a b where "0 < b" "\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. b < inner a x"
9.1745 + using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
9.1746 + using closed_compact_differences[OF assms(2,4)] using assms(6) by(auto, blast)
9.1747 + hence ab:"\<forall>x\<in>s. \<forall>y\<in>t. b + inner a y < inner a x" apply- apply(rule,rule) apply(erule_tac x="x - y" in ballE) by (auto simp add: inner_diff)
9.1748 + def k \<equiv> "rsup ((\<lambda>x. inner a x) ` t)"
9.1749 + show ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-(k + b / 2)" in exI)
9.1750 + apply(rule,rule) defer apply(rule) unfolding inner_minus_left and neg_less_iff_less proof-
9.1751 + from ab have "((\<lambda>x. inner a x) ` t) *<= (inner a y - b)"
9.1752 + apply(erule_tac x=y in ballE) apply(rule setleI) using `y\<in>s` by auto
9.1753 + hence k:"isLub UNIV ((\<lambda>x. inner a x) ` t) k" unfolding k_def apply(rule_tac rsup) using assms(5) by auto
9.1754 + fix x assume "x\<in>t" thus "inner a x < (k + b / 2)" using `0<b` and isLubD2[OF k, of "inner a x"] by auto
9.1755 + next
9.1756 + fix x assume "x\<in>s"
9.1757 + hence "k \<le> inner a x - b" unfolding k_def apply(rule_tac rsup_le) using assms(5)
9.1758 + unfolding setle_def
9.1759 + using ab[THEN bspec[where x=x]] by auto
9.1760 + thus "k + b / 2 < inner a x" using `0 < b` by auto
9.1761 + qed
9.1762 +qed
9.1763 +
9.1764 +lemma separating_hyperplane_compact_closed:
9.1765 + fixes s :: "(real ^ _) set"
9.1766 + assumes "convex s" "compact s" "s \<noteq> {}" "convex t" "closed t" "s \<inter> t = {}"
9.1767 + shows "\<exists>a b. (\<forall>x\<in>s. inner a x < b) \<and> (\<forall>x\<in>t. inner a x > b)"
9.1768 +proof- obtain a b where "(\<forall>x\<in>t. inner a x < b) \<and> (\<forall>x\<in>s. b < inner a x)"
9.1769 + using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6) by auto
9.1770 + thus ?thesis apply(rule_tac x="-a" in exI, rule_tac x="-b" in exI) by auto qed
9.1771 +
9.1772 +subsection {* General case without assuming closure and getting non-strict separation. *}
9.1773 +
9.1774 +lemma separating_hyperplane_set_0:
9.1775 + assumes "convex s" "(0::real^'n::finite) \<notin> s"
9.1776 + shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>s. 0 \<le> inner a x)"
9.1777 +proof- let ?k = "\<lambda>c. {x::real^'n. 0 \<le> inner c x}"
9.1778 + have "frontier (cball 0 1) \<inter> (\<Inter> (?k ` s)) \<noteq> {}"
9.1779 + apply(rule compact_imp_fip) apply(rule compact_frontier[OF compact_cball])
9.1780 + defer apply(rule,rule,erule conjE) proof-
9.1781 + fix f assume as:"f \<subseteq> ?k ` s" "finite f"
9.1782 + obtain c where c:"f = ?k ` c" "c\<subseteq>s" "finite c" using finite_subset_image[OF as(2,1)] by auto
9.1783 + then obtain a b where ab:"a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
9.1784 + using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
9.1785 + using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
9.1786 + using subset_hull[unfolded mem_def, of convex, OF assms(1), THEN sym, of c] by auto
9.1787 + hence "\<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)
9.1788 + using hull_subset[of c convex] unfolding subset_eq and inner_scaleR
9.1789 + apply- apply rule defer apply rule apply(rule mult_nonneg_nonneg)
9.1790 + by(auto simp add: inner_commute elim!: ballE)
9.1791 + thus "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" unfolding c(1) frontier_cball dist_norm by auto
9.1792 + qed(insert closed_halfspace_ge, auto)
9.1793 + then obtain x where "norm x = 1" "\<forall>y\<in>s. x\<in>?k y" unfolding frontier_cball dist_norm by auto
9.1794 + thus ?thesis apply(rule_tac x=x in exI) by(auto simp add: inner_commute) qed
9.1795 +
9.1796 +lemma separating_hyperplane_sets:
9.1797 + assumes "convex s" "convex (t::(real^'n::finite) set)" "s \<noteq> {}" "t \<noteq> {}" "s \<inter> t = {}"
9.1798 + 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)"
9.1799 +proof- from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
9.1800 + 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 auto
9.1801 + hence "\<forall>x\<in>t. \<forall>y\<in>s. inner a y \<le> inner a x" apply- apply(rule, rule) apply(erule_tac x="x - y" in ballE) by (auto simp add: inner_diff)
9.1802 + thus ?thesis apply(rule_tac x=a in exI, rule_tac x="rsup ((\<lambda>x. inner a x) ` s)" in exI) using `a\<noteq>0`
9.1803 + apply(rule) apply(rule,rule) apply(rule rsup[THEN isLubD2]) prefer 4 apply(rule,rule rsup_le) unfolding setle_def
9.1804 + prefer 4 using assms(3-5) by blast+ qed
9.1805 +
9.1806 +subsection {* More convexity generalities. *}
9.1807 +
9.1808 +lemma convex_closure:
9.1809 + fixes s :: "'a::real_normed_vector set"
9.1810 + assumes "convex s" shows "convex(closure s)"
9.1811 + unfolding convex_def Ball_def closure_sequential
9.1812 + apply(rule,rule,rule,rule,rule,rule,rule,rule,rule) apply(erule_tac exE)+
9.1813 + apply(rule_tac x="\<lambda>n. u *\<^sub>R xb n + v *\<^sub>R xc n" in exI) apply(rule,rule)
9.1814 + apply(rule assms[unfolded convex_def, rule_format]) prefer 6
9.1815 + apply(rule Lim_add) apply(rule_tac [1-2] Lim_cmul) by auto
9.1816 +
9.1817 +lemma convex_interior:
9.1818 + fixes s :: "'a::real_normed_vector set"
9.1819 + assumes "convex s" shows "convex(interior s)"
9.1820 + unfolding convex_alt Ball_def mem_interior apply(rule,rule,rule,rule,rule,rule) apply(erule exE | erule conjE)+ proof-
9.1821 + fix x y u assume u:"0 \<le> u" "u \<le> (1::real)"
9.1822 + fix e d assume ed:"ball x e \<subseteq> s" "ball y d \<subseteq> s" "0<d" "0<e"
9.1823 + show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> s" apply(rule_tac x="min d e" in exI)
9.1824 + apply rule unfolding subset_eq defer apply rule proof-
9.1825 + fix z assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
9.1826 + hence "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> s"
9.1827 + apply(rule_tac assms[unfolded convex_alt, rule_format])
9.1828 + using ed(1,2) and u unfolding subset_eq mem_ball Ball_def dist_norm by(auto simp add: algebra_simps)
9.1829 + thus "z \<in> s" using u by (auto simp add: algebra_simps) qed(insert u ed(3-4), auto) qed
9.1830 +
9.1831 +lemma convex_hull_eq_empty: "convex hull s = {} \<longleftrightarrow> s = {}"
9.1832 + using hull_subset[of s convex] convex_hull_empty by auto
9.1833 +
9.1834 +subsection {* Moving and scaling convex hulls. *}
9.1835 +
9.1836 +lemma convex_hull_translation_lemma:
9.1837 + "convex hull ((\<lambda>x. a + x) ` s) \<subseteq> (\<lambda>x. a + x) ` (convex hull s)"
9.1838 + apply(rule hull_minimal, rule image_mono, rule hull_subset) unfolding mem_def
9.1839 + using convex_translation[OF convex_convex_hull, of a s] by assumption
9.1840 +
9.1841 +lemma convex_hull_bilemma: fixes neg
9.1842 + assumes "(\<forall>s a. (convex hull (up a s)) \<subseteq> up a (convex hull s))"
9.1843 + shows "(\<forall>s. up a (up (neg a) s) = s) \<and> (\<forall>s. up (neg a) (up a s) = s) \<and> (\<forall>s t a. s \<subseteq> t \<longrightarrow> up a s \<subseteq> up a t)
9.1844 + \<Longrightarrow> \<forall>s. (convex hull (up a s)) = up a (convex hull s)"
9.1845 + using assms by(metis subset_antisym)
9.1846 +
9.1847 +lemma convex_hull_translation:
9.1848 + "convex hull ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (convex hull s)"
9.1849 + apply(rule convex_hull_bilemma[rule_format, of _ _ "\<lambda>a. -a"], rule convex_hull_translation_lemma) unfolding image_image by auto
9.1850 +
9.1851 +lemma convex_hull_scaling_lemma:
9.1852 + "(convex hull ((\<lambda>x. c *\<^sub>R x) ` s)) \<subseteq> (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
9.1853 + apply(rule hull_minimal, rule image_mono, rule hull_subset)
9.1854 + unfolding mem_def by(rule convex_scaling, rule convex_convex_hull)
9.1855 +
9.1856 +lemma convex_hull_scaling:
9.1857 + "convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
9.1858 + apply(cases "c=0") defer apply(rule convex_hull_bilemma[rule_format, of _ _ inverse]) apply(rule convex_hull_scaling_lemma)
9.1859 + unfolding image_image scaleR_scaleR by(auto simp add:image_constant_conv convex_hull_eq_empty)
9.1860 +
9.1861 +lemma convex_hull_affinity:
9.1862 + "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
9.1863 + unfolding image_image[THEN sym] convex_hull_scaling convex_hull_translation ..
9.1864 +
9.1865 +subsection {* Convex set as intersection of halfspaces. *}
9.1866 +
9.1867 +lemma convex_halfspace_intersection:
9.1868 + fixes s :: "(real ^ _) set"
9.1869 + assumes "closed s" "convex s"
9.1870 + shows "s = \<Inter> {h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
9.1871 + apply(rule set_ext, rule) unfolding Inter_iff Ball_def mem_Collect_eq apply(rule,rule,erule conjE) proof-
9.1872 + fix x assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
9.1873 + hence "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}" by blast
9.1874 + thus "x\<in>s" apply(rule_tac ccontr) apply(drule separating_hyperplane_closed_point[OF assms(2,1)])
9.1875 + apply(erule exE)+ apply(erule_tac x="-a" in allE, erule_tac x="-b" in allE) by auto
9.1876 +qed auto
9.1877 +
9.1878 +subsection {* Radon's theorem (from Lars Schewe). *}
9.1879 +
9.1880 +lemma radon_ex_lemma:
9.1881 + assumes "finite c" "affine_dependent c"
9.1882 + shows "\<exists>u. setsum u c = 0 \<and> (\<exists>v\<in>c. u v \<noteq> 0) \<and> setsum (\<lambda>v. u v *\<^sub>R v) c = 0"
9.1883 +proof- from assms(2)[unfolded affine_dependent_explicit] guess s .. then guess u ..
9.1884 + thus ?thesis apply(rule_tac x="\<lambda>v. if v\<in>s then u v else 0" in exI) unfolding if_smult scaleR_zero_left
9.1885 + and setsum_restrict_set[OF assms(1), THEN sym] by(auto simp add: Int_absorb1) qed
9.1886 +
9.1887 +lemma radon_s_lemma:
9.1888 + assumes "finite s" "setsum f s = (0::real)"
9.1889 + shows "setsum f {x\<in>s. 0 < f x} = - setsum f {x\<in>s. f x < 0}"
9.1890 +proof- have *:"\<And>x. (if f x < 0 then f x else 0) + (if 0 < f x then f x else 0) = f x" by auto
9.1891 + show ?thesis unfolding real_add_eq_0_iff[THEN sym] and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
9.1892 + using assms(2) by assumption qed
9.1893 +
9.1894 +lemma radon_v_lemma:
9.1895 + assumes "finite s" "setsum f s = 0" "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::real^'n)"
9.1896 + shows "(setsum f {x\<in>s. 0 < g x}) = - setsum f {x\<in>s. g x < 0}"
9.1897 +proof-
9.1898 + have *:"\<And>x. (if 0 < g x then f x else 0) + (if g x < 0 then f x else 0) = f x" using assms(3) by auto
9.1899 + show ?thesis unfolding eq_neg_iff_add_eq_0 and setsum_restrict_set''[OF assms(1)] and setsum_addf[THEN sym] and *
9.1900 + using assms(2) by assumption qed
9.1901 +
9.1902 +lemma radon_partition:
9.1903 + assumes "finite c" "affine_dependent c"
9.1904 + shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}" proof-
9.1905 + obtain u v where uv:"setsum u c = 0" "v\<in>c" "u v \<noteq> 0" "(\<Sum>v\<in>c. u v *\<^sub>R v) = 0" using radon_ex_lemma[OF assms] by auto
9.1906 + have fin:"finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}" using assms(1) by auto
9.1907 + def z \<equiv> "(inverse (setsum u {x\<in>c. u x > 0})) *\<^sub>R setsum (\<lambda>x. u x *\<^sub>R x) {x\<in>c. u x > 0}"
9.1908 + have "setsum u {x \<in> c. 0 < u x} \<noteq> 0" proof(cases "u v \<ge> 0")
9.1909 + case False hence "u v < 0" by auto
9.1910 + thus ?thesis proof(cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
9.1911 + case True thus ?thesis using setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
9.1912 + next
9.1913 + case False hence "setsum u c \<le> setsum (\<lambda>x. if x=v then u v else 0) c" apply(rule_tac setsum_mono) by auto
9.1914 + thus ?thesis unfolding setsum_delta[OF assms(1)] using uv(2) and `u v < 0` and uv(1) by auto qed
9.1915 + qed (insert setsum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
9.1916 +
9.1917 + hence *:"setsum u {x\<in>c. u x > 0} > 0" unfolding real_less_def apply(rule_tac conjI, rule_tac setsum_nonneg) by auto
9.1918 + moreover have "setsum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = setsum u c"
9.1919 + "(\<Sum>x\<in>{x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}. u x *\<^sub>R x) = (\<Sum>x\<in>c. u x *\<^sub>R x)"
9.1920 + using assms(1) apply(rule_tac[!] setsum_mono_zero_left) by auto
9.1921 + hence "setsum u {x \<in> c. 0 < u x} = - setsum u {x \<in> c. 0 > u x}"
9.1922 + "(\<Sum>x\<in>{x \<in> c. 0 < u x}. u x *\<^sub>R x) = - (\<Sum>x\<in>{x \<in> c. 0 > u x}. u x *\<^sub>R x)"
9.1923 + unfolding eq_neg_iff_add_eq_0 using uv(1,4) by (auto simp add: setsum_Un_zero[OF fin, THEN sym])
9.1924 + moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * - u x"
9.1925 + apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
9.1926 +
9.1927 + ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}" unfolding convex_hull_explicit mem_Collect_eq
9.1928 + apply(rule_tac x="{v \<in> c. u v < 0}" in exI, rule_tac x="\<lambda>y. inverse (setsum u {x\<in>c. u x > 0}) * - u y" in exI)
9.1929 + using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def
9.1930 + by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
9.1931 + moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (setsum u {x \<in> c. 0 < u x}) * u x"
9.1932 + apply (rule) apply (rule mult_nonneg_nonneg) using * by auto
9.1933 + hence "z \<in> convex hull {v \<in> c. u v > 0}" unfolding convex_hull_explicit mem_Collect_eq
9.1934 + apply(rule_tac x="{v \<in> c. 0 < u v}" in exI, rule_tac x="\<lambda>y. inverse (setsum u {x\<in>c. u x > 0}) * u y" in exI)
9.1935 + using assms(1) unfolding scaleR_scaleR[THEN sym] scaleR_right.setsum [symmetric] and z_def using *
9.1936 + by(auto simp add: setsum_negf vector_smult_lneg mult_right.setsum[THEN sym])
9.1937 + ultimately show ?thesis apply(rule_tac x="{v\<in>c. u v \<le> 0}" in exI, rule_tac x="{v\<in>c. u v > 0}" in exI) by auto
9.1938 +qed
9.1939 +
9.1940 +lemma radon: assumes "affine_dependent c"
9.1941 + obtains m p where "m\<subseteq>c" "p\<subseteq>c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
9.1942 +proof- from assms[unfolded affine_dependent_explicit] guess s .. then guess u ..
9.1943 + hence *:"finite s" "affine_dependent s" and s:"s \<subseteq> c" unfolding affine_dependent_explicit by auto
9.1944 + from radon_partition[OF *] guess m .. then guess p ..
9.1945 + thus ?thesis apply(rule_tac that[of p m]) using s by auto qed
9.1946 +
9.1947 +subsection {* Helly's theorem. *}
9.1948 +
9.1949 +lemma helly_induct: fixes f::"(real^'n::finite) set set"
9.1950 + assumes "f hassize n" "n \<ge> CARD('n) + 1"
9.1951 + "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
9.1952 + shows "\<Inter> f \<noteq> {}"
9.1953 + using assms unfolding hassize_def apply(erule_tac conjE) proof(induct n arbitrary: f)
9.1954 +case (Suc n)
9.1955 +show "\<Inter> f \<noteq> {}" apply(cases "n = CARD('n)") apply(rule Suc(4)[rule_format])
9.1956 + unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6) proof-
9.1957 + assume ng:"n \<noteq> CARD('n)" hence "\<exists>X. \<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" apply(rule_tac bchoice) unfolding ex_in_conv
9.1958 + apply(rule, rule Suc(1)[rule_format]) unfolding card_Diff_singleton_if[OF Suc(5)] and Suc(6)
9.1959 + defer apply(rule Suc(3)[rule_format]) defer apply(rule Suc(4)[rule_format]) using Suc(2,5) by auto
9.1960 + then obtain X where X:"\<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" by auto
9.1961 + show ?thesis proof(cases "inj_on X f")
9.1962 + case False then obtain s t where st:"s\<noteq>t" "s\<in>f" "t\<in>f" "X s = X t" unfolding inj_on_def by auto
9.1963 + hence *:"\<Inter> f = \<Inter> (f - {s}) \<inter> \<Inter> (f - {t})" by auto
9.1964 + show ?thesis unfolding * unfolding ex_in_conv[THEN sym] apply(rule_tac x="X s" in exI)
9.1965 + apply(rule, rule X[rule_format]) using X st by auto
9.1966 + next case True then obtain m p where mp:"m \<inter> p = {}" "m \<union> p = X ` f" "convex hull m \<inter> convex hull p \<noteq> {}"
9.1967 + using radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
9.1968 + unfolding card_image[OF True] and Suc(6) using Suc(2,5) and ng by auto
9.1969 + have "m \<subseteq> X ` f" "p \<subseteq> X ` f" using mp(2) by auto
9.1970 + then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f" unfolding subset_image_iff by auto
9.1971 + hence "f \<union> (g \<union> h) = f" by auto
9.1972 + hence f:"f = g \<union> h" using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
9.1973 + unfolding mp(2)[unfolded image_Un[THEN sym] gh] by auto
9.1974 + have *:"g \<inter> h = {}" using mp(1) unfolding gh using inj_on_image_Int[OF True gh(3,4)] by auto
9.1975 + have "convex hull (X ` h) \<subseteq> \<Inter> g" "convex hull (X ` g) \<subseteq> \<Inter> h"
9.1976 + apply(rule_tac [!] hull_minimal) using Suc(3) gh(3-4) unfolding mem_def unfolding subset_eq
9.1977 + apply(rule_tac [2] convex_Inter, rule_tac [4] convex_Inter) apply rule prefer 3 apply rule proof-
9.1978 + fix x assume "x\<in>X ` g" then guess y unfolding image_iff ..
9.1979 + thus "x\<in>\<Inter>h" using X[THEN bspec[where x=y]] using * f by auto next
9.1980 + fix x assume "x\<in>X ` h" then guess y unfolding image_iff ..
9.1981 + thus "x\<in>\<Inter>g" using X[THEN bspec[where x=y]] using * f by auto
9.1982 + qed(auto)
9.1983 + thus ?thesis unfolding f using mp(3)[unfolded gh] by blast qed
9.1984 +qed(insert dimindex_ge_1, auto) qed(auto)
9.1985 +
9.1986 +lemma helly: fixes f::"(real^'n::finite) set set"
9.1987 + assumes "finite f" "card f \<ge> CARD('n) + 1" "\<forall>s\<in>f. convex s"
9.1988 + "\<forall>t\<subseteq>f. card t = CARD('n) + 1 \<longrightarrow> \<Inter> t \<noteq> {}"
9.1989 + shows "\<Inter> f \<noteq>{}"
9.1990 + apply(rule helly_induct) unfolding hassize_def using assms by auto
9.1991 +
9.1992 +subsection {* Convex hull is "preserved" by a linear function. *}
9.1993 +
9.1994 +lemma convex_hull_linear_image:
9.1995 + assumes "bounded_linear f"
9.1996 + shows "f ` (convex hull s) = convex hull (f ` s)"
9.1997 + apply rule unfolding subset_eq ball_simps apply(rule_tac[!] hull_induct, rule hull_inc) prefer 3
9.1998 + apply(erule imageE)apply(rule_tac x=xa in image_eqI) apply assumption
9.1999 + apply(rule hull_subset[unfolded subset_eq, rule_format]) apply assumption
9.2000 +proof-
9.2001 + interpret f: bounded_linear f by fact
9.2002 + show "convex {x. f x \<in> convex hull f ` s}"
9.2003 + unfolding convex_def by(auto simp add: f.scaleR f.add convex_convex_hull[unfolded convex_def, rule_format]) next
9.2004 + interpret f: bounded_linear f by fact
9.2005 + show "convex {x. x \<in> f ` (convex hull s)}" using convex_convex_hull[unfolded convex_def, of s]
9.2006 + unfolding convex_def by (auto simp add: f.scaleR [symmetric] f.add [symmetric])
9.2007 +qed auto
9.2008 +
9.2009 +lemma in_convex_hull_linear_image:
9.2010 + assumes "bounded_linear f" "x \<in> convex hull s"
9.2011 + shows "(f x) \<in> convex hull (f ` s)"
9.2012 +using convex_hull_linear_image[OF assms(1)] assms(2) by auto
9.2013 +
9.2014 +subsection {* Homeomorphism of all convex compact sets with nonempty interior. *}
9.2015 +
9.2016 +lemma compact_frontier_line_lemma:
9.2017 + fixes s :: "(real ^ _) set"
9.2018 + assumes "compact s" "0 \<in> s" "x \<noteq> 0"
9.2019 + obtains u where "0 \<le> u" "(u *\<^sub>R x) \<in> frontier s" "\<forall>v>u. (v *\<^sub>R x) \<notin> s"
9.2020 +proof-
9.2021 + obtain b where b:"b>0" "\<forall>x\<in>s. norm x \<le> b" using compact_imp_bounded[OF assms(1), unfolded bounded_pos] by auto
9.2022 + let ?A = "{y. \<exists>u. 0 \<le> u \<and> u \<le> b / norm(x) \<and> (y = u *\<^sub>R x)}"
9.2023 + have A:"?A = (\<lambda>u. dest_vec1 u *\<^sub>R x) ` {0 .. vec1 (b / norm x)}"
9.2024 + unfolding image_image[of "\<lambda>u. u *\<^sub>R x" "\<lambda>x. dest_vec1 x", THEN sym]
9.2025 + unfolding dest_vec1_inverval vec1_dest_vec1 by auto
9.2026 + have "compact ?A" unfolding A apply(rule compact_continuous_image, rule continuous_at_imp_continuous_on)
9.2027 + apply(rule, rule continuous_vmul)
9.2028 + apply (rule continuous_dest_vec1)
9.2029 + apply(rule continuous_at_id) by(rule compact_interval)
9.2030 + moreover have "{y. \<exists>u\<ge>0. u \<le> b / norm x \<and> y = u *\<^sub>R x} \<inter> s \<noteq> {}" apply(rule not_disjointI[OF _ assms(2)])
9.2031 + unfolding mem_Collect_eq using `b>0` assms(3) by(auto intro!: divide_nonneg_pos)
9.2032 + ultimately obtain u y where obt: "u\<ge>0" "u \<le> b / norm x" "y = u *\<^sub>R x"
9.2033 + "y\<in>?A" "y\<in>s" "\<forall>z\<in>?A \<inter> s. dist 0 z \<le> dist 0 y" using distance_attains_sup[OF compact_inter[OF _ assms(1), of ?A], of 0] by auto
9.2034 +
9.2035 + have "norm x > 0" using assms(3)[unfolded zero_less_norm_iff[THEN sym]] by auto
9.2036 + { fix v assume as:"v > u" "v *\<^sub>R x \<in> s"
9.2037 + hence "v \<le> b / norm x" using b(2)[rule_format, OF as(2)]
9.2038 + using `u\<ge>0` unfolding pos_le_divide_eq[OF `norm x > 0`] by auto
9.2039 + hence "norm (v *\<^sub>R x) \<le> norm y" apply(rule_tac obt(6)[rule_format, unfolded dist_0_norm]) apply(rule IntI) defer
9.2040 + apply(rule as(2)) unfolding mem_Collect_eq apply(rule_tac x=v in exI)
9.2041 + using as(1) `u\<ge>0` by(auto simp add:field_simps)
9.2042 + hence False unfolding obt(3) using `u\<ge>0` `norm x > 0` `v>u` by(auto simp add:field_simps)
9.2043 + } note u_max = this
9.2044 +
9.2045 + have "u *\<^sub>R x \<in> frontier s" unfolding frontier_straddle apply(rule,rule,rule) apply(rule_tac x="u *\<^sub>R x" in bexI) unfolding obt(3)[THEN sym]
9.2046 + prefer 3 apply(rule_tac x="(u + (e / 2) / norm x) *\<^sub>R x" in exI) apply(rule, rule) proof-
9.2047 + fix e assume "0 < e" and as:"(u + e / 2 / norm x) *\<^sub>R x \<in> s"
9.2048 + hence "u + e / 2 / norm x > u" using`norm x > 0` by(auto simp del:zero_less_norm_iff intro!: divide_pos_pos)
9.2049 + thus False using u_max[OF _ as] by auto
9.2050 + qed(insert `y\<in>s`, auto simp add: dist_norm scaleR_left_distrib obt(3))
9.2051 + thus ?thesis apply(rule_tac that[of u]) apply(rule obt(1), assumption)
9.2052 + apply(rule,rule,rule ccontr) apply(rule u_max) by auto qed
9.2053 +
9.2054 +lemma starlike_compact_projective:
9.2055 + assumes "compact s" "cball (0::real^'n::finite) 1 \<subseteq> s "
9.2056 + "\<forall>x\<in>s. \<forall>u. 0 \<le> u \<and> u < 1 \<longrightarrow> (u *\<^sub>R x) \<in> (s - frontier s )"
9.2057 + shows "s homeomorphic (cball (0::real^'n::finite) 1)"
9.2058 +proof-
9.2059 + have fs:"frontier s \<subseteq> s" apply(rule frontier_subset_closed) using compact_imp_closed[OF assms(1)] by simp
9.2060 + def pi \<equiv> "\<lambda>x::real^'n. inverse (norm x) *\<^sub>R x"
9.2061 + have "0 \<notin> frontier s" unfolding frontier_straddle apply(rule ccontr) unfolding not_not apply(erule_tac x=1 in allE)
9.2062 + using assms(2)[unfolded subset_eq Ball_def mem_cball] by auto
9.2063 + have injpi:"\<And>x y. pi x = pi y \<and> norm x = norm y \<longleftrightarrow> x = y" unfolding pi_def by auto
9.2064 +
9.2065 + have contpi:"continuous_on (UNIV - {0}) pi" apply(rule continuous_at_imp_continuous_on)
9.2066 + apply rule unfolding pi_def
9.2067 + apply (rule continuous_mul)
9.2068 + apply (rule continuous_at_inv[unfolded o_def])
9.2069 + apply (rule continuous_at_norm)
9.2070 + apply simp
9.2071 + apply (rule continuous_at_id)
9.2072 + done
9.2073 + def sphere \<equiv> "{x::real^'n. norm x = 1}"
9.2074 + have pi:"\<And>x. x \<noteq> 0 \<Longrightarrow> pi x \<in> sphere" "\<And>x u. u>0 \<Longrightarrow> pi (u *\<^sub>R x) = pi x" unfolding pi_def sphere_def by auto
9.2075 +
9.2076 + have "0\<in>s" using assms(2) and centre_in_cball[of 0 1] by auto
9.2077 + have front_smul:"\<forall>x\<in>frontier s. \<forall>u\<ge>0. u *\<^sub>R x \<in> s \<longleftrightarrow> u \<le> 1" proof(rule,rule,rule)
9.2078 + fix x u assume x:"x\<in>frontier s" and "(0::real)\<le>u"
9.2079 + hence "x\<noteq>0" using `0\<notin>frontier s` by auto
9.2080 + obtain v where v:"0 \<le> v" "v *\<^sub>R x \<in> frontier s" "\<forall>w>v. w *\<^sub>R x \<notin> s"
9.2081 + using compact_frontier_line_lemma[OF assms(1) `0\<in>s` `x\<noteq>0`] by auto
9.2082 + have "v=1" apply(rule ccontr) unfolding neq_iff apply(erule disjE) proof-
9.2083 + assume "v<1" thus False using v(3)[THEN spec[where x=1]] using x and fs by auto next
9.2084 + assume "v>1" thus False using assms(3)[THEN bspec[where x="v *\<^sub>R x"], THEN spec[where x="inverse v"]]
9.2085 + using v and x and fs unfolding inverse_less_1_iff by auto qed
9.2086 + show "u *\<^sub>R x \<in> s \<longleftrightarrow> u \<le> 1" apply rule using v(3)[unfolded `v=1`, THEN spec[where x=u]] proof-
9.2087 + assume "u\<le>1" thus "u *\<^sub>R x \<in> s" apply(cases "u=1")
9.2088 + using assms(3)[THEN bspec[where x=x], THEN spec[where x=u]] using `0\<le>u` and x and fs by auto qed auto qed
9.2089 +
9.2090 + have "\<exists>surf. homeomorphism (frontier s) sphere pi surf"
9.2091 + apply(rule homeomorphism_compact) apply(rule compact_frontier[OF assms(1)])
9.2092 + apply(rule continuous_on_subset[OF contpi]) defer apply(rule set_ext,rule)
9.2093 + unfolding inj_on_def prefer 3 apply(rule,rule,rule)
9.2094 + proof- fix x assume "x\<in>pi ` frontier s" then obtain y where "y\<in>frontier s" "x = pi y" by auto
9.2095 + thus "x \<in> sphere" using pi(1)[of y] and `0 \<notin> frontier s` by auto
9.2096 + next fix x assume "x\<in>sphere" hence "norm x = 1" "x\<noteq>0" unfolding sphere_def by auto
9.2097 + then obtain u where "0 \<le> u" "u *\<^sub>R x \<in> frontier s" "\<forall>v>u. v *\<^sub>R x \<notin> s"
9.2098 + using compact_frontier_line_lemma[OF assms(1) `0\<in>s`, of x] by auto
9.2099 + thus "x \<in> pi ` frontier s" unfolding image_iff le_less pi_def apply(rule_tac x="u *\<^sub>R x" in bexI) using `norm x = 1` `0\<notin>frontier s` by auto
9.2100 + next fix x y assume as:"x \<in> frontier s" "y \<in> frontier s" "pi x = pi y"
9.2101 + hence xys:"x\<in>s" "y\<in>s" using fs by auto
9.2102 + from as(1,2) have nor:"norm x \<noteq> 0" "norm y \<noteq> 0" using `0\<notin>frontier s` by auto
9.2103 + from nor have x:"x = norm x *\<^sub>R ((inverse (norm y)) *\<^sub>R y)" unfolding as(3)[unfolded pi_def, THEN sym] by auto
9.2104 + from nor have y:"y = norm y *\<^sub>R ((inverse (norm x)) *\<^sub>R x)" unfolding as(3)[unfolded pi_def] by auto
9.2105 + have "0 \<le> norm y * inverse (norm x)" "0 \<le> norm x * inverse (norm y)"
9.2106 + unfolding divide_inverse[THEN sym] apply(rule_tac[!] divide_nonneg_pos) using nor by auto
9.2107 + hence "norm x = norm y" apply(rule_tac ccontr) unfolding neq_iff
9.2108 + using x y and front_smul[THEN bspec, OF as(1), THEN spec[where x="norm y * (inverse (norm x))"]]
9.2109 + using front_smul[THEN bspec, OF as(2), THEN spec[where x="norm x * (inverse (norm y))"]]
9.2110 + using xys nor by(auto simp add:field_simps divide_le_eq_1 divide_inverse[THEN sym])
9.2111 + thus "x = y" apply(subst injpi[THEN sym]) using as(3) by auto
9.2112 + qed(insert `0 \<notin> frontier s`, auto)
9.2113 + then obtain surf where surf:"\<forall>x\<in>frontier s. surf (pi x) = x" "pi ` frontier s = sphere" "continuous_on (frontier s) pi"
9.2114 + "\<forall>y\<in>sphere. pi (surf y) = y" "surf ` sphere = frontier s" "continuous_on sphere surf" unfolding homeomorphism_def by auto
9.2115 +
9.2116 + have cont_surfpi:"continuous_on (UNIV - {0}) (surf \<circ> pi)" apply(rule continuous_on_compose, rule contpi)
9.2117 + apply(rule continuous_on_subset[of sphere], rule surf(6)) using pi(1) by auto
9.2118 +
9.2119 + { fix x assume as:"x \<in> cball (0::real^'n) 1"
9.2120 + have "norm x *\<^sub>R surf (pi x) \<in> s" proof(cases "x=0 \<or> norm x = 1")
9.2121 + case False hence "pi x \<in> sphere" "norm x < 1" using pi(1)[of x] as by(auto simp add: dist_norm)
9.2122 + thus ?thesis apply(rule_tac assms(3)[rule_format, THEN DiffD1])
9.2123 + apply(rule_tac fs[unfolded subset_eq, rule_format])
9.2124 + unfolding surf(5)[THEN sym] by auto
9.2125 + next case True thus ?thesis apply rule defer unfolding pi_def apply(rule fs[unfolded subset_eq, rule_format])
9.2126 + unfolding surf(5)[unfolded sphere_def, THEN sym] using `0\<in>s` by auto qed } note hom = this
9.2127 +
9.2128 + { fix x assume "x\<in>s"
9.2129 + hence "x \<in> (\<lambda>x. norm x *\<^sub>R surf (pi x)) ` cball 0 1" proof(cases "x=0")
9.2130 + case True show ?thesis unfolding image_iff True apply(rule_tac x=0 in bexI) by auto
9.2131 + next let ?a = "inverse (norm (surf (pi x)))"
9.2132 + case False hence invn:"inverse (norm x) \<noteq> 0" by auto
9.2133 + from False have pix:"pi x\<in>sphere" using pi(1) by auto
9.2134 + hence "pi (surf (pi x)) = pi x" apply(rule_tac surf(4)[rule_format]) by assumption
9.2135 + hence **:"norm x *\<^sub>R (?a *\<^sub>R surf (pi x)) = x" apply(rule_tac scaleR_left_imp_eq[OF invn]) unfolding pi_def using invn by auto
9.2136 + hence *:"?a * norm x > 0" and"?a > 0" "?a \<noteq> 0" using surf(5) `0\<notin>frontier s` apply -
9.2137 + apply(rule_tac mult_pos_pos) using False[unfolded zero_less_norm_iff[THEN sym]] by auto
9.2138 + have "norm (surf (pi x)) \<noteq> 0" using ** False by auto
9.2139 + hence "norm x = norm ((?a * norm x) *\<^sub>R surf (pi x))"
9.2140 + unfolding norm_scaleR abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`] by auto
9.2141 + moreover have "pi x = pi ((inverse (norm (surf (pi x))) * norm x) *\<^sub>R surf (pi x))"
9.2142 + unfolding pi(2)[OF *] surf(4)[rule_format, OF pix] ..
9.2143 + moreover have "surf (pi x) \<in> frontier s" using surf(5) pix by auto
9.2144 + hence "dist 0 (inverse (norm (surf (pi x))) *\<^sub>R x) \<le> 1" unfolding dist_norm
9.2145 + using ** and * using front_smul[THEN bspec[where x="surf (pi x)"], THEN spec[where x="norm x * ?a"]]
9.2146 + using False `x\<in>s` by(auto simp add:field_simps)
9.2147 + ultimately show ?thesis unfolding image_iff apply(rule_tac x="inverse (norm (surf(pi x))) *\<^sub>R x" in bexI)
9.2148 + apply(subst injpi[THEN sym]) unfolding abs_mult abs_norm_cancel abs_of_pos[OF `?a > 0`]
9.2149 + unfolding pi(2)[OF `?a > 0`] by auto
9.2150 + qed } note hom2 = this
9.2151 +
9.2152 + show ?thesis apply(subst homeomorphic_sym) apply(rule homeomorphic_compact[where f="\<lambda>x. norm x *\<^sub>R surf (pi x)"])
9.2153 + apply(rule compact_cball) defer apply(rule set_ext, rule, erule imageE, drule hom)
9.2154 + prefer 4 apply(rule continuous_at_imp_continuous_on, rule) apply(rule_tac [3] hom2) proof-
9.2155 + fix x::"real^'n" assume as:"x \<in> cball 0 1"
9.2156 + thus "continuous (at x) (\<lambda>x. norm x *\<^sub>R surf (pi x))" proof(cases "x=0")
9.2157 + case False thus ?thesis apply(rule_tac continuous_mul, rule_tac continuous_at_norm)
9.2158 + using cont_surfpi unfolding continuous_on_eq_continuous_at[OF open_delete[OF open_UNIV]] o_def by auto
9.2159 + next guess a using UNIV_witness[where 'a = 'n] ..
9.2160 + obtain B where B:"\<forall>x\<in>s. norm x \<le> B" using compact_imp_bounded[OF assms(1)] unfolding bounded_iff by auto
9.2161 + hence "B > 0" using assms(2) unfolding subset_eq apply(erule_tac x="basis a" in ballE) defer apply(erule_tac x="basis a" in ballE)
9.2162 + unfolding Ball_def mem_cball dist_norm by (auto simp add: norm_basis[unfolded One_nat_def])
9.2163 + case True show ?thesis unfolding True continuous_at Lim_at apply(rule,rule) apply(rule_tac x="e / B" in exI)
9.2164 + apply(rule) apply(rule divide_pos_pos) prefer 3 apply(rule,rule,erule conjE)
9.2165 + unfolding norm_0 scaleR_zero_left dist_norm diff_0_right norm_scaleR abs_norm_cancel proof-
9.2166 + fix e and x::"real^'n" assume as:"norm x < e / B" "0 < norm x" "0<e"
9.2167 + hence "surf (pi x) \<in> frontier s" using pi(1)[of x] unfolding surf(5)[THEN sym] by auto
9.2168 + hence "norm (surf (pi x)) \<le> B" using B fs by auto
9.2169 + hence "norm x * norm (surf (pi x)) \<le> norm x * B" using as(2) by auto
9.2170 + also have "\<dots> < e / B * B" apply(rule mult_strict_right_mono) using as(1) `B>0` by auto
9.2171 + also have "\<dots> = e" using `B>0` by auto
9.2172 + finally show "norm x * norm (surf (pi x)) < e" by assumption
9.2173 + qed(insert `B>0`, auto) qed
9.2174 + next { fix x assume as:"surf (pi x) = 0"
9.2175 + have "x = 0" proof(rule ccontr)
9.2176 + assume "x\<noteq>0" hence "pi x \<in> sphere" using pi(1) by auto
9.2177 + hence "surf (pi x) \<in> frontier s" using surf(5) by auto
9.2178 + thus False using `0\<notin>frontier s` unfolding as by simp qed
9.2179 + } note surf_0 = this
9.2180 + show "inj_on (\<lambda>x. norm x *\<^sub>R surf (pi x)) (cball 0 1)" unfolding inj_on_def proof(rule,rule,rule)
9.2181 + fix x y assume as:"x \<in> cball 0 1" "y \<in> cball 0 1" "norm x *\<^sub>R surf (pi x) = norm y *\<^sub>R surf (pi y)"
9.2182 + thus "x=y" proof(cases "x=0 \<or> y=0")
9.2183 + case True thus ?thesis using as by(auto elim: surf_0) next
9.2184 + case False
9.2185 + hence "pi (surf (pi x)) = pi (surf (pi y))" using as(3)
9.2186 + using pi(2)[of "norm x" "surf (pi x)"] pi(2)[of "norm y" "surf (pi y)"] by auto
9.2187 + moreover have "pi x \<in> sphere" "pi y \<in> sphere" using pi(1) False by auto
9.2188 + ultimately have *:"pi x = pi y" using surf(4)[THEN bspec[where x="pi x"]] surf(4)[THEN bspec[where x="pi y"]] by auto
9.2189 + moreover have "norm x = norm y" using as(3)[unfolded *] using False by(auto dest:surf_0)
9.2190 + ultimately show ?thesis using injpi by auto qed qed
9.2191 + qed auto qed
9.2192 +
9.2193 +lemma homeomorphic_convex_compact_lemma: fixes s::"(real^'n::finite) set"
9.2194 + assumes "convex s" "compact s" "cball 0 1 \<subseteq> s"
9.2195 + shows "s homeomorphic (cball (0::real^'n) 1)"
9.2196 + apply(rule starlike_compact_projective[OF assms(2-3)]) proof(rule,rule,rule,erule conjE)
9.2197 + fix x u assume as:"x \<in> s" "0 \<le> u" "u < (1::real)"
9.2198 + hence "u *\<^sub>R x \<in> interior s" unfolding interior_def mem_Collect_eq
9.2199 + apply(rule_tac x="ball (u *\<^sub>R x) (1 - u)" in exI) apply(rule, rule open_ball)
9.2200 + unfolding centre_in_ball apply rule defer apply(rule) unfolding mem_ball proof-
9.2201 + fix y assume "dist (u *\<^sub>R x) y < 1 - u"
9.2202 + hence "inverse (1 - u) *\<^sub>R (y - u *\<^sub>R x) \<in> s"
9.2203 + using assms(3) apply(erule_tac subsetD) unfolding mem_cball dist_commute dist_norm
9.2204 + unfolding group_add_class.diff_0 group_add_class.diff_0_right norm_minus_cancel norm_scaleR
9.2205 + apply (rule mult_left_le_imp_le[of "1 - u"])
9.2206 + unfolding class_semiring.mul_a using `u<1` by auto
9.2207 + thus "y \<in> s" using assms(1)[unfolded convex_def, rule_format, of "inverse(1 - u) *\<^sub>R (y - u *\<^sub>R x)" x "1 - u" u]
9.2208 + using as unfolding scaleR_scaleR by auto qed auto
9.2209 + thus "u *\<^sub>R x \<in> s - frontier s" using frontier_def and interior_subset by auto qed
9.2210 +
9.2211 +lemma homeomorphic_convex_compact_cball: fixes e::real and s::"(real^'n::finite) set"
9.2212 + assumes "convex s" "compact s" "interior s \<noteq> {}" "0 < e"
9.2213 + shows "s homeomorphic (cball (b::real^'n::finite) e)"
9.2214 +proof- obtain a where "a\<in>interior s" using assms(3) by auto
9.2215 + then obtain d where "d>0" and d:"cball a d \<subseteq> s" unfolding mem_interior_cball by auto
9.2216 + let ?d = "inverse d" and ?n = "0::real^'n"
9.2217 + have "cball ?n 1 \<subseteq> (\<lambda>x. inverse d *\<^sub>R (x - a)) ` s"
9.2218 + apply(rule, rule_tac x="d *\<^sub>R x + a" in image_eqI) defer
9.2219 + apply(rule d[unfolded subset_eq, rule_format]) using `d>0` unfolding mem_cball dist_norm
9.2220 + by(auto simp add: mult_right_le_one_le)
9.2221 + hence "(\<lambda>x. inverse d *\<^sub>R (x - a)) ` s homeomorphic cball ?n 1"
9.2222 + using homeomorphic_convex_compact_lemma[of "(\<lambda>x. ?d *\<^sub>R -a + ?d *\<^sub>R x) ` s", OF convex_affinity compact_affinity]
9.2223 + using assms(1,2) by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib)
9.2224 + thus ?thesis apply(rule_tac homeomorphic_trans[OF _ homeomorphic_balls(2)[of 1 _ ?n]])
9.2225 + apply(rule homeomorphic_trans[OF homeomorphic_affinity[of "?d" s "?d *\<^sub>R -a"]])
9.2226 + using `d>0` `e>0` by(auto simp add: uminus_add_conv_diff scaleR_right_diff_distrib) qed
9.2227 +
9.2228 +lemma homeomorphic_convex_compact: fixes s::"(real^'n::finite) set" and t::"(real^'n) set"
9.2229 + assumes "convex s" "compact s" "interior s \<noteq> {}"
9.2230 + "convex t" "compact t" "interior t \<noteq> {}"
9.2231 + shows "s homeomorphic t"
9.2232 + using assms by(meson zero_less_one homeomorphic_trans homeomorphic_convex_compact_cball homeomorphic_sym)
9.2233 +
9.2234 +subsection {* Epigraphs of convex functions. *}
9.2235 +
9.2236 +definition "epigraph s (f::real^'n \<Rightarrow> real) = {xy. fstcart xy \<in> s \<and> f(fstcart xy) \<le> dest_vec1 (sndcart xy)}"
9.2237 +
9.2238 +lemma mem_epigraph: "(pastecart x (vec1 y)) \<in> epigraph s f \<longleftrightarrow> x \<in> s \<and> f x \<le> y" unfolding epigraph_def by auto
9.2239 +
9.2240 +lemma convex_epigraph:
9.2241 + "convex(epigraph s f) \<longleftrightarrow> convex_on s f \<and> convex s"
9.2242 + unfolding convex_def convex_on_def unfolding Ball_def forall_pastecart epigraph_def
9.2243 + unfolding mem_Collect_eq fstcart_pastecart sndcart_pastecart sndcart_add sndcart_cmul [where 'a=real, unfolded smult_conv_scaleR] fstcart_add fstcart_cmul [where 'a=real, unfolded smult_conv_scaleR]
9.2244 + unfolding Ball_def[symmetric] unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR]
9.2245 + apply(subst forall_dest_vec1[THEN sym])+ by(meson real_le_refl real_le_trans add_mono mult_left_mono)
9.2246 +
9.2247 +lemma convex_epigraphI: assumes "convex_on s f" "convex s"
9.2248 + shows "convex(epigraph s f)" using assms unfolding convex_epigraph by auto
9.2249 +
9.2250 +lemma convex_epigraph_convex: "convex s \<Longrightarrow> (convex_on s f \<longleftrightarrow> convex(epigraph s f))"
9.2251 + using convex_epigraph by auto
9.2252 +
9.2253 +subsection {* Use this to derive general bound property of convex function. *}
9.2254 +
9.2255 +lemma forall_of_pastecart:
9.2256 + "(\<forall>p. P (\<lambda>x. fstcart (p x)) (\<lambda>x. sndcart (p x))) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
9.2257 + apply(erule_tac x="\<lambda>a. pastecart (x a) (y a)" in allE) unfolding o_def by auto
9.2258 +
9.2259 +lemma forall_of_pastecart':
9.2260 + "(\<forall>p. P (fstcart p) (sndcart p)) \<longleftrightarrow> (\<forall>x y. P x y)" apply meson
9.2261 + apply(erule_tac x="pastecart x y" in allE) unfolding o_def by auto
9.2262 +
9.2263 +lemma forall_of_dest_vec1: "(\<forall>v. P (\<lambda>x. dest_vec1 (v x))) \<longleftrightarrow> (\<forall>x. P x)"
9.2264 + apply rule apply rule apply(erule_tac x="(vec1 \<circ> x)" in allE) unfolding o_def vec1_dest_vec1 by auto
9.2265 +
9.2266 +lemma forall_of_dest_vec1': "(\<forall>v. P (dest_vec1 v)) \<longleftrightarrow> (\<forall>x. P x)"
9.2267 + apply rule apply rule apply(erule_tac x="(vec1 x)" in allE) defer apply rule
9.2268 + apply(erule_tac x="dest_vec1 v" in allE) unfolding o_def vec1_dest_vec1 by auto
9.2269 +
9.2270 +lemma convex_on:
9.2271 + fixes s :: "(real ^ _) set"
9.2272 + assumes "convex s"
9.2273 + shows "convex_on s f \<longleftrightarrow> (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> s) \<and> setsum u {1..k} = 1 \<longrightarrow>
9.2274 + f (setsum (\<lambda>i. u i *\<^sub>R x i) {1..k} ) \<le> setsum (\<lambda>i. u i * f(x i)) {1..k} ) "
9.2275 + unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
9.2276 + unfolding sndcart_setsum[OF finite_atLeastAtMost] fstcart_setsum[OF finite_atLeastAtMost] dest_vec1_setsum[OF finite_atLeastAtMost]
9.2277 + unfolding fstcart_pastecart sndcart_pastecart sndcart_add sndcart_cmul [where 'a=real, unfolded smult_conv_scaleR] fstcart_add fstcart_cmul [where 'a=real, unfolded smult_conv_scaleR]
9.2278 + unfolding dest_vec1_add dest_vec1_cmul [where 'a=real, unfolded smult_conv_scaleR] apply(subst forall_of_pastecart)+ apply(subst forall_of_dest_vec1)+ apply rule
9.2279 + using assms[unfolded convex] apply simp apply(rule,rule,rule)
9.2280 + apply(erule_tac x=k in allE, erule_tac x=u in allE, erule_tac x=x in allE) apply rule apply rule apply rule defer
9.2281 + apply(rule_tac j="\<Sum>i = 1..k. u i * f (x i)" in real_le_trans)
9.2282 + defer apply(rule setsum_mono) apply(erule conjE)+ apply(erule_tac x=i in allE)apply(rule mult_left_mono)
9.2283 + using assms[unfolded convex] by auto
9.2284 +
9.2285 +subsection {* Convexity of general and special intervals. *}
9.2286 +
9.2287 +lemma is_interval_convex:
9.2288 + fixes s :: "(real ^ _) set"
9.2289 + assumes "is_interval s" shows "convex s"
9.2290 + unfolding convex_def apply(rule,rule,rule,rule,rule,rule,rule) proof-
9.2291 + fix x y u v assume as:"x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
9.2292 + hence *:"u = 1 - v" "1 - v \<ge> 0" and **:"v = 1 - u" "1 - u \<ge> 0" by auto
9.2293 + { fix a b assume "\<not> b \<le> u * a + v * b"
9.2294 + hence "u * a < (1 - v) * b" unfolding not_le using as(4) by(auto simp add: field_simps)
9.2295 + hence "a < b" unfolding * using as(4) *(2) apply(rule_tac mult_left_less_imp_less[of "1 - v"]) by(auto simp add: field_simps)
9.2296 + hence "a \<le> u * a + v * b" unfolding * using as(4) by (auto simp add: field_simps intro!:mult_right_mono)
9.2297 + } moreover
9.2298 + { fix a b assume "\<not> u * a + v * b \<le> a"
9.2299 + hence "v * b > (1 - u) * a" unfolding not_le using as(4) by(auto simp add: field_simps)
9.2300 + hence "a < b" unfolding * using as(4) apply(rule_tac mult_left_less_imp_less) by(auto simp add: ring_simps)
9.2301 + hence "u * a + v * b \<le> b" unfolding ** using **(2) as(3) by(auto simp add: field_simps intro!:mult_right_mono) }
9.2302 + 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)])
9.2303 + using as(3-) dimindex_ge_1 apply- by(auto simp add: vector_component) qed
9.2304 +
9.2305 +lemma is_interval_connected:
9.2306 + fixes s :: "(real ^ _) set"
9.2307 + shows "is_interval s \<Longrightarrow> connected s"
9.2308 + using is_interval_convex convex_connected by auto
9.2309 +
9.2310 +lemma convex_interval: "convex {a .. b}" "convex {a<..<b::real^'n::finite}"
9.2311 + apply(rule_tac[!] is_interval_convex) using is_interval_interval by auto
9.2312 +
9.2313 +subsection {* On @{text "real^1"}, @{text "is_interval"}, @{text "convex"} and @{text "connected"} are all equivalent. *}
9.2314 +
9.2315 +lemma is_interval_1:
9.2316 + "is_interval s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. \<forall> x. dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b \<longrightarrow> x \<in> s)"
9.2317 + unfolding is_interval_def dest_vec1_def forall_1 by auto
9.2318 +
9.2319 +lemma is_interval_connected_1: "is_interval s \<longleftrightarrow> connected (s::(real^1) set)"
9.2320 + apply(rule, rule is_interval_connected, assumption) unfolding is_interval_1
9.2321 + apply(rule,rule,rule,rule,erule conjE,rule ccontr) proof-
9.2322 + fix a b x assume as:"connected s" "a \<in> s" "b \<in> s" "dest_vec1 a \<le> dest_vec1 x" "dest_vec1 x \<le> dest_vec1 b" "x\<notin>s"
9.2323 + hence *:"dest_vec1 a < dest_vec1 x" "dest_vec1 x < dest_vec1 b" apply(rule_tac [!] ccontr) unfolding not_less by auto
9.2324 + let ?halfl = "{z. inner (basis 1) z < dest_vec1 x} " and ?halfr = "{z. inner (basis 1) z > dest_vec1 x} "
9.2325 + { fix y assume "y \<in> s" have "y \<in> ?halfr \<union> ?halfl" apply(rule ccontr)
9.2326 + using as(6) `y\<in>s` by (auto simp add: inner_vector_def dest_vec1_eq [unfolded dest_vec1_def] dest_vec1_def) }
9.2327 + moreover have "a\<in>?halfl" "b\<in>?halfr" using * by (auto simp add: inner_vector_def dest_vec1_def)
9.2328 + hence "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}" using as(2-3) by auto
9.2329 + ultimately show False apply(rule_tac notE[OF as(1)[unfolded connected_def]])
9.2330 + apply(rule_tac x="?halfl" in exI, rule_tac x="?halfr" in exI)
9.2331 + apply(rule, rule open_halfspace_lt, rule, rule open_halfspace_gt) apply(rule, rule, rule ccontr)
9.2332 + by(auto simp add: basis_component field_simps) qed
9.2333 +
9.2334 +lemma is_interval_convex_1:
9.2335 + "is_interval s \<longleftrightarrow> convex (s::(real^1) set)"
9.2336 + using is_interval_convex convex_connected is_interval_connected_1 by auto
9.2337 +
9.2338 +lemma convex_connected_1:
9.2339 + "connected s \<longleftrightarrow> convex (s::(real^1) set)"
9.2340 + using is_interval_convex convex_connected is_interval_connected_1 by auto
9.2341 +
9.2342 +subsection {* Another intermediate value theorem formulation. *}
9.2343 +
9.2344 +lemma ivt_increasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
9.2345 + assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f a)$k \<le> y" "y \<le> (f b)$k"
9.2346 + shows "\<exists>x\<in>{a..b}. (f x)$k = y"
9.2347 +proof- have "f a \<in> f ` {a..b}" "f b \<in> f ` {a..b}" apply(rule_tac[!] imageI)
9.2348 + using assms(1) by(auto simp add: vector_less_eq_def dest_vec1_def)
9.2349 + thus ?thesis using connected_ivt_component[of "f ` {a..b}" "f a" "f b" k y]
9.2350 + using connected_continuous_image[OF assms(2) convex_connected[OF convex_interval(1)]]
9.2351 + using assms by(auto intro!: imageI) qed
9.2352 +
9.2353 +lemma ivt_increasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
9.2354 + assumes "dest_vec1 a \<le> dest_vec1 b"
9.2355 + "\<forall>x\<in>{a .. b}. continuous (at x) f" "f a$k \<le> y" "y \<le> f b$k"
9.2356 + shows "\<exists>x\<in>{a..b}. (f x)$k = y"
9.2357 + apply(rule ivt_increasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
9.2358 +
9.2359 +lemma ivt_decreasing_component_on_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
9.2360 + assumes "dest_vec1 a \<le> dest_vec1 b" "continuous_on {a .. b} f" "(f b)$k \<le> y" "y \<le> (f a)$k"
9.2361 + shows "\<exists>x\<in>{a..b}. (f x)$k = y"
9.2362 + apply(subst neg_equal_iff_equal[THEN sym]) unfolding vector_uminus_component[THEN sym]
9.2363 + apply(rule ivt_increasing_component_on_1) using assms using continuous_on_neg
9.2364 + by(auto simp add:vector_uminus_component)
9.2365 +
9.2366 +lemma ivt_decreasing_component_1: fixes f::"real^1 \<Rightarrow> real^'n::finite"
9.2367 + assumes "dest_vec1 a \<le> dest_vec1 b" "\<forall>x\<in>{a .. b}. continuous (at x) f" "f b$k \<le> y" "y \<le> f a$k"
9.2368 + shows "\<exists>x\<in>{a..b}. (f x)$k = y"
9.2369 + apply(rule ivt_decreasing_component_on_1) using assms using continuous_at_imp_continuous_on by auto
9.2370 +
9.2371 +subsection {* A bound within a convex hull, and so an interval. *}
9.2372 +
9.2373 +lemma convex_on_convex_hull_bound:
9.2374 + fixes s :: "(real ^ _) set"
9.2375 + assumes "convex_on (convex hull s) f" "\<forall>x\<in>s. f x \<le> b"
9.2376 + shows "\<forall>x\<in> convex hull s. f x \<le> b" proof
9.2377 + fix x assume "x\<in>convex hull s"
9.2378 + then obtain k u v where obt:"\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> v i \<in> s" "setsum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R v i) = x"
9.2379 + unfolding convex_hull_indexed mem_Collect_eq by auto
9.2380 + have "(\<Sum>i = 1..k. u i * f (v i)) \<le> b" using setsum_mono[of "{1..k}" "\<lambda>i. u i * f (v i)" "\<lambda>i. u i * b"]
9.2381 + unfolding setsum_left_distrib[THEN sym] obt(2) mult_1 apply(drule_tac meta_mp) apply(rule mult_left_mono)
9.2382 + using assms(2) obt(1) by auto
9.2383 + thus "f x \<le> b" using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
9.2384 + unfolding obt(2-3) using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s] by auto qed
9.2385 +
9.2386 +lemma unit_interval_convex_hull:
9.2387 + "{0::real^'n::finite .. 1} = convex hull {x. \<forall>i. (x$i = 0) \<or> (x$i = 1)}" (is "?int = convex hull ?points")
9.2388 +proof- have 01:"{0,1} \<subseteq> convex hull ?points" apply rule apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) by auto
9.2389 + { fix n x assume "x\<in>{0::real^'n .. 1}" "n \<le> CARD('n)" "card {i. x$i \<noteq> 0} \<le> n"
9.2390 + hence "x\<in>convex hull ?points" proof(induct n arbitrary: x)
9.2391 + case 0 hence "x = 0" apply(subst Cart_eq) apply rule by auto
9.2392 + thus "x\<in>convex hull ?points" using 01 by auto
9.2393 + next
9.2394 + case (Suc n) show "x\<in>convex hull ?points" proof(cases "{i. x$i \<noteq> 0} = {}")
9.2395 + case True hence "x = 0" unfolding Cart_eq by auto
9.2396 + thus "x\<in>convex hull ?points" using 01 by auto
9.2397 + next
9.2398 + case False def xi \<equiv> "Min ((\<lambda>i. x$i) ` {i. x$i \<noteq> 0})"
9.2399 + have "xi \<in> (\<lambda>i. x$i) ` {i. x$i \<noteq> 0}" unfolding xi_def apply(rule Min_in) using False by auto
9.2400 + then obtain i where i':"x$i = xi" "x$i \<noteq> 0" by auto
9.2401 + have i:"\<And>j. x$j > 0 \<Longrightarrow> x$i \<le> x$j"
9.2402 + unfolding i'(1) xi_def apply(rule_tac Min_le) unfolding image_iff
9.2403 + defer apply(rule_tac x=j in bexI) using i' by auto
9.2404 + have i01:"x$i \<le> 1" "x$i > 0" using Suc(2)[unfolded mem_interval,rule_format,of i] using i'(2) `x$i \<noteq> 0`
9.2405 + by(auto simp add: Cart_lambda_beta)
9.2406 + show ?thesis proof(cases "x$i=1")
9.2407 + case True have "\<forall>j\<in>{i. x$i \<noteq> 0}. x$j = 1" apply(rule, rule ccontr) unfolding mem_Collect_eq proof-
9.2408 + fix j assume "x $ j \<noteq> 0" "x $ j \<noteq> 1"
9.2409 + hence j:"x$j \<in> {0<..<1}" using Suc(2) by(auto simp add: vector_less_eq_def elim!:allE[where x=j])
9.2410 + hence "x$j \<in> op $ x ` {i. x $ i \<noteq> 0}" by auto
9.2411 + hence "x$j \<ge> x$i" unfolding i'(1) xi_def apply(rule_tac Min_le) by auto
9.2412 + thus False using True Suc(2) j by(auto simp add: vector_less_eq_def elim!:ballE[where x=j]) qed
9.2413 + thus "x\<in>convex hull ?points" apply(rule_tac hull_subset[unfolded subset_eq, rule_format])
9.2414 + by(auto simp add: Cart_lambda_beta)
9.2415 + next let ?y = "\<lambda>j. if x$j = 0 then 0 else (x$j - x$i) / (1 - x$i)"
9.2416 + case False hence *:"x = x$i *\<^sub>R (\<chi> j. if x$j = 0 then 0 else 1) + (1 - x$i) *\<^sub>R (\<chi> j. ?y j)" unfolding Cart_eq
9.2417 + by(auto simp add: Cart_lambda_beta vector_add_component vector_smult_component vector_minus_component field_simps)
9.2418 + { fix j have "x$j \<noteq> 0 \<Longrightarrow> 0 \<le> (x $ j - x $ i) / (1 - x $ i)" "(x $ j - x $ i) / (1 - x $ i) \<le> 1"
9.2419 + apply(rule_tac divide_nonneg_pos) using i(1)[of j] using False i01
9.2420 + using Suc(2)[unfolded mem_interval, rule_format, of j] by(auto simp add:field_simps Cart_lambda_beta)
9.2421 + hence "0 \<le> ?y j \<and> ?y j \<le> 1" by auto }
9.2422 + moreover have "i\<in>{j. x$j \<noteq> 0} - {j. ((\<chi> j. ?y j)::real^'n) $ j \<noteq> 0}" using i01 by(auto simp add: Cart_lambda_beta)
9.2423 + hence "{j. x$j \<noteq> 0} \<noteq> {j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0}" by auto
9.2424 + hence **:"{j. ((\<chi> j. ?y j)::real^'n::finite) $ j \<noteq> 0} \<subset> {j. x$j \<noteq> 0}" apply - apply rule by(auto simp add: Cart_lambda_beta)
9.2425 + have "card {j. ((\<chi> j. ?y j)::real^'n) $ j \<noteq> 0} \<le> n" using less_le_trans[OF psubset_card_mono[OF _ **] Suc(4)] by auto
9.2426 + ultimately show ?thesis apply(subst *) apply(rule convex_convex_hull[unfolded convex_def, rule_format])
9.2427 + apply(rule_tac hull_subset[unfolded subset_eq, rule_format]) defer apply(rule Suc(1))
9.2428 + unfolding mem_interval using i01 Suc(3) by (auto simp add: Cart_lambda_beta)
9.2429 + qed qed qed } note * = this
9.2430 + show ?thesis apply rule defer apply(rule hull_minimal) unfolding subset_eq prefer 3 apply rule
9.2431 + apply(rule_tac n2="CARD('n)" in *) prefer 3 apply(rule card_mono) using 01 and convex_interval(1) prefer 5 apply - apply rule
9.2432 + unfolding mem_interval apply rule unfolding mem_Collect_eq apply(erule_tac x=i in allE)
9.2433 + by(auto simp add: vector_less_eq_def mem_def[of _ convex]) qed
9.2434 +
9.2435 +subsection {* And this is a finite set of vertices. *}
9.2436 +
9.2437 +lemma unit_cube_convex_hull: obtains s where "finite s" "{0 .. 1::real^'n::finite} = convex hull s"
9.2438 + apply(rule that[of "{x::real^'n::finite. \<forall>i. x$i=0 \<or> x$i=1}"])
9.2439 + apply(rule finite_subset[of _ "(\<lambda>s. (\<chi> i. if i\<in>s then 1::real else 0)::real^'n::finite) ` UNIV"])
9.2440 + prefer 3 apply(rule unit_interval_convex_hull) apply rule unfolding mem_Collect_eq proof-
9.2441 + fix x::"real^'n" assume as:"\<forall>i. x $ i = 0 \<or> x $ i = 1"
9.2442 + show "x \<in> (\<lambda>s. \<chi> i. if i \<in> s then 1 else 0) ` UNIV" apply(rule image_eqI[where x="{i. x$i = 1}"])
9.2443 + unfolding Cart_eq using as by(auto simp add:Cart_lambda_beta) qed auto
9.2444 +
9.2445 +subsection {* Hence any cube (could do any nonempty interval). *}
9.2446 +
9.2447 +lemma cube_convex_hull:
9.2448 + assumes "0 < d" obtains s::"(real^'n::finite) set" where "finite s" "{x - (\<chi> i. d) .. x + (\<chi> i. d)} = convex hull s" proof-
9.2449 + let ?d = "(\<chi> i. d)::real^'n"
9.2450 + have *:"{x - ?d .. x + ?d} = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` {0 .. 1}" apply(rule set_ext, rule)
9.2451 + unfolding image_iff defer apply(erule bexE) proof-
9.2452 + fix y assume as:"y\<in>{x - ?d .. x + ?d}"
9.2453 + { fix i::'n have "x $ i \<le> d + y $ i" "y $ i \<le> d + x $ i" using as[unfolded mem_interval, THEN spec[where x=i]]
9.2454 + by(auto simp add: vector_component)
9.2455 + hence "1 \<ge> inverse d * (x $ i - y $ i)" "1 \<ge> inverse d * (y $ i - x $ i)"
9.2456 + apply(rule_tac[!] mult_left_le_imp_le[OF _ assms]) unfolding mult_assoc[THEN sym]
9.2457 + using assms by(auto simp add: field_simps right_inverse)
9.2458 + hence "inverse d * (x $ i * 2) \<le> 2 + inverse d * (y $ i * 2)"
9.2459 + "inverse d * (y $ i * 2) \<le> 2 + inverse d * (x $ i * 2)" by(auto simp add:field_simps) }
9.2460 + hence "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> {0..1}" unfolding mem_interval using assms
9.2461 + by(auto simp add: Cart_eq vector_component_simps field_simps)
9.2462 + thus "\<exists>z\<in>{0..1}. y = x - ?d + (2 * d) *\<^sub>R z" apply- apply(rule_tac x="inverse (2 * d) *\<^sub>R (y - (x - ?d))" in bexI)
9.2463 + using assms by(auto simp add: Cart_eq vector_less_eq_def Cart_lambda_beta)
9.2464 + next
9.2465 + fix y z assume as:"z\<in>{0..1}" "y = x - ?d + (2*d) *\<^sub>R z"
9.2466 + have "\<And>i. 0 \<le> d * z $ i \<and> d * z $ i \<le> d" using assms as(1)[unfolded mem_interval] apply(erule_tac x=i in allE)
9.2467 + apply rule apply(rule mult_nonneg_nonneg) prefer 3 apply(rule mult_right_le_one_le)
9.2468 + using assms by(auto simp add: vector_component_simps Cart_eq)
9.2469 + thus "y \<in> {x - ?d..x + ?d}" unfolding as(2) mem_interval apply- apply rule using as(1)[unfolded mem_interval]
9.2470 + apply(erule_tac x=i in allE) using assms by(auto simp add: vector_component_simps Cart_eq) qed
9.2471 + obtain s where "finite s" "{0..1::real^'n} = convex hull s" using unit_cube_convex_hull by auto
9.2472 + thus ?thesis apply(rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` s"]) unfolding * and convex_hull_affinity by auto qed
9.2473 +
9.2474 +subsection {* Bounded convex function on open set is continuous. *}
9.2475 +
9.2476 +lemma convex_on_bounded_continuous:
9.2477 + fixes s :: "(real ^ _) set"
9.2478 + assumes "open s" "convex_on s f" "\<forall>x\<in>s. abs(f x) \<le> b"
9.2479 + shows "continuous_on s f"
9.2480 + apply(rule continuous_at_imp_continuous_on) unfolding continuous_at_real_range proof(rule,rule,rule)
9.2481 + fix x e assume "x\<in>s" "(0::real) < e"
9.2482 + def B \<equiv> "abs b + 1"
9.2483 + have B:"0 < B" "\<And>x. x\<in>s \<Longrightarrow> abs (f x) \<le> B"
9.2484 + unfolding B_def defer apply(drule assms(3)[rule_format]) by auto
9.2485 + obtain k where "k>0"and k:"cball x k \<subseteq> s" using assms(1)[unfolded open_contains_cball, THEN bspec[where x=x]] using `x\<in>s` by auto
9.2486 + show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
9.2487 + apply(rule_tac x="min (k / 2) (e / (2 * B) * k)" in exI) apply rule defer proof(rule,rule)
9.2488 + fix y assume as:"norm (y - x) < min (k / 2) (e / (2 * B) * k)"
9.2489 + show "\<bar>f y - f x\<bar> < e" proof(cases "y=x")
9.2490 + case False def t \<equiv> "k / norm (y - x)"
9.2491 + have "2 < t" "0<t" unfolding t_def using as False and `k>0` by(auto simp add:field_simps)
9.2492 + have "y\<in>s" apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
9.2493 + apply(rule order_trans[of _ "2 * norm (x - y)"]) using as by(auto simp add: field_simps norm_minus_commute)
9.2494 + { def w \<equiv> "x + t *\<^sub>R (y - x)"
9.2495 + have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
9.2496 + unfolding t_def using `k>0` by auto
9.2497 + 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 add: algebra_simps)
9.2498 + also have "\<dots> = 0" using `t>0` by(auto simp add:field_simps)
9.2499 + finally have w:"(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y" unfolding w_def using False and `t>0` by (auto simp add: algebra_simps)
9.2500 + have "2 * B < e * t" unfolding t_def using `0<e` `0<k` `B>0` and as and False by (auto simp add:field_simps)
9.2501 + hence "(f w - f x) / t < e"
9.2502 + using B(2)[OF `w\<in>s`] and B(2)[OF `x\<in>s`] using `t>0` by(auto simp add:field_simps)
9.2503 + hence th1:"f y - f x < e" apply- apply(rule le_less_trans) defer apply assumption
9.2504 + using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
9.2505 + using `0<t` `2<t` and `x\<in>s` `w\<in>s` by(auto simp add:field_simps) }
9.2506 + moreover
9.2507 + { def w \<equiv> "x - t *\<^sub>R (y - x)"
9.2508 + have "w\<in>s" unfolding w_def apply(rule k[unfolded subset_eq,rule_format]) unfolding mem_cball dist_norm
9.2509 + unfolding t_def using `k>0` by auto
9.2510 + 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 add: algebra_simps)
9.2511 + also have "\<dots>=x" using `t>0` by (auto simp add:field_simps)
9.2512 + finally have w:"(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x" unfolding w_def using False and `t>0` by (auto simp add: algebra_simps)
9.2513 + have "2 * B < e * t" unfolding t_def using `0<e` `0<k` `B>0` and as and False by (auto simp add:field_simps)
9.2514 + hence *:"(f w - f y) / t < e" using B(2)[OF `w\<in>s`] and B(2)[OF `y\<in>s`] using `t>0` by(auto simp add:field_simps)
9.2515 + have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
9.2516 + using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
9.2517 + using `0<t` `2<t` and `y\<in>s` `w\<in>s` by (auto simp add:field_simps)
9.2518 + also have "\<dots> = (f w + t * f y) / (1 + t)" using `t>0` unfolding real_divide_def by (auto simp add:field_simps)
9.2519 + also have "\<dots> < e + f y" using `t>0` * `e>0` by(auto simp add:field_simps)
9.2520 + finally have "f x - f y < e" by auto }
9.2521 + ultimately show ?thesis by auto
9.2522 + qed(insert `0<e`, auto)
9.2523 + qed(insert `0<e` `0<k` `0<B`, auto simp add:field_simps intro!:mult_pos_pos) qed
9.2524 +
9.2525 +subsection {* Upper bound on a ball implies upper and lower bounds. *}
9.2526 +
9.2527 +lemma convex_bounds_lemma:
9.2528 + fixes x :: "real ^ _"
9.2529 + assumes "convex_on (cball x e) f" "\<forall>y \<in> cball x e. f y \<le> b"
9.2530 + shows "\<forall>y \<in> cball x e. abs(f y) \<le> b + 2 * abs(f x)"
9.2531 + apply(rule) proof(cases "0 \<le> e") case True
9.2532 + fix y assume y:"y\<in>cball x e" def z \<equiv> "2 *\<^sub>R x - y"
9.2533 + have *:"x - (2 *\<^sub>R x - y) = y - x" by vector
9.2534 + have z:"z\<in>cball x e" using y unfolding z_def mem_cball dist_norm * by(auto simp add: norm_minus_commute)
9.2535 + have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x" unfolding z_def by (auto simp add: algebra_simps)
9.2536 + thus "\<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"]
9.2537 + using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z] by(auto simp add:field_simps)
9.2538 +next case False fix y assume "y\<in>cball x e"
9.2539 + hence "dist x y < 0" using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
9.2540 + thus "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" using zero_le_dist[of x y] by auto qed
9.2541 +
9.2542 +subsection {* Hence a convex function on an open set is continuous. *}
9.2543 +
9.2544 +lemma convex_on_continuous:
9.2545 + assumes "open (s::(real^'n::finite) set)" "convex_on s f"
9.2546 + shows "continuous_on s f"
9.2547 + unfolding continuous_on_eq_continuous_at[OF assms(1)] proof
9.2548 + note dimge1 = dimindex_ge_1[where 'a='n]
9.2549 + fix x assume "x\<in>s"
9.2550 + then obtain e where e:"cball x e \<subseteq> s" "e>0" using assms(1) unfolding open_contains_cball by auto
9.2551 + def d \<equiv> "e / real CARD('n)"
9.2552 + have "0 < d" unfolding d_def using `e>0` dimge1 by(rule_tac divide_pos_pos, auto)
9.2553 + let ?d = "(\<chi> i. d)::real^'n"
9.2554 + obtain c where c:"finite c" "{x - ?d..x + ?d} = convex hull c" using cube_convex_hull[OF `d>0`, of x] by auto
9.2555 + have "x\<in>{x - ?d..x + ?d}" using `d>0` unfolding mem_interval by(auto simp add:vector_component_simps)
9.2556 + hence "c\<noteq>{}" apply(rule_tac ccontr) using c by(auto simp add:convex_hull_empty)
9.2557 + def k \<equiv> "Max (f ` c)"
9.2558 + have "convex_on {x - ?d..x + ?d} f" apply(rule convex_on_subset[OF assms(2)])
9.2559 + apply(rule subset_trans[OF _ e(1)]) unfolding subset_eq mem_cball proof
9.2560 + fix z assume z:"z\<in>{x - ?d..x + ?d}"
9.2561 + have e:"e = setsum (\<lambda>i. d) (UNIV::'n set)" unfolding setsum_constant d_def using dimge1
9.2562 + by (metis card_enum field_simps d_def not_one_le_zero of_nat_le_iff real_eq_of_nat real_of_nat_1)
9.2563 + show "dist x z \<le> e" unfolding dist_norm e apply(rule_tac order_trans[OF norm_le_l1], rule setsum_mono)
9.2564 + using z[unfolded mem_interval] apply(erule_tac x=i in allE) by(auto simp add:field_simps vector_component_simps) qed
9.2565 + hence k:"\<forall>y\<in>{x - ?d..x + ?d}. f y \<le> k" unfolding c(2) apply(rule_tac convex_on_convex_hull_bound) apply assumption
9.2566 + unfolding k_def apply(rule, rule Max_ge) using c(1) by auto
9.2567 + have "d \<le> e" unfolding d_def apply(rule mult_imp_div_pos_le) using `e>0` dimge1 unfolding mult_le_cancel_left1 using real_dimindex_ge_1 by auto
9.2568 + hence dsube:"cball x d \<subseteq> cball x e" unfolding subset_eq Ball_def mem_cball by auto
9.2569 + have conv:"convex_on (cball x d) f" apply(rule convex_on_subset, rule convex_on_subset[OF assms(2)]) apply(rule e(1)) using dsube by auto
9.2570 + hence "\<forall>y\<in>cball x d. abs (f y) \<le> k + 2 * abs (f x)" apply(rule_tac convex_bounds_lemma) apply assumption proof
9.2571 + fix y assume y:"y\<in>cball x d"
9.2572 + { fix i::'n have "x $ i - d \<le> y $ i" "y $ i \<le> x $ i + d"
9.2573 + using order_trans[OF component_le_norm y[unfolded mem_cball dist_norm], of i] by(auto simp add: vector_component) }
9.2574 + thus "f y \<le> k" apply(rule_tac k[rule_format]) unfolding mem_cball mem_interval dist_norm
9.2575 + by(auto simp add: vector_component_simps) qed
9.2576 + hence "continuous_on (ball x d) f" apply(rule_tac convex_on_bounded_continuous)
9.2577 + apply(rule open_ball, rule convex_on_subset[OF conv], rule ball_subset_cball) by auto
9.2578 + thus "continuous (at x) f" unfolding continuous_on_eq_continuous_at[OF open_ball] using `d>0` by auto qed
9.2579 +
9.2580 +subsection {* Line segments, starlike sets etc. *)
9.2581 +(* Use the same overloading tricks as for intervals, so that *)
9.2582 +(* segment[a,b] is closed and segment(a,b) is open relative to affine hull. *}
9.2583 +
9.2584 +definition
9.2585 + midpoint :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 'n" where
9.2586 + "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
9.2587 +
9.2588 +definition
9.2589 + open_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
9.2590 + "open_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 < u \<and> u < 1}"
9.2591 +
9.2592 +definition
9.2593 + closed_segment :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> (real ^ 'n) set" where
9.2594 + "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
9.2595 +
9.2596 +definition "between = (\<lambda> (a,b). closed_segment a b)"
9.2597 +
9.2598 +lemmas segment = open_segment_def closed_segment_def
9.2599 +
9.2600 +definition "starlike s \<longleftrightarrow> (\<exists>a\<in>s. \<forall>x\<in>s. closed_segment a x \<subseteq> s)"
9.2601 +
9.2602 +lemma midpoint_refl: "midpoint x x = x"
9.2603 + unfolding midpoint_def unfolding scaleR_right_distrib unfolding scaleR_left_distrib[THEN sym] by auto
9.2604 +
9.2605 +lemma midpoint_sym: "midpoint a b = midpoint b a" unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
9.2606 +
9.2607 +lemma dist_midpoint:
9.2608 + "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
9.2609 + "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
9.2610 + "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
9.2611 + "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
9.2612 +proof-
9.2613 + have *: "\<And>x y::real^'n::finite. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2" unfolding equation_minus_iff by auto
9.2614 + have **:"\<And>x y::real^'n::finite. 2 *\<^sub>R x = y \<Longrightarrow> norm x = (norm y) / 2" by auto
9.2615 + note scaleR_right_distrib [simp]
9.2616 + show ?t1 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector)
9.2617 + show ?t2 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
9.2618 + show ?t3 unfolding midpoint_def dist_norm apply (rule *) by(auto,vector)
9.2619 + show ?t4 unfolding midpoint_def dist_norm apply (rule **) by(auto,vector) qed
9.2620 +
9.2621 +lemma midpoint_eq_endpoint:
9.2622 + "midpoint a b = a \<longleftrightarrow> a = (b::real^'n::finite)"
9.2623 + "midpoint a b = b \<longleftrightarrow> a = b"
9.2624 + unfolding dist_eq_0_iff[where 'a="real^'n", THEN sym] dist_midpoint by auto
9.2625 +
9.2626 +lemma convex_contains_segment:
9.2627 + "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. closed_segment a b \<subseteq> s)"
9.2628 + unfolding convex_alt closed_segment_def by auto
9.2629 +
9.2630 +lemma convex_imp_starlike:
9.2631 + "convex s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> starlike s"
9.2632 + unfolding convex_contains_segment starlike_def by auto
9.2633 +
9.2634 +lemma segment_convex_hull:
9.2635 + "closed_segment a b = convex hull {a,b}" proof-
9.2636 + have *:"\<And>x. {x} \<noteq> {}" by auto
9.2637 + have **:"\<And>u v. u + v = 1 \<longleftrightarrow> u = 1 - (v::real)" by auto
9.2638 + show ?thesis unfolding segment convex_hull_insert[OF *] convex_hull_singleton apply(rule set_ext)
9.2639 + unfolding mem_Collect_eq apply(rule,erule exE)
9.2640 + apply(rule_tac x="1 - u" in exI) apply rule defer apply(rule_tac x=u in exI) defer
9.2641 + apply(erule exE, (erule conjE)?)+ apply(rule_tac x="1 - u" in exI) unfolding ** by auto qed
9.2642 +
9.2643 +lemma convex_segment: "convex (closed_segment a b)"
9.2644 + unfolding segment_convex_hull by(rule convex_convex_hull)
9.2645 +
9.2646 +lemma ends_in_segment: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
9.2647 + unfolding segment_convex_hull apply(rule_tac[!] hull_subset[unfolded subset_eq, rule_format]) by auto
9.2648 +
9.2649 +lemma segment_furthest_le:
9.2650 + assumes "x \<in> closed_segment a b" shows "norm(y - x) \<le> norm(y - a) \<or> norm(y - x) \<le> norm(y - b)" proof-
9.2651 + obtain z where "z\<in>{a, b}" "norm (x - y) \<le> norm (z - y)" using simplex_furthest_le[of "{a, b}" y]
9.2652 + using assms[unfolded segment_convex_hull] by auto
9.2653 + thus ?thesis by(auto simp add:norm_minus_commute) qed
9.2654 +
9.2655 +lemma segment_bound:
9.2656 + assumes "x \<in> closed_segment a b"
9.2657 + shows "norm(x - a) \<le> norm(b - a)" "norm(x - b) \<le> norm(b - a)"
9.2658 + using segment_furthest_le[OF assms, of a]
9.2659 + using segment_furthest_le[OF assms, of b]
9.2660 + by (auto simp add:norm_minus_commute)
9.2661 +
9.2662 +lemma segment_refl:"closed_segment a a = {a}" unfolding segment by (auto simp add: algebra_simps)
9.2663 +
9.2664 +lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
9.2665 + unfolding between_def mem_def by auto
9.2666 +
9.2667 +lemma between:"between (a,b) (x::real^'n::finite) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
9.2668 +proof(cases "a = b")
9.2669 + case True thus ?thesis unfolding between_def split_conv mem_def[of x, symmetric]
9.2670 + by(auto simp add:segment_refl dist_commute) next
9.2671 + case False hence Fal:"norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0" by auto
9.2672 + have *:"\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)" by (auto simp add: algebra_simps)
9.2673 + show ?thesis unfolding between_def split_conv mem_def[of x, symmetric] closed_segment_def mem_Collect_eq
9.2674 + apply rule apply(erule exE, (erule conjE)+) apply(subst dist_triangle_eq) proof-
9.2675 + fix u assume as:"x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
9.2676 + hence *:"a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
9.2677 + unfolding as(1) by(auto simp add:algebra_simps)
9.2678 + show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
9.2679 + unfolding norm_minus_commute[of x a] * Cart_eq using as(2,3)
9.2680 + by(auto simp add: vector_component_simps field_simps)
9.2681 + next assume as:"dist a b = dist a x + dist x b"
9.2682 + have "norm (a - x) / norm (a - b) \<le> 1" unfolding divide_le_eq_1_pos[OF Fal2] unfolding as[unfolded dist_norm] norm_ge_zero by auto
9.2683 + thus "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1" apply(rule_tac x="dist a x / dist a b" in exI)
9.2684 + unfolding dist_norm Cart_eq apply- apply rule defer apply(rule, rule divide_nonneg_pos) prefer 4 proof rule
9.2685 + fix i::'n have "((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i =
9.2686 + ((norm (a - b) - norm (a - x)) * (a $ i) + norm (a - x) * (b $ i)) / norm (a - b)"
9.2687 + using Fal by(auto simp add:vector_component_simps field_simps)
9.2688 + also have "\<dots> = x$i" apply(rule divide_eq_imp[OF Fal])
9.2689 + unfolding as[unfolded dist_norm] using as[unfolded dist_triangle_eq Cart_eq,rule_format, of i]
9.2690 + by(auto simp add:field_simps vector_component_simps)
9.2691 + finally show "x $ i = ((1 - norm (a - x) / norm (a - b)) *\<^sub>R a + (norm (a - x) / norm (a - b)) *\<^sub>R b) $ i" by auto
9.2692 + qed(insert Fal2, auto) qed qed
9.2693 +
9.2694 +lemma between_midpoint: fixes a::"real^'n::finite" shows
9.2695 + "between (a,b) (midpoint a b)" (is ?t1)
9.2696 + "between (b,a) (midpoint a b)" (is ?t2)
9.2697 +proof- have *:"\<And>x y z. x = (1/2::real) *\<^sub>R z \<Longrightarrow> y = (1/2) *\<^sub>R z \<Longrightarrow> norm z = norm x + norm y" by auto
9.2698 + show ?t1 ?t2 unfolding between midpoint_def dist_norm apply(rule_tac[!] *)
9.2699 + by(auto simp add:field_simps Cart_eq vector_component_simps) qed
9.2700 +
9.2701 +lemma between_mem_convex_hull:
9.2702 + "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
9.2703 + unfolding between_mem_segment segment_convex_hull ..
9.2704 +
9.2705 +subsection {* Shrinking towards the interior of a convex set. *}
9.2706 +
9.2707 +lemma mem_interior_convex_shrink:
9.2708 + fixes s :: "(real ^ _) set"
9.2709 + assumes "convex s" "c \<in> interior s" "x \<in> s" "0 < e" "e \<le> 1"
9.2710 + shows "x - e *\<^sub>R (x - c) \<in> interior s"
9.2711 +proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
9.2712 + show ?thesis unfolding mem_interior apply(rule_tac x="e*d" in exI)
9.2713 + apply(rule) defer unfolding subset_eq Ball_def mem_ball proof(rule,rule)
9.2714 + fix y assume as:"dist (x - e *\<^sub>R (x - c)) y < e * d"
9.2715 + have *:"y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x" using `e>0` by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
9.2716 + have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = abs(1/e) * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)"
9.2717 + unfolding dist_norm unfolding norm_scaleR[THEN sym] apply(rule norm_eqI) using `e>0`
9.2718 + by(auto simp add:vector_component_simps Cart_eq field_simps)
9.2719 + also have "\<dots> = abs(1/e) * norm (x - e *\<^sub>R (x - c) - y)" by(auto intro!:norm_eqI simp add: algebra_simps)
9.2720 + also have "\<dots> < d" using as[unfolded dist_norm] and `e>0`
9.2721 + by(auto simp add:pos_divide_less_eq[OF `e>0`] real_mult_commute)
9.2722 + finally show "y \<in> s" apply(subst *) apply(rule assms(1)[unfolded convex_alt,rule_format])
9.2723 + apply(rule d[unfolded subset_eq,rule_format]) unfolding mem_ball using assms(3-5) by auto
9.2724 + qed(rule mult_pos_pos, insert `e>0` `d>0`, auto) qed
9.2725 +
9.2726 +lemma mem_interior_closure_convex_shrink:
9.2727 + fixes s :: "(real ^ _) set"
9.2728 + assumes "convex s" "c \<in> interior s" "x \<in> closure s" "0 < e" "e \<le> 1"
9.2729 + shows "x - e *\<^sub>R (x - c) \<in> interior s"
9.2730 +proof- obtain d where "d>0" and d:"ball c d \<subseteq> s" using assms(2) unfolding mem_interior by auto
9.2731 + have "\<exists>y\<in>s. norm (y - x) * (1 - e) < e * d" proof(cases "x\<in>s")
9.2732 + case True thus ?thesis using `e>0` `d>0` by(rule_tac bexI[where x=x], auto intro!: mult_pos_pos) next
9.2733 + case False hence x:"x islimpt s" using assms(3)[unfolded closure_def] by auto
9.2734 + show ?thesis proof(cases "e=1")
9.2735 + case True obtain y where "y\<in>s" "y \<noteq> x" "dist y x < 1"
9.2736 + using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
9.2737 + thus ?thesis apply(rule_tac x=y in bexI) unfolding True using `d>0` by auto next
9.2738 + case False hence "0 < e * d / (1 - e)" and *:"1 - e > 0"
9.2739 + using `e\<le>1` `e>0` `d>0` by(auto intro!:mult_pos_pos divide_pos_pos)
9.2740 + then obtain y where "y\<in>s" "y \<noteq> x" "dist y x < e * d / (1 - e)"
9.2741 + using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
9.2742 + thus ?thesis apply(rule_tac x=y in bexI) unfolding dist_norm using pos_less_divide_eq[OF *] by auto qed qed
9.2743 + then obtain y where "y\<in>s" and y:"norm (y - x) * (1 - e) < e * d" by auto
9.2744 + def z \<equiv> "c + ((1 - e) / e) *\<^sub>R (x - y)"
9.2745 + have *:"x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)" unfolding z_def using `e>0` by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
9.2746 + have "z\<in>interior s" apply(rule subset_interior[OF d,unfolded subset_eq,rule_format])
9.2747 + unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
9.2748 + by(auto simp add:field_simps norm_minus_commute)
9.2749 + thus ?thesis unfolding * apply - apply(rule mem_interior_convex_shrink)
9.2750 + using assms(1,4-5) `y\<in>s` by auto qed
9.2751 +
9.2752 +subsection {* Some obvious but surprisingly hard simplex lemmas. *}
9.2753 +
9.2754 +lemma simplex:
9.2755 + assumes "finite s" "0 \<notin> s"
9.2756 + shows "convex hull (insert 0 s) = { y. (\<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> setsum u s \<le> 1 \<and> setsum (\<lambda>x. u x *\<^sub>R x) s = y)}"
9.2757 + unfolding convex_hull_finite[OF finite.insertI[OF assms(1)]] apply(rule set_ext, rule) unfolding mem_Collect_eq
9.2758 + apply(erule_tac[!] exE) apply(erule_tac[!] conjE)+ unfolding setsum_clauses(2)[OF assms(1)]
9.2759 + apply(rule_tac x=u in exI) defer apply(rule_tac x="\<lambda>x. if x = 0 then 1 - setsum u s else u x" in exI) using assms(2)
9.2760 + unfolding if_smult and setsum_delta_notmem[OF assms(2)] by auto
9.2761 +
9.2762 +lemma std_simplex:
9.2763 + "convex hull (insert 0 { basis i | i. i\<in>UNIV}) =
9.2764 + {x::real^'n::finite . (\<forall>i. 0 \<le> x$i) \<and> setsum (\<lambda>i. x$i) UNIV \<le> 1 }" (is "convex hull (insert 0 ?p) = ?s")
9.2765 +proof- let ?D = "UNIV::'n set"
9.2766 + have "0\<notin>?p" by(auto simp add: basis_nonzero)
9.2767 + have "{(basis i)::real^'n |i. i \<in> ?D} = basis ` ?D" by auto
9.2768 + note sumbas = this setsum_reindex[OF basis_inj, unfolded o_def]
9.2769 + show ?thesis unfolding simplex[OF finite_stdbasis `0\<notin>?p`] apply(rule set_ext) unfolding mem_Collect_eq apply rule
9.2770 + apply(erule exE, (erule conjE)+) apply(erule_tac[2] conjE)+ proof-
9.2771 + fix x::"real^'n" and u assume as: "\<forall>x\<in>{basis i |i. i \<in>?D}. 0 \<le> u x" "setsum u {basis i |i. i \<in> ?D} \<le> 1" "(\<Sum>x\<in>{basis i |i. i \<in>?D}. u x *\<^sub>R x) = x"
9.2772 + have *:"\<forall>i. u (basis i) = x$i" using as(3) unfolding sumbas and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by auto
9.2773 + hence **:"setsum u {basis i |i. i \<in> ?D} = setsum (op $ x) ?D" unfolding sumbas by(rule_tac setsum_cong, auto)
9.2774 + show " (\<forall>i. 0 \<le> x $ i) \<and> setsum (op $ x) ?D \<le> 1" apply - proof(rule,rule)
9.2775 + fix i::'n show "0 \<le> x$i" unfolding *[rule_format,of i,THEN sym] apply(rule_tac as(1)[rule_format]) by auto
9.2776 + qed(insert as(2)[unfolded **], auto)
9.2777 + next fix x::"real^'n" assume as:"\<forall>i. 0 \<le> x $ i" "setsum (op $ x) ?D \<le> 1"
9.2778 + show "\<exists>u. (\<forall>x\<in>{basis i |i. i \<in> ?D}. 0 \<le> u x) \<and> setsum u {basis i |i. i \<in> ?D} \<le> 1 \<and> (\<Sum>x\<in>{basis i |i. i \<in> ?D}. u x *\<^sub>R x) = x"
9.2779 + apply(rule_tac x="\<lambda>y. inner y x" in exI) apply(rule,rule) unfolding mem_Collect_eq apply(erule exE) using as(1) apply(erule_tac x=i in allE)
9.2780 + unfolding sumbas using as(2) and basis_expansion_unique [where 'a=real, unfolded smult_conv_scaleR] by(auto simp add:inner_basis) qed qed
9.2781 +
9.2782 +lemma interior_std_simplex:
9.2783 + "interior (convex hull (insert 0 { basis i| i. i\<in>UNIV})) =
9.2784 + {x::real^'n::finite. (\<forall>i. 0 < x$i) \<and> setsum (\<lambda>i. x$i) UNIV < 1 }"
9.2785 + apply(rule set_ext) unfolding mem_interior std_simplex unfolding subset_eq mem_Collect_eq Ball_def mem_ball
9.2786 + unfolding Ball_def[symmetric] apply rule apply(erule exE, (erule conjE)+) defer apply(erule conjE) proof-
9.2787 + fix x::"real^'n" and e assume "0<e" and as:"\<forall>xa. dist x xa < e \<longrightarrow> (\<forall>x. 0 \<le> xa $ x) \<and> setsum (op $ xa) UNIV \<le> 1"
9.2788 + show "(\<forall>xa. 0 < x $ xa) \<and> setsum (op $ x) UNIV < 1" apply(rule,rule) proof-
9.2789 + fix i::'n show "0 < x $ i" using as[THEN spec[where x="x - (e / 2) *\<^sub>R basis i"]] and `e>0`
9.2790 + unfolding dist_norm by(auto simp add: norm_basis vector_component_simps basis_component elim:allE[where x=i])
9.2791 + next guess a using UNIV_witness[where 'a='n] ..
9.2792 + have **:"dist x (x + (e / 2) *\<^sub>R basis a) < e" using `e>0` and norm_basis[of a]
9.2793 + unfolding dist_norm by(auto simp add: vector_component_simps basis_component intro!: mult_strict_left_mono_comm)
9.2794 + have "\<And>i. (x + (e / 2) *\<^sub>R basis a) $ i = x$i + (if i = a then e/2 else 0)" by(auto simp add:vector_component_simps)
9.2795 + hence *:"setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV = setsum (\<lambda>i. x$i + (if a = i then e/2 else 0)) UNIV" by(rule_tac setsum_cong, auto)
9.2796 + have "setsum (op $ x) UNIV < setsum (op $ (x + (e / 2) *\<^sub>R basis a)) UNIV" unfolding * setsum_addf
9.2797 + using `0<e` dimindex_ge_1 by(auto simp add: setsum_delta')
9.2798 + also have "\<dots> \<le> 1" using ** apply(drule_tac as[rule_format]) by auto
9.2799 + finally show "setsum (op $ x) UNIV < 1" by auto qed
9.2800 +next
9.2801 + fix x::"real^'n::finite" assume as:"\<forall>i. 0 < x $ i" "setsum (op $ x) UNIV < 1"
9.2802 + guess a using UNIV_witness[where 'a='b] ..
9.2803 + let ?d = "(1 - setsum (op $ x) UNIV) / real (CARD('n))"
9.2804 + have "Min ((op $ x) ` UNIV) > 0" apply(rule Min_grI) using as(1) dimindex_ge_1 by auto
9.2805 + moreover have"?d > 0" apply(rule divide_pos_pos) using as(2) using dimindex_ge_1 by(auto simp add: Suc_le_eq)
9.2806 + ultimately show "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> (\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1"
9.2807 + apply(rule_tac x="min (Min ((op $ x) ` UNIV)) ?D" in exI) apply rule defer apply(rule,rule) proof-
9.2808 + fix y assume y:"dist x y < min (Min (op $ x ` UNIV)) ?d"
9.2809 + have "setsum (op $ y) UNIV \<le> setsum (\<lambda>i. x$i + ?d) UNIV" proof(rule setsum_mono)
9.2810 + fix i::'n have "abs (y$i - x$i) < ?d" apply(rule le_less_trans) using component_le_norm[of "y - x" i]
9.2811 + using y[unfolded min_less_iff_conj dist_norm, THEN conjunct2] by(auto simp add:vector_component_simps norm_minus_commute)
9.2812 + thus "y $ i \<le> x $ i + ?d" by auto qed
9.2813 + also have "\<dots> \<le> 1" unfolding setsum_addf setsum_constant card_enum real_eq_of_nat using dimindex_ge_1 by(auto simp add: Suc_le_eq)
9.2814 + finally show "(\<forall>i. 0 \<le> y $ i) \<and> setsum (op $ y) UNIV \<le> 1" apply- proof(rule,rule)
9.2815 + fix i::'n have "norm (x - y) < x$i" using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
9.2816 + using Min_gr_iff[of "op $ x ` dimset x"] dimindex_ge_1 by auto
9.2817 + thus "0 \<le> y$i" using component_le_norm[of "x - y" i] and as(1)[rule_format, of i] by(auto simp add: vector_component_simps)
9.2818 + qed auto qed auto qed
9.2819 +
9.2820 +lemma interior_std_simplex_nonempty: obtains a::"real^'n::finite" where
9.2821 + "a \<in> interior(convex hull (insert 0 {basis i | i . i \<in> UNIV}))" proof-
9.2822 + let ?D = "UNIV::'n set" let ?a = "setsum (\<lambda>b::real^'n. inverse (2 * real CARD('n)) *\<^sub>R b) {(basis i) | i. i \<in> ?D}"
9.2823 + have *:"{basis i :: real ^ 'n | i. i \<in> ?D} = basis ` ?D" by auto
9.2824 + { fix i have "?a $ i = inverse (2 * real CARD('n))"
9.2825 + unfolding setsum_component vector_smult_component and * and setsum_reindex[OF basis_inj] and o_def
9.2826 + apply(rule trans[of _ "setsum (\<lambda>j. if i = j then inverse (2 * real CARD('n)) else 0) ?D"]) apply(rule setsum_cong2)
9.2827 + unfolding setsum_delta'[OF finite_UNIV[where 'a='n]] and real_dimindex_ge_1[where 'n='n] by(auto simp add: basis_component[of i]) }
9.2828 + note ** = this
9.2829 + show ?thesis apply(rule that[of ?a]) unfolding interior_std_simplex mem_Collect_eq proof(rule,rule)
9.2830 + fix i::'n show "0 < ?a $ i" unfolding ** using dimindex_ge_1 by(auto simp add: Suc_le_eq) next
9.2831 + have "setsum (op $ ?a) ?D = setsum (\<lambda>i. inverse (2 * real CARD('n))) ?D" by(rule setsum_cong2, rule **)
9.2832 + also have "\<dots> < 1" unfolding setsum_constant card_enum real_eq_of_nat real_divide_def[THEN sym] by (auto simp add:field_simps)
9.2833 + finally show "setsum (op $ ?a) ?D < 1" by auto qed qed
9.2834 +
9.2835 +subsection {* Paths. *}
9.2836 +
9.2837 +definition "path (g::real^1 \<Rightarrow> real^'n::finite) \<longleftrightarrow> continuous_on {0 .. 1} g"
9.2838 +
9.2839 +definition "pathstart (g::real^1 \<Rightarrow> real^'n) = g 0"
9.2840 +
9.2841 +definition "pathfinish (g::real^1 \<Rightarrow> real^'n) = g 1"
9.2842 +
9.2843 +definition "path_image (g::real^1 \<Rightarrow> real^'n) = g ` {0 .. 1}"
9.2844 +
9.2845 +definition "reversepath (g::real^1 \<Rightarrow> real^'n) = (\<lambda>x. g(1 - x))"
9.2846 +
9.2847 +definition joinpaths:: "(real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n) \<Rightarrow> (real^1 \<Rightarrow> real^'n)" (infixr "+++" 75)
9.2848 + where "joinpaths g1 g2 = (\<lambda>x. if dest_vec1 x \<le> ((1 / 2)::real) then g1 (2 *\<^sub>R x) else g2(2 *\<^sub>R x - 1))"
9.2849 +definition "simple_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
9.2850 + (\<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)"
9.2851 +
9.2852 +definition "injective_path (g::real^1 \<Rightarrow> real^'n) \<longleftrightarrow>
9.2853 + (\<forall>x\<in>{0..1}. \<forall>y\<in>{0..1}. g x = g y \<longrightarrow> x = y)"
9.2854 +
9.2855 +subsection {* Some lemmas about these concepts. *}
9.2856 +
9.2857 +lemma injective_imp_simple_path:
9.2858 + "injective_path g \<Longrightarrow> simple_path g"
9.2859 + unfolding injective_path_def simple_path_def by auto
9.2860 +
9.2861 +lemma path_image_nonempty: "path_image g \<noteq> {}"
9.2862 + unfolding path_image_def image_is_empty interval_eq_empty by auto
9.2863 +
9.2864 +lemma pathstart_in_path_image[intro]: "(pathstart g) \<in> path_image g"
9.2865 + unfolding pathstart_def path_image_def apply(rule imageI)
9.2866 + unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
9.2867 +
9.2868 +lemma pathfinish_in_path_image[intro]: "(pathfinish g) \<in> path_image g"
9.2869 + unfolding pathfinish_def path_image_def apply(rule imageI)
9.2870 + unfolding mem_interval_1 vec_1[THEN sym] dest_vec1_vec by auto
9.2871 +
9.2872 +lemma connected_path_image[intro]: "path g \<Longrightarrow> connected(path_image g)"
9.2873 + unfolding path_def path_image_def apply(rule connected_continuous_image, assumption)
9.2874 + by(rule convex_connected, rule convex_interval)
9.2875 +
9.2876 +lemma compact_path_image[intro]: "path g \<Longrightarrow> compact(path_image g)"
9.2877 + unfolding path_def path_image_def apply(rule compact_continuous_image, assumption)
9.2878 + by(rule compact_interval)
9.2879 +
9.2880 +lemma reversepath_reversepath[simp]: "reversepath(reversepath g) = g"
9.2881 + unfolding reversepath_def by auto
9.2882 +
9.2883 +lemma pathstart_reversepath[simp]: "pathstart(reversepath g) = pathfinish g"
9.2884 + unfolding pathstart_def reversepath_def pathfinish_def by auto
9.2885 +
9.2886 +lemma pathfinish_reversepath[simp]: "pathfinish(reversepath g) = pathstart g"
9.2887 + unfolding pathstart_def reversepath_def pathfinish_def by auto
9.2888 +
9.2889 +lemma pathstart_join[simp]: "pathstart(g1 +++ g2) = pathstart g1"
9.2890 + unfolding pathstart_def joinpaths_def pathfinish_def by auto
9.2891 +
9.2892 +lemma pathfinish_join[simp]:"pathfinish(g1 +++ g2) = pathfinish g2" proof-
9.2893 + have "2 *\<^sub>R 1 - 1 = (1::real^1)" unfolding Cart_eq by(auto simp add:vector_component_simps)
9.2894 + thus ?thesis unfolding pathstart_def joinpaths_def pathfinish_def
9.2895 + unfolding vec_1[THEN sym] dest_vec1_vec by auto qed
9.2896 +
9.2897 +lemma path_image_reversepath[simp]: "path_image(reversepath g) = path_image g" proof-
9.2898 + have *:"\<And>g. path_image(reversepath g) \<subseteq> path_image g"
9.2899 + unfolding path_image_def subset_eq reversepath_def Ball_def image_iff apply(rule,rule,erule bexE)
9.2900 + apply(rule_tac x="1 - xa" in bexI) by(auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
9.2901 + show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
9.2902 +
9.2903 +lemma path_reversepath[simp]: "path(reversepath g) \<longleftrightarrow> path g" proof-
9.2904 + have *:"\<And>g. path g \<Longrightarrow> path(reversepath g)" unfolding path_def reversepath_def
9.2905 + apply(rule continuous_on_compose[unfolded o_def, of _ "\<lambda>x. 1 - x"])
9.2906 + apply(rule continuous_on_sub, rule continuous_on_const, rule continuous_on_id)
9.2907 + apply(rule continuous_on_subset[of "{0..1}"], assumption)
9.2908 + by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
9.2909 + show ?thesis using *[of g] *[of "reversepath g"] unfolding reversepath_reversepath by auto qed
9.2910 +
9.2911 +lemmas reversepath_simps = path_reversepath path_image_reversepath pathstart_reversepath pathfinish_reversepath
9.2912 +
9.2913 +lemma path_join[simp]: assumes "pathfinish g1 = pathstart g2" shows "path (g1 +++ g2) \<longleftrightarrow> path g1 \<and> path g2"
9.2914 + unfolding path_def pathfinish_def pathstart_def apply rule defer apply(erule conjE) proof-
9.2915 + assume as:"continuous_on {0..1} (g1 +++ g2)"
9.2916 + have *:"g1 = (\<lambda>x. g1 (2 *\<^sub>R x)) \<circ> (\<lambda>x. (1/2) *\<^sub>R x)"
9.2917 + "g2 = (\<lambda>x. g2 (2 *\<^sub>R x - 1)) \<circ> (\<lambda>x. (1/2) *\<^sub>R (x + 1))" unfolding o_def by auto
9.2918 + have "op *\<^sub>R (1 / 2) ` {0::real^1..1} \<subseteq> {0..1}" "(\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {(0::real^1)..1} \<subseteq> {0..1}"
9.2919 + unfolding image_smult_interval by (auto, auto simp add:vector_less_eq_def vector_component_simps elim!:ballE)
9.2920 + thus "continuous_on {0..1} g1 \<and> continuous_on {0..1} g2" apply -apply rule
9.2921 + apply(subst *) defer apply(subst *) apply (rule_tac[!] continuous_on_compose)
9.2922 + apply (rule continuous_on_cmul, rule continuous_on_add, rule continuous_on_id, rule continuous_on_const) defer
9.2923 + apply (rule continuous_on_cmul, rule continuous_on_id) apply(rule_tac[!] continuous_on_eq[of _ "g1 +++ g2"]) defer prefer 3
9.2924 + apply(rule_tac[1-2] continuous_on_subset[of "{0 .. 1}"]) apply(rule as, assumption, rule as, assumption)
9.2925 + apply(rule) defer apply rule proof-
9.2926 + fix x assume "x \<in> op *\<^sub>R (1 / 2) ` {0::real^1..1}"
9.2927 + hence "dest_vec1 x \<le> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
9.2928 + thus "(g1 +++ g2) x = g1 (2 *\<^sub>R x)" unfolding joinpaths_def by auto next
9.2929 + fix x assume "x \<in> (\<lambda>x. (1 / 2) *\<^sub>R (x + 1)) ` {0::real^1..1}"
9.2930 + hence "dest_vec1 x \<ge> 1 / 2" unfolding image_iff by(auto simp add: vector_component_simps)
9.2931 + thus "(g1 +++ g2) x = g2 (2 *\<^sub>R x - 1)" proof(cases "dest_vec1 x = 1 / 2")
9.2932 + case True hence "x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
9.2933 + thus ?thesis unfolding joinpaths_def using assms[unfolded pathstart_def pathfinish_def] by auto
9.2934 + qed (auto simp add:le_less joinpaths_def) qed
9.2935 +next assume as:"continuous_on {0..1} g1" "continuous_on {0..1} g2"
9.2936 + have *:"{0 .. 1::real^1} = {0.. (1/2)*\<^sub>R 1} \<union> {(1/2) *\<^sub>R 1 .. 1}" by(auto simp add: vector_component_simps)
9.2937 + have **:"op *\<^sub>R 2 ` {0..(1 / 2) *\<^sub>R 1} = {0..1::real^1}" apply(rule set_ext, rule) unfolding image_iff
9.2938 + defer apply(rule_tac x="(1/2)*\<^sub>R x" in bexI) by(auto simp add: vector_component_simps)
9.2939 + have ***:"(\<lambda>x. 2 *\<^sub>R x - 1) ` {(1 / 2) *\<^sub>R 1..1} = {0..1::real^1}"
9.2940 + unfolding image_affinity_interval[of _ "- 1", unfolded diff_def[symmetric]] and interval_eq_empty_1
9.2941 + by(auto simp add: vector_component_simps)
9.2942 + have ****:"\<And>x::real^1. x $ 1 * 2 = 1 \<longleftrightarrow> x = (1/2) *\<^sub>R 1" unfolding Cart_eq by(auto simp add: forall_1 vector_component_simps)
9.2943 + show "continuous_on {0..1} (g1 +++ g2)" unfolding * apply(rule continuous_on_union) apply(rule closed_interval)+ proof-
9.2944 + show "continuous_on {0..(1 / 2) *\<^sub>R 1} (g1 +++ g2)" apply(rule continuous_on_eq[of _ "\<lambda>x. g1 (2 *\<^sub>R x)"]) defer
9.2945 + unfolding o_def[THEN sym] apply(rule continuous_on_compose) apply(rule continuous_on_cmul, rule continuous_on_id)
9.2946 + unfolding ** apply(rule as(1)) unfolding joinpaths_def by(auto simp add: vector_component_simps) next
9.2947 + show "continuous_on {(1/2)*\<^sub>R1..1} (g1 +++ g2)" apply(rule continuous_on_eq[of _ "g2 \<circ> (\<lambda>x. 2 *\<^sub>R x - 1)"]) defer
9.2948 + apply(rule continuous_on_compose) apply(rule continuous_on_sub, rule continuous_on_cmul, rule continuous_on_id, rule continuous_on_const)
9.2949 + unfolding *** o_def joinpaths_def apply(rule as(2)) using assms[unfolded pathstart_def pathfinish_def]
9.2950 + by(auto simp add: vector_component_simps ****) qed qed
9.2951 +
9.2952 +lemma path_image_join_subset: "path_image(g1 +++ g2) \<subseteq> (path_image g1 \<union> path_image g2)" proof
9.2953 + fix x assume "x \<in> path_image (g1 +++ g2)"
9.2954 + then obtain y where y:"y\<in>{0..1}" "x = (if dest_vec1 y \<le> 1 / 2 then g1 (2 *\<^sub>R y) else g2 (2 *\<^sub>R y - 1))"
9.2955 + unfolding path_image_def image_iff joinpaths_def by auto
9.2956 + thus "x \<in> path_image g1 \<union> path_image g2" apply(cases "dest_vec1 y \<le> 1/2")
9.2957 + apply(rule_tac UnI1) defer apply(rule_tac UnI2) unfolding y(2) path_image_def using y(1)
9.2958 + by(auto intro!: imageI simp add: vector_component_simps) qed
9.2959 +
9.2960 +lemma subset_path_image_join:
9.2961 + assumes "path_image g1 \<subseteq> s" "path_image g2 \<subseteq> s" shows "path_image(g1 +++ g2) \<subseteq> s"
9.2962 + using path_image_join_subset[of g1 g2] and assms by auto
9.2963 +
9.2964 +lemma path_image_join:
9.2965 + assumes "path g1" "path g2" "pathfinish g1 = pathstart g2"
9.2966 + shows "path_image(g1 +++ g2) = (path_image g1) \<union> (path_image g2)"
9.2967 +apply(rule, rule path_image_join_subset, rule) unfolding Un_iff proof(erule disjE)
9.2968 + fix x assume "x \<in> path_image g1"
9.2969 + then obtain y where y:"y\<in>{0..1}" "x = g1 y" unfolding path_image_def image_iff by auto
9.2970 + thus "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
9.2971 + apply(rule_tac x="(1/2) *\<^sub>R y" in bexI) by(auto simp add: vector_component_simps) next
9.2972 + fix x assume "x \<in> path_image g2"
9.2973 + then obtain y where y:"y\<in>{0..1}" "x = g2 y" unfolding path_image_def image_iff by auto
9.2974 + moreover have *:"y $ 1 = 0 \<Longrightarrow> y = 0" unfolding Cart_eq by auto
9.2975 + ultimately show "x \<in> path_image (g1 +++ g2)" unfolding joinpaths_def path_image_def image_iff
9.2976 + apply(rule_tac x="(1/2) *\<^sub>R (y + 1)" in bexI) using assms(3)[unfolded pathfinish_def pathstart_def]
9.2977 + by(auto simp add: vector_component_simps) qed
9.2978 +
9.2979 +lemma not_in_path_image_join:
9.2980 + assumes "x \<notin> path_image g1" "x \<notin> path_image g2" shows "x \<notin> path_image(g1 +++ g2)"
9.2981 + using assms and path_image_join_subset[of g1 g2] by auto
9.2982 +
9.2983 +lemma simple_path_reversepath: assumes "simple_path g" shows "simple_path (reversepath g)"
9.2984 + using assms unfolding simple_path_def reversepath_def apply- apply(rule ballI)+
9.2985 + apply(erule_tac x="1-x" in ballE, erule_tac x="1-y" in ballE)
9.2986 + unfolding mem_interval_1 by(auto simp add:vector_component_simps)
9.2987 +
9.2988 +lemma dest_vec1_scaleR [simp]:
9.2989 + "dest_vec1 (scaleR a x) = scaleR a (dest_vec1 x)"
9.2990 +unfolding dest_vec1_def by simp
9.2991 +
9.2992 +lemma simple_path_join_loop:
9.2993 + assumes "injective_path g1" "injective_path g2" "pathfinish g2 = pathstart g1"
9.2994 + "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g1,pathstart g2}"
9.2995 + shows "simple_path(g1 +++ g2)"
9.2996 +unfolding simple_path_def proof((rule ballI)+, rule impI) let ?g = "g1 +++ g2"
9.2997 + note inj = assms(1,2)[unfolded injective_path_def, rule_format]
9.2998 + fix x y::"real^1" assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "?g x = ?g y"
9.2999 + show "x = y \<or> x = 0 \<and> y = 1 \<or> x = 1 \<and> y = 0" proof(case_tac "x$1 \<le> 1/2",case_tac[!] "y$1 \<le> 1/2", unfold not_le)
9.3000 + assume as:"x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2"
9.3001 + hence "g1 (2 *\<^sub>R x) = g1 (2 *\<^sub>R y)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
9.3002 + moreover have "2 *\<^sub>R x \<in> {0..1}" "2 *\<^sub>R y \<in> {0..1}" using xy(1,2) as
9.3003 + unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
9.3004 + ultimately show ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] by auto
9.3005 + next assume as:"x $ 1 > 1 / 2" "y $ 1 > 1 / 2"
9.3006 + hence "g2 (2 *\<^sub>R x - 1) = g2 (2 *\<^sub>R y - 1)" using xy(3) unfolding joinpaths_def dest_vec1_def by auto
9.3007 + moreover have "2 *\<^sub>R x - 1 \<in> {0..1}" "2 *\<^sub>R y - 1 \<in> {0..1}" using xy(1,2) as
9.3008 + unfolding mem_interval_1 dest_vec1_def by(auto simp add:vector_component_simps)
9.3009 + ultimately show ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] by auto
9.3010 + next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
9.3011 + hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
9.3012 + using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
9.3013 + moreover have "?g y \<noteq> pathstart g2" using as(2) unfolding pathstart_def joinpaths_def
9.3014 + using inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(2)[unfolded mem_interval_1]
9.3015 + apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
9.3016 + ultimately have *:"?g x = pathstart g1" using assms(4) unfolding xy(3) by auto
9.3017 + hence "x = 0" unfolding pathstart_def joinpaths_def using as(1) and xy(1)[unfolded mem_interval_1]
9.3018 + using inj(1)[of "2 *\<^sub>R x" 0] by(auto simp add:vector_component_simps)
9.3019 + moreover have "y = 1" using * unfolding xy(3) assms(3)[THEN sym]
9.3020 + unfolding joinpaths_def pathfinish_def using as(2) and xy(2)[unfolded mem_interval_1]
9.3021 + using inj(2)[of "2 *\<^sub>R y - 1" 1] by (auto simp add:vector_component_simps Cart_eq)
9.3022 + ultimately show ?thesis by auto
9.3023 + next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
9.3024 + hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
9.3025 + using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
9.3026 + moreover have "?g x \<noteq> pathstart g2" using as(1) unfolding pathstart_def joinpaths_def
9.3027 + using inj(2)[of "2 *\<^sub>R x - 1" 0] and xy(1)[unfolded mem_interval_1]
9.3028 + apply(rule_tac ccontr) by(auto simp add:vector_component_simps field_simps Cart_eq)
9.3029 + ultimately have *:"?g y = pathstart g1" using assms(4) unfolding xy(3) by auto
9.3030 + hence "y = 0" unfolding pathstart_def joinpaths_def using as(2) and xy(2)[unfolded mem_interval_1]
9.3031 + using inj(1)[of "2 *\<^sub>R y" 0] by(auto simp add:vector_component_simps)
9.3032 + moreover have "x = 1" using * unfolding xy(3)[THEN sym] assms(3)[THEN sym]
9.3033 + unfolding joinpaths_def pathfinish_def using as(1) and xy(1)[unfolded mem_interval_1]
9.3034 + using inj(2)[of "2 *\<^sub>R x - 1" 1] by(auto simp add:vector_component_simps Cart_eq)
9.3035 + ultimately show ?thesis by auto qed qed
9.3036 +
9.3037 +lemma injective_path_join:
9.3038 + assumes "injective_path g1" "injective_path g2" "pathfinish g1 = pathstart g2"
9.3039 + "(path_image g1 \<inter> path_image g2) \<subseteq> {pathstart g2}"
9.3040 + shows "injective_path(g1 +++ g2)"
9.3041 + unfolding injective_path_def proof(rule,rule,rule) let ?g = "g1 +++ g2"
9.3042 + note inj = assms(1,2)[unfolded injective_path_def, rule_format]
9.3043 + fix x y assume xy:"x \<in> {0..1}" "y \<in> {0..1}" "(g1 +++ g2) x = (g1 +++ g2) y"
9.3044 + show "x = y" proof(cases "x$1 \<le> 1/2", case_tac[!] "y$1 \<le> 1/2", unfold not_le)
9.3045 + assume "x $ 1 \<le> 1 / 2" "y $ 1 \<le> 1 / 2" thus ?thesis using inj(1)[of "2*\<^sub>R x" "2*\<^sub>R y"] and xy
9.3046 + unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
9.3047 + next assume "x $ 1 > 1 / 2" "y $ 1 > 1 / 2" thus ?thesis using inj(2)[of "2*\<^sub>R x - 1" "2*\<^sub>R y - 1"] and xy
9.3048 + unfolding mem_interval_1 joinpaths_def by(auto simp add:vector_component_simps)
9.3049 + next assume as:"x $ 1 \<le> 1 / 2" "y $ 1 > 1 / 2"
9.3050 + hence "?g x \<in> path_image g1" "?g y \<in> path_image g2" unfolding path_image_def joinpaths_def
9.3051 + using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
9.3052 + hence "?g x = pathfinish g1" "?g y = pathstart g2" using assms(4) unfolding assms(3) xy(3) by auto
9.3053 + thus ?thesis using as and inj(1)[of "2 *\<^sub>R x" 1] inj(2)[of "2 *\<^sub>R y - 1" 0] and xy(1,2)
9.3054 + unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
9.3055 + by(auto simp add:vector_component_simps Cart_eq forall_1)
9.3056 + next assume as:"x $ 1 > 1 / 2" "y $ 1 \<le> 1 / 2"
9.3057 + hence "?g x \<in> path_image g2" "?g y \<in> path_image g1" unfolding path_image_def joinpaths_def
9.3058 + using xy(1,2)[unfolded mem_interval_1] by(auto simp add:vector_component_simps intro!: imageI)
9.3059 + hence "?g x = pathstart g2" "?g y = pathfinish g1" using assms(4) unfolding assms(3) xy(3) by auto
9.3060 + thus ?thesis using as and inj(2)[of "2 *\<^sub>R x - 1" 0] inj(1)[of "2 *\<^sub>R y" 1] and xy(1,2)
9.3061 + unfolding pathstart_def pathfinish_def joinpaths_def mem_interval_1
9.3062 + by(auto simp add:vector_component_simps forall_1 Cart_eq) qed qed
9.3063 +
9.3064 +lemmas join_paths_simps = path_join path_image_join pathstart_join pathfinish_join
9.3065 +
9.3066 +subsection {* Reparametrizing a closed curve to start at some chosen point. *}
9.3067 +
9.3068 +definition "shiftpath a (f::real^1 \<Rightarrow> real^'n) =
9.3069 + (\<lambda>x. if dest_vec1 (a + x) \<le> 1 then f(a + x) else f(a + x - 1))"
9.3070 +
9.3071 +lemma pathstart_shiftpath: "a \<le> 1 \<Longrightarrow> pathstart(shiftpath a g) = g a"
9.3072 + unfolding pathstart_def shiftpath_def by auto
9.3073 +
9.3074 +(** move this **)
9.3075 +declare forall_1[simp] ex_1[simp]
9.3076 +
9.3077 +lemma pathfinish_shiftpath: assumes "0 \<le> a" "pathfinish g = pathstart g"
9.3078 + shows "pathfinish(shiftpath a g) = g a"
9.3079 + using assms unfolding pathstart_def pathfinish_def shiftpath_def
9.3080 + by(auto simp add: vector_component_simps)
9.3081 +
9.3082 +lemma endpoints_shiftpath:
9.3083 + assumes "pathfinish g = pathstart g" "a \<in> {0 .. 1}"
9.3084 + shows "pathfinish(shiftpath a g) = g a" "pathstart(shiftpath a g) = g a"
9.3085 + using assms by(auto intro!:pathfinish_shiftpath pathstart_shiftpath)
9.3086 +
9.3087 +lemma closed_shiftpath:
9.3088 + assumes "pathfinish g = pathstart g" "a \<in> {0..1}"
9.3089 + shows "pathfinish(shiftpath a g) = pathstart(shiftpath a g)"
9.3090 + using endpoints_shiftpath[OF assms] by auto
9.3091 +
9.3092 +lemma path_shiftpath:
9.3093 + assumes "path g" "pathfinish g = pathstart g" "a \<in> {0..1}"
9.3094 + shows "path(shiftpath a g)" proof-
9.3095 + have *:"{0 .. 1} = {0 .. 1-a} \<union> {1-a .. 1}" using assms(3) by(auto simp add: vector_component_simps)
9.3096 + have **:"\<And>x. x + a = 1 \<Longrightarrow> g (x + a - 1) = g (x + a)"
9.3097 + using assms(2)[unfolded pathfinish_def pathstart_def] by auto
9.3098 + show ?thesis unfolding path_def shiftpath_def * apply(rule continuous_on_union)
9.3099 + apply(rule closed_interval)+ apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a + x)"]) prefer 3
9.3100 + apply(rule continuous_on_eq[of _ "g \<circ> (\<lambda>x. a - 1 + x)"]) defer prefer 3
9.3101 + apply(rule continuous_on_intros)+ prefer 2 apply(rule continuous_on_intros)+
9.3102 + apply(rule_tac[1-2] continuous_on_subset[OF assms(1)[unfolded path_def]])
9.3103 + using assms(3) and ** by(auto simp add:vector_component_simps field_simps Cart_eq) qed
9.3104 +
9.3105 +lemma shiftpath_shiftpath: assumes "pathfinish g = pathstart g" "a \<in> {0..1}" "x \<in> {0..1}"
9.3106 + shows "shiftpath (1 - a) (shiftpath a g) x = g x"
9.3107 + using assms unfolding pathfinish_def pathstart_def shiftpath_def
9.3108 + by(auto simp add: vector_component_simps)
9.3109 +
9.3110 +lemma path_image_shiftpath:
9.3111 + assumes "a \<in> {0..1}" "pathfinish g = pathstart g"
9.3112 + shows "path_image(shiftpath a g) = path_image g" proof-
9.3113 + { fix x assume as:"g 1 = g 0" "x \<in> {0..1::real^1}" " \<forall>y\<in>{0..1} \<inter> {x. \<not> a $ 1 + x $ 1 \<le> 1}. g x \<noteq> g (a + y - 1)"
9.3114 + hence "\<exists>y\<in>{0..1} \<inter> {x. a $ 1 + x $ 1 \<le> 1}. g x = g (a + y)" proof(cases "a \<le> x")
9.3115 + case False thus ?thesis apply(rule_tac x="1 + x - a" in bexI)
9.3116 + using as(1,2) and as(3)[THEN bspec[where x="1 + x - a"]] and assms(1)
9.3117 + by(auto simp add:vector_component_simps field_simps atomize_not) next
9.3118 + case True thus ?thesis using as(1-2) and assms(1) apply(rule_tac x="x - a" in bexI)
9.3119 + by(auto simp add:vector_component_simps field_simps) qed }
9.3120 + thus ?thesis using assms unfolding shiftpath_def path_image_def pathfinish_def pathstart_def
9.3121 + by(auto simp add:vector_component_simps image_iff) qed
9.3122 +
9.3123 +subsection {* Special case of straight-line paths. *}
9.3124 +
9.3125 +definition
9.3126 + linepath :: "real ^ 'n::finite \<Rightarrow> real ^ 'n \<Rightarrow> real ^ 1 \<Rightarrow> real ^ 'n" where
9.3127 + "linepath a b = (\<lambda>x. (1 - dest_vec1 x) *\<^sub>R a + dest_vec1 x *\<^sub>R b)"
9.3128 +
9.3129 +lemma pathstart_linepath[simp]: "pathstart(linepath a b) = a"
9.3130 + unfolding pathstart_def linepath_def by auto
9.3131 +
9.3132 +lemma pathfinish_linepath[simp]: "pathfinish(linepath a b) = b"
9.3133 + unfolding pathfinish_def linepath_def by auto
9.3134 +
9.3135 +lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
9.3136 + unfolding linepath_def
9.3137 + by (intro continuous_intros continuous_dest_vec1)
9.3138 +
9.3139 +lemma continuous_on_linepath[intro]: "continuous_on s (linepath a b)"
9.3140 + using continuous_linepath_at by(auto intro!: continuous_at_imp_continuous_on)
9.3141 +
9.3142 +lemma path_linepath[intro]: "path(linepath a b)"
9.3143 + unfolding path_def by(rule continuous_on_linepath)
9.3144 +
9.3145 +lemma path_image_linepath[simp]: "path_image(linepath a b) = (closed_segment a b)"
9.3146 + unfolding path_image_def segment linepath_def apply (rule set_ext, rule) defer
9.3147 + unfolding mem_Collect_eq image_iff apply(erule exE) apply(rule_tac x="u *\<^sub>R 1" in bexI)
9.3148 + by(auto simp add:vector_component_simps)
9.3149 +
9.3150 +lemma reversepath_linepath[simp]: "reversepath(linepath a b) = linepath b a"
9.3151 + unfolding reversepath_def linepath_def by(rule ext, auto simp add:vector_component_simps)
9.3152 +
9.3153 +lemma injective_path_linepath: assumes "a \<noteq> b" shows "injective_path(linepath a b)" proof-
9.3154 + { obtain i where i:"a$i \<noteq> b$i" using assms[unfolded Cart_eq] by auto
9.3155 + fix x y::"real^1" assume "x $ 1 *\<^sub>R b + y $ 1 *\<^sub>R a = x $ 1 *\<^sub>R a + y $ 1 *\<^sub>R b"
9.3156 + hence "x$1 * (b$i - a$i) = y$1 * (b$i - a$i)" unfolding Cart_eq by(auto simp add:field_simps vector_component_simps)
9.3157 + hence "x = y" unfolding mult_cancel_right Cart_eq using i(1) by(auto simp add:field_simps) }
9.3158 + thus ?thesis unfolding injective_path_def linepath_def by(auto simp add:vector_component_simps algebra_simps) qed
9.3159 +
9.3160 +lemma simple_path_linepath[intro]: "a \<noteq> b \<Longrightarrow> simple_path(linepath a b)" by(auto intro!: injective_imp_simple_path injective_path_linepath)
9.3161 +
9.3162 +subsection {* Bounding a point away from a path. *}
9.3163 +
9.3164 +lemma not_on_path_ball: assumes "path g" "z \<notin> path_image g"
9.3165 + shows "\<exists>e>0. ball z e \<inter> (path_image g) = {}" proof-
9.3166 + obtain a where "a\<in>path_image g" "\<forall>y\<in>path_image g. dist z a \<le> dist z y"
9.3167 + using distance_attains_inf[OF _ path_image_nonempty, of g z]
9.3168 + using compact_path_image[THEN compact_imp_closed, OF assms(1)] by auto
9.3169 + thus ?thesis apply(rule_tac x="dist z a" in exI) using assms(2) by(auto intro!: dist_pos_lt) qed
9.3170 +
9.3171 +lemma not_on_path_cball: assumes "path g" "z \<notin> path_image g"
9.3172 + shows "\<exists>e>0. cball z e \<inter> (path_image g) = {}" proof-
9.3173 + obtain e where "ball z e \<inter> path_image g = {}" "e>0" using not_on_path_ball[OF assms] by auto
9.3174 + moreover have "cball z (e/2) \<subseteq> ball z e" using `e>0` by auto
9.3175 + ultimately show ?thesis apply(rule_tac x="e/2" in exI) by auto qed
9.3176 +
9.3177 +subsection {* Path component, considered as a "joinability" relation (from Tom Hales). *}
9.3178 +
9.3179 +definition "path_component s x y \<longleftrightarrow> (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y)"
9.3180 +
9.3181 +lemmas path_defs = path_def pathstart_def pathfinish_def path_image_def path_component_def
9.3182 +
9.3183 +lemma path_component_mem: assumes "path_component s x y" shows "x \<in> s" "y \<in> s"
9.3184 + using assms unfolding path_defs by auto
9.3185 +
9.3186 +lemma path_component_refl: assumes "x \<in> s" shows "path_component s x x"
9.3187 + unfolding path_defs apply(rule_tac x="\<lambda>u. x" in exI) using assms
9.3188 + by(auto intro!:continuous_on_intros)
9.3189 +
9.3190 +lemma path_component_refl_eq: "path_component s x x \<longleftrightarrow> x \<in> s"
9.3191 + by(auto intro!: path_component_mem path_component_refl)
9.3192 +
9.3193 +lemma path_component_sym: "path_component s x y \<Longrightarrow> path_component s y x"
9.3194 + using assms unfolding path_component_def apply(erule exE) apply(rule_tac x="reversepath g" in exI)
9.3195 + by(auto simp add: reversepath_simps)
9.3196 +
9.3197 +lemma path_component_trans: assumes "path_component s x y" "path_component s y z" shows "path_component s x z"
9.3198 + using assms unfolding path_component_def apply- apply(erule exE)+ apply(rule_tac x="g +++ ga" in exI) by(auto simp add: path_image_join)
9.3199 +
9.3200 +lemma path_component_of_subset: "s \<subseteq> t \<Longrightarrow> path_component s x y \<Longrightarrow> path_component t x y"
9.3201 + unfolding path_component_def by auto
9.3202 +
9.3203 +subsection {* Can also consider it as a set, as the name suggests. *}
9.3204 +
9.3205 +lemma path_component_set: "path_component s x = { y. (\<exists>g. path g \<and> path_image g \<subseteq> s \<and> pathstart g = x \<and> pathfinish g = y )}"
9.3206 + apply(rule set_ext) unfolding mem_Collect_eq unfolding mem_def path_component_def by auto
9.3207 +
9.3208 +lemma mem_path_component_set:"x \<in> path_component s y \<longleftrightarrow> path_component s y x" unfolding mem_def by auto
9.3209 +
9.3210 +lemma path_component_subset: "(path_component s x) \<subseteq> s"
9.3211 + apply(rule, rule path_component_mem(2)) by(auto simp add:mem_def)
9.3212 +
9.3213 +lemma path_component_eq_empty: "path_component s x = {} \<longleftrightarrow> x \<notin> s"
9.3214 + apply rule apply(drule equals0D[of _ x]) defer apply(rule equals0I) unfolding mem_path_component_set
9.3215 + apply(drule path_component_mem(1)) using path_component_refl by auto
9.3216 +
9.3217 +subsection {* Path connectedness of a space. *}
9.3218 +
9.3219 +definition "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)"
9.3220 +
9.3221 +lemma path_connected_component: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. path_component s x y)"
9.3222 + unfolding path_connected_def path_component_def by auto
9.3223 +
9.3224 +lemma path_connected_component_set: "path_connected s \<longleftrightarrow> (\<forall>x\<in>s. path_component s x = s)"
9.3225 + unfolding path_connected_component apply(rule, rule, rule, rule path_component_subset)
9.3226 + unfolding subset_eq mem_path_component_set Ball_def mem_def by auto
9.3227 +
9.3228 +subsection {* Some useful lemmas about path-connectedness. *}
9.3229 +
9.3230 +lemma convex_imp_path_connected: assumes "convex s" shows "path_connected s"
9.3231 + unfolding path_connected_def apply(rule,rule,rule_tac x="linepath x y" in exI)
9.3232 + unfolding path_image_linepath using assms[unfolded convex_contains_segment] by auto
9.3233 +
9.3234 +lemma path_connected_imp_connected: assumes "path_connected s" shows "connected s"
9.3235 + unfolding connected_def not_ex apply(rule,rule,rule ccontr) unfolding not_not apply(erule conjE)+ proof-
9.3236 + 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> {}"
9.3237 + then obtain x1 x2 where obt:"x1\<in>e1\<inter>s" "x2\<in>e2\<inter>s" by auto
9.3238 + then obtain g where g:"path g" "path_image g \<subseteq> s" "pathstart g = x1" "pathfinish g = x2"
9.3239 + using assms[unfolded path_connected_def,rule_format,of x1 x2] by auto
9.3240 + have *:"connected {0..1::real^1}" by(auto intro!: convex_connected convex_interval)
9.3241 + 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
9.3242 + 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
9.3243 + 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(auto intro!: exI)
9.3244 + ultimately show False using *[unfolded connected_local not_ex,rule_format, of "{x\<in>{0..1}. g x \<in> e1}" "{x\<in>{0..1}. g x \<in> e2}"]
9.3245 + using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(1)]
9.3246 + using continuous_open_in_preimage[OF g(1)[unfolded path_def] as(2)] by auto qed
9.3247 +
9.3248 +lemma open_path_component: assumes "open s" shows "open(path_component s x)"
9.3249 + unfolding open_contains_ball proof
9.3250 + fix y assume as:"y \<in> path_component s x"
9.3251 + hence "y\<in>s" apply- apply(rule path_component_mem(2)) unfolding mem_def by auto
9.3252 + then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
9.3253 + show "\<exists>e>0. ball y e \<subseteq> path_component s x" apply(rule_tac x=e in exI) apply(rule,rule `e>0`,rule) unfolding mem_ball mem_path_component_set proof-
9.3254 + fix z assume "dist y z < e" thus "path_component s x z" apply(rule_tac path_component_trans[of _ _ y]) defer
9.3255 + apply(rule path_component_of_subset[OF e(2)]) apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) using `e>0`
9.3256 + using as[unfolded mem_def] by auto qed qed
9.3257 +
9.3258 +lemma open_non_path_component: assumes "open s" shows "open(s - path_component s x)" unfolding open_contains_ball proof
9.3259 + fix y assume as:"y\<in>s - path_component s x"
9.3260 + then obtain e where e:"e>0" "ball y e \<subseteq> s" using assms[unfolded open_contains_ball] by auto
9.3261 + show "\<exists>e>0. ball y e \<subseteq> s - path_component s x" apply(rule_tac x=e in exI) apply(rule,rule `e>0`,rule,rule) defer proof(rule ccontr)
9.3262 + fix z assume "z\<in>ball y e" "\<not> z \<notin> path_component s x"
9.3263 + hence "y \<in> path_component s x" unfolding not_not mem_path_component_set using `e>0`
9.3264 + apply- apply(rule path_component_trans,assumption) apply(rule path_component_of_subset[OF e(2)])
9.3265 + apply(rule convex_imp_path_connected[OF convex_ball, unfolded path_connected_component, rule_format]) by auto
9.3266 + thus False using as by auto qed(insert e(2), auto) qed
9.3267 +
9.3268 +lemma connected_open_path_connected: assumes "open s" "connected s" shows "path_connected s"
9.3269 + unfolding path_connected_component_set proof(rule,rule,rule path_component_subset, rule)
9.3270 + fix x y assume "x \<in> s" "y \<in> s" show "y \<in> path_component s x" proof(rule ccontr)
9.3271 + assume "y \<notin> path_component s x" moreover
9.3272 + have "path_component s x \<inter> s \<noteq> {}" using `x\<in>s` path_component_eq_empty path_component_subset[of s x] by auto
9.3273 + ultimately show False using `y\<in>s` open_non_path_component[OF assms(1)] open_path_component[OF assms(1)]
9.3274 + using assms(2)[unfolded connected_def not_ex, rule_format, of"path_component s x" "s - path_component s x"] by auto
9.3275 +qed qed
9.3276 +
9.3277 +lemma path_connected_continuous_image:
9.3278 + assumes "continuous_on s f" "path_connected s" shows "path_connected (f ` s)"
9.3279 + unfolding path_connected_def proof(rule,rule)
9.3280 + fix x' y' assume "x' \<in> f ` s" "y' \<in> f ` s"
9.3281 + then obtain x y where xy:"x\<in>s" "y\<in>s" "x' = f x" "y' = f y" by auto
9.3282 + guess g using assms(2)[unfolded path_connected_def,rule_format,OF xy(1,2)] ..
9.3283 + thus "\<exists>g. path g \<and> path_image g \<subseteq> f ` s \<and> pathstart g = x' \<and> pathfinish g = y'"
9.3284 + unfolding xy apply(rule_tac x="f \<circ> g" in exI) unfolding path_defs
9.3285 + using assms(1) by(auto intro!: continuous_on_compose continuous_on_subset[of _ _ "g ` {0..1}"]) qed
9.3286 +
9.3287 +lemma homeomorphic_path_connectedness:
9.3288 + "s homeomorphic t \<Longrightarrow> (path_connected s \<longleftrightarrow> path_connected t)"
9.3289 + unfolding homeomorphic_def homeomorphism_def apply(erule exE|erule conjE)+ apply rule
9.3290 + apply(drule_tac f=f in path_connected_continuous_image) prefer 3
9.3291 + apply(drule_tac f=g in path_connected_continuous_image) by auto
9.3292 +
9.3293 +lemma path_connected_empty: "path_connected {}"
9.3294 + unfolding path_connected_def by auto
9.3295 +
9.3296 +lemma path_connected_singleton: "path_connected {a}"
9.3297 + unfolding path_connected_def apply(rule,rule)
9.3298 + apply(rule_tac x="linepath a a" in exI) by(auto simp add:segment scaleR_left_diff_distrib)
9.3299 +
9.3300 +lemma path_connected_Un: assumes "path_connected s" "path_connected t" "s \<inter> t \<noteq> {}"
9.3301 + shows "path_connected (s \<union> t)" unfolding path_connected_component proof(rule,rule)
9.3302 + fix x y assume as:"x \<in> s \<union> t" "y \<in> s \<union> t"
9.3303 + from assms(3) obtain z where "z \<in> s \<inter> t" by auto
9.3304 + thus "path_component (s \<union> t) x y" using as using assms(1-2)[unfolded path_connected_component] apply-
9.3305 + apply(erule_tac[!] UnE)+ apply(rule_tac[2-3] path_component_trans[of _ _ z])
9.3306 + by(auto simp add:path_component_of_subset [OF Un_upper1] path_component_of_subset[OF Un_upper2]) qed
9.3307 +
9.3308 +subsection {* sphere is path-connected. *}
9.3309 +
9.3310 +lemma path_connected_punctured_universe:
9.3311 + assumes "2 \<le> CARD('n::finite)" shows "path_connected((UNIV::(real^'n::finite) set) - {a})" proof-
9.3312 + obtain \<psi> where \<psi>:"bij_betw \<psi> {1..CARD('n)} (UNIV::'n set)" using ex_bij_betw_nat_finite_1[OF finite_UNIV] by auto
9.3313 + let ?U = "UNIV::(real^'n) set" let ?u = "?U - {0}"
9.3314 + let ?basis = "\<lambda>k. basis (\<psi> k)"
9.3315 + let ?A = "\<lambda>k. {x::real^'n. \<exists>i\<in>{1..k}. inner (basis (\<psi> i)) x \<noteq> 0}"
9.3316 + have "\<forall>k\<in>{2..CARD('n)}. path_connected (?A k)" proof
9.3317 + have *:"\<And>k. ?A (Suc k) = {x. inner (?basis (Suc k)) x < 0} \<union> {x. inner (?basis (Suc k)) x > 0} \<union> ?A k" apply(rule set_ext,rule) defer
9.3318 + apply(erule UnE)+ unfolding mem_Collect_eq apply(rule_tac[1-2] x="Suc k" in bexI)
9.3319 + by(auto elim!: ballE simp add: not_less le_Suc_eq)
9.3320 + fix k assume "k \<in> {2..CARD('n)}" thus "path_connected (?A k)" proof(induct k)
9.3321 + case (Suc k) show ?case proof(cases "k = 1")
9.3322 + case False from Suc have d:"k \<in> {1..CARD('n)}" "Suc k \<in> {1..CARD('n)}" by auto
9.3323 + hence "\<psi> k \<noteq> \<psi> (Suc k)" using \<psi>[unfolded bij_betw_def inj_on_def, THEN conjunct1, THEN bspec[where x=k]] by auto
9.3324 + hence **:"?basis k + ?basis (Suc k) \<in> {x. 0 < inner (?basis (Suc k)) x} \<inter> (?A k)"
9.3325 + "?basis k - ?basis (Suc k) \<in> {x. 0 > inner (?basis (Suc k)) x} \<inter> ({x. 0 < inner (?basis (Suc k)) x} \<union> (?A k))" using d
9.3326 + by(auto simp add: inner_basis vector_component_simps intro!:bexI[where x=k])
9.3327 + show ?thesis unfolding * Un_assoc apply(rule path_connected_Un) defer apply(rule path_connected_Un)
9.3328 + prefer 5 apply(rule_tac[1-2] convex_imp_path_connected, rule convex_halfspace_lt, rule convex_halfspace_gt)
9.3329 + apply(rule Suc(1)) apply(rule_tac[2-3] ccontr) using d ** False by auto
9.3330 + next case True hence d:"1\<in>{1..CARD('n)}" "2\<in>{1..CARD('n)}" using Suc(2) by auto
9.3331 + have ***:"Suc 1 = 2" by auto
9.3332 + have **:"\<And>s t P Q. s \<union> t \<union> {x. P x \<or> Q x} = (s \<union> {x. P x}) \<union> (t \<union> {x. Q x})" by auto
9.3333 + have "\<psi> 2 \<noteq> \<psi> (Suc 0)" apply(rule ccontr) using \<psi>[unfolded bij_betw_def inj_on_def, THEN conjunct1, THEN bspec[where x=2]] using assms by auto
9.3334 + thus ?thesis unfolding * True unfolding ** neq_iff bex_disj_distrib apply -
9.3335 + apply(rule path_connected_Un, rule_tac[1-2] path_connected_Un) defer 3 apply(rule_tac[1-4] convex_imp_path_connected)
9.3336 + apply(rule_tac[5] x=" ?basis 1 + ?basis 2" in nequals0I)
9.3337 + apply(rule_tac[6] x="-?basis 1 + ?basis 2" in nequals0I)
9.3338 + apply(rule_tac[7] x="-?basis 1 - ?basis 2" in nequals0I)
9.3339 + using d unfolding *** by(auto intro!: convex_halfspace_gt convex_halfspace_lt, auto simp add:vector_component_simps inner_basis)
9.3340 + qed qed auto qed note lem = this
9.3341 +
9.3342 + have ***:"\<And>x::real^'n. (\<exists>i\<in>{1..CARD('n)}. inner (basis (\<psi> i)) x \<noteq> 0) \<longleftrightarrow> (\<exists>i. inner (basis i) x \<noteq> 0)"
9.3343 + apply rule apply(erule bexE) apply(rule_tac x="\<psi> i" in exI) defer apply(erule exE) proof-
9.3344 + fix x::"real^'n" and i assume as:"inner (basis i) x \<noteq> 0"
9.3345 + have "i\<in>\<psi> ` {1..CARD('n)}" using \<psi>[unfolded bij_betw_def, THEN conjunct2] by auto
9.3346 + then obtain j where "j\<in>{1..CARD('n)}" "\<psi> j = i" by auto
9.3347 + thus "\<exists>i\<in>{1..CARD('n)}. inner (basis (\<psi> i)) x \<noteq> 0" apply(rule_tac x=j in bexI) using as by auto qed auto
9.3348 + have *:"?U - {a} = (\<lambda>x. x + a) ` {x. x \<noteq> 0}" apply(rule set_ext) unfolding image_iff
9.3349 + apply rule apply(rule_tac x="x - a" in bexI) by auto
9.3350 + have **:"\<And>x::real^'n. x\<noteq>0 \<longleftrightarrow> (\<exists>i. inner (basis i) x \<noteq> 0)" unfolding Cart_eq by(auto simp add: inner_basis)
9.3351 + show ?thesis unfolding * apply(rule path_connected_continuous_image) apply(rule continuous_on_intros)+
9.3352 + unfolding ** apply(rule lem[THEN bspec[where x="CARD('n)"], unfolded ***]) using assms by auto qed
9.3353 +
9.3354 +lemma path_connected_sphere: assumes "2 \<le> CARD('n::finite)" shows "path_connected {x::real^'n::finite. norm(x - a) = r}" proof(cases "r\<le>0")
9.3355 + case True thus ?thesis proof(cases "r=0")
9.3356 + case False hence "{x::real^'n. norm(x - a) = r} = {}" using True by auto
9.3357 + thus ?thesis using path_connected_empty by auto
9.3358 + qed(auto intro!:path_connected_singleton) next
9.3359 + case False hence *:"{x::real^'n. norm(x - a) = r} = (\<lambda>x. a + r *\<^sub>R x) ` {x. norm x = 1}" unfolding not_le apply -apply(rule set_ext,rule)
9.3360 + unfolding image_iff apply(rule_tac x="(1/r) *\<^sub>R (x - a)" in bexI) unfolding mem_Collect_eq norm_scaleR by (auto simp add: scaleR_right_diff_distrib)
9.3361 + have **:"{x::real^'n. norm x = 1} = (\<lambda>x. (1/norm x) *\<^sub>R x) ` (UNIV - {0})" apply(rule set_ext,rule)
9.3362 + unfolding image_iff apply(rule_tac x=x in bexI) unfolding mem_Collect_eq by(auto split:split_if_asm)
9.3363 + have "continuous_on (UNIV - {0}) (\<lambda>x::real^'n. 1 / norm x)" unfolding o_def continuous_on_eq_continuous_within
9.3364 + apply(rule, rule continuous_at_within_inv[unfolded o_def inverse_eq_divide]) apply(rule continuous_at_within)
9.3365 + apply(rule continuous_at_norm[unfolded o_def]) by auto
9.3366 + thus ?thesis unfolding * ** using path_connected_punctured_universe[OF assms]
9.3367 + by(auto intro!: path_connected_continuous_image continuous_on_intros continuous_on_mul) qed
9.3368 +
9.3369 +lemma connected_sphere: "2 \<le> CARD('n) \<Longrightarrow> connected {x::real^'n::finite. norm(x - a) = r}"
9.3370 + using path_connected_sphere path_connected_imp_connected by auto
9.3371 +
9.3372 +(** In continuous_at_vec1_norm : Use \<And> instead of \<forall>. **)
9.3373 +
9.3374 +end
10.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2 +++ b/src/HOL/Multivariate_Analysis/Determinants.thy Fri Oct 23 13:23:18 2009 +0200
10.3 @@ -0,0 +1,1087 @@
10.4 +(* Title: Determinants
10.5 + Author: Amine Chaieb, University of Cambridge
10.6 +*)
10.7 +
10.8 +header {* Traces, Determinant of square matrices and some properties *}
10.9 +
10.10 +theory Determinants
10.11 +imports Euclidean_Space Permutations
10.12 +begin
10.13 +
10.14 +subsection{* First some facts about products*}
10.15 +lemma setprod_insert_eq: "finite A \<Longrightarrow> setprod f (insert a A) = (if a \<in> A then setprod f A else f a * setprod f A)"
10.16 +apply clarsimp
10.17 +by(subgoal_tac "insert a A = A", auto)
10.18 +
10.19 +lemma setprod_add_split:
10.20 + assumes mn: "(m::nat) <= n + 1"
10.21 + shows "setprod f {m.. n+p} = setprod f {m .. n} * setprod f {n+1..n+p}"
10.22 +proof-
10.23 + let ?A = "{m .. n+p}"
10.24 + let ?B = "{m .. n}"
10.25 + let ?C = "{n+1..n+p}"
10.26 + from mn have un: "?B \<union> ?C = ?A" by auto
10.27 + from mn have dj: "?B \<inter> ?C = {}" by auto
10.28 + have f: "finite ?B" "finite ?C" by simp_all
10.29 + from setprod_Un_disjoint[OF f dj, of f, unfolded un] show ?thesis .
10.30 +qed
10.31 +
10.32 +
10.33 +lemma setprod_offset: "setprod f {(m::nat) + p .. n + p} = setprod (\<lambda>i. f (i + p)) {m..n}"
10.34 +apply (rule setprod_reindex_cong[where f="op + p"])
10.35 +apply (auto simp add: image_iff Bex_def inj_on_def)
10.36 +apply arith
10.37 +apply (rule ext)
10.38 +apply (simp add: add_commute)
10.39 +done
10.40 +
10.41 +lemma setprod_singleton: "setprod f {x} = f x" by simp
10.42 +
10.43 +lemma setprod_singleton_nat_seg: "setprod f {n..n} = f (n::'a::order)" by simp
10.44 +
10.45 +lemma setprod_numseg: "setprod f {m..0} = (if m=0 then f 0 else 1)"
10.46 + "setprod f {m .. Suc n} = (if m \<le> Suc n then f (Suc n) * setprod f {m..n}
10.47 + else setprod f {m..n})"
10.48 + by (auto simp add: atLeastAtMostSuc_conv)
10.49 +
10.50 +lemma setprod_le: assumes fS: "finite S" and fg: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (g x :: 'a::ordered_idom)"
10.51 + shows "setprod f S \<le> setprod g S"
10.52 +using fS fg
10.53 +apply(induct S)
10.54 +apply simp
10.55 +apply auto
10.56 +apply (rule mult_mono)
10.57 +apply (auto intro: setprod_nonneg)
10.58 +done
10.59 +
10.60 + (* FIXME: In Finite_Set there is a useless further assumption *)
10.61 +lemma setprod_inversef: "finite A ==> setprod (inverse \<circ> f) A = (inverse (setprod f A) :: 'a:: {division_by_zero, field})"
10.62 + apply (erule finite_induct)
10.63 + apply (simp)
10.64 + apply simp
10.65 + done
10.66 +
10.67 +lemma setprod_le_1: assumes fS: "finite S" and f: "\<forall>x\<in>S. f x \<ge> 0 \<and> f x \<le> (1::'a::ordered_idom)"
10.68 + shows "setprod f S \<le> 1"
10.69 +using setprod_le[OF fS f] unfolding setprod_1 .
10.70 +
10.71 +subsection{* Trace *}
10.72 +
10.73 +definition trace :: "'a::semiring_1^'n^'n \<Rightarrow> 'a" where
10.74 + "trace A = setsum (\<lambda>i. ((A$i)$i)) (UNIV::'n set)"
10.75 +
10.76 +lemma trace_0: "trace(mat 0) = 0"
10.77 + by (simp add: trace_def mat_def)
10.78 +
10.79 +lemma trace_I: "trace(mat 1 :: 'a::semiring_1^'n^'n) = of_nat(CARD('n))"
10.80 + by (simp add: trace_def mat_def)
10.81 +
10.82 +lemma trace_add: "trace ((A::'a::comm_semiring_1^'n^'n) + B) = trace A + trace B"
10.83 + by (simp add: trace_def setsum_addf)
10.84 +
10.85 +lemma trace_sub: "trace ((A::'a::comm_ring_1^'n^'n) - B) = trace A - trace B"
10.86 + by (simp add: trace_def setsum_subtractf)
10.87 +
10.88 +lemma trace_mul_sym:"trace ((A::'a::comm_semiring_1^'n^'n) ** B) = trace (B**A)"
10.89 + apply (simp add: trace_def matrix_matrix_mult_def)
10.90 + apply (subst setsum_commute)
10.91 + by (simp add: mult_commute)
10.92 +
10.93 +(* ------------------------------------------------------------------------- *)
10.94 +(* Definition of determinant. *)
10.95 +(* ------------------------------------------------------------------------- *)
10.96 +
10.97 +definition det:: "'a::comm_ring_1^'n^'n \<Rightarrow> 'a" where
10.98 + "det A = setsum (\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)) {p. p permutes (UNIV :: 'n set)}"
10.99 +
10.100 +(* ------------------------------------------------------------------------- *)
10.101 +(* A few general lemmas we need below. *)
10.102 +(* ------------------------------------------------------------------------- *)
10.103 +
10.104 +lemma setprod_permute:
10.105 + assumes p: "p permutes S"
10.106 + shows "setprod f S = setprod (f o p) S"
10.107 +proof-
10.108 + {assume "\<not> finite S" hence ?thesis by simp}
10.109 + moreover
10.110 + {assume fS: "finite S"
10.111 + then have ?thesis
10.112 + apply (simp add: setprod_def cong del:strong_setprod_cong)
10.113 + apply (rule ab_semigroup_mult.fold_image_permute)
10.114 + apply (auto simp add: p)
10.115 + apply unfold_locales
10.116 + done}
10.117 + ultimately show ?thesis by blast
10.118 +qed
10.119 +
10.120 +lemma setproduct_permute_nat_interval: "p permutes {m::nat .. n} ==> setprod f {m..n} = setprod (f o p) {m..n}"
10.121 + by (blast intro!: setprod_permute)
10.122 +
10.123 +(* ------------------------------------------------------------------------- *)
10.124 +(* Basic determinant properties. *)
10.125 +(* ------------------------------------------------------------------------- *)
10.126 +
10.127 +lemma det_transp: "det (transp A) = det (A::'a::comm_ring_1 ^'n^'n::finite)"
10.128 +proof-
10.129 + let ?di = "\<lambda>A i j. A$i$j"
10.130 + let ?U = "(UNIV :: 'n set)"
10.131 + have fU: "finite ?U" by simp
10.132 + {fix p assume p: "p \<in> {p. p permutes ?U}"
10.133 + from p have pU: "p permutes ?U" by blast
10.134 + have sth: "sign (inv p) = sign p"
10.135 + by (metis sign_inverse fU p mem_def Collect_def permutation_permutes)
10.136 + from permutes_inj[OF pU]
10.137 + have pi: "inj_on p ?U" by (blast intro: subset_inj_on)
10.138 + from permutes_image[OF pU]
10.139 + have "setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U = setprod (\<lambda>i. ?di (transp A) i (inv p i)) (p ` ?U)" by simp
10.140 + also have "\<dots> = setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U"
10.141 + unfolding setprod_reindex[OF pi] ..
10.142 + also have "\<dots> = setprod (\<lambda>i. ?di A i (p i)) ?U"
10.143 + proof-
10.144 + {fix i assume i: "i \<in> ?U"
10.145 + from i permutes_inv_o[OF pU] permutes_in_image[OF pU]
10.146 + have "((\<lambda>i. ?di (transp A) i (inv p i)) o p) i = ?di A i (p i)"
10.147 + unfolding transp_def by (simp add: expand_fun_eq)}
10.148 + then show "setprod ((\<lambda>i. ?di (transp A) i (inv p i)) o p) ?U = setprod (\<lambda>i. ?di A i (p i)) ?U" by (auto intro: setprod_cong)
10.149 + qed
10.150 + finally have "of_int (sign (inv p)) * (setprod (\<lambda>i. ?di (transp A) i (inv p i)) ?U) = of_int (sign p) * (setprod (\<lambda>i. ?di A i (p i)) ?U)" using sth
10.151 + by simp}
10.152 + then show ?thesis unfolding det_def apply (subst setsum_permutations_inverse)
10.153 + apply (rule setsum_cong2) by blast
10.154 +qed
10.155 +
10.156 +lemma det_lowerdiagonal:
10.157 + fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
10.158 + assumes ld: "\<And>i j. i < j \<Longrightarrow> A$i$j = 0"
10.159 + shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
10.160 +proof-
10.161 + let ?U = "UNIV:: 'n set"
10.162 + let ?PU = "{p. p permutes ?U}"
10.163 + let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
10.164 + have fU: "finite ?U" by simp
10.165 + from finite_permutations[OF fU] have fPU: "finite ?PU" .
10.166 + have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
10.167 + {fix p assume p: "p \<in> ?PU -{id}"
10.168 + from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
10.169 + from permutes_natset_le[OF pU] pid obtain i where
10.170 + i: "p i > i" by (metis not_le)
10.171 + from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
10.172 + from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
10.173 + then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
10.174 + from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
10.175 + unfolding det_def by (simp add: sign_id)
10.176 +qed
10.177 +
10.178 +lemma det_upperdiagonal:
10.179 + fixes A :: "'a::comm_ring_1^'n^'n::{finite,wellorder}"
10.180 + assumes ld: "\<And>i j. i > j \<Longrightarrow> A$i$j = 0"
10.181 + shows "det A = setprod (\<lambda>i. A$i$i) (UNIV:: 'n set)"
10.182 +proof-
10.183 + let ?U = "UNIV:: 'n set"
10.184 + let ?PU = "{p. p permutes ?U}"
10.185 + let ?pp = "(\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set))"
10.186 + have fU: "finite ?U" by simp
10.187 + from finite_permutations[OF fU] have fPU: "finite ?PU" .
10.188 + have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
10.189 + {fix p assume p: "p \<in> ?PU -{id}"
10.190 + from p have pU: "p permutes ?U" and pid: "p \<noteq> id" by blast+
10.191 + from permutes_natset_ge[OF pU] pid obtain i where
10.192 + i: "p i < i" by (metis not_le)
10.193 + from ld[OF i] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
10.194 + from setprod_zero[OF fU ex] have "?pp p = 0" by simp}
10.195 + then have p0: "\<forall>p \<in> ?PU -{id}. ?pp p = 0" by blast
10.196 + from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
10.197 + unfolding det_def by (simp add: sign_id)
10.198 +qed
10.199 +
10.200 +lemma det_diagonal:
10.201 + fixes A :: "'a::comm_ring_1^'n^'n::finite"
10.202 + assumes ld: "\<And>i j. i \<noteq> j \<Longrightarrow> A$i$j = 0"
10.203 + shows "det A = setprod (\<lambda>i. A$i$i) (UNIV::'n set)"
10.204 +proof-
10.205 + let ?U = "UNIV:: 'n set"
10.206 + let ?PU = "{p. p permutes ?U}"
10.207 + let ?pp = "\<lambda>p. of_int (sign p) * setprod (\<lambda>i. A$i$p i) (UNIV :: 'n set)"
10.208 + have fU: "finite ?U" by simp
10.209 + from finite_permutations[OF fU] have fPU: "finite ?PU" .
10.210 + have id0: "{id} \<subseteq> ?PU" by (auto simp add: permutes_id)
10.211 + {fix p assume p: "p \<in> ?PU - {id}"
10.212 + then have "p \<noteq> id" by simp
10.213 + then obtain i where i: "p i \<noteq> i" unfolding expand_fun_eq by auto
10.214 + from ld [OF i [symmetric]] have ex:"\<exists>i \<in> ?U. A$i$p i = 0" by blast
10.215 + from setprod_zero [OF fU ex] have "?pp p = 0" by simp}
10.216 + then have p0: "\<forall>p \<in> ?PU - {id}. ?pp p = 0" by blast
10.217 + from setsum_mono_zero_cong_left[OF fPU id0 p0] show ?thesis
10.218 + unfolding det_def by (simp add: sign_id)
10.219 +qed
10.220 +
10.221 +lemma det_I: "det (mat 1 :: 'a::comm_ring_1^'n^'n::finite) = 1"
10.222 +proof-
10.223 + let ?A = "mat 1 :: 'a::comm_ring_1^'n^'n"
10.224 + let ?U = "UNIV :: 'n set"
10.225 + let ?f = "\<lambda>i j. ?A$i$j"
10.226 + {fix i assume i: "i \<in> ?U"
10.227 + have "?f i i = 1" using i by (vector mat_def)}
10.228 + hence th: "setprod (\<lambda>i. ?f i i) ?U = setprod (\<lambda>x. 1) ?U"
10.229 + by (auto intro: setprod_cong)
10.230 + {fix i j assume i: "i \<in> ?U" and j: "j \<in> ?U" and ij: "i \<noteq> j"
10.231 + have "?f i j = 0" using i j ij by (vector mat_def) }
10.232 + then have "det ?A = setprod (\<lambda>i. ?f i i) ?U" using det_diagonal
10.233 + by blast
10.234 + also have "\<dots> = 1" unfolding th setprod_1 ..
10.235 + finally show ?thesis .
10.236 +qed
10.237 +
10.238 +lemma det_0: "det (mat 0 :: 'a::comm_ring_1^'n^'n::finite) = 0"
10.239 + by (simp add: det_def setprod_zero)
10.240 +
10.241 +lemma det_permute_rows:
10.242 + fixes A :: "'a::comm_ring_1^'n^'n::finite"
10.243 + assumes p: "p permutes (UNIV :: 'n::finite set)"
10.244 + shows "det(\<chi> i. A$p i :: 'a^'n^'n) = of_int (sign p) * det A"
10.245 + apply (simp add: det_def setsum_right_distrib mult_assoc[symmetric])
10.246 + apply (subst sum_permutations_compose_right[OF p])
10.247 +proof(rule setsum_cong2)
10.248 + let ?U = "UNIV :: 'n set"
10.249 + let ?PU = "{p. p permutes ?U}"
10.250 + fix q assume qPU: "q \<in> ?PU"
10.251 + have fU: "finite ?U" by simp
10.252 + from qPU have q: "q permutes ?U" by blast
10.253 + from p q have pp: "permutation p" and qp: "permutation q"
10.254 + by (metis fU permutation_permutes)+
10.255 + from permutes_inv[OF p] have ip: "inv p permutes ?U" .
10.256 + have "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod ((\<lambda>i. A$p i$(q o p) i) o inv p) ?U"
10.257 + by (simp only: setprod_permute[OF ip, symmetric])
10.258 + also have "\<dots> = setprod (\<lambda>i. A $ (p o inv p) i $ (q o (p o inv p)) i) ?U"
10.259 + by (simp only: o_def)
10.260 + also have "\<dots> = setprod (\<lambda>i. A$i$q i) ?U" by (simp only: o_def permutes_inverses[OF p])
10.261 + finally have thp: "setprod (\<lambda>i. A$p i$ (q o p) i) ?U = setprod (\<lambda>i. A$i$q i) ?U"
10.262 + by blast
10.263 + show "of_int (sign (q o p)) * setprod (\<lambda>i. A$ p i$ (q o p) i) ?U = of_int (sign p) * of_int (sign q) * setprod (\<lambda>i. A$i$q i) ?U"
10.264 + by (simp only: thp sign_compose[OF qp pp] mult_commute of_int_mult)
10.265 +qed
10.266 +
10.267 +lemma det_permute_columns:
10.268 + fixes A :: "'a::comm_ring_1^'n^'n::finite"
10.269 + assumes p: "p permutes (UNIV :: 'n set)"
10.270 + shows "det(\<chi> i j. A$i$ p j :: 'a^'n^'n) = of_int (sign p) * det A"
10.271 +proof-
10.272 + let ?Ap = "\<chi> i j. A$i$ p j :: 'a^'n^'n"
10.273 + let ?At = "transp A"
10.274 + have "of_int (sign p) * det A = det (transp (\<chi> i. transp A $ p i))"
10.275 + unfolding det_permute_rows[OF p, of ?At] det_transp ..
10.276 + moreover
10.277 + have "?Ap = transp (\<chi> i. transp A $ p i)"
10.278 + by (simp add: transp_def Cart_eq)
10.279 + ultimately show ?thesis by simp
10.280 +qed
10.281 +
10.282 +lemma det_identical_rows:
10.283 + fixes A :: "'a::ordered_idom^'n^'n::finite"
10.284 + assumes ij: "i \<noteq> j"
10.285 + and r: "row i A = row j A"
10.286 + shows "det A = 0"
10.287 +proof-
10.288 + have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
10.289 + by simp
10.290 + have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
10.291 + let ?p = "Fun.swap i j id"
10.292 + let ?A = "\<chi> i. A $ ?p i"
10.293 + from r have "A = ?A" by (simp add: Cart_eq row_def swap_def)
10.294 + hence "det A = det ?A" by simp
10.295 + moreover have "det A = - det ?A"
10.296 + by (simp add: det_permute_rows[OF permutes_swap_id] sign_swap_id ij th1)
10.297 + ultimately show "det A = 0" by (metis tha)
10.298 +qed
10.299 +
10.300 +lemma det_identical_columns:
10.301 + fixes A :: "'a::ordered_idom^'n^'n::finite"
10.302 + assumes ij: "i \<noteq> j"
10.303 + and r: "column i A = column j A"
10.304 + shows "det A = 0"
10.305 +apply (subst det_transp[symmetric])
10.306 +apply (rule det_identical_rows[OF ij])
10.307 +by (metis row_transp r)
10.308 +
10.309 +lemma det_zero_row:
10.310 + fixes A :: "'a::{idom, ring_char_0}^'n^'n::finite"
10.311 + assumes r: "row i A = 0"
10.312 + shows "det A = 0"
10.313 +using r
10.314 +apply (simp add: row_def det_def Cart_eq)
10.315 +apply (rule setsum_0')
10.316 +apply (auto simp: sign_nz)
10.317 +done
10.318 +
10.319 +lemma det_zero_column:
10.320 + fixes A :: "'a::{idom,ring_char_0}^'n^'n::finite"
10.321 + assumes r: "column i A = 0"
10.322 + shows "det A = 0"
10.323 + apply (subst det_transp[symmetric])
10.324 + apply (rule det_zero_row [of i])
10.325 + by (metis row_transp r)
10.326 +
10.327 +lemma det_row_add:
10.328 + fixes a b c :: "'n::finite \<Rightarrow> _ ^ 'n"
10.329 + shows "det((\<chi> i. if i = k then a i + b i else c i)::'a::comm_ring_1^'n^'n) =
10.330 + det((\<chi> i. if i = k then a i else c i)::'a::comm_ring_1^'n^'n) +
10.331 + det((\<chi> i. if i = k then b i else c i)::'a::comm_ring_1^'n^'n)"
10.332 +unfolding det_def Cart_lambda_beta setsum_addf[symmetric]
10.333 +proof (rule setsum_cong2)
10.334 + let ?U = "UNIV :: 'n set"
10.335 + let ?pU = "{p. p permutes ?U}"
10.336 + let ?f = "(\<lambda>i. if i = k then a i + b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
10.337 + let ?g = "(\<lambda> i. if i = k then a i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
10.338 + let ?h = "(\<lambda> i. if i = k then b i else c i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
10.339 + fix p assume p: "p \<in> ?pU"
10.340 + let ?Uk = "?U - {k}"
10.341 + from p have pU: "p permutes ?U" by blast
10.342 + have kU: "?U = insert k ?Uk" by blast
10.343 + {fix j assume j: "j \<in> ?Uk"
10.344 + from j have "?f j $ p j = ?g j $ p j" and "?f j $ p j= ?h j $ p j"
10.345 + by simp_all}
10.346 + then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
10.347 + and th2: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?h i $ p i) ?Uk"
10.348 + apply -
10.349 + apply (rule setprod_cong, simp_all)+
10.350 + done
10.351 + have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
10.352 + have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
10.353 + unfolding kU[symmetric] ..
10.354 + also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
10.355 + apply (rule setprod_insert)
10.356 + apply simp
10.357 + by blast
10.358 + also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk)" by (simp add: ring_simps)
10.359 + also have "\<dots> = (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk) + (b k$ p k * setprod (\<lambda>i. ?h i $ p i) ?Uk)" by (metis th1 th2)
10.360 + also have "\<dots> = setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk) + setprod (\<lambda>i. ?h i $ p i) (insert k ?Uk)"
10.361 + unfolding setprod_insert[OF th3] by simp
10.362 + finally have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?g i $ p i) ?U + setprod (\<lambda>i. ?h i $ p i) ?U" unfolding kU[symmetric] .
10.363 + then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U + of_int (sign p) * setprod (\<lambda>i. ?h i $ p i) ?U"
10.364 + by (simp add: ring_simps)
10.365 +qed
10.366 +
10.367 +lemma det_row_mul:
10.368 + fixes a b :: "'n::finite \<Rightarrow> _ ^ 'n"
10.369 + shows "det((\<chi> i. if i = k then c *s a i else b i)::'a::comm_ring_1^'n^'n) =
10.370 + c* det((\<chi> i. if i = k then a i else b i)::'a::comm_ring_1^'n^'n)"
10.371 +
10.372 +unfolding det_def Cart_lambda_beta setsum_right_distrib
10.373 +proof (rule setsum_cong2)
10.374 + let ?U = "UNIV :: 'n set"
10.375 + let ?pU = "{p. p permutes ?U}"
10.376 + let ?f = "(\<lambda>i. if i = k then c*s a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
10.377 + let ?g = "(\<lambda> i. if i = k then a i else b i)::'n \<Rightarrow> 'a::comm_ring_1^'n"
10.378 + fix p assume p: "p \<in> ?pU"
10.379 + let ?Uk = "?U - {k}"
10.380 + from p have pU: "p permutes ?U" by blast
10.381 + have kU: "?U = insert k ?Uk" by blast
10.382 + {fix j assume j: "j \<in> ?Uk"
10.383 + from j have "?f j $ p j = ?g j $ p j" by simp}
10.384 + then have th1: "setprod (\<lambda>i. ?f i $ p i) ?Uk = setprod (\<lambda>i. ?g i $ p i) ?Uk"
10.385 + apply -
10.386 + apply (rule setprod_cong, simp_all)
10.387 + done
10.388 + have th3: "finite ?Uk" "k \<notin> ?Uk" by auto
10.389 + have "setprod (\<lambda>i. ?f i $ p i) ?U = setprod (\<lambda>i. ?f i $ p i) (insert k ?Uk)"
10.390 + unfolding kU[symmetric] ..
10.391 + also have "\<dots> = ?f k $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk"
10.392 + apply (rule setprod_insert)
10.393 + apply simp
10.394 + by blast
10.395 + also have "\<dots> = (c*s a k) $ p k * setprod (\<lambda>i. ?f i $ p i) ?Uk" by (simp add: ring_simps)
10.396 + also have "\<dots> = c* (a k $ p k * setprod (\<lambda>i. ?g i $ p i) ?Uk)"
10.397 + unfolding th1 by (simp add: mult_ac)
10.398 + also have "\<dots> = c* (setprod (\<lambda>i. ?g i $ p i) (insert k ?Uk))"
10.399 + unfolding setprod_insert[OF th3] by simp
10.400 + finally have "setprod (\<lambda>i. ?f i $ p i) ?U = c* (setprod (\<lambda>i. ?g i $ p i) ?U)" unfolding kU[symmetric] .
10.401 + then show "of_int (sign p) * setprod (\<lambda>i. ?f i $ p i) ?U = c * (of_int (sign p) * setprod (\<lambda>i. ?g i $ p i) ?U)"
10.402 + by (simp add: ring_simps)
10.403 +qed
10.404 +
10.405 +lemma det_row_0:
10.406 + fixes b :: "'n::finite \<Rightarrow> _ ^ 'n"
10.407 + shows "det((\<chi> i. if i = k then 0 else b i)::'a::comm_ring_1^'n^'n) = 0"
10.408 +using det_row_mul[of k 0 "\<lambda>i. 1" b]
10.409 +apply (simp)
10.410 + unfolding vector_smult_lzero .
10.411 +
10.412 +lemma det_row_operation:
10.413 + fixes A :: "'a::ordered_idom^'n^'n::finite"
10.414 + assumes ij: "i \<noteq> j"
10.415 + shows "det (\<chi> k. if k = i then row i A + c *s row j A else row k A) = det A"
10.416 +proof-
10.417 + let ?Z = "(\<chi> k. if k = i then row j A else row k A) :: 'a ^'n^'n"
10.418 + have th: "row i ?Z = row j ?Z" by (vector row_def)
10.419 + have th2: "((\<chi> k. if k = i then row i A else row k A) :: 'a^'n^'n) = A"
10.420 + by (vector row_def)
10.421 + show ?thesis
10.422 + unfolding det_row_add [of i] det_row_mul[of i] det_identical_rows[OF ij th] th2
10.423 + by simp
10.424 +qed
10.425 +
10.426 +lemma det_row_span:
10.427 + fixes A :: "'a:: ordered_idom^'n^'n::finite"
10.428 + assumes x: "x \<in> span {row j A |j. j \<noteq> i}"
10.429 + shows "det (\<chi> k. if k = i then row i A + x else row k A) = det A"
10.430 +proof-
10.431 + let ?U = "UNIV :: 'n set"
10.432 + let ?S = "{row j A |j. j \<noteq> i}"
10.433 + let ?d = "\<lambda>x. det (\<chi> k. if k = i then x else row k A)"
10.434 + let ?P = "\<lambda>x. ?d (row i A + x) = det A"
10.435 + {fix k
10.436 +
10.437 + have "(if k = i then row i A + 0 else row k A) = row k A" by simp}
10.438 + then have P0: "?P 0"
10.439 + apply -
10.440 + apply (rule cong[of det, OF refl])
10.441 + by (vector row_def)
10.442 + moreover
10.443 + {fix c z y assume zS: "z \<in> ?S" and Py: "?P y"
10.444 + from zS obtain j where j: "z = row j A" "i \<noteq> j" by blast
10.445 + let ?w = "row i A + y"
10.446 + have th0: "row i A + (c*s z + y) = ?w + c*s z" by vector
10.447 + have thz: "?d z = 0"
10.448 + apply (rule det_identical_rows[OF j(2)])
10.449 + using j by (vector row_def)
10.450 + have "?d (row i A + (c*s z + y)) = ?d (?w + c*s z)" unfolding th0 ..
10.451 + then have "?P (c*s z + y)" unfolding thz Py det_row_mul[of i] det_row_add[of i]
10.452 + by simp }
10.453 +
10.454 + ultimately show ?thesis
10.455 + apply -
10.456 + apply (rule span_induct_alt[of ?P ?S, OF P0])
10.457 + apply blast
10.458 + apply (rule x)
10.459 + done
10.460 +qed
10.461 +
10.462 +(* ------------------------------------------------------------------------- *)
10.463 +(* May as well do this, though it's a bit unsatisfactory since it ignores *)
10.464 +(* exact duplicates by considering the rows/columns as a set. *)
10.465 +(* ------------------------------------------------------------------------- *)
10.466 +
10.467 +lemma det_dependent_rows:
10.468 + fixes A:: "'a::ordered_idom^'n^'n::finite"
10.469 + assumes d: "dependent (rows A)"
10.470 + shows "det A = 0"
10.471 +proof-
10.472 + let ?U = "UNIV :: 'n set"
10.473 + from d obtain i where i: "row i A \<in> span (rows A - {row i A})"
10.474 + unfolding dependent_def rows_def by blast
10.475 + {fix j k assume jk: "j \<noteq> k"
10.476 + and c: "row j A = row k A"
10.477 + from det_identical_rows[OF jk c] have ?thesis .}
10.478 + moreover
10.479 + {assume H: "\<And> i j. i \<noteq> j \<Longrightarrow> row i A \<noteq> row j A"
10.480 + have th0: "- row i A \<in> span {row j A|j. j \<noteq> i}"
10.481 + apply (rule span_neg)
10.482 + apply (rule set_rev_mp)
10.483 + apply (rule i)
10.484 + apply (rule span_mono)
10.485 + using H i by (auto simp add: rows_def)
10.486 + from det_row_span[OF th0]
10.487 + have "det A = det (\<chi> k. if k = i then 0 *s 1 else row k A)"
10.488 + unfolding right_minus vector_smult_lzero ..
10.489 + with det_row_mul[of i "0::'a" "\<lambda>i. 1"]
10.490 + have "det A = 0" by simp}
10.491 + ultimately show ?thesis by blast
10.492 +qed
10.493 +
10.494 +lemma det_dependent_columns: assumes d: "dependent(columns (A::'a::ordered_idom^'n^'n::finite))" shows "det A = 0"
10.495 +by (metis d det_dependent_rows rows_transp det_transp)
10.496 +
10.497 +(* ------------------------------------------------------------------------- *)
10.498 +(* Multilinearity and the multiplication formula. *)
10.499 +(* ------------------------------------------------------------------------- *)
10.500 +
10.501 +lemma Cart_lambda_cong: "(\<And>x. f x = g x) \<Longrightarrow> (Cart_lambda f::'a^'n) = (Cart_lambda g :: 'a^'n)"
10.502 + apply (rule iffD1[OF Cart_lambda_unique]) by vector
10.503 +
10.504 +lemma det_linear_row_setsum:
10.505 + assumes fS: "finite S"
10.506 + shows "det ((\<chi> i. if i = k then setsum (a i) S else c i)::'a::comm_ring_1^'n^'n::finite) = setsum (\<lambda>j. det ((\<chi> i. if i = k then a i j else c i)::'a^'n^'n)) S"
10.507 +proof(induct rule: finite_induct[OF fS])
10.508 + case 1 thus ?case apply simp unfolding setsum_empty det_row_0[of k] ..
10.509 +next
10.510 + case (2 x F)
10.511 + then show ?case by (simp add: det_row_add cong del: if_weak_cong)
10.512 +qed
10.513 +
10.514 +lemma finite_bounded_functions:
10.515 + assumes fS: "finite S"
10.516 + shows "finite {f. (\<forall>i \<in> {1.. (k::nat)}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1 .. k} \<longrightarrow> f i = i)}"
10.517 +proof(induct k)
10.518 + case 0
10.519 + have th: "{f. \<forall>i. f i = i} = {id}" by (auto intro: ext)
10.520 + show ?case by (auto simp add: th)
10.521 +next
10.522 + case (Suc k)
10.523 + let ?f = "\<lambda>(y::nat,g) i. if i = Suc k then y else g i"
10.524 + let ?S = "?f ` (S \<times> {f. (\<forall>i\<in>{1..k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1..k} \<longrightarrow> f i = i)})"
10.525 + have "?S = {f. (\<forall>i\<in>{1.. Suc k}. f i \<in> S) \<and> (\<forall>i. i \<notin> {1.. Suc k} \<longrightarrow> f i = i)}"
10.526 + apply (auto simp add: image_iff)
10.527 + apply (rule_tac x="x (Suc k)" in bexI)
10.528 + apply (rule_tac x = "\<lambda>i. if i = Suc k then i else x i" in exI)
10.529 + apply (auto intro: ext)
10.530 + done
10.531 + with finite_imageI[OF finite_cartesian_product[OF fS Suc.hyps(1)], of ?f]
10.532 + show ?case by metis
10.533 +qed
10.534 +
10.535 +
10.536 +lemma eq_id_iff[simp]: "(\<forall>x. f x = x) = (f = id)" by (auto intro: ext)
10.537 +
10.538 +lemma det_linear_rows_setsum_lemma:
10.539 + assumes fS: "finite S" and fT: "finite T"
10.540 + shows "det((\<chi> i. if i \<in> T then setsum (a i) S else c i):: 'a::comm_ring_1^'n^'n::finite) =
10.541 + setsum (\<lambda>f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n))
10.542 + {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
10.543 +using fT
10.544 +proof(induct T arbitrary: a c set: finite)
10.545 + case empty
10.546 + have th0: "\<And>x y. (\<chi> i. if i \<in> {} then x i else y i) = (\<chi> i. y i)" by vector
10.547 + from "empty.prems" show ?case unfolding th0 by simp
10.548 +next
10.549 + case (insert z T a c)
10.550 + let ?F = "\<lambda>T. {f. (\<forall>i \<in> T. f i \<in> S) \<and> (\<forall>i. i \<notin> T \<longrightarrow> f i = i)}"
10.551 + let ?h = "\<lambda>(y,g) i. if i = z then y else g i"
10.552 + let ?k = "\<lambda>h. (h(z),(\<lambda>i. if i = z then i else h i))"
10.553 + let ?s = "\<lambda> k a c f. det((\<chi> i. if i \<in> T then a i (f i) else c i)::'a^'n^'n)"
10.554 + let ?c = "\<lambda>i. if i = z then a i j else c i"
10.555 + have thif: "\<And>a b c d. (if a \<or> b then c else d) = (if a then c else if b then c else d)" by simp
10.556 + have thif2: "\<And>a b c d e. (if a then b else if c then d else e) =
10.557 + (if c then (if a then b else d) else (if a then b else e))" by simp
10.558 + from `z \<notin> T` have nz: "\<And>i. i \<in> T \<Longrightarrow> i = z \<longleftrightarrow> False" by auto
10.559 + have "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
10.560 + det (\<chi> i. if i = z then setsum (a i) S
10.561 + else if i \<in> T then setsum (a i) S else c i)"
10.562 + unfolding insert_iff thif ..
10.563 + also have "\<dots> = (\<Sum>j\<in>S. det (\<chi> i. if i \<in> T then setsum (a i) S
10.564 + else if i = z then a i j else c i))"
10.565 + unfolding det_linear_row_setsum[OF fS]
10.566 + apply (subst thif2)
10.567 + using nz by (simp cong del: if_weak_cong cong add: if_cong)
10.568 + finally have tha:
10.569 + "det (\<chi> i. if i \<in> insert z T then setsum (a i) S else c i) =
10.570 + (\<Sum>(j, f)\<in>S \<times> ?F T. det (\<chi> i. if i \<in> T then a i (f i)
10.571 + else if i = z then a i j
10.572 + else c i))"
10.573 + unfolding insert.hyps unfolding setsum_cartesian_product by blast
10.574 + show ?case unfolding tha
10.575 + apply(rule setsum_eq_general_reverses[where h= "?h" and k= "?k"],
10.576 + blast intro: finite_cartesian_product fS finite,
10.577 + blast intro: finite_cartesian_product fS finite)
10.578 + using `z \<notin> T`
10.579 + apply (auto intro: ext)
10.580 + apply (rule cong[OF refl[of det]])
10.581 + by vector
10.582 +qed
10.583 +
10.584 +lemma det_linear_rows_setsum:
10.585 + assumes fS: "finite (S::'n::finite set)"
10.586 + shows "det (\<chi> i. setsum (a i) S) = setsum (\<lambda>f. det (\<chi> i. a i (f i) :: 'a::comm_ring_1 ^ 'n^'n::finite)) {f. \<forall>i. f i \<in> S}"
10.587 +proof-
10.588 + have th0: "\<And>x y. ((\<chi> i. if i \<in> (UNIV:: 'n set) then x i else y i) :: 'a^'n^'n) = (\<chi> i. x i)" by vector
10.589 +
10.590 + from det_linear_rows_setsum_lemma[OF fS, of "UNIV :: 'n set" a, unfolded th0, OF finite] show ?thesis by simp
10.591 +qed
10.592 +
10.593 +lemma matrix_mul_setsum_alt:
10.594 + fixes A B :: "'a::comm_ring_1^'n^'n::finite"
10.595 + shows "A ** B = (\<chi> i. setsum (\<lambda>k. A$i$k *s B $ k) (UNIV :: 'n set))"
10.596 + by (vector matrix_matrix_mult_def setsum_component)
10.597 +
10.598 +lemma det_rows_mul:
10.599 + "det((\<chi> i. c i *s a i)::'a::comm_ring_1^'n^'n::finite) =
10.600 + setprod (\<lambda>i. c i) (UNIV:: 'n set) * det((\<chi> i. a i)::'a^'n^'n)"
10.601 +proof (simp add: det_def setsum_right_distrib cong add: setprod_cong, rule setsum_cong2)
10.602 + let ?U = "UNIV :: 'n set"
10.603 + let ?PU = "{p. p permutes ?U}"
10.604 + fix p assume pU: "p \<in> ?PU"
10.605 + let ?s = "of_int (sign p)"
10.606 + from pU have p: "p permutes ?U" by blast
10.607 + have "setprod (\<lambda>i. c i * a i $ p i) ?U = setprod c ?U * setprod (\<lambda>i. a i $ p i) ?U"
10.608 + unfolding setprod_timesf ..
10.609 + then show "?s * (\<Prod>xa\<in>?U. c xa * a xa $ p xa) =
10.610 + setprod c ?U * (?s* (\<Prod>xa\<in>?U. a xa $ p xa))" by (simp add: ring_simps)
10.611 +qed
10.612 +
10.613 +lemma det_mul:
10.614 + fixes A B :: "'a::ordered_idom^'n^'n::finite"
10.615 + shows "det (A ** B) = det A * det B"
10.616 +proof-
10.617 + let ?U = "UNIV :: 'n set"
10.618 + let ?F = "{f. (\<forall>i\<in> ?U. f i \<in> ?U) \<and> (\<forall>i. i \<notin> ?U \<longrightarrow> f i = i)}"
10.619 + let ?PU = "{p. p permutes ?U}"
10.620 + have fU: "finite ?U" by simp
10.621 + have fF: "finite ?F" by (rule finite)
10.622 + {fix p assume p: "p permutes ?U"
10.623 +
10.624 + have "p \<in> ?F" unfolding mem_Collect_eq permutes_in_image[OF p]
10.625 + using p[unfolded permutes_def] by simp}
10.626 + then have PUF: "?PU \<subseteq> ?F" by blast
10.627 + {fix f assume fPU: "f \<in> ?F - ?PU"
10.628 + have fUU: "f ` ?U \<subseteq> ?U" using fPU by auto
10.629 + from fPU have f: "\<forall>i \<in> ?U. f i \<in> ?U"
10.630 + "\<forall>i. i \<notin> ?U \<longrightarrow> f i = i" "\<not>(\<forall>y. \<exists>!x. f x = y)" unfolding permutes_def
10.631 + by auto
10.632 +
10.633 + let ?A = "(\<chi> i. A$i$f i *s B$f i) :: 'a^'n^'n"
10.634 + let ?B = "(\<chi> i. B$f i) :: 'a^'n^'n"
10.635 + {assume fni: "\<not> inj_on f ?U"
10.636 + then obtain i j where ij: "f i = f j" "i \<noteq> j"
10.637 + unfolding inj_on_def by blast
10.638 + from ij
10.639 + have rth: "row i ?B = row j ?B" by (vector row_def)
10.640 + from det_identical_rows[OF ij(2) rth]
10.641 + have "det (\<chi> i. A$i$f i *s B$f i) = 0"
10.642 + unfolding det_rows_mul by simp}
10.643 + moreover
10.644 + {assume fi: "inj_on f ?U"
10.645 + from f fi have fith: "\<And>i j. f i = f j \<Longrightarrow> i = j"
10.646 + unfolding inj_on_def by metis
10.647 + note fs = fi[unfolded surjective_iff_injective_gen[OF fU fU refl fUU, symmetric]]
10.648 +
10.649 + {fix y
10.650 + from fs f have "\<exists>x. f x = y" by blast
10.651 + then obtain x where x: "f x = y" by blast
10.652 + {fix z assume z: "f z = y" from fith x z have "z = x" by metis}
10.653 + with x have "\<exists>!x. f x = y" by blast}
10.654 + with f(3) have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
10.655 + ultimately have "det (\<chi> i. A$i$f i *s B$f i) = 0" by blast}
10.656 + hence zth: "\<forall> f\<in> ?F - ?PU. det (\<chi> i. A$i$f i *s B$f i) = 0" by simp
10.657 + {fix p assume pU: "p \<in> ?PU"
10.658 + from pU have p: "p permutes ?U" by blast
10.659 + let ?s = "\<lambda>p. of_int (sign p)"
10.660 + let ?f = "\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
10.661 + (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))"
10.662 + have "(setsum (\<lambda>q. ?s q *
10.663 + (\<Prod>i\<in> ?U. (\<chi> i. A $ i $ p i *s B $ p i :: 'a^'n^'n) $ i $ q i)) ?PU) =
10.664 + (setsum (\<lambda>q. ?s p * (\<Prod>i\<in> ?U. A $ i $ p i) *
10.665 + (?s q * (\<Prod>i\<in> ?U. B $ i $ q i))) ?PU)"
10.666 + unfolding sum_permutations_compose_right[OF permutes_inv[OF p], of ?f]
10.667 + proof(rule setsum_cong2)
10.668 + fix q assume qU: "q \<in> ?PU"
10.669 + hence q: "q permutes ?U" by blast
10.670 + from p q have pp: "permutation p" and pq: "permutation q"
10.671 + unfolding permutation_permutes by auto
10.672 + have th00: "of_int (sign p) * of_int (sign p) = (1::'a)"
10.673 + "\<And>a. of_int (sign p) * (of_int (sign p) * a) = a"
10.674 + unfolding mult_assoc[symmetric] unfolding of_int_mult[symmetric]
10.675 + by (simp_all add: sign_idempotent)
10.676 + have ths: "?s q = ?s p * ?s (q o inv p)"
10.677 + using pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
10.678 + by (simp add: th00 mult_ac sign_idempotent sign_compose)
10.679 + have th001: "setprod (\<lambda>i. B$i$ q (inv p i)) ?U = setprod ((\<lambda>i. B$i$ q (inv p i)) o p) ?U"
10.680 + by (rule setprod_permute[OF p])
10.681 + have thp: "setprod (\<lambda>i. (\<chi> i. A$i$p i *s B$p i :: 'a^'n^'n) $i $ q i) ?U = setprod (\<lambda>i. A$i$p i) ?U * setprod (\<lambda>i. B$i$ q (inv p i)) ?U"
10.682 + unfolding th001 setprod_timesf[symmetric] o_def permutes_inverses[OF p]
10.683 + apply (rule setprod_cong[OF refl])
10.684 + using permutes_in_image[OF q] by vector
10.685 + show "?s q * setprod (\<lambda>i. (((\<chi> i. A$i$p i *s B$p i) :: 'a^'n^'n)$i$q i)) ?U = ?s p * (setprod (\<lambda>i. A$i$p i) ?U) * (?s (q o inv p) * setprod (\<lambda>i. B$i$(q o inv p) i) ?U)"
10.686 + using ths thp pp pq permutation_inverse[OF pp] sign_inverse[OF pp]
10.687 + by (simp add: sign_nz th00 ring_simps sign_idempotent sign_compose)
10.688 + qed
10.689 + }
10.690 + then have th2: "setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU = det A * det B"
10.691 + unfolding det_def setsum_product
10.692 + by (rule setsum_cong2)
10.693 + have "det (A**B) = setsum (\<lambda>f. det (\<chi> i. A $ i $ f i *s B $ f i)) ?F"
10.694 + unfolding matrix_mul_setsum_alt det_linear_rows_setsum[OF fU] by simp
10.695 + also have "\<dots> = setsum (\<lambda>f. det (\<chi> i. A$i$f i *s B$f i)) ?PU"
10.696 + using setsum_mono_zero_cong_left[OF fF PUF zth, symmetric]
10.697 + unfolding det_rows_mul by auto
10.698 + finally show ?thesis unfolding th2 .
10.699 +qed
10.700 +
10.701 +(* ------------------------------------------------------------------------- *)
10.702 +(* Relation to invertibility. *)
10.703 +(* ------------------------------------------------------------------------- *)
10.704 +
10.705 +lemma invertible_left_inverse:
10.706 + fixes A :: "real^'n^'n::finite"
10.707 + shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). B** A = mat 1)"
10.708 + by (metis invertible_def matrix_left_right_inverse)
10.709 +
10.710 +lemma invertible_righ_inverse:
10.711 + fixes A :: "real^'n^'n::finite"
10.712 + shows "invertible A \<longleftrightarrow> (\<exists>(B::real^'n^'n). A** B = mat 1)"
10.713 + by (metis invertible_def matrix_left_right_inverse)
10.714 +
10.715 +lemma invertible_det_nz:
10.716 + fixes A::"real ^'n^'n::finite"
10.717 + shows "invertible A \<longleftrightarrow> det A \<noteq> 0"
10.718 +proof-
10.719 + {assume "invertible A"
10.720 + then obtain B :: "real ^'n^'n" where B: "A ** B = mat 1"
10.721 + unfolding invertible_righ_inverse by blast
10.722 + hence "det (A ** B) = det (mat 1 :: real ^'n^'n)" by simp
10.723 + hence "det A \<noteq> 0"
10.724 + apply (simp add: det_mul det_I) by algebra }
10.725 + moreover
10.726 + {assume H: "\<not> invertible A"
10.727 + let ?U = "UNIV :: 'n set"
10.728 + have fU: "finite ?U" by simp
10.729 + from H obtain c i where c: "setsum (\<lambda>i. c i *s row i A) ?U = 0"
10.730 + and iU: "i \<in> ?U" and ci: "c i \<noteq> 0"
10.731 + unfolding invertible_righ_inverse
10.732 + unfolding matrix_right_invertible_independent_rows by blast
10.733 + have stupid: "\<And>(a::real^'n) b. a + b = 0 \<Longrightarrow> -a = b"
10.734 + apply (drule_tac f="op + (- a)" in cong[OF refl])
10.735 + apply (simp only: ab_left_minus add_assoc[symmetric])
10.736 + apply simp
10.737 + done
10.738 + from c ci
10.739 + have thr0: "- row i A = setsum (\<lambda>j. (1/ c i) *s (c j *s row j A)) (?U - {i})"
10.740 + unfolding setsum_diff1'[OF fU iU] setsum_cmul
10.741 + apply -
10.742 + apply (rule vector_mul_lcancel_imp[OF ci])
10.743 + apply (auto simp add: vector_smult_assoc vector_smult_rneg field_simps)
10.744 + unfolding stupid ..
10.745 + have thr: "- row i A \<in> span {row j A| j. j \<noteq> i}"
10.746 + unfolding thr0
10.747 + apply (rule span_setsum)
10.748 + apply simp
10.749 + apply (rule ballI)
10.750 + apply (rule span_mul)+
10.751 + apply (rule span_superset)
10.752 + apply auto
10.753 + done
10.754 + let ?B = "(\<chi> k. if k = i then 0 else row k A) :: real ^'n^'n"
10.755 + have thrb: "row i ?B = 0" using iU by (vector row_def)
10.756 + have "det A = 0"
10.757 + unfolding det_row_span[OF thr, symmetric] right_minus
10.758 + unfolding det_zero_row[OF thrb] ..}
10.759 + ultimately show ?thesis by blast
10.760 +qed
10.761 +
10.762 +(* ------------------------------------------------------------------------- *)
10.763 +(* Cramer's rule. *)
10.764 +(* ------------------------------------------------------------------------- *)
10.765 +
10.766 +lemma cramer_lemma_transp:
10.767 + fixes A:: "'a::ordered_idom^'n^'n::finite" and x :: "'a ^'n::finite"
10.768 + shows "det ((\<chi> i. if i = k then setsum (\<lambda>i. x$i *s row i A) (UNIV::'n set)
10.769 + else row i A)::'a^'n^'n) = x$k * det A"
10.770 + (is "?lhs = ?rhs")
10.771 +proof-
10.772 + let ?U = "UNIV :: 'n set"
10.773 + let ?Uk = "?U - {k}"
10.774 + have U: "?U = insert k ?Uk" by blast
10.775 + have fUk: "finite ?Uk" by simp
10.776 + have kUk: "k \<notin> ?Uk" by simp
10.777 + have th00: "\<And>k s. x$k *s row k A + s = (x$k - 1) *s row k A + row k A + s"
10.778 + by (vector ring_simps)
10.779 + have th001: "\<And>f k . (\<lambda>x. if x = k then f k else f x) = f" by (auto intro: ext)
10.780 + have "(\<chi> i. row i A) = A" by (vector row_def)
10.781 + then have thd1: "det (\<chi> i. row i A) = det A" by simp
10.782 + have thd0: "det (\<chi> i. if i = k then row k A + (\<Sum>i \<in> ?Uk. x $ i *s row i A) else row i A) = det A"
10.783 + apply (rule det_row_span)
10.784 + apply (rule span_setsum[OF fUk])
10.785 + apply (rule ballI)
10.786 + apply (rule span_mul)
10.787 + apply (rule span_superset)
10.788 + apply auto
10.789 + done
10.790 + show "?lhs = x$k * det A"
10.791 + apply (subst U)
10.792 + unfolding setsum_insert[OF fUk kUk]
10.793 + apply (subst th00)
10.794 + unfolding add_assoc
10.795 + apply (subst det_row_add)
10.796 + unfolding thd0
10.797 + unfolding det_row_mul
10.798 + unfolding th001[of k "\<lambda>i. row i A"]
10.799 + unfolding thd1 by (simp add: ring_simps)
10.800 +qed
10.801 +
10.802 +lemma cramer_lemma:
10.803 + fixes A :: "'a::ordered_idom ^'n^'n::finite"
10.804 + shows "det((\<chi> i j. if j = k then (A *v x)$i else A$i$j):: 'a^'n^'n) = x$k * det A"
10.805 +proof-
10.806 + let ?U = "UNIV :: 'n set"
10.807 + have stupid: "\<And>c. setsum (\<lambda>i. c i *s row i (transp A)) ?U = setsum (\<lambda>i. c i *s column i A) ?U"
10.808 + by (auto simp add: row_transp intro: setsum_cong2)
10.809 + show ?thesis unfolding matrix_mult_vsum
10.810 + unfolding cramer_lemma_transp[of k x "transp A", unfolded det_transp, symmetric]
10.811 + unfolding stupid[of "\<lambda>i. x$i"]
10.812 + apply (subst det_transp[symmetric])
10.813 + apply (rule cong[OF refl[of det]]) by (vector transp_def column_def row_def)
10.814 +qed
10.815 +
10.816 +lemma cramer:
10.817 + fixes A ::"real^'n^'n::finite"
10.818 + assumes d0: "det A \<noteq> 0"
10.819 + shows "A *v x = b \<longleftrightarrow> x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
10.820 +proof-
10.821 + from d0 obtain B where B: "A ** B = mat 1" "B ** A = mat 1"
10.822 + unfolding invertible_det_nz[symmetric] invertible_def by blast
10.823 + have "(A ** B) *v b = b" by (simp add: B matrix_vector_mul_lid)
10.824 + hence "A *v (B *v b) = b" by (simp add: matrix_vector_mul_assoc)
10.825 + then have xe: "\<exists>x. A*v x = b" by blast
10.826 + {fix x assume x: "A *v x = b"
10.827 + have "x = (\<chi> k. det(\<chi> i j. if j=k then b$i else A$i$j :: real^'n^'n) / det A)"
10.828 + unfolding x[symmetric]
10.829 + using d0 by (simp add: Cart_eq cramer_lemma field_simps)}
10.830 + with xe show ?thesis by auto
10.831 +qed
10.832 +
10.833 +(* ------------------------------------------------------------------------- *)
10.834 +(* Orthogonality of a transformation and matrix. *)
10.835 +(* ------------------------------------------------------------------------- *)
10.836 +
10.837 +definition "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>v w. f v \<bullet> f w = v \<bullet> w)"
10.838 +
10.839 +lemma orthogonal_transformation: "orthogonal_transformation f \<longleftrightarrow> linear f \<and> (\<forall>(v::real ^_). norm (f v) = norm v)"
10.840 + unfolding orthogonal_transformation_def
10.841 + apply auto
10.842 + apply (erule_tac x=v in allE)+
10.843 + apply (simp add: real_vector_norm_def)
10.844 + by (simp add: dot_norm linear_add[symmetric])
10.845 +
10.846 +definition "orthogonal_matrix (Q::'a::semiring_1^'n^'n) \<longleftrightarrow> transp Q ** Q = mat 1 \<and> Q ** transp Q = mat 1"
10.847 +
10.848 +lemma orthogonal_matrix: "orthogonal_matrix (Q:: real ^'n^'n::finite) \<longleftrightarrow> transp Q ** Q = mat 1"
10.849 + by (metis matrix_left_right_inverse orthogonal_matrix_def)
10.850 +
10.851 +lemma orthogonal_matrix_id: "orthogonal_matrix (mat 1 :: _^'n^'n::finite)"
10.852 + by (simp add: orthogonal_matrix_def transp_mat matrix_mul_lid)
10.853 +
10.854 +lemma orthogonal_matrix_mul:
10.855 + fixes A :: "real ^'n^'n::finite"
10.856 + assumes oA : "orthogonal_matrix A"
10.857 + and oB: "orthogonal_matrix B"
10.858 + shows "orthogonal_matrix(A ** B)"
10.859 + using oA oB
10.860 + unfolding orthogonal_matrix matrix_transp_mul
10.861 + apply (subst matrix_mul_assoc)
10.862 + apply (subst matrix_mul_assoc[symmetric])
10.863 + by (simp add: matrix_mul_rid)
10.864 +
10.865 +lemma orthogonal_transformation_matrix:
10.866 + fixes f:: "real^'n \<Rightarrow> real^'n::finite"
10.867 + shows "orthogonal_transformation f \<longleftrightarrow> linear f \<and> orthogonal_matrix(matrix f)"
10.868 + (is "?lhs \<longleftrightarrow> ?rhs")
10.869 +proof-
10.870 + let ?mf = "matrix f"
10.871 + let ?ot = "orthogonal_transformation f"
10.872 + let ?U = "UNIV :: 'n set"
10.873 + have fU: "finite ?U" by simp
10.874 + let ?m1 = "mat 1 :: real ^'n^'n"
10.875 + {assume ot: ?ot
10.876 + from ot have lf: "linear f" and fd: "\<forall>v w. f v \<bullet> f w = v \<bullet> w"
10.877 + unfolding orthogonal_transformation_def orthogonal_matrix by blast+
10.878 + {fix i j
10.879 + let ?A = "transp ?mf ** ?mf"
10.880 + have th0: "\<And>b (x::'a::comm_ring_1). (if b then 1 else 0)*x = (if b then x else 0)"
10.881 + "\<And>b (x::'a::comm_ring_1). x*(if b then 1 else 0) = (if b then x else 0)"
10.882 + by simp_all
10.883 + from fd[rule_format, of "basis i" "basis j", unfolded matrix_works[OF lf, symmetric] dot_matrix_vector_mul]
10.884 + have "?A$i$j = ?m1 $ i $ j"
10.885 + by (simp add: dot_def matrix_matrix_mult_def columnvector_def rowvector_def basis_def th0 setsum_delta[OF fU] mat_def)}
10.886 + hence "orthogonal_matrix ?mf" unfolding orthogonal_matrix by vector
10.887 + with lf have ?rhs by blast}
10.888 + moreover
10.889 + {assume lf: "linear f" and om: "orthogonal_matrix ?mf"
10.890 + from lf om have ?lhs
10.891 + unfolding orthogonal_matrix_def norm_eq orthogonal_transformation
10.892 + unfolding matrix_works[OF lf, symmetric]
10.893 + apply (subst dot_matrix_vector_mul)
10.894 + by (simp add: dot_matrix_product matrix_mul_lid)}
10.895 + ultimately show ?thesis by blast
10.896 +qed
10.897 +
10.898 +lemma det_orthogonal_matrix:
10.899 + fixes Q:: "'a::ordered_idom^'n^'n::finite"
10.900 + assumes oQ: "orthogonal_matrix Q"
10.901 + shows "det Q = 1 \<or> det Q = - 1"
10.902 +proof-
10.903 +
10.904 + have th: "\<And>x::'a. x = 1 \<or> x = - 1 \<longleftrightarrow> x*x = 1" (is "\<And>x::'a. ?ths x")
10.905 + proof-
10.906 + fix x:: 'a
10.907 + have th0: "x*x - 1 = (x - 1)*(x + 1)" by (simp add: ring_simps)
10.908 + have th1: "\<And>(x::'a) y. x = - y \<longleftrightarrow> x + y = 0"
10.909 + apply (subst eq_iff_diff_eq_0) by simp
10.910 + have "x*x = 1 \<longleftrightarrow> x*x - 1 = 0" by simp
10.911 + also have "\<dots> \<longleftrightarrow> x = 1 \<or> x = - 1" unfolding th0 th1 by simp
10.912 + finally show "?ths x" ..
10.913 + qed
10.914 + from oQ have "Q ** transp Q = mat 1" by (metis orthogonal_matrix_def)
10.915 + hence "det (Q ** transp Q) = det (mat 1:: 'a^'n^'n)" by simp
10.916 + hence "det Q * det Q = 1" by (simp add: det_mul det_I det_transp)
10.917 + then show ?thesis unfolding th .
10.918 +qed
10.919 +
10.920 +(* ------------------------------------------------------------------------- *)
10.921 +(* Linearity of scaling, and hence isometry, that preserves origin. *)
10.922 +(* ------------------------------------------------------------------------- *)
10.923 +lemma scaling_linear:
10.924 + fixes f :: "real ^'n \<Rightarrow> real ^'n::finite"
10.925 + assumes f0: "f 0 = 0" and fd: "\<forall>x y. dist (f x) (f y) = c * dist x y"
10.926 + shows "linear f"
10.927 +proof-
10.928 + {fix v w
10.929 + {fix x note fd[rule_format, of x 0, unfolded dist_norm f0 diff_0_right] }
10.930 + note th0 = this
10.931 + have "f v \<bullet> f w = c^2 * (v \<bullet> w)"
10.932 + unfolding dot_norm_neg dist_norm[symmetric]
10.933 + unfolding th0 fd[rule_format] by (simp add: power2_eq_square field_simps)}
10.934 + note fc = this
10.935 + show ?thesis unfolding linear_def vector_eq
10.936 + by (simp add: dot_lmult dot_ladd dot_rmult dot_radd fc ring_simps)
10.937 +qed
10.938 +
10.939 +lemma isometry_linear:
10.940 + "f (0:: real^'n) = (0:: real^'n::finite) \<Longrightarrow> \<forall>x y. dist(f x) (f y) = dist x y
10.941 + \<Longrightarrow> linear f"
10.942 +by (rule scaling_linear[where c=1]) simp_all
10.943 +
10.944 +(* ------------------------------------------------------------------------- *)
10.945 +(* Hence another formulation of orthogonal transformation. *)
10.946 +(* ------------------------------------------------------------------------- *)
10.947 +
10.948 +lemma orthogonal_transformation_isometry:
10.949 + "orthogonal_transformation f \<longleftrightarrow> f(0::real^'n) = (0::real^'n::finite) \<and> (\<forall>x y. dist(f x) (f y) = dist x y)"
10.950 + unfolding orthogonal_transformation
10.951 + apply (rule iffI)
10.952 + apply clarify
10.953 + apply (clarsimp simp add: linear_0 linear_sub[symmetric] dist_norm)
10.954 + apply (rule conjI)
10.955 + apply (rule isometry_linear)
10.956 + apply simp
10.957 + apply simp
10.958 + apply clarify
10.959 + apply (erule_tac x=v in allE)
10.960 + apply (erule_tac x=0 in allE)
10.961 + by (simp add: dist_norm)
10.962 +
10.963 +(* ------------------------------------------------------------------------- *)
10.964 +(* Can extend an isometry from unit sphere. *)
10.965 +(* ------------------------------------------------------------------------- *)
10.966 +
10.967 +lemma isometry_sphere_extend:
10.968 + fixes f:: "real ^'n \<Rightarrow> real ^'n::finite"
10.969 + assumes f1: "\<forall>x. norm x = 1 \<longrightarrow> norm (f x) = 1"
10.970 + and fd1: "\<forall> x y. norm x = 1 \<longrightarrow> norm y = 1 \<longrightarrow> dist (f x) (f y) = dist x y"
10.971 + shows "\<exists>g. orthogonal_transformation g \<and> (\<forall>x. norm x = 1 \<longrightarrow> g x = f x)"
10.972 +proof-
10.973 + {fix x y x' y' x0 y0 x0' y0' :: "real ^'n"
10.974 + assume H: "x = norm x *s x0" "y = norm y *s y0"
10.975 + "x' = norm x *s x0'" "y' = norm y *s y0'"
10.976 + "norm x0 = 1" "norm x0' = 1" "norm y0 = 1" "norm y0' = 1"
10.977 + "norm(x0' - y0') = norm(x0 - y0)"
10.978 +
10.979 + have "norm(x' - y') = norm(x - y)"
10.980 + apply (subst H(1))
10.981 + apply (subst H(2))
10.982 + apply (subst H(3))
10.983 + apply (subst H(4))
10.984 + using H(5-9)
10.985 + apply (simp add: norm_eq norm_eq_1)
10.986 + apply (simp add: dot_lsub dot_rsub dot_lmult dot_rmult)
10.987 + apply (simp add: ring_simps)
10.988 + by (simp only: right_distrib[symmetric])}
10.989 + note th0 = this
10.990 + let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
10.991 + {fix x:: "real ^'n" assume nx: "norm x = 1"
10.992 + have "?g x = f x" using nx by auto}
10.993 + hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
10.994 + have g0: "?g 0 = 0" by simp
10.995 + {fix x y :: "real ^'n"
10.996 + {assume "x = 0" "y = 0"
10.997 + then have "dist (?g x) (?g y) = dist x y" by simp }
10.998 + moreover
10.999 + {assume "x = 0" "y \<noteq> 0"
10.1000 + then have "dist (?g x) (?g y) = dist x y"
10.1001 + apply (simp add: dist_norm norm_mul)
10.1002 + apply (rule f1[rule_format])
10.1003 + by(simp add: norm_mul field_simps)}
10.1004 + moreover
10.1005 + {assume "x \<noteq> 0" "y = 0"
10.1006 + then have "dist (?g x) (?g y) = dist x y"
10.1007 + apply (simp add: dist_norm norm_mul)
10.1008 + apply (rule f1[rule_format])
10.1009 + by(simp add: norm_mul field_simps)}
10.1010 + moreover
10.1011 + {assume z: "x \<noteq> 0" "y \<noteq> 0"
10.1012 + have th00: "x = norm x *s (inverse (norm x) *s x)" "y = norm y *s (inverse (norm y) *s y)" "norm x *s f ((inverse (norm x) *s x)) = norm x *s f (inverse (norm x) *s x)"
10.1013 + "norm y *s f (inverse (norm y) *s y) = norm y *s f (inverse (norm y) *s y)"
10.1014 + "norm (inverse (norm x) *s x) = 1"
10.1015 + "norm (f (inverse (norm x) *s x)) = 1"
10.1016 + "norm (inverse (norm y) *s y) = 1"
10.1017 + "norm (f (inverse (norm y) *s y)) = 1"
10.1018 + "norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
10.1019 + norm (inverse (norm x) *s x - inverse (norm y) *s y)"
10.1020 + using z
10.1021 + by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_norm])
10.1022 + from z th0[OF th00] have "dist (?g x) (?g y) = dist x y"
10.1023 + by (simp add: dist_norm)}
10.1024 + ultimately have "dist (?g x) (?g y) = dist x y" by blast}
10.1025 + note thd = this
10.1026 + show ?thesis
10.1027 + apply (rule exI[where x= ?g])
10.1028 + unfolding orthogonal_transformation_isometry
10.1029 + using g0 thfg thd by metis
10.1030 +qed
10.1031 +
10.1032 +(* ------------------------------------------------------------------------- *)
10.1033 +(* Rotation, reflection, rotoinversion. *)
10.1034 +(* ------------------------------------------------------------------------- *)
10.1035 +
10.1036 +definition "rotation_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = 1"
10.1037 +definition "rotoinversion_matrix Q \<longleftrightarrow> orthogonal_matrix Q \<and> det Q = - 1"
10.1038 +
10.1039 +lemma orthogonal_rotation_or_rotoinversion:
10.1040 + fixes Q :: "'a::ordered_idom^'n^'n::finite"
10.1041 + shows " orthogonal_matrix Q \<longleftrightarrow> rotation_matrix Q \<or> rotoinversion_matrix Q"
10.1042 + by (metis rotoinversion_matrix_def rotation_matrix_def det_orthogonal_matrix)
10.1043 +(* ------------------------------------------------------------------------- *)
10.1044 +(* Explicit formulas for low dimensions. *)
10.1045 +(* ------------------------------------------------------------------------- *)
10.1046 +
10.1047 +lemma setprod_1: "setprod f {(1::nat)..1} = f 1" by simp
10.1048 +
10.1049 +lemma setprod_2: "setprod f {(1::nat)..2} = f 1 * f 2"
10.1050 + by (simp add: nat_number setprod_numseg mult_commute)
10.1051 +lemma setprod_3: "setprod f {(1::nat)..3} = f 1 * f 2 * f 3"
10.1052 + by (simp add: nat_number setprod_numseg mult_commute)
10.1053 +
10.1054 +lemma det_1: "det (A::'a::comm_ring_1^1^1) = A$1$1"
10.1055 + by (simp add: det_def permutes_sing sign_id UNIV_1)
10.1056 +
10.1057 +lemma det_2: "det (A::'a::comm_ring_1^2^2) = A$1$1 * A$2$2 - A$1$2 * A$2$1"
10.1058 +proof-
10.1059 + have f12: "finite {2::2}" "1 \<notin> {2::2}" by auto
10.1060 + show ?thesis
10.1061 + unfolding det_def UNIV_2
10.1062 + unfolding setsum_over_permutations_insert[OF f12]
10.1063 + unfolding permutes_sing
10.1064 + apply (simp add: sign_swap_id sign_id swap_id_eq)
10.1065 + by (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
10.1066 +qed
10.1067 +
10.1068 +lemma det_3: "det (A::'a::comm_ring_1^3^3) =
10.1069 + A$1$1 * A$2$2 * A$3$3 +
10.1070 + A$1$2 * A$2$3 * A$3$1 +
10.1071 + A$1$3 * A$2$1 * A$3$2 -
10.1072 + A$1$1 * A$2$3 * A$3$2 -
10.1073 + A$1$2 * A$2$1 * A$3$3 -
10.1074 + A$1$3 * A$2$2 * A$3$1"
10.1075 +proof-
10.1076 + have f123: "finite {2::3, 3}" "1 \<notin> {2::3, 3}" by auto
10.1077 + have f23: "finite {3::3}" "2 \<notin> {3::3}" by auto
10.1078 +
10.1079 + show ?thesis
10.1080 + unfolding det_def UNIV_3
10.1081 + unfolding setsum_over_permutations_insert[OF f123]
10.1082 + unfolding setsum_over_permutations_insert[OF f23]
10.1083 +
10.1084 + unfolding permutes_sing
10.1085 + apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
10.1086 + apply (simp add: arith_simps(31)[symmetric] of_int_minus of_int_1 del: arith_simps(31))
10.1087 + by (simp add: ring_simps)
10.1088 +qed
10.1089 +
10.1090 +end
11.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2 +++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
11.3 @@ -0,0 +1,5372 @@
11.4 +(* Title: Library/Euclidean_Space
11.5 + Author: Amine Chaieb, University of Cambridge
11.6 +*)
11.7 +
11.8 +header {* (Real) Vectors in Euclidean space, and elementary linear algebra.*}
11.9 +
11.10 +theory Euclidean_Space
11.11 +imports
11.12 + Complex_Main "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
11.13 + Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
11.14 + Inner_Product
11.15 +uses "positivstellensatz.ML" ("normarith.ML")
11.16 +begin
11.17 +
11.18 +text{* Some common special cases.*}
11.19 +
11.20 +lemma forall_1: "(\<forall>i::1. P i) \<longleftrightarrow> P 1"
11.21 + by (metis num1_eq_iff)
11.22 +
11.23 +lemma exhaust_2:
11.24 + fixes x :: 2 shows "x = 1 \<or> x = 2"
11.25 +proof (induct x)
11.26 + case (of_int z)
11.27 + then have "0 <= z" and "z < 2" by simp_all
11.28 + then have "z = 0 | z = 1" by arith
11.29 + then show ?case by auto
11.30 +qed
11.31 +
11.32 +lemma forall_2: "(\<forall>i::2. P i) \<longleftrightarrow> P 1 \<and> P 2"
11.33 + by (metis exhaust_2)
11.34 +
11.35 +lemma exhaust_3:
11.36 + fixes x :: 3 shows "x = 1 \<or> x = 2 \<or> x = 3"
11.37 +proof (induct x)
11.38 + case (of_int z)
11.39 + then have "0 <= z" and "z < 3" by simp_all
11.40 + then have "z = 0 \<or> z = 1 \<or> z = 2" by arith
11.41 + then show ?case by auto
11.42 +qed
11.43 +
11.44 +lemma forall_3: "(\<forall>i::3. P i) \<longleftrightarrow> P 1 \<and> P 2 \<and> P 3"
11.45 + by (metis exhaust_3)
11.46 +
11.47 +lemma UNIV_1: "UNIV = {1::1}"
11.48 + by (auto simp add: num1_eq_iff)
11.49 +
11.50 +lemma UNIV_2: "UNIV = {1::2, 2::2}"
11.51 + using exhaust_2 by auto
11.52 +
11.53 +lemma UNIV_3: "UNIV = {1::3, 2::3, 3::3}"
11.54 + using exhaust_3 by auto
11.55 +
11.56 +lemma setsum_1: "setsum f (UNIV::1 set) = f 1"
11.57 + unfolding UNIV_1 by simp
11.58 +
11.59 +lemma setsum_2: "setsum f (UNIV::2 set) = f 1 + f 2"
11.60 + unfolding UNIV_2 by simp
11.61 +
11.62 +lemma setsum_3: "setsum f (UNIV::3 set) = f 1 + f 2 + f 3"
11.63 + unfolding UNIV_3 by (simp add: add_ac)
11.64 +
11.65 +subsection{* Basic componentwise operations on vectors. *}
11.66 +
11.67 +instantiation "^" :: (plus,type) plus
11.68 +begin
11.69 +definition vector_add_def : "op + \<equiv> (\<lambda> x y. (\<chi> i. (x$i) + (y$i)))"
11.70 +instance ..
11.71 +end
11.72 +
11.73 +instantiation "^" :: (times,type) times
11.74 +begin
11.75 + definition vector_mult_def : "op * \<equiv> (\<lambda> x y. (\<chi> i. (x$i) * (y$i)))"
11.76 + instance ..
11.77 +end
11.78 +
11.79 +instantiation "^" :: (minus,type) minus begin
11.80 + definition vector_minus_def : "op - \<equiv> (\<lambda> x y. (\<chi> i. (x$i) - (y$i)))"
11.81 +instance ..
11.82 +end
11.83 +
11.84 +instantiation "^" :: (uminus,type) uminus begin
11.85 + definition vector_uminus_def : "uminus \<equiv> (\<lambda> x. (\<chi> i. - (x$i)))"
11.86 +instance ..
11.87 +end
11.88 +instantiation "^" :: (zero,type) zero begin
11.89 + definition vector_zero_def : "0 \<equiv> (\<chi> i. 0)"
11.90 +instance ..
11.91 +end
11.92 +
11.93 +instantiation "^" :: (one,type) one begin
11.94 + definition vector_one_def : "1 \<equiv> (\<chi> i. 1)"
11.95 +instance ..
11.96 +end
11.97 +
11.98 +instantiation "^" :: (ord,type) ord
11.99 + begin
11.100 +definition vector_less_eq_def:
11.101 + "less_eq (x :: 'a ^'b) y = (ALL i. x$i <= y$i)"
11.102 +definition vector_less_def: "less (x :: 'a ^'b) y = (ALL i. x$i < y$i)"
11.103 +
11.104 +instance by (intro_classes)
11.105 +end
11.106 +
11.107 +instantiation "^" :: (scaleR, type) scaleR
11.108 +begin
11.109 +definition vector_scaleR_def: "scaleR = (\<lambda> r x. (\<chi> i. scaleR r (x$i)))"
11.110 +instance ..
11.111 +end
11.112 +
11.113 +text{* Also the scalar-vector multiplication. *}
11.114 +
11.115 +definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixl "*s" 70)
11.116 + where "c *s x = (\<chi> i. c * (x$i))"
11.117 +
11.118 +text{* Constant Vectors *}
11.119 +
11.120 +definition "vec x = (\<chi> i. x)"
11.121 +
11.122 +text{* Dot products. *}
11.123 +
11.124 +definition dot :: "'a::{comm_monoid_add, times} ^ 'n \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a" (infix "\<bullet>" 70) where
11.125 + "x \<bullet> y = setsum (\<lambda>i. x$i * y$i) UNIV"
11.126 +
11.127 +lemma dot_1[simp]: "(x::'a::{comm_monoid_add, times}^1) \<bullet> y = (x$1) * (y$1)"
11.128 + by (simp add: dot_def setsum_1)
11.129 +
11.130 +lemma dot_2[simp]: "(x::'a::{comm_monoid_add, times}^2) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2)"
11.131 + by (simp add: dot_def setsum_2)
11.132 +
11.133 +lemma dot_3[simp]: "(x::'a::{comm_monoid_add, times}^3) \<bullet> y = (x$1) * (y$1) + (x$2) * (y$2) + (x$3) * (y$3)"
11.134 + by (simp add: dot_def setsum_3)
11.135 +
11.136 +subsection {* A naive proof procedure to lift really trivial arithmetic stuff from the basis of the vector space. *}
11.137 +
11.138 +method_setup vector = {*
11.139 +let
11.140 + val ss1 = HOL_basic_ss addsimps [@{thm dot_def}, @{thm setsum_addf} RS sym,
11.141 + @{thm setsum_subtractf} RS sym, @{thm setsum_right_distrib},
11.142 + @{thm setsum_left_distrib}, @{thm setsum_negf} RS sym]
11.143 + val ss2 = @{simpset} addsimps
11.144 + [@{thm vector_add_def}, @{thm vector_mult_def},
11.145 + @{thm vector_minus_def}, @{thm vector_uminus_def},
11.146 + @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def},
11.147 + @{thm vector_scaleR_def},
11.148 + @{thm Cart_lambda_beta}, @{thm vector_scalar_mult_def}]
11.149 + fun vector_arith_tac ths =
11.150 + simp_tac ss1
11.151 + THEN' (fn i => rtac @{thm setsum_cong2} i
11.152 + ORELSE rtac @{thm setsum_0'} i
11.153 + ORELSE simp_tac (HOL_basic_ss addsimps [@{thm "Cart_eq"}]) i)
11.154 + (* THEN' TRY o clarify_tac HOL_cs THEN' (TRY o rtac @{thm iffI}) *)
11.155 + THEN' asm_full_simp_tac (ss2 addsimps ths)
11.156 + in
11.157 + Attrib.thms >> (fn ths => K (SIMPLE_METHOD' (vector_arith_tac ths)))
11.158 + end
11.159 +*} "Lifts trivial vector statements to real arith statements"
11.160 +
11.161 +lemma vec_0[simp]: "vec 0 = 0" by (vector vector_zero_def)
11.162 +lemma vec_1[simp]: "vec 1 = 1" by (vector vector_one_def)
11.163 +
11.164 +
11.165 +
11.166 +text{* Obvious "component-pushing". *}
11.167 +
11.168 +lemma vec_component [simp]: "(vec x :: 'a ^ 'n)$i = x"
11.169 + by (vector vec_def)
11.170 +
11.171 +lemma vector_add_component [simp]:
11.172 + fixes x y :: "'a::{plus} ^ 'n"
11.173 + shows "(x + y)$i = x$i + y$i"
11.174 + by vector
11.175 +
11.176 +lemma vector_minus_component [simp]:
11.177 + fixes x y :: "'a::{minus} ^ 'n"
11.178 + shows "(x - y)$i = x$i - y$i"
11.179 + by vector
11.180 +
11.181 +lemma vector_mult_component [simp]:
11.182 + fixes x y :: "'a::{times} ^ 'n"
11.183 + shows "(x * y)$i = x$i * y$i"
11.184 + by vector
11.185 +
11.186 +lemma vector_smult_component [simp]:
11.187 + fixes y :: "'a::{times} ^ 'n"
11.188 + shows "(c *s y)$i = c * (y$i)"
11.189 + by vector
11.190 +
11.191 +lemma vector_uminus_component [simp]:
11.192 + fixes x :: "'a::{uminus} ^ 'n"
11.193 + shows "(- x)$i = - (x$i)"
11.194 + by vector
11.195 +
11.196 +lemma vector_scaleR_component [simp]:
11.197 + fixes x :: "'a::scaleR ^ 'n"
11.198 + shows "(scaleR r x)$i = scaleR r (x$i)"
11.199 + by vector
11.200 +
11.201 +lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
11.202 +
11.203 +lemmas vector_component =
11.204 + vec_component vector_add_component vector_mult_component
11.205 + vector_smult_component vector_minus_component vector_uminus_component
11.206 + vector_scaleR_component cond_component
11.207 +
11.208 +subsection {* Some frequently useful arithmetic lemmas over vectors. *}
11.209 +
11.210 +instance "^" :: (semigroup_add,type) semigroup_add
11.211 + apply (intro_classes) by (vector add_assoc)
11.212 +
11.213 +
11.214 +instance "^" :: (monoid_add,type) monoid_add
11.215 + apply (intro_classes) by vector+
11.216 +
11.217 +instance "^" :: (group_add,type) group_add
11.218 + apply (intro_classes) by (vector algebra_simps)+
11.219 +
11.220 +instance "^" :: (ab_semigroup_add,type) ab_semigroup_add
11.221 + apply (intro_classes) by (vector add_commute)
11.222 +
11.223 +instance "^" :: (comm_monoid_add,type) comm_monoid_add
11.224 + apply (intro_classes) by vector
11.225 +
11.226 +instance "^" :: (ab_group_add,type) ab_group_add
11.227 + apply (intro_classes) by vector+
11.228 +
11.229 +instance "^" :: (cancel_semigroup_add,type) cancel_semigroup_add
11.230 + apply (intro_classes)
11.231 + by (vector Cart_eq)+
11.232 +
11.233 +instance "^" :: (cancel_ab_semigroup_add,type) cancel_ab_semigroup_add
11.234 + apply (intro_classes)
11.235 + by (vector Cart_eq)
11.236 +
11.237 +instance "^" :: (real_vector, type) real_vector
11.238 + by default (vector scaleR_left_distrib scaleR_right_distrib)+
11.239 +
11.240 +instance "^" :: (semigroup_mult,type) semigroup_mult
11.241 + apply (intro_classes) by (vector mult_assoc)
11.242 +
11.243 +instance "^" :: (monoid_mult,type) monoid_mult
11.244 + apply (intro_classes) by vector+
11.245 +
11.246 +instance "^" :: (ab_semigroup_mult,type) ab_semigroup_mult
11.247 + apply (intro_classes) by (vector mult_commute)
11.248 +
11.249 +instance "^" :: (ab_semigroup_idem_mult,type) ab_semigroup_idem_mult
11.250 + apply (intro_classes) by (vector mult_idem)
11.251 +
11.252 +instance "^" :: (comm_monoid_mult,type) comm_monoid_mult
11.253 + apply (intro_classes) by vector
11.254 +
11.255 +fun vector_power :: "('a::{one,times} ^'n) \<Rightarrow> nat \<Rightarrow> 'a^'n" where
11.256 + "vector_power x 0 = 1"
11.257 + | "vector_power x (Suc n) = x * vector_power x n"
11.258 +
11.259 +instance "^" :: (semiring,type) semiring
11.260 + apply (intro_classes) by (vector ring_simps)+
11.261 +
11.262 +instance "^" :: (semiring_0,type) semiring_0
11.263 + apply (intro_classes) by (vector ring_simps)+
11.264 +instance "^" :: (semiring_1,type) semiring_1
11.265 + apply (intro_classes) by vector
11.266 +instance "^" :: (comm_semiring,type) comm_semiring
11.267 + apply (intro_classes) by (vector ring_simps)+
11.268 +
11.269 +instance "^" :: (comm_semiring_0,type) comm_semiring_0 by (intro_classes)
11.270 +instance "^" :: (cancel_comm_monoid_add, type) cancel_comm_monoid_add ..
11.271 +instance "^" :: (semiring_0_cancel,type) semiring_0_cancel by (intro_classes)
11.272 +instance "^" :: (comm_semiring_0_cancel,type) comm_semiring_0_cancel by (intro_classes)
11.273 +instance "^" :: (ring,type) ring by (intro_classes)
11.274 +instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes)
11.275 +instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
11.276 +
11.277 +instance "^" :: (ring_1,type) ring_1 ..
11.278 +
11.279 +instance "^" :: (real_algebra,type) real_algebra
11.280 + apply intro_classes
11.281 + apply (simp_all add: vector_scaleR_def ring_simps)
11.282 + apply vector
11.283 + apply vector
11.284 + done
11.285 +
11.286 +instance "^" :: (real_algebra_1,type) real_algebra_1 ..
11.287 +
11.288 +lemma of_nat_index:
11.289 + "(of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
11.290 + apply (induct n)
11.291 + apply vector
11.292 + apply vector
11.293 + done
11.294 +lemma zero_index[simp]:
11.295 + "(0 :: 'a::zero ^'n)$i = 0" by vector
11.296 +
11.297 +lemma one_index[simp]:
11.298 + "(1 :: 'a::one ^'n)$i = 1" by vector
11.299 +
11.300 +lemma one_plus_of_nat_neq_0: "(1::'a::semiring_char_0) + of_nat n \<noteq> 0"
11.301 +proof-
11.302 + have "(1::'a) + of_nat n = 0 \<longleftrightarrow> of_nat 1 + of_nat n = (of_nat 0 :: 'a)" by simp
11.303 + also have "\<dots> \<longleftrightarrow> 1 + n = 0" by (simp only: of_nat_add[symmetric] of_nat_eq_iff)
11.304 + finally show ?thesis by simp
11.305 +qed
11.306 +
11.307 +instance "^" :: (semiring_char_0,type) semiring_char_0
11.308 +proof (intro_classes)
11.309 + fix m n ::nat
11.310 + show "(of_nat m :: 'a^'b) = of_nat n \<longleftrightarrow> m = n"
11.311 + by (simp add: Cart_eq of_nat_index)
11.312 +qed
11.313 +
11.314 +instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
11.315 +instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
11.316 +
11.317 +lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"
11.318 + by (vector mult_assoc)
11.319 +lemma vector_sadd_rdistrib: "((a::'a::semiring) + b) *s x = a *s x + b *s x"
11.320 + by (vector ring_simps)
11.321 +lemma vector_add_ldistrib: "(c::'a::semiring) *s (x + y) = c *s x + c *s y"
11.322 + by (vector ring_simps)
11.323 +lemma vector_smult_lzero[simp]: "(0::'a::mult_zero) *s x = 0" by vector
11.324 +lemma vector_smult_lid[simp]: "(1::'a::monoid_mult) *s x = x" by vector
11.325 +lemma vector_ssub_ldistrib: "(c::'a::ring) *s (x - y) = c *s x - c *s y"
11.326 + by (vector ring_simps)
11.327 +lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
11.328 +lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
11.329 +lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
11.330 +lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
11.331 +lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
11.332 + by (vector ring_simps)
11.333 +
11.334 +lemma vec_eq[simp]: "(vec m = vec n) \<longleftrightarrow> (m = n)"
11.335 + by (simp add: Cart_eq)
11.336 +
11.337 +subsection {* Topological space *}
11.338 +
11.339 +instantiation "^" :: (topological_space, finite) topological_space
11.340 +begin
11.341 +
11.342 +definition open_vector_def:
11.343 + "open (S :: ('a ^ 'b) set) \<longleftrightarrow>
11.344 + (\<forall>x\<in>S. \<exists>A. (\<forall>i. open (A i) \<and> x$i \<in> A i) \<and>
11.345 + (\<forall>y. (\<forall>i. y$i \<in> A i) \<longrightarrow> y \<in> S))"
11.346 +
11.347 +instance proof
11.348 + show "open (UNIV :: ('a ^ 'b) set)"
11.349 + unfolding open_vector_def by auto
11.350 +next
11.351 + fix S T :: "('a ^ 'b) set"
11.352 + assume "open S" "open T" thus "open (S \<inter> T)"
11.353 + unfolding open_vector_def
11.354 + apply clarify
11.355 + apply (drule (1) bspec)+
11.356 + apply (clarify, rename_tac Sa Ta)
11.357 + apply (rule_tac x="\<lambda>i. Sa i \<inter> Ta i" in exI)
11.358 + apply (simp add: open_Int)
11.359 + done
11.360 +next
11.361 + fix K :: "('a ^ 'b) set set"
11.362 + assume "\<forall>S\<in>K. open S" thus "open (\<Union>K)"
11.363 + unfolding open_vector_def
11.364 + apply clarify
11.365 + apply (drule (1) bspec)
11.366 + apply (drule (1) bspec)
11.367 + apply clarify
11.368 + apply (rule_tac x=A in exI)
11.369 + apply fast
11.370 + done
11.371 +qed
11.372 +
11.373 +end
11.374 +
11.375 +lemma open_vector_box: "\<forall>i. open (S i) \<Longrightarrow> open {x. \<forall>i. x $ i \<in> S i}"
11.376 +unfolding open_vector_def by auto
11.377 +
11.378 +lemma open_vimage_Cart_nth: "open S \<Longrightarrow> open ((\<lambda>x. x $ i) -` S)"
11.379 +unfolding open_vector_def
11.380 +apply clarify
11.381 +apply (rule_tac x="\<lambda>k. if k = i then S else UNIV" in exI, simp)
11.382 +done
11.383 +
11.384 +lemma closed_vimage_Cart_nth: "closed S \<Longrightarrow> closed ((\<lambda>x. x $ i) -` S)"
11.385 +unfolding closed_open vimage_Compl [symmetric]
11.386 +by (rule open_vimage_Cart_nth)
11.387 +
11.388 +lemma closed_vector_box: "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
11.389 +proof -
11.390 + have "{x. \<forall>i. x $ i \<in> S i} = (\<Inter>i. (\<lambda>x. x $ i) -` S i)" by auto
11.391 + thus "\<forall>i. closed (S i) \<Longrightarrow> closed {x. \<forall>i. x $ i \<in> S i}"
11.392 + by (simp add: closed_INT closed_vimage_Cart_nth)
11.393 +qed
11.394 +
11.395 +lemma tendsto_Cart_nth [tendsto_intros]:
11.396 + assumes "((\<lambda>x. f x) ---> a) net"
11.397 + shows "((\<lambda>x. f x $ i) ---> a $ i) net"
11.398 +proof (rule topological_tendstoI)
11.399 + fix S assume "open S" "a $ i \<in> S"
11.400 + then have "open ((\<lambda>y. y $ i) -` S)" "a \<in> ((\<lambda>y. y $ i) -` S)"
11.401 + by (simp_all add: open_vimage_Cart_nth)
11.402 + with assms have "eventually (\<lambda>x. f x \<in> (\<lambda>y. y $ i) -` S) net"
11.403 + by (rule topological_tendstoD)
11.404 + then show "eventually (\<lambda>x. f x $ i \<in> S) net"
11.405 + by simp
11.406 +qed
11.407 +
11.408 +subsection {* Square root of sum of squares *}
11.409 +
11.410 +definition
11.411 + "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
11.412 +
11.413 +lemma setL2_cong:
11.414 + "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
11.415 + unfolding setL2_def by simp
11.416 +
11.417 +lemma strong_setL2_cong:
11.418 + "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
11.419 + unfolding setL2_def simp_implies_def by simp
11.420 +
11.421 +lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
11.422 + unfolding setL2_def by simp
11.423 +
11.424 +lemma setL2_empty [simp]: "setL2 f {} = 0"
11.425 + unfolding setL2_def by simp
11.426 +
11.427 +lemma setL2_insert [simp]:
11.428 + "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
11.429 + setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
11.430 + unfolding setL2_def by (simp add: setsum_nonneg)
11.431 +
11.432 +lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
11.433 + unfolding setL2_def by (simp add: setsum_nonneg)
11.434 +
11.435 +lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
11.436 + unfolding setL2_def by simp
11.437 +
11.438 +lemma setL2_constant: "setL2 (\<lambda>x. y) A = sqrt (of_nat (card A)) * \<bar>y\<bar>"
11.439 + unfolding setL2_def by (simp add: real_sqrt_mult)
11.440 +
11.441 +lemma setL2_mono:
11.442 + assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
11.443 + assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
11.444 + shows "setL2 f K \<le> setL2 g K"
11.445 + unfolding setL2_def
11.446 + by (simp add: setsum_nonneg setsum_mono power_mono prems)
11.447 +
11.448 +lemma setL2_strict_mono:
11.449 + assumes "finite K" and "K \<noteq> {}"
11.450 + assumes "\<And>i. i \<in> K \<Longrightarrow> f i < g i"
11.451 + assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
11.452 + shows "setL2 f K < setL2 g K"
11.453 + unfolding setL2_def
11.454 + by (simp add: setsum_strict_mono power_strict_mono assms)
11.455 +
11.456 +lemma setL2_right_distrib:
11.457 + "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
11.458 + unfolding setL2_def
11.459 + apply (simp add: power_mult_distrib)
11.460 + apply (simp add: setsum_right_distrib [symmetric])
11.461 + apply (simp add: real_sqrt_mult setsum_nonneg)
11.462 + done
11.463 +
11.464 +lemma setL2_left_distrib:
11.465 + "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
11.466 + unfolding setL2_def
11.467 + apply (simp add: power_mult_distrib)
11.468 + apply (simp add: setsum_left_distrib [symmetric])
11.469 + apply (simp add: real_sqrt_mult setsum_nonneg)
11.470 + done
11.471 +
11.472 +lemma setsum_nonneg_eq_0_iff:
11.473 + fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
11.474 + shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
11.475 + apply (induct set: finite, simp)
11.476 + apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
11.477 + done
11.478 +
11.479 +lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
11.480 + unfolding setL2_def
11.481 + by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
11.482 +
11.483 +lemma setL2_triangle_ineq:
11.484 + shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
11.485 +proof (cases "finite A")
11.486 + case False
11.487 + thus ?thesis by simp
11.488 +next
11.489 + case True
11.490 + thus ?thesis
11.491 + proof (induct set: finite)
11.492 + case empty
11.493 + show ?case by simp
11.494 + next
11.495 + case (insert x F)
11.496 + hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
11.497 + sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
11.498 + by (intro real_sqrt_le_mono add_left_mono power_mono insert
11.499 + setL2_nonneg add_increasing zero_le_power2)
11.500 + also have
11.501 + "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
11.502 + by (rule real_sqrt_sum_squares_triangle_ineq)
11.503 + finally show ?case
11.504 + using insert by simp
11.505 + qed
11.506 +qed
11.507 +
11.508 +lemma sqrt_sum_squares_le_sum:
11.509 + "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
11.510 + apply (rule power2_le_imp_le)
11.511 + apply (simp add: power2_sum)
11.512 + apply (simp add: mult_nonneg_nonneg)
11.513 + apply (simp add: add_nonneg_nonneg)
11.514 + done
11.515 +
11.516 +lemma setL2_le_setsum [rule_format]:
11.517 + "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
11.518 + apply (cases "finite A")
11.519 + apply (induct set: finite)
11.520 + apply simp
11.521 + apply clarsimp
11.522 + apply (erule order_trans [OF sqrt_sum_squares_le_sum])
11.523 + apply simp
11.524 + apply simp
11.525 + apply simp
11.526 + done
11.527 +
11.528 +lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
11.529 + apply (rule power2_le_imp_le)
11.530 + apply (simp add: power2_sum)
11.531 + apply (simp add: mult_nonneg_nonneg)
11.532 + apply (simp add: add_nonneg_nonneg)
11.533 + done
11.534 +
11.535 +lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
11.536 + apply (cases "finite A")
11.537 + apply (induct set: finite)
11.538 + apply simp
11.539 + apply simp
11.540 + apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
11.541 + apply simp
11.542 + apply simp
11.543 + done
11.544 +
11.545 +lemma setL2_mult_ineq_lemma:
11.546 + fixes a b c d :: real
11.547 + shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
11.548 +proof -
11.549 + have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
11.550 + also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
11.551 + by (simp only: power2_diff power_mult_distrib)
11.552 + also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
11.553 + by simp
11.554 + finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
11.555 + by simp
11.556 +qed
11.557 +
11.558 +lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
11.559 + apply (cases "finite A")
11.560 + apply (induct set: finite)
11.561 + apply simp
11.562 + apply (rule power2_le_imp_le, simp)
11.563 + apply (rule order_trans)
11.564 + apply (rule power_mono)
11.565 + apply (erule add_left_mono)
11.566 + apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
11.567 + apply (simp add: power2_sum)
11.568 + apply (simp add: power_mult_distrib)
11.569 + apply (simp add: right_distrib left_distrib)
11.570 + apply (rule ord_le_eq_trans)
11.571 + apply (rule setL2_mult_ineq_lemma)
11.572 + apply simp
11.573 + apply (intro mult_nonneg_nonneg setL2_nonneg)
11.574 + apply simp
11.575 + done
11.576 +
11.577 +lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
11.578 + apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
11.579 + apply fast
11.580 + apply (subst setL2_insert)
11.581 + apply simp
11.582 + apply simp
11.583 + apply simp
11.584 + done
11.585 +
11.586 +subsection {* Metric *}
11.587 +
11.588 +(* TODO: move somewhere else *)
11.589 +lemma finite_choice: "finite A \<Longrightarrow> \<forall>x\<in>A. \<exists>y. P x y \<Longrightarrow> \<exists>f. \<forall>x\<in>A. P x (f x)"
11.590 +apply (induct set: finite, simp_all)
11.591 +apply (clarify, rename_tac y)
11.592 +apply (rule_tac x="f(x:=y)" in exI, simp)
11.593 +done
11.594 +
11.595 +instantiation "^" :: (metric_space, finite) metric_space
11.596 +begin
11.597 +
11.598 +definition dist_vector_def:
11.599 + "dist (x::'a^'b) (y::'a^'b) = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV"
11.600 +
11.601 +lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
11.602 +unfolding dist_vector_def
11.603 +by (rule member_le_setL2) simp_all
11.604 +
11.605 +instance proof
11.606 + fix x y :: "'a ^ 'b"
11.607 + show "dist x y = 0 \<longleftrightarrow> x = y"
11.608 + unfolding dist_vector_def
11.609 + by (simp add: setL2_eq_0_iff Cart_eq)
11.610 +next
11.611 + fix x y z :: "'a ^ 'b"
11.612 + show "dist x y \<le> dist x z + dist y z"
11.613 + unfolding dist_vector_def
11.614 + apply (rule order_trans [OF _ setL2_triangle_ineq])
11.615 + apply (simp add: setL2_mono dist_triangle2)
11.616 + done
11.617 +next
11.618 + (* FIXME: long proof! *)
11.619 + fix S :: "('a ^ 'b) set"
11.620 + show "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
11.621 + unfolding open_vector_def open_dist
11.622 + apply safe
11.623 + apply (drule (1) bspec)
11.624 + apply clarify
11.625 + apply (subgoal_tac "\<exists>e>0. \<forall>i y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
11.626 + apply clarify
11.627 + apply (rule_tac x=e in exI, clarify)
11.628 + apply (drule spec, erule mp, clarify)
11.629 + apply (drule spec, drule spec, erule mp)
11.630 + apply (erule le_less_trans [OF dist_nth_le])
11.631 + apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
11.632 + apply (drule finite_choice [OF finite], clarify)
11.633 + apply (rule_tac x="Min (range f)" in exI, simp)
11.634 + apply clarify
11.635 + apply (drule_tac x=i in spec, clarify)
11.636 + apply (erule (1) bspec)
11.637 + apply (drule (1) bspec, clarify)
11.638 + apply (subgoal_tac "\<exists>r. (\<forall>i::'b. 0 < r i) \<and> e = setL2 r UNIV")
11.639 + apply clarify
11.640 + apply (rule_tac x="\<lambda>i. {y. dist y (x$i) < r i}" in exI)
11.641 + apply (rule conjI)
11.642 + apply clarify
11.643 + apply (rule conjI)
11.644 + apply (clarify, rename_tac y)
11.645 + apply (rule_tac x="r i - dist y (x$i)" in exI, rule conjI, simp)
11.646 + apply clarify
11.647 + apply (simp only: less_diff_eq)
11.648 + apply (erule le_less_trans [OF dist_triangle])
11.649 + apply simp
11.650 + apply clarify
11.651 + apply (drule spec, erule mp)
11.652 + apply (simp add: dist_vector_def setL2_strict_mono)
11.653 + apply (rule_tac x="\<lambda>i. e / sqrt (of_nat CARD('b))" in exI)
11.654 + apply (simp add: divide_pos_pos setL2_constant)
11.655 + done
11.656 +qed
11.657 +
11.658 +end
11.659 +
11.660 +lemma LIMSEQ_Cart_nth:
11.661 + "(X ----> a) \<Longrightarrow> (\<lambda>n. X n $ i) ----> a $ i"
11.662 +unfolding LIMSEQ_conv_tendsto by (rule tendsto_Cart_nth)
11.663 +
11.664 +lemma LIM_Cart_nth:
11.665 + "(f -- x --> y) \<Longrightarrow> (\<lambda>x. f x $ i) -- x --> y $ i"
11.666 +unfolding LIM_conv_tendsto by (rule tendsto_Cart_nth)
11.667 +
11.668 +lemma Cauchy_Cart_nth:
11.669 + "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
11.670 +unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le])
11.671 +
11.672 +lemma LIMSEQ_vector:
11.673 + fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
11.674 + assumes X: "\<And>i. (\<lambda>n. X n $ i) ----> (a $ i)"
11.675 + shows "X ----> a"
11.676 +proof (rule metric_LIMSEQ_I)
11.677 + fix r :: real assume "0 < r"
11.678 + then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
11.679 + by (simp add: divide_pos_pos)
11.680 + def N \<equiv> "\<lambda>i. LEAST N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
11.681 + def M \<equiv> "Max (range N)"
11.682 + have "\<And>i. \<exists>N. \<forall>n\<ge>N. dist (X n $ i) (a $ i) < ?s"
11.683 + using X `0 < ?s` by (rule metric_LIMSEQ_D)
11.684 + hence "\<And>i. \<forall>n\<ge>N i. dist (X n $ i) (a $ i) < ?s"
11.685 + unfolding N_def by (rule LeastI_ex)
11.686 + hence M: "\<And>i. \<forall>n\<ge>M. dist (X n $ i) (a $ i) < ?s"
11.687 + unfolding M_def by simp
11.688 + {
11.689 + fix n :: nat assume "M \<le> n"
11.690 + have "dist (X n) a = setL2 (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
11.691 + unfolding dist_vector_def ..
11.692 + also have "\<dots> \<le> setsum (\<lambda>i. dist (X n $ i) (a $ i)) UNIV"
11.693 + by (rule setL2_le_setsum [OF zero_le_dist])
11.694 + also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
11.695 + by (rule setsum_strict_mono, simp_all add: M `M \<le> n`)
11.696 + also have "\<dots> = r"
11.697 + by simp
11.698 + finally have "dist (X n) a < r" .
11.699 + }
11.700 + hence "\<forall>n\<ge>M. dist (X n) a < r"
11.701 + by simp
11.702 + then show "\<exists>M. \<forall>n\<ge>M. dist (X n) a < r" ..
11.703 +qed
11.704 +
11.705 +lemma Cauchy_vector:
11.706 + fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n::finite"
11.707 + assumes X: "\<And>i. Cauchy (\<lambda>n. X n $ i)"
11.708 + shows "Cauchy (\<lambda>n. X n)"
11.709 +proof (rule metric_CauchyI)
11.710 + fix r :: real assume "0 < r"
11.711 + then have "0 < r / of_nat CARD('n)" (is "0 < ?s")
11.712 + by (simp add: divide_pos_pos)
11.713 + def N \<equiv> "\<lambda>i. LEAST N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
11.714 + def M \<equiv> "Max (range N)"
11.715 + have "\<And>i. \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m $ i) (X n $ i) < ?s"
11.716 + using X `0 < ?s` by (rule metric_CauchyD)
11.717 + hence "\<And>i. \<forall>m\<ge>N i. \<forall>n\<ge>N i. dist (X m $ i) (X n $ i) < ?s"
11.718 + unfolding N_def by (rule LeastI_ex)
11.719 + hence M: "\<And>i. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m $ i) (X n $ i) < ?s"
11.720 + unfolding M_def by simp
11.721 + {
11.722 + fix m n :: nat
11.723 + assume "M \<le> m" "M \<le> n"
11.724 + have "dist (X m) (X n) = setL2 (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
11.725 + unfolding dist_vector_def ..
11.726 + also have "\<dots> \<le> setsum (\<lambda>i. dist (X m $ i) (X n $ i)) UNIV"
11.727 + by (rule setL2_le_setsum [OF zero_le_dist])
11.728 + also have "\<dots> < setsum (\<lambda>i::'n. ?s) UNIV"
11.729 + by (rule setsum_strict_mono, simp_all add: M `M \<le> m` `M \<le> n`)
11.730 + also have "\<dots> = r"
11.731 + by simp
11.732 + finally have "dist (X m) (X n) < r" .
11.733 + }
11.734 + hence "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r"
11.735 + by simp
11.736 + then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < r" ..
11.737 +qed
11.738 +
11.739 +instance "^" :: (complete_space, finite) complete_space
11.740 +proof
11.741 + fix X :: "nat \<Rightarrow> 'a ^ 'b" assume "Cauchy X"
11.742 + have "\<And>i. (\<lambda>n. X n $ i) ----> lim (\<lambda>n. X n $ i)"
11.743 + using Cauchy_Cart_nth [OF `Cauchy X`]
11.744 + by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
11.745 + hence "X ----> Cart_lambda (\<lambda>i. lim (\<lambda>n. X n $ i))"
11.746 + by (simp add: LIMSEQ_vector)
11.747 + then show "convergent X"
11.748 + by (rule convergentI)
11.749 +qed
11.750 +
11.751 +subsection {* Norms *}
11.752 +
11.753 +instantiation "^" :: (real_normed_vector, finite) real_normed_vector
11.754 +begin
11.755 +
11.756 +definition norm_vector_def:
11.757 + "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) UNIV"
11.758 +
11.759 +definition vector_sgn_def:
11.760 + "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
11.761 +
11.762 +instance proof
11.763 + fix a :: real and x y :: "'a ^ 'b"
11.764 + show "0 \<le> norm x"
11.765 + unfolding norm_vector_def
11.766 + by (rule setL2_nonneg)
11.767 + show "norm x = 0 \<longleftrightarrow> x = 0"
11.768 + unfolding norm_vector_def
11.769 + by (simp add: setL2_eq_0_iff Cart_eq)
11.770 + show "norm (x + y) \<le> norm x + norm y"
11.771 + unfolding norm_vector_def
11.772 + apply (rule order_trans [OF _ setL2_triangle_ineq])
11.773 + apply (simp add: setL2_mono norm_triangle_ineq)
11.774 + done
11.775 + show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
11.776 + unfolding norm_vector_def
11.777 + by (simp add: setL2_right_distrib)
11.778 + show "sgn x = scaleR (inverse (norm x)) x"
11.779 + by (rule vector_sgn_def)
11.780 + show "dist x y = norm (x - y)"
11.781 + unfolding dist_vector_def norm_vector_def
11.782 + by (simp add: dist_norm)
11.783 +qed
11.784 +
11.785 +end
11.786 +
11.787 +lemma norm_nth_le: "norm (x $ i) \<le> norm x"
11.788 +unfolding norm_vector_def
11.789 +by (rule member_le_setL2) simp_all
11.790 +
11.791 +interpretation Cart_nth: bounded_linear "\<lambda>x. x $ i"
11.792 +apply default
11.793 +apply (rule vector_add_component)
11.794 +apply (rule vector_scaleR_component)
11.795 +apply (rule_tac x="1" in exI, simp add: norm_nth_le)
11.796 +done
11.797 +
11.798 +instance "^" :: (banach, finite) banach ..
11.799 +
11.800 +subsection {* Inner products *}
11.801 +
11.802 +instantiation "^" :: (real_inner, finite) real_inner
11.803 +begin
11.804 +
11.805 +definition inner_vector_def:
11.806 + "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) UNIV"
11.807 +
11.808 +instance proof
11.809 + fix r :: real and x y z :: "'a ^ 'b"
11.810 + show "inner x y = inner y x"
11.811 + unfolding inner_vector_def
11.812 + by (simp add: inner_commute)
11.813 + show "inner (x + y) z = inner x z + inner y z"
11.814 + unfolding inner_vector_def
11.815 + by (simp add: inner_add_left setsum_addf)
11.816 + show "inner (scaleR r x) y = r * inner x y"
11.817 + unfolding inner_vector_def
11.818 + by (simp add: setsum_right_distrib)
11.819 + show "0 \<le> inner x x"
11.820 + unfolding inner_vector_def
11.821 + by (simp add: setsum_nonneg)
11.822 + show "inner x x = 0 \<longleftrightarrow> x = 0"
11.823 + unfolding inner_vector_def
11.824 + by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
11.825 + show "norm x = sqrt (inner x x)"
11.826 + unfolding inner_vector_def norm_vector_def setL2_def
11.827 + by (simp add: power2_norm_eq_inner)
11.828 +qed
11.829 +
11.830 +end
11.831 +
11.832 +subsection{* Properties of the dot product. *}
11.833 +
11.834 +lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x"
11.835 + by (vector mult_commute)
11.836 +lemma dot_ladd: "((x::'a::ring ^ 'n) + y) \<bullet> z = (x \<bullet> z) + (y \<bullet> z)"
11.837 + by (vector ring_simps)
11.838 +lemma dot_radd: "x \<bullet> (y + (z::'a::ring ^ 'n)) = (x \<bullet> y) + (x \<bullet> z)"
11.839 + by (vector ring_simps)
11.840 +lemma dot_lsub: "((x::'a::ring ^ 'n) - y) \<bullet> z = (x \<bullet> z) - (y \<bullet> z)"
11.841 + by (vector ring_simps)
11.842 +lemma dot_rsub: "(x::'a::ring ^ 'n) \<bullet> (y - z) = (x \<bullet> y) - (x \<bullet> z)"
11.843 + by (vector ring_simps)
11.844 +lemma dot_lmult: "(c *s x) \<bullet> y = (c::'a::ring) * (x \<bullet> y)" by (vector ring_simps)
11.845 +lemma dot_rmult: "x \<bullet> (c *s y) = (c::'a::comm_ring) * (x \<bullet> y)" by (vector ring_simps)
11.846 +lemma dot_lneg: "(-x) \<bullet> (y::'a::ring ^ 'n) = -(x \<bullet> y)" by vector
11.847 +lemma dot_rneg: "(x::'a::ring ^ 'n) \<bullet> (-y) = -(x \<bullet> y)" by vector
11.848 +lemma dot_lzero[simp]: "0 \<bullet> x = (0::'a::{comm_monoid_add, mult_zero})" by vector
11.849 +lemma dot_rzero[simp]: "x \<bullet> 0 = (0::'a::{comm_monoid_add, mult_zero})" by vector
11.850 +lemma dot_pos_le[simp]: "(0::'a\<Colon>ordered_ring_strict) <= x \<bullet> x"
11.851 + by (simp add: dot_def setsum_nonneg)
11.852 +
11.853 +lemma setsum_squares_eq_0_iff: assumes fS: "finite F" and fp: "\<forall>x \<in> F. f x \<ge> (0 ::'a::pordered_ab_group_add)" shows "setsum f F = 0 \<longleftrightarrow> (ALL x:F. f x = 0)"
11.854 +using fS fp setsum_nonneg[OF fp]
11.855 +proof (induct set: finite)
11.856 + case empty thus ?case by simp
11.857 +next
11.858 + case (insert x F)
11.859 + from insert.prems have Fx: "f x \<ge> 0" and Fp: "\<forall> a \<in> F. f a \<ge> 0" by simp_all
11.860 + from insert.hyps Fp setsum_nonneg[OF Fp]
11.861 + have h: "setsum f F = 0 \<longleftrightarrow> (\<forall>a \<in>F. f a = 0)" by metis
11.862 + from add_nonneg_eq_0_iff[OF Fx setsum_nonneg[OF Fp]] insert.hyps(1,2)
11.863 + show ?case by (simp add: h)
11.864 +qed
11.865 +
11.866 +lemma dot_eq_0: "x \<bullet> x = 0 \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) = 0"
11.867 + by (simp add: dot_def setsum_squares_eq_0_iff Cart_eq)
11.868 +
11.869 +lemma dot_pos_lt[simp]: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n::finite) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x]
11.870 + by (auto simp add: le_less)
11.871 +
11.872 +subsection{* The collapse of the general concepts to dimension one. *}
11.873 +
11.874 +lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
11.875 + by (simp add: Cart_eq forall_1)
11.876 +
11.877 +lemma forall_one: "(\<forall>(x::'a ^1). P x) \<longleftrightarrow> (\<forall>x. P(\<chi> i. x))"
11.878 + apply auto
11.879 + apply (erule_tac x= "x$1" in allE)
11.880 + apply (simp only: vector_one[symmetric])
11.881 + done
11.882 +
11.883 +lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
11.884 + by (simp add: norm_vector_def UNIV_1)
11.885 +
11.886 +lemma norm_real: "norm(x::real ^ 1) = abs(x$1)"
11.887 + by (simp add: norm_vector_1)
11.888 +
11.889 +lemma dist_real: "dist(x::real ^ 1) y = abs((x$1) - (y$1))"
11.890 + by (auto simp add: norm_real dist_norm)
11.891 +
11.892 +subsection {* A connectedness or intermediate value lemma with several applications. *}
11.893 +
11.894 +lemma connected_real_lemma:
11.895 + fixes f :: "real \<Rightarrow> 'a::metric_space"
11.896 + assumes ab: "a \<le> b" and fa: "f a \<in> e1" and fb: "f b \<in> e2"
11.897 + and dst: "\<And>e x. a <= x \<Longrightarrow> x <= b \<Longrightarrow> 0 < e ==> \<exists>d > 0. \<forall>y. abs(y - x) < d \<longrightarrow> dist(f y) (f x) < e"
11.898 + and e1: "\<forall>y \<in> e1. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e1"
11.899 + and e2: "\<forall>y \<in> e2. \<exists>e > 0. \<forall>y'. dist y' y < e \<longrightarrow> y' \<in> e2"
11.900 + and e12: "~(\<exists>x \<ge> a. x <= b \<and> f x \<in> e1 \<and> f x \<in> e2)"
11.901 + shows "\<exists>x \<ge> a. x <= b \<and> f x \<notin> e1 \<and> f x \<notin> e2" (is "\<exists> x. ?P x")
11.902 +proof-
11.903 + let ?S = "{c. \<forall>x \<ge> a. x <= c \<longrightarrow> f x \<in> e1}"
11.904 + have Se: " \<exists>x. x \<in> ?S" apply (rule exI[where x=a]) by (auto simp add: fa)
11.905 + have Sub: "\<exists>y. isUb UNIV ?S y"
11.906 + apply (rule exI[where x= b])
11.907 + using ab fb e12 by (auto simp add: isUb_def setle_def)
11.908 + from reals_complete[OF Se Sub] obtain l where
11.909 + l: "isLub UNIV ?S l"by blast
11.910 + have alb: "a \<le> l" "l \<le> b" using l ab fa fb e12
11.911 + apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
11.912 + by (metis linorder_linear)
11.913 + have ale1: "\<forall>z \<ge> a. z < l \<longrightarrow> f z \<in> e1" using l
11.914 + apply (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
11.915 + by (metis linorder_linear not_le)
11.916 + have th1: "\<And>z x e d :: real. z <= x + e \<Longrightarrow> e < d ==> z < x \<or> abs(z - x) < d" by arith
11.917 + have th2: "\<And>e x:: real. 0 < e ==> ~(x + e <= x)" by arith
11.918 + have th3: "\<And>d::real. d > 0 \<Longrightarrow> \<exists>e > 0. e < d" by dlo
11.919 + {assume le2: "f l \<in> e2"
11.920 + from le2 fa fb e12 alb have la: "l \<noteq> a" by metis
11.921 + hence lap: "l - a > 0" using alb by arith
11.922 + from e2[rule_format, OF le2] obtain e where
11.923 + e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e2" by metis
11.924 + from dst[OF alb e(1)] obtain d where
11.925 + d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
11.926 + have "\<exists>d'. d' < d \<and> d' >0 \<and> l - d' > a" using lap d(1)
11.927 + apply ferrack by arith
11.928 + then obtain d' where d': "d' > 0" "d' < d" "l - d' > a" by metis
11.929 + from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e2" by metis
11.930 + from th0[rule_format, of "l - d'"] d' have "f (l - d') \<in> e2" by auto
11.931 + moreover
11.932 + have "f (l - d') \<in> e1" using ale1[rule_format, of "l -d'"] d' by auto
11.933 + ultimately have False using e12 alb d' by auto}
11.934 + moreover
11.935 + {assume le1: "f l \<in> e1"
11.936 + from le1 fa fb e12 alb have lb: "l \<noteq> b" by metis
11.937 + hence blp: "b - l > 0" using alb by arith
11.938 + from e1[rule_format, OF le1] obtain e where
11.939 + e: "e > 0" "\<forall>y. dist y (f l) < e \<longrightarrow> y \<in> e1" by metis
11.940 + from dst[OF alb e(1)] obtain d where
11.941 + d: "d > 0" "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> dist (f y) (f l) < e" by metis
11.942 + have "\<exists>d'. d' < d \<and> d' >0" using d(1) by dlo
11.943 + then obtain d' where d': "d' > 0" "d' < d" by metis
11.944 + from d e have th0: "\<forall>y. \<bar>y - l\<bar> < d \<longrightarrow> f y \<in> e1" by auto
11.945 + hence "\<forall>y. l \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" using d' by auto
11.946 + with ale1 have "\<forall>y. a \<le> y \<and> y \<le> l + d' \<longrightarrow> f y \<in> e1" by auto
11.947 + with l d' have False
11.948 + by (auto simp add: isLub_def isUb_def setle_def setge_def leastP_def) }
11.949 + ultimately show ?thesis using alb by metis
11.950 +qed
11.951 +
11.952 +text{* One immediately useful corollary is the existence of square roots! --- Should help to get rid of all the development of square-root for reals as a special case @{typ "real^1"} *}
11.953 +
11.954 +lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)"
11.955 +proof-
11.956 + have "(x + 1/2)^2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith
11.957 + thus ?thesis by (simp add: ring_simps power2_eq_square)
11.958 +qed
11.959 +
11.960 +lemma square_continuous: "0 < (e::real) ==> \<exists>d. 0 < d \<and> (\<forall>y. abs(y - x) < d \<longrightarrow> abs(y * y - x * x) < e)"
11.961 + using isCont_power[OF isCont_ident, of 2, unfolded isCont_def LIM_eq, rule_format, of e x] apply (auto simp add: power2_eq_square)
11.962 + apply (rule_tac x="s" in exI)
11.963 + apply auto
11.964 + apply (erule_tac x=y in allE)
11.965 + apply auto
11.966 + done
11.967 +
11.968 +lemma real_le_lsqrt: "0 <= x \<Longrightarrow> 0 <= y \<Longrightarrow> x <= y^2 ==> sqrt x <= y"
11.969 + using real_sqrt_le_iff[of x "y^2"] by simp
11.970 +
11.971 +lemma real_le_rsqrt: "x^2 \<le> y \<Longrightarrow> x \<le> sqrt y"
11.972 + using real_sqrt_le_mono[of "x^2" y] by simp
11.973 +
11.974 +lemma real_less_rsqrt: "x^2 < y \<Longrightarrow> x < sqrt y"
11.975 + using real_sqrt_less_mono[of "x^2" y] by simp
11.976 +
11.977 +lemma sqrt_even_pow2: assumes n: "even n"
11.978 + shows "sqrt(2 ^ n) = 2 ^ (n div 2)"
11.979 +proof-
11.980 + from n obtain m where m: "n = 2*m" unfolding even_nat_equiv_def2
11.981 + by (auto simp add: nat_number)
11.982 + from m have "sqrt(2 ^ n) = sqrt ((2 ^ m) ^ 2)"
11.983 + by (simp only: power_mult[symmetric] mult_commute)
11.984 + then show ?thesis using m by simp
11.985 +qed
11.986 +
11.987 +lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)"
11.988 + apply (cases "x = 0", simp_all)
11.989 + using sqrt_divide_self_eq[of x]
11.990 + apply (simp add: inverse_eq_divide real_sqrt_ge_0_iff field_simps)
11.991 + done
11.992 +
11.993 +text{* Hence derive more interesting properties of the norm. *}
11.994 +
11.995 +text {*
11.996 + This type-specific version is only here
11.997 + to make @{text normarith.ML} happy.
11.998 +*}
11.999 +lemma norm_0: "norm (0::real ^ _) = 0"
11.1000 + by (rule norm_zero)
11.1001 +
11.1002 +lemma norm_mul[simp]: "norm(a *s x) = abs(a) * norm x"
11.1003 + by (simp add: norm_vector_def vector_component setL2_right_distrib
11.1004 + abs_mult cong: strong_setL2_cong)
11.1005 +lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
11.1006 + by (simp add: norm_vector_def dot_def setL2_def power2_eq_square)
11.1007 +lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
11.1008 + by (simp add: norm_vector_def setL2_def dot_def power2_eq_square)
11.1009 +lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
11.1010 + by (simp add: real_vector_norm_def)
11.1011 +lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n::finite)" by (metis norm_eq_zero)
11.1012 +lemma vector_mul_eq_0[simp]: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
11.1013 + by vector
11.1014 +lemma vector_mul_lcancel[simp]: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
11.1015 + by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_ssub_ldistrib)
11.1016 +lemma vector_mul_rcancel[simp]: "a *s x = b *s x \<longleftrightarrow> (a::real) = b \<or> x = 0"
11.1017 + by (metis eq_iff_diff_eq_0 vector_mul_eq_0 vector_sub_rdistrib)
11.1018 +lemma vector_mul_lcancel_imp: "a \<noteq> (0::real) ==> a *s x = a *s y ==> (x = y)"
11.1019 + by (metis vector_mul_lcancel)
11.1020 +lemma vector_mul_rcancel_imp: "x \<noteq> 0 \<Longrightarrow> (a::real) *s x = b *s x ==> a = b"
11.1021 + by (metis vector_mul_rcancel)
11.1022 +lemma norm_cauchy_schwarz:
11.1023 + fixes x y :: "real ^ 'n::finite"
11.1024 + shows "x \<bullet> y <= norm x * norm y"
11.1025 +proof-
11.1026 + {assume "norm x = 0"
11.1027 + hence ?thesis by (simp add: dot_lzero dot_rzero)}
11.1028 + moreover
11.1029 + {assume "norm y = 0"
11.1030 + hence ?thesis by (simp add: dot_lzero dot_rzero)}
11.1031 + moreover
11.1032 + {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
11.1033 + let ?z = "norm y *s x - norm x *s y"
11.1034 + from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
11.1035 + from dot_pos_le[of ?z]
11.1036 + have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
11.1037 + apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
11.1038 + by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym)
11.1039 + hence "x\<bullet>y \<le> (norm x ^2 * norm y ^2) / (norm x * norm y)" using p
11.1040 + by (simp add: field_simps)
11.1041 + hence ?thesis using h by (simp add: power2_eq_square)}
11.1042 + ultimately show ?thesis by metis
11.1043 +qed
11.1044 +
11.1045 +lemma norm_cauchy_schwarz_abs:
11.1046 + fixes x y :: "real ^ 'n::finite"
11.1047 + shows "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
11.1048 + using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
11.1049 + by (simp add: real_abs_def dot_rneg)
11.1050 +
11.1051 +lemma norm_triangle_sub:
11.1052 + fixes x y :: "'a::real_normed_vector"
11.1053 + shows "norm x \<le> norm y + norm (x - y)"
11.1054 + using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
11.1055 +
11.1056 +lemma norm_triangle_le: "norm(x::real ^'n::finite) + norm y <= e ==> norm(x + y) <= e"
11.1057 + by (metis order_trans norm_triangle_ineq)
11.1058 +lemma norm_triangle_lt: "norm(x::real ^'n::finite) + norm(y) < e ==> norm(x + y) < e"
11.1059 + by (metis basic_trans_rules(21) norm_triangle_ineq)
11.1060 +
11.1061 +lemma component_le_norm: "\<bar>x$i\<bar> <= norm (x::real ^ 'n::finite)"
11.1062 + apply (simp add: norm_vector_def)
11.1063 + apply (rule member_le_setL2, simp_all)
11.1064 + done
11.1065 +
11.1066 +lemma norm_bound_component_le: "norm(x::real ^ 'n::finite) <= e
11.1067 + ==> \<bar>x$i\<bar> <= e"
11.1068 + by (metis component_le_norm order_trans)
11.1069 +
11.1070 +lemma norm_bound_component_lt: "norm(x::real ^ 'n::finite) < e
11.1071 + ==> \<bar>x$i\<bar> < e"
11.1072 + by (metis component_le_norm basic_trans_rules(21))
11.1073 +
11.1074 +lemma norm_le_l1: "norm (x:: real ^'n::finite) <= setsum(\<lambda>i. \<bar>x$i\<bar>) UNIV"
11.1075 + by (simp add: norm_vector_def setL2_le_setsum)
11.1076 +
11.1077 +lemma real_abs_norm: "\<bar>norm x\<bar> = norm (x :: real ^ _)"
11.1078 + by (rule abs_norm_cancel)
11.1079 +lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n::finite) - norm y\<bar> <= norm(x - y)"
11.1080 + by (rule norm_triangle_ineq3)
11.1081 +lemma norm_le: "norm(x::real ^ _) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
11.1082 + by (simp add: real_vector_norm_def)
11.1083 +lemma norm_lt: "norm(x::real ^ _) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
11.1084 + by (simp add: real_vector_norm_def)
11.1085 +lemma norm_eq: "norm (x::real ^ _) = norm y \<longleftrightarrow> x \<bullet> x = y \<bullet> y"
11.1086 + by (simp add: order_eq_iff norm_le)
11.1087 +lemma norm_eq_1: "norm(x::real ^ _) = 1 \<longleftrightarrow> x \<bullet> x = 1"
11.1088 + by (simp add: real_vector_norm_def)
11.1089 +
11.1090 +text{* Squaring equations and inequalities involving norms. *}
11.1091 +
11.1092 +lemma dot_square_norm: "x \<bullet> x = norm(x)^2"
11.1093 + by (simp add: real_vector_norm_def)
11.1094 +
11.1095 +lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
11.1096 + by (auto simp add: real_vector_norm_def)
11.1097 +
11.1098 +lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
11.1099 +proof-
11.1100 + have "x^2 \<le> y^2 \<longleftrightarrow> (x -y) * (y + x) \<le> 0" by (simp add: ring_simps power2_eq_square)
11.1101 + also have "\<dots> \<longleftrightarrow> \<bar>x\<bar> \<le> \<bar>y\<bar>" apply (simp add: zero_compare_simps real_abs_def not_less) by arith
11.1102 +finally show ?thesis ..
11.1103 +qed
11.1104 +
11.1105 +lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
11.1106 + apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
11.1107 + using norm_ge_zero[of x]
11.1108 + apply arith
11.1109 + done
11.1110 +
11.1111 +lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2"
11.1112 + apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
11.1113 + using norm_ge_zero[of x]
11.1114 + apply arith
11.1115 + done
11.1116 +
11.1117 +lemma norm_lt_square: "norm(x) < a \<longleftrightarrow> 0 < a \<and> x \<bullet> x < a^2"
11.1118 + by (metis not_le norm_ge_square)
11.1119 +lemma norm_gt_square: "norm(x) > a \<longleftrightarrow> a < 0 \<or> x \<bullet> x > a^2"
11.1120 + by (metis norm_le_square not_less)
11.1121 +
11.1122 +text{* Dot product in terms of the norm rather than conversely. *}
11.1123 +
11.1124 +lemma dot_norm: "x \<bullet> y = (norm(x + y) ^2 - norm x ^ 2 - norm y ^ 2) / 2"
11.1125 + by (simp add: norm_pow_2 dot_ladd dot_radd dot_sym)
11.1126 +
11.1127 +lemma dot_norm_neg: "x \<bullet> y = ((norm x ^ 2 + norm y ^ 2) - norm(x - y) ^ 2) / 2"
11.1128 + by (simp add: norm_pow_2 dot_ladd dot_radd dot_lsub dot_rsub dot_sym)
11.1129 +
11.1130 +
11.1131 +text{* Equality of vectors in terms of @{term "op \<bullet>"} products. *}
11.1132 +
11.1133 +lemma vector_eq: "(x:: real ^ 'n::finite) = y \<longleftrightarrow> x \<bullet> x = x \<bullet> y\<and> y \<bullet> y = x \<bullet> x" (is "?lhs \<longleftrightarrow> ?rhs")
11.1134 +proof
11.1135 + assume "?lhs" then show ?rhs by simp
11.1136 +next
11.1137 + assume ?rhs
11.1138 + then have "x \<bullet> x - x \<bullet> y = 0 \<and> x \<bullet> y - y\<bullet> y = 0" by simp
11.1139 + hence "x \<bullet> (x - y) = 0 \<and> y \<bullet> (x - y) = 0"
11.1140 + by (simp add: dot_rsub dot_lsub dot_sym)
11.1141 + then have "(x - y) \<bullet> (x - y) = 0" by (simp add: ring_simps dot_lsub dot_rsub)
11.1142 + then show "x = y" by (simp add: dot_eq_0)
11.1143 +qed
11.1144 +
11.1145 +
11.1146 +subsection{* General linear decision procedure for normed spaces. *}
11.1147 +
11.1148 +lemma norm_cmul_rule_thm:
11.1149 + fixes x :: "'a::real_normed_vector"
11.1150 + shows "b >= norm(x) ==> \<bar>c\<bar> * b >= norm(scaleR c x)"
11.1151 + unfolding norm_scaleR
11.1152 + apply (erule mult_mono1)
11.1153 + apply simp
11.1154 + done
11.1155 +
11.1156 + (* FIXME: Move all these theorems into the ML code using lemma antiquotation *)
11.1157 +lemma norm_add_rule_thm:
11.1158 + fixes x1 x2 :: "'a::real_normed_vector"
11.1159 + shows "norm x1 \<le> b1 \<Longrightarrow> norm x2 \<le> b2 \<Longrightarrow> norm (x1 + x2) \<le> b1 + b2"
11.1160 + by (rule order_trans [OF norm_triangle_ineq add_mono])
11.1161 +
11.1162 +lemma ge_iff_diff_ge_0: "(a::'a::ordered_ring) \<ge> b == a - b \<ge> 0"
11.1163 + by (simp add: ring_simps)
11.1164 +
11.1165 +lemma pth_1:
11.1166 + fixes x :: "'a::real_normed_vector"
11.1167 + shows "x == scaleR 1 x" by simp
11.1168 +
11.1169 +lemma pth_2:
11.1170 + fixes x :: "'a::real_normed_vector"
11.1171 + shows "x - y == x + -y" by (atomize (full)) simp
11.1172 +
11.1173 +lemma pth_3:
11.1174 + fixes x :: "'a::real_normed_vector"
11.1175 + shows "- x == scaleR (-1) x" by simp
11.1176 +
11.1177 +lemma pth_4:
11.1178 + fixes x :: "'a::real_normed_vector"
11.1179 + shows "scaleR 0 x == 0" and "scaleR c 0 = (0::'a)" by simp_all
11.1180 +
11.1181 +lemma pth_5:
11.1182 + fixes x :: "'a::real_normed_vector"
11.1183 + shows "scaleR c (scaleR d x) == scaleR (c * d) x" by simp
11.1184 +
11.1185 +lemma pth_6:
11.1186 + fixes x :: "'a::real_normed_vector"
11.1187 + shows "scaleR c (x + y) == scaleR c x + scaleR c y"
11.1188 + by (simp add: scaleR_right_distrib)
11.1189 +
11.1190 +lemma pth_7:
11.1191 + fixes x :: "'a::real_normed_vector"
11.1192 + shows "0 + x == x" and "x + 0 == x" by simp_all
11.1193 +
11.1194 +lemma pth_8:
11.1195 + fixes x :: "'a::real_normed_vector"
11.1196 + shows "scaleR c x + scaleR d x == scaleR (c + d) x"
11.1197 + by (simp add: scaleR_left_distrib)
11.1198 +
11.1199 +lemma pth_9:
11.1200 + fixes x :: "'a::real_normed_vector" shows
11.1201 + "(scaleR c x + z) + scaleR d x == scaleR (c + d) x + z"
11.1202 + "scaleR c x + (scaleR d x + z) == scaleR (c + d) x + z"
11.1203 + "(scaleR c x + w) + (scaleR d x + z) == scaleR (c + d) x + (w + z)"
11.1204 + by (simp_all add: algebra_simps)
11.1205 +
11.1206 +lemma pth_a:
11.1207 + fixes x :: "'a::real_normed_vector"
11.1208 + shows "scaleR 0 x + y == y" by simp
11.1209 +
11.1210 +lemma pth_b:
11.1211 + fixes x :: "'a::real_normed_vector" shows
11.1212 + "scaleR c x + scaleR d y == scaleR c x + scaleR d y"
11.1213 + "(scaleR c x + z) + scaleR d y == scaleR c x + (z + scaleR d y)"
11.1214 + "scaleR c x + (scaleR d y + z) == scaleR c x + (scaleR d y + z)"
11.1215 + "(scaleR c x + w) + (scaleR d y + z) == scaleR c x + (w + (scaleR d y + z))"
11.1216 + by (simp_all add: algebra_simps)
11.1217 +
11.1218 +lemma pth_c:
11.1219 + fixes x :: "'a::real_normed_vector" shows
11.1220 + "scaleR c x + scaleR d y == scaleR d y + scaleR c x"
11.1221 + "(scaleR c x + z) + scaleR d y == scaleR d y + (scaleR c x + z)"
11.1222 + "scaleR c x + (scaleR d y + z) == scaleR d y + (scaleR c x + z)"
11.1223 + "(scaleR c x + w) + (scaleR d y + z) == scaleR d y + ((scaleR c x + w) + z)"
11.1224 + by (simp_all add: algebra_simps)
11.1225 +
11.1226 +lemma pth_d:
11.1227 + fixes x :: "'a::real_normed_vector"
11.1228 + shows "x + 0 == x" by simp
11.1229 +
11.1230 +lemma norm_imp_pos_and_ge:
11.1231 + fixes x :: "'a::real_normed_vector"
11.1232 + shows "norm x == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
11.1233 + by atomize auto
11.1234 +
11.1235 +lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
11.1236 +
11.1237 +lemma norm_pths:
11.1238 + fixes x :: "'a::real_normed_vector" shows
11.1239 + "x = y \<longleftrightarrow> norm (x - y) \<le> 0"
11.1240 + "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
11.1241 + using norm_ge_zero[of "x - y"] by auto
11.1242 +
11.1243 +lemma vector_dist_norm:
11.1244 + fixes x :: "'a::real_normed_vector"
11.1245 + shows "dist x y = norm (x - y)"
11.1246 + by (rule dist_norm)
11.1247 +
11.1248 +use "normarith.ML"
11.1249 +
11.1250 +method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
11.1251 +*} "Proves simple linear statements about vector norms"
11.1252 +
11.1253 +
11.1254 +text{* Hence more metric properties. *}
11.1255 +
11.1256 +lemma dist_triangle_alt:
11.1257 + fixes x y z :: "'a::metric_space"
11.1258 + shows "dist y z <= dist x y + dist x z"
11.1259 +using dist_triangle [of y z x] by (simp add: dist_commute)
11.1260 +
11.1261 +lemma dist_pos_lt:
11.1262 + fixes x y :: "'a::metric_space"
11.1263 + shows "x \<noteq> y ==> 0 < dist x y"
11.1264 +by (simp add: zero_less_dist_iff)
11.1265 +
11.1266 +lemma dist_nz:
11.1267 + fixes x y :: "'a::metric_space"
11.1268 + shows "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
11.1269 +by (simp add: zero_less_dist_iff)
11.1270 +
11.1271 +lemma dist_triangle_le:
11.1272 + fixes x y z :: "'a::metric_space"
11.1273 + shows "dist x z + dist y z <= e \<Longrightarrow> dist x y <= e"
11.1274 +by (rule order_trans [OF dist_triangle2])
11.1275 +
11.1276 +lemma dist_triangle_lt:
11.1277 + fixes x y z :: "'a::metric_space"
11.1278 + shows "dist x z + dist y z < e ==> dist x y < e"
11.1279 +by (rule le_less_trans [OF dist_triangle2])
11.1280 +
11.1281 +lemma dist_triangle_half_l:
11.1282 + fixes x1 x2 y :: "'a::metric_space"
11.1283 + shows "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
11.1284 +by (rule dist_triangle_lt [where z=y], simp)
11.1285 +
11.1286 +lemma dist_triangle_half_r:
11.1287 + fixes x1 x2 y :: "'a::metric_space"
11.1288 + shows "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
11.1289 +by (rule dist_triangle_half_l, simp_all add: dist_commute)
11.1290 +
11.1291 +lemma dist_triangle_add:
11.1292 + fixes x y x' y' :: "'a::real_normed_vector"
11.1293 + shows "dist (x + y) (x' + y') <= dist x x' + dist y y'"
11.1294 + by norm
11.1295 +
11.1296 +lemma dist_mul[simp]: "dist (c *s x) (c *s y) = \<bar>c\<bar> * dist x y"
11.1297 + unfolding dist_norm vector_ssub_ldistrib[symmetric] norm_mul ..
11.1298 +
11.1299 +lemma dist_triangle_add_half:
11.1300 + fixes x x' y y' :: "'a::real_normed_vector"
11.1301 + shows "dist x x' < e / 2 \<Longrightarrow> dist y y' < e / 2 \<Longrightarrow> dist(x + y) (x' + y') < e"
11.1302 + by norm
11.1303 +
11.1304 +lemma setsum_component [simp]:
11.1305 + fixes f:: " 'a \<Rightarrow> ('b::comm_monoid_add) ^'n"
11.1306 + shows "(setsum f S)$i = setsum (\<lambda>x. (f x)$i) S"
11.1307 + by (cases "finite S", induct S set: finite, simp_all)
11.1308 +
11.1309 +lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
11.1310 + by (simp add: Cart_eq)
11.1311 +
11.1312 +lemma setsum_clauses:
11.1313 + shows "setsum f {} = 0"
11.1314 + and "finite S \<Longrightarrow> setsum f (insert x S) =
11.1315 + (if x \<in> S then setsum f S else f x + setsum f S)"
11.1316 + by (auto simp add: insert_absorb)
11.1317 +
11.1318 +lemma setsum_cmul:
11.1319 + fixes f:: "'c \<Rightarrow> ('a::semiring_1)^'n"
11.1320 + shows "setsum (\<lambda>x. c *s f x) S = c *s setsum f S"
11.1321 + by (simp add: Cart_eq setsum_right_distrib)
11.1322 +
11.1323 +lemma setsum_norm:
11.1324 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
11.1325 + assumes fS: "finite S"
11.1326 + shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
11.1327 +proof(induct rule: finite_induct[OF fS])
11.1328 + case 1 thus ?case by simp
11.1329 +next
11.1330 + case (2 x S)
11.1331 + from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
11.1332 + also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
11.1333 + using "2.hyps" by simp
11.1334 + finally show ?case using "2.hyps" by simp
11.1335 +qed
11.1336 +
11.1337 +lemma real_setsum_norm:
11.1338 + fixes f :: "'a \<Rightarrow> real ^'n::finite"
11.1339 + assumes fS: "finite S"
11.1340 + shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
11.1341 +proof(induct rule: finite_induct[OF fS])
11.1342 + case 1 thus ?case by simp
11.1343 +next
11.1344 + case (2 x S)
11.1345 + from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
11.1346 + also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
11.1347 + using "2.hyps" by simp
11.1348 + finally show ?case using "2.hyps" by simp
11.1349 +qed
11.1350 +
11.1351 +lemma setsum_norm_le:
11.1352 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
11.1353 + assumes fS: "finite S"
11.1354 + and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
11.1355 + shows "norm (setsum f S) \<le> setsum g S"
11.1356 +proof-
11.1357 + from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
11.1358 + by - (rule setsum_mono, simp)
11.1359 + then show ?thesis using setsum_norm[OF fS, of f] fg
11.1360 + by arith
11.1361 +qed
11.1362 +
11.1363 +lemma real_setsum_norm_le:
11.1364 + fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
11.1365 + assumes fS: "finite S"
11.1366 + and fg: "\<forall>x \<in> S. norm (f x) \<le> g x"
11.1367 + shows "norm (setsum f S) \<le> setsum g S"
11.1368 +proof-
11.1369 + from fg have "setsum (\<lambda>x. norm(f x)) S <= setsum g S"
11.1370 + by - (rule setsum_mono, simp)
11.1371 + then show ?thesis using real_setsum_norm[OF fS, of f] fg
11.1372 + by arith
11.1373 +qed
11.1374 +
11.1375 +lemma setsum_norm_bound:
11.1376 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
11.1377 + assumes fS: "finite S"
11.1378 + and K: "\<forall>x \<in> S. norm (f x) \<le> K"
11.1379 + shows "norm (setsum f S) \<le> of_nat (card S) * K"
11.1380 + using setsum_norm_le[OF fS K] setsum_constant[symmetric]
11.1381 + by simp
11.1382 +
11.1383 +lemma real_setsum_norm_bound:
11.1384 + fixes f :: "'a \<Rightarrow> real ^ 'n::finite"
11.1385 + assumes fS: "finite S"
11.1386 + and K: "\<forall>x \<in> S. norm (f x) \<le> K"
11.1387 + shows "norm (setsum f S) \<le> of_nat (card S) * K"
11.1388 + using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
11.1389 + by simp
11.1390 +
11.1391 +lemma setsum_vmul:
11.1392 + fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
11.1393 + assumes fS: "finite S"
11.1394 + shows "setsum f S *s v = setsum (\<lambda>x. f x *s v) S"
11.1395 +proof(induct rule: finite_induct[OF fS])
11.1396 + case 1 then show ?case by (simp add: vector_smult_lzero)
11.1397 +next
11.1398 + case (2 x F)
11.1399 + from "2.hyps" have "setsum f (insert x F) *s v = (f x + setsum f F) *s v"
11.1400 + by simp
11.1401 + also have "\<dots> = f x *s v + setsum f F *s v"
11.1402 + by (simp add: vector_sadd_rdistrib)
11.1403 + also have "\<dots> = setsum (\<lambda>x. f x *s v) (insert x F)" using "2.hyps" by simp
11.1404 + finally show ?case .
11.1405 +qed
11.1406 +
11.1407 +(* FIXME : Problem thm setsum_vmul[of _ "f:: 'a \<Rightarrow> real ^'n"] ---
11.1408 + Get rid of *s and use real_vector instead! Also prove that ^ creates a real_vector !! *)
11.1409 +
11.1410 + (* FIXME: Here too need stupid finiteness assumption on T!!! *)
11.1411 +lemma setsum_group:
11.1412 + assumes fS: "finite S" and fT: "finite T" and fST: "f ` S \<subseteq> T"
11.1413 + shows "setsum (\<lambda>y. setsum g {x. x\<in> S \<and> f x = y}) T = setsum g S"
11.1414 +
11.1415 +apply (subst setsum_image_gen[OF fS, of g f])
11.1416 +apply (rule setsum_mono_zero_right[OF fT fST])
11.1417 +by (auto intro: setsum_0')
11.1418 +
11.1419 +lemma vsum_norm_allsubsets_bound:
11.1420 + fixes f:: "'a \<Rightarrow> real ^'n::finite"
11.1421 + assumes fP: "finite P" and fPs: "\<And>Q. Q \<subseteq> P \<Longrightarrow> norm (setsum f Q) \<le> e"
11.1422 + shows "setsum (\<lambda>x. norm (f x)) P \<le> 2 * real CARD('n) * e"
11.1423 +proof-
11.1424 + let ?d = "real CARD('n)"
11.1425 + let ?nf = "\<lambda>x. norm (f x)"
11.1426 + let ?U = "UNIV :: 'n set"
11.1427 + have th0: "setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P = setsum (\<lambda>i. setsum (\<lambda>x. \<bar>f x $ i\<bar>) P) ?U"
11.1428 + by (rule setsum_commute)
11.1429 + have th1: "2 * ?d * e = of_nat (card ?U) * (2 * e)" by (simp add: real_of_nat_def)
11.1430 + have "setsum ?nf P \<le> setsum (\<lambda>x. setsum (\<lambda>i. \<bar>f x $ i\<bar>) ?U) P"
11.1431 + apply (rule setsum_mono)
11.1432 + by (rule norm_le_l1)
11.1433 + also have "\<dots> \<le> 2 * ?d * e"
11.1434 + unfolding th0 th1
11.1435 + proof(rule setsum_bounded)
11.1436 + fix i assume i: "i \<in> ?U"
11.1437 + let ?Pp = "{x. x\<in> P \<and> f x $ i \<ge> 0}"
11.1438 + let ?Pn = "{x. x \<in> P \<and> f x $ i < 0}"
11.1439 + have thp: "P = ?Pp \<union> ?Pn" by auto
11.1440 + have thp0: "?Pp \<inter> ?Pn ={}" by auto
11.1441 + have PpP: "?Pp \<subseteq> P" and PnP: "?Pn \<subseteq> P" by blast+
11.1442 + have Ppe:"setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp \<le> e"
11.1443 + using component_le_norm[of "setsum (\<lambda>x. f x) ?Pp" i] fPs[OF PpP]
11.1444 + by (auto intro: abs_le_D1)
11.1445 + have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
11.1446 + using component_le_norm[of "setsum (\<lambda>x. - f x) ?Pn" i] fPs[OF PnP]
11.1447 + by (auto simp add: setsum_negf intro: abs_le_D1)
11.1448 + have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn"
11.1449 + apply (subst thp)
11.1450 + apply (rule setsum_Un_zero)
11.1451 + using fP thp0 by auto
11.1452 + also have "\<dots> \<le> 2*e" using Pne Ppe by arith
11.1453 + finally show "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P \<le> 2*e" .
11.1454 + qed
11.1455 + finally show ?thesis .
11.1456 +qed
11.1457 +
11.1458 +lemma dot_lsum: "finite S \<Longrightarrow> setsum f S \<bullet> (y::'a::{comm_ring}^'n) = setsum (\<lambda>x. f x \<bullet> y) S "
11.1459 + by (induct rule: finite_induct, auto simp add: dot_lzero dot_ladd dot_radd)
11.1460 +
11.1461 +lemma dot_rsum: "finite S \<Longrightarrow> (y::'a::{comm_ring}^'n) \<bullet> setsum f S = setsum (\<lambda>x. y \<bullet> f x) S "
11.1462 + by (induct rule: finite_induct, auto simp add: dot_rzero dot_radd)
11.1463 +
11.1464 +subsection{* Basis vectors in coordinate directions. *}
11.1465 +
11.1466 +
11.1467 +definition "basis k = (\<chi> i. if i = k then 1 else 0)"
11.1468 +
11.1469 +lemma basis_component [simp]: "basis k $ i = (if k=i then 1 else 0)"
11.1470 + unfolding basis_def by simp
11.1471 +
11.1472 +lemma delta_mult_idempotent:
11.1473 + "(if k=a then 1 else (0::'a::semiring_1)) * (if k=a then 1 else 0) = (if k=a then 1 else 0)" by (cases "k=a", auto)
11.1474 +
11.1475 +lemma norm_basis:
11.1476 + shows "norm (basis k :: real ^'n::finite) = 1"
11.1477 + apply (simp add: basis_def real_vector_norm_def dot_def)
11.1478 + apply (vector delta_mult_idempotent)
11.1479 + using setsum_delta[of "UNIV :: 'n set" "k" "\<lambda>k. 1::real"]
11.1480 + apply auto
11.1481 + done
11.1482 +
11.1483 +lemma norm_basis_1: "norm(basis 1 :: real ^'n::{finite,one}) = 1"
11.1484 + by (rule norm_basis)
11.1485 +
11.1486 +lemma vector_choose_size: "0 <= c ==> \<exists>(x::real^'n::finite). norm x = c"
11.1487 + apply (rule exI[where x="c *s basis arbitrary"])
11.1488 + by (simp only: norm_mul norm_basis)
11.1489 +
11.1490 +lemma vector_choose_dist: assumes e: "0 <= e"
11.1491 + shows "\<exists>(y::real^'n::finite). dist x y = e"
11.1492 +proof-
11.1493 + from vector_choose_size[OF e] obtain c:: "real ^'n" where "norm c = e"
11.1494 + by blast
11.1495 + then have "dist x (x - c) = e" by (simp add: dist_norm)
11.1496 + then show ?thesis by blast
11.1497 +qed
11.1498 +
11.1499 +lemma basis_inj: "inj (basis :: 'n \<Rightarrow> real ^'n::finite)"
11.1500 + by (simp add: inj_on_def Cart_eq)
11.1501 +
11.1502 +lemma cond_value_iff: "f (if b then x else y) = (if b then f x else f y)"
11.1503 + by auto
11.1504 +
11.1505 +lemma basis_expansion:
11.1506 + "setsum (\<lambda>i. (x$i) *s basis i) UNIV = (x::('a::ring_1) ^'n::finite)" (is "?lhs = ?rhs" is "setsum ?f ?S = _")
11.1507 + by (auto simp add: Cart_eq cond_value_iff setsum_delta[of "?S", where ?'b = "'a", simplified] cong del: if_weak_cong)
11.1508 +
11.1509 +lemma basis_expansion_unique:
11.1510 + "setsum (\<lambda>i. f i *s basis i) UNIV = (x::('a::comm_ring_1) ^'n::finite) \<longleftrightarrow> (\<forall>i. f i = x$i)"
11.1511 + by (simp add: Cart_eq setsum_delta cond_value_iff cong del: if_weak_cong)
11.1512 +
11.1513 +lemma cond_application_beta: "(if b then f else g) x = (if b then f x else g x)"
11.1514 + by auto
11.1515 +
11.1516 +lemma dot_basis:
11.1517 + shows "basis i \<bullet> x = x$i" "x \<bullet> (basis i :: 'a^'n::finite) = (x$i :: 'a::semiring_1)"
11.1518 + by (auto simp add: dot_def basis_def cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
11.1519 +
11.1520 +lemma inner_basis:
11.1521 + fixes x :: "'a::{real_inner, real_algebra_1} ^ 'n::finite"
11.1522 + shows "inner (basis i) x = inner 1 (x $ i)"
11.1523 + and "inner x (basis i) = inner (x $ i) 1"
11.1524 + unfolding inner_vector_def basis_def
11.1525 + by (auto simp add: cond_application_beta cond_value_iff setsum_delta cong del: if_weak_cong)
11.1526 +
11.1527 +lemma basis_eq_0: "basis i = (0::'a::semiring_1^'n) \<longleftrightarrow> False"
11.1528 + by (auto simp add: Cart_eq)
11.1529 +
11.1530 +lemma basis_nonzero:
11.1531 + shows "basis k \<noteq> (0:: 'a::semiring_1 ^'n)"
11.1532 + by (simp add: basis_eq_0)
11.1533 +
11.1534 +lemma vector_eq_ldot: "(\<forall>x. x \<bullet> y = x \<bullet> z) \<longleftrightarrow> y = (z::'a::semiring_1^'n::finite)"
11.1535 + apply (auto simp add: Cart_eq dot_basis)
11.1536 + apply (erule_tac x="basis i" in allE)
11.1537 + apply (simp add: dot_basis)
11.1538 + apply (subgoal_tac "y = z")
11.1539 + apply simp
11.1540 + apply (simp add: Cart_eq)
11.1541 + done
11.1542 +
11.1543 +lemma vector_eq_rdot: "(\<forall>z. x \<bullet> z = y \<bullet> z) \<longleftrightarrow> x = (y::'a::semiring_1^'n::finite)"
11.1544 + apply (auto simp add: Cart_eq dot_basis)
11.1545 + apply (erule_tac x="basis i" in allE)
11.1546 + apply (simp add: dot_basis)
11.1547 + apply (subgoal_tac "x = y")
11.1548 + apply simp
11.1549 + apply (simp add: Cart_eq)
11.1550 + done
11.1551 +
11.1552 +subsection{* Orthogonality. *}
11.1553 +
11.1554 +definition "orthogonal x y \<longleftrightarrow> (x \<bullet> y = 0)"
11.1555 +
11.1556 +lemma orthogonal_basis:
11.1557 + shows "orthogonal (basis i :: 'a^'n::finite) x \<longleftrightarrow> x$i = (0::'a::ring_1)"
11.1558 + by (auto simp add: orthogonal_def dot_def basis_def cond_value_iff cond_application_beta setsum_delta cong del: if_weak_cong)
11.1559 +
11.1560 +lemma orthogonal_basis_basis:
11.1561 + shows "orthogonal (basis i :: 'a::ring_1^'n::finite) (basis j) \<longleftrightarrow> i \<noteq> j"
11.1562 + unfolding orthogonal_basis[of i] basis_component[of j] by simp
11.1563 +
11.1564 + (* FIXME : Maybe some of these require less than comm_ring, but not all*)
11.1565 +lemma orthogonal_clauses:
11.1566 + "orthogonal a (0::'a::comm_ring ^'n)"
11.1567 + "orthogonal a x ==> orthogonal a (c *s x)"
11.1568 + "orthogonal a x ==> orthogonal a (-x)"
11.1569 + "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x + y)"
11.1570 + "orthogonal a x \<Longrightarrow> orthogonal a y ==> orthogonal a (x - y)"
11.1571 + "orthogonal 0 a"
11.1572 + "orthogonal x a ==> orthogonal (c *s x) a"
11.1573 + "orthogonal x a ==> orthogonal (-x) a"
11.1574 + "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x + y) a"
11.1575 + "orthogonal x a \<Longrightarrow> orthogonal y a ==> orthogonal (x - y) a"
11.1576 + unfolding orthogonal_def dot_rneg dot_rmult dot_radd dot_rsub
11.1577 + dot_lzero dot_rzero dot_lneg dot_lmult dot_ladd dot_lsub
11.1578 + by simp_all
11.1579 +
11.1580 +lemma orthogonal_commute: "orthogonal (x::'a::{ab_semigroup_mult,comm_monoid_add} ^'n)y \<longleftrightarrow> orthogonal y x"
11.1581 + by (simp add: orthogonal_def dot_sym)
11.1582 +
11.1583 +subsection{* Explicit vector construction from lists. *}
11.1584 +
11.1585 +primrec from_nat :: "nat \<Rightarrow> 'a::{monoid_add,one}"
11.1586 +where "from_nat 0 = 0" | "from_nat (Suc n) = 1 + from_nat n"
11.1587 +
11.1588 +lemma from_nat [simp]: "from_nat = of_nat"
11.1589 +by (rule ext, induct_tac x, simp_all)
11.1590 +
11.1591 +primrec
11.1592 + list_fun :: "nat \<Rightarrow> _ list \<Rightarrow> _ \<Rightarrow> _"
11.1593 +where
11.1594 + "list_fun n [] = (\<lambda>x. 0)"
11.1595 +| "list_fun n (x # xs) = fun_upd (list_fun (Suc n) xs) (from_nat n) x"
11.1596 +
11.1597 +definition "vector l = (\<chi> i. list_fun 1 l i)"
11.1598 +(*definition "vector l = (\<chi> i. if i <= length l then l ! (i - 1) else 0)"*)
11.1599 +
11.1600 +lemma vector_1: "(vector[x]) $1 = x"
11.1601 + unfolding vector_def by simp
11.1602 +
11.1603 +lemma vector_2:
11.1604 + "(vector[x,y]) $1 = x"
11.1605 + "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
11.1606 + unfolding vector_def by simp_all
11.1607 +
11.1608 +lemma vector_3:
11.1609 + "(vector [x,y,z] ::('a::zero)^3)$1 = x"
11.1610 + "(vector [x,y,z] ::('a::zero)^3)$2 = y"
11.1611 + "(vector [x,y,z] ::('a::zero)^3)$3 = z"
11.1612 + unfolding vector_def by simp_all
11.1613 +
11.1614 +lemma forall_vector_1: "(\<forall>v::'a::zero^1. P v) \<longleftrightarrow> (\<forall>x. P(vector[x]))"
11.1615 + apply auto
11.1616 + apply (erule_tac x="v$1" in allE)
11.1617 + apply (subgoal_tac "vector [v$1] = v")
11.1618 + apply simp
11.1619 + apply (vector vector_def)
11.1620 + apply (simp add: forall_1)
11.1621 + done
11.1622 +
11.1623 +lemma forall_vector_2: "(\<forall>v::'a::zero^2. P v) \<longleftrightarrow> (\<forall>x y. P(vector[x, y]))"
11.1624 + apply auto
11.1625 + apply (erule_tac x="v$1" in allE)
11.1626 + apply (erule_tac x="v$2" in allE)
11.1627 + apply (subgoal_tac "vector [v$1, v$2] = v")
11.1628 + apply simp
11.1629 + apply (vector vector_def)
11.1630 + apply (simp add: forall_2)
11.1631 + done
11.1632 +
11.1633 +lemma forall_vector_3: "(\<forall>v::'a::zero^3. P v) \<longleftrightarrow> (\<forall>x y z. P(vector[x, y, z]))"
11.1634 + apply auto
11.1635 + apply (erule_tac x="v$1" in allE)
11.1636 + apply (erule_tac x="v$2" in allE)
11.1637 + apply (erule_tac x="v$3" in allE)
11.1638 + apply (subgoal_tac "vector [v$1, v$2, v$3] = v")
11.1639 + apply simp
11.1640 + apply (vector vector_def)
11.1641 + apply (simp add: forall_3)
11.1642 + done
11.1643 +
11.1644 +subsection{* Linear functions. *}
11.1645 +
11.1646 +definition "linear f \<longleftrightarrow> (\<forall>x y. f(x + y) = f x + f y) \<and> (\<forall>c x. f(c *s x) = c *s f x)"
11.1647 +
11.1648 +lemma linear_compose_cmul: "linear f ==> linear (\<lambda>x. (c::'a::comm_semiring) *s f x)"
11.1649 + by (vector linear_def Cart_eq ring_simps)
11.1650 +
11.1651 +lemma linear_compose_neg: "linear (f :: 'a ^'n \<Rightarrow> 'a::comm_ring ^'m) ==> linear (\<lambda>x. -(f(x)))" by (vector linear_def Cart_eq)
11.1652 +
11.1653 +lemma linear_compose_add: "linear (f :: 'a ^'n \<Rightarrow> 'a::semiring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f(x) + g(x))"
11.1654 + by (vector linear_def Cart_eq ring_simps)
11.1655 +
11.1656 +lemma linear_compose_sub: "linear (f :: 'a ^'n \<Rightarrow> 'a::ring_1 ^'m) \<Longrightarrow> linear g ==> linear (\<lambda>x. f x - g x)"
11.1657 + by (vector linear_def Cart_eq ring_simps)
11.1658 +
11.1659 +lemma linear_compose: "linear f \<Longrightarrow> linear g ==> linear (g o f)"
11.1660 + by (simp add: linear_def)
11.1661 +
11.1662 +lemma linear_id: "linear id" by (simp add: linear_def id_def)
11.1663 +
11.1664 +lemma linear_zero: "linear (\<lambda>x. 0::'a::semiring_1 ^ 'n)" by (simp add: linear_def)
11.1665 +
11.1666 +lemma linear_compose_setsum:
11.1667 + assumes fS: "finite S" and lS: "\<forall>a \<in> S. linear (f a :: 'a::semiring_1 ^ 'n \<Rightarrow> 'a ^ 'm)"
11.1668 + shows "linear(\<lambda>x. setsum (\<lambda>a. f a x :: 'a::semiring_1 ^'m) S)"
11.1669 + using lS
11.1670 + apply (induct rule: finite_induct[OF fS])
11.1671 + by (auto simp add: linear_zero intro: linear_compose_add)
11.1672 +
11.1673 +lemma linear_vmul_component:
11.1674 + fixes f:: "'a::semiring_1^'m \<Rightarrow> 'a^'n"
11.1675 + assumes lf: "linear f"
11.1676 + shows "linear (\<lambda>x. f x $ k *s v)"
11.1677 + using lf
11.1678 + apply (auto simp add: linear_def )
11.1679 + by (vector ring_simps)+
11.1680 +
11.1681 +lemma linear_0: "linear f ==> f 0 = (0::'a::semiring_1 ^'n)"
11.1682 + unfolding linear_def
11.1683 + apply clarsimp
11.1684 + apply (erule allE[where x="0::'a"])
11.1685 + apply simp
11.1686 + done
11.1687 +
11.1688 +lemma linear_cmul: "linear f ==> f(c*s x) = c *s f x" by (simp add: linear_def)
11.1689 +
11.1690 +lemma linear_neg: "linear (f :: 'a::ring_1 ^'n \<Rightarrow> _) ==> f (-x) = - f x"
11.1691 + unfolding vector_sneg_minus1
11.1692 + using linear_cmul[of f] by auto
11.1693 +
11.1694 +lemma linear_add: "linear f ==> f(x + y) = f x + f y" by (metis linear_def)
11.1695 +
11.1696 +lemma linear_sub: "linear (f::'a::ring_1 ^'n \<Rightarrow> _) ==> f(x - y) = f x - f y"
11.1697 + by (simp add: diff_def linear_add linear_neg)
11.1698 +
11.1699 +lemma linear_setsum:
11.1700 + fixes f:: "'a::semiring_1^'n \<Rightarrow> _"
11.1701 + assumes lf: "linear f" and fS: "finite S"
11.1702 + shows "f (setsum g S) = setsum (f o g) S"
11.1703 +proof (induct rule: finite_induct[OF fS])
11.1704 + case 1 thus ?case by (simp add: linear_0[OF lf])
11.1705 +next
11.1706 + case (2 x F)
11.1707 + have "f (setsum g (insert x F)) = f (g x + setsum g F)" using "2.hyps"
11.1708 + by simp
11.1709 + also have "\<dots> = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp
11.1710 + also have "\<dots> = setsum (f o g) (insert x F)" using "2.hyps" by simp
11.1711 + finally show ?case .
11.1712 +qed
11.1713 +
11.1714 +lemma linear_setsum_mul:
11.1715 + fixes f:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m"
11.1716 + assumes lf: "linear f" and fS: "finite S"
11.1717 + shows "f (setsum (\<lambda>i. c i *s v i) S) = setsum (\<lambda>i. c i *s f (v i)) S"
11.1718 + using linear_setsum[OF lf fS, of "\<lambda>i. c i *s v i" , unfolded o_def]
11.1719 + linear_cmul[OF lf] by simp
11.1720 +
11.1721 +lemma linear_injective_0:
11.1722 + assumes lf: "linear (f:: 'a::ring_1 ^ 'n \<Rightarrow> _)"
11.1723 + shows "inj f \<longleftrightarrow> (\<forall>x. f x = 0 \<longrightarrow> x = 0)"
11.1724 +proof-
11.1725 + have "inj f \<longleftrightarrow> (\<forall> x y. f x = f y \<longrightarrow> x = y)" by (simp add: inj_on_def)
11.1726 + also have "\<dots> \<longleftrightarrow> (\<forall> x y. f x - f y = 0 \<longrightarrow> x - y = 0)" by simp
11.1727 + also have "\<dots> \<longleftrightarrow> (\<forall> x y. f (x - y) = 0 \<longrightarrow> x - y = 0)"
11.1728 + by (simp add: linear_sub[OF lf])
11.1729 + also have "\<dots> \<longleftrightarrow> (\<forall> x. f x = 0 \<longrightarrow> x = 0)" by auto
11.1730 + finally show ?thesis .
11.1731 +qed
11.1732 +
11.1733 +lemma linear_bounded:
11.1734 + fixes f:: "real ^'m::finite \<Rightarrow> real ^'n::finite"
11.1735 + assumes lf: "linear f"
11.1736 + shows "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
11.1737 +proof-
11.1738 + let ?S = "UNIV:: 'm set"
11.1739 + let ?B = "setsum (\<lambda>i. norm(f(basis i))) ?S"
11.1740 + have fS: "finite ?S" by simp
11.1741 + {fix x:: "real ^ 'm"
11.1742 + let ?g = "(\<lambda>i. (x$i) *s (basis i) :: real ^ 'm)"
11.1743 + have "norm (f x) = norm (f (setsum (\<lambda>i. (x$i) *s (basis i)) ?S))"
11.1744 + by (simp only: basis_expansion)
11.1745 + also have "\<dots> = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)"
11.1746 + using linear_setsum[OF lf fS, of ?g, unfolded o_def] linear_cmul[OF lf]
11.1747 + by auto
11.1748 + finally have th0: "norm (f x) = norm (setsum (\<lambda>i. (x$i) *s f (basis i))?S)" .
11.1749 + {fix i assume i: "i \<in> ?S"
11.1750 + from component_le_norm[of x i]
11.1751 + have "norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x"
11.1752 + unfolding norm_mul
11.1753 + apply (simp only: mult_commute)
11.1754 + apply (rule mult_mono)
11.1755 + by (auto simp add: ring_simps norm_ge_zero) }
11.1756 + then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis
11.1757 + from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
11.1758 + have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
11.1759 + then show ?thesis by blast
11.1760 +qed
11.1761 +
11.1762 +lemma linear_bounded_pos:
11.1763 + fixes f:: "real ^'n::finite \<Rightarrow> real ^ 'm::finite"
11.1764 + assumes lf: "linear f"
11.1765 + shows "\<exists>B > 0. \<forall>x. norm (f x) \<le> B * norm x"
11.1766 +proof-
11.1767 + from linear_bounded[OF lf] obtain B where
11.1768 + B: "\<forall>x. norm (f x) \<le> B * norm x" by blast
11.1769 + let ?K = "\<bar>B\<bar> + 1"
11.1770 + have Kp: "?K > 0" by arith
11.1771 + {assume C: "B < 0"
11.1772 + have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
11.1773 + with C have "B * norm (1:: real ^ 'n) < 0"
11.1774 + by (simp add: zero_compare_simps)
11.1775 + with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
11.1776 + }
11.1777 + then have Bp: "B \<ge> 0" by ferrack
11.1778 + {fix x::"real ^ 'n"
11.1779 + have "norm (f x) \<le> ?K * norm x"
11.1780 + using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
11.1781 + apply (auto simp add: ring_simps split add: abs_split)
11.1782 + apply (erule order_trans, simp)
11.1783 + done
11.1784 + }
11.1785 + then show ?thesis using Kp by blast
11.1786 +qed
11.1787 +
11.1788 +lemma smult_conv_scaleR: "c *s x = scaleR c x"
11.1789 + unfolding vector_scalar_mult_def vector_scaleR_def by simp
11.1790 +
11.1791 +lemma linear_conv_bounded_linear:
11.1792 + fixes f :: "real ^ _ \<Rightarrow> real ^ _"
11.1793 + shows "linear f \<longleftrightarrow> bounded_linear f"
11.1794 +proof
11.1795 + assume "linear f"
11.1796 + show "bounded_linear f"
11.1797 + proof
11.1798 + fix x y show "f (x + y) = f x + f y"
11.1799 + using `linear f` unfolding linear_def by simp
11.1800 + next
11.1801 + fix r x show "f (scaleR r x) = scaleR r (f x)"
11.1802 + using `linear f` unfolding linear_def
11.1803 + by (simp add: smult_conv_scaleR)
11.1804 + next
11.1805 + have "\<exists>B. \<forall>x. norm (f x) \<le> B * norm x"
11.1806 + using `linear f` by (rule linear_bounded)
11.1807 + thus "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
11.1808 + by (simp add: mult_commute)
11.1809 + qed
11.1810 +next
11.1811 + assume "bounded_linear f"
11.1812 + then interpret f: bounded_linear f .
11.1813 + show "linear f"
11.1814 + unfolding linear_def smult_conv_scaleR
11.1815 + by (simp add: f.add f.scaleR)
11.1816 +qed
11.1817 +
11.1818 +subsection{* Bilinear functions. *}
11.1819 +
11.1820 +definition "bilinear f \<longleftrightarrow> (\<forall>x. linear(\<lambda>y. f x y)) \<and> (\<forall>y. linear(\<lambda>x. f x y))"
11.1821 +
11.1822 +lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)"
11.1823 + by (simp add: bilinear_def linear_def)
11.1824 +lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)"
11.1825 + by (simp add: bilinear_def linear_def)
11.1826 +
11.1827 +lemma bilinear_lmul: "bilinear h ==> h (c *s x) y = c *s (h x y)"
11.1828 + by (simp add: bilinear_def linear_def)
11.1829 +
11.1830 +lemma bilinear_rmul: "bilinear h ==> h x (c *s y) = c *s (h x y)"
11.1831 + by (simp add: bilinear_def linear_def)
11.1832 +
11.1833 +lemma bilinear_lneg: "bilinear h ==> h (- (x:: 'a::ring_1 ^ 'n)) y = -(h x y)"
11.1834 + by (simp only: vector_sneg_minus1 bilinear_lmul)
11.1835 +
11.1836 +lemma bilinear_rneg: "bilinear h ==> h x (- (y:: 'a::ring_1 ^ 'n)) = - h x y"
11.1837 + by (simp only: vector_sneg_minus1 bilinear_rmul)
11.1838 +
11.1839 +lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
11.1840 + using add_imp_eq[of x y 0] by auto
11.1841 +
11.1842 +lemma bilinear_lzero:
11.1843 + fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h 0 x = 0"
11.1844 + using bilinear_ladd[OF bh, of 0 0 x]
11.1845 + by (simp add: eq_add_iff ring_simps)
11.1846 +
11.1847 +lemma bilinear_rzero:
11.1848 + fixes h :: "'a::ring^'n \<Rightarrow> _" assumes bh: "bilinear h" shows "h x 0 = 0"
11.1849 + using bilinear_radd[OF bh, of x 0 0 ]
11.1850 + by (simp add: eq_add_iff ring_simps)
11.1851 +
11.1852 +lemma bilinear_lsub: "bilinear h ==> h (x - (y:: 'a::ring_1 ^ 'n)) z = h x z - h y z"
11.1853 + by (simp add: diff_def bilinear_ladd bilinear_lneg)
11.1854 +
11.1855 +lemma bilinear_rsub: "bilinear h ==> h z (x - (y:: 'a::ring_1 ^ 'n)) = h z x - h z y"
11.1856 + by (simp add: diff_def bilinear_radd bilinear_rneg)
11.1857 +
11.1858 +lemma bilinear_setsum:
11.1859 + fixes h:: "'a ^'n \<Rightarrow> 'a::semiring_1^'m \<Rightarrow> 'a ^ 'k"
11.1860 + assumes bh: "bilinear h" and fS: "finite S" and fT: "finite T"
11.1861 + shows "h (setsum f S) (setsum g T) = setsum (\<lambda>(i,j). h (f i) (g j)) (S \<times> T) "
11.1862 +proof-
11.1863 + have "h (setsum f S) (setsum g T) = setsum (\<lambda>x. h (f x) (setsum g T)) S"
11.1864 + apply (rule linear_setsum[unfolded o_def])
11.1865 + using bh fS by (auto simp add: bilinear_def)
11.1866 + also have "\<dots> = setsum (\<lambda>x. setsum (\<lambda>y. h (f x) (g y)) T) S"
11.1867 + apply (rule setsum_cong, simp)
11.1868 + apply (rule linear_setsum[unfolded o_def])
11.1869 + using bh fT by (auto simp add: bilinear_def)
11.1870 + finally show ?thesis unfolding setsum_cartesian_product .
11.1871 +qed
11.1872 +
11.1873 +lemma bilinear_bounded:
11.1874 + fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
11.1875 + assumes bh: "bilinear h"
11.1876 + shows "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
11.1877 +proof-
11.1878 + let ?M = "UNIV :: 'm set"
11.1879 + let ?N = "UNIV :: 'n set"
11.1880 + let ?B = "setsum (\<lambda>(i,j). norm (h (basis i) (basis j))) (?M \<times> ?N)"
11.1881 + have fM: "finite ?M" and fN: "finite ?N" by simp_all
11.1882 + {fix x:: "real ^ 'm" and y :: "real^'n"
11.1883 + have "norm (h x y) = norm (h (setsum (\<lambda>i. (x$i) *s basis i) ?M) (setsum (\<lambda>i. (y$i) *s basis i) ?N))" unfolding basis_expansion ..
11.1884 + also have "\<dots> = norm (setsum (\<lambda> (i,j). h ((x$i) *s basis i) ((y$j) *s basis j)) (?M \<times> ?N))" unfolding bilinear_setsum[OF bh fM fN] ..
11.1885 + finally have th: "norm (h x y) = \<dots>" .
11.1886 + have "norm (h x y) \<le> ?B * norm x * norm y"
11.1887 + apply (simp add: setsum_left_distrib th)
11.1888 + apply (rule real_setsum_norm_le)
11.1889 + using fN fM
11.1890 + apply simp
11.1891 + apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
11.1892 + apply (rule mult_mono)
11.1893 + apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
11.1894 + apply (rule mult_mono)
11.1895 + apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
11.1896 + done}
11.1897 + then show ?thesis by metis
11.1898 +qed
11.1899 +
11.1900 +lemma bilinear_bounded_pos:
11.1901 + fixes h:: "real ^'m::finite \<Rightarrow> real^'n::finite \<Rightarrow> real ^ 'k::finite"
11.1902 + assumes bh: "bilinear h"
11.1903 + shows "\<exists>B > 0. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
11.1904 +proof-
11.1905 + from bilinear_bounded[OF bh] obtain B where
11.1906 + B: "\<forall>x y. norm (h x y) \<le> B * norm x * norm y" by blast
11.1907 + let ?K = "\<bar>B\<bar> + 1"
11.1908 + have Kp: "?K > 0" by arith
11.1909 + have KB: "B < ?K" by arith
11.1910 + {fix x::"real ^'m" and y :: "real ^'n"
11.1911 + from KB Kp
11.1912 + have "B * norm x * norm y \<le> ?K * norm x * norm y"
11.1913 + apply -
11.1914 + apply (rule mult_right_mono, rule mult_right_mono)
11.1915 + by (auto simp add: norm_ge_zero)
11.1916 + then have "norm (h x y) \<le> ?K * norm x * norm y"
11.1917 + using B[rule_format, of x y] by simp}
11.1918 + with Kp show ?thesis by blast
11.1919 +qed
11.1920 +
11.1921 +lemma bilinear_conv_bounded_bilinear:
11.1922 + fixes h :: "real ^ _ \<Rightarrow> real ^ _ \<Rightarrow> real ^ _"
11.1923 + shows "bilinear h \<longleftrightarrow> bounded_bilinear h"
11.1924 +proof
11.1925 + assume "bilinear h"
11.1926 + show "bounded_bilinear h"
11.1927 + proof
11.1928 + fix x y z show "h (x + y) z = h x z + h y z"
11.1929 + using `bilinear h` unfolding bilinear_def linear_def by simp
11.1930 + next
11.1931 + fix x y z show "h x (y + z) = h x y + h x z"
11.1932 + using `bilinear h` unfolding bilinear_def linear_def by simp
11.1933 + next
11.1934 + fix r x y show "h (scaleR r x) y = scaleR r (h x y)"
11.1935 + using `bilinear h` unfolding bilinear_def linear_def
11.1936 + by (simp add: smult_conv_scaleR)
11.1937 + next
11.1938 + fix r x y show "h x (scaleR r y) = scaleR r (h x y)"
11.1939 + using `bilinear h` unfolding bilinear_def linear_def
11.1940 + by (simp add: smult_conv_scaleR)
11.1941 + next
11.1942 + have "\<exists>B. \<forall>x y. norm (h x y) \<le> B * norm x * norm y"
11.1943 + using `bilinear h` by (rule bilinear_bounded)
11.1944 + thus "\<exists>K. \<forall>x y. norm (h x y) \<le> norm x * norm y * K"
11.1945 + by (simp add: mult_ac)
11.1946 + qed
11.1947 +next
11.1948 + assume "bounded_bilinear h"
11.1949 + then interpret h: bounded_bilinear h .
11.1950 + show "bilinear h"
11.1951 + unfolding bilinear_def linear_conv_bounded_linear
11.1952 + using h.bounded_linear_left h.bounded_linear_right
11.1953 + by simp
11.1954 +qed
11.1955 +
11.1956 +subsection{* Adjoints. *}
11.1957 +
11.1958 +definition "adjoint f = (SOME f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y)"
11.1959 +
11.1960 +lemma choice_iff: "(\<forall>x. \<exists>y. P x y) \<longleftrightarrow> (\<exists>f. \<forall>x. P x (f x))" by metis
11.1961 +
11.1962 +lemma adjoint_works_lemma:
11.1963 + fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.1964 + assumes lf: "linear f"
11.1965 + shows "\<forall>x y. f x \<bullet> y = x \<bullet> adjoint f y"
11.1966 +proof-
11.1967 + let ?N = "UNIV :: 'n set"
11.1968 + let ?M = "UNIV :: 'm set"
11.1969 + have fN: "finite ?N" by simp
11.1970 + have fM: "finite ?M" by simp
11.1971 + {fix y:: "'a ^ 'm"
11.1972 + let ?w = "(\<chi> i. (f (basis i) \<bullet> y)) :: 'a ^ 'n"
11.1973 + {fix x
11.1974 + have "f x \<bullet> y = f (setsum (\<lambda>i. (x$i) *s basis i) ?N) \<bullet> y"
11.1975 + by (simp only: basis_expansion)
11.1976 + also have "\<dots> = (setsum (\<lambda>i. (x$i) *s f (basis i)) ?N) \<bullet> y"
11.1977 + unfolding linear_setsum[OF lf fN]
11.1978 + by (simp add: linear_cmul[OF lf])
11.1979 + finally have "f x \<bullet> y = x \<bullet> ?w"
11.1980 + apply (simp only: )
11.1981 + apply (simp add: dot_def setsum_left_distrib setsum_right_distrib setsum_commute[of _ ?M ?N] ring_simps)
11.1982 + done}
11.1983 + }
11.1984 + then show ?thesis unfolding adjoint_def
11.1985 + some_eq_ex[of "\<lambda>f'. \<forall>x y. f x \<bullet> y = x \<bullet> f' y"]
11.1986 + using choice_iff[of "\<lambda>a b. \<forall>x. f x \<bullet> a = x \<bullet> b "]
11.1987 + by metis
11.1988 +qed
11.1989 +
11.1990 +lemma adjoint_works:
11.1991 + fixes f:: "'a::ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.1992 + assumes lf: "linear f"
11.1993 + shows "x \<bullet> adjoint f y = f x \<bullet> y"
11.1994 + using adjoint_works_lemma[OF lf] by metis
11.1995 +
11.1996 +
11.1997 +lemma adjoint_linear:
11.1998 + fixes f :: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.1999 + assumes lf: "linear f"
11.2000 + shows "linear (adjoint f)"
11.2001 + by (simp add: linear_def vector_eq_ldot[symmetric] dot_radd dot_rmult adjoint_works[OF lf])
11.2002 +
11.2003 +lemma adjoint_clauses:
11.2004 + fixes f:: "'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.2005 + assumes lf: "linear f"
11.2006 + shows "x \<bullet> adjoint f y = f x \<bullet> y"
11.2007 + and "adjoint f y \<bullet> x = y \<bullet> f x"
11.2008 + by (simp_all add: adjoint_works[OF lf] dot_sym )
11.2009 +
11.2010 +lemma adjoint_adjoint:
11.2011 + fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.2012 + assumes lf: "linear f"
11.2013 + shows "adjoint (adjoint f) = f"
11.2014 + apply (rule ext)
11.2015 + by (simp add: vector_eq_ldot[symmetric] adjoint_clauses[OF adjoint_linear[OF lf]] adjoint_clauses[OF lf])
11.2016 +
11.2017 +lemma adjoint_unique:
11.2018 + fixes f:: "'a::comm_ring_1 ^ 'n::finite \<Rightarrow> 'a ^ 'm::finite"
11.2019 + assumes lf: "linear f" and u: "\<forall>x y. f' x \<bullet> y = x \<bullet> f y"
11.2020 + shows "f' = adjoint f"
11.2021 + apply (rule ext)
11.2022 + using u
11.2023 + by (simp add: vector_eq_rdot[symmetric] adjoint_clauses[OF lf])
11.2024 +
11.2025 +text{* Matrix notation. NB: an MxN matrix is of type @{typ "'a^'n^'m"}, not @{typ "'a^'m^'n"} *}
11.2026 +
11.2027 +consts generic_mult :: "'a \<Rightarrow> 'b \<Rightarrow> 'c" (infixr "\<star>" 75)
11.2028 +
11.2029 +defs (overloaded)
11.2030 +matrix_matrix_mult_def: "(m:: ('a::semiring_1) ^'n^'m) \<star> (m' :: 'a ^'p^'n) \<equiv> (\<chi> i j. setsum (\<lambda>k. ((m$i)$k) * ((m'$k)$j)) (UNIV :: 'n set)) ::'a ^ 'p ^'m"
11.2031 +
11.2032 +abbreviation
11.2033 + matrix_matrix_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'p^'n \<Rightarrow> 'a ^ 'p ^'m" (infixl "**" 70)
11.2034 + where "m ** m' == m\<star> m'"
11.2035 +
11.2036 +defs (overloaded)
11.2037 + matrix_vector_mult_def: "(m::('a::semiring_1) ^'n^'m) \<star> (x::'a ^'n) \<equiv> (\<chi> i. setsum (\<lambda>j. ((m$i)$j) * (x$j)) (UNIV ::'n set)) :: 'a^'m"
11.2038 +
11.2039 +abbreviation
11.2040 + matrix_vector_mult' :: "('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'm" (infixl "*v" 70)
11.2041 + where
11.2042 + "m *v v == m \<star> v"
11.2043 +
11.2044 +defs (overloaded)
11.2045 + vector_matrix_mult_def: "(x::'a^'m) \<star> (m::('a::semiring_1) ^'n^'m) \<equiv> (\<chi> j. setsum (\<lambda>i. ((m$i)$j) * (x$i)) (UNIV :: 'm set)) :: 'a^'n"
11.2046 +
11.2047 +abbreviation
11.2048 + vactor_matrix_mult' :: "'a ^ 'm \<Rightarrow> ('a::semiring_1) ^'n^'m \<Rightarrow> 'a ^'n " (infixl "v*" 70)
11.2049 + where
11.2050 + "v v* m == v \<star> m"
11.2051 +
11.2052 +definition "(mat::'a::zero => 'a ^'n^'n) k = (\<chi> i j. if i = j then k else 0)"
11.2053 +definition "(transp::'a^'n^'m \<Rightarrow> 'a^'m^'n) A = (\<chi> i j. ((A$j)$i))"
11.2054 +definition "(row::'m => 'a ^'n^'m \<Rightarrow> 'a ^'n) i A = (\<chi> j. ((A$i)$j))"
11.2055 +definition "(column::'n =>'a^'n^'m =>'a^'m) j A = (\<chi> i. ((A$i)$j))"
11.2056 +definition "rows(A::'a^'n^'m) = { row i A | i. i \<in> (UNIV :: 'm set)}"
11.2057 +definition "columns(A::'a^'n^'m) = { column i A | i. i \<in> (UNIV :: 'n set)}"
11.2058 +
11.2059 +lemma mat_0[simp]: "mat 0 = 0" by (vector mat_def)
11.2060 +lemma matrix_add_ldistrib: "(A ** (B + C)) = (A \<star> B) + (A \<star> C)"
11.2061 + by (vector matrix_matrix_mult_def setsum_addf[symmetric] ring_simps)
11.2062 +
11.2063 +lemma matrix_mul_lid:
11.2064 + fixes A :: "'a::semiring_1 ^ 'm ^ 'n::finite"
11.2065 + shows "mat 1 ** A = A"
11.2066 + apply (simp add: matrix_matrix_mult_def mat_def)
11.2067 + apply vector
11.2068 + by (auto simp only: cond_value_iff cond_application_beta setsum_delta'[OF finite] mult_1_left mult_zero_left if_True UNIV_I)
11.2069 +
11.2070 +
11.2071 +lemma matrix_mul_rid:
11.2072 + fixes A :: "'a::semiring_1 ^ 'm::finite ^ 'n"
11.2073 + shows "A ** mat 1 = A"
11.2074 + apply (simp add: matrix_matrix_mult_def mat_def)
11.2075 + apply vector
11.2076 + by (auto simp only: cond_value_iff cond_application_beta setsum_delta[OF finite] mult_1_right mult_zero_right if_True UNIV_I cong: if_cong)
11.2077 +
11.2078 +lemma matrix_mul_assoc: "A ** (B ** C) = (A ** B) ** C"
11.2079 + apply (vector matrix_matrix_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
11.2080 + apply (subst setsum_commute)
11.2081 + apply simp
11.2082 + done
11.2083 +
11.2084 +lemma matrix_vector_mul_assoc: "A *v (B *v x) = (A ** B) *v x"
11.2085 + apply (vector matrix_matrix_mult_def matrix_vector_mult_def setsum_right_distrib setsum_left_distrib mult_assoc)
11.2086 + apply (subst setsum_commute)
11.2087 + apply simp
11.2088 + done
11.2089 +
11.2090 +lemma matrix_vector_mul_lid: "mat 1 *v x = (x::'a::semiring_1 ^ 'n::finite)"
11.2091 + apply (vector matrix_vector_mult_def mat_def)
11.2092 + by (simp add: cond_value_iff cond_application_beta
11.2093 + setsum_delta' cong del: if_weak_cong)
11.2094 +
11.2095 +lemma matrix_transp_mul: "transp(A ** B) = transp B ** transp (A::'a::comm_semiring_1^'m^'n)"
11.2096 + by (simp add: matrix_matrix_mult_def transp_def Cart_eq mult_commute)
11.2097 +
11.2098 +lemma matrix_eq:
11.2099 + fixes A B :: "'a::semiring_1 ^ 'n::finite ^ 'm"
11.2100 + shows "A = B \<longleftrightarrow> (\<forall>x. A *v x = B *v x)" (is "?lhs \<longleftrightarrow> ?rhs")
11.2101 + apply auto
11.2102 + apply (subst Cart_eq)
11.2103 + apply clarify
11.2104 + apply (clarsimp simp add: matrix_vector_mult_def basis_def cond_value_iff cond_application_beta Cart_eq cong del: if_weak_cong)
11.2105 + apply (erule_tac x="basis ia" in allE)
11.2106 + apply (erule_tac x="i" in allE)
11.2107 + by (auto simp add: basis_def cond_value_iff cond_application_beta setsum_delta[OF finite] cong del: if_weak_cong)
11.2108 +
11.2109 +lemma matrix_vector_mul_component:
11.2110 + shows "((A::'a::semiring_1^'n'^'m) *v x)$k = (A$k) \<bullet> x"
11.2111 + by (simp add: matrix_vector_mult_def dot_def)
11.2112 +
11.2113 +lemma dot_lmul_matrix: "((x::'a::comm_semiring_1 ^'n) v* A) \<bullet> y = x \<bullet> (A *v y)"
11.2114 + apply (simp add: dot_def matrix_vector_mult_def vector_matrix_mult_def setsum_left_distrib setsum_right_distrib mult_ac)
11.2115 + apply (subst setsum_commute)
11.2116 + by simp
11.2117 +
11.2118 +lemma transp_mat: "transp (mat n) = mat n"
11.2119 + by (vector transp_def mat_def)
11.2120 +
11.2121 +lemma transp_transp: "transp(transp A) = A"
11.2122 + by (vector transp_def)
11.2123 +
11.2124 +lemma row_transp:
11.2125 + fixes A:: "'a::semiring_1^'n^'m"
11.2126 + shows "row i (transp A) = column i A"
11.2127 + by (simp add: row_def column_def transp_def Cart_eq)
11.2128 +
11.2129 +lemma column_transp:
11.2130 + fixes A:: "'a::semiring_1^'n^'m"
11.2131 + shows "column i (transp A) = row i A"
11.2132 + by (simp add: row_def column_def transp_def Cart_eq)
11.2133 +
11.2134 +lemma rows_transp: "rows(transp (A::'a::semiring_1^'n^'m)) = columns A"
11.2135 +by (auto simp add: rows_def columns_def row_transp intro: set_ext)
11.2136 +
11.2137 +lemma columns_transp: "columns(transp (A::'a::semiring_1^'n^'m)) = rows A" by (metis transp_transp rows_transp)
11.2138 +
11.2139 +text{* Two sometimes fruitful ways of looking at matrix-vector multiplication. *}
11.2140 +
11.2141 +lemma matrix_mult_dot: "A *v x = (\<chi> i. A$i \<bullet> x)"
11.2142 + by (simp add: matrix_vector_mult_def dot_def)
11.2143 +
11.2144 +lemma matrix_mult_vsum: "(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s column i A) (UNIV:: 'n set)"
11.2145 + by (simp add: matrix_vector_mult_def Cart_eq column_def mult_commute)
11.2146 +
11.2147 +lemma vector_componentwise:
11.2148 + "(x::'a::ring_1^'n::finite) = (\<chi> j. setsum (\<lambda>i. (x$i) * (basis i :: 'a^'n)$j) (UNIV :: 'n set))"
11.2149 + apply (subst basis_expansion[symmetric])
11.2150 + by (vector Cart_eq setsum_component)
11.2151 +
11.2152 +lemma linear_componentwise:
11.2153 + fixes f:: "'a::ring_1 ^ 'm::finite \<Rightarrow> 'a ^ 'n"
11.2154 + assumes lf: "linear f"
11.2155 + shows "(f x)$j = setsum (\<lambda>i. (x$i) * (f (basis i)$j)) (UNIV :: 'm set)" (is "?lhs = ?rhs")
11.2156 +proof-
11.2157 + let ?M = "(UNIV :: 'm set)"
11.2158 + let ?N = "(UNIV :: 'n set)"
11.2159 + have fM: "finite ?M" by simp
11.2160 + have "?rhs = (setsum (\<lambda>i.(x$i) *s f (basis i) ) ?M)$j"
11.2161 + unfolding vector_smult_component[symmetric]
11.2162 + unfolding setsum_component[of "(\<lambda>i.(x$i) *s f (basis i :: 'a^'m))" ?M]
11.2163 + ..
11.2164 + then show ?thesis unfolding linear_setsum_mul[OF lf fM, symmetric] basis_expansion ..
11.2165 +qed
11.2166 +
11.2167 +text{* Inverse matrices (not necessarily square) *}
11.2168 +
11.2169 +definition "invertible(A::'a::semiring_1^'n^'m) \<longleftrightarrow> (\<exists>A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
11.2170 +
11.2171 +definition "matrix_inv(A:: 'a::semiring_1^'n^'m) =
11.2172 + (SOME A'::'a^'m^'n. A ** A' = mat 1 \<and> A' ** A = mat 1)"
11.2173 +
11.2174 +text{* Correspondence between matrices and linear operators. *}
11.2175 +
11.2176 +definition matrix:: "('a::{plus,times, one, zero}^'m \<Rightarrow> 'a ^ 'n) \<Rightarrow> 'a^'m^'n"
11.2177 +where "matrix f = (\<chi> i j. (f(basis j))$i)"
11.2178 +
11.2179 +lemma matrix_vector_mul_linear: "linear(\<lambda>x. A *v (x::'a::comm_semiring_1 ^ 'n))"
11.2180 + by (simp add: linear_def matrix_vector_mult_def Cart_eq ring_simps setsum_right_distrib setsum_addf)
11.2181 +
11.2182 +lemma matrix_works: assumes lf: "linear f" shows "matrix f *v x = f (x::'a::comm_ring_1 ^ 'n::finite)"
11.2183 +apply (simp add: matrix_def matrix_vector_mult_def Cart_eq mult_commute)
11.2184 +apply clarify
11.2185 +apply (rule linear_componentwise[OF lf, symmetric])
11.2186 +done
11.2187 +
11.2188 +lemma matrix_vector_mul: "linear f ==> f = (\<lambda>x. matrix f *v (x::'a::comm_ring_1 ^ 'n::finite))" by (simp add: ext matrix_works)
11.2189 +
11.2190 +lemma matrix_of_matrix_vector_mul: "matrix(\<lambda>x. A *v (x :: 'a:: comm_ring_1 ^ 'n::finite)) = A"
11.2191 + by (simp add: matrix_eq matrix_vector_mul_linear matrix_works)
11.2192 +
11.2193 +lemma matrix_compose:
11.2194 + assumes lf: "linear (f::'a::comm_ring_1^'n::finite \<Rightarrow> 'a^'m::finite)"
11.2195 + and lg: "linear (g::'a::comm_ring_1^'m::finite \<Rightarrow> 'a^'k)"
11.2196 + shows "matrix (g o f) = matrix g ** matrix f"
11.2197 + using lf lg linear_compose[OF lf lg] matrix_works[OF linear_compose[OF lf lg]]
11.2198 + by (simp add: matrix_eq matrix_works matrix_vector_mul_assoc[symmetric] o_def)
11.2199 +
11.2200 +lemma matrix_vector_column:"(A::'a::comm_semiring_1^'n^'m) *v x = setsum (\<lambda>i. (x$i) *s ((transp A)$i)) (UNIV:: 'n set)"
11.2201 + by (simp add: matrix_vector_mult_def transp_def Cart_eq mult_commute)
11.2202 +
11.2203 +lemma adjoint_matrix: "adjoint(\<lambda>x. (A::'a::comm_ring_1^'n::finite^'m::finite) *v x) = (\<lambda>x. transp A *v x)"
11.2204 + apply (rule adjoint_unique[symmetric])
11.2205 + apply (rule matrix_vector_mul_linear)
11.2206 + apply (simp add: transp_def dot_def matrix_vector_mult_def setsum_left_distrib setsum_right_distrib)
11.2207 + apply (subst setsum_commute)
11.2208 + apply (auto simp add: mult_ac)
11.2209 + done
11.2210 +
11.2211 +lemma matrix_adjoint: assumes lf: "linear (f :: 'a::comm_ring_1^'n::finite \<Rightarrow> 'a ^ 'm::finite)"
11.2212 + shows "matrix(adjoint f) = transp(matrix f)"
11.2213 + apply (subst matrix_vector_mul[OF lf])
11.2214 + unfolding adjoint_matrix matrix_of_matrix_vector_mul ..
11.2215 +
11.2216 +subsection{* Interlude: Some properties of real sets *}
11.2217 +
11.2218 +lemma seq_mono_lemma: assumes "\<forall>(n::nat) \<ge> m. (d n :: real) < e n" and "\<forall>n \<ge> m. e n <= e m"
11.2219 + shows "\<forall>n \<ge> m. d n < e m"
11.2220 + using prems apply auto
11.2221 + apply (erule_tac x="n" in allE)
11.2222 + apply (erule_tac x="n" in allE)
11.2223 + apply auto
11.2224 + done
11.2225 +
11.2226 +
11.2227 +lemma real_convex_bound_lt:
11.2228 + assumes xa: "(x::real) < a" and ya: "y < a" and u: "0 <= u" and v: "0 <= v"
11.2229 + and uv: "u + v = 1"
11.2230 + shows "u * x + v * y < a"
11.2231 +proof-
11.2232 + have uv': "u = 0 \<longrightarrow> v \<noteq> 0" using u v uv by arith
11.2233 + have "a = a * (u + v)" unfolding uv by simp
11.2234 + hence th: "u * a + v * a = a" by (simp add: ring_simps)
11.2235 + from xa u have "u \<noteq> 0 \<Longrightarrow> u*x < u*a" by (simp add: mult_compare_simps)
11.2236 + from ya v have "v \<noteq> 0 \<Longrightarrow> v * y < v * a" by (simp add: mult_compare_simps)
11.2237 + from xa ya u v have "u * x + v * y < u * a + v * a"
11.2238 + apply (cases "u = 0", simp_all add: uv')
11.2239 + apply(rule mult_strict_left_mono)
11.2240 + using uv' apply simp_all
11.2241 +
11.2242 + apply (rule add_less_le_mono)
11.2243 + apply(rule mult_strict_left_mono)
11.2244 + apply simp_all
11.2245 + apply (rule mult_left_mono)
11.2246 + apply simp_all
11.2247 + done
11.2248 + thus ?thesis unfolding th .
11.2249 +qed
11.2250 +
11.2251 +lemma real_convex_bound_le:
11.2252 + assumes xa: "(x::real) \<le> a" and ya: "y \<le> a" and u: "0 <= u" and v: "0 <= v"
11.2253 + and uv: "u + v = 1"
11.2254 + shows "u * x + v * y \<le> a"
11.2255 +proof-
11.2256 + from xa ya u v have "u * x + v * y \<le> u * a + v * a" by (simp add: add_mono mult_left_mono)
11.2257 + also have "\<dots> \<le> (u + v) * a" by (simp add: ring_simps)
11.2258 + finally show ?thesis unfolding uv by simp
11.2259 +qed
11.2260 +
11.2261 +lemma infinite_enumerate: assumes fS: "infinite S"
11.2262 + shows "\<exists>r. subseq r \<and> (\<forall>n. r n \<in> S)"
11.2263 +unfolding subseq_def
11.2264 +using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto
11.2265 +
11.2266 +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)"
11.2267 +apply auto
11.2268 +apply (rule_tac x="d/2" in exI)
11.2269 +apply auto
11.2270 +done
11.2271 +
11.2272 +
11.2273 +lemma triangle_lemma:
11.2274 + assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x^2 <= y^2 + z^2"
11.2275 + shows "x <= y + z"
11.2276 +proof-
11.2277 + have "y^2 + z^2 \<le> y^2 + 2*y*z + z^2" using z y by (simp add: zero_compare_simps)
11.2278 + with xy have th: "x ^2 \<le> (y+z)^2" by (simp add: power2_eq_square ring_simps)
11.2279 + from y z have yz: "y + z \<ge> 0" by arith
11.2280 + from power2_le_imp_le[OF th yz] show ?thesis .
11.2281 +qed
11.2282 +
11.2283 +
11.2284 +lemma lambda_skolem: "(\<forall>i. \<exists>x. P i x) \<longleftrightarrow>
11.2285 + (\<exists>x::'a ^ 'n. \<forall>i. P i (x$i))" (is "?lhs \<longleftrightarrow> ?rhs")
11.2286 +proof-
11.2287 + let ?S = "(UNIV :: 'n set)"
11.2288 + {assume H: "?rhs"
11.2289 + then have ?lhs by auto}
11.2290 + moreover
11.2291 + {assume H: "?lhs"
11.2292 + then obtain f where f:"\<forall>i. P i (f i)" unfolding choice_iff by metis
11.2293 + let ?x = "(\<chi> i. (f i)) :: 'a ^ 'n"
11.2294 + {fix i
11.2295 + from f have "P i (f i)" by metis
11.2296 + then have "P i (?x$i)" by auto
11.2297 + }
11.2298 + hence "\<forall>i. P i (?x$i)" by metis
11.2299 + hence ?rhs by metis }
11.2300 + ultimately show ?thesis by metis
11.2301 +qed
11.2302 +
11.2303 +(* Supremum and infimum of real sets *)
11.2304 +
11.2305 +
11.2306 +definition rsup:: "real set \<Rightarrow> real" where
11.2307 + "rsup S = (SOME a. isLub UNIV S a)"
11.2308 +
11.2309 +lemma rsup_alt: "rsup S = (SOME a. (\<forall>x \<in> S. x \<le> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<le> b) \<longrightarrow> a \<le> b))" by (auto simp add: isLub_def rsup_def leastP_def isUb_def setle_def setge_def)
11.2310 +
11.2311 +lemma rsup: assumes Se: "S \<noteq> {}" and b: "\<exists>b. S *<= b"
11.2312 + shows "isLub UNIV S (rsup S)"
11.2313 +using Se b
11.2314 +unfolding rsup_def
11.2315 +apply clarify
11.2316 +apply (rule someI_ex)
11.2317 +apply (rule reals_complete)
11.2318 +by (auto simp add: isUb_def setle_def)
11.2319 +
11.2320 +lemma rsup_le: assumes Se: "S \<noteq> {}" and Sb: "S *<= b" shows "rsup S \<le> b"
11.2321 +proof-
11.2322 + from Sb have bu: "isUb UNIV S b" by (simp add: isUb_def setle_def)
11.2323 + from rsup[OF Se] Sb have "isLub UNIV S (rsup S)" by blast
11.2324 + then show ?thesis using bu by (auto simp add: isLub_def leastP_def setle_def setge_def)
11.2325 +qed
11.2326 +
11.2327 +lemma rsup_finite_Max: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2328 + shows "rsup S = Max S"
11.2329 +using fS Se
11.2330 +proof-
11.2331 + let ?m = "Max S"
11.2332 + from Max_ge[OF fS] have Sm: "\<forall> x\<in> S. x \<le> ?m" by metis
11.2333 + with rsup[OF Se] have lub: "isLub UNIV S (rsup S)" by (metis setle_def)
11.2334 + from Max_in[OF fS Se] lub have mrS: "?m \<le> rsup S"
11.2335 + by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def)
11.2336 + moreover
11.2337 + have "rsup S \<le> ?m" using Sm lub
11.2338 + by (auto simp add: isLub_def leastP_def isUb_def setle_def setge_def)
11.2339 + ultimately show ?thesis by arith
11.2340 +qed
11.2341 +
11.2342 +lemma rsup_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2343 + shows "rsup S \<in> S"
11.2344 + using rsup_finite_Max[OF fS Se] Max_in[OF fS Se] by metis
11.2345 +
11.2346 +lemma rsup_finite_Ub: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2347 + shows "isUb S S (rsup S)"
11.2348 + using rsup_finite_Max[OF fS Se] rsup_finite_in[OF fS Se] Max_ge[OF fS]
11.2349 + unfolding isUb_def setle_def by metis
11.2350 +
11.2351 +lemma rsup_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2352 + shows "a \<le> rsup S \<longleftrightarrow> (\<exists> x \<in> S. a \<le> x)"
11.2353 +using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
11.2354 +
11.2355 +lemma rsup_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2356 + shows "a \<ge> rsup S \<longleftrightarrow> (\<forall> x \<in> S. a \<ge> x)"
11.2357 +using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
11.2358 +
11.2359 +lemma rsup_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2360 + shows "a < rsup S \<longleftrightarrow> (\<exists> x \<in> S. a < x)"
11.2361 +using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
11.2362 +
11.2363 +lemma rsup_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2364 + shows "a > rsup S \<longleftrightarrow> (\<forall> x \<in> S. a > x)"
11.2365 +using rsup_finite_Ub[OF fS Se] by (auto simp add: isUb_def setle_def)
11.2366 +
11.2367 +lemma rsup_unique: assumes b: "S *<= b" and S: "\<forall>b' < b. \<exists>x \<in> S. b' < x"
11.2368 + shows "rsup S = b"
11.2369 +using b S
11.2370 +unfolding setle_def rsup_alt
11.2371 +apply -
11.2372 +apply (rule some_equality)
11.2373 +apply (metis linorder_not_le order_eq_iff[symmetric])+
11.2374 +done
11.2375 +
11.2376 +lemma rsup_le_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. T *<= b) \<Longrightarrow> rsup S \<le> rsup T"
11.2377 + apply (rule rsup_le)
11.2378 + apply simp
11.2379 + using rsup[of T] by (auto simp add: isLub_def leastP_def setge_def setle_def isUb_def)
11.2380 +
11.2381 +lemma isUb_def': "isUb R S = (\<lambda>x. S *<= x \<and> x \<in> R)"
11.2382 + apply (rule ext)
11.2383 + by (metis isUb_def)
11.2384 +
11.2385 +lemma UNIV_trivial: "UNIV x" using UNIV_I[of x] by (metis mem_def)
11.2386 +lemma rsup_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
11.2387 + shows "a \<le> rsup S \<and> rsup S \<le> b"
11.2388 +proof-
11.2389 + from rsup[OF Se] u have lub: "isLub UNIV S (rsup S)" by blast
11.2390 + hence b: "rsup S \<le> b" using u by (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
11.2391 + from Se obtain y where y: "y \<in> S" by blast
11.2392 + from lub l have "a \<le> rsup S" apply (auto simp add: isLub_def leastP_def setle_def setge_def isUb_def')
11.2393 + apply (erule ballE[where x=y])
11.2394 + apply (erule ballE[where x=y])
11.2395 + apply arith
11.2396 + using y apply auto
11.2397 + done
11.2398 + with b show ?thesis by blast
11.2399 +qed
11.2400 +
11.2401 +lemma rsup_abs_le: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rsup S\<bar> \<le> a"
11.2402 + unfolding abs_le_interval_iff using rsup_bounds[of S "-a" a]
11.2403 + by (auto simp add: setge_def setle_def)
11.2404 +
11.2405 +lemma rsup_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rsup S - l\<bar> \<le> e"
11.2406 +proof-
11.2407 + have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith
11.2408 + show ?thesis using S b rsup_bounds[of S "l - e" "l+e"] unfolding th
11.2409 + by (auto simp add: setge_def setle_def)
11.2410 +qed
11.2411 +
11.2412 +definition rinf:: "real set \<Rightarrow> real" where
11.2413 + "rinf S = (SOME a. isGlb UNIV S a)"
11.2414 +
11.2415 +lemma rinf_alt: "rinf S = (SOME a. (\<forall>x \<in> S. x \<ge> a) \<and> (\<forall>b. (\<forall>x \<in> S. x \<ge> b) \<longrightarrow> a \<ge> b))" by (auto simp add: isGlb_def rinf_def greatestP_def isLb_def setle_def setge_def)
11.2416 +
11.2417 +lemma reals_complete_Glb: assumes Se: "\<exists>x. x \<in> S" and lb: "\<exists> y. isLb UNIV S y"
11.2418 + shows "\<exists>(t::real). isGlb UNIV S t"
11.2419 +proof-
11.2420 + let ?M = "uminus ` S"
11.2421 + from lb have th: "\<exists>y. isUb UNIV ?M y" apply (auto simp add: isUb_def isLb_def setle_def setge_def)
11.2422 + by (rule_tac x="-y" in exI, auto)
11.2423 + from Se have Me: "\<exists>x. x \<in> ?M" by blast
11.2424 + from reals_complete[OF Me th] obtain t where t: "isLub UNIV ?M t" by blast
11.2425 + have "isGlb UNIV S (- t)" using t
11.2426 + apply (auto simp add: isLub_def isGlb_def leastP_def greatestP_def setle_def setge_def isUb_def isLb_def)
11.2427 + apply (erule_tac x="-y" in allE)
11.2428 + apply auto
11.2429 + done
11.2430 + then show ?thesis by metis
11.2431 +qed
11.2432 +
11.2433 +lemma rinf: assumes Se: "S \<noteq> {}" and b: "\<exists>b. b <=* S"
11.2434 + shows "isGlb UNIV S (rinf S)"
11.2435 +using Se b
11.2436 +unfolding rinf_def
11.2437 +apply clarify
11.2438 +apply (rule someI_ex)
11.2439 +apply (rule reals_complete_Glb)
11.2440 +apply (auto simp add: isLb_def setle_def setge_def)
11.2441 +done
11.2442 +
11.2443 +lemma rinf_ge: assumes Se: "S \<noteq> {}" and Sb: "b <=* S" shows "rinf S \<ge> b"
11.2444 +proof-
11.2445 + from Sb have bu: "isLb UNIV S b" by (simp add: isLb_def setge_def)
11.2446 + from rinf[OF Se] Sb have "isGlb UNIV S (rinf S)" by blast
11.2447 + then show ?thesis using bu by (auto simp add: isGlb_def greatestP_def setle_def setge_def)
11.2448 +qed
11.2449 +
11.2450 +lemma rinf_finite_Min: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2451 + shows "rinf S = Min S"
11.2452 +using fS Se
11.2453 +proof-
11.2454 + let ?m = "Min S"
11.2455 + from Min_le[OF fS] have Sm: "\<forall> x\<in> S. x \<ge> ?m" by metis
11.2456 + with rinf[OF Se] have glb: "isGlb UNIV S (rinf S)" by (metis setge_def)
11.2457 + from Min_in[OF fS Se] glb have mrS: "?m \<ge> rinf S"
11.2458 + by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def)
11.2459 + moreover
11.2460 + have "rinf S \<ge> ?m" using Sm glb
11.2461 + by (auto simp add: isGlb_def greatestP_def isLb_def setle_def setge_def)
11.2462 + ultimately show ?thesis by arith
11.2463 +qed
11.2464 +
11.2465 +lemma rinf_finite_in: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2466 + shows "rinf S \<in> S"
11.2467 + using rinf_finite_Min[OF fS Se] Min_in[OF fS Se] by metis
11.2468 +
11.2469 +lemma rinf_finite_Lb: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2470 + shows "isLb S S (rinf S)"
11.2471 + using rinf_finite_Min[OF fS Se] rinf_finite_in[OF fS Se] Min_le[OF fS]
11.2472 + unfolding isLb_def setge_def by metis
11.2473 +
11.2474 +lemma rinf_finite_ge_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2475 + shows "a \<le> rinf S \<longleftrightarrow> (\<forall> x \<in> S. a \<le> x)"
11.2476 +using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
11.2477 +
11.2478 +lemma rinf_finite_le_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2479 + shows "a \<ge> rinf S \<longleftrightarrow> (\<exists> x \<in> S. a \<ge> x)"
11.2480 +using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
11.2481 +
11.2482 +lemma rinf_finite_gt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2483 + shows "a < rinf S \<longleftrightarrow> (\<forall> x \<in> S. a < x)"
11.2484 +using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
11.2485 +
11.2486 +lemma rinf_finite_lt_iff: assumes fS: "finite S" and Se: "S \<noteq> {}"
11.2487 + shows "a > rinf S \<longleftrightarrow> (\<exists> x \<in> S. a > x)"
11.2488 +using rinf_finite_Lb[OF fS Se] by (auto simp add: isLb_def setge_def)
11.2489 +
11.2490 +lemma rinf_unique: assumes b: "b <=* S" and S: "\<forall>b' > b. \<exists>x \<in> S. b' > x"
11.2491 + shows "rinf S = b"
11.2492 +using b S
11.2493 +unfolding setge_def rinf_alt
11.2494 +apply -
11.2495 +apply (rule some_equality)
11.2496 +apply (metis linorder_not_le order_eq_iff[symmetric])+
11.2497 +done
11.2498 +
11.2499 +lemma rinf_ge_subset: "S\<noteq>{} \<Longrightarrow> S \<subseteq> T \<Longrightarrow> (\<exists>b. b <=* T) \<Longrightarrow> rinf S >= rinf T"
11.2500 + apply (rule rinf_ge)
11.2501 + apply simp
11.2502 + using rinf[of T] by (auto simp add: isGlb_def greatestP_def setge_def setle_def isLb_def)
11.2503 +
11.2504 +lemma isLb_def': "isLb R S = (\<lambda>x. x <=* S \<and> x \<in> R)"
11.2505 + apply (rule ext)
11.2506 + by (metis isLb_def)
11.2507 +
11.2508 +lemma rinf_bounds: assumes Se: "S \<noteq> {}" and l: "a <=* S" and u: "S *<= b"
11.2509 + shows "a \<le> rinf S \<and> rinf S \<le> b"
11.2510 +proof-
11.2511 + from rinf[OF Se] l have lub: "isGlb UNIV S (rinf S)" by blast
11.2512 + hence b: "a \<le> rinf S" using l by (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
11.2513 + from Se obtain y where y: "y \<in> S" by blast
11.2514 + from lub u have "b \<ge> rinf S" apply (auto simp add: isGlb_def greatestP_def setle_def setge_def isLb_def')
11.2515 + apply (erule ballE[where x=y])
11.2516 + apply (erule ballE[where x=y])
11.2517 + apply arith
11.2518 + using y apply auto
11.2519 + done
11.2520 + with b show ?thesis by blast
11.2521 +qed
11.2522 +
11.2523 +lemma rinf_abs_ge: "S \<noteq> {} \<Longrightarrow> (\<forall>x\<in>S. \<bar>x\<bar> \<le> a) \<Longrightarrow> \<bar>rinf S\<bar> \<le> a"
11.2524 + unfolding abs_le_interval_iff using rinf_bounds[of S "-a" a]
11.2525 + by (auto simp add: setge_def setle_def)
11.2526 +
11.2527 +lemma rinf_asclose: assumes S:"S \<noteq> {}" and b: "\<forall>x\<in>S. \<bar>x - l\<bar> \<le> e" shows "\<bar>rinf S - l\<bar> \<le> e"
11.2528 +proof-
11.2529 + have th: "\<And>(x::real) l e. \<bar>x - l\<bar> \<le> e \<longleftrightarrow> l - e \<le> x \<and> x \<le> l + e" by arith
11.2530 + show ?thesis using S b rinf_bounds[of S "l - e" "l+e"] unfolding th
11.2531 + by (auto simp add: setge_def setle_def)
11.2532 +qed
11.2533 +
11.2534 +
11.2535 +
11.2536 +subsection{* Operator norm. *}
11.2537 +
11.2538 +definition "onorm f = rsup {norm (f x)| x. norm x = 1}"
11.2539 +
11.2540 +lemma norm_bound_generalize:
11.2541 + fixes f:: "real ^'n::finite \<Rightarrow> real^'m::finite"
11.2542 + assumes lf: "linear f"
11.2543 + shows "(\<forall>x. norm x = 1 \<longrightarrow> norm (f x) \<le> b) \<longleftrightarrow> (\<forall>x. norm (f x) \<le> b * norm x)" (is "?lhs \<longleftrightarrow> ?rhs")
11.2544 +proof-
11.2545 + {assume H: ?rhs
11.2546 + {fix x :: "real^'n" assume x: "norm x = 1"
11.2547 + from H[rule_format, of x] x have "norm (f x) \<le> b" by simp}
11.2548 + then have ?lhs by blast }
11.2549 +
11.2550 + moreover
11.2551 + {assume H: ?lhs
11.2552 + from H[rule_format, of "basis arbitrary"]
11.2553 + have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis arbitrary)"]
11.2554 + by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
11.2555 + {fix x :: "real ^'n"
11.2556 + {assume "x = 0"
11.2557 + then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
11.2558 + moreover
11.2559 + {assume x0: "x \<noteq> 0"
11.2560 + hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
11.2561 + let ?c = "1/ norm x"
11.2562 + have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
11.2563 + with H have "norm (f(?c*s x)) \<le> b" by blast
11.2564 + hence "?c * norm (f x) \<le> b"
11.2565 + by (simp add: linear_cmul[OF lf] norm_mul)
11.2566 + hence "norm (f x) \<le> b * norm x"
11.2567 + using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
11.2568 + ultimately have "norm (f x) \<le> b * norm x" by blast}
11.2569 + then have ?rhs by blast}
11.2570 + ultimately show ?thesis by blast
11.2571 +qed
11.2572 +
11.2573 +lemma onorm:
11.2574 + fixes f:: "real ^'n::finite \<Rightarrow> real ^'m::finite"
11.2575 + assumes lf: "linear f"
11.2576 + shows "norm (f x) <= onorm f * norm x"
11.2577 + and "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
11.2578 +proof-
11.2579 + {
11.2580 + let ?S = "{norm (f x) |x. norm x = 1}"
11.2581 + have Se: "?S \<noteq> {}" using norm_basis by auto
11.2582 + from linear_bounded[OF lf] have b: "\<exists> b. ?S *<= b"
11.2583 + unfolding norm_bound_generalize[OF lf, symmetric] by (auto simp add: setle_def)
11.2584 + {from rsup[OF Se b, unfolded onorm_def[symmetric]]
11.2585 + show "norm (f x) <= onorm f * norm x"
11.2586 + apply -
11.2587 + apply (rule spec[where x = x])
11.2588 + unfolding norm_bound_generalize[OF lf, symmetric]
11.2589 + by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
11.2590 + {
11.2591 + show "\<forall>x. norm (f x) <= b * norm x \<Longrightarrow> onorm f <= b"
11.2592 + using rsup[OF Se b, unfolded onorm_def[symmetric]]
11.2593 + unfolding norm_bound_generalize[OF lf, symmetric]
11.2594 + by (auto simp add: isLub_def isUb_def leastP_def setge_def setle_def)}
11.2595 + }
11.2596 +qed
11.2597 +
11.2598 +lemma onorm_pos_le: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" shows "0 <= onorm f"
11.2599 + using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis arbitrary"], unfolded norm_basis] by simp
11.2600 +
11.2601 +lemma onorm_eq_0: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
11.2602 + shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
11.2603 + using onorm[OF lf]
11.2604 + apply (auto simp add: onorm_pos_le)
11.2605 + apply atomize
11.2606 + apply (erule allE[where x="0::real"])
11.2607 + using onorm_pos_le[OF lf]
11.2608 + apply arith
11.2609 + done
11.2610 +
11.2611 +lemma onorm_const: "onorm(\<lambda>x::real^'n::finite. (y::real ^ 'm::finite)) = norm y"
11.2612 +proof-
11.2613 + let ?f = "\<lambda>x::real^'n. (y::real ^ 'm)"
11.2614 + have th: "{norm (?f x)| x. norm x = 1} = {norm y}"
11.2615 + by(auto intro: vector_choose_size set_ext)
11.2616 + show ?thesis
11.2617 + unfolding onorm_def th
11.2618 + apply (rule rsup_unique) by (simp_all add: setle_def)
11.2619 +qed
11.2620 +
11.2621 +lemma onorm_pos_lt: assumes lf: "linear (f::real ^ 'n::finite \<Rightarrow> real ^'m::finite)"
11.2622 + shows "0 < onorm f \<longleftrightarrow> ~(\<forall>x. f x = 0)"
11.2623 + unfolding onorm_eq_0[OF lf, symmetric]
11.2624 + using onorm_pos_le[OF lf] by arith
11.2625 +
11.2626 +lemma onorm_compose:
11.2627 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)"
11.2628 + and lg: "linear (g::real^'k::finite \<Rightarrow> real^'n::finite)"
11.2629 + shows "onorm (f o g) <= onorm f * onorm g"
11.2630 + apply (rule onorm(2)[OF linear_compose[OF lg lf], rule_format])
11.2631 + unfolding o_def
11.2632 + apply (subst mult_assoc)
11.2633 + apply (rule order_trans)
11.2634 + apply (rule onorm(1)[OF lf])
11.2635 + apply (rule mult_mono1)
11.2636 + apply (rule onorm(1)[OF lg])
11.2637 + apply (rule onorm_pos_le[OF lf])
11.2638 + done
11.2639 +
11.2640 +lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
11.2641 + shows "onorm (\<lambda>x. - f x) \<le> onorm f"
11.2642 + using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
11.2643 + unfolding norm_minus_cancel by metis
11.2644 +
11.2645 +lemma onorm_neg: assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real^'m::finite)"
11.2646 + shows "onorm (\<lambda>x. - f x) = onorm f"
11.2647 + using onorm_neg_lemma[OF lf] onorm_neg_lemma[OF linear_compose_neg[OF lf]]
11.2648 + by simp
11.2649 +
11.2650 +lemma onorm_triangle:
11.2651 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and lg: "linear g"
11.2652 + shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
11.2653 + apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
11.2654 + apply (rule order_trans)
11.2655 + apply (rule norm_triangle_ineq)
11.2656 + apply (simp add: distrib)
11.2657 + apply (rule add_mono)
11.2658 + apply (rule onorm(1)[OF lf])
11.2659 + apply (rule onorm(1)[OF lg])
11.2660 + done
11.2661 +
11.2662 +lemma onorm_triangle_le: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) <= e
11.2663 + \<Longrightarrow> onorm(\<lambda>x. f x + g x) <= e"
11.2664 + apply (rule order_trans)
11.2665 + apply (rule onorm_triangle)
11.2666 + apply assumption+
11.2667 + done
11.2668 +
11.2669 +lemma onorm_triangle_lt: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite) \<Longrightarrow> linear g \<Longrightarrow> onorm(f) + onorm(g) < e
11.2670 + ==> onorm(\<lambda>x. f x + g x) < e"
11.2671 + apply (rule order_le_less_trans)
11.2672 + apply (rule onorm_triangle)
11.2673 + by assumption+
11.2674 +
11.2675 +(* "lift" from 'a to 'a^1 and "drop" from 'a^1 to 'a -- FIXME: potential use of transfer *)
11.2676 +
11.2677 +definition vec1:: "'a \<Rightarrow> 'a ^ 1" where "vec1 x = (\<chi> i. x)"
11.2678 +
11.2679 +definition dest_vec1:: "'a ^1 \<Rightarrow> 'a"
11.2680 + where "dest_vec1 x = (x$1)"
11.2681 +
11.2682 +lemma vec1_component[simp]: "(vec1 x)$1 = x"
11.2683 + by (simp add: vec1_def)
11.2684 +
11.2685 +lemma vec1_dest_vec1[simp]: "vec1(dest_vec1 x) = x" "dest_vec1(vec1 y) = y"
11.2686 + by (simp_all add: vec1_def dest_vec1_def Cart_eq forall_1)
11.2687 +
11.2688 +lemma forall_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P (vec1 x))" by (metis vec1_dest_vec1)
11.2689 +
11.2690 +lemma exists_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(vec1 x))" by (metis vec1_dest_vec1)
11.2691 +
11.2692 +lemma forall_dest_vec1: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x. P(dest_vec1 x))" by (metis vec1_dest_vec1)
11.2693 +
11.2694 +lemma exists_dest_vec1: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. P(dest_vec1 x))"by (metis vec1_dest_vec1)
11.2695 +
11.2696 +lemma vec1_eq[simp]: "vec1 x = vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
11.2697 +
11.2698 +lemma dest_vec1_eq[simp]: "dest_vec1 x = dest_vec1 y \<longleftrightarrow> x = y" by (metis vec1_dest_vec1)
11.2699 +
11.2700 +lemma vec1_in_image_vec1: "vec1 x \<in> (vec1 ` S) \<longleftrightarrow> x \<in> S" by auto
11.2701 +
11.2702 +lemma vec1_vec: "vec1 x = vec x" by (vector vec1_def)
11.2703 +
11.2704 +lemma vec1_add: "vec1(x + y) = vec1 x + vec1 y" by (vector vec1_def)
11.2705 +lemma vec1_sub: "vec1(x - y) = vec1 x - vec1 y" by (vector vec1_def)
11.2706 +lemma vec1_cmul: "vec1(c* x) = c *s vec1 x " by (vector vec1_def)
11.2707 +lemma vec1_neg: "vec1(- x) = - vec1 x " by (vector vec1_def)
11.2708 +
11.2709 +lemma vec1_setsum: assumes fS: "finite S"
11.2710 + shows "vec1(setsum f S) = setsum (vec1 o f) S"
11.2711 + apply (induct rule: finite_induct[OF fS])
11.2712 + apply (simp add: vec1_vec)
11.2713 + apply (auto simp add: vec1_add)
11.2714 + done
11.2715 +
11.2716 +lemma dest_vec1_lambda: "dest_vec1(\<chi> i. x i) = x 1"
11.2717 + by (simp add: dest_vec1_def)
11.2718 +
11.2719 +lemma dest_vec1_vec: "dest_vec1(vec x) = x"
11.2720 + by (simp add: vec1_vec[symmetric])
11.2721 +
11.2722 +lemma dest_vec1_add: "dest_vec1(x + y) = dest_vec1 x + dest_vec1 y"
11.2723 + by (metis vec1_dest_vec1 vec1_add)
11.2724 +
11.2725 +lemma dest_vec1_sub: "dest_vec1(x - y) = dest_vec1 x - dest_vec1 y"
11.2726 + by (metis vec1_dest_vec1 vec1_sub)
11.2727 +
11.2728 +lemma dest_vec1_cmul: "dest_vec1(c*sx) = c * dest_vec1 x"
11.2729 + by (metis vec1_dest_vec1 vec1_cmul)
11.2730 +
11.2731 +lemma dest_vec1_neg: "dest_vec1(- x) = - dest_vec1 x"
11.2732 + by (metis vec1_dest_vec1 vec1_neg)
11.2733 +
11.2734 +lemma dest_vec1_0[simp]: "dest_vec1 0 = 0" by (metis vec_0 dest_vec1_vec)
11.2735 +
11.2736 +lemma dest_vec1_sum: assumes fS: "finite S"
11.2737 + shows "dest_vec1(setsum f S) = setsum (dest_vec1 o f) S"
11.2738 + apply (induct rule: finite_induct[OF fS])
11.2739 + apply (simp add: dest_vec1_vec)
11.2740 + apply (auto simp add: dest_vec1_add)
11.2741 + done
11.2742 +
11.2743 +lemma norm_vec1: "norm(vec1 x) = abs(x)"
11.2744 + by (simp add: vec1_def norm_real)
11.2745 +
11.2746 +lemma dist_vec1: "dist(vec1 x) (vec1 y) = abs(x - y)"
11.2747 + by (simp only: dist_real vec1_component)
11.2748 +lemma abs_dest_vec1: "norm x = \<bar>dest_vec1 x\<bar>"
11.2749 + by (metis vec1_dest_vec1 norm_vec1)
11.2750 +
11.2751 +lemma linear_vmul_dest_vec1:
11.2752 + fixes f:: "'a::semiring_1^'n \<Rightarrow> 'a^1"
11.2753 + shows "linear f \<Longrightarrow> linear (\<lambda>x. dest_vec1(f x) *s v)"
11.2754 + unfolding dest_vec1_def
11.2755 + apply (rule linear_vmul_component)
11.2756 + by auto
11.2757 +
11.2758 +lemma linear_from_scalars:
11.2759 + assumes lf: "linear (f::'a::comm_ring_1 ^1 \<Rightarrow> 'a^'n)"
11.2760 + shows "f = (\<lambda>x. dest_vec1 x *s column 1 (matrix f))"
11.2761 + apply (rule ext)
11.2762 + apply (subst matrix_works[OF lf, symmetric])
11.2763 + apply (auto simp add: Cart_eq matrix_vector_mult_def dest_vec1_def column_def mult_commute UNIV_1)
11.2764 + done
11.2765 +
11.2766 +lemma linear_to_scalars: assumes lf: "linear (f::'a::comm_ring_1 ^'n::finite \<Rightarrow> 'a^1)"
11.2767 + shows "f = (\<lambda>x. vec1(row 1 (matrix f) \<bullet> x))"
11.2768 + apply (rule ext)
11.2769 + apply (subst matrix_works[OF lf, symmetric])
11.2770 + apply (simp add: Cart_eq matrix_vector_mult_def vec1_def row_def dot_def mult_commute forall_1)
11.2771 + done
11.2772 +
11.2773 +lemma dest_vec1_eq_0: "dest_vec1 x = 0 \<longleftrightarrow> x = 0"
11.2774 + by (simp add: dest_vec1_eq[symmetric])
11.2775 +
11.2776 +lemma setsum_scalars: assumes fS: "finite S"
11.2777 + shows "setsum f S = vec1 (setsum (dest_vec1 o f) S)"
11.2778 + unfolding vec1_setsum[OF fS] by simp
11.2779 +
11.2780 +lemma dest_vec1_wlog_le: "(\<And>(x::'a::linorder ^ 1) y. P x y \<longleftrightarrow> P y x) \<Longrightarrow> (\<And>x y. dest_vec1 x <= dest_vec1 y ==> P x y) \<Longrightarrow> P x y"
11.2781 + apply (cases "dest_vec1 x \<le> dest_vec1 y")
11.2782 + apply simp
11.2783 + apply (subgoal_tac "dest_vec1 y \<le> dest_vec1 x")
11.2784 + apply (auto)
11.2785 + done
11.2786 +
11.2787 +text{* Pasting vectors. *}
11.2788 +
11.2789 +lemma linear_fstcart: "linear fstcart"
11.2790 + by (auto simp add: linear_def Cart_eq)
11.2791 +
11.2792 +lemma linear_sndcart: "linear sndcart"
11.2793 + by (auto simp add: linear_def Cart_eq)
11.2794 +
11.2795 +lemma fstcart_vec[simp]: "fstcart(vec x) = vec x"
11.2796 + by (simp add: Cart_eq)
11.2797 +
11.2798 +lemma fstcart_add[simp]:"fstcart(x + y) = fstcart (x::'a::{plus,times}^('b + 'c)) + fstcart y"
11.2799 + by (simp add: Cart_eq)
11.2800 +
11.2801 +lemma fstcart_cmul[simp]:"fstcart(c*s x) = c*s fstcart (x::'a::{plus,times}^('b + 'c))"
11.2802 + by (simp add: Cart_eq)
11.2803 +
11.2804 +lemma fstcart_neg[simp]:"fstcart(- x) = - fstcart (x::'a::ring_1^('b + 'c))"
11.2805 + by (simp add: Cart_eq)
11.2806 +
11.2807 +lemma fstcart_sub[simp]:"fstcart(x - y) = fstcart (x::'a::ring_1^('b + 'c)) - fstcart y"
11.2808 + by (simp add: Cart_eq)
11.2809 +
11.2810 +lemma fstcart_setsum:
11.2811 + fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
11.2812 + assumes fS: "finite S"
11.2813 + shows "fstcart (setsum f S) = setsum (\<lambda>i. fstcart (f i)) S"
11.2814 + by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
11.2815 +
11.2816 +lemma sndcart_vec[simp]: "sndcart(vec x) = vec x"
11.2817 + by (simp add: Cart_eq)
11.2818 +
11.2819 +lemma sndcart_add[simp]:"sndcart(x + y) = sndcart (x::'a::{plus,times}^('b + 'c)) + sndcart y"
11.2820 + by (simp add: Cart_eq)
11.2821 +
11.2822 +lemma sndcart_cmul[simp]:"sndcart(c*s x) = c*s sndcart (x::'a::{plus,times}^('b + 'c))"
11.2823 + by (simp add: Cart_eq)
11.2824 +
11.2825 +lemma sndcart_neg[simp]:"sndcart(- x) = - sndcart (x::'a::ring_1^('b + 'c))"
11.2826 + by (simp add: Cart_eq)
11.2827 +
11.2828 +lemma sndcart_sub[simp]:"sndcart(x - y) = sndcart (x::'a::ring_1^('b + 'c)) - sndcart y"
11.2829 + by (simp add: Cart_eq)
11.2830 +
11.2831 +lemma sndcart_setsum:
11.2832 + fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
11.2833 + assumes fS: "finite S"
11.2834 + shows "sndcart (setsum f S) = setsum (\<lambda>i. sndcart (f i)) S"
11.2835 + by (induct rule: finite_induct[OF fS], simp_all add: vec_0[symmetric] del: vec_0)
11.2836 +
11.2837 +lemma pastecart_vec[simp]: "pastecart (vec x) (vec x) = vec x"
11.2838 + by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
11.2839 +
11.2840 +lemma pastecart_add[simp]:"pastecart (x1::'a::{plus,times}^_) y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)"
11.2841 + by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
11.2842 +
11.2843 +lemma pastecart_cmul[simp]: "pastecart (c *s (x1::'a::{plus,times}^_)) (c *s y1) = c *s pastecart x1 y1"
11.2844 + by (simp add: pastecart_eq fstcart_pastecart sndcart_pastecart)
11.2845 +
11.2846 +lemma pastecart_neg[simp]: "pastecart (- (x::'a::ring_1^_)) (- y) = - pastecart x y"
11.2847 + unfolding vector_sneg_minus1 pastecart_cmul ..
11.2848 +
11.2849 +lemma pastecart_sub: "pastecart (x1::'a::ring_1^_) y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)"
11.2850 + by (simp add: diff_def pastecart_neg[symmetric] del: pastecart_neg)
11.2851 +
11.2852 +lemma pastecart_setsum:
11.2853 + fixes f:: "'d \<Rightarrow> 'a::semiring_1^_"
11.2854 + assumes fS: "finite S"
11.2855 + shows "pastecart (setsum f S) (setsum g S) = setsum (\<lambda>i. pastecart (f i) (g i)) S"
11.2856 + by (simp add: pastecart_eq fstcart_setsum[OF fS] sndcart_setsum[OF fS] fstcart_pastecart sndcart_pastecart)
11.2857 +
11.2858 +lemma setsum_Plus:
11.2859 + "\<lbrakk>finite A; finite B\<rbrakk> \<Longrightarrow>
11.2860 + (\<Sum>x\<in>A <+> B. g x) = (\<Sum>x\<in>A. g (Inl x)) + (\<Sum>x\<in>B. g (Inr x))"
11.2861 + unfolding Plus_def
11.2862 + by (subst setsum_Un_disjoint, auto simp add: setsum_reindex)
11.2863 +
11.2864 +lemma setsum_UNIV_sum:
11.2865 + fixes g :: "'a::finite + 'b::finite \<Rightarrow> _"
11.2866 + shows "(\<Sum>x\<in>UNIV. g x) = (\<Sum>x\<in>UNIV. g (Inl x)) + (\<Sum>x\<in>UNIV. g (Inr x))"
11.2867 + apply (subst UNIV_Plus_UNIV [symmetric])
11.2868 + apply (rule setsum_Plus [OF finite finite])
11.2869 + done
11.2870 +
11.2871 +lemma norm_fstcart: "norm(fstcart x) <= norm (x::real ^('n::finite + 'm::finite))"
11.2872 +proof-
11.2873 + have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
11.2874 + by (simp add: pastecart_fst_snd)
11.2875 + have th1: "fstcart x \<bullet> fstcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
11.2876 + by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
11.2877 + then show ?thesis
11.2878 + unfolding th0
11.2879 + unfolding real_vector_norm_def real_sqrt_le_iff id_def
11.2880 + by (simp add: dot_def)
11.2881 +qed
11.2882 +
11.2883 +lemma dist_fstcart: "dist(fstcart (x::real^_)) (fstcart y) <= dist x y"
11.2884 + unfolding dist_norm by (metis fstcart_sub[symmetric] norm_fstcart)
11.2885 +
11.2886 +lemma norm_sndcart: "norm(sndcart x) <= norm (x::real ^('n::finite + 'm::finite))"
11.2887 +proof-
11.2888 + have th0: "norm x = norm (pastecart (fstcart x) (sndcart x))"
11.2889 + by (simp add: pastecart_fst_snd)
11.2890 + have th1: "sndcart x \<bullet> sndcart x \<le> pastecart (fstcart x) (sndcart x) \<bullet> pastecart (fstcart x) (sndcart x)"
11.2891 + by (simp add: dot_def setsum_UNIV_sum pastecart_def setsum_nonneg)
11.2892 + then show ?thesis
11.2893 + unfolding th0
11.2894 + unfolding real_vector_norm_def real_sqrt_le_iff id_def
11.2895 + by (simp add: dot_def)
11.2896 +qed
11.2897 +
11.2898 +lemma dist_sndcart: "dist(sndcart (x::real^_)) (sndcart y) <= dist x y"
11.2899 + unfolding dist_norm by (metis sndcart_sub[symmetric] norm_sndcart)
11.2900 +
11.2901 +lemma dot_pastecart: "(pastecart (x1::'a::{times,comm_monoid_add}^'n::finite) (x2::'a::{times,comm_monoid_add}^'m::finite)) \<bullet> (pastecart y1 y2) = x1 \<bullet> y1 + x2 \<bullet> y2"
11.2902 + by (simp add: dot_def setsum_UNIV_sum pastecart_def)
11.2903 +
11.2904 +text {* TODO: move to NthRoot *}
11.2905 +lemma sqrt_add_le_add_sqrt:
11.2906 + assumes x: "0 \<le> x" and y: "0 \<le> y"
11.2907 + shows "sqrt (x + y) \<le> sqrt x + sqrt y"
11.2908 +apply (rule power2_le_imp_le)
11.2909 +apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y)
11.2910 +apply (simp add: mult_nonneg_nonneg x y)
11.2911 +apply (simp add: add_nonneg_nonneg x y)
11.2912 +done
11.2913 +
11.2914 +lemma norm_pastecart: "norm (pastecart x y) <= norm x + norm y"
11.2915 + unfolding norm_vector_def setL2_def setsum_UNIV_sum
11.2916 + by (simp add: sqrt_add_le_add_sqrt setsum_nonneg)
11.2917 +
11.2918 +subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *}
11.2919 +
11.2920 +definition hull :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "hull" 75) where
11.2921 + "S hull s = Inter {t. t \<in> S \<and> s \<subseteq> t}"
11.2922 +
11.2923 +lemma hull_same: "s \<in> S \<Longrightarrow> S hull s = s"
11.2924 + unfolding hull_def by auto
11.2925 +
11.2926 +lemma hull_in: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) \<in> S"
11.2927 +unfolding hull_def subset_iff by auto
11.2928 +
11.2929 +lemma hull_eq: "(\<And>T. T \<subseteq> S ==> Inter T \<in> S) ==> (S hull s) = s \<longleftrightarrow> s \<in> S"
11.2930 +using hull_same[of s S] hull_in[of S s] by metis
11.2931 +
11.2932 +
11.2933 +lemma hull_hull: "S hull (S hull s) = S hull s"
11.2934 + unfolding hull_def by blast
11.2935 +
11.2936 +lemma hull_subset: "s \<subseteq> (S hull s)"
11.2937 + unfolding hull_def by blast
11.2938 +
11.2939 +lemma hull_mono: " s \<subseteq> t ==> (S hull s) \<subseteq> (S hull t)"
11.2940 + unfolding hull_def by blast
11.2941 +
11.2942 +lemma hull_antimono: "S \<subseteq> T ==> (T hull s) \<subseteq> (S hull s)"
11.2943 + unfolding hull_def by blast
11.2944 +
11.2945 +lemma hull_minimal: "s \<subseteq> t \<Longrightarrow> t \<in> S ==> (S hull s) \<subseteq> t"
11.2946 + unfolding hull_def by blast
11.2947 +
11.2948 +lemma subset_hull: "t \<in> S ==> S hull s \<subseteq> t \<longleftrightarrow> s \<subseteq> t"
11.2949 + unfolding hull_def by blast
11.2950 +
11.2951 +lemma hull_unique: "s \<subseteq> t \<Longrightarrow> t \<in> S \<Longrightarrow> (\<And>t'. s \<subseteq> t' \<Longrightarrow> t' \<in> S ==> t \<subseteq> t')
11.2952 + ==> (S hull s = t)"
11.2953 +unfolding hull_def by auto
11.2954 +
11.2955 +lemma hull_induct: "(\<And>x. x\<in> S \<Longrightarrow> P x) \<Longrightarrow> Q {x. P x} \<Longrightarrow> \<forall>x\<in> Q hull S. P x"
11.2956 + using hull_minimal[of S "{x. P x}" Q]
11.2957 + by (auto simp add: subset_eq Collect_def mem_def)
11.2958 +
11.2959 +lemma hull_inc: "x \<in> S \<Longrightarrow> x \<in> P hull S" by (metis hull_subset subset_eq)
11.2960 +
11.2961 +lemma hull_union_subset: "(S hull s) \<union> (S hull t) \<subseteq> (S hull (s \<union> t))"
11.2962 +unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2)
11.2963 +
11.2964 +lemma hull_union: assumes T: "\<And>T. T \<subseteq> S ==> Inter T \<in> S"
11.2965 + shows "S hull (s \<union> t) = S hull (S hull s \<union> S hull t)"
11.2966 +apply rule
11.2967 +apply (rule hull_mono)
11.2968 +unfolding Un_subset_iff
11.2969 +apply (metis hull_subset Un_upper1 Un_upper2 subset_trans)
11.2970 +apply (rule hull_minimal)
11.2971 +apply (metis hull_union_subset)
11.2972 +apply (metis hull_in T)
11.2973 +done
11.2974 +
11.2975 +lemma hull_redundant_eq: "a \<in> (S hull s) \<longleftrightarrow> (S hull (insert a s) = S hull s)"
11.2976 + unfolding hull_def by blast
11.2977 +
11.2978 +lemma hull_redundant: "a \<in> (S hull s) ==> (S hull (insert a s) = S hull s)"
11.2979 +by (metis hull_redundant_eq)
11.2980 +
11.2981 +text{* Archimedian properties and useful consequences. *}
11.2982 +
11.2983 +lemma real_arch_simple: "\<exists>n. x <= real (n::nat)"
11.2984 + using reals_Archimedean2[of x] apply auto by (rule_tac x="Suc n" in exI, auto)
11.2985 +lemmas real_arch_lt = reals_Archimedean2
11.2986 +
11.2987 +lemmas real_arch = reals_Archimedean3
11.2988 +
11.2989 +lemma real_arch_inv: "0 < e \<longleftrightarrow> (\<exists>n::nat. n \<noteq> 0 \<and> 0 < inverse (real n) \<and> inverse (real n) < e)"
11.2990 + using reals_Archimedean
11.2991 + apply (auto simp add: field_simps inverse_positive_iff_positive)
11.2992 + apply (subgoal_tac "inverse (real n) > 0")
11.2993 + apply arith
11.2994 + apply simp
11.2995 + done
11.2996 +
11.2997 +lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n"
11.2998 +proof(induct n)
11.2999 + case 0 thus ?case by simp
11.3000 +next
11.3001 + case (Suc n)
11.3002 + hence h: "1 + real n * x \<le> (1 + x) ^ n" by simp
11.3003 + from h have p: "1 \<le> (1 + x) ^ n" using Suc.prems by simp
11.3004 + from h have "1 + real n * x + x \<le> (1 + x) ^ n + x" by simp
11.3005 + also have "\<dots> \<le> (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric])
11.3006 + apply (simp add: ring_simps)
11.3007 + using mult_left_mono[OF p Suc.prems] by simp
11.3008 + finally show ?case by (simp add: real_of_nat_Suc ring_simps)
11.3009 +qed
11.3010 +
11.3011 +lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\<exists>n. y < x^n"
11.3012 +proof-
11.3013 + from x have x0: "x - 1 > 0" by arith
11.3014 + from real_arch[OF x0, rule_format, of y]
11.3015 + obtain n::nat where n:"y < real n * (x - 1)" by metis
11.3016 + from x0 have x00: "x- 1 \<ge> 0" by arith
11.3017 + from real_pow_lbound[OF x00, of n] n
11.3018 + have "y < x^n" by auto
11.3019 + then show ?thesis by metis
11.3020 +qed
11.3021 +
11.3022 +lemma real_arch_pow2: "\<exists>n. (x::real) < 2^ n"
11.3023 + using real_arch_pow[of 2 x] by simp
11.3024 +
11.3025 +lemma real_arch_pow_inv: assumes y: "(y::real) > 0" and x1: "x < 1"
11.3026 + shows "\<exists>n. x^n < y"
11.3027 +proof-
11.3028 + {assume x0: "x > 0"
11.3029 + from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps)
11.3030 + from real_arch_pow[OF ix, of "1/y"]
11.3031 + obtain n where n: "1/y < (1/x)^n" by blast
11.3032 + then
11.3033 + have ?thesis using y x0 by (auto simp add: field_simps power_divide) }
11.3034 + moreover
11.3035 + {assume "\<not> x > 0" with y x1 have ?thesis apply auto by (rule exI[where x=1], auto)}
11.3036 + ultimately show ?thesis by metis
11.3037 +qed
11.3038 +
11.3039 +lemma forall_pos_mono: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n::nat. n \<noteq> 0 ==> P(inverse(real n))) \<Longrightarrow> (\<And>e. 0 < e ==> P e)"
11.3040 + by (metis real_arch_inv)
11.3041 +
11.3042 +lemma forall_pos_mono_1: "(\<And>d e::real. d < e \<Longrightarrow> P d ==> P e) \<Longrightarrow> (\<And>n. P(inverse(real (Suc n)))) ==> 0 < e ==> P e"
11.3043 + apply (rule forall_pos_mono)
11.3044 + apply auto
11.3045 + apply (atomize)
11.3046 + apply (erule_tac x="n - 1" in allE)
11.3047 + apply auto
11.3048 + done
11.3049 +
11.3050 +lemma real_archimedian_rdiv_eq_0: assumes x0: "x \<ge> 0" and c: "c \<ge> 0" and xc: "\<forall>(m::nat)>0. real m * x \<le> c"
11.3051 + shows "x = 0"
11.3052 +proof-
11.3053 + {assume "x \<noteq> 0" with x0 have xp: "x > 0" by arith
11.3054 + from real_arch[OF xp, rule_format, of c] obtain n::nat where n: "c < real n * x" by blast
11.3055 + with xc[rule_format, of n] have "n = 0" by arith
11.3056 + with n c have False by simp}
11.3057 + then show ?thesis by blast
11.3058 +qed
11.3059 +
11.3060 +(* ------------------------------------------------------------------------- *)
11.3061 +(* Relate max and min to sup and inf. *)
11.3062 +(* ------------------------------------------------------------------------- *)
11.3063 +
11.3064 +lemma real_max_rsup: "max x y = rsup {x,y}"
11.3065 +proof-
11.3066 + have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
11.3067 + from rsup_finite_le_iff[OF f, of "max x y"] have "rsup {x,y} \<le> max x y" by simp
11.3068 + moreover
11.3069 + have "max x y \<le> rsup {x,y}" using rsup_finite_ge_iff[OF f, of "max x y"]
11.3070 + by (simp add: linorder_linear)
11.3071 + ultimately show ?thesis by arith
11.3072 +qed
11.3073 +
11.3074 +lemma real_min_rinf: "min x y = rinf {x,y}"
11.3075 +proof-
11.3076 + have f: "finite {x, y}" "{x,y} \<noteq> {}" by simp_all
11.3077 + from rinf_finite_le_iff[OF f, of "min x y"] have "rinf {x,y} \<le> min x y"
11.3078 + by (simp add: linorder_linear)
11.3079 + moreover
11.3080 + have "min x y \<le> rinf {x,y}" using rinf_finite_ge_iff[OF f, of "min x y"]
11.3081 + by simp
11.3082 + ultimately show ?thesis by arith
11.3083 +qed
11.3084 +
11.3085 +(* ------------------------------------------------------------------------- *)
11.3086 +(* Geometric progression. *)
11.3087 +(* ------------------------------------------------------------------------- *)
11.3088 +
11.3089 +lemma sum_gp_basic: "((1::'a::{field}) - x) * setsum (\<lambda>i. x^i) {0 .. n} = (1 - x^(Suc n))"
11.3090 + (is "?lhs = ?rhs")
11.3091 +proof-
11.3092 + {assume x1: "x = 1" hence ?thesis by simp}
11.3093 + moreover
11.3094 + {assume x1: "x\<noteq>1"
11.3095 + hence x1': "x - 1 \<noteq> 0" "1 - x \<noteq> 0" "x - 1 = - (1 - x)" "- (1 - x) \<noteq> 0" by auto
11.3096 + from geometric_sum[OF x1, of "Suc n", unfolded x1']
11.3097 + have "(- (1 - x)) * setsum (\<lambda>i. x^i) {0 .. n} = - (1 - x^(Suc n))"
11.3098 + unfolding atLeastLessThanSuc_atLeastAtMost
11.3099 + using x1' apply (auto simp only: field_simps)
11.3100 + apply (simp add: ring_simps)
11.3101 + done
11.3102 + then have ?thesis by (simp add: ring_simps) }
11.3103 + ultimately show ?thesis by metis
11.3104 +qed
11.3105 +
11.3106 +lemma sum_gp_multiplied: assumes mn: "m <= n"
11.3107 + shows "((1::'a::{field}) - x) * setsum (op ^ x) {m..n} = x^m - x^ Suc n"
11.3108 + (is "?lhs = ?rhs")
11.3109 +proof-
11.3110 + let ?S = "{0..(n - m)}"
11.3111 + from mn have mn': "n - m \<ge> 0" by arith
11.3112 + let ?f = "op + m"
11.3113 + have i: "inj_on ?f ?S" unfolding inj_on_def by auto
11.3114 + have f: "?f ` ?S = {m..n}"
11.3115 + using mn apply (auto simp add: image_iff Bex_def) by arith
11.3116 + have th: "op ^ x o op + m = (\<lambda>i. x^m * x^i)"
11.3117 + by (rule ext, simp add: power_add power_mult)
11.3118 + from setsum_reindex[OF i, of "op ^ x", unfolded f th setsum_right_distrib[symmetric]]
11.3119 + have "?lhs = x^m * ((1 - x) * setsum (op ^ x) {0..n - m})" by simp
11.3120 + then show ?thesis unfolding sum_gp_basic using mn
11.3121 + by (simp add: ring_simps power_add[symmetric])
11.3122 +qed
11.3123 +
11.3124 +lemma sum_gp: "setsum (op ^ (x::'a::{field})) {m .. n} =
11.3125 + (if n < m then 0 else if x = 1 then of_nat ((n + 1) - m)
11.3126 + else (x^ m - x^ (Suc n)) / (1 - x))"
11.3127 +proof-
11.3128 + {assume nm: "n < m" hence ?thesis by simp}
11.3129 + moreover
11.3130 + {assume "\<not> n < m" hence nm: "m \<le> n" by arith
11.3131 + {assume x: "x = 1" hence ?thesis by simp}
11.3132 + moreover
11.3133 + {assume x: "x \<noteq> 1" hence nz: "1 - x \<noteq> 0" by simp
11.3134 + from sum_gp_multiplied[OF nm, of x] nz have ?thesis by (simp add: field_simps)}
11.3135 + ultimately have ?thesis by metis
11.3136 + }
11.3137 + ultimately show ?thesis by metis
11.3138 +qed
11.3139 +
11.3140 +lemma sum_gp_offset: "setsum (op ^ (x::'a::{field})) {m .. m+n} =
11.3141 + (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
11.3142 + unfolding sum_gp[of x m "m + n"] power_Suc
11.3143 + by (simp add: ring_simps power_add)
11.3144 +
11.3145 +
11.3146 +subsection{* A bit of linear algebra. *}
11.3147 +
11.3148 +definition "subspace S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>x\<in> S. \<forall>y \<in>S. x + y \<in> S) \<and> (\<forall>c. \<forall>x \<in>S. c *s x \<in>S )"
11.3149 +definition "span S = (subspace hull S)"
11.3150 +definition "dependent S \<longleftrightarrow> (\<exists>a \<in> S. a \<in> span(S - {a}))"
11.3151 +abbreviation "independent s == ~(dependent s)"
11.3152 +
11.3153 +(* Closure properties of subspaces. *)
11.3154 +
11.3155 +lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def)
11.3156 +
11.3157 +lemma subspace_0: "subspace S ==> 0 \<in> S" by (metis subspace_def)
11.3158 +
11.3159 +lemma subspace_add: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S ==> x + y \<in> S"
11.3160 + by (metis subspace_def)
11.3161 +
11.3162 +lemma subspace_mul: "subspace S \<Longrightarrow> x \<in> S \<Longrightarrow> c *s x \<in> S"
11.3163 + by (metis subspace_def)
11.3164 +
11.3165 +lemma subspace_neg: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> - x \<in> S"
11.3166 + by (metis vector_sneg_minus1 subspace_mul)
11.3167 +
11.3168 +lemma subspace_sub: "subspace S \<Longrightarrow> (x::'a::ring_1^'n) \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> x - y \<in> S"
11.3169 + by (metis diff_def subspace_add subspace_neg)
11.3170 +
11.3171 +lemma subspace_setsum:
11.3172 + assumes sA: "subspace A" and fB: "finite B"
11.3173 + and f: "\<forall>x\<in> B. f x \<in> A"
11.3174 + shows "setsum f B \<in> A"
11.3175 + using fB f sA
11.3176 + apply(induct rule: finite_induct[OF fB])
11.3177 + by (simp add: subspace_def sA, auto simp add: sA subspace_add)
11.3178 +
11.3179 +lemma subspace_linear_image:
11.3180 + assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and sS: "subspace S"
11.3181 + shows "subspace(f ` S)"
11.3182 + using lf sS linear_0[OF lf]
11.3183 + unfolding linear_def subspace_def
11.3184 + apply (auto simp add: image_iff)
11.3185 + apply (rule_tac x="x + y" in bexI, auto)
11.3186 + apply (rule_tac x="c*s x" in bexI, auto)
11.3187 + done
11.3188 +
11.3189 +lemma subspace_linear_preimage: "linear (f::'a::semiring_1^'n \<Rightarrow> _) ==> subspace S ==> subspace {x. f x \<in> S}"
11.3190 + by (auto simp add: subspace_def linear_def linear_0[of f])
11.3191 +
11.3192 +lemma subspace_trivial: "subspace {0::'a::semiring_1 ^_}"
11.3193 + by (simp add: subspace_def)
11.3194 +
11.3195 +lemma subspace_inter: "subspace A \<Longrightarrow> subspace B ==> subspace (A \<inter> B)"
11.3196 + by (simp add: subspace_def)
11.3197 +
11.3198 +
11.3199 +lemma span_mono: "A \<subseteq> B ==> span A \<subseteq> span B"
11.3200 + by (metis span_def hull_mono)
11.3201 +
11.3202 +lemma subspace_span: "subspace(span S)"
11.3203 + unfolding span_def
11.3204 + apply (rule hull_in[unfolded mem_def])
11.3205 + apply (simp only: subspace_def Inter_iff Int_iff subset_eq)
11.3206 + apply auto
11.3207 + apply (erule_tac x="X" in ballE)
11.3208 + apply (simp add: mem_def)
11.3209 + apply blast
11.3210 + apply (erule_tac x="X" in ballE)
11.3211 + apply (erule_tac x="X" in ballE)
11.3212 + apply (erule_tac x="X" in ballE)
11.3213 + apply (clarsimp simp add: mem_def)
11.3214 + apply simp
11.3215 + apply simp
11.3216 + apply simp
11.3217 + apply (erule_tac x="X" in ballE)
11.3218 + apply (erule_tac x="X" in ballE)
11.3219 + apply (simp add: mem_def)
11.3220 + apply simp
11.3221 + apply simp
11.3222 + done
11.3223 +
11.3224 +lemma span_clauses:
11.3225 + "a \<in> S ==> a \<in> span S"
11.3226 + "0 \<in> span S"
11.3227 + "x\<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
11.3228 + "x \<in> span S \<Longrightarrow> c *s x \<in> span S"
11.3229 + by (metis span_def hull_subset subset_eq subspace_span subspace_def)+
11.3230 +
11.3231 +lemma span_induct: assumes SP: "\<And>x. x \<in> S ==> P x"
11.3232 + and P: "subspace P" and x: "x \<in> span S" shows "P x"
11.3233 +proof-
11.3234 + from SP have SP': "S \<subseteq> P" by (simp add: mem_def subset_eq)
11.3235 + from P have P': "P \<in> subspace" by (simp add: mem_def)
11.3236 + from x hull_minimal[OF SP' P', unfolded span_def[symmetric]]
11.3237 + show "P x" by (metis mem_def subset_eq)
11.3238 +qed
11.3239 +
11.3240 +lemma span_empty: "span {} = {(0::'a::semiring_0 ^ 'n)}"
11.3241 + apply (simp add: span_def)
11.3242 + apply (rule hull_unique)
11.3243 + apply (auto simp add: mem_def subspace_def)
11.3244 + unfolding mem_def[of "0::'a^'n", symmetric]
11.3245 + apply simp
11.3246 + done
11.3247 +
11.3248 +lemma independent_empty: "independent {}"
11.3249 + by (simp add: dependent_def)
11.3250 +
11.3251 +lemma independent_mono: "independent A \<Longrightarrow> B \<subseteq> A ==> independent B"
11.3252 + apply (clarsimp simp add: dependent_def span_mono)
11.3253 + apply (subgoal_tac "span (B - {a}) \<le> span (A - {a})")
11.3254 + apply force
11.3255 + apply (rule span_mono)
11.3256 + apply auto
11.3257 + done
11.3258 +
11.3259 +lemma span_subspace: "A \<subseteq> B \<Longrightarrow> B \<le> span A \<Longrightarrow> subspace B \<Longrightarrow> span A = B"
11.3260 + by (metis order_antisym span_def hull_minimal mem_def)
11.3261 +
11.3262 +lemma span_induct': assumes SP: "\<forall>x \<in> S. P x"
11.3263 + and P: "subspace P" shows "\<forall>x \<in> span S. P x"
11.3264 + using span_induct SP P by blast
11.3265 +
11.3266 +inductive span_induct_alt_help for S:: "'a::semiring_1^'n \<Rightarrow> bool"
11.3267 + where
11.3268 + span_induct_alt_help_0: "span_induct_alt_help S 0"
11.3269 + | span_induct_alt_help_S: "x \<in> S \<Longrightarrow> span_induct_alt_help S z \<Longrightarrow> span_induct_alt_help S (c *s x + z)"
11.3270 +
11.3271 +lemma span_induct_alt':
11.3272 + assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" shows "\<forall>x \<in> span S. h x"
11.3273 +proof-
11.3274 + {fix x:: "'a^'n" assume x: "span_induct_alt_help S x"
11.3275 + have "h x"
11.3276 + apply (rule span_induct_alt_help.induct[OF x])
11.3277 + apply (rule h0)
11.3278 + apply (rule hS, assumption, assumption)
11.3279 + done}
11.3280 + note th0 = this
11.3281 + {fix x assume x: "x \<in> span S"
11.3282 +
11.3283 + have "span_induct_alt_help S x"
11.3284 + proof(rule span_induct[where x=x and S=S])
11.3285 + show "x \<in> span S" using x .
11.3286 + next
11.3287 + fix x assume xS : "x \<in> S"
11.3288 + from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1]
11.3289 + show "span_induct_alt_help S x" by simp
11.3290 + next
11.3291 + have "span_induct_alt_help S 0" by (rule span_induct_alt_help_0)
11.3292 + moreover
11.3293 + {fix x y assume h: "span_induct_alt_help S x" "span_induct_alt_help S y"
11.3294 + from h
11.3295 + have "span_induct_alt_help S (x + y)"
11.3296 + apply (induct rule: span_induct_alt_help.induct)
11.3297 + apply simp
11.3298 + unfolding add_assoc
11.3299 + apply (rule span_induct_alt_help_S)
11.3300 + apply assumption
11.3301 + apply simp
11.3302 + done}
11.3303 + moreover
11.3304 + {fix c x assume xt: "span_induct_alt_help S x"
11.3305 + then have "span_induct_alt_help S (c*s x)"
11.3306 + apply (induct rule: span_induct_alt_help.induct)
11.3307 + apply (simp add: span_induct_alt_help_0)
11.3308 + apply (simp add: vector_smult_assoc vector_add_ldistrib)
11.3309 + apply (rule span_induct_alt_help_S)
11.3310 + apply assumption
11.3311 + apply simp
11.3312 + done
11.3313 + }
11.3314 + ultimately show "subspace (span_induct_alt_help S)"
11.3315 + unfolding subspace_def mem_def Ball_def by blast
11.3316 + qed}
11.3317 + with th0 show ?thesis by blast
11.3318 +qed
11.3319 +
11.3320 +lemma span_induct_alt:
11.3321 + assumes h0: "h (0::'a::semiring_1^'n)" and hS: "\<And>c x y. x \<in> S \<Longrightarrow> h y \<Longrightarrow> h (c*s x + y)" and x: "x \<in> span S"
11.3322 + shows "h x"
11.3323 +using span_induct_alt'[of h S] h0 hS x by blast
11.3324 +
11.3325 +(* Individual closure properties. *)
11.3326 +
11.3327 +lemma span_superset: "x \<in> S ==> x \<in> span S" by (metis span_clauses)
11.3328 +
11.3329 +lemma span_0: "0 \<in> span S" by (metis subspace_span subspace_0)
11.3330 +
11.3331 +lemma span_add: "x \<in> span S \<Longrightarrow> y \<in> span S ==> x + y \<in> span S"
11.3332 + by (metis subspace_add subspace_span)
11.3333 +
11.3334 +lemma span_mul: "x \<in> span S ==> (c *s x) \<in> span S"
11.3335 + by (metis subspace_span subspace_mul)
11.3336 +
11.3337 +lemma span_neg: "x \<in> span S ==> - (x::'a::ring_1^'n) \<in> span S"
11.3338 + by (metis subspace_neg subspace_span)
11.3339 +
11.3340 +lemma span_sub: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> y \<in> span S ==> x - y \<in> span S"
11.3341 + by (metis subspace_span subspace_sub)
11.3342 +
11.3343 +lemma span_setsum: "finite A \<Longrightarrow> \<forall>x \<in> A. f x \<in> span S ==> setsum f A \<in> span S"
11.3344 + apply (rule subspace_setsum)
11.3345 + by (metis subspace_span subspace_setsum)+
11.3346 +
11.3347 +lemma span_add_eq: "(x::'a::ring_1^'n) \<in> span S \<Longrightarrow> x + y \<in> span S \<longleftrightarrow> y \<in> span S"
11.3348 + apply (auto simp only: span_add span_sub)
11.3349 + apply (subgoal_tac "(x + y) - x \<in> span S", simp)
11.3350 + by (simp only: span_add span_sub)
11.3351 +
11.3352 +(* Mapping under linear image. *)
11.3353 +
11.3354 +lemma span_linear_image: assumes lf: "linear (f::'a::semiring_1 ^ 'n => _)"
11.3355 + shows "span (f ` S) = f ` (span S)"
11.3356 +proof-
11.3357 + {fix x
11.3358 + assume x: "x \<in> span (f ` S)"
11.3359 + have "x \<in> f ` span S"
11.3360 + apply (rule span_induct[where x=x and S = "f ` S"])
11.3361 + apply (clarsimp simp add: image_iff)
11.3362 + apply (frule span_superset)
11.3363 + apply blast
11.3364 + apply (simp only: mem_def)
11.3365 + apply (rule subspace_linear_image[OF lf])
11.3366 + apply (rule subspace_span)
11.3367 + apply (rule x)
11.3368 + done}
11.3369 + moreover
11.3370 + {fix x assume x: "x \<in> span S"
11.3371 + have th0:"(\<lambda>a. f a \<in> span (f ` S)) = {x. f x \<in> span (f ` S)}" apply (rule set_ext)
11.3372 + unfolding mem_def Collect_def ..
11.3373 + have "f x \<in> span (f ` S)"
11.3374 + apply (rule span_induct[where S=S])
11.3375 + apply (rule span_superset)
11.3376 + apply simp
11.3377 + apply (subst th0)
11.3378 + apply (rule subspace_linear_preimage[OF lf subspace_span, of "f ` S"])
11.3379 + apply (rule x)
11.3380 + done}
11.3381 + ultimately show ?thesis by blast
11.3382 +qed
11.3383 +
11.3384 +(* The key breakdown property. *)
11.3385 +
11.3386 +lemma span_breakdown:
11.3387 + assumes bS: "(b::'a::ring_1 ^ 'n) \<in> S" and aS: "a \<in> span S"
11.3388 + shows "\<exists>k. a - k*s b \<in> span (S - {b})" (is "?P a")
11.3389 +proof-
11.3390 + {fix x assume xS: "x \<in> S"
11.3391 + {assume ab: "x = b"
11.3392 + then have "?P x"
11.3393 + apply simp
11.3394 + apply (rule exI[where x="1"], simp)
11.3395 + by (rule span_0)}
11.3396 + moreover
11.3397 + {assume ab: "x \<noteq> b"
11.3398 + then have "?P x" using xS
11.3399 + apply -
11.3400 + apply (rule exI[where x=0])
11.3401 + apply (rule span_superset)
11.3402 + by simp}
11.3403 + ultimately have "?P x" by blast}
11.3404 + moreover have "subspace ?P"
11.3405 + unfolding subspace_def
11.3406 + apply auto
11.3407 + apply (simp add: mem_def)
11.3408 + apply (rule exI[where x=0])
11.3409 + using span_0[of "S - {b}"]
11.3410 + apply (simp add: mem_def)
11.3411 + apply (clarsimp simp add: mem_def)
11.3412 + apply (rule_tac x="k + ka" in exI)
11.3413 + apply (subgoal_tac "x + y - (k + ka) *s b = (x - k*s b) + (y - ka *s b)")
11.3414 + apply (simp only: )
11.3415 + apply (rule span_add[unfolded mem_def])
11.3416 + apply assumption+
11.3417 + apply (vector ring_simps)
11.3418 + apply (clarsimp simp add: mem_def)
11.3419 + apply (rule_tac x= "c*k" in exI)
11.3420 + apply (subgoal_tac "c *s x - (c * k) *s b = c*s (x - k*s b)")
11.3421 + apply (simp only: )
11.3422 + apply (rule span_mul[unfolded mem_def])
11.3423 + apply assumption
11.3424 + by (vector ring_simps)
11.3425 + ultimately show "?P a" using aS span_induct[where S=S and P= "?P"] by metis
11.3426 +qed
11.3427 +
11.3428 +lemma span_breakdown_eq:
11.3429 + "(x::'a::ring_1^'n) \<in> span (insert a S) \<longleftrightarrow> (\<exists>k. (x - k *s a) \<in> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
11.3430 +proof-
11.3431 + {assume x: "x \<in> span (insert a S)"
11.3432 + from x span_breakdown[of "a" "insert a S" "x"]
11.3433 + have ?rhs apply clarsimp
11.3434 + apply (rule_tac x= "k" in exI)
11.3435 + apply (rule set_rev_mp[of _ "span (S - {a})" _])
11.3436 + apply assumption
11.3437 + apply (rule span_mono)
11.3438 + apply blast
11.3439 + done}
11.3440 + moreover
11.3441 + { fix k assume k: "x - k *s a \<in> span S"
11.3442 + have eq: "x = (x - k *s a) + k *s a" by vector
11.3443 + have "(x - k *s a) + k *s a \<in> span (insert a S)"
11.3444 + apply (rule span_add)
11.3445 + apply (rule set_rev_mp[of _ "span S" _])
11.3446 + apply (rule k)
11.3447 + apply (rule span_mono)
11.3448 + apply blast
11.3449 + apply (rule span_mul)
11.3450 + apply (rule span_superset)
11.3451 + apply blast
11.3452 + done
11.3453 + then have ?lhs using eq by metis}
11.3454 + ultimately show ?thesis by blast
11.3455 +qed
11.3456 +
11.3457 +(* Hence some "reversal" results.*)
11.3458 +
11.3459 +lemma in_span_insert:
11.3460 + assumes a: "(a::'a::field^'n) \<in> span (insert b S)" and na: "a \<notin> span S"
11.3461 + shows "b \<in> span (insert a S)"
11.3462 +proof-
11.3463 + from span_breakdown[of b "insert b S" a, OF insertI1 a]
11.3464 + obtain k where k: "a - k*s b \<in> span (S - {b})" by auto
11.3465 + {assume k0: "k = 0"
11.3466 + with k have "a \<in> span S"
11.3467 + apply (simp)
11.3468 + apply (rule set_rev_mp)
11.3469 + apply assumption
11.3470 + apply (rule span_mono)
11.3471 + apply blast
11.3472 + done
11.3473 + with na have ?thesis by blast}
11.3474 + moreover
11.3475 + {assume k0: "k \<noteq> 0"
11.3476 + have eq: "b = (1/k) *s a - ((1/k) *s a - b)" by vector
11.3477 + from k0 have eq': "(1/k) *s (a - k*s b) = (1/k) *s a - b"
11.3478 + by (vector field_simps)
11.3479 + from k have "(1/k) *s (a - k*s b) \<in> span (S - {b})"
11.3480 + by (rule span_mul)
11.3481 + hence th: "(1/k) *s a - b \<in> span (S - {b})"
11.3482 + unfolding eq' .
11.3483 +
11.3484 + from k
11.3485 + have ?thesis
11.3486 + apply (subst eq)
11.3487 + apply (rule span_sub)
11.3488 + apply (rule span_mul)
11.3489 + apply (rule span_superset)
11.3490 + apply blast
11.3491 + apply (rule set_rev_mp)
11.3492 + apply (rule th)
11.3493 + apply (rule span_mono)
11.3494 + using na by blast}
11.3495 + ultimately show ?thesis by blast
11.3496 +qed
11.3497 +
11.3498 +lemma in_span_delete:
11.3499 + assumes a: "(a::'a::field^'n) \<in> span S"
11.3500 + and na: "a \<notin> span (S-{b})"
11.3501 + shows "b \<in> span (insert a (S - {b}))"
11.3502 + apply (rule in_span_insert)
11.3503 + apply (rule set_rev_mp)
11.3504 + apply (rule a)
11.3505 + apply (rule span_mono)
11.3506 + apply blast
11.3507 + apply (rule na)
11.3508 + done
11.3509 +
11.3510 +(* Transitivity property. *)
11.3511 +
11.3512 +lemma span_trans:
11.3513 + assumes x: "(x::'a::ring_1^'n) \<in> span S" and y: "y \<in> span (insert x S)"
11.3514 + shows "y \<in> span S"
11.3515 +proof-
11.3516 + from span_breakdown[of x "insert x S" y, OF insertI1 y]
11.3517 + obtain k where k: "y -k*s x \<in> span (S - {x})" by auto
11.3518 + have eq: "y = (y - k *s x) + k *s x" by vector
11.3519 + show ?thesis
11.3520 + apply (subst eq)
11.3521 + apply (rule span_add)
11.3522 + apply (rule set_rev_mp)
11.3523 + apply (rule k)
11.3524 + apply (rule span_mono)
11.3525 + apply blast
11.3526 + apply (rule span_mul)
11.3527 + by (rule x)
11.3528 +qed
11.3529 +
11.3530 +(* ------------------------------------------------------------------------- *)
11.3531 +(* An explicit expansion is sometimes needed. *)
11.3532 +(* ------------------------------------------------------------------------- *)
11.3533 +
11.3534 +lemma span_explicit:
11.3535 + "span P = {y::'a::semiring_1^'n. \<exists>S u. finite S \<and> S \<subseteq> P \<and> setsum (\<lambda>v. u v *s v) S = y}"
11.3536 + (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \<exists>S u. ?Q S u y}")
11.3537 +proof-
11.3538 + {fix x assume x: "x \<in> ?E"
11.3539 + then obtain S u where fS: "finite S" and SP: "S\<subseteq>P" and u: "setsum (\<lambda>v. u v *s v) S = x"
11.3540 + by blast
11.3541 + have "x \<in> span P"
11.3542 + unfolding u[symmetric]
11.3543 + apply (rule span_setsum[OF fS])
11.3544 + using span_mono[OF SP]
11.3545 + by (auto intro: span_superset span_mul)}
11.3546 + moreover
11.3547 + have "\<forall>x \<in> span P. x \<in> ?E"
11.3548 + unfolding mem_def Collect_def
11.3549 + proof(rule span_induct_alt')
11.3550 + show "?h 0"
11.3551 + apply (rule exI[where x="{}"]) by simp
11.3552 + next
11.3553 + fix c x y
11.3554 + assume x: "x \<in> P" and hy: "?h y"
11.3555 + from hy obtain S u where fS: "finite S" and SP: "S\<subseteq>P"
11.3556 + and u: "setsum (\<lambda>v. u v *s v) S = y" by blast
11.3557 + let ?S = "insert x S"
11.3558 + let ?u = "\<lambda>y. if y = x then (if x \<in> S then u y + c else c)
11.3559 + else u y"
11.3560 + from fS SP x have th0: "finite (insert x S)" "insert x S \<subseteq> P" by blast+
11.3561 + {assume xS: "x \<in> S"
11.3562 + have S1: "S = (S - {x}) \<union> {x}"
11.3563 + and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \<inter> {x} = {}" using xS fS by auto
11.3564 + have "setsum (\<lambda>v. ?u v *s v) ?S =(\<Sum>v\<in>S - {x}. u v *s v) + (u x + c) *s x"
11.3565 + using xS
11.3566 + by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]]
11.3567 + setsum_clauses(2)[OF fS] cong del: if_weak_cong)
11.3568 + also have "\<dots> = (\<Sum>v\<in>S. u v *s v) + c *s x"
11.3569 + apply (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]])
11.3570 + by (vector ring_simps)
11.3571 + also have "\<dots> = c*s x + y"
11.3572 + by (simp add: add_commute u)
11.3573 + finally have "setsum (\<lambda>v. ?u v *s v) ?S = c*s x + y" .
11.3574 + then have "?Q ?S ?u (c*s x + y)" using th0 by blast}
11.3575 + moreover
11.3576 + {assume xS: "x \<notin> S"
11.3577 + have th00: "(\<Sum>v\<in>S. (if v = x then c else u v) *s v) = y"
11.3578 + unfolding u[symmetric]
11.3579 + apply (rule setsum_cong2)
11.3580 + using xS by auto
11.3581 + have "?Q ?S ?u (c*s x + y)" using fS xS th0
11.3582 + by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong)}
11.3583 + ultimately have "?Q ?S ?u (c*s x + y)"
11.3584 + by (cases "x \<in> S", simp, simp)
11.3585 + then show "?h (c*s x + y)"
11.3586 + apply -
11.3587 + apply (rule exI[where x="?S"])
11.3588 + apply (rule exI[where x="?u"]) by metis
11.3589 + qed
11.3590 + ultimately show ?thesis by blast
11.3591 +qed
11.3592 +
11.3593 +lemma dependent_explicit:
11.3594 + "dependent P \<longleftrightarrow> (\<exists>S u. finite S \<and> S \<subseteq> P \<and> (\<exists>(v::'a::{idom,field}^'n) \<in>S. u v \<noteq> 0 \<and> setsum (\<lambda>v. u v *s v) S = 0))" (is "?lhs = ?rhs")
11.3595 +proof-
11.3596 + {assume dP: "dependent P"
11.3597 + then obtain a S u where aP: "a \<in> P" and fS: "finite S"
11.3598 + and SP: "S \<subseteq> P - {a}" and ua: "setsum (\<lambda>v. u v *s v) S = a"
11.3599 + unfolding dependent_def span_explicit by blast
11.3600 + let ?S = "insert a S"
11.3601 + let ?u = "\<lambda>y. if y = a then - 1 else u y"
11.3602 + let ?v = a
11.3603 + from aP SP have aS: "a \<notin> S" by blast
11.3604 + from fS SP aP have th0: "finite ?S" "?S \<subseteq> P" "?v \<in> ?S" "?u ?v \<noteq> 0" by auto
11.3605 + have s0: "setsum (\<lambda>v. ?u v *s v) ?S = 0"
11.3606 + using fS aS
11.3607 + apply (simp add: vector_smult_lneg vector_smult_lid setsum_clauses ring_simps )
11.3608 + apply (subst (2) ua[symmetric])
11.3609 + apply (rule setsum_cong2)
11.3610 + by auto
11.3611 + with th0 have ?rhs
11.3612 + apply -
11.3613 + apply (rule exI[where x= "?S"])
11.3614 + apply (rule exI[where x= "?u"])
11.3615 + by clarsimp}
11.3616 + moreover
11.3617 + {fix S u v assume fS: "finite S"
11.3618 + and SP: "S \<subseteq> P" and vS: "v \<in> S" and uv: "u v \<noteq> 0"
11.3619 + and u: "setsum (\<lambda>v. u v *s v) S = 0"
11.3620 + let ?a = v
11.3621 + let ?S = "S - {v}"
11.3622 + let ?u = "\<lambda>i. (- u i) / u v"
11.3623 + have th0: "?a \<in> P" "finite ?S" "?S \<subseteq> P" using fS SP vS by auto
11.3624 + have "setsum (\<lambda>v. ?u v *s v) ?S = setsum (\<lambda>v. (- (inverse (u ?a))) *s (u v *s v)) S - ?u v *s v"
11.3625 + using fS vS uv
11.3626 + by (simp add: setsum_diff1 vector_smult_lneg divide_inverse
11.3627 + vector_smult_assoc field_simps)
11.3628 + also have "\<dots> = ?a"
11.3629 + unfolding setsum_cmul u
11.3630 + using uv by (simp add: vector_smult_lneg)
11.3631 + finally have "setsum (\<lambda>v. ?u v *s v) ?S = ?a" .
11.3632 + with th0 have ?lhs
11.3633 + unfolding dependent_def span_explicit
11.3634 + apply -
11.3635 + apply (rule bexI[where x= "?a"])
11.3636 + apply simp_all
11.3637 + apply (rule exI[where x= "?S"])
11.3638 + by auto}
11.3639 + ultimately show ?thesis by blast
11.3640 +qed
11.3641 +
11.3642 +
11.3643 +lemma span_finite:
11.3644 + assumes fS: "finite S"
11.3645 + shows "span S = {(y::'a::semiring_1^'n). \<exists>u. setsum (\<lambda>v. u v *s v) S = y}"
11.3646 + (is "_ = ?rhs")
11.3647 +proof-
11.3648 + {fix y assume y: "y \<in> span S"
11.3649 + from y obtain S' u where fS': "finite S'" and SS': "S' \<subseteq> S" and
11.3650 + u: "setsum (\<lambda>v. u v *s v) S' = y" unfolding span_explicit by blast
11.3651 + let ?u = "\<lambda>x. if x \<in> S' then u x else 0"
11.3652 + from setsum_restrict_set[OF fS, of "\<lambda>v. u v *s v" S', symmetric] SS'
11.3653 + have "setsum (\<lambda>v. ?u v *s v) S = setsum (\<lambda>v. u v *s v) S'"
11.3654 + unfolding cond_value_iff cond_application_beta
11.3655 + by (simp add: cond_value_iff inf_absorb2 cong del: if_weak_cong)
11.3656 + hence "setsum (\<lambda>v. ?u v *s v) S = y" by (metis u)
11.3657 + hence "y \<in> ?rhs" by auto}
11.3658 + moreover
11.3659 + {fix y u assume u: "setsum (\<lambda>v. u v *s v) S = y"
11.3660 + then have "y \<in> span S" using fS unfolding span_explicit by auto}
11.3661 + ultimately show ?thesis by blast
11.3662 +qed
11.3663 +
11.3664 +
11.3665 +(* Standard bases are a spanning set, and obviously finite. *)
11.3666 +
11.3667 +lemma span_stdbasis:"span {basis i :: 'a::ring_1^'n::finite | i. i \<in> (UNIV :: 'n set)} = UNIV"
11.3668 +apply (rule set_ext)
11.3669 +apply auto
11.3670 +apply (subst basis_expansion[symmetric])
11.3671 +apply (rule span_setsum)
11.3672 +apply simp
11.3673 +apply auto
11.3674 +apply (rule span_mul)
11.3675 +apply (rule span_superset)
11.3676 +apply (auto simp add: Collect_def mem_def)
11.3677 +done
11.3678 +
11.3679 +lemma has_size_stdbasis: "{basis i ::real ^'n::finite | i. i \<in> (UNIV :: 'n set)} hassize CARD('n)" (is "?S hassize ?n")
11.3680 +proof-
11.3681 + have eq: "?S = basis ` UNIV" by blast
11.3682 + show ?thesis unfolding eq
11.3683 + apply (rule hassize_image_inj[OF basis_inj])
11.3684 + by (simp add: hassize_def)
11.3685 +qed
11.3686 +
11.3687 +lemma finite_stdbasis: "finite {basis i ::real^'n::finite |i. i\<in> (UNIV:: 'n set)}"
11.3688 + using has_size_stdbasis[unfolded hassize_def]
11.3689 + ..
11.3690 +
11.3691 +lemma card_stdbasis: "card {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)} = CARD('n)"
11.3692 + using has_size_stdbasis[unfolded hassize_def]
11.3693 + ..
11.3694 +
11.3695 +lemma independent_stdbasis_lemma:
11.3696 + assumes x: "(x::'a::semiring_1 ^ 'n) \<in> span (basis ` S)"
11.3697 + and iS: "i \<notin> S"
11.3698 + shows "(x$i) = 0"
11.3699 +proof-
11.3700 + let ?U = "UNIV :: 'n set"
11.3701 + let ?B = "basis ` S"
11.3702 + let ?P = "\<lambda>(x::'a^'n). \<forall>i\<in> ?U. i \<notin> S \<longrightarrow> x$i =0"
11.3703 + {fix x::"'a^'n" assume xS: "x\<in> ?B"
11.3704 + from xS have "?P x" by auto}
11.3705 + moreover
11.3706 + have "subspace ?P"
11.3707 + by (auto simp add: subspace_def Collect_def mem_def)
11.3708 + ultimately show ?thesis
11.3709 + using x span_induct[of ?B ?P x] iS by blast
11.3710 +qed
11.3711 +
11.3712 +lemma independent_stdbasis: "independent {basis i ::real^'n::finite |i. i\<in> (UNIV :: 'n set)}"
11.3713 +proof-
11.3714 + let ?I = "UNIV :: 'n set"
11.3715 + let ?b = "basis :: _ \<Rightarrow> real ^'n"
11.3716 + let ?B = "?b ` ?I"
11.3717 + have eq: "{?b i|i. i \<in> ?I} = ?B"
11.3718 + by auto
11.3719 + {assume d: "dependent ?B"
11.3720 + then obtain k where k: "k \<in> ?I" "?b k \<in> span (?B - {?b k})"
11.3721 + unfolding dependent_def by auto
11.3722 + have eq1: "?B - {?b k} = ?B - ?b ` {k}" by simp
11.3723 + have eq2: "?B - {?b k} = ?b ` (?I - {k})"
11.3724 + unfolding eq1
11.3725 + apply (rule inj_on_image_set_diff[symmetric])
11.3726 + apply (rule basis_inj) using k(1) by auto
11.3727 + from k(2) have th0: "?b k \<in> span (?b ` (?I - {k}))" unfolding eq2 .
11.3728 + from independent_stdbasis_lemma[OF th0, of k, simplified]
11.3729 + have False by simp}
11.3730 + then show ?thesis unfolding eq dependent_def ..
11.3731 +qed
11.3732 +
11.3733 +(* This is useful for building a basis step-by-step. *)
11.3734 +
11.3735 +lemma independent_insert:
11.3736 + "independent(insert (a::'a::field ^'n) S) \<longleftrightarrow>
11.3737 + (if a \<in> S then independent S
11.3738 + else independent S \<and> a \<notin> span S)" (is "?lhs \<longleftrightarrow> ?rhs")
11.3739 +proof-
11.3740 + {assume aS: "a \<in> S"
11.3741 + hence ?thesis using insert_absorb[OF aS] by simp}
11.3742 + moreover
11.3743 + {assume aS: "a \<notin> S"
11.3744 + {assume i: ?lhs
11.3745 + then have ?rhs using aS
11.3746 + apply simp
11.3747 + apply (rule conjI)
11.3748 + apply (rule independent_mono)
11.3749 + apply assumption
11.3750 + apply blast
11.3751 + by (simp add: dependent_def)}
11.3752 + moreover
11.3753 + {assume i: ?rhs
11.3754 + have ?lhs using i aS
11.3755 + apply simp
11.3756 + apply (auto simp add: dependent_def)
11.3757 + apply (case_tac "aa = a", auto)
11.3758 + apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})")
11.3759 + apply simp
11.3760 + apply (subgoal_tac "a \<in> span (insert aa (S - {aa}))")
11.3761 + apply (subgoal_tac "insert aa (S - {aa}) = S")
11.3762 + apply simp
11.3763 + apply blast
11.3764 + apply (rule in_span_insert)
11.3765 + apply assumption
11.3766 + apply blast
11.3767 + apply blast
11.3768 + done}
11.3769 + ultimately have ?thesis by blast}
11.3770 + ultimately show ?thesis by blast
11.3771 +qed
11.3772 +
11.3773 +(* The degenerate case of the Exchange Lemma. *)
11.3774 +
11.3775 +lemma mem_delete: "x \<in> (A - {a}) \<longleftrightarrow> x \<noteq> a \<and> x \<in> A"
11.3776 + by blast
11.3777 +
11.3778 +lemma span_span: "span (span A) = span A"
11.3779 + unfolding span_def hull_hull ..
11.3780 +
11.3781 +lemma span_inc: "S \<subseteq> span S"
11.3782 + by (metis subset_eq span_superset)
11.3783 +
11.3784 +lemma spanning_subset_independent:
11.3785 + assumes BA: "B \<subseteq> A" and iA: "independent (A::('a::field ^'n) set)"
11.3786 + and AsB: "A \<subseteq> span B"
11.3787 + shows "A = B"
11.3788 +proof
11.3789 + from BA show "B \<subseteq> A" .
11.3790 +next
11.3791 + from span_mono[OF BA] span_mono[OF AsB]
11.3792 + have sAB: "span A = span B" unfolding span_span by blast
11.3793 +
11.3794 + {fix x assume x: "x \<in> A"
11.3795 + from iA have th0: "x \<notin> span (A - {x})"
11.3796 + unfolding dependent_def using x by blast
11.3797 + from x have xsA: "x \<in> span A" by (blast intro: span_superset)
11.3798 + have "A - {x} \<subseteq> A" by blast
11.3799 + hence th1:"span (A - {x}) \<subseteq> span A" by (metis span_mono)
11.3800 + {assume xB: "x \<notin> B"
11.3801 + from xB BA have "B \<subseteq> A -{x}" by blast
11.3802 + hence "span B \<subseteq> span (A - {x})" by (metis span_mono)
11.3803 + with th1 th0 sAB have "x \<notin> span A" by blast
11.3804 + with x have False by (metis span_superset)}
11.3805 + then have "x \<in> B" by blast}
11.3806 + then show "A \<subseteq> B" by blast
11.3807 +qed
11.3808 +
11.3809 +(* The general case of the Exchange Lemma, the key to what follows. *)
11.3810 +
11.3811 +lemma exchange_lemma:
11.3812 + assumes f:"finite (t:: ('a::field^'n) set)" and i: "independent s"
11.3813 + and sp:"s \<subseteq> span t"
11.3814 + shows "\<exists>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
11.3815 +using f i sp
11.3816 +proof(induct c\<equiv>"card(t - s)" arbitrary: s t rule: nat_less_induct)
11.3817 + fix n:: nat and s t :: "('a ^'n) set"
11.3818 + assume H: " \<forall>m<n. \<forall>(x:: ('a ^'n) set) xa.
11.3819 + finite xa \<longrightarrow>
11.3820 + independent x \<longrightarrow>
11.3821 + x \<subseteq> span xa \<longrightarrow>
11.3822 + m = card (xa - x) \<longrightarrow>
11.3823 + (\<exists>t'. (t' hassize card xa) \<and>
11.3824 + x \<subseteq> t' \<and> t' \<subseteq> x \<union> xa \<and> x \<subseteq> span t')"
11.3825 + and ft: "finite t" and s: "independent s" and sp: "s \<subseteq> span t"
11.3826 + and n: "n = card (t - s)"
11.3827 + let ?P = "\<lambda>t'. (t' hassize card t) \<and> s \<subseteq> t' \<and> t' \<subseteq> s \<union> t \<and> s \<subseteq> span t'"
11.3828 + let ?ths = "\<exists>t'. ?P t'"
11.3829 + {assume st: "s \<subseteq> t"
11.3830 + from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
11.3831 + by (auto simp add: hassize_def intro: span_superset)}
11.3832 + moreover
11.3833 + {assume st: "t \<subseteq> s"
11.3834 +
11.3835 + from spanning_subset_independent[OF st s sp]
11.3836 + st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t])
11.3837 + by (auto simp add: hassize_def intro: span_superset)}
11.3838 + moreover
11.3839 + {assume st: "\<not> s \<subseteq> t" "\<not> t \<subseteq> s"
11.3840 + from st(2) obtain b where b: "b \<in> t" "b \<notin> s" by blast
11.3841 + from b have "t - {b} - s \<subset> t - s" by blast
11.3842 + then have cardlt: "card (t - {b} - s) < n" using n ft
11.3843 + by (auto intro: psubset_card_mono)
11.3844 + from b ft have ct0: "card t \<noteq> 0" by auto
11.3845 + {assume stb: "s \<subseteq> span(t -{b})"
11.3846 + from ft have ftb: "finite (t -{b})" by auto
11.3847 + from H[rule_format, OF cardlt ftb s stb]
11.3848 + obtain u where u: "u hassize card (t-{b})" "s \<subseteq> u" "u \<subseteq> s \<union> (t - {b})" "s \<subseteq> span u" by blast
11.3849 + let ?w = "insert b u"
11.3850 + have th0: "s \<subseteq> insert b u" using u by blast
11.3851 + from u(3) b have "u \<subseteq> s \<union> t" by blast
11.3852 + then have th1: "insert b u \<subseteq> s \<union> t" using u b by blast
11.3853 + have bu: "b \<notin> u" using b u by blast
11.3854 + from u(1) have fu: "finite u" by (simp add: hassize_def)
11.3855 + from u(1) ft b have "u hassize (card t - 1)" by auto
11.3856 + then
11.3857 + have th2: "insert b u hassize card t"
11.3858 + using card_insert_disjoint[OF fu bu] ct0 by (auto simp add: hassize_def)
11.3859 + from u(4) have "s \<subseteq> span u" .
11.3860 + also have "\<dots> \<subseteq> span (insert b u)" apply (rule span_mono) by blast
11.3861 + finally have th3: "s \<subseteq> span (insert b u)" . from th0 th1 th2 th3 have th: "?P ?w" by blast
11.3862 + from th have ?ths by blast}
11.3863 + moreover
11.3864 + {assume stb: "\<not> s \<subseteq> span(t -{b})"
11.3865 + from stb obtain a where a: "a \<in> s" "a \<notin> span (t - {b})" by blast
11.3866 + have ab: "a \<noteq> b" using a b by blast
11.3867 + have at: "a \<notin> t" using a ab span_superset[of a "t- {b}"] by auto
11.3868 + have mlt: "card ((insert a (t - {b})) - s) < n"
11.3869 + using cardlt ft n a b by auto
11.3870 + have ft': "finite (insert a (t - {b}))" using ft by auto
11.3871 + {fix x assume xs: "x \<in> s"
11.3872 + have t: "t \<subseteq> (insert b (insert a (t -{b})))" using b by auto
11.3873 + from b(1) have "b \<in> span t" by (simp add: span_superset)
11.3874 + have bs: "b \<in> span (insert a (t - {b}))"
11.3875 + by (metis in_span_delete a sp mem_def subset_eq)
11.3876 + from xs sp have "x \<in> span t" by blast
11.3877 + with span_mono[OF t]
11.3878 + have x: "x \<in> span (insert b (insert a (t - {b})))" ..
11.3879 + from span_trans[OF bs x] have "x \<in> span (insert a (t - {b}))" .}
11.3880 + then have sp': "s \<subseteq> span (insert a (t - {b}))" by blast
11.3881 +
11.3882 + from H[rule_format, OF mlt ft' s sp' refl] obtain u where
11.3883 + u: "u hassize card (insert a (t -{b}))" "s \<subseteq> u" "u \<subseteq> s \<union> insert a (t -{b})"
11.3884 + "s \<subseteq> span u" by blast
11.3885 + from u a b ft at ct0 have "?P u" by (auto simp add: hassize_def)
11.3886 + then have ?ths by blast }
11.3887 + ultimately have ?ths by blast
11.3888 + }
11.3889 + ultimately
11.3890 + show ?ths by blast
11.3891 +qed
11.3892 +
11.3893 +(* This implies corresponding size bounds. *)
11.3894 +
11.3895 +lemma independent_span_bound:
11.3896 + assumes f: "finite t" and i: "independent (s::('a::field^'n) set)" and sp:"s \<subseteq> span t"
11.3897 + shows "finite s \<and> card s \<le> card t"
11.3898 + by (metis exchange_lemma[OF f i sp] hassize_def finite_subset card_mono)
11.3899 +
11.3900 +
11.3901 +lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\<in> (UNIV::'a::finite set)}"
11.3902 +proof-
11.3903 + have eq: "{f x |x. x\<in> UNIV} = f ` UNIV" by auto
11.3904 + show ?thesis unfolding eq
11.3905 + apply (rule finite_imageI)
11.3906 + apply (rule finite)
11.3907 + done
11.3908 +qed
11.3909 +
11.3910 +
11.3911 +lemma independent_bound:
11.3912 + fixes S:: "(real^'n::finite) set"
11.3913 + shows "independent S \<Longrightarrow> finite S \<and> card S <= CARD('n)"
11.3914 + apply (subst card_stdbasis[symmetric])
11.3915 + apply (rule independent_span_bound)
11.3916 + apply (rule finite_Atleast_Atmost_nat)
11.3917 + apply assumption
11.3918 + unfolding span_stdbasis
11.3919 + apply (rule subset_UNIV)
11.3920 + done
11.3921 +
11.3922 +lemma dependent_biggerset: "(finite (S::(real ^'n::finite) set) ==> card S > CARD('n)) ==> dependent S"
11.3923 + by (metis independent_bound not_less)
11.3924 +
11.3925 +(* Hence we can create a maximal independent subset. *)
11.3926 +
11.3927 +lemma maximal_independent_subset_extend:
11.3928 + assumes sv: "(S::(real^'n::finite) set) \<subseteq> V" and iS: "independent S"
11.3929 + shows "\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
11.3930 + using sv iS
11.3931 +proof(induct d\<equiv> "CARD('n) - card S" arbitrary: S rule: nat_less_induct)
11.3932 + fix n and S:: "(real^'n) set"
11.3933 + assume H: "\<forall>m<n. \<forall>S \<subseteq> V. independent S \<longrightarrow> m = CARD('n) - card S \<longrightarrow>
11.3934 + (\<exists>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B)"
11.3935 + and sv: "S \<subseteq> V" and i: "independent S" and n: "n = CARD('n) - card S"
11.3936 + let ?P = "\<lambda>B. S \<subseteq> B \<and> B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
11.3937 + let ?ths = "\<exists>x. ?P x"
11.3938 + let ?d = "CARD('n)"
11.3939 + {assume "V \<subseteq> span S"
11.3940 + then have ?ths using sv i by blast }
11.3941 + moreover
11.3942 + {assume VS: "\<not> V \<subseteq> span S"
11.3943 + from VS obtain a where a: "a \<in> V" "a \<notin> span S" by blast
11.3944 + from a have aS: "a \<notin> S" by (auto simp add: span_superset)
11.3945 + have th0: "insert a S \<subseteq> V" using a sv by blast
11.3946 + from independent_insert[of a S] i a
11.3947 + have th1: "independent (insert a S)" by auto
11.3948 + have mlt: "?d - card (insert a S) < n"
11.3949 + using aS a n independent_bound[OF th1]
11.3950 + by auto
11.3951 +
11.3952 + from H[rule_format, OF mlt th0 th1 refl]
11.3953 + obtain B where B: "insert a S \<subseteq> B" "B \<subseteq> V" "independent B" " V \<subseteq> span B"
11.3954 + by blast
11.3955 + from B have "?P B" by auto
11.3956 + then have ?ths by blast}
11.3957 + ultimately show ?ths by blast
11.3958 +qed
11.3959 +
11.3960 +lemma maximal_independent_subset:
11.3961 + "\<exists>(B:: (real ^'n::finite) set). B\<subseteq> V \<and> independent B \<and> V \<subseteq> span B"
11.3962 + by (metis maximal_independent_subset_extend[of "{}:: (real ^'n) set"] empty_subsetI independent_empty)
11.3963 +
11.3964 +(* Notion of dimension. *)
11.3965 +
11.3966 +definition "dim V = (SOME n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n))"
11.3967 +
11.3968 +lemma basis_exists: "\<exists>B. (B :: (real ^'n::finite) set) \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize dim V)"
11.3969 +unfolding dim_def some_eq_ex[of "\<lambda>n. \<exists>B. B \<subseteq> V \<and> independent B \<and> V \<subseteq> span B \<and> (B hassize n)"]
11.3970 +unfolding hassize_def
11.3971 +using maximal_independent_subset[of V] independent_bound
11.3972 +by auto
11.3973 +
11.3974 +(* Consequences of independence or spanning for cardinality. *)
11.3975 +
11.3976 +lemma independent_card_le_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B \<le> dim V"
11.3977 +by (metis basis_exists[of V] independent_span_bound[where ?'a=real] hassize_def subset_trans)
11.3978 +
11.3979 +lemma span_card_ge_dim: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> finite B \<Longrightarrow> dim V \<le> card B"
11.3980 + by (metis basis_exists[of V] independent_span_bound hassize_def subset_trans)
11.3981 +
11.3982 +lemma basis_card_eq_dim:
11.3983 + "B \<subseteq> (V:: (real ^'n::finite) set) \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> finite B \<and> card B = dim V"
11.3984 + by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_mono)
11.3985 +
11.3986 +lemma dim_unique: "(B::(real ^'n::finite) set) \<subseteq> V \<Longrightarrow> V \<subseteq> span B \<Longrightarrow> independent B \<Longrightarrow> B hassize n \<Longrightarrow> dim V = n"
11.3987 + by (metis basis_card_eq_dim hassize_def)
11.3988 +
11.3989 +(* More lemmas about dimension. *)
11.3990 +
11.3991 +lemma dim_univ: "dim (UNIV :: (real^'n::finite) set) = CARD('n)"
11.3992 + apply (rule dim_unique[of "{basis i |i. i\<in> (UNIV :: 'n set)}"])
11.3993 + by (auto simp only: span_stdbasis has_size_stdbasis independent_stdbasis)
11.3994 +
11.3995 +lemma dim_subset:
11.3996 + "(S:: (real ^'n::finite) set) \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
11.3997 + using basis_exists[of T] basis_exists[of S]
11.3998 + by (metis independent_span_bound[where ?'a = real and ?'n = 'n] subset_eq hassize_def)
11.3999 +
11.4000 +lemma dim_subset_univ: "dim (S:: (real^'n::finite) set) \<le> CARD('n)"
11.4001 + by (metis dim_subset subset_UNIV dim_univ)
11.4002 +
11.4003 +(* Converses to those. *)
11.4004 +
11.4005 +lemma card_ge_dim_independent:
11.4006 + assumes BV:"(B::(real ^'n::finite) set) \<subseteq> V" and iB:"independent B" and dVB:"dim V \<le> card B"
11.4007 + shows "V \<subseteq> span B"
11.4008 +proof-
11.4009 + {fix a assume aV: "a \<in> V"
11.4010 + {assume aB: "a \<notin> span B"
11.4011 + then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert)
11.4012 + from aV BV have th0: "insert a B \<subseteq> V" by blast
11.4013 + from aB have "a \<notin>B" by (auto simp add: span_superset)
11.4014 + with independent_card_le_dim[OF th0 iaB] dVB have False by auto}
11.4015 + then have "a \<in> span B" by blast}
11.4016 + then show ?thesis by blast
11.4017 +qed
11.4018 +
11.4019 +lemma card_le_dim_spanning:
11.4020 + assumes BV: "(B:: (real ^'n::finite) set) \<subseteq> V" and VB: "V \<subseteq> span B"
11.4021 + and fB: "finite B" and dVB: "dim V \<ge> card B"
11.4022 + shows "independent B"
11.4023 +proof-
11.4024 + {fix a assume a: "a \<in> B" "a \<in> span (B -{a})"
11.4025 + from a fB have c0: "card B \<noteq> 0" by auto
11.4026 + from a fB have cb: "card (B -{a}) = card B - 1" by auto
11.4027 + from BV a have th0: "B -{a} \<subseteq> V" by blast
11.4028 + {fix x assume x: "x \<in> V"
11.4029 + from a have eq: "insert a (B -{a}) = B" by blast
11.4030 + from x VB have x': "x \<in> span B" by blast
11.4031 + from span_trans[OF a(2), unfolded eq, OF x']
11.4032 + have "x \<in> span (B -{a})" . }
11.4033 + then have th1: "V \<subseteq> span (B -{a})" by blast
11.4034 + have th2: "finite (B -{a})" using fB by auto
11.4035 + from span_card_ge_dim[OF th0 th1 th2]
11.4036 + have c: "dim V \<le> card (B -{a})" .
11.4037 + from c c0 dVB cb have False by simp}
11.4038 + then show ?thesis unfolding dependent_def by blast
11.4039 +qed
11.4040 +
11.4041 +lemma card_eq_dim: "(B:: (real ^'n::finite) set) \<subseteq> V \<Longrightarrow> B hassize dim V \<Longrightarrow> independent B \<longleftrightarrow> V \<subseteq> span B"
11.4042 + by (metis hassize_def order_eq_iff card_le_dim_spanning
11.4043 + card_ge_dim_independent)
11.4044 +
11.4045 +(* ------------------------------------------------------------------------- *)
11.4046 +(* More general size bound lemmas. *)
11.4047 +(* ------------------------------------------------------------------------- *)
11.4048 +
11.4049 +lemma independent_bound_general:
11.4050 + "independent (S:: (real^'n::finite) set) \<Longrightarrow> finite S \<and> card S \<le> dim S"
11.4051 + by (metis independent_card_le_dim independent_bound subset_refl)
11.4052 +
11.4053 +lemma dependent_biggerset_general: "(finite (S:: (real^'n::finite) set) \<Longrightarrow> card S > dim S) \<Longrightarrow> dependent S"
11.4054 + using independent_bound_general[of S] by (metis linorder_not_le)
11.4055 +
11.4056 +lemma dim_span: "dim (span (S:: (real ^'n::finite) set)) = dim S"
11.4057 +proof-
11.4058 + have th0: "dim S \<le> dim (span S)"
11.4059 + by (auto simp add: subset_eq intro: dim_subset span_superset)
11.4060 + from basis_exists[of S]
11.4061 + obtain B where B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
11.4062 + from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
11.4063 + have bSS: "B \<subseteq> span S" using B(1) by (metis subset_eq span_inc)
11.4064 + have sssB: "span S \<subseteq> span B" using span_mono[OF B(3)] by (simp add: span_span)
11.4065 + from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis
11.4066 + using fB(2) by arith
11.4067 +qed
11.4068 +
11.4069 +lemma subset_le_dim: "(S:: (real ^'n::finite) set) \<subseteq> span T \<Longrightarrow> dim S \<le> dim T"
11.4070 + by (metis dim_span dim_subset)
11.4071 +
11.4072 +lemma span_eq_dim: "span (S:: (real ^'n::finite) set) = span T ==> dim S = dim T"
11.4073 + by (metis dim_span)
11.4074 +
11.4075 +lemma spans_image:
11.4076 + assumes lf: "linear (f::'a::semiring_1^'n \<Rightarrow> _)" and VB: "V \<subseteq> span B"
11.4077 + shows "f ` V \<subseteq> span (f ` B)"
11.4078 + unfolding span_linear_image[OF lf]
11.4079 + by (metis VB image_mono)
11.4080 +
11.4081 +lemma dim_image_le:
11.4082 + fixes f :: "real^'n::finite \<Rightarrow> real^'m::finite"
11.4083 + assumes lf: "linear f" shows "dim (f ` S) \<le> dim (S:: (real ^'n::finite) set)"
11.4084 +proof-
11.4085 + from basis_exists[of S] obtain B where
11.4086 + B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
11.4087 + from B have fB: "finite B" "card B = dim S" unfolding hassize_def by blast+
11.4088 + have "dim (f ` S) \<le> card (f ` B)"
11.4089 + apply (rule span_card_ge_dim)
11.4090 + using lf B fB by (auto simp add: span_linear_image spans_image subset_image_iff)
11.4091 + also have "\<dots> \<le> dim S" using card_image_le[OF fB(1)] fB by simp
11.4092 + finally show ?thesis .
11.4093 +qed
11.4094 +
11.4095 +(* Relation between bases and injectivity/surjectivity of map. *)
11.4096 +
11.4097 +lemma spanning_surjective_image:
11.4098 + assumes us: "UNIV \<subseteq> span (S:: ('a::semiring_1 ^'n) set)"
11.4099 + and lf: "linear f" and sf: "surj f"
11.4100 + shows "UNIV \<subseteq> span (f ` S)"
11.4101 +proof-
11.4102 + have "UNIV \<subseteq> f ` UNIV" using sf by (auto simp add: surj_def)
11.4103 + also have " \<dots> \<subseteq> span (f ` S)" using spans_image[OF lf us] .
11.4104 +finally show ?thesis .
11.4105 +qed
11.4106 +
11.4107 +lemma independent_injective_image:
11.4108 + assumes iS: "independent (S::('a::semiring_1^'n) set)" and lf: "linear f" and fi: "inj f"
11.4109 + shows "independent (f ` S)"
11.4110 +proof-
11.4111 + {fix a assume a: "a \<in> S" "f a \<in> span (f ` S - {f a})"
11.4112 + have eq: "f ` S - {f a} = f ` (S - {a})" using fi
11.4113 + by (auto simp add: inj_on_def)
11.4114 + from a have "f a \<in> f ` span (S -{a})"
11.4115 + unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast
11.4116 + hence "a \<in> span (S -{a})" using fi by (auto simp add: inj_on_def)
11.4117 + with a(1) iS have False by (simp add: dependent_def) }
11.4118 + then show ?thesis unfolding dependent_def by blast
11.4119 +qed
11.4120 +
11.4121 +(* ------------------------------------------------------------------------- *)
11.4122 +(* Picking an orthogonal replacement for a spanning set. *)
11.4123 +(* ------------------------------------------------------------------------- *)
11.4124 + (* FIXME : Move to some general theory ?*)
11.4125 +definition "pairwise R S \<longleftrightarrow> (\<forall>x \<in> S. \<forall>y\<in> S. x\<noteq>y \<longrightarrow> R x y)"
11.4126 +
11.4127 +lemma vector_sub_project_orthogonal: "(b::'a::ordered_field^'n::finite) \<bullet> (x - ((b \<bullet> x) / (b\<bullet>b)) *s b) = 0"
11.4128 + apply (cases "b = 0", simp)
11.4129 + apply (simp add: dot_rsub dot_rmult)
11.4130 + unfolding times_divide_eq_right[symmetric]
11.4131 + by (simp add: field_simps dot_eq_0)
11.4132 +
11.4133 +lemma basis_orthogonal:
11.4134 + fixes B :: "(real ^'n::finite) set"
11.4135 + assumes fB: "finite B"
11.4136 + shows "\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C"
11.4137 + (is " \<exists>C. ?P B C")
11.4138 +proof(induct rule: finite_induct[OF fB])
11.4139 + case 1 thus ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def)
11.4140 +next
11.4141 + case (2 a B)
11.4142 + note fB = `finite B` and aB = `a \<notin> B`
11.4143 + from `\<exists>C. finite C \<and> card C \<le> card B \<and> span C = span B \<and> pairwise orthogonal C`
11.4144 + obtain C where C: "finite C" "card C \<le> card B"
11.4145 + "span C = span B" "pairwise orthogonal C" by blast
11.4146 + let ?a = "a - setsum (\<lambda>x. (x\<bullet>a / (x\<bullet>x)) *s x) C"
11.4147 + let ?C = "insert ?a C"
11.4148 + from C(1) have fC: "finite ?C" by simp
11.4149 + from fB aB C(1,2) have cC: "card ?C \<le> card (insert a B)" by (simp add: card_insert_if)
11.4150 + {fix x k
11.4151 + have th0: "\<And>(a::'b::comm_ring) b c. a - (b - c) = c + (a - b)" by (simp add: ring_simps)
11.4152 + have "x - k *s (a - (\<Sum>x\<in>C. (x \<bullet> a / (x \<bullet> x)) *s x)) \<in> span C \<longleftrightarrow> x - k *s a \<in> span C"
11.4153 + apply (simp only: vector_ssub_ldistrib th0)
11.4154 + apply (rule span_add_eq)
11.4155 + apply (rule span_mul)
11.4156 + apply (rule span_setsum[OF C(1)])
11.4157 + apply clarify
11.4158 + apply (rule span_mul)
11.4159 + by (rule span_superset)}
11.4160 + then have SC: "span ?C = span (insert a B)"
11.4161 + unfolding expand_set_eq span_breakdown_eq C(3)[symmetric] by auto
11.4162 + thm pairwise_def
11.4163 + {fix x y assume xC: "x \<in> ?C" and yC: "y \<in> ?C" and xy: "x \<noteq> y"
11.4164 + {assume xa: "x = ?a" and ya: "y = ?a"
11.4165 + have "orthogonal x y" using xa ya xy by blast}
11.4166 + moreover
11.4167 + {assume xa: "x = ?a" and ya: "y \<noteq> ?a" "y \<in> C"
11.4168 + from ya have Cy: "C = insert y (C - {y})" by blast
11.4169 + have fth: "finite (C - {y})" using C by simp
11.4170 + have "orthogonal x y"
11.4171 + using xa ya
11.4172 + unfolding orthogonal_def xa dot_lsub dot_rsub diff_eq_0_iff_eq
11.4173 + apply simp
11.4174 + apply (subst Cy)
11.4175 + using C(1) fth
11.4176 + apply (simp only: setsum_clauses)
11.4177 + thm dot_ladd
11.4178 + apply (auto simp add: dot_ladd dot_radd dot_lmult dot_rmult dot_eq_0 dot_sym[of y a] dot_lsum[OF fth])
11.4179 + apply (rule setsum_0')
11.4180 + apply clarsimp
11.4181 + apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
11.4182 + by auto}
11.4183 + moreover
11.4184 + {assume xa: "x \<noteq> ?a" "x \<in> C" and ya: "y = ?a"
11.4185 + from xa have Cx: "C = insert x (C - {x})" by blast
11.4186 + have fth: "finite (C - {x})" using C by simp
11.4187 + have "orthogonal x y"
11.4188 + using xa ya
11.4189 + unfolding orthogonal_def ya dot_rsub dot_lsub diff_eq_0_iff_eq
11.4190 + apply simp
11.4191 + apply (subst Cx)
11.4192 + using C(1) fth
11.4193 + apply (simp only: setsum_clauses)
11.4194 + apply (subst dot_sym[of x])
11.4195 + apply (auto simp add: dot_radd dot_rmult dot_eq_0 dot_sym[of x a] dot_rsum[OF fth])
11.4196 + apply (rule setsum_0')
11.4197 + apply clarsimp
11.4198 + apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format])
11.4199 + by auto}
11.4200 + moreover
11.4201 + {assume xa: "x \<in> C" and ya: "y \<in> C"
11.4202 + have "orthogonal x y" using xa ya xy C(4) unfolding pairwise_def by blast}
11.4203 + ultimately have "orthogonal x y" using xC yC by blast}
11.4204 + then have CPO: "pairwise orthogonal ?C" unfolding pairwise_def by blast
11.4205 + from fC cC SC CPO have "?P (insert a B) ?C" by blast
11.4206 + then show ?case by blast
11.4207 +qed
11.4208 +
11.4209 +lemma orthogonal_basis_exists:
11.4210 + fixes V :: "(real ^'n::finite) set"
11.4211 + shows "\<exists>B. independent B \<and> B \<subseteq> span V \<and> V \<subseteq> span B \<and> (B hassize dim V) \<and> pairwise orthogonal B"
11.4212 +proof-
11.4213 + from basis_exists[of V] obtain B where B: "B \<subseteq> V" "independent B" "V \<subseteq> span B" "B hassize dim V" by blast
11.4214 + from B have fB: "finite B" "card B = dim V" by (simp_all add: hassize_def)
11.4215 + from basis_orthogonal[OF fB(1)] obtain C where
11.4216 + C: "finite C" "card C \<le> card B" "span C = span B" "pairwise orthogonal C" by blast
11.4217 + from C B
11.4218 + have CSV: "C \<subseteq> span V" by (metis span_inc span_mono subset_trans)
11.4219 + from span_mono[OF B(3)] C have SVC: "span V \<subseteq> span C" by (simp add: span_span)
11.4220 + from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB
11.4221 + have iC: "independent C" by (simp add: dim_span)
11.4222 + from C fB have "card C \<le> dim V" by simp
11.4223 + moreover have "dim V \<le> card C" using span_card_ge_dim[OF CSV SVC C(1)]
11.4224 + by (simp add: dim_span)
11.4225 + ultimately have CdV: "C hassize dim V" unfolding hassize_def using C(1) by simp
11.4226 + from C B CSV CdV iC show ?thesis by auto
11.4227 +qed
11.4228 +
11.4229 +lemma span_eq: "span S = span T \<longleftrightarrow> S \<subseteq> span T \<and> T \<subseteq> span S"
11.4230 + by (metis set_eq_subset span_mono span_span span_inc) (* FIXME: slow *)
11.4231 +
11.4232 +(* ------------------------------------------------------------------------- *)
11.4233 +(* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *)
11.4234 +(* ------------------------------------------------------------------------- *)
11.4235 +
11.4236 +lemma span_not_univ_orthogonal:
11.4237 + assumes sU: "span S \<noteq> UNIV"
11.4238 + shows "\<exists>(a:: real ^'n::finite). a \<noteq>0 \<and> (\<forall>x \<in> span S. a \<bullet> x = 0)"
11.4239 +proof-
11.4240 + from sU obtain a where a: "a \<notin> span S" by blast
11.4241 + from orthogonal_basis_exists obtain B where
11.4242 + B: "independent B" "B \<subseteq> span S" "S \<subseteq> span B" "B hassize dim S" "pairwise orthogonal B"
11.4243 + by blast
11.4244 + from B have fB: "finite B" "card B = dim S" by (simp_all add: hassize_def)
11.4245 + from span_mono[OF B(2)] span_mono[OF B(3)]
11.4246 + have sSB: "span S = span B" by (simp add: span_span)
11.4247 + let ?a = "a - setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B"
11.4248 + have "setsum (\<lambda>b. (a\<bullet>b / (b\<bullet>b)) *s b) B \<in> span S"
11.4249 + unfolding sSB
11.4250 + apply (rule span_setsum[OF fB(1)])
11.4251 + apply clarsimp
11.4252 + apply (rule span_mul)
11.4253 + by (rule span_superset)
11.4254 + with a have a0:"?a \<noteq> 0" by auto
11.4255 + have "\<forall>x\<in>span B. ?a \<bullet> x = 0"
11.4256 + proof(rule span_induct')
11.4257 + show "subspace (\<lambda>x. ?a \<bullet> x = 0)"
11.4258 + by (auto simp add: subspace_def mem_def dot_radd dot_rmult)
11.4259 + next
11.4260 + {fix x assume x: "x \<in> B"
11.4261 + from x have B': "B = insert x (B - {x})" by blast
11.4262 + have fth: "finite (B - {x})" using fB by simp
11.4263 + have "?a \<bullet> x = 0"
11.4264 + apply (subst B') using fB fth
11.4265 + unfolding setsum_clauses(2)[OF fth]
11.4266 + apply simp
11.4267 + apply (clarsimp simp add: dot_lsub dot_ladd dot_lmult dot_lsum dot_eq_0)
11.4268 + apply (rule setsum_0', rule ballI)
11.4269 + unfolding dot_sym
11.4270 + by (auto simp add: x field_simps dot_eq_0 intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format])}
11.4271 + then show "\<forall>x \<in> B. ?a \<bullet> x = 0" by blast
11.4272 + qed
11.4273 + with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"])
11.4274 +qed
11.4275 +
11.4276 +lemma span_not_univ_subset_hyperplane:
11.4277 + assumes SU: "span S \<noteq> (UNIV ::(real^'n::finite) set)"
11.4278 + shows "\<exists> a. a \<noteq>0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
11.4279 + using span_not_univ_orthogonal[OF SU] by auto
11.4280 +
11.4281 +lemma lowdim_subset_hyperplane:
11.4282 + assumes d: "dim S < CARD('n::finite)"
11.4283 + shows "\<exists>(a::real ^'n::finite). a \<noteq> 0 \<and> span S \<subseteq> {x. a \<bullet> x = 0}"
11.4284 +proof-
11.4285 + {assume "span S = UNIV"
11.4286 + hence "dim (span S) = dim (UNIV :: (real ^'n) set)" by simp
11.4287 + hence "dim S = CARD('n)" by (simp add: dim_span dim_univ)
11.4288 + with d have False by arith}
11.4289 + hence th: "span S \<noteq> UNIV" by blast
11.4290 + from span_not_univ_subset_hyperplane[OF th] show ?thesis .
11.4291 +qed
11.4292 +
11.4293 +(* We can extend a linear basis-basis injection to the whole set. *)
11.4294 +
11.4295 +lemma linear_indep_image_lemma:
11.4296 + assumes lf: "linear f" and fB: "finite B"
11.4297 + and ifB: "independent (f ` B)"
11.4298 + and fi: "inj_on f B" and xsB: "x \<in> span B"
11.4299 + and fx: "f (x::'a::field^'n) = 0"
11.4300 + shows "x = 0"
11.4301 + using fB ifB fi xsB fx
11.4302 +proof(induct arbitrary: x rule: finite_induct[OF fB])
11.4303 + case 1 thus ?case by (auto simp add: span_empty)
11.4304 +next
11.4305 + case (2 a b x)
11.4306 + have fb: "finite b" using "2.prems" by simp
11.4307 + have th0: "f ` b \<subseteq> f ` (insert a b)"
11.4308 + apply (rule image_mono) by blast
11.4309 + from independent_mono[ OF "2.prems"(2) th0]
11.4310 + have ifb: "independent (f ` b)" .
11.4311 + have fib: "inj_on f b"
11.4312 + apply (rule subset_inj_on [OF "2.prems"(3)])
11.4313 + by blast
11.4314 + from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)]
11.4315 + obtain k where k: "x - k*s a \<in> span (b -{a})" by blast
11.4316 + have "f (x - k*s a) \<in> span (f ` b)"
11.4317 + unfolding span_linear_image[OF lf]
11.4318 + apply (rule imageI)
11.4319 + using k span_mono[of "b-{a}" b] by blast
11.4320 + hence "f x - k*s f a \<in> span (f ` b)"
11.4321 + by (simp add: linear_sub[OF lf] linear_cmul[OF lf])
11.4322 + hence th: "-k *s f a \<in> span (f ` b)"
11.4323 + using "2.prems"(5) by (simp add: vector_smult_lneg)
11.4324 + {assume k0: "k = 0"
11.4325 + from k0 k have "x \<in> span (b -{a})" by simp
11.4326 + then have "x \<in> span b" using span_mono[of "b-{a}" b]
11.4327 + by blast}
11.4328 + moreover
11.4329 + {assume k0: "k \<noteq> 0"
11.4330 + from span_mul[OF th, of "- 1/ k"] k0
11.4331 + have th1: "f a \<in> span (f ` b)"
11.4332 + by (auto simp add: vector_smult_assoc)
11.4333 + from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric]
11.4334 + have tha: "f ` insert a b - f ` {a} = f ` (insert a b - {a})" by blast
11.4335 + from "2.prems"(2)[unfolded dependent_def bex_simps(10), rule_format, of "f a"]
11.4336 + have "f a \<notin> span (f ` b)" using tha
11.4337 + using "2.hyps"(2)
11.4338 + "2.prems"(3) by auto
11.4339 + with th1 have False by blast
11.4340 + then have "x \<in> span b" by blast}
11.4341 + ultimately have xsb: "x \<in> span b" by blast
11.4342 + from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)]
11.4343 + show "x = 0" .
11.4344 +qed
11.4345 +
11.4346 +(* We can extend a linear mapping from basis. *)
11.4347 +
11.4348 +lemma linear_independent_extend_lemma:
11.4349 + assumes fi: "finite B" and ib: "independent B"
11.4350 + shows "\<exists>g. (\<forall>x\<in> span B. \<forall>y\<in> span B. g ((x::'a::field^'n) + y) = g x + g y)
11.4351 + \<and> (\<forall>x\<in> span B. \<forall>c. g (c*s x) = c *s g x)
11.4352 + \<and> (\<forall>x\<in> B. g x = f x)"
11.4353 +using ib fi
11.4354 +proof(induct rule: finite_induct[OF fi])
11.4355 + case 1 thus ?case by (auto simp add: span_empty)
11.4356 +next
11.4357 + case (2 a b)
11.4358 + from "2.prems" "2.hyps" have ibf: "independent b" "finite b"
11.4359 + by (simp_all add: independent_insert)
11.4360 + from "2.hyps"(3)[OF ibf] obtain g where
11.4361 + g: "\<forall>x\<in>span b. \<forall>y\<in>span b. g (x + y) = g x + g y"
11.4362 + "\<forall>x\<in>span b. \<forall>c. g (c *s x) = c *s g x" "\<forall>x\<in>b. g x = f x" by blast
11.4363 + let ?h = "\<lambda>z. SOME k. (z - k *s a) \<in> span b"
11.4364 + {fix z assume z: "z \<in> span (insert a b)"
11.4365 + have th0: "z - ?h z *s a \<in> span b"
11.4366 + apply (rule someI_ex)
11.4367 + unfolding span_breakdown_eq[symmetric]
11.4368 + using z .
11.4369 + {fix k assume k: "z - k *s a \<in> span b"
11.4370 + have eq: "z - ?h z *s a - (z - k*s a) = (k - ?h z) *s a"
11.4371 + by (simp add: ring_simps vector_sadd_rdistrib[symmetric])
11.4372 + from span_sub[OF th0 k]
11.4373 + have khz: "(k - ?h z) *s a \<in> span b" by (simp add: eq)
11.4374 + {assume "k \<noteq> ?h z" hence k0: "k - ?h z \<noteq> 0" by simp
11.4375 + from k0 span_mul[OF khz, of "1 /(k - ?h z)"]
11.4376 + have "a \<in> span b" by (simp add: vector_smult_assoc)
11.4377 + with "2.prems"(1) "2.hyps"(2) have False
11.4378 + by (auto simp add: dependent_def)}
11.4379 + then have "k = ?h z" by blast}
11.4380 + with th0 have "z - ?h z *s a \<in> span b \<and> (\<forall>k. z - k *s a \<in> span b \<longrightarrow> k = ?h z)" by blast}
11.4381 + note h = this
11.4382 + let ?g = "\<lambda>z. ?h z *s f a + g (z - ?h z *s a)"
11.4383 + {fix x y assume x: "x \<in> span (insert a b)" and y: "y \<in> span (insert a b)"
11.4384 + have tha: "\<And>(x::'a^'n) y a k l. (x + y) - (k + l) *s a = (x - k *s a) + (y - l *s a)"
11.4385 + by (vector ring_simps)
11.4386 + have addh: "?h (x + y) = ?h x + ?h y"
11.4387 + apply (rule conjunct2[OF h, rule_format, symmetric])
11.4388 + apply (rule span_add[OF x y])
11.4389 + unfolding tha
11.4390 + by (metis span_add x y conjunct1[OF h, rule_format])
11.4391 + have "?g (x + y) = ?g x + ?g y"
11.4392 + unfolding addh tha
11.4393 + g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]]
11.4394 + by (simp add: vector_sadd_rdistrib)}
11.4395 + moreover
11.4396 + {fix x:: "'a^'n" and c:: 'a assume x: "x \<in> span (insert a b)"
11.4397 + have tha: "\<And>(x::'a^'n) c k a. c *s x - (c * k) *s a = c *s (x - k *s a)"
11.4398 + by (vector ring_simps)
11.4399 + have hc: "?h (c *s x) = c * ?h x"
11.4400 + apply (rule conjunct2[OF h, rule_format, symmetric])
11.4401 + apply (metis span_mul x)
11.4402 + by (metis tha span_mul x conjunct1[OF h])
11.4403 + have "?g (c *s x) = c*s ?g x"
11.4404 + unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]]
11.4405 + by (vector ring_simps)}
11.4406 + moreover
11.4407 + {fix x assume x: "x \<in> (insert a b)"
11.4408 + {assume xa: "x = a"
11.4409 + have ha1: "1 = ?h a"
11.4410 + apply (rule conjunct2[OF h, rule_format])
11.4411 + apply (metis span_superset insertI1)
11.4412 + using conjunct1[OF h, OF span_superset, OF insertI1]
11.4413 + by (auto simp add: span_0)
11.4414 +
11.4415 + from xa ha1[symmetric] have "?g x = f x"
11.4416 + apply simp
11.4417 + using g(2)[rule_format, OF span_0, of 0]
11.4418 + by simp}
11.4419 + moreover
11.4420 + {assume xb: "x \<in> b"
11.4421 + have h0: "0 = ?h x"
11.4422 + apply (rule conjunct2[OF h, rule_format])
11.4423 + apply (metis span_superset insertI1 xb x)
11.4424 + apply simp
11.4425 + apply (metis span_superset xb)
11.4426 + done
11.4427 + have "?g x = f x"
11.4428 + by (simp add: h0[symmetric] g(3)[rule_format, OF xb])}
11.4429 + ultimately have "?g x = f x" using x by blast }
11.4430 + ultimately show ?case apply - apply (rule exI[where x="?g"]) by blast
11.4431 +qed
11.4432 +
11.4433 +lemma linear_independent_extend:
11.4434 + assumes iB: "independent (B:: (real ^'n::finite) set)"
11.4435 + shows "\<exists>g. linear g \<and> (\<forall>x\<in>B. g x = f x)"
11.4436 +proof-
11.4437 + from maximal_independent_subset_extend[of B UNIV] iB
11.4438 + obtain C where C: "B \<subseteq> C" "independent C" "\<And>x. x \<in> span C" by auto
11.4439 +
11.4440 + from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f]
11.4441 + obtain g where g: "(\<forall>x\<in> span C. \<forall>y\<in> span C. g (x + y) = g x + g y)
11.4442 + \<and> (\<forall>x\<in> span C. \<forall>c. g (c*s x) = c *s g x)
11.4443 + \<and> (\<forall>x\<in> C. g x = f x)" by blast
11.4444 + from g show ?thesis unfolding linear_def using C
11.4445 + apply clarsimp by blast
11.4446 +qed
11.4447 +
11.4448 +(* Can construct an isomorphism between spaces of same dimension. *)
11.4449 +
11.4450 +lemma card_le_inj: assumes fA: "finite A" and fB: "finite B"
11.4451 + and c: "card A \<le> card B" shows "(\<exists>f. f ` A \<subseteq> B \<and> inj_on f A)"
11.4452 +using fB c
11.4453 +proof(induct arbitrary: B rule: finite_induct[OF fA])
11.4454 + case 1 thus ?case by simp
11.4455 +next
11.4456 + case (2 x s t)
11.4457 + thus ?case
11.4458 + proof(induct rule: finite_induct[OF "2.prems"(1)])
11.4459 + case 1 then show ?case by simp
11.4460 + next
11.4461 + case (2 y t)
11.4462 + from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \<le> card t" by simp
11.4463 + from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where
11.4464 + f: "f ` s \<subseteq> t \<and> inj_on f s" by blast
11.4465 + from f "2.prems"(2) "2.hyps"(2) show ?case
11.4466 + apply -
11.4467 + apply (rule exI[where x = "\<lambda>z. if z = x then y else f z"])
11.4468 + by (auto simp add: inj_on_def)
11.4469 + qed
11.4470 +qed
11.4471 +
11.4472 +lemma card_subset_eq: assumes fB: "finite B" and AB: "A \<subseteq> B" and
11.4473 + c: "card A = card B"
11.4474 + shows "A = B"
11.4475 +proof-
11.4476 + from fB AB have fA: "finite A" by (auto intro: finite_subset)
11.4477 + from fA fB have fBA: "finite (B - A)" by auto
11.4478 + have e: "A \<inter> (B - A) = {}" by blast
11.4479 + have eq: "A \<union> (B - A) = B" using AB by blast
11.4480 + from card_Un_disjoint[OF fA fBA e, unfolded eq c]
11.4481 + have "card (B - A) = 0" by arith
11.4482 + hence "B - A = {}" unfolding card_eq_0_iff using fA fB by simp
11.4483 + with AB show "A = B" by blast
11.4484 +qed
11.4485 +
11.4486 +lemma subspace_isomorphism:
11.4487 + assumes s: "subspace (S:: (real ^'n::finite) set)"
11.4488 + and t: "subspace (T :: (real ^ 'm::finite) set)"
11.4489 + and d: "dim S = dim T"
11.4490 + shows "\<exists>f. linear f \<and> f ` S = T \<and> inj_on f S"
11.4491 +proof-
11.4492 + from basis_exists[of S] obtain B where
11.4493 + B: "B \<subseteq> S" "independent B" "S \<subseteq> span B" "B hassize dim S" by blast
11.4494 + from basis_exists[of T] obtain C where
11.4495 + C: "C \<subseteq> T" "independent C" "T \<subseteq> span C" "C hassize dim T" by blast
11.4496 + from B(4) C(4) card_le_inj[of B C] d obtain f where
11.4497 + f: "f ` B \<subseteq> C" "inj_on f B" unfolding hassize_def by auto
11.4498 + from linear_independent_extend[OF B(2)] obtain g where
11.4499 + g: "linear g" "\<forall>x\<in> B. g x = f x" by blast
11.4500 + from B(4) have fB: "finite B" by (simp add: hassize_def)
11.4501 + from C(4) have fC: "finite C" by (simp add: hassize_def)
11.4502 + from inj_on_iff_eq_card[OF fB, of f] f(2)
11.4503 + have "card (f ` B) = card B" by simp
11.4504 + with B(4) C(4) have ceq: "card (f ` B) = card C" using d
11.4505 + by (simp add: hassize_def)
11.4506 + have "g ` B = f ` B" using g(2)
11.4507 + by (auto simp add: image_iff)
11.4508 + also have "\<dots> = C" using card_subset_eq[OF fC f(1) ceq] .
11.4509 + finally have gBC: "g ` B = C" .
11.4510 + have gi: "inj_on g B" using f(2) g(2)
11.4511 + by (auto simp add: inj_on_def)
11.4512 + note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi]
11.4513 + {fix x y assume x: "x \<in> S" and y: "y \<in> S" and gxy:"g x = g y"
11.4514 + from B(3) x y have x': "x \<in> span B" and y': "y \<in> span B" by blast+
11.4515 + from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)])
11.4516 + have th1: "x - y \<in> span B" using x' y' by (metis span_sub)
11.4517 + have "x=y" using g0[OF th1 th0] by simp }
11.4518 + then have giS: "inj_on g S"
11.4519 + unfolding inj_on_def by blast
11.4520 + from span_subspace[OF B(1,3) s]
11.4521 + have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)])
11.4522 + also have "\<dots> = span C" unfolding gBC ..
11.4523 + also have "\<dots> = T" using span_subspace[OF C(1,3) t] .
11.4524 + finally have gS: "g ` S = T" .
11.4525 + from g(1) gS giS show ?thesis by blast
11.4526 +qed
11.4527 +
11.4528 +(* linear functions are equal on a subspace if they are on a spanning set. *)
11.4529 +
11.4530 +lemma subspace_kernel:
11.4531 + assumes lf: "linear (f::'a::semiring_1 ^'n \<Rightarrow> _)"
11.4532 + shows "subspace {x. f x = 0}"
11.4533 +apply (simp add: subspace_def)
11.4534 +by (simp add: linear_add[OF lf] linear_cmul[OF lf] linear_0[OF lf])
11.4535 +
11.4536 +lemma linear_eq_0_span:
11.4537 + assumes lf: "linear f" and f0: "\<forall>x\<in>B. f x = 0"
11.4538 + shows "\<forall>x \<in> span B. f x = (0::'a::semiring_1 ^'n)"
11.4539 +proof
11.4540 + fix x assume x: "x \<in> span B"
11.4541 + let ?P = "\<lambda>x. f x = 0"
11.4542 + from subspace_kernel[OF lf] have "subspace ?P" unfolding Collect_def .
11.4543 + with x f0 span_induct[of B "?P" x] show "f x = 0" by blast
11.4544 +qed
11.4545 +
11.4546 +lemma linear_eq_0:
11.4547 + assumes lf: "linear f" and SB: "S \<subseteq> span B" and f0: "\<forall>x\<in>B. f x = 0"
11.4548 + shows "\<forall>x \<in> S. f x = (0::'a::semiring_1^'n)"
11.4549 + by (metis linear_eq_0_span[OF lf] subset_eq SB f0)
11.4550 +
11.4551 +lemma linear_eq:
11.4552 + assumes lf: "linear (f::'a::ring_1^'n \<Rightarrow> _)" and lg: "linear g" and S: "S \<subseteq> span B"
11.4553 + and fg: "\<forall> x\<in> B. f x = g x"
11.4554 + shows "\<forall>x\<in> S. f x = g x"
11.4555 +proof-
11.4556 + let ?h = "\<lambda>x. f x - g x"
11.4557 + from fg have fg': "\<forall>x\<in> B. ?h x = 0" by simp
11.4558 + from linear_eq_0[OF linear_compose_sub[OF lf lg] S fg']
11.4559 + show ?thesis by simp
11.4560 +qed
11.4561 +
11.4562 +lemma linear_eq_stdbasis:
11.4563 + assumes lf: "linear (f::'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite)" and lg: "linear g"
11.4564 + and fg: "\<forall>i. f (basis i) = g(basis i)"
11.4565 + shows "f = g"
11.4566 +proof-
11.4567 + let ?U = "UNIV :: 'm set"
11.4568 + let ?I = "{basis i:: 'a^'m|i. i \<in> ?U}"
11.4569 + {fix x assume x: "x \<in> (UNIV :: ('a^'m) set)"
11.4570 + from equalityD2[OF span_stdbasis]
11.4571 + have IU: " (UNIV :: ('a^'m) set) \<subseteq> span ?I" by blast
11.4572 + from linear_eq[OF lf lg IU] fg x
11.4573 + have "f x = g x" unfolding Collect_def Ball_def mem_def by metis}
11.4574 + then show ?thesis by (auto intro: ext)
11.4575 +qed
11.4576 +
11.4577 +(* Similar results for bilinear functions. *)
11.4578 +
11.4579 +lemma bilinear_eq:
11.4580 + assumes bf: "bilinear (f:: 'a::ring^'m \<Rightarrow> 'a^'n \<Rightarrow> 'a^'p)"
11.4581 + and bg: "bilinear g"
11.4582 + and SB: "S \<subseteq> span B" and TC: "T \<subseteq> span C"
11.4583 + and fg: "\<forall>x\<in> B. \<forall>y\<in> C. f x y = g x y"
11.4584 + shows "\<forall>x\<in>S. \<forall>y\<in>T. f x y = g x y "
11.4585 +proof-
11.4586 + let ?P = "\<lambda>x. \<forall>y\<in> span C. f x y = g x y"
11.4587 + from bf bg have sp: "subspace ?P"
11.4588 + unfolding bilinear_def linear_def subspace_def bf bg
11.4589 + by(auto simp add: span_0 mem_def bilinear_lzero[OF bf] bilinear_lzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf])
11.4590 +
11.4591 + have "\<forall>x \<in> span B. \<forall>y\<in> span C. f x y = g x y"
11.4592 + apply -
11.4593 + apply (rule ballI)
11.4594 + apply (rule span_induct[of B ?P])
11.4595 + defer
11.4596 + apply (rule sp)
11.4597 + apply assumption
11.4598 + apply (clarsimp simp add: Ball_def)
11.4599 + apply (rule_tac P="\<lambda>y. f xa y = g xa y" and S=C in span_induct)
11.4600 + using fg
11.4601 + apply (auto simp add: subspace_def)
11.4602 + using bf bg unfolding bilinear_def linear_def
11.4603 + by(auto simp add: span_0 mem_def bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf])
11.4604 + then show ?thesis using SB TC by (auto intro: ext)
11.4605 +qed
11.4606 +
11.4607 +lemma bilinear_eq_stdbasis:
11.4608 + assumes bf: "bilinear (f:: 'a::ring_1^'m::finite \<Rightarrow> 'a^'n::finite \<Rightarrow> 'a^'p)"
11.4609 + and bg: "bilinear g"
11.4610 + and fg: "\<forall>i j. f (basis i) (basis j) = g (basis i) (basis j)"
11.4611 + shows "f = g"
11.4612 +proof-
11.4613 + from fg have th: "\<forall>x \<in> {basis i| i. i\<in> (UNIV :: 'm set)}. \<forall>y\<in> {basis j |j. j \<in> (UNIV :: 'n set)}. f x y = g x y" by blast
11.4614 + from bilinear_eq[OF bf bg equalityD2[OF span_stdbasis] equalityD2[OF span_stdbasis] th] show ?thesis by (blast intro: ext)
11.4615 +qed
11.4616 +
11.4617 +(* Detailed theorems about left and right invertibility in general case. *)
11.4618 +
11.4619 +lemma left_invertible_transp:
11.4620 + "(\<exists>(B::'a^'n^'m). B ** transp (A::'a^'n^'m) = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). A ** B = mat 1)"
11.4621 + by (metis matrix_transp_mul transp_mat transp_transp)
11.4622 +
11.4623 +lemma right_invertible_transp:
11.4624 + "(\<exists>(B::'a^'n^'m). transp (A::'a^'n^'m) ** B = mat (1::'a::comm_semiring_1)) \<longleftrightarrow> (\<exists>(B::'a^'m^'n). B ** A = mat 1)"
11.4625 + by (metis matrix_transp_mul transp_mat transp_transp)
11.4626 +
11.4627 +lemma linear_injective_left_inverse:
11.4628 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'m::finite)" and fi: "inj f"
11.4629 + shows "\<exists>g. linear g \<and> g o f = id"
11.4630 +proof-
11.4631 + from linear_independent_extend[OF independent_injective_image, OF independent_stdbasis, OF lf fi]
11.4632 + obtain h:: "real ^'m \<Rightarrow> real ^'n" where h: "linear h" " \<forall>x \<in> f ` {basis i|i. i \<in> (UNIV::'n set)}. h x = inv f x" by blast
11.4633 + from h(2)
11.4634 + have th: "\<forall>i. (h \<circ> f) (basis i) = id (basis i)"
11.4635 + using inv_o_cancel[OF fi, unfolded stupid_ext[symmetric] id_def o_def]
11.4636 + by auto
11.4637 +
11.4638 + from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th]
11.4639 + have "h o f = id" .
11.4640 + then show ?thesis using h(1) by blast
11.4641 +qed
11.4642 +
11.4643 +lemma linear_surjective_right_inverse:
11.4644 + assumes lf: "linear (f:: real ^'m::finite \<Rightarrow> real ^'n::finite)" and sf: "surj f"
11.4645 + shows "\<exists>g. linear g \<and> f o g = id"
11.4646 +proof-
11.4647 + from linear_independent_extend[OF independent_stdbasis]
11.4648 + obtain h:: "real ^'n \<Rightarrow> real ^'m" where
11.4649 + h: "linear h" "\<forall> x\<in> {basis i| i. i\<in> (UNIV :: 'n set)}. h x = inv f x" by blast
11.4650 + from h(2)
11.4651 + have th: "\<forall>i. (f o h) (basis i) = id (basis i)"
11.4652 + using sf
11.4653 + apply (auto simp add: surj_iff o_def stupid_ext[symmetric])
11.4654 + apply (erule_tac x="basis i" in allE)
11.4655 + by auto
11.4656 +
11.4657 + from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th]
11.4658 + have "f o h = id" .
11.4659 + then show ?thesis using h(1) by blast
11.4660 +qed
11.4661 +
11.4662 +lemma matrix_left_invertible_injective:
11.4663 +"(\<exists>B. (B::real^'m^'n) ** (A::real^'n::finite^'m::finite) = mat 1) \<longleftrightarrow> (\<forall>x y. A *v x = A *v y \<longrightarrow> x = y)"
11.4664 +proof-
11.4665 + {fix B:: "real^'m^'n" and x y assume B: "B ** A = mat 1" and xy: "A *v x = A*v y"
11.4666 + from xy have "B*v (A *v x) = B *v (A*v y)" by simp
11.4667 + hence "x = y"
11.4668 + unfolding matrix_vector_mul_assoc B matrix_vector_mul_lid .}
11.4669 + moreover
11.4670 + {assume A: "\<forall>x y. A *v x = A *v y \<longrightarrow> x = y"
11.4671 + hence i: "inj (op *v A)" unfolding inj_on_def by auto
11.4672 + from linear_injective_left_inverse[OF matrix_vector_mul_linear i]
11.4673 + obtain g where g: "linear g" "g o op *v A = id" by blast
11.4674 + have "matrix g ** A = mat 1"
11.4675 + unfolding matrix_eq matrix_vector_mul_lid matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
11.4676 + using g(2) by (simp add: o_def id_def stupid_ext)
11.4677 + then have "\<exists>B. (B::real ^'m^'n) ** A = mat 1" by blast}
11.4678 + ultimately show ?thesis by blast
11.4679 +qed
11.4680 +
11.4681 +lemma matrix_left_invertible_ker:
11.4682 + "(\<exists>B. (B::real ^'m::finite^'n::finite) ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> (\<forall>x. A *v x = 0 \<longrightarrow> x = 0)"
11.4683 + unfolding matrix_left_invertible_injective
11.4684 + using linear_injective_0[OF matrix_vector_mul_linear, of A]
11.4685 + by (simp add: inj_on_def)
11.4686 +
11.4687 +lemma matrix_right_invertible_surjective:
11.4688 +"(\<exists>B. (A::real^'n::finite^'m::finite) ** (B::real^'m^'n) = mat 1) \<longleftrightarrow> surj (\<lambda>x. A *v x)"
11.4689 +proof-
11.4690 + {fix B :: "real ^'m^'n" assume AB: "A ** B = mat 1"
11.4691 + {fix x :: "real ^ 'm"
11.4692 + have "A *v (B *v x) = x"
11.4693 + by (simp add: matrix_vector_mul_lid matrix_vector_mul_assoc AB)}
11.4694 + hence "surj (op *v A)" unfolding surj_def by metis }
11.4695 + moreover
11.4696 + {assume sf: "surj (op *v A)"
11.4697 + from linear_surjective_right_inverse[OF matrix_vector_mul_linear sf]
11.4698 + obtain g:: "real ^'m \<Rightarrow> real ^'n" where g: "linear g" "op *v A o g = id"
11.4699 + by blast
11.4700 +
11.4701 + have "A ** (matrix g) = mat 1"
11.4702 + unfolding matrix_eq matrix_vector_mul_lid
11.4703 + matrix_vector_mul_assoc[symmetric] matrix_works[OF g(1)]
11.4704 + using g(2) unfolding o_def stupid_ext[symmetric] id_def
11.4705 + .
11.4706 + hence "\<exists>B. A ** (B::real^'m^'n) = mat 1" by blast
11.4707 + }
11.4708 + ultimately show ?thesis unfolding surj_def by blast
11.4709 +qed
11.4710 +
11.4711 +lemma matrix_left_invertible_independent_columns:
11.4712 + fixes A :: "real^'n::finite^'m::finite"
11.4713 + shows "(\<exists>(B::real ^'m^'n). B ** A = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s column i A) (UNIV :: 'n set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
11.4714 + (is "?lhs \<longleftrightarrow> ?rhs")
11.4715 +proof-
11.4716 + let ?U = "UNIV :: 'n set"
11.4717 + {assume k: "\<forall>x. A *v x = 0 \<longrightarrow> x = 0"
11.4718 + {fix c i assume c: "setsum (\<lambda>i. c i *s column i A) ?U = 0"
11.4719 + and i: "i \<in> ?U"
11.4720 + let ?x = "\<chi> i. c i"
11.4721 + have th0:"A *v ?x = 0"
11.4722 + using c
11.4723 + unfolding matrix_mult_vsum Cart_eq
11.4724 + by auto
11.4725 + from k[rule_format, OF th0] i
11.4726 + have "c i = 0" by (vector Cart_eq)}
11.4727 + hence ?rhs by blast}
11.4728 + moreover
11.4729 + {assume H: ?rhs
11.4730 + {fix x assume x: "A *v x = 0"
11.4731 + let ?c = "\<lambda>i. ((x$i ):: real)"
11.4732 + from H[rule_format, of ?c, unfolded matrix_mult_vsum[symmetric], OF x]
11.4733 + have "x = 0" by vector}}
11.4734 + ultimately show ?thesis unfolding matrix_left_invertible_ker by blast
11.4735 +qed
11.4736 +
11.4737 +lemma matrix_right_invertible_independent_rows:
11.4738 + fixes A :: "real^'n::finite^'m::finite"
11.4739 + shows "(\<exists>(B::real^'m^'n). A ** B = mat 1) \<longleftrightarrow> (\<forall>c. setsum (\<lambda>i. c i *s row i A) (UNIV :: 'm set) = 0 \<longrightarrow> (\<forall>i. c i = 0))"
11.4740 + unfolding left_invertible_transp[symmetric]
11.4741 + matrix_left_invertible_independent_columns
11.4742 + by (simp add: column_transp)
11.4743 +
11.4744 +lemma matrix_right_invertible_span_columns:
11.4745 + "(\<exists>(B::real ^'n::finite^'m::finite). (A::real ^'m^'n) ** B = mat 1) \<longleftrightarrow> span (columns A) = UNIV" (is "?lhs = ?rhs")
11.4746 +proof-
11.4747 + let ?U = "UNIV :: 'm set"
11.4748 + have fU: "finite ?U" by simp
11.4749 + have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y)"
11.4750 + unfolding matrix_right_invertible_surjective matrix_mult_vsum surj_def
11.4751 + apply (subst eq_commute) ..
11.4752 + have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> span (columns A))" by blast
11.4753 + {assume h: ?lhs
11.4754 + {fix x:: "real ^'n"
11.4755 + from h[unfolded lhseq, rule_format, of x] obtain y:: "real ^'m"
11.4756 + where y: "setsum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
11.4757 + have "x \<in> span (columns A)"
11.4758 + unfolding y[symmetric]
11.4759 + apply (rule span_setsum[OF fU])
11.4760 + apply clarify
11.4761 + apply (rule span_mul)
11.4762 + apply (rule span_superset)
11.4763 + unfolding columns_def
11.4764 + by blast}
11.4765 + then have ?rhs unfolding rhseq by blast}
11.4766 + moreover
11.4767 + {assume h:?rhs
11.4768 + let ?P = "\<lambda>(y::real ^'n). \<exists>(x::real^'m). setsum (\<lambda>i. (x$i) *s column i A) ?U = y"
11.4769 + {fix y have "?P y"
11.4770 + proof(rule span_induct_alt[of ?P "columns A"])
11.4771 + show "\<exists>x\<Colon>real ^ 'm. setsum (\<lambda>i. (x$i) *s column i A) ?U = 0"
11.4772 + apply (rule exI[where x=0])
11.4773 + by (simp add: zero_index vector_smult_lzero)
11.4774 + next
11.4775 + fix c y1 y2 assume y1: "y1 \<in> columns A" and y2: "?P y2"
11.4776 + from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
11.4777 + unfolding columns_def by blast
11.4778 + from y2 obtain x:: "real ^'m" where
11.4779 + x: "setsum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
11.4780 + let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::real^'m"
11.4781 + show "?P (c*s y1 + y2)"
11.4782 + proof(rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] cond_value_iff right_distrib cond_application_beta cong del: if_weak_cong)
11.4783 + fix j
11.4784 + have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
11.4785 + else (x$xa) * ((column xa A$j))) = (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))" using i(1)
11.4786 + by (simp add: ring_simps)
11.4787 + have "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
11.4788 + else (x$xa) * ((column xa A$j))) ?U = setsum (\<lambda>xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U"
11.4789 + apply (rule setsum_cong[OF refl])
11.4790 + using th by blast
11.4791 + also have "\<dots> = setsum (\<lambda>xa. if xa = i then c * ((column i A)$j) else 0) ?U + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
11.4792 + by (simp add: setsum_addf)
11.4793 + also have "\<dots> = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
11.4794 + unfolding setsum_delta[OF fU]
11.4795 + using i(1) by simp
11.4796 + finally show "setsum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
11.4797 + else (x$xa) * ((column xa A$j))) ?U = c * ((column i A)$j) + setsum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U" .
11.4798 + qed
11.4799 + next
11.4800 + show "y \<in> span (columns A)" unfolding h by blast
11.4801 + qed}
11.4802 + then have ?lhs unfolding lhseq ..}
11.4803 + ultimately show ?thesis by blast
11.4804 +qed
11.4805 +
11.4806 +lemma matrix_left_invertible_span_rows:
11.4807 + "(\<exists>(B::real^'m::finite^'n::finite). B ** (A::real^'n^'m) = mat 1) \<longleftrightarrow> span (rows A) = UNIV"
11.4808 + unfolding right_invertible_transp[symmetric]
11.4809 + unfolding columns_transp[symmetric]
11.4810 + unfolding matrix_right_invertible_span_columns
11.4811 + ..
11.4812 +
11.4813 +(* An injective map real^'n->real^'n is also surjective. *)
11.4814 +
11.4815 +lemma linear_injective_imp_surjective:
11.4816 + assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
11.4817 + shows "surj f"
11.4818 +proof-
11.4819 + let ?U = "UNIV :: (real ^'n) set"
11.4820 + from basis_exists[of ?U] obtain B
11.4821 + where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
11.4822 + by blast
11.4823 + from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
11.4824 + have th: "?U \<subseteq> span (f ` B)"
11.4825 + apply (rule card_ge_dim_independent)
11.4826 + apply blast
11.4827 + apply (rule independent_injective_image[OF B(2) lf fi])
11.4828 + apply (rule order_eq_refl)
11.4829 + apply (rule sym)
11.4830 + unfolding d
11.4831 + apply (rule card_image)
11.4832 + apply (rule subset_inj_on[OF fi])
11.4833 + by blast
11.4834 + from th show ?thesis
11.4835 + unfolding span_linear_image[OF lf] surj_def
11.4836 + using B(3) by blast
11.4837 +qed
11.4838 +
11.4839 +(* And vice versa. *)
11.4840 +
11.4841 +lemma surjective_iff_injective_gen:
11.4842 + assumes fS: "finite S" and fT: "finite T" and c: "card S = card T"
11.4843 + and ST: "f ` S \<subseteq> T"
11.4844 + shows "(\<forall>y \<in> T. \<exists>x \<in> S. f x = y) \<longleftrightarrow> inj_on f S" (is "?lhs \<longleftrightarrow> ?rhs")
11.4845 +proof-
11.4846 + {assume h: "?lhs"
11.4847 + {fix x y assume x: "x \<in> S" and y: "y \<in> S" and f: "f x = f y"
11.4848 + from x fS have S0: "card S \<noteq> 0" by auto
11.4849 + {assume xy: "x \<noteq> y"
11.4850 + have th: "card S \<le> card (f ` (S - {y}))"
11.4851 + unfolding c
11.4852 + apply (rule card_mono)
11.4853 + apply (rule finite_imageI)
11.4854 + using fS apply simp
11.4855 + using h xy x y f unfolding subset_eq image_iff
11.4856 + apply auto
11.4857 + apply (case_tac "xa = f x")
11.4858 + apply (rule bexI[where x=x])
11.4859 + apply auto
11.4860 + done
11.4861 + also have " \<dots> \<le> card (S -{y})"
11.4862 + apply (rule card_image_le)
11.4863 + using fS by simp
11.4864 + also have "\<dots> \<le> card S - 1" using y fS by simp
11.4865 + finally have False using S0 by arith }
11.4866 + then have "x = y" by blast}
11.4867 + then have ?rhs unfolding inj_on_def by blast}
11.4868 + moreover
11.4869 + {assume h: ?rhs
11.4870 + have "f ` S = T"
11.4871 + apply (rule card_subset_eq[OF fT ST])
11.4872 + unfolding card_image[OF h] using c .
11.4873 + then have ?lhs by blast}
11.4874 + ultimately show ?thesis by blast
11.4875 +qed
11.4876 +
11.4877 +lemma linear_surjective_imp_injective:
11.4878 + assumes lf: "linear (f::real ^'n::finite => real ^'n)" and sf: "surj f"
11.4879 + shows "inj f"
11.4880 +proof-
11.4881 + let ?U = "UNIV :: (real ^'n) set"
11.4882 + from basis_exists[of ?U] obtain B
11.4883 + where B: "B \<subseteq> ?U" "independent B" "?U \<subseteq> span B" "B hassize dim ?U"
11.4884 + by blast
11.4885 + {fix x assume x: "x \<in> span B" and fx: "f x = 0"
11.4886 + from B(4) have fB: "finite B" by (simp add: hassize_def)
11.4887 + from B(4) have d: "dim ?U = card B" by (simp add: hassize_def)
11.4888 + have fBi: "independent (f ` B)"
11.4889 + apply (rule card_le_dim_spanning[of "f ` B" ?U])
11.4890 + apply blast
11.4891 + using sf B(3)
11.4892 + unfolding span_linear_image[OF lf] surj_def subset_eq image_iff
11.4893 + apply blast
11.4894 + using fB apply (blast intro: finite_imageI)
11.4895 + unfolding d
11.4896 + apply (rule card_image_le)
11.4897 + apply (rule fB)
11.4898 + done
11.4899 + have th0: "dim ?U \<le> card (f ` B)"
11.4900 + apply (rule span_card_ge_dim)
11.4901 + apply blast
11.4902 + unfolding span_linear_image[OF lf]
11.4903 + apply (rule subset_trans[where B = "f ` UNIV"])
11.4904 + using sf unfolding surj_def apply blast
11.4905 + apply (rule image_mono)
11.4906 + apply (rule B(3))
11.4907 + apply (metis finite_imageI fB)
11.4908 + done
11.4909 +
11.4910 + moreover have "card (f ` B) \<le> card B"
11.4911 + by (rule card_image_le, rule fB)
11.4912 + ultimately have th1: "card B = card (f ` B)" unfolding d by arith
11.4913 + have fiB: "inj_on f B"
11.4914 + unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast
11.4915 + from linear_indep_image_lemma[OF lf fB fBi fiB x] fx
11.4916 + have "x = 0" by blast}
11.4917 + note th = this
11.4918 + from th show ?thesis unfolding linear_injective_0[OF lf]
11.4919 + using B(3) by blast
11.4920 +qed
11.4921 +
11.4922 +(* Hence either is enough for isomorphism. *)
11.4923 +
11.4924 +lemma left_right_inverse_eq:
11.4925 + assumes fg: "f o g = id" and gh: "g o h = id"
11.4926 + shows "f = h"
11.4927 +proof-
11.4928 + have "f = f o (g o h)" unfolding gh by simp
11.4929 + also have "\<dots> = (f o g) o h" by (simp add: o_assoc)
11.4930 + finally show "f = h" unfolding fg by simp
11.4931 +qed
11.4932 +
11.4933 +lemma isomorphism_expand:
11.4934 + "f o g = id \<and> g o f = id \<longleftrightarrow> (\<forall>x. f(g x) = x) \<and> (\<forall>x. g(f x) = x)"
11.4935 + by (simp add: expand_fun_eq o_def id_def)
11.4936 +
11.4937 +lemma linear_injective_isomorphism:
11.4938 + assumes lf: "linear (f :: real^'n::finite \<Rightarrow> real ^'n)" and fi: "inj f"
11.4939 + shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
11.4940 +unfolding isomorphism_expand[symmetric]
11.4941 +using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi]
11.4942 +by (metis left_right_inverse_eq)
11.4943 +
11.4944 +lemma linear_surjective_isomorphism:
11.4945 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and sf: "surj f"
11.4946 + shows "\<exists>f'. linear f' \<and> (\<forall>x. f' (f x) = x) \<and> (\<forall>x. f (f' x) = x)"
11.4947 +unfolding isomorphism_expand[symmetric]
11.4948 +using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]]
11.4949 +by (metis left_right_inverse_eq)
11.4950 +
11.4951 +(* Left and right inverses are the same for R^N->R^N. *)
11.4952 +
11.4953 +lemma linear_inverse_left:
11.4954 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and lf': "linear f'"
11.4955 + shows "f o f' = id \<longleftrightarrow> f' o f = id"
11.4956 +proof-
11.4957 + {fix f f':: "real ^'n \<Rightarrow> real ^'n"
11.4958 + assume lf: "linear f" "linear f'" and f: "f o f' = id"
11.4959 + from f have sf: "surj f"
11.4960 +
11.4961 + apply (auto simp add: o_def stupid_ext[symmetric] id_def surj_def)
11.4962 + by metis
11.4963 + from linear_surjective_isomorphism[OF lf(1) sf] lf f
11.4964 + have "f' o f = id" unfolding stupid_ext[symmetric] o_def id_def
11.4965 + by metis}
11.4966 + then show ?thesis using lf lf' by metis
11.4967 +qed
11.4968 +
11.4969 +(* Moreover, a one-sided inverse is automatically linear. *)
11.4970 +
11.4971 +lemma left_inverse_linear:
11.4972 + assumes lf: "linear (f::real ^'n::finite \<Rightarrow> real ^'n)" and gf: "g o f = id"
11.4973 + shows "linear g"
11.4974 +proof-
11.4975 + from gf have fi: "inj f" apply (auto simp add: inj_on_def o_def id_def stupid_ext[symmetric])
11.4976 + by metis
11.4977 + from linear_injective_isomorphism[OF lf fi]
11.4978 + obtain h:: "real ^'n \<Rightarrow> real ^'n" where
11.4979 + h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
11.4980 + have "h = g" apply (rule ext) using gf h(2,3)
11.4981 + apply (simp add: o_def id_def stupid_ext[symmetric])
11.4982 + by metis
11.4983 + with h(1) show ?thesis by blast
11.4984 +qed
11.4985 +
11.4986 +lemma right_inverse_linear:
11.4987 + assumes lf: "linear (f:: real ^'n::finite \<Rightarrow> real ^'n)" and gf: "f o g = id"
11.4988 + shows "linear g"
11.4989 +proof-
11.4990 + from gf have fi: "surj f" apply (auto simp add: surj_def o_def id_def stupid_ext[symmetric])
11.4991 + by metis
11.4992 + from linear_surjective_isomorphism[OF lf fi]
11.4993 + obtain h:: "real ^'n \<Rightarrow> real ^'n" where
11.4994 + h: "linear h" "\<forall>x. h (f x) = x" "\<forall>x. f (h x) = x" by blast
11.4995 + have "h = g" apply (rule ext) using gf h(2,3)
11.4996 + apply (simp add: o_def id_def stupid_ext[symmetric])
11.4997 + by metis
11.4998 + with h(1) show ?thesis by blast
11.4999 +qed
11.5000 +
11.5001 +(* The same result in terms of square matrices. *)
11.5002 +
11.5003 +lemma matrix_left_right_inverse:
11.5004 + fixes A A' :: "real ^'n::finite^'n"
11.5005 + shows "A ** A' = mat 1 \<longleftrightarrow> A' ** A = mat 1"
11.5006 +proof-
11.5007 + {fix A A' :: "real ^'n^'n" assume AA': "A ** A' = mat 1"
11.5008 + have sA: "surj (op *v A)"
11.5009 + unfolding surj_def
11.5010 + apply clarify
11.5011 + apply (rule_tac x="(A' *v y)" in exI)
11.5012 + by (simp add: matrix_vector_mul_assoc AA' matrix_vector_mul_lid)
11.5013 + from linear_surjective_isomorphism[OF matrix_vector_mul_linear sA]
11.5014 + obtain f' :: "real ^'n \<Rightarrow> real ^'n"
11.5015 + where f': "linear f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
11.5016 + have th: "matrix f' ** A = mat 1"
11.5017 + by (simp add: matrix_eq matrix_works[OF f'(1)] matrix_vector_mul_assoc[symmetric] matrix_vector_mul_lid f'(2)[rule_format])
11.5018 + hence "(matrix f' ** A) ** A' = mat 1 ** A'" by simp
11.5019 + hence "matrix f' = A'" by (simp add: matrix_mul_assoc[symmetric] AA' matrix_mul_rid matrix_mul_lid)
11.5020 + hence "matrix f' ** A = A' ** A" by simp
11.5021 + hence "A' ** A = mat 1" by (simp add: th)}
11.5022 + then show ?thesis by blast
11.5023 +qed
11.5024 +
11.5025 +(* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *)
11.5026 +
11.5027 +definition "rowvector v = (\<chi> i j. (v$j))"
11.5028 +
11.5029 +definition "columnvector v = (\<chi> i j. (v$i))"
11.5030 +
11.5031 +lemma transp_columnvector:
11.5032 + "transp(columnvector v) = rowvector v"
11.5033 + by (simp add: transp_def rowvector_def columnvector_def Cart_eq)
11.5034 +
11.5035 +lemma transp_rowvector: "transp(rowvector v) = columnvector v"
11.5036 + by (simp add: transp_def columnvector_def rowvector_def Cart_eq)
11.5037 +
11.5038 +lemma dot_rowvector_columnvector:
11.5039 + "columnvector (A *v v) = A ** columnvector v"
11.5040 + by (vector columnvector_def matrix_matrix_mult_def matrix_vector_mult_def)
11.5041 +
11.5042 +lemma dot_matrix_product: "(x::'a::semiring_1^'n::finite) \<bullet> y = (((rowvector x ::'a^'n^1) ** (columnvector y :: 'a^1^'n))$1)$1"
11.5043 + by (vector matrix_matrix_mult_def rowvector_def columnvector_def dot_def)
11.5044 +
11.5045 +lemma dot_matrix_vector_mul:
11.5046 + fixes A B :: "real ^'n::finite ^'n" and x y :: "real ^'n"
11.5047 + shows "(A *v x) \<bullet> (B *v y) =
11.5048 + (((rowvector x :: real^'n^1) ** ((transp A ** B) ** (columnvector y :: real ^1^'n)))$1)$1"
11.5049 +unfolding dot_matrix_product transp_columnvector[symmetric]
11.5050 + dot_rowvector_columnvector matrix_transp_mul matrix_mul_assoc ..
11.5051 +
11.5052 +(* Infinity norm. *)
11.5053 +
11.5054 +definition "infnorm (x::real^'n::finite) = rsup {abs(x$i) |i. i\<in> (UNIV :: 'n set)}"
11.5055 +
11.5056 +lemma numseg_dimindex_nonempty: "\<exists>i. i \<in> (UNIV :: 'n set)"
11.5057 + by auto
11.5058 +
11.5059 +lemma infnorm_set_image:
11.5060 + "{abs(x$i) |i. i\<in> (UNIV :: 'n set)} =
11.5061 + (\<lambda>i. abs(x$i)) ` (UNIV :: 'n set)" by blast
11.5062 +
11.5063 +lemma infnorm_set_lemma:
11.5064 + shows "finite {abs((x::'a::abs ^'n::finite)$i) |i. i\<in> (UNIV :: 'n set)}"
11.5065 + and "{abs(x$i) |i. i\<in> (UNIV :: 'n::finite set)} \<noteq> {}"
11.5066 + unfolding infnorm_set_image
11.5067 + by (auto intro: finite_imageI)
11.5068 +
11.5069 +lemma infnorm_pos_le: "0 \<le> infnorm (x::real^'n::finite)"
11.5070 + unfolding infnorm_def
11.5071 + unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
11.5072 + unfolding infnorm_set_image
11.5073 + by auto
11.5074 +
11.5075 +lemma infnorm_triangle: "infnorm ((x::real^'n::finite) + y) \<le> infnorm x + infnorm y"
11.5076 +proof-
11.5077 + have th: "\<And>x y (z::real). x - y <= z \<longleftrightarrow> x - z <= y" by arith
11.5078 + have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
11.5079 + have th2: "\<And>x (y::real). abs(x + y) - abs(x) <= abs(y)" by arith
11.5080 + show ?thesis
11.5081 + unfolding infnorm_def
11.5082 + unfolding rsup_finite_le_iff[ OF infnorm_set_lemma]
11.5083 + apply (subst diff_le_eq[symmetric])
11.5084 + unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
11.5085 + unfolding infnorm_set_image bex_simps
11.5086 + apply (subst th)
11.5087 + unfolding th1
11.5088 + unfolding rsup_finite_ge_iff[ OF infnorm_set_lemma]
11.5089 +
11.5090 + unfolding infnorm_set_image ball_simps bex_simps
11.5091 + apply simp
11.5092 + apply (metis th2)
11.5093 + done
11.5094 +qed
11.5095 +
11.5096 +lemma infnorm_eq_0: "infnorm x = 0 \<longleftrightarrow> (x::real ^'n::finite) = 0"
11.5097 +proof-
11.5098 + have "infnorm x <= 0 \<longleftrightarrow> x = 0"
11.5099 + unfolding infnorm_def
11.5100 + unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
11.5101 + unfolding infnorm_set_image ball_simps
11.5102 + by vector
11.5103 + then show ?thesis using infnorm_pos_le[of x] by simp
11.5104 +qed
11.5105 +
11.5106 +lemma infnorm_0: "infnorm 0 = 0"
11.5107 + by (simp add: infnorm_eq_0)
11.5108 +
11.5109 +lemma infnorm_neg: "infnorm (- x) = infnorm x"
11.5110 + unfolding infnorm_def
11.5111 + apply (rule cong[of "rsup" "rsup"])
11.5112 + apply blast
11.5113 + apply (rule set_ext)
11.5114 + apply auto
11.5115 + done
11.5116 +
11.5117 +lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)"
11.5118 +proof-
11.5119 + have "y - x = - (x - y)" by simp
11.5120 + then show ?thesis by (metis infnorm_neg)
11.5121 +qed
11.5122 +
11.5123 +lemma real_abs_sub_infnorm: "\<bar> infnorm x - infnorm y\<bar> \<le> infnorm (x - y)"
11.5124 +proof-
11.5125 + have th: "\<And>(nx::real) n ny. nx <= n + ny \<Longrightarrow> ny <= n + nx ==> \<bar>nx - ny\<bar> <= n"
11.5126 + by arith
11.5127 + from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"]
11.5128 + have ths: "infnorm x \<le> infnorm (x - y) + infnorm y"
11.5129 + "infnorm y \<le> infnorm (x - y) + infnorm x"
11.5130 + by (simp_all add: ring_simps infnorm_neg diff_def[symmetric])
11.5131 + from th[OF ths] show ?thesis .
11.5132 +qed
11.5133 +
11.5134 +lemma real_abs_infnorm: " \<bar>infnorm x\<bar> = infnorm x"
11.5135 + using infnorm_pos_le[of x] by arith
11.5136 +
11.5137 +lemma component_le_infnorm:
11.5138 + shows "\<bar>x$i\<bar> \<le> infnorm (x::real^'n::finite)"
11.5139 +proof-
11.5140 + let ?U = "UNIV :: 'n set"
11.5141 + let ?S = "{\<bar>x$i\<bar> |i. i\<in> ?U}"
11.5142 + have fS: "finite ?S" unfolding image_Collect[symmetric]
11.5143 + apply (rule finite_imageI) unfolding Collect_def mem_def by simp
11.5144 + have S0: "?S \<noteq> {}" by blast
11.5145 + have th1: "\<And>S f. f ` S = { f i| i. i \<in> S}" by blast
11.5146 + from rsup_finite_in[OF fS S0] rsup_finite_Ub[OF fS S0]
11.5147 + show ?thesis unfolding infnorm_def isUb_def setle_def
11.5148 + unfolding infnorm_set_image ball_simps by auto
11.5149 +qed
11.5150 +
11.5151 +lemma infnorm_mul_lemma: "infnorm(a *s x) <= \<bar>a\<bar> * infnorm x"
11.5152 + apply (subst infnorm_def)
11.5153 + unfolding rsup_finite_le_iff[OF infnorm_set_lemma]
11.5154 + unfolding infnorm_set_image ball_simps
11.5155 + apply (simp add: abs_mult)
11.5156 + apply (rule allI)
11.5157 + apply (cut_tac component_le_infnorm[of x])
11.5158 + apply (rule mult_mono)
11.5159 + apply auto
11.5160 + done
11.5161 +
11.5162 +lemma infnorm_mul: "infnorm(a *s x) = abs a * infnorm x"
11.5163 +proof-
11.5164 + {assume a0: "a = 0" hence ?thesis by (simp add: infnorm_0) }
11.5165 + moreover
11.5166 + {assume a0: "a \<noteq> 0"
11.5167 + from a0 have th: "(1/a) *s (a *s x) = x"
11.5168 + by (simp add: vector_smult_assoc)
11.5169 + from a0 have ap: "\<bar>a\<bar> > 0" by arith
11.5170 + from infnorm_mul_lemma[of "1/a" "a *s x"]
11.5171 + have "infnorm x \<le> 1/\<bar>a\<bar> * infnorm (a*s x)"
11.5172 + unfolding th by simp
11.5173 + with ap have "\<bar>a\<bar> * infnorm x \<le> \<bar>a\<bar> * (1/\<bar>a\<bar> * infnorm (a *s x))" by (simp add: field_simps)
11.5174 + then have "\<bar>a\<bar> * infnorm x \<le> infnorm (a*s x)"
11.5175 + using ap by (simp add: field_simps)
11.5176 + with infnorm_mul_lemma[of a x] have ?thesis by arith }
11.5177 + ultimately show ?thesis by blast
11.5178 +qed
11.5179 +
11.5180 +lemma infnorm_pos_lt: "infnorm x > 0 \<longleftrightarrow> x \<noteq> 0"
11.5181 + using infnorm_pos_le[of x] infnorm_eq_0[of x] by arith
11.5182 +
11.5183 +(* Prove that it differs only up to a bound from Euclidean norm. *)
11.5184 +
11.5185 +lemma infnorm_le_norm: "infnorm x \<le> norm x"
11.5186 + unfolding infnorm_def rsup_finite_le_iff[OF infnorm_set_lemma]
11.5187 + unfolding infnorm_set_image ball_simps
11.5188 + by (metis component_le_norm)
11.5189 +lemma card_enum: "card {1 .. n} = n" by auto
11.5190 +lemma norm_le_infnorm: "norm(x) <= sqrt(real CARD('n)) * infnorm(x::real ^'n::finite)"
11.5191 +proof-
11.5192 + let ?d = "CARD('n)"
11.5193 + have "real ?d \<ge> 0" by simp
11.5194 + hence d2: "(sqrt (real ?d))^2 = real ?d"
11.5195 + by (auto intro: real_sqrt_pow2)
11.5196 + have th: "sqrt (real ?d) * infnorm x \<ge> 0"
11.5197 + by (simp add: zero_le_mult_iff real_sqrt_ge_0_iff infnorm_pos_le)
11.5198 + have th1: "x\<bullet>x \<le> (sqrt (real ?d) * infnorm x)^2"
11.5199 + unfolding power_mult_distrib d2
11.5200 + apply (subst power2_abs[symmetric])
11.5201 + unfolding real_of_nat_def dot_def power2_eq_square[symmetric]
11.5202 + apply (subst power2_abs[symmetric])
11.5203 + apply (rule setsum_bounded)
11.5204 + apply (rule power_mono)
11.5205 + unfolding abs_of_nonneg[OF infnorm_pos_le]
11.5206 + unfolding infnorm_def rsup_finite_ge_iff[OF infnorm_set_lemma]
11.5207 + unfolding infnorm_set_image bex_simps
11.5208 + apply blast
11.5209 + by (rule abs_ge_zero)
11.5210 + from real_le_lsqrt[OF dot_pos_le th th1]
11.5211 + show ?thesis unfolding real_vector_norm_def id_def .
11.5212 +qed
11.5213 +
11.5214 +(* Equality in Cauchy-Schwarz and triangle inequalities. *)
11.5215 +
11.5216 +lemma norm_cauchy_schwarz_eq: "(x::real ^'n::finite) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
11.5217 +proof-
11.5218 + {assume h: "x = 0"
11.5219 + hence ?thesis by simp}
11.5220 + moreover
11.5221 + {assume h: "y = 0"
11.5222 + hence ?thesis by simp}
11.5223 + moreover
11.5224 + {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
11.5225 + from dot_eq_0[of "norm y *s x - norm x *s y"]
11.5226 + have "?rhs \<longleftrightarrow> (norm y * (norm y * norm x * norm x - norm x * (x \<bullet> y)) - norm x * (norm y * (y \<bullet> x) - norm x * norm y * norm y) = 0)"
11.5227 + using x y
11.5228 + unfolding dot_rsub dot_lsub dot_lmult dot_rmult
11.5229 + unfolding norm_pow_2[symmetric] power2_eq_square diff_eq_0_iff_eq apply (simp add: dot_sym)
11.5230 + apply (simp add: ring_simps)
11.5231 + apply metis
11.5232 + done
11.5233 + also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
11.5234 + by (simp add: ring_simps dot_sym)
11.5235 + also have "\<dots> \<longleftrightarrow> ?lhs" using x y
11.5236 + apply simp
11.5237 + by metis
11.5238 + finally have ?thesis by blast}
11.5239 + ultimately show ?thesis by blast
11.5240 +qed
11.5241 +
11.5242 +lemma norm_cauchy_schwarz_abs_eq:
11.5243 + fixes x y :: "real ^ 'n::finite"
11.5244 + shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow>
11.5245 + norm x *s y = norm y *s x \<or> norm(x) *s y = - norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
11.5246 +proof-
11.5247 + have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
11.5248 + have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
11.5249 + apply simp by vector
11.5250 + also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
11.5251 + (-x) \<bullet> y = norm x * norm y)"
11.5252 + unfolding norm_cauchy_schwarz_eq[symmetric]
11.5253 + unfolding norm_minus_cancel
11.5254 + norm_mul by blast
11.5255 + also have "\<dots> \<longleftrightarrow> ?lhs"
11.5256 + unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
11.5257 + by arith
11.5258 + finally show ?thesis ..
11.5259 +qed
11.5260 +
11.5261 +lemma norm_triangle_eq:
11.5262 + fixes x y :: "real ^ 'n::finite"
11.5263 + shows "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
11.5264 +proof-
11.5265 + {assume x: "x =0 \<or> y =0"
11.5266 + hence ?thesis by (cases "x=0", simp_all)}
11.5267 + moreover
11.5268 + {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
11.5269 + hence "norm x \<noteq> 0" "norm y \<noteq> 0"
11.5270 + by simp_all
11.5271 + hence n: "norm x > 0" "norm y > 0"
11.5272 + using norm_ge_zero[of x] norm_ge_zero[of y]
11.5273 + by arith+
11.5274 + have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
11.5275 + have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
11.5276 + apply (rule th) using n norm_ge_zero[of "x + y"]
11.5277 + by arith
11.5278 + also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
11.5279 + unfolding norm_cauchy_schwarz_eq[symmetric]
11.5280 + unfolding norm_pow_2 dot_ladd dot_radd
11.5281 + by (simp add: norm_pow_2[symmetric] power2_eq_square dot_sym ring_simps)
11.5282 + finally have ?thesis .}
11.5283 + ultimately show ?thesis by blast
11.5284 +qed
11.5285 +
11.5286 +(* Collinearity.*)
11.5287 +
11.5288 +definition "collinear S \<longleftrightarrow> (\<exists>u. \<forall>x \<in> S. \<forall> y \<in> S. \<exists>c. x - y = c *s u)"
11.5289 +
11.5290 +lemma collinear_empty: "collinear {}" by (simp add: collinear_def)
11.5291 +
11.5292 +lemma collinear_sing: "collinear {(x::'a::ring_1^'n)}"
11.5293 + apply (simp add: collinear_def)
11.5294 + apply (rule exI[where x=0])
11.5295 + by simp
11.5296 +
11.5297 +lemma collinear_2: "collinear {(x::'a::ring_1^'n),y}"
11.5298 + apply (simp add: collinear_def)
11.5299 + apply (rule exI[where x="x - y"])
11.5300 + apply auto
11.5301 + apply (rule exI[where x=0], simp)
11.5302 + apply (rule exI[where x=1], simp)
11.5303 + apply (rule exI[where x="- 1"], simp add: vector_sneg_minus1[symmetric])
11.5304 + apply (rule exI[where x=0], simp)
11.5305 + done
11.5306 +
11.5307 +lemma collinear_lemma: "collinear {(0::real^'n),x,y} \<longleftrightarrow> x = 0 \<or> y = 0 \<or> (\<exists>c. y = c *s x)" (is "?lhs \<longleftrightarrow> ?rhs")
11.5308 +proof-
11.5309 + {assume "x=0 \<or> y = 0" hence ?thesis
11.5310 + by (cases "x = 0", simp_all add: collinear_2 insert_commute)}
11.5311 + moreover
11.5312 + {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
11.5313 + {assume h: "?lhs"
11.5314 + then obtain u where u: "\<forall> x\<in> {0,x,y}. \<forall>y\<in> {0,x,y}. \<exists>c. x - y = c *s u" unfolding collinear_def by blast
11.5315 + from u[rule_format, of x 0] u[rule_format, of y 0]
11.5316 + obtain cx and cy where
11.5317 + cx: "x = cx*s u" and cy: "y = cy*s u"
11.5318 + by auto
11.5319 + from cx x have cx0: "cx \<noteq> 0" by auto
11.5320 + from cy y have cy0: "cy \<noteq> 0" by auto
11.5321 + let ?d = "cy / cx"
11.5322 + from cx cy cx0 have "y = ?d *s x"
11.5323 + by (simp add: vector_smult_assoc)
11.5324 + hence ?rhs using x y by blast}
11.5325 + moreover
11.5326 + {assume h: "?rhs"
11.5327 + then obtain c where c: "y = c*s x" using x y by blast
11.5328 + have ?lhs unfolding collinear_def c
11.5329 + apply (rule exI[where x=x])
11.5330 + apply auto
11.5331 + apply (rule exI[where x="- 1"], simp only: vector_smult_lneg vector_smult_lid)
11.5332 + apply (rule exI[where x= "-c"], simp only: vector_smult_lneg)
11.5333 + apply (rule exI[where x=1], simp)
11.5334 + apply (rule exI[where x="1 - c"], simp add: vector_smult_lneg vector_sub_rdistrib)
11.5335 + apply (rule exI[where x="c - 1"], simp add: vector_smult_lneg vector_sub_rdistrib)
11.5336 + done}
11.5337 + ultimately have ?thesis by blast}
11.5338 + ultimately show ?thesis by blast
11.5339 +qed
11.5340 +
11.5341 +lemma norm_cauchy_schwarz_equal:
11.5342 + fixes x y :: "real ^ 'n::finite"
11.5343 + shows "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
11.5344 +unfolding norm_cauchy_schwarz_abs_eq
11.5345 +apply (cases "x=0", simp_all add: collinear_2)
11.5346 +apply (cases "y=0", simp_all add: collinear_2 insert_commute)
11.5347 +unfolding collinear_lemma
11.5348 +apply simp
11.5349 +apply (subgoal_tac "norm x \<noteq> 0")
11.5350 +apply (subgoal_tac "norm y \<noteq> 0")
11.5351 +apply (rule iffI)
11.5352 +apply (cases "norm x *s y = norm y *s x")
11.5353 +apply (rule exI[where x="(1/norm x) * norm y"])
11.5354 +apply (drule sym)
11.5355 +unfolding vector_smult_assoc[symmetric]
11.5356 +apply (simp add: vector_smult_assoc field_simps)
11.5357 +apply (rule exI[where x="(1/norm x) * - norm y"])
11.5358 +apply clarify
11.5359 +apply (drule sym)
11.5360 +unfolding vector_smult_assoc[symmetric]
11.5361 +apply (simp add: vector_smult_assoc field_simps)
11.5362 +apply (erule exE)
11.5363 +apply (erule ssubst)
11.5364 +unfolding vector_smult_assoc
11.5365 +unfolding norm_mul
11.5366 +apply (subgoal_tac "norm x * c = \<bar>c\<bar> * norm x \<or> norm x * c = - \<bar>c\<bar> * norm x")
11.5367 +apply (case_tac "c <= 0", simp add: ring_simps)
11.5368 +apply (simp add: ring_simps)
11.5369 +apply (case_tac "c <= 0", simp add: ring_simps)
11.5370 +apply (simp add: ring_simps)
11.5371 +apply simp
11.5372 +apply simp
11.5373 +done
11.5374 +
11.5375 +end
12.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2 +++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy Fri Oct 23 13:23:18 2009 +0200
12.3 @@ -0,0 +1,95 @@
12.4 +(* Title: HOL/Library/Finite_Cartesian_Product
12.5 + Author: Amine Chaieb, University of Cambridge
12.6 +*)
12.7 +
12.8 +header {* Definition of finite Cartesian product types. *}
12.9 +
12.10 +theory Finite_Cartesian_Product
12.11 +imports Main (*FIXME: ATP_Linkup is only needed for metis at a few places. We could dispense of that by changing the proofs.*)
12.12 +begin
12.13 +
12.14 +definition hassize (infixr "hassize" 12) where
12.15 + "(S hassize n) = (finite S \<and> card S = n)"
12.16 +
12.17 +lemma hassize_image_inj: assumes f: "inj_on f S" and S: "S hassize n"
12.18 + shows "f ` S hassize n"
12.19 + using f S card_image[OF f]
12.20 + by (simp add: hassize_def inj_on_def)
12.21 +
12.22 +
12.23 +subsection {* Finite Cartesian products, with indexing and lambdas. *}
12.24 +
12.25 +typedef (open Cart)
12.26 + ('a, 'b) "^" (infixl "^" 15)
12.27 + = "UNIV :: ('b \<Rightarrow> 'a) set"
12.28 + morphisms Cart_nth Cart_lambda ..
12.29 +
12.30 +notation Cart_nth (infixl "$" 90)
12.31 +
12.32 +notation (xsymbols) Cart_lambda (binder "\<chi>" 10)
12.33 +
12.34 +lemma stupid_ext: "(\<forall>x. f x = g x) \<longleftrightarrow> (f = g)"
12.35 + apply auto
12.36 + apply (rule ext)
12.37 + apply auto
12.38 + done
12.39 +
12.40 +lemma Cart_eq: "((x:: 'a ^ 'b) = y) \<longleftrightarrow> (\<forall>i. x$i = y$i)"
12.41 + by (simp add: Cart_nth_inject [symmetric] expand_fun_eq)
12.42 +
12.43 +lemma Cart_lambda_beta [simp]: "Cart_lambda g $ i = g i"
12.44 + by (simp add: Cart_lambda_inverse)
12.45 +
12.46 +lemma Cart_lambda_unique:
12.47 + fixes f :: "'a ^ 'b"
12.48 + shows "(\<forall>i. f$i = g i) \<longleftrightarrow> Cart_lambda g = f"
12.49 + by (auto simp add: Cart_eq)
12.50 +
12.51 +lemma Cart_lambda_eta: "(\<chi> i. (g$i)) = g"
12.52 + by (simp add: Cart_eq)
12.53 +
12.54 +text{* A non-standard sum to "paste" Cartesian products. *}
12.55 +
12.56 +definition pastecart :: "'a ^ 'm \<Rightarrow> 'a ^ 'n \<Rightarrow> 'a ^ ('m + 'n)" where
12.57 + "pastecart f g = (\<chi> i. case i of Inl a \<Rightarrow> f$a | Inr b \<Rightarrow> g$b)"
12.58 +
12.59 +definition fstcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'm" where
12.60 + "fstcart f = (\<chi> i. (f$(Inl i)))"
12.61 +
12.62 +definition sndcart:: "'a ^('m + 'n) \<Rightarrow> 'a ^ 'n" where
12.63 + "sndcart f = (\<chi> i. (f$(Inr i)))"
12.64 +
12.65 +lemma nth_pastecart_Inl [simp]: "pastecart f g $ Inl a = f$a"
12.66 + unfolding pastecart_def by simp
12.67 +
12.68 +lemma nth_pastecart_Inr [simp]: "pastecart f g $ Inr b = g$b"
12.69 + unfolding pastecart_def by simp
12.70 +
12.71 +lemma nth_fstcart [simp]: "fstcart f $ i = f $ Inl i"
12.72 + unfolding fstcart_def by simp
12.73 +
12.74 +lemma nth_sndtcart [simp]: "sndcart f $ i = f $ Inr i"
12.75 + unfolding sndcart_def by simp
12.76 +
12.77 +lemma finite_sum_image: "(UNIV::('a + 'b) set) = range Inl \<union> range Inr"
12.78 +by (auto, case_tac x, auto)
12.79 +
12.80 +lemma fstcart_pastecart: "fstcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = x"
12.81 + by (simp add: Cart_eq)
12.82 +
12.83 +lemma sndcart_pastecart: "sndcart (pastecart (x::'a ^'m ) (y:: 'a ^ 'n)) = y"
12.84 + by (simp add: Cart_eq)
12.85 +
12.86 +lemma pastecart_fst_snd: "pastecart (fstcart z) (sndcart z) = z"
12.87 + by (simp add: Cart_eq pastecart_def fstcart_def sndcart_def split: sum.split)
12.88 +
12.89 +lemma pastecart_eq: "(x = y) \<longleftrightarrow> (fstcart x = fstcart y) \<and> (sndcart x = sndcart y)"
12.90 + using pastecart_fst_snd[of x] pastecart_fst_snd[of y] by metis
12.91 +
12.92 +lemma forall_pastecart: "(\<forall>p. P p) \<longleftrightarrow> (\<forall>x y. P (pastecart x y))"
12.93 + by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
12.94 +
12.95 +lemma exists_pastecart: "(\<exists>p. P p) \<longleftrightarrow> (\<exists>x y. P (pastecart x y))"
12.96 + by (metis pastecart_fst_snd fstcart_pastecart sndcart_pastecart)
12.97 +
12.98 +end
13.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
13.2 +++ b/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy Fri Oct 23 13:23:18 2009 +0200
13.3 @@ -0,0 +1,6 @@
13.4 +theory Multivariate_Analysis imports
13.5 + Convex_Euclidean_Space
13.6 + Determinants
13.7 +begin
13.8 +
13.9 +end
14.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
14.2 +++ b/src/HOL/Multivariate_Analysis/ROOT.ML Fri Oct 23 13:23:18 2009 +0200
14.3 @@ -0,0 +1,6 @@
14.4 +(*
14.5 + no_document use_thy "ThisTheory";
14.6 + use_thy "ThatTheory";
14.7 +*)
14.8 +
14.9 +use_thy "Multivariate_Analysis";
15.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
15.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Fri Oct 23 13:23:18 2009 +0200
15.3 @@ -0,0 +1,6027 @@
15.4 +(* Title: HOL/Library/Topology_Euclidian_Space.thy
15.5 + Author: Amine Chaieb, University of Cambridge
15.6 + Author: Robert Himmelmann, TU Muenchen
15.7 +*)
15.8 +
15.9 +header {* Elementary topology in Euclidean space. *}
15.10 +
15.11 +theory Topology_Euclidean_Space
15.12 +imports SEQ Euclidean_Space Product_Vector
15.13 +begin
15.14 +
15.15 +declare fstcart_pastecart[simp] sndcart_pastecart[simp]
15.16 +
15.17 +subsection{* General notion of a topology *}
15.18 +
15.19 +definition "istopology L \<longleftrightarrow> {} \<in> L \<and> (\<forall>S \<in>L. \<forall>T \<in>L. S \<inter> T \<in> L) \<and> (\<forall>K. K \<subseteq>L \<longrightarrow> \<Union> K \<in> L)"
15.20 +typedef (open) 'a topology = "{L::('a set) set. istopology L}"
15.21 + morphisms "openin" "topology"
15.22 + unfolding istopology_def by blast
15.23 +
15.24 +lemma istopology_open_in[intro]: "istopology(openin U)"
15.25 + using openin[of U] by blast
15.26 +
15.27 +lemma topology_inverse': "istopology U \<Longrightarrow> openin (topology U) = U"
15.28 + using topology_inverse[unfolded mem_def Collect_def] .
15.29 +
15.30 +lemma topology_inverse_iff: "istopology U \<longleftrightarrow> openin (topology U) = U"
15.31 + using topology_inverse[of U] istopology_open_in[of "topology U"] by auto
15.32 +
15.33 +lemma topology_eq: "T1 = T2 \<longleftrightarrow> (\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S)"
15.34 +proof-
15.35 + {assume "T1=T2" hence "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S" by simp}
15.36 + moreover
15.37 + {assume H: "\<forall>S. openin T1 S \<longleftrightarrow> openin T2 S"
15.38 + hence "openin T1 = openin T2" by (metis mem_def set_ext)
15.39 + hence "topology (openin T1) = topology (openin T2)" by simp
15.40 + hence "T1 = T2" unfolding openin_inverse .}
15.41 + ultimately show ?thesis by blast
15.42 +qed
15.43 +
15.44 +text{* Infer the "universe" from union of all sets in the topology. *}
15.45 +
15.46 +definition "topspace T = \<Union>{S. openin T S}"
15.47 +
15.48 +subsection{* Main properties of open sets *}
15.49 +
15.50 +lemma openin_clauses:
15.51 + fixes U :: "'a topology"
15.52 + shows "openin U {}"
15.53 + "\<And>S T. openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S\<inter>T)"
15.54 + "\<And>K. (\<forall>S \<in> K. openin U S) \<Longrightarrow> openin U (\<Union>K)"
15.55 + using openin[of U] unfolding istopology_def Collect_def mem_def
15.56 + by (metis mem_def subset_eq)+
15.57 +
15.58 +lemma openin_subset[intro]: "openin U S \<Longrightarrow> S \<subseteq> topspace U"
15.59 + unfolding topspace_def by blast
15.60 +lemma openin_empty[simp]: "openin U {}" by (simp add: openin_clauses)
15.61 +
15.62 +lemma openin_Int[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<inter> T)"
15.63 + by (simp add: openin_clauses)
15.64 +
15.65 +lemma openin_Union[intro]: "(\<forall>S \<in>K. openin U S) \<Longrightarrow> openin U (\<Union> K)" by (simp add: openin_clauses)
15.66 +
15.67 +lemma openin_Un[intro]: "openin U S \<Longrightarrow> openin U T \<Longrightarrow> openin U (S \<union> T)"
15.68 + using openin_Union[of "{S,T}" U] by auto
15.69 +
15.70 +lemma openin_topspace[intro, simp]: "openin U (topspace U)" by (simp add: openin_Union topspace_def)
15.71 +
15.72 +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")
15.73 +proof-
15.74 + {assume ?lhs then have ?rhs by auto }
15.75 + moreover
15.76 + {assume H: ?rhs
15.77 + then obtain t where t: "\<forall>x\<in>S. openin U (t x) \<and> x \<in> t x \<and> t x \<subseteq> S"
15.78 + unfolding Ball_def ex_simps(6)[symmetric] choice_iff by blast
15.79 + from t have th0: "\<forall>x\<in> t`S. openin U x" by auto
15.80 + have "\<Union> t`S = S" using t by auto
15.81 + with openin_Union[OF th0] have "openin U S" by simp }
15.82 + ultimately show ?thesis by blast
15.83 +qed
15.84 +
15.85 +subsection{* Closed sets *}
15.86 +
15.87 +definition "closedin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> openin U (topspace U - S)"
15.88 +
15.89 +lemma closedin_subset: "closedin U S \<Longrightarrow> S \<subseteq> topspace U" by (metis closedin_def)
15.90 +lemma closedin_empty[simp]: "closedin U {}" by (simp add: closedin_def)
15.91 +lemma closedin_topspace[intro,simp]:
15.92 + "closedin U (topspace U)" by (simp add: closedin_def)
15.93 +lemma closedin_Un[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<union> T)"
15.94 + by (auto simp add: Diff_Un closedin_def)
15.95 +
15.96 +lemma Diff_Inter[intro]: "A - \<Inter>S = \<Union> {A - s|s. s\<in>S}" by auto
15.97 +lemma closedin_Inter[intro]: assumes Ke: "K \<noteq> {}" and Kc: "\<forall>S \<in>K. closedin U S"
15.98 + shows "closedin U (\<Inter> K)" using Ke Kc unfolding closedin_def Diff_Inter by auto
15.99 +
15.100 +lemma closedin_Int[intro]: "closedin U S \<Longrightarrow> closedin U T \<Longrightarrow> closedin U (S \<inter> T)"
15.101 + using closedin_Inter[of "{S,T}" U] by auto
15.102 +
15.103 +lemma Diff_Diff_Int: "A - (A - B) = A \<inter> B" by blast
15.104 +lemma openin_closedin_eq: "openin U S \<longleftrightarrow> S \<subseteq> topspace U \<and> closedin U (topspace U - S)"
15.105 + apply (auto simp add: closedin_def Diff_Diff_Int inf_absorb2)
15.106 + apply (metis openin_subset subset_eq)
15.107 + done
15.108 +
15.109 +lemma openin_closedin: "S \<subseteq> topspace U \<Longrightarrow> (openin U S \<longleftrightarrow> closedin U (topspace U - S))"
15.110 + by (simp add: openin_closedin_eq)
15.111 +
15.112 +lemma openin_diff[intro]: assumes oS: "openin U S" and cT: "closedin U T" shows "openin U (S - T)"
15.113 +proof-
15.114 + have "S - T = S \<inter> (topspace U - T)" using openin_subset[of U S] oS cT
15.115 + by (auto simp add: topspace_def openin_subset)
15.116 + then show ?thesis using oS cT by (auto simp add: closedin_def)
15.117 +qed
15.118 +
15.119 +lemma closedin_diff[intro]: assumes oS: "closedin U S" and cT: "openin U T" shows "closedin U (S - T)"
15.120 +proof-
15.121 + have "S - T = S \<inter> (topspace U - T)" using closedin_subset[of U S] oS cT
15.122 + by (auto simp add: topspace_def )
15.123 + then show ?thesis using oS cT by (auto simp add: openin_closedin_eq)
15.124 +qed
15.125 +
15.126 +subsection{* Subspace topology. *}
15.127 +
15.128 +definition "subtopology U V = topology {S \<inter> V |S. openin U S}"
15.129 +
15.130 +lemma istopology_subtopology: "istopology {S \<inter> V |S. openin U S}" (is "istopology ?L")
15.131 +proof-
15.132 + have "{} \<in> ?L" by blast
15.133 + {fix A B assume A: "A \<in> ?L" and B: "B \<in> ?L"
15.134 + 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
15.135 + have "A\<inter>B = (Sa \<inter> Sb) \<inter> V" "openin U (Sa \<inter> Sb)" using Sa Sb by blast+
15.136 + then have "A \<inter> B \<in> ?L" by blast}
15.137 + moreover
15.138 + {fix K assume K: "K \<subseteq> ?L"
15.139 + have th0: "?L = (\<lambda>S. S \<inter> V) ` openin U "
15.140 + apply (rule set_ext)
15.141 + apply (simp add: Ball_def image_iff)
15.142 + by (metis mem_def)
15.143 + from K[unfolded th0 subset_image_iff]
15.144 + obtain Sk where Sk: "Sk \<subseteq> openin U" "K = (\<lambda>S. S \<inter> V) ` Sk" by blast
15.145 + have "\<Union>K = (\<Union>Sk) \<inter> V" using Sk by auto
15.146 + moreover have "openin U (\<Union> Sk)" using Sk by (auto simp add: subset_eq mem_def)
15.147 + ultimately have "\<Union>K \<in> ?L" by blast}
15.148 + ultimately show ?thesis unfolding istopology_def by blast
15.149 +qed
15.150 +
15.151 +lemma openin_subtopology:
15.152 + "openin (subtopology U V) S \<longleftrightarrow> (\<exists> T. (openin U T) \<and> (S = T \<inter> V))"
15.153 + unfolding subtopology_def topology_inverse'[OF istopology_subtopology]
15.154 + by (auto simp add: Collect_def)
15.155 +
15.156 +lemma topspace_subtopology: "topspace(subtopology U V) = topspace U \<inter> V"
15.157 + by (auto simp add: topspace_def openin_subtopology)
15.158 +
15.159 +lemma closedin_subtopology:
15.160 + "closedin (subtopology U V) S \<longleftrightarrow> (\<exists>T. closedin U T \<and> S = T \<inter> V)"
15.161 + unfolding closedin_def topspace_subtopology
15.162 + apply (simp add: openin_subtopology)
15.163 + apply (rule iffI)
15.164 + apply clarify
15.165 + apply (rule_tac x="topspace U - T" in exI)
15.166 + by auto
15.167 +
15.168 +lemma openin_subtopology_refl: "openin (subtopology U V) V \<longleftrightarrow> V \<subseteq> topspace U"
15.169 + unfolding openin_subtopology
15.170 + apply (rule iffI, clarify)
15.171 + apply (frule openin_subset[of U]) apply blast
15.172 + apply (rule exI[where x="topspace U"])
15.173 + by auto
15.174 +
15.175 +lemma subtopology_superset: assumes UV: "topspace U \<subseteq> V"
15.176 + shows "subtopology U V = U"
15.177 +proof-
15.178 + {fix S
15.179 + {fix T assume T: "openin U T" "S = T \<inter> V"
15.180 + from T openin_subset[OF T(1)] UV have eq: "S = T" by blast
15.181 + have "openin U S" unfolding eq using T by blast}
15.182 + moreover
15.183 + {assume S: "openin U S"
15.184 + hence "\<exists>T. openin U T \<and> S = T \<inter> V"
15.185 + using openin_subset[OF S] UV by auto}
15.186 + ultimately have "(\<exists>T. openin U T \<and> S = T \<inter> V) \<longleftrightarrow> openin U S" by blast}
15.187 + then show ?thesis unfolding topology_eq openin_subtopology by blast
15.188 +qed
15.189 +
15.190 +
15.191 +lemma subtopology_topspace[simp]: "subtopology U (topspace U) = U"
15.192 + by (simp add: subtopology_superset)
15.193 +
15.194 +lemma subtopology_UNIV[simp]: "subtopology U UNIV = U"
15.195 + by (simp add: subtopology_superset)
15.196 +
15.197 +subsection{* The universal Euclidean versions are what we use most of the time *}
15.198 +
15.199 +definition
15.200 + euclidean :: "'a::topological_space topology" where
15.201 + "euclidean = topology open"
15.202 +
15.203 +lemma open_openin: "open S \<longleftrightarrow> openin euclidean S"
15.204 + unfolding euclidean_def
15.205 + apply (rule cong[where x=S and y=S])
15.206 + apply (rule topology_inverse[symmetric])
15.207 + apply (auto simp add: istopology_def)
15.208 + by (auto simp add: mem_def subset_eq)
15.209 +
15.210 +lemma topspace_euclidean: "topspace euclidean = UNIV"
15.211 + apply (simp add: topspace_def)
15.212 + apply (rule set_ext)
15.213 + by (auto simp add: open_openin[symmetric])
15.214 +
15.215 +lemma topspace_euclidean_subtopology[simp]: "topspace (subtopology euclidean S) = S"
15.216 + by (simp add: topspace_euclidean topspace_subtopology)
15.217 +
15.218 +lemma closed_closedin: "closed S \<longleftrightarrow> closedin euclidean S"
15.219 + by (simp add: closed_def closedin_def topspace_euclidean open_openin Compl_eq_Diff_UNIV)
15.220 +
15.221 +lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
15.222 + by (simp add: open_openin openin_subopen[symmetric])
15.223 +
15.224 +subsection{* Open and closed balls. *}
15.225 +
15.226 +definition
15.227 + ball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
15.228 + "ball x e = {y. dist x y < e}"
15.229 +
15.230 +definition
15.231 + cball :: "'a::metric_space \<Rightarrow> real \<Rightarrow> 'a set" where
15.232 + "cball x e = {y. dist x y \<le> e}"
15.233 +
15.234 +lemma mem_ball[simp]: "y \<in> ball x e \<longleftrightarrow> dist x y < e" by (simp add: ball_def)
15.235 +lemma mem_cball[simp]: "y \<in> cball x e \<longleftrightarrow> dist x y \<le> e" by (simp add: cball_def)
15.236 +
15.237 +lemma mem_ball_0 [simp]:
15.238 + fixes x :: "'a::real_normed_vector"
15.239 + shows "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
15.240 + by (simp add: dist_norm)
15.241 +
15.242 +lemma mem_cball_0 [simp]:
15.243 + fixes x :: "'a::real_normed_vector"
15.244 + shows "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
15.245 + by (simp add: dist_norm)
15.246 +
15.247 +lemma centre_in_cball[simp]: "x \<in> cball x e \<longleftrightarrow> 0\<le> e" by simp
15.248 +lemma ball_subset_cball[simp,intro]: "ball x e \<subseteq> cball x e" by (simp add: subset_eq)
15.249 +lemma subset_ball[intro]: "d <= e ==> ball x d \<subseteq> ball x e" by (simp add: subset_eq)
15.250 +lemma subset_cball[intro]: "d <= e ==> cball x d \<subseteq> cball x e" by (simp add: subset_eq)
15.251 +lemma ball_max_Un: "ball a (max r s) = ball a r \<union> ball a s"
15.252 + by (simp add: expand_set_eq) arith
15.253 +
15.254 +lemma ball_min_Int: "ball a (min r s) = ball a r \<inter> ball a s"
15.255 + by (simp add: expand_set_eq)
15.256 +
15.257 +subsection{* Topological properties of open balls *}
15.258 +
15.259 +lemma diff_less_iff: "(a::real) - b > 0 \<longleftrightarrow> a > b"
15.260 + "(a::real) - b < 0 \<longleftrightarrow> a < b"
15.261 + "a - b < c \<longleftrightarrow> a < c +b" "a - b > c \<longleftrightarrow> a > c +b" by arith+
15.262 +lemma diff_le_iff: "(a::real) - b \<ge> 0 \<longleftrightarrow> a \<ge> b" "(a::real) - b \<le> 0 \<longleftrightarrow> a \<le> b"
15.263 + "a - b \<le> c \<longleftrightarrow> a \<le> c +b" "a - b \<ge> c \<longleftrightarrow> a \<ge> c +b" by arith+
15.264 +
15.265 +lemma open_ball[intro, simp]: "open (ball x e)"
15.266 + unfolding open_dist ball_def Collect_def Ball_def mem_def
15.267 + unfolding dist_commute
15.268 + apply clarify
15.269 + apply (rule_tac x="e - dist xa x" in exI)
15.270 + using dist_triangle_alt[where z=x]
15.271 + apply (clarsimp simp add: diff_less_iff)
15.272 + apply atomize
15.273 + apply (erule_tac x="y" in allE)
15.274 + apply (erule_tac x="xa" in allE)
15.275 + by arith
15.276 +
15.277 +lemma centre_in_ball[simp]: "x \<in> ball x e \<longleftrightarrow> e > 0" by (metis mem_ball dist_self)
15.278 +lemma open_contains_ball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. ball x e \<subseteq> S)"
15.279 + unfolding open_dist subset_eq mem_ball Ball_def dist_commute ..
15.280 +
15.281 +lemma open_contains_ball_eq: "open S \<Longrightarrow> \<forall>x. x\<in>S \<longleftrightarrow> (\<exists>e>0. ball x e \<subseteq> S)"
15.282 + by (metis open_contains_ball subset_eq centre_in_ball)
15.283 +
15.284 +lemma ball_eq_empty[simp]: "ball x e = {} \<longleftrightarrow> e \<le> 0"
15.285 + unfolding mem_ball expand_set_eq
15.286 + apply (simp add: not_less)
15.287 + by (metis zero_le_dist order_trans dist_self)
15.288 +
15.289 +lemma ball_empty[intro]: "e \<le> 0 ==> ball x e = {}" by simp
15.290 +
15.291 +subsection{* Basic "localization" results are handy for connectedness. *}
15.292 +
15.293 +lemma openin_open: "openin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. open T \<and> (S = U \<inter> T))"
15.294 + by (auto simp add: openin_subtopology open_openin[symmetric])
15.295 +
15.296 +lemma openin_open_Int[intro]: "open S \<Longrightarrow> openin (subtopology euclidean U) (U \<inter> S)"
15.297 + by (auto simp add: openin_open)
15.298 +
15.299 +lemma open_openin_trans[trans]:
15.300 + "open S \<Longrightarrow> open T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> openin (subtopology euclidean S) T"
15.301 + by (metis Int_absorb1 openin_open_Int)
15.302 +
15.303 +lemma open_subset: "S \<subseteq> T \<Longrightarrow> open S \<Longrightarrow> openin (subtopology euclidean T) S"
15.304 + by (auto simp add: openin_open)
15.305 +
15.306 +lemma closedin_closed: "closedin (subtopology euclidean U) S \<longleftrightarrow> (\<exists>T. closed T \<and> S = U \<inter> T)"
15.307 + by (simp add: closedin_subtopology closed_closedin Int_ac)
15.308 +
15.309 +lemma closedin_closed_Int: "closed S ==> closedin (subtopology euclidean U) (U \<inter> S)"
15.310 + by (metis closedin_closed)
15.311 +
15.312 +lemma closed_closedin_trans: "closed S \<Longrightarrow> closed T \<Longrightarrow> T \<subseteq> S \<Longrightarrow> closedin (subtopology euclidean S) T"
15.313 + apply (subgoal_tac "S \<inter> T = T" )
15.314 + apply auto
15.315 + apply (frule closedin_closed_Int[of T S])
15.316 + by simp
15.317 +
15.318 +lemma closed_subset: "S \<subseteq> T \<Longrightarrow> closed S \<Longrightarrow> closedin (subtopology euclidean T) S"
15.319 + by (auto simp add: closedin_closed)
15.320 +
15.321 +lemma openin_euclidean_subtopology_iff:
15.322 + fixes S U :: "'a::metric_space set"
15.323 + shows "openin (subtopology euclidean U) S
15.324 + \<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")
15.325 +proof-
15.326 + {assume ?lhs hence ?rhs unfolding openin_subtopology open_openin[symmetric]
15.327 + by (simp add: open_dist) blast}
15.328 + moreover
15.329 + {assume SU: "S \<subseteq> U" and H: "\<And>x. x \<in> S \<Longrightarrow> \<exists>e>0. \<forall>x'\<in>U. dist x' x < e \<longrightarrow> x' \<in> S"
15.330 + from H obtain d where d: "\<And>x . x\<in> S \<Longrightarrow> d x > 0 \<and> (\<forall>x' \<in> U. dist x' x < d x \<longrightarrow> x' \<in> S)"
15.331 + by metis
15.332 + let ?T = "\<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
15.333 + have oT: "open ?T" by auto
15.334 + { fix x assume "x\<in>S"
15.335 + hence "x \<in> \<Union>{B. \<exists>x\<in>S. B = ball x (d x)}"
15.336 + apply simp apply(rule_tac x="ball x(d x)" in exI) apply auto
15.337 + by (rule d [THEN conjunct1])
15.338 + hence "x\<in> ?T \<inter> U" using SU and `x\<in>S` by auto }
15.339 + moreover
15.340 + { fix y assume "y\<in>?T"
15.341 + then obtain B where "y\<in>B" "B\<in>{B. \<exists>x\<in>S. B = ball x (d x)}" by auto
15.342 + then obtain x where "x\<in>S" and x:"y \<in> ball x (d x)" by auto
15.343 + assume "y\<in>U"
15.344 + hence "y\<in>S" using d[OF `x\<in>S`] and x by(auto simp add: dist_commute) }
15.345 + ultimately have "S = ?T \<inter> U" by blast
15.346 + with oT have ?lhs unfolding openin_subtopology open_openin[symmetric] by blast}
15.347 + ultimately show ?thesis by blast
15.348 +qed
15.349 +
15.350 +text{* These "transitivity" results are handy too. *}
15.351 +
15.352 +lemma openin_trans[trans]: "openin (subtopology euclidean T) S \<Longrightarrow> openin (subtopology euclidean U) T
15.353 + \<Longrightarrow> openin (subtopology euclidean U) S"
15.354 + unfolding open_openin openin_open by blast
15.355 +
15.356 +lemma openin_open_trans: "openin (subtopology euclidean T) S \<Longrightarrow> open T \<Longrightarrow> open S"
15.357 + by (auto simp add: openin_open intro: openin_trans)
15.358 +
15.359 +lemma closedin_trans[trans]:
15.360 + "closedin (subtopology euclidean T) S \<Longrightarrow>
15.361 + closedin (subtopology euclidean U) T
15.362 + ==> closedin (subtopology euclidean U) S"
15.363 + by (auto simp add: closedin_closed closed_closedin closed_Inter Int_assoc)
15.364 +
15.365 +lemma closedin_closed_trans: "closedin (subtopology euclidean T) S \<Longrightarrow> closed T \<Longrightarrow> closed S"
15.366 + by (auto simp add: closedin_closed intro: closedin_trans)
15.367 +
15.368 +subsection{* Connectedness *}
15.369 +
15.370 +definition "connected S \<longleftrightarrow>
15.371 + ~(\<exists>e1 e2. open e1 \<and> open e2 \<and> S \<subseteq> (e1 \<union> e2) \<and> (e1 \<inter> e2 \<inter> S = {})
15.372 + \<and> ~(e1 \<inter> S = {}) \<and> ~(e2 \<inter> S = {}))"
15.373 +
15.374 +lemma connected_local:
15.375 + "connected S \<longleftrightarrow> ~(\<exists>e1 e2.
15.376 + openin (subtopology euclidean S) e1 \<and>
15.377 + openin (subtopology euclidean S) e2 \<and>
15.378 + S \<subseteq> e1 \<union> e2 \<and>
15.379 + e1 \<inter> e2 = {} \<and>
15.380 + ~(e1 = {}) \<and>
15.381 + ~(e2 = {}))"
15.382 +unfolding connected_def openin_open by (safe, blast+)
15.383 +
15.384 +lemma exists_diff: "(\<exists>S. P(UNIV - S)) \<longleftrightarrow> (\<exists>S. P S)" (is "?lhs \<longleftrightarrow> ?rhs")
15.385 +proof-
15.386 +
15.387 + {assume "?lhs" hence ?rhs by blast }
15.388 + moreover
15.389 + {fix S assume H: "P S"
15.390 + have "S = UNIV - (UNIV - S)" by auto
15.391 + with H have "P (UNIV - (UNIV - S))" by metis }
15.392 + ultimately show ?thesis by metis
15.393 +qed
15.394 +
15.395 +lemma connected_clopen: "connected S \<longleftrightarrow>
15.396 + (\<forall>T. openin (subtopology euclidean S) T \<and>
15.397 + closedin (subtopology euclidean S) T \<longrightarrow> T = {} \<or> T = S)" (is "?lhs \<longleftrightarrow> ?rhs")
15.398 +proof-
15.399 + have " \<not> connected S \<longleftrightarrow> (\<exists>e1 e2. open e1 \<and> open (UNIV - e2) \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
15.400 + unfolding connected_def openin_open closedin_closed
15.401 + apply (subst exists_diff) by blast
15.402 + hence th0: "connected S \<longleftrightarrow> \<not> (\<exists>e2 e1. closed e2 \<and> open e1 \<and> S \<subseteq> e1 \<union> (UNIV - e2) \<and> e1 \<inter> (UNIV - e2) \<inter> S = {} \<and> e1 \<inter> S \<noteq> {} \<and> (UNIV - e2) \<inter> S \<noteq> {})"
15.403 + (is " _ \<longleftrightarrow> \<not> (\<exists>e2 e1. ?P e2 e1)") apply (simp add: closed_def Compl_eq_Diff_UNIV) by metis
15.404 +
15.405 + 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'))"
15.406 + (is "_ \<longleftrightarrow> \<not> (\<exists>t' t. ?Q t' t)")
15.407 + unfolding connected_def openin_open closedin_closed by auto
15.408 + {fix e2
15.409 + {fix e1 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)"
15.410 + by auto}
15.411 + then have "(\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by metis}
15.412 + then have "\<forall>e2. (\<exists>e1. ?P e2 e1) \<longleftrightarrow> (\<exists>t. ?Q e2 t)" by blast
15.413 + then show ?thesis unfolding th0 th1 by simp
15.414 +qed
15.415 +
15.416 +lemma connected_empty[simp, intro]: "connected {}"
15.417 + by (simp add: connected_def)
15.418 +
15.419 +subsection{* Hausdorff and other separation properties *}
15.420 +
15.421 +class t0_space =
15.422 + assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
15.423 +
15.424 +class t1_space =
15.425 + assumes t1_space: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<notin> U \<and> x \<notin> V \<and> y \<in> V"
15.426 +begin
15.427 +
15.428 +subclass t0_space
15.429 +proof
15.430 +qed (fast dest: t1_space)
15.431 +
15.432 +end
15.433 +
15.434 +text {* T2 spaces are also known as Hausdorff spaces. *}
15.435 +
15.436 +class t2_space =
15.437 + assumes hausdorff: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
15.438 +begin
15.439 +
15.440 +subclass t1_space
15.441 +proof
15.442 +qed (fast dest: hausdorff)
15.443 +
15.444 +end
15.445 +
15.446 +instance metric_space \<subseteq> t2_space
15.447 +proof
15.448 + fix x y :: "'a::metric_space"
15.449 + assume xy: "x \<noteq> y"
15.450 + let ?U = "ball x (dist x y / 2)"
15.451 + let ?V = "ball y (dist x y / 2)"
15.452 + have th0: "\<And>d x y z. (d x z :: real) <= d x y + d y z \<Longrightarrow> d y z = d z y
15.453 + ==> ~(d x y * 2 < d x z \<and> d z y * 2 < d x z)" by arith
15.454 + have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
15.455 + using dist_pos_lt[OF xy] th0[of dist,OF dist_triangle dist_commute]
15.456 + by (auto simp add: expand_set_eq)
15.457 + then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
15.458 + by blast
15.459 +qed
15.460 +
15.461 +lemma separation_t2:
15.462 + fixes x y :: "'a::t2_space"
15.463 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
15.464 + using hausdorff[of x y] by blast
15.465 +
15.466 +lemma separation_t1:
15.467 + fixes x y :: "'a::t1_space"
15.468 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in>U \<and> y\<notin> U \<and> x\<notin>V \<and> y\<in>V)"
15.469 + using t1_space[of x y] by blast
15.470 +
15.471 +lemma separation_t0:
15.472 + fixes x y :: "'a::t0_space"
15.473 + shows "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> ~(x\<in>U \<longleftrightarrow> y\<in>U))"
15.474 + using t0_space[of x y] by blast
15.475 +
15.476 +subsection{* Limit points *}
15.477 +
15.478 +definition
15.479 + islimpt:: "'a::topological_space \<Rightarrow> 'a set \<Rightarrow> bool"
15.480 + (infixr "islimpt" 60) where
15.481 + "x islimpt S \<longleftrightarrow> (\<forall>T. x\<in>T \<longrightarrow> open T \<longrightarrow> (\<exists>y\<in>S. y\<in>T \<and> y\<noteq>x))"
15.482 +
15.483 +lemma islimptI:
15.484 + assumes "\<And>T. x \<in> T \<Longrightarrow> open T \<Longrightarrow> \<exists>y\<in>S. y \<in> T \<and> y \<noteq> x"
15.485 + shows "x islimpt S"
15.486 + using assms unfolding islimpt_def by auto
15.487 +
15.488 +lemma islimptE:
15.489 + assumes "x islimpt S" and "x \<in> T" and "open T"
15.490 + obtains y where "y \<in> S" and "y \<in> T" and "y \<noteq> x"
15.491 + using assms unfolding islimpt_def by auto
15.492 +
15.493 +lemma islimpt_subset: "x islimpt S \<Longrightarrow> S \<subseteq> T ==> x islimpt T" by (auto simp add: islimpt_def)
15.494 +
15.495 +lemma islimpt_approachable:
15.496 + fixes x :: "'a::metric_space"
15.497 + shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e)"
15.498 + unfolding islimpt_def
15.499 + apply auto
15.500 + apply(erule_tac x="ball x e" in allE)
15.501 + apply auto
15.502 + apply(rule_tac x=y in bexI)
15.503 + apply (auto simp add: dist_commute)
15.504 + apply (simp add: open_dist, drule (1) bspec)
15.505 + apply (clarify, drule spec, drule (1) mp, auto)
15.506 + done
15.507 +
15.508 +lemma islimpt_approachable_le:
15.509 + fixes x :: "'a::metric_space"
15.510 + shows "x islimpt S \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> S. x' \<noteq> x \<and> dist x' x <= e)"
15.511 + unfolding islimpt_approachable
15.512 + using approachable_lt_le[where f="\<lambda>x'. dist x' x" and P="\<lambda>x'. \<not> (x'\<in>S \<and> x'\<noteq>x)"]
15.513 + by metis (* FIXME: VERY slow! *)
15.514 +
15.515 +class perfect_space =
15.516 + (* FIXME: perfect_space should inherit from topological_space *)
15.517 + assumes islimpt_UNIV [simp, intro]: "(x::'a::metric_space) islimpt UNIV"
15.518 +
15.519 +lemma perfect_choose_dist:
15.520 + fixes x :: "'a::perfect_space"
15.521 + shows "0 < r \<Longrightarrow> \<exists>a. a \<noteq> x \<and> dist a x < r"
15.522 +using islimpt_UNIV [of x]
15.523 +by (simp add: islimpt_approachable)
15.524 +
15.525 +instance real :: perfect_space
15.526 +apply default
15.527 +apply (rule islimpt_approachable [THEN iffD2])
15.528 +apply (clarify, rule_tac x="x + e/2" in bexI)
15.529 +apply (auto simp add: dist_norm)
15.530 +done
15.531 +
15.532 +instance "^" :: (perfect_space, finite) perfect_space
15.533 +proof
15.534 + fix x :: "'a ^ 'b"
15.535 + {
15.536 + fix e :: real assume "0 < e"
15.537 + def a \<equiv> "x $ undefined"
15.538 + have "a islimpt UNIV" by (rule islimpt_UNIV)
15.539 + with `0 < e` obtain b where "b \<noteq> a" and "dist b a < e"
15.540 + unfolding islimpt_approachable by auto
15.541 + def y \<equiv> "Cart_lambda ((Cart_nth x)(undefined := b))"
15.542 + from `b \<noteq> a` have "y \<noteq> x"
15.543 + unfolding a_def y_def by (simp add: Cart_eq)
15.544 + from `dist b a < e` have "dist y x < e"
15.545 + unfolding dist_vector_def a_def y_def
15.546 + apply simp
15.547 + apply (rule le_less_trans [OF setL2_le_setsum [OF zero_le_dist]])
15.548 + apply (subst setsum_diff1' [where a=undefined], simp, simp, simp)
15.549 + done
15.550 + from `y \<noteq> x` and `dist y x < e`
15.551 + have "\<exists>y\<in>UNIV. y \<noteq> x \<and> dist y x < e" by auto
15.552 + }
15.553 + then show "x islimpt UNIV" unfolding islimpt_approachable by blast
15.554 +qed
15.555 +
15.556 +lemma closed_limpt: "closed S \<longleftrightarrow> (\<forall>x. x islimpt S \<longrightarrow> x \<in> S)"
15.557 + unfolding closed_def
15.558 + apply (subst open_subopen)
15.559 + apply (simp add: islimpt_def subset_eq Compl_eq_Diff_UNIV)
15.560 + by (metis DiffE DiffI UNIV_I insertCI insert_absorb mem_def)
15.561 +
15.562 +lemma islimpt_EMPTY[simp]: "\<not> x islimpt {}"
15.563 + unfolding islimpt_def by auto
15.564 +
15.565 +lemma closed_positive_orthant: "closed {x::real^'n::finite. \<forall>i. 0 \<le>x$i}"
15.566 +proof-
15.567 + let ?U = "UNIV :: 'n set"
15.568 + let ?O = "{x::real^'n. \<forall>i. x$i\<ge>0}"
15.569 + {fix x:: "real^'n" and i::'n assume H: "\<forall>e>0. \<exists>x'\<in>?O. x' \<noteq> x \<and> dist x' x < e"
15.570 + and xi: "x$i < 0"
15.571 + from xi have th0: "-x$i > 0" by arith
15.572 + from H[rule_format, OF th0] obtain x' where x': "x' \<in>?O" "x' \<noteq> x" "dist x' x < -x $ i" by blast
15.573 + have th:" \<And>b a (x::real). abs x <= b \<Longrightarrow> b <= a ==> ~(a + x < 0)" by arith
15.574 + have th': "\<And>x (y::real). x < 0 \<Longrightarrow> 0 <= y ==> abs x <= abs (y - x)" by arith
15.575 + have th1: "\<bar>x$i\<bar> \<le> \<bar>(x' - x)$i\<bar>" using x'(1) xi
15.576 + apply (simp only: vector_component)
15.577 + by (rule th') auto
15.578 + have th2: "\<bar>dist x x'\<bar> \<ge> \<bar>(x' - x)$i\<bar>" using component_le_norm[of "x'-x" i]
15.579 + apply (simp add: dist_norm) by norm
15.580 + from th[OF th1 th2] x'(3) have False by (simp add: dist_commute) }
15.581 + then show ?thesis unfolding closed_limpt islimpt_approachable
15.582 + unfolding not_le[symmetric] by blast
15.583 +qed
15.584 +
15.585 +lemma finite_set_avoid:
15.586 + fixes a :: "'a::metric_space"
15.587 + assumes fS: "finite S" shows "\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<longrightarrow> d <= dist a x"
15.588 +proof(induct rule: finite_induct[OF fS])
15.589 + case 1 thus ?case apply auto by ferrack
15.590 +next
15.591 + case (2 x F)
15.592 + from 2 obtain d where d: "d >0" "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> d \<le> dist a x" by blast
15.593 + {assume "x = a" hence ?case using d by auto }
15.594 + moreover
15.595 + {assume xa: "x\<noteq>a"
15.596 + let ?d = "min d (dist a x)"
15.597 + have dp: "?d > 0" using xa d(1) using dist_nz by auto
15.598 + from d have d': "\<forall>x\<in>F. x\<noteq>a \<longrightarrow> ?d \<le> dist a x" by auto
15.599 + with dp xa have ?case by(auto intro!: exI[where x="?d"]) }
15.600 + ultimately show ?case by blast
15.601 +qed
15.602 +
15.603 +lemma islimpt_finite:
15.604 + fixes S :: "'a::metric_space set"
15.605 + assumes fS: "finite S" shows "\<not> a islimpt S"
15.606 + unfolding islimpt_approachable
15.607 + using finite_set_avoid[OF fS, of a] by (metis dist_commute not_le)
15.608 +
15.609 +lemma islimpt_Un: "x islimpt (S \<union> T) \<longleftrightarrow> x islimpt S \<or> x islimpt T"
15.610 + apply (rule iffI)
15.611 + defer
15.612 + apply (metis Un_upper1 Un_upper2 islimpt_subset)
15.613 + unfolding islimpt_def
15.614 + apply (rule ccontr, clarsimp, rename_tac A B)
15.615 + apply (drule_tac x="A \<inter> B" in spec)
15.616 + apply (auto simp add: open_Int)
15.617 + done
15.618 +
15.619 +lemma discrete_imp_closed:
15.620 + fixes S :: "'a::metric_space set"
15.621 + assumes e: "0 < e" and d: "\<forall>x \<in> S. \<forall>y \<in> S. dist y x < e \<longrightarrow> y = x"
15.622 + shows "closed S"
15.623 +proof-
15.624 + {fix x assume C: "\<forall>e>0. \<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
15.625 + from e have e2: "e/2 > 0" by arith
15.626 + from C[rule_format, OF e2] obtain y where y: "y \<in> S" "y\<noteq>x" "dist y x < e/2" by blast
15.627 + let ?m = "min (e/2) (dist x y) "
15.628 + from e2 y(2) have mp: "?m > 0" by (simp add: dist_nz[THEN sym])
15.629 + from C[rule_format, OF mp] obtain z where z: "z \<in> S" "z\<noteq>x" "dist z x < ?m" by blast
15.630 + have th: "dist z y < e" using z y
15.631 + by (intro dist_triangle_lt [where z=x], simp)
15.632 + from d[rule_format, OF y(1) z(1) th] y z
15.633 + have False by (auto simp add: dist_commute)}
15.634 + then show ?thesis by (metis islimpt_approachable closed_limpt [where 'a='a])
15.635 +qed
15.636 +
15.637 +subsection{* Interior of a Set *}
15.638 +definition "interior S = {x. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S}"
15.639 +
15.640 +lemma interior_eq: "interior S = S \<longleftrightarrow> open S"
15.641 + apply (simp add: expand_set_eq interior_def)
15.642 + apply (subst (2) open_subopen) by (safe, blast+)
15.643 +
15.644 +lemma interior_open: "open S ==> (interior S = S)" by (metis interior_eq)
15.645 +
15.646 +lemma interior_empty[simp]: "interior {} = {}" by (simp add: interior_def)
15.647 +
15.648 +lemma open_interior[simp, intro]: "open(interior S)"
15.649 + apply (simp add: interior_def)
15.650 + apply (subst open_subopen) by blast
15.651 +
15.652 +lemma interior_interior[simp]: "interior(interior S) = interior S" by (metis interior_eq open_interior)
15.653 +lemma interior_subset: "interior S \<subseteq> S" by (auto simp add: interior_def)
15.654 +lemma subset_interior: "S \<subseteq> T ==> (interior S) \<subseteq> (interior T)" by (auto simp add: interior_def)
15.655 +lemma interior_maximal: "T \<subseteq> S \<Longrightarrow> open T ==> T \<subseteq> (interior S)" by (auto simp add: interior_def)
15.656 +lemma interior_unique: "T \<subseteq> S \<Longrightarrow> open T \<Longrightarrow> (\<forall>T'. T' \<subseteq> S \<and> open T' \<longrightarrow> T' \<subseteq> T) \<Longrightarrow> interior S = T"
15.657 + by (metis equalityI interior_maximal interior_subset open_interior)
15.658 +lemma mem_interior: "x \<in> interior S \<longleftrightarrow> (\<exists>e. 0 < e \<and> ball x e \<subseteq> S)"
15.659 + apply (simp add: interior_def)
15.660 + by (metis open_contains_ball centre_in_ball open_ball subset_trans)
15.661 +
15.662 +lemma open_subset_interior: "open S ==> S \<subseteq> interior T \<longleftrightarrow> S \<subseteq> T"
15.663 + by (metis interior_maximal interior_subset subset_trans)
15.664 +
15.665 +lemma interior_inter[simp]: "interior(S \<inter> T) = interior S \<inter> interior T"
15.666 + apply (rule equalityI, simp)
15.667 + apply (metis Int_lower1 Int_lower2 subset_interior)
15.668 + by (metis Int_mono interior_subset open_Int open_interior open_subset_interior)
15.669 +
15.670 +lemma interior_limit_point [intro]:
15.671 + fixes x :: "'a::perfect_space"
15.672 + assumes x: "x \<in> interior S" shows "x islimpt S"
15.673 +proof-
15.674 + from x obtain e where e: "e>0" "\<forall>x'. dist x x' < e \<longrightarrow> x' \<in> S"
15.675 + unfolding mem_interior subset_eq Ball_def mem_ball by blast
15.676 + {
15.677 + fix d::real assume d: "d>0"
15.678 + let ?m = "min d e"
15.679 + have mde2: "0 < ?m" using e(1) d(1) by simp
15.680 + from perfect_choose_dist [OF mde2, of x]
15.681 + obtain y where "y \<noteq> x" and "dist y x < ?m" by blast
15.682 + then have "dist y x < e" "dist y x < d" by simp_all
15.683 + from `dist y x < e` e(2) have "y \<in> S" by (simp add: dist_commute)
15.684 + have "\<exists>x'\<in>S. x'\<noteq> x \<and> dist x' x < d"
15.685 + using `y \<in> S` `y \<noteq> x` `dist y x < d` by fast
15.686 + }
15.687 + then show ?thesis unfolding islimpt_approachable by blast
15.688 +qed
15.689 +
15.690 +lemma interior_closed_Un_empty_interior:
15.691 + assumes cS: "closed S" and iT: "interior T = {}"
15.692 + shows "interior(S \<union> T) = interior S"
15.693 +proof
15.694 + show "interior S \<subseteq> interior (S\<union>T)"
15.695 + by (rule subset_interior, blast)
15.696 +next
15.697 + show "interior (S \<union> T) \<subseteq> interior S"
15.698 + proof
15.699 + fix x assume "x \<in> interior (S \<union> T)"
15.700 + then obtain R where "open R" "x \<in> R" "R \<subseteq> S \<union> T"
15.701 + unfolding interior_def by fast
15.702 + show "x \<in> interior S"
15.703 + proof (rule ccontr)
15.704 + assume "x \<notin> interior S"
15.705 + with `x \<in> R` `open R` obtain y where "y \<in> R - S"
15.706 + unfolding interior_def expand_set_eq by fast
15.707 + from `open R` `closed S` have "open (R - S)" by (rule open_Diff)
15.708 + from `R \<subseteq> S \<union> T` have "R - S \<subseteq> T" by fast
15.709 + from `y \<in> R - S` `open (R - S)` `R - S \<subseteq> T` `interior T = {}`
15.710 + show "False" unfolding interior_def by fast
15.711 + qed
15.712 + qed
15.713 +qed
15.714 +
15.715 +
15.716 +subsection{* Closure of a Set *}
15.717 +
15.718 +definition "closure S = S \<union> {x | x. x islimpt S}"
15.719 +
15.720 +lemma closure_interior: "closure S = UNIV - interior (UNIV - S)"
15.721 +proof-
15.722 + { fix x
15.723 + have "x\<in>UNIV - interior (UNIV - S) \<longleftrightarrow> x \<in> closure S" (is "?lhs = ?rhs")
15.724 + proof
15.725 + let ?exT = "\<lambda> y. (\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> UNIV - S)"
15.726 + assume "?lhs"
15.727 + hence *:"\<not> ?exT x"
15.728 + unfolding interior_def
15.729 + by simp
15.730 + { assume "\<not> ?rhs"
15.731 + hence False using *
15.732 + unfolding closure_def islimpt_def
15.733 + by blast
15.734 + }
15.735 + thus "?rhs"
15.736 + by blast
15.737 + next
15.738 + assume "?rhs" thus "?lhs"
15.739 + unfolding closure_def interior_def islimpt_def
15.740 + by blast
15.741 + qed
15.742 + }
15.743 + thus ?thesis
15.744 + by blast
15.745 +qed
15.746 +
15.747 +lemma interior_closure: "interior S = UNIV - (closure (UNIV - S))"
15.748 +proof-
15.749 + { fix x
15.750 + have "x \<in> interior S \<longleftrightarrow> x \<in> UNIV - (closure (UNIV - S))"
15.751 + unfolding interior_def closure_def islimpt_def
15.752 + by blast (* FIXME: VERY slow! *)
15.753 + }
15.754 + thus ?thesis
15.755 + by blast
15.756 +qed
15.757 +
15.758 +lemma closed_closure[simp, intro]: "closed (closure S)"
15.759 +proof-
15.760 + have "closed (UNIV - interior (UNIV -S))" by blast
15.761 + thus ?thesis using closure_interior[of S] by simp
15.762 +qed
15.763 +
15.764 +lemma closure_hull: "closure S = closed hull S"
15.765 +proof-
15.766 + have "S \<subseteq> closure S"
15.767 + unfolding closure_def
15.768 + by blast
15.769 + moreover
15.770 + have "closed (closure S)"
15.771 + using closed_closure[of S]
15.772 + by assumption
15.773 + moreover
15.774 + { fix t
15.775 + assume *:"S \<subseteq> t" "closed t"
15.776 + { fix x
15.777 + assume "x islimpt S"
15.778 + hence "x islimpt t" using *(1)
15.779 + using islimpt_subset[of x, of S, of t]
15.780 + by blast
15.781 + }
15.782 + with * have "closure S \<subseteq> t"
15.783 + unfolding closure_def
15.784 + using closed_limpt[of t]
15.785 + by auto
15.786 + }
15.787 + ultimately show ?thesis
15.788 + using hull_unique[of S, of "closure S", of closed]
15.789 + unfolding mem_def
15.790 + by simp
15.791 +qed
15.792 +
15.793 +lemma closure_eq: "closure S = S \<longleftrightarrow> closed S"
15.794 + unfolding closure_hull
15.795 + using hull_eq[of closed, unfolded mem_def, OF closed_Inter, of S]
15.796 + by (metis mem_def subset_eq)
15.797 +
15.798 +lemma closure_closed[simp]: "closed S \<Longrightarrow> closure S = S"
15.799 + using closure_eq[of S]
15.800 + by simp
15.801 +
15.802 +lemma closure_closure[simp]: "closure (closure S) = closure S"
15.803 + unfolding closure_hull
15.804 + using hull_hull[of closed S]
15.805 + by assumption
15.806 +
15.807 +lemma closure_subset: "S \<subseteq> closure S"
15.808 + unfolding closure_hull
15.809 + using hull_subset[of S closed]
15.810 + by assumption
15.811 +
15.812 +lemma subset_closure: "S \<subseteq> T \<Longrightarrow> closure S \<subseteq> closure T"
15.813 + unfolding closure_hull
15.814 + using hull_mono[of S T closed]
15.815 + by assumption
15.816 +
15.817 +lemma closure_minimal: "S \<subseteq> T \<Longrightarrow> closed T \<Longrightarrow> closure S \<subseteq> T"
15.818 + using hull_minimal[of S T closed]
15.819 + unfolding closure_hull mem_def
15.820 + by simp
15.821 +
15.822 +lemma closure_unique: "S \<subseteq> T \<and> closed T \<and> (\<forall> T'. S \<subseteq> T' \<and> closed T' \<longrightarrow> T \<subseteq> T') \<Longrightarrow> closure S = T"
15.823 + using hull_unique[of S T closed]
15.824 + unfolding closure_hull mem_def
15.825 + by simp
15.826 +
15.827 +lemma closure_empty[simp]: "closure {} = {}"
15.828 + using closed_empty closure_closed[of "{}"]
15.829 + by simp
15.830 +
15.831 +lemma closure_univ[simp]: "closure UNIV = UNIV"
15.832 + using closure_closed[of UNIV]
15.833 + by simp
15.834 +
15.835 +lemma closure_eq_empty: "closure S = {} \<longleftrightarrow> S = {}"
15.836 + using closure_empty closure_subset[of S]
15.837 + by blast
15.838 +
15.839 +lemma closure_subset_eq: "closure S \<subseteq> S \<longleftrightarrow> closed S"
15.840 + using closure_eq[of S] closure_subset[of S]
15.841 + by simp
15.842 +
15.843 +lemma open_inter_closure_eq_empty:
15.844 + "open S \<Longrightarrow> (S \<inter> closure T) = {} \<longleftrightarrow> S \<inter> T = {}"
15.845 + using open_subset_interior[of S "UNIV - T"]
15.846 + using interior_subset[of "UNIV - T"]
15.847 + unfolding closure_interior
15.848 + by auto
15.849 +
15.850 +lemma open_inter_closure_subset:
15.851 + "open S \<Longrightarrow> (S \<inter> (closure T)) \<subseteq> closure(S \<inter> T)"
15.852 +proof
15.853 + fix x
15.854 + assume as: "open S" "x \<in> S \<inter> closure T"
15.855 + { assume *:"x islimpt T"
15.856 + have "x islimpt (S \<inter> T)"
15.857 + proof (rule islimptI)
15.858 + fix A
15.859 + assume "x \<in> A" "open A"
15.860 + with as have "x \<in> A \<inter> S" "open (A \<inter> S)"
15.861 + by (simp_all add: open_Int)
15.862 + with * obtain y where "y \<in> T" "y \<in> A \<inter> S" "y \<noteq> x"
15.863 + by (rule islimptE)
15.864 + hence "y \<in> S \<inter> T" "y \<in> A \<and> y \<noteq> x"
15.865 + by simp_all
15.866 + thus "\<exists>y\<in>(S \<inter> T). y \<in> A \<and> y \<noteq> x" ..
15.867 + qed
15.868 + }
15.869 + then show "x \<in> closure (S \<inter> T)" using as
15.870 + unfolding closure_def
15.871 + by blast
15.872 +qed
15.873 +
15.874 +lemma closure_complement: "closure(UNIV - S) = UNIV - interior(S)"
15.875 +proof-
15.876 + have "S = UNIV - (UNIV - S)"
15.877 + by auto
15.878 + thus ?thesis
15.879 + unfolding closure_interior
15.880 + by auto
15.881 +qed
15.882 +
15.883 +lemma interior_complement: "interior(UNIV - S) = UNIV - closure(S)"
15.884 + unfolding closure_interior
15.885 + by blast
15.886 +
15.887 +subsection{* Frontier (aka boundary) *}
15.888 +
15.889 +definition "frontier S = closure S - interior S"
15.890 +
15.891 +lemma frontier_closed: "closed(frontier S)"
15.892 + by (simp add: frontier_def closed_Diff)
15.893 +
15.894 +lemma frontier_closures: "frontier S = (closure S) \<inter> (closure(UNIV - S))"
15.895 + by (auto simp add: frontier_def interior_closure)
15.896 +
15.897 +lemma frontier_straddle:
15.898 + fixes a :: "'a::metric_space"
15.899 + shows "a \<in> frontier S \<longleftrightarrow> (\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e))" (is "?lhs \<longleftrightarrow> ?rhs")
15.900 +proof
15.901 + assume "?lhs"
15.902 + { fix e::real
15.903 + assume "e > 0"
15.904 + let ?rhse = "(\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)"
15.905 + { assume "a\<in>S"
15.906 + have "\<exists>x\<in>S. dist a x < e" using `e>0` `a\<in>S` by(rule_tac x=a in bexI) auto
15.907 + moreover have "\<exists>x. x \<notin> S \<and> dist a x < e" using `?lhs` `a\<in>S`
15.908 + unfolding frontier_closures closure_def islimpt_def using `e>0`
15.909 + by (auto, erule_tac x="ball a e" in allE, auto)
15.910 + ultimately have ?rhse by auto
15.911 + }
15.912 + moreover
15.913 + { assume "a\<notin>S"
15.914 + hence ?rhse using `?lhs`
15.915 + unfolding frontier_closures closure_def islimpt_def
15.916 + using open_ball[of a e] `e > 0`
15.917 + by (auto, erule_tac x = "ball a e" in allE, auto) (* FIXME: VERY slow! *)
15.918 + }
15.919 + ultimately have ?rhse by auto
15.920 + }
15.921 + thus ?rhs by auto
15.922 +next
15.923 + assume ?rhs
15.924 + moreover
15.925 + { fix T assume "a\<notin>S" and
15.926 + as:"\<forall>e>0. (\<exists>x\<in>S. dist a x < e) \<and> (\<exists>x. x \<notin> S \<and> dist a x < e)" "a \<notin> S" "a \<in> T" "open T"
15.927 + from `open T` `a \<in> T` have "\<exists>e>0. ball a e \<subseteq> T" unfolding open_contains_ball[of T] by auto
15.928 + then obtain e where "e>0" "ball a e \<subseteq> T" by auto
15.929 + then obtain y where y:"y\<in>S" "dist a y < e" using as(1) by auto
15.930 + have "\<exists>y\<in>S. y \<in> T \<and> y \<noteq> a"
15.931 + using `dist a y < e` `ball a e \<subseteq> T` unfolding ball_def using `y\<in>S` `a\<notin>S` by auto
15.932 + }
15.933 + hence "a \<in> closure S" unfolding closure_def islimpt_def using `?rhs` by auto
15.934 + moreover
15.935 + { fix T assume "a \<in> T" "open T" "a\<in>S"
15.936 + then obtain e where "e>0" and balle: "ball a e \<subseteq> T" unfolding open_contains_ball using `?rhs` by auto
15.937 + obtain x where "x \<notin> S" "dist a x < e" using `?rhs` using `e>0` by auto
15.938 + hence "\<exists>y\<in>UNIV - S. y \<in> T \<and> y \<noteq> a" using balle `a\<in>S` unfolding ball_def by (rule_tac x=x in bexI)auto
15.939 + }
15.940 + hence "a islimpt (UNIV - S) \<or> a\<notin>S" unfolding islimpt_def by auto
15.941 + ultimately show ?lhs unfolding frontier_closures using closure_def[of "UNIV - S"] by auto
15.942 +qed
15.943 +
15.944 +lemma frontier_subset_closed: "closed S \<Longrightarrow> frontier S \<subseteq> S"
15.945 + by (metis frontier_def closure_closed Diff_subset)
15.946 +
15.947 +lemma frontier_empty: "frontier {} = {}"
15.948 + by (simp add: frontier_def closure_empty)
15.949 +
15.950 +lemma frontier_subset_eq: "frontier S \<subseteq> S \<longleftrightarrow> closed S"
15.951 +proof-
15.952 + { assume "frontier S \<subseteq> S"
15.953 + hence "closure S \<subseteq> S" using interior_subset unfolding frontier_def by auto
15.954 + hence "closed S" using closure_subset_eq by auto
15.955 + }
15.956 + thus ?thesis using frontier_subset_closed[of S] by auto
15.957 +qed
15.958 +
15.959 +lemma frontier_complement: "frontier(UNIV - S) = frontier S"
15.960 + by (auto simp add: frontier_def closure_complement interior_complement)
15.961 +
15.962 +lemma frontier_disjoint_eq: "frontier S \<inter> S = {} \<longleftrightarrow> open S"
15.963 + using frontier_complement frontier_subset_eq[of "UNIV - S"]
15.964 + unfolding open_closed Compl_eq_Diff_UNIV by auto
15.965 +
15.966 +subsection{* Common nets and The "within" modifier for nets. *}
15.967 +
15.968 +definition
15.969 + at_infinity :: "'a::real_normed_vector net" where
15.970 + "at_infinity = Abs_net (range (\<lambda>r. {x. r \<le> norm x}))"
15.971 +
15.972 +definition
15.973 + indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a net" (infixr "indirection" 70) where
15.974 + "a indirection v = (at a) within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
15.975 +
15.976 +text{* Prove That They are all nets. *}
15.977 +
15.978 +lemma Rep_net_at_infinity:
15.979 + "Rep_net at_infinity = range (\<lambda>r. {x. r \<le> norm x})"
15.980 +unfolding at_infinity_def
15.981 +apply (rule Abs_net_inverse')
15.982 +apply (rule image_nonempty, simp)
15.983 +apply (clarsimp, rename_tac r s)
15.984 +apply (rule_tac x="max r s" in exI, auto)
15.985 +done
15.986 +
15.987 +lemma within_UNIV: "net within UNIV = net"
15.988 + by (simp add: Rep_net_inject [symmetric] Rep_net_within)
15.989 +
15.990 +subsection{* Identify Trivial limits, where we can't approach arbitrarily closely. *}
15.991 +
15.992 +definition
15.993 + trivial_limit :: "'a net \<Rightarrow> bool" where
15.994 + "trivial_limit net \<longleftrightarrow> {} \<in> Rep_net net"
15.995 +
15.996 +lemma trivial_limit_within:
15.997 + shows "trivial_limit (at a within S) \<longleftrightarrow> \<not> a islimpt S"
15.998 +proof
15.999 + assume "trivial_limit (at a within S)"
15.1000 + thus "\<not> a islimpt S"
15.1001 + unfolding trivial_limit_def
15.1002 + unfolding Rep_net_within Rep_net_at
15.1003 + unfolding islimpt_def
15.1004 + apply (clarsimp simp add: expand_set_eq)
15.1005 + apply (rename_tac T, rule_tac x=T in exI)
15.1006 + apply (clarsimp, drule_tac x=y in spec, simp)
15.1007 + done
15.1008 +next
15.1009 + assume "\<not> a islimpt S"
15.1010 + thus "trivial_limit (at a within S)"
15.1011 + unfolding trivial_limit_def
15.1012 + unfolding Rep_net_within Rep_net_at
15.1013 + unfolding islimpt_def
15.1014 + apply (clarsimp simp add: image_image)
15.1015 + apply (rule_tac x=T in image_eqI)
15.1016 + apply (auto simp add: expand_set_eq)
15.1017 + done
15.1018 +qed
15.1019 +
15.1020 +lemma trivial_limit_at_iff: "trivial_limit (at a) \<longleftrightarrow> \<not> a islimpt UNIV"
15.1021 + using trivial_limit_within [of a UNIV]
15.1022 + by (simp add: within_UNIV)
15.1023 +
15.1024 +lemma trivial_limit_at:
15.1025 + fixes a :: "'a::perfect_space"
15.1026 + shows "\<not> trivial_limit (at a)"
15.1027 + by (simp add: trivial_limit_at_iff)
15.1028 +
15.1029 +lemma trivial_limit_at_infinity:
15.1030 + "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,zero_neq_one}) net)"
15.1031 + (* FIXME: find a more appropriate type class *)
15.1032 + unfolding trivial_limit_def Rep_net_at_infinity
15.1033 + apply (clarsimp simp add: expand_set_eq)
15.1034 + apply (drule_tac x="scaleR r (sgn 1)" in spec)
15.1035 + apply (simp add: norm_sgn)
15.1036 + done
15.1037 +
15.1038 +lemma trivial_limit_sequentially: "\<not> trivial_limit sequentially"
15.1039 + by (auto simp add: trivial_limit_def Rep_net_sequentially)
15.1040 +
15.1041 +subsection{* Some property holds "sufficiently close" to the limit point. *}
15.1042 +
15.1043 +lemma eventually_at: (* FIXME: this replaces Limits.eventually_at *)
15.1044 + "eventually P (at a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
15.1045 +unfolding eventually_at dist_nz by auto
15.1046 +
15.1047 +lemma eventually_at_infinity:
15.1048 + "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. norm x >= b \<longrightarrow> P x)"
15.1049 +unfolding eventually_def Rep_net_at_infinity by auto
15.1050 +
15.1051 +lemma eventually_within: "eventually P (at a within S) \<longleftrightarrow>
15.1052 + (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a < d \<longrightarrow> P x)"
15.1053 +unfolding eventually_within eventually_at dist_nz by auto
15.1054 +
15.1055 +lemma eventually_within_le: "eventually P (at a within S) \<longleftrightarrow>
15.1056 + (\<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> P x)" (is "?lhs = ?rhs")
15.1057 +unfolding eventually_within
15.1058 +apply safe
15.1059 +apply (rule_tac x="d/2" in exI, simp)
15.1060 +apply (rule_tac x="d" in exI, simp)
15.1061 +done
15.1062 +
15.1063 +lemma eventually_happens: "eventually P net ==> trivial_limit net \<or> (\<exists>x. P x)"
15.1064 + unfolding eventually_def trivial_limit_def
15.1065 + using Rep_net_nonempty [of net] by auto
15.1066 +
15.1067 +lemma always_eventually: "(\<forall>x. P x) ==> eventually P net"
15.1068 + unfolding eventually_def trivial_limit_def
15.1069 + using Rep_net_nonempty [of net] by auto
15.1070 +
15.1071 +lemma trivial_limit_eventually: "trivial_limit net \<Longrightarrow> eventually P net"
15.1072 + unfolding trivial_limit_def eventually_def by auto
15.1073 +
15.1074 +lemma eventually_False: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
15.1075 + unfolding trivial_limit_def eventually_def by auto
15.1076 +
15.1077 +lemma trivial_limit_eq: "trivial_limit net \<longleftrightarrow> (\<forall>P. eventually P net)"
15.1078 + apply (safe elim!: trivial_limit_eventually)
15.1079 + apply (simp add: eventually_False [symmetric])
15.1080 + done
15.1081 +
15.1082 +text{* Combining theorems for "eventually" *}
15.1083 +
15.1084 +lemma eventually_conjI:
15.1085 + "\<lbrakk>eventually (\<lambda>x. P x) net; eventually (\<lambda>x. Q x) net\<rbrakk>
15.1086 + \<Longrightarrow> eventually (\<lambda>x. P x \<and> Q x) net"
15.1087 +by (rule eventually_conj)
15.1088 +
15.1089 +lemma eventually_rev_mono:
15.1090 + "eventually P net \<Longrightarrow> (\<forall>x. P x \<longrightarrow> Q x) \<Longrightarrow> eventually Q net"
15.1091 +using eventually_mono [of P Q] by fast
15.1092 +
15.1093 +lemma eventually_and: " eventually (\<lambda>x. P x \<and> Q x) net \<longleftrightarrow> eventually P net \<and> eventually Q net"
15.1094 + by (auto intro!: eventually_conjI elim: eventually_rev_mono)
15.1095 +
15.1096 +lemma eventually_false: "eventually (\<lambda>x. False) net \<longleftrightarrow> trivial_limit net"
15.1097 + by (auto simp add: eventually_False)
15.1098 +
15.1099 +lemma not_eventually: "(\<forall>x. \<not> P x ) \<Longrightarrow> ~(trivial_limit net) ==> ~(eventually (\<lambda>x. P x) net)"
15.1100 + by (simp add: eventually_False)
15.1101 +
15.1102 +subsection{* Limits, defined as vacuously true when the limit is trivial. *}
15.1103 +
15.1104 + text{* Notation Lim to avoid collition with lim defined in analysis *}
15.1105 +definition
15.1106 + Lim :: "'a net \<Rightarrow> ('a \<Rightarrow> 'b::t2_space) \<Rightarrow> 'b" where
15.1107 + "Lim net f = (THE l. (f ---> l) net)"
15.1108 +
15.1109 +lemma Lim:
15.1110 + "(f ---> l) net \<longleftrightarrow>
15.1111 + trivial_limit net \<or>
15.1112 + (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) net)"
15.1113 + unfolding tendsto_iff trivial_limit_eq by auto
15.1114 +
15.1115 +
15.1116 +text{* Show that they yield usual definitions in the various cases. *}
15.1117 +
15.1118 +lemma Lim_within_le: "(f ---> l)(at a within S) \<longleftrightarrow>
15.1119 + (\<forall>e>0. \<exists>d>0. \<forall>x\<in>S. 0 < dist x a \<and> dist x a <= d \<longrightarrow> dist (f x) l < e)"
15.1120 + by (auto simp add: tendsto_iff eventually_within_le)
15.1121 +
15.1122 +lemma Lim_within: "(f ---> l) (at a within S) \<longleftrightarrow>
15.1123 + (\<forall>e >0. \<exists>d>0. \<forall>x \<in> S. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
15.1124 + by (auto simp add: tendsto_iff eventually_within)
15.1125 +
15.1126 +lemma Lim_at: "(f ---> l) (at a) \<longleftrightarrow>
15.1127 + (\<forall>e >0. \<exists>d>0. \<forall>x. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) l < e)"
15.1128 + by (auto simp add: tendsto_iff eventually_at)
15.1129 +
15.1130 +lemma Lim_at_iff_LIM: "(f ---> l) (at a) \<longleftrightarrow> f -- a --> l"
15.1131 + unfolding Lim_at LIM_def by (simp only: zero_less_dist_iff)
15.1132 +
15.1133 +lemma Lim_at_infinity:
15.1134 + "(f ---> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x >= b \<longrightarrow> dist (f x) l < e)"
15.1135 + by (auto simp add: tendsto_iff eventually_at_infinity)
15.1136 +
15.1137 +lemma Lim_sequentially:
15.1138 + "(S ---> l) sequentially \<longleftrightarrow>
15.1139 + (\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (S n) l < e)"
15.1140 + by (auto simp add: tendsto_iff eventually_sequentially)
15.1141 +
15.1142 +lemma Lim_sequentially_iff_LIMSEQ: "(S ---> l) sequentially \<longleftrightarrow> S ----> l"
15.1143 + unfolding Lim_sequentially LIMSEQ_def ..
15.1144 +
15.1145 +lemma Lim_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> (f ---> l) net"
15.1146 + by (rule topological_tendstoI, auto elim: eventually_rev_mono)
15.1147 +
15.1148 +text{* The expected monotonicity property. *}
15.1149 +
15.1150 +lemma Lim_within_empty: "(f ---> l) (net within {})"
15.1151 + unfolding tendsto_def Limits.eventually_within by simp
15.1152 +
15.1153 +lemma Lim_within_subset: "(f ---> l) (net within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f ---> l) (net within T)"
15.1154 + unfolding tendsto_def Limits.eventually_within
15.1155 + by (auto elim!: eventually_elim1)
15.1156 +
15.1157 +lemma Lim_Un: assumes "(f ---> l) (net within S)" "(f ---> l) (net within T)"
15.1158 + shows "(f ---> l) (net within (S \<union> T))"
15.1159 + using assms unfolding tendsto_def Limits.eventually_within
15.1160 + apply clarify
15.1161 + apply (drule spec, drule (1) mp, drule (1) mp)
15.1162 + apply (drule spec, drule (1) mp, drule (1) mp)
15.1163 + apply (auto elim: eventually_elim2)
15.1164 + done
15.1165 +
15.1166 +lemma Lim_Un_univ:
15.1167 + "(f ---> l) (net within S) \<Longrightarrow> (f ---> l) (net within T) \<Longrightarrow> S \<union> T = UNIV
15.1168 + ==> (f ---> l) net"
15.1169 + by (metis Lim_Un within_UNIV)
15.1170 +
15.1171 +text{* Interrelations between restricted and unrestricted limits. *}
15.1172 +
15.1173 +lemma Lim_at_within: "(f ---> l) net ==> (f ---> l)(net within S)"
15.1174 + (* FIXME: rename *)
15.1175 + unfolding tendsto_def Limits.eventually_within
15.1176 + apply (clarify, drule spec, drule (1) mp, drule (1) mp)
15.1177 + by (auto elim!: eventually_elim1)
15.1178 +
15.1179 +lemma Lim_within_open:
15.1180 + fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
15.1181 + assumes"a \<in> S" "open S"
15.1182 + shows "(f ---> l)(at a within S) \<longleftrightarrow> (f ---> l)(at a)" (is "?lhs \<longleftrightarrow> ?rhs")
15.1183 +proof
15.1184 + assume ?lhs
15.1185 + { fix A assume "open A" "l \<in> A"
15.1186 + with `?lhs` have "eventually (\<lambda>x. f x \<in> A) (at a within S)"
15.1187 + by (rule topological_tendstoD)
15.1188 + hence "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x \<in> A) (at a)"
15.1189 + unfolding Limits.eventually_within .
15.1190 + then obtain T where "open T" "a \<in> T" "\<forall>x\<in>T. x \<noteq> a \<longrightarrow> x \<in> S \<longrightarrow> f x \<in> A"
15.1191 + unfolding eventually_at_topological by fast
15.1192 + hence "open (T \<inter> S)" "a \<in> T \<inter> S" "\<forall>x\<in>(T \<inter> S). x \<noteq> a \<longrightarrow> f x \<in> A"
15.1193 + using assms by auto
15.1194 + hence "\<exists>T. open T \<and> a \<in> T \<and> (\<forall>x\<in>T. x \<noteq> a \<longrightarrow> f x \<in> A)"
15.1195 + by fast
15.1196 + hence "eventually (\<lambda>x. f x \<in> A) (at a)"
15.1197 + unfolding eventually_at_topological .
15.1198 + }
15.1199 + thus ?rhs by (rule topological_tendstoI)
15.1200 +next
15.1201 + assume ?rhs
15.1202 + thus ?lhs by (rule Lim_at_within)
15.1203 +qed
15.1204 +
15.1205 +text{* Another limit point characterization. *}
15.1206 +
15.1207 +lemma islimpt_sequential:
15.1208 + fixes x :: "'a::metric_space" (* FIXME: generalize to topological_space *)
15.1209 + shows "x islimpt S \<longleftrightarrow> (\<exists>f. (\<forall>n::nat. f n \<in> S -{x}) \<and> (f ---> x) sequentially)"
15.1210 + (is "?lhs = ?rhs")
15.1211 +proof
15.1212 + assume ?lhs
15.1213 + then obtain f where f:"\<forall>y. y>0 \<longrightarrow> f y \<in> S \<and> f y \<noteq> x \<and> dist (f y) x < y"
15.1214 + unfolding islimpt_approachable using choice[of "\<lambda>e y. e>0 \<longrightarrow> y\<in>S \<and> y\<noteq>x \<and> dist y x < e"] by auto
15.1215 + { fix n::nat
15.1216 + have "f (inverse (real n + 1)) \<in> S - {x}" using f by auto
15.1217 + }
15.1218 + moreover
15.1219 + { fix e::real assume "e>0"
15.1220 + hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
15.1221 + then obtain N::nat where "inverse (real (N + 1)) < e" by auto
15.1222 + hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
15.1223 + moreover have "\<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < (inverse (real n + 1))" using f `e>0` by auto
15.1224 + ultimately have "\<exists>N::nat. \<forall>n\<ge>N. dist (f (inverse (real n + 1))) x < e" apply(rule_tac x=N in exI) apply auto apply(erule_tac x=n in allE)+ by auto
15.1225 + }
15.1226 + hence " ((\<lambda>n. f (inverse (real n + 1))) ---> x) sequentially"
15.1227 + unfolding Lim_sequentially using f by auto
15.1228 + ultimately show ?rhs apply (rule_tac x="(\<lambda>n::nat. f (inverse (real n + 1)))" in exI) by auto
15.1229 +next
15.1230 + assume ?rhs
15.1231 + then obtain f::"nat\<Rightarrow>'a" where f:"(\<forall>n. f n \<in> S - {x})" "(\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f n) x < e)" unfolding Lim_sequentially by auto
15.1232 + { fix e::real assume "e>0"
15.1233 + then obtain N where "dist (f N) x < e" using f(2) by auto
15.1234 + moreover have "f N\<in>S" "f N \<noteq> x" using f(1) by auto
15.1235 + ultimately have "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e" by auto
15.1236 + }
15.1237 + thus ?lhs unfolding islimpt_approachable by auto
15.1238 +qed
15.1239 +
15.1240 +text{* Basic arithmetical combining theorems for limits. *}
15.1241 +
15.1242 +lemma Lim_linear:
15.1243 + assumes "(f ---> l) net" "bounded_linear h"
15.1244 + shows "((\<lambda>x. h (f x)) ---> h l) net"
15.1245 +using `bounded_linear h` `(f ---> l) net`
15.1246 +by (rule bounded_linear.tendsto)
15.1247 +
15.1248 +lemma Lim_ident_at: "((\<lambda>x. x) ---> a) (at a)"
15.1249 + unfolding tendsto_def Limits.eventually_at_topological by fast
15.1250 +
15.1251 +lemma Lim_const: "((\<lambda>x. a) ---> a) net"
15.1252 + by (rule tendsto_const)
15.1253 +
15.1254 +lemma Lim_cmul:
15.1255 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1256 + shows "(f ---> l) net ==> ((\<lambda>x. c *\<^sub>R f x) ---> c *\<^sub>R l) net"
15.1257 + by (intro tendsto_intros)
15.1258 +
15.1259 +lemma Lim_neg:
15.1260 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1261 + shows "(f ---> l) net ==> ((\<lambda>x. -(f x)) ---> -l) net"
15.1262 + by (rule tendsto_minus)
15.1263 +
15.1264 +lemma Lim_add: fixes f :: "'a \<Rightarrow> 'b::real_normed_vector" shows
15.1265 + "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) + g(x)) ---> l + m) net"
15.1266 + by (rule tendsto_add)
15.1267 +
15.1268 +lemma Lim_sub:
15.1269 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1270 + shows "(f ---> l) net \<Longrightarrow> (g ---> m) net \<Longrightarrow> ((\<lambda>x. f(x) - g(x)) ---> l - m) net"
15.1271 + by (rule tendsto_diff)
15.1272 +
15.1273 +lemma Lim_null:
15.1274 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1275 + shows "(f ---> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) ---> 0) net" by (simp add: Lim dist_norm)
15.1276 +
15.1277 +lemma Lim_null_norm:
15.1278 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1279 + shows "(f ---> 0) net \<longleftrightarrow> ((\<lambda>x. norm(f x)) ---> 0) net"
15.1280 + by (simp add: Lim dist_norm)
15.1281 +
15.1282 +lemma Lim_null_comparison:
15.1283 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1284 + assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g ---> 0) net"
15.1285 + shows "(f ---> 0) net"
15.1286 +proof(simp add: tendsto_iff, rule+)
15.1287 + fix e::real assume "0<e"
15.1288 + { fix x
15.1289 + assume "norm (f x) \<le> g x" "dist (g x) 0 < e"
15.1290 + hence "dist (f x) 0 < e" by (simp add: dist_norm)
15.1291 + }
15.1292 + thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
15.1293 + using eventually_and[of "\<lambda>x. norm(f x) <= g x" "\<lambda>x. dist (g x) 0 < e" net]
15.1294 + using eventually_mono[of "(\<lambda>x. norm (f x) \<le> g x \<and> dist (g x) 0 < e)" "(\<lambda>x. dist (f x) 0 < e)" net]
15.1295 + using assms `e>0` unfolding tendsto_iff by auto
15.1296 +qed
15.1297 +
15.1298 +lemma Lim_component:
15.1299 + fixes f :: "'a \<Rightarrow> 'b::metric_space ^ 'n::finite"
15.1300 + shows "(f ---> l) net \<Longrightarrow> ((\<lambda>a. f a $i) ---> l$i) net"
15.1301 + unfolding tendsto_iff
15.1302 + apply (clarify)
15.1303 + apply (drule spec, drule (1) mp)
15.1304 + apply (erule eventually_elim1)
15.1305 + apply (erule le_less_trans [OF dist_nth_le])
15.1306 + done
15.1307 +
15.1308 +lemma Lim_transform_bound:
15.1309 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1310 + fixes g :: "'a \<Rightarrow> 'c::real_normed_vector"
15.1311 + assumes "eventually (\<lambda>n. norm(f n) <= norm(g n)) net" "(g ---> 0) net"
15.1312 + shows "(f ---> 0) net"
15.1313 +proof (rule tendstoI)
15.1314 + fix e::real assume "e>0"
15.1315 + { fix x
15.1316 + assume "norm (f x) \<le> norm (g x)" "dist (g x) 0 < e"
15.1317 + hence "dist (f x) 0 < e" by (simp add: dist_norm)}
15.1318 + thus "eventually (\<lambda>x. dist (f x) 0 < e) net"
15.1319 + using eventually_and[of "\<lambda>x. norm (f x) \<le> norm (g x)" "\<lambda>x. dist (g x) 0 < e" net]
15.1320 + using eventually_mono[of "\<lambda>x. norm (f x) \<le> norm (g x) \<and> dist (g x) 0 < e" "\<lambda>x. dist (f x) 0 < e" net]
15.1321 + using assms `e>0` unfolding tendsto_iff by blast
15.1322 +qed
15.1323 +
15.1324 +text{* Deducing things about the limit from the elements. *}
15.1325 +
15.1326 +lemma Lim_in_closed_set:
15.1327 + assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) net" "\<not>(trivial_limit net)" "(f ---> l) net"
15.1328 + shows "l \<in> S"
15.1329 +proof (rule ccontr)
15.1330 + assume "l \<notin> S"
15.1331 + with `closed S` have "open (- S)" "l \<in> - S"
15.1332 + by (simp_all add: open_Compl)
15.1333 + with assms(4) have "eventually (\<lambda>x. f x \<in> - S) net"
15.1334 + by (rule topological_tendstoD)
15.1335 + with assms(2) have "eventually (\<lambda>x. False) net"
15.1336 + by (rule eventually_elim2) simp
15.1337 + with assms(3) show "False"
15.1338 + by (simp add: eventually_False)
15.1339 +qed
15.1340 +
15.1341 +text{* Need to prove closed(cball(x,e)) before deducing this as a corollary. *}
15.1342 +
15.1343 +lemma Lim_dist_ubound:
15.1344 + assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. dist a (f x) <= e) net"
15.1345 + shows "dist a l <= e"
15.1346 +proof (rule ccontr)
15.1347 + assume "\<not> dist a l \<le> e"
15.1348 + then have "0 < dist a l - e" by simp
15.1349 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < dist a l - e) net"
15.1350 + by (rule tendstoD)
15.1351 + with assms(3) have "eventually (\<lambda>x. dist a (f x) \<le> e \<and> dist (f x) l < dist a l - e) net"
15.1352 + by (rule eventually_conjI)
15.1353 + then obtain w where "dist a (f w) \<le> e" "dist (f w) l < dist a l - e"
15.1354 + using assms(1) eventually_happens by auto
15.1355 + hence "dist a (f w) + dist (f w) l < e + (dist a l - e)"
15.1356 + by (rule add_le_less_mono)
15.1357 + hence "dist a (f w) + dist (f w) l < dist a l"
15.1358 + by simp
15.1359 + also have "\<dots> \<le> dist a (f w) + dist (f w) l"
15.1360 + by (rule dist_triangle)
15.1361 + finally show False by simp
15.1362 +qed
15.1363 +
15.1364 +lemma Lim_norm_ubound:
15.1365 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1366 + assumes "\<not>(trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. norm(f x) <= e) net"
15.1367 + shows "norm(l) <= e"
15.1368 +proof (rule ccontr)
15.1369 + assume "\<not> norm l \<le> e"
15.1370 + then have "0 < norm l - e" by simp
15.1371 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < norm l - e) net"
15.1372 + by (rule tendstoD)
15.1373 + with assms(3) have "eventually (\<lambda>x. norm (f x) \<le> e \<and> dist (f x) l < norm l - e) net"
15.1374 + by (rule eventually_conjI)
15.1375 + then obtain w where "norm (f w) \<le> e" "dist (f w) l < norm l - e"
15.1376 + using assms(1) eventually_happens by auto
15.1377 + hence "norm (f w - l) < norm l - e" "norm (f w) \<le> e" by (simp_all add: dist_norm)
15.1378 + hence "norm (f w - l) + norm (f w) < norm l" by simp
15.1379 + hence "norm (f w - l - f w) < norm l" by (rule le_less_trans [OF norm_triangle_ineq4])
15.1380 + thus False using `\<not> norm l \<le> e` by simp
15.1381 +qed
15.1382 +
15.1383 +lemma Lim_norm_lbound:
15.1384 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.1385 + assumes "\<not> (trivial_limit net)" "(f ---> l) net" "eventually (\<lambda>x. e <= norm(f x)) net"
15.1386 + shows "e \<le> norm l"
15.1387 +proof (rule ccontr)
15.1388 + assume "\<not> e \<le> norm l"
15.1389 + then have "0 < e - norm l" by simp
15.1390 + with assms(2) have "eventually (\<lambda>x. dist (f x) l < e - norm l) net"
15.1391 + by (rule tendstoD)
15.1392 + with assms(3) have "eventually (\<lambda>x. e \<le> norm (f x) \<and> dist (f x) l < e - norm l) net"
15.1393 + by (rule eventually_conjI)
15.1394 + then obtain w where "e \<le> norm (f w)" "dist (f w) l < e - norm l"
15.1395 + using assms(1) eventually_happens by auto
15.1396 + hence "norm (f w - l) + norm l < e" "e \<le> norm (f w)" by (simp_all add: dist_norm)
15.1397 + hence "norm (f w - l) + norm l < norm (f w)" by (rule less_le_trans)
15.1398 + hence "norm (f w - l + l) < norm (f w)" by (rule le_less_trans [OF norm_triangle_ineq])
15.1399 + thus False by simp
15.1400 +qed
15.1401 +
15.1402 +text{* Uniqueness of the limit, when nontrivial. *}
15.1403 +
15.1404 +lemma Lim_unique:
15.1405 + fixes f :: "'a \<Rightarrow> 'b::t2_space"
15.1406 + assumes "\<not> trivial_limit net" "(f ---> l) net" "(f ---> l') net"
15.1407 + shows "l = l'"
15.1408 +proof (rule ccontr)
15.1409 + assume "l \<noteq> l'"
15.1410 + obtain U V where "open U" "open V" "l \<in> U" "l' \<in> V" "U \<inter> V = {}"
15.1411 + using hausdorff [OF `l \<noteq> l'`] by fast
15.1412 + have "eventually (\<lambda>x. f x \<in> U) net"
15.1413 + using `(f ---> l) net` `open U` `l \<in> U` by (rule topological_tendstoD)
15.1414 + moreover
15.1415 + have "eventually (\<lambda>x. f x \<in> V) net"
15.1416 + using `(f ---> l') net` `open V` `l' \<in> V` by (rule topological_tendstoD)
15.1417 + ultimately
15.1418 + have "eventually (\<lambda>x. False) net"
15.1419 + proof (rule eventually_elim2)
15.1420 + fix x
15.1421 + assume "f x \<in> U" "f x \<in> V"
15.1422 + hence "f x \<in> U \<inter> V" by simp
15.1423 + with `U \<inter> V = {}` show "False" by simp
15.1424 + qed
15.1425 + with `\<not> trivial_limit net` show "False"
15.1426 + by (simp add: eventually_False)
15.1427 +qed
15.1428 +
15.1429 +lemma tendsto_Lim:
15.1430 + fixes f :: "'a \<Rightarrow> 'b::t2_space"
15.1431 + shows "~(trivial_limit net) \<Longrightarrow> (f ---> l) net ==> Lim net f = l"
15.1432 + unfolding Lim_def using Lim_unique[of net f] by auto
15.1433 +
15.1434 +text{* Limit under bilinear function *}
15.1435 +
15.1436 +lemma Lim_bilinear:
15.1437 + assumes "(f ---> l) net" and "(g ---> m) net" and "bounded_bilinear h"
15.1438 + shows "((\<lambda>x. h (f x) (g x)) ---> (h l m)) net"
15.1439 +using `bounded_bilinear h` `(f ---> l) net` `(g ---> m) net`
15.1440 +by (rule bounded_bilinear.tendsto)
15.1441 +
15.1442 +text{* These are special for limits out of the same vector space. *}
15.1443 +
15.1444 +lemma Lim_within_id: "(id ---> a) (at a within s)"
15.1445 + unfolding tendsto_def Limits.eventually_within eventually_at_topological
15.1446 + by auto
15.1447 +
15.1448 +lemma Lim_at_id: "(id ---> a) (at a)"
15.1449 +apply (subst within_UNIV[symmetric]) by (simp add: Lim_within_id)
15.1450 +
15.1451 +lemma Lim_at_zero:
15.1452 + fixes a :: "'a::real_normed_vector"
15.1453 + fixes l :: "'b::topological_space"
15.1454 + shows "(f ---> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) ---> l) (at 0)" (is "?lhs = ?rhs")
15.1455 +proof
15.1456 + assume "?lhs"
15.1457 + { fix S assume "open S" "l \<in> S"
15.1458 + with `?lhs` have "eventually (\<lambda>x. f x \<in> S) (at a)"
15.1459 + by (rule topological_tendstoD)
15.1460 + then obtain d where d: "d>0" "\<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S"
15.1461 + unfolding Limits.eventually_at by fast
15.1462 + { fix x::"'a" assume "x \<noteq> 0 \<and> dist x 0 < d"
15.1463 + hence "f (a + x) \<in> S" using d
15.1464 + apply(erule_tac x="x+a" in allE)
15.1465 + by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
15.1466 + }
15.1467 + hence "\<exists>d>0. \<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
15.1468 + using d(1) by auto
15.1469 + hence "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
15.1470 + unfolding Limits.eventually_at .
15.1471 + }
15.1472 + thus "?rhs" by (rule topological_tendstoI)
15.1473 +next
15.1474 + assume "?rhs"
15.1475 + { fix S assume "open S" "l \<in> S"
15.1476 + with `?rhs` have "eventually (\<lambda>x. f (a + x) \<in> S) (at 0)"
15.1477 + by (rule topological_tendstoD)
15.1478 + then obtain d where d: "d>0" "\<forall>x. x \<noteq> 0 \<and> dist x 0 < d \<longrightarrow> f (a + x) \<in> S"
15.1479 + unfolding Limits.eventually_at by fast
15.1480 + { fix x::"'a" assume "x \<noteq> a \<and> dist x a < d"
15.1481 + hence "f x \<in> S" using d apply(erule_tac x="x-a" in allE)
15.1482 + by(auto simp add: comm_monoid_add.mult_commute dist_norm dist_commute)
15.1483 + }
15.1484 + hence "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<in> S" using d(1) by auto
15.1485 + hence "eventually (\<lambda>x. f x \<in> S) (at a)" unfolding Limits.eventually_at .
15.1486 + }
15.1487 + thus "?lhs" by (rule topological_tendstoI)
15.1488 +qed
15.1489 +
15.1490 +text{* It's also sometimes useful to extract the limit point from the net. *}
15.1491 +
15.1492 +definition
15.1493 + netlimit :: "'a::t2_space net \<Rightarrow> 'a" where
15.1494 + "netlimit net = (SOME a. ((\<lambda>x. x) ---> a) net)"
15.1495 +
15.1496 +lemma netlimit_within:
15.1497 + assumes "\<not> trivial_limit (at a within S)"
15.1498 + shows "netlimit (at a within S) = a"
15.1499 +unfolding netlimit_def
15.1500 +apply (rule some_equality)
15.1501 +apply (rule Lim_at_within)
15.1502 +apply (rule Lim_ident_at)
15.1503 +apply (erule Lim_unique [OF assms])
15.1504 +apply (rule Lim_at_within)
15.1505 +apply (rule Lim_ident_at)
15.1506 +done
15.1507 +
15.1508 +lemma netlimit_at:
15.1509 + fixes a :: "'a::perfect_space"
15.1510 + shows "netlimit (at a) = a"
15.1511 + apply (subst within_UNIV[symmetric])
15.1512 + using netlimit_within[of a UNIV]
15.1513 + by (simp add: trivial_limit_at within_UNIV)
15.1514 +
15.1515 +text{* Transformation of limit. *}
15.1516 +
15.1517 +lemma Lim_transform:
15.1518 + fixes f g :: "'a::type \<Rightarrow> 'b::real_normed_vector"
15.1519 + assumes "((\<lambda>x. f x - g x) ---> 0) net" "(f ---> l) net"
15.1520 + shows "(g ---> l) net"
15.1521 +proof-
15.1522 + from assms have "((\<lambda>x. f x - g x - f x) ---> 0 - l) net" using Lim_sub[of "\<lambda>x. f x - g x" 0 net f l] by auto
15.1523 + thus "?thesis" using Lim_neg [of "\<lambda> x. - g x" "-l" net] by auto
15.1524 +qed
15.1525 +
15.1526 +lemma Lim_transform_eventually:
15.1527 + "eventually (\<lambda>x. f x = g x) net \<Longrightarrow> (f ---> l) net ==> (g ---> l) net"
15.1528 + apply (rule topological_tendstoI)
15.1529 + apply (drule (2) topological_tendstoD)
15.1530 + apply (erule (1) eventually_elim2, simp)
15.1531 + done
15.1532 +
15.1533 +lemma Lim_transform_within:
15.1534 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1535 + assumes "0 < d" "(\<forall>x'\<in>S. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x')"
15.1536 + "(f ---> l) (at x within S)"
15.1537 + shows "(g ---> l) (at x within S)"
15.1538 + using assms(1,3) unfolding Lim_within
15.1539 + apply -
15.1540 + apply (clarify, rename_tac e)
15.1541 + apply (drule_tac x=e in spec, clarsimp, rename_tac r)
15.1542 + apply (rule_tac x="min d r" in exI, clarsimp, rename_tac y)
15.1543 + apply (drule_tac x=y in bspec, assumption, clarsimp)
15.1544 + apply (simp add: assms(2))
15.1545 + done
15.1546 +
15.1547 +lemma Lim_transform_at:
15.1548 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1549 + shows "0 < d \<Longrightarrow> (\<forall>x'. 0 < dist x' x \<and> dist x' x < d \<longrightarrow> f x' = g x') \<Longrightarrow>
15.1550 + (f ---> l) (at x) ==> (g ---> l) (at x)"
15.1551 + apply (subst within_UNIV[symmetric])
15.1552 + using Lim_transform_within[of d UNIV x f g l]
15.1553 + by (auto simp add: within_UNIV)
15.1554 +
15.1555 +text{* Common case assuming being away from some crucial point like 0. *}
15.1556 +
15.1557 +lemma Lim_transform_away_within:
15.1558 + fixes a b :: "'a::metric_space"
15.1559 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1560 + assumes "a\<noteq>b" "\<forall>x\<in> S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
15.1561 + and "(f ---> l) (at a within S)"
15.1562 + shows "(g ---> l) (at a within S)"
15.1563 +proof-
15.1564 + have "\<forall>x'\<in>S. 0 < dist x' a \<and> dist x' a < dist a b \<longrightarrow> f x' = g x'" using assms(2)
15.1565 + apply auto apply(erule_tac x=x' in ballE) by (auto simp add: dist_commute)
15.1566 + thus ?thesis using Lim_transform_within[of "dist a b" S a f g l] using assms(1,3) unfolding dist_nz by auto
15.1567 +qed
15.1568 +
15.1569 +lemma Lim_transform_away_at:
15.1570 + fixes a b :: "'a::metric_space"
15.1571 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1572 + assumes ab: "a\<noteq>b" and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
15.1573 + and fl: "(f ---> l) (at a)"
15.1574 + shows "(g ---> l) (at a)"
15.1575 + using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl
15.1576 + by (auto simp add: within_UNIV)
15.1577 +
15.1578 +text{* Alternatively, within an open set. *}
15.1579 +
15.1580 +lemma Lim_transform_within_open:
15.1581 + fixes a :: "'a::metric_space"
15.1582 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1583 + assumes "open S" "a \<in> S" "\<forall>x\<in>S. x \<noteq> a \<longrightarrow> f x = g x" "(f ---> l) (at a)"
15.1584 + shows "(g ---> l) (at a)"
15.1585 +proof-
15.1586 + from assms(1,2) obtain e::real where "e>0" and e:"ball a e \<subseteq> S" unfolding open_contains_ball by auto
15.1587 + hence "\<forall>x'. 0 < dist x' a \<and> dist x' a < e \<longrightarrow> f x' = g x'" using assms(3)
15.1588 + unfolding ball_def subset_eq apply auto apply(erule_tac x=x' in allE) apply(erule_tac x=x' in ballE) by(auto simp add: dist_commute)
15.1589 + thus ?thesis using Lim_transform_at[of e a f g l] `e>0` assms(4) by auto
15.1590 +qed
15.1591 +
15.1592 +text{* A congruence rule allowing us to transform limits assuming not at point. *}
15.1593 +
15.1594 +(* FIXME: Only one congruence rule for tendsto can be used at a time! *)
15.1595 +
15.1596 +lemma Lim_cong_within[cong add]:
15.1597 + fixes a :: "'a::metric_space"
15.1598 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1599 + shows "(\<And>x. x \<noteq> a \<Longrightarrow> f x = g x) ==> ((\<lambda>x. f x) ---> l) (at a within S) \<longleftrightarrow> ((g ---> l) (at a within S))"
15.1600 + by (simp add: Lim_within dist_nz[symmetric])
15.1601 +
15.1602 +lemma Lim_cong_at[cong add]:
15.1603 + fixes a :: "'a::metric_space"
15.1604 + fixes l :: "'b::metric_space" (* TODO: generalize *)
15.1605 + shows "(\<And>x. x \<noteq> a ==> f x = g x) ==> (((\<lambda>x. f x) ---> l) (at a) \<longleftrightarrow> ((g ---> l) (at a)))"
15.1606 + by (simp add: Lim_at dist_nz[symmetric])
15.1607 +
15.1608 +text{* Useful lemmas on closure and set of possible sequential limits.*}
15.1609 +
15.1610 +lemma closure_sequential:
15.1611 + fixes l :: "'a::metric_space" (* TODO: generalize *)
15.1612 + shows "l \<in> closure S \<longleftrightarrow> (\<exists>x. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially)" (is "?lhs = ?rhs")
15.1613 +proof
15.1614 + assume "?lhs" moreover
15.1615 + { assume "l \<in> S"
15.1616 + hence "?rhs" using Lim_const[of l sequentially] by auto
15.1617 + } moreover
15.1618 + { assume "l islimpt S"
15.1619 + hence "?rhs" unfolding islimpt_sequential by auto
15.1620 + } ultimately
15.1621 + show "?rhs" unfolding closure_def by auto
15.1622 +next
15.1623 + assume "?rhs"
15.1624 + thus "?lhs" unfolding closure_def unfolding islimpt_sequential by auto
15.1625 +qed
15.1626 +
15.1627 +lemma closed_sequential_limits:
15.1628 + fixes S :: "'a::metric_space set"
15.1629 + shows "closed S \<longleftrightarrow> (\<forall>x l. (\<forall>n. x n \<in> S) \<and> (x ---> l) sequentially \<longrightarrow> l \<in> S)"
15.1630 + unfolding closed_limpt
15.1631 + using closure_sequential [where 'a='a] closure_closed [where 'a='a] closed_limpt [where 'a='a] islimpt_sequential [where 'a='a] mem_delete [where 'a='a]
15.1632 + by metis
15.1633 +
15.1634 +lemma closure_approachable:
15.1635 + fixes S :: "'a::metric_space set"
15.1636 + shows "x \<in> closure S \<longleftrightarrow> (\<forall>e>0. \<exists>y\<in>S. dist y x < e)"
15.1637 + apply (auto simp add: closure_def islimpt_approachable)
15.1638 + by (metis dist_self)
15.1639 +
15.1640 +lemma closed_approachable:
15.1641 + fixes S :: "'a::metric_space set"
15.1642 + shows "closed S ==> (\<forall>e>0. \<exists>y\<in>S. dist y x < e) \<longleftrightarrow> x \<in> S"
15.1643 + by (metis closure_closed closure_approachable)
15.1644 +
15.1645 +text{* Some other lemmas about sequences. *}
15.1646 +
15.1647 +lemma seq_offset:
15.1648 + fixes l :: "'a::metric_space" (* TODO: generalize *)
15.1649 + shows "(f ---> l) sequentially ==> ((\<lambda>i. f( i + k)) ---> l) sequentially"
15.1650 + apply (auto simp add: Lim_sequentially)
15.1651 + by (metis trans_le_add1 )
15.1652 +
15.1653 +lemma seq_offset_neg:
15.1654 + "(f ---> l) sequentially ==> ((\<lambda>i. f(i - k)) ---> l) sequentially"
15.1655 + apply (rule topological_tendstoI)
15.1656 + apply (drule (2) topological_tendstoD)
15.1657 + apply (simp only: eventually_sequentially)
15.1658 + apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k")
15.1659 + apply metis
15.1660 + by arith
15.1661 +
15.1662 +lemma seq_offset_rev:
15.1663 + "((\<lambda>i. f(i + k)) ---> l) sequentially ==> (f ---> l) sequentially"
15.1664 + apply (rule topological_tendstoI)
15.1665 + apply (drule (2) topological_tendstoD)
15.1666 + apply (simp only: eventually_sequentially)
15.1667 + apply (subgoal_tac "\<And>N k (n::nat). N + k <= n ==> N <= n - k \<and> (n - k) + k = n")
15.1668 + by metis arith
15.1669 +
15.1670 +lemma seq_harmonic: "((\<lambda>n. inverse (real n)) ---> 0) sequentially"
15.1671 +proof-
15.1672 + { fix e::real assume "e>0"
15.1673 + hence "\<exists>N::nat. \<forall>n::nat\<ge>N. inverse (real n) < e"
15.1674 + using real_arch_inv[of e] apply auto apply(rule_tac x=n in exI)
15.1675 + by (metis not_le le_imp_inverse_le not_less real_of_nat_gt_zero_cancel_iff real_of_nat_less_iff xt1(7))
15.1676 + }
15.1677 + thus ?thesis unfolding Lim_sequentially dist_norm by simp
15.1678 +qed
15.1679 +
15.1680 +text{* More properties of closed balls. *}
15.1681 +
15.1682 +lemma closed_cball: "closed (cball x e)"
15.1683 +unfolding cball_def closed_def
15.1684 +unfolding Collect_neg_eq [symmetric] not_le
15.1685 +apply (clarsimp simp add: open_dist, rename_tac y)
15.1686 +apply (rule_tac x="dist x y - e" in exI, clarsimp)
15.1687 +apply (rename_tac x')
15.1688 +apply (cut_tac x=x and y=x' and z=y in dist_triangle)
15.1689 +apply simp
15.1690 +done
15.1691 +
15.1692 +lemma open_contains_cball: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. cball x e \<subseteq> S)"
15.1693 +proof-
15.1694 + { fix x and e::real assume "x\<in>S" "e>0" "ball x e \<subseteq> S"
15.1695 + hence "\<exists>d>0. cball x d \<subseteq> S" unfolding subset_eq by (rule_tac x="e/2" in exI, auto)
15.1696 + } moreover
15.1697 + { fix x and e::real assume "x\<in>S" "e>0" "cball x e \<subseteq> S"
15.1698 + hence "\<exists>d>0. ball x d \<subseteq> S" unfolding subset_eq apply(rule_tac x="e/2" in exI) by auto
15.1699 + } ultimately
15.1700 + show ?thesis unfolding open_contains_ball by auto
15.1701 +qed
15.1702 +
15.1703 +lemma open_contains_cball_eq: "open S ==> (\<forall>x. x \<in> S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S))"
15.1704 + by (metis open_contains_cball subset_eq order_less_imp_le centre_in_cball mem_def)
15.1705 +
15.1706 +lemma mem_interior_cball: "x \<in> interior S \<longleftrightarrow> (\<exists>e>0. cball x e \<subseteq> S)"
15.1707 + apply (simp add: interior_def, safe)
15.1708 + apply (force simp add: open_contains_cball)
15.1709 + apply (rule_tac x="ball x e" in exI)
15.1710 + apply (simp add: open_ball centre_in_ball subset_trans [OF ball_subset_cball])
15.1711 + done
15.1712 +
15.1713 +lemma islimpt_ball:
15.1714 + fixes x y :: "'a::{real_normed_vector,perfect_space}"
15.1715 + shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e" (is "?lhs = ?rhs")
15.1716 +proof
15.1717 + assume "?lhs"
15.1718 + { assume "e \<le> 0"
15.1719 + hence *:"ball x e = {}" using ball_eq_empty[of x e] by auto
15.1720 + have False using `?lhs` unfolding * using islimpt_EMPTY[of y] by auto
15.1721 + }
15.1722 + hence "e > 0" by (metis not_less)
15.1723 + moreover
15.1724 + have "y \<in> cball x e" using closed_cball[of x e] islimpt_subset[of y "ball x e" "cball x e"] ball_subset_cball[of x e] `?lhs` unfolding closed_limpt by auto
15.1725 + ultimately show "?rhs" by auto
15.1726 +next
15.1727 + assume "?rhs" hence "e>0" by auto
15.1728 + { fix d::real assume "d>0"
15.1729 + have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
15.1730 + proof(cases "d \<le> dist x y")
15.1731 + case True thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
15.1732 + proof(cases "x=y")
15.1733 + case True hence False using `d \<le> dist x y` `d>0` by auto
15.1734 + thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by auto
15.1735 + next
15.1736 + case False
15.1737 +
15.1738 + have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x))
15.1739 + = norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
15.1740 + unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[THEN sym] by auto
15.1741 + also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
15.1742 + using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", THEN sym, of "y - x"]
15.1743 + unfolding scaleR_minus_left scaleR_one
15.1744 + by (auto simp add: norm_minus_commute)
15.1745 + also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
15.1746 + unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
15.1747 + unfolding real_add_mult_distrib using `x\<noteq>y`[unfolded dist_nz, unfolded dist_norm] by auto
15.1748 + also have "\<dots> \<le> e - d/2" using `d \<le> dist x y` and `d>0` and `?rhs` by(auto simp add: dist_norm)
15.1749 + finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using `d>0` by auto
15.1750 +
15.1751 + moreover
15.1752 +
15.1753 + have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
15.1754 + using `x\<noteq>y`[unfolded dist_nz] `d>0` unfolding scaleR_eq_0_iff by (auto simp add: dist_commute)
15.1755 + moreover
15.1756 + have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d" unfolding dist_norm apply simp unfolding norm_minus_cancel
15.1757 + using `d>0` `x\<noteq>y`[unfolded dist_nz] dist_commute[of x y]
15.1758 + unfolding dist_norm by auto
15.1759 + ultimately show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d" by (rule_tac x="y - (d / (2*dist y x)) *\<^sub>R (y - x)" in bexI) auto
15.1760 + qed
15.1761 + next
15.1762 + case False hence "d > dist x y" by auto
15.1763 + show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
15.1764 + proof(cases "x=y")
15.1765 + case True
15.1766 + obtain z where **: "z \<noteq> y" "dist z y < min e d"
15.1767 + using perfect_choose_dist[of "min e d" y]
15.1768 + using `d > 0` `e>0` by auto
15.1769 + show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
15.1770 + unfolding `x = y`
15.1771 + using `z \<noteq> y` **
15.1772 + by (rule_tac x=z in bexI, auto simp add: dist_commute)
15.1773 + next
15.1774 + case False thus "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
15.1775 + using `d>0` `d > dist x y` `?rhs` by(rule_tac x=x in bexI, auto)
15.1776 + qed
15.1777 + qed }
15.1778 + thus "?lhs" unfolding mem_cball islimpt_approachable mem_ball by auto
15.1779 +qed
15.1780 +
15.1781 +lemma closure_ball_lemma:
15.1782 + fixes x y :: "'a::real_normed_vector"
15.1783 + assumes "x \<noteq> y" shows "y islimpt ball x (dist x y)"
15.1784 +proof (rule islimptI)
15.1785 + fix T assume "y \<in> T" "open T"
15.1786 + then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
15.1787 + unfolding open_dist by fast
15.1788 + (* choose point between x and y, within distance r of y. *)
15.1789 + def k \<equiv> "min 1 (r / (2 * dist x y))"
15.1790 + def z \<equiv> "y + scaleR k (x - y)"
15.1791 + have z_def2: "z = x + scaleR (1 - k) (y - x)"
15.1792 + unfolding z_def by (simp add: algebra_simps)
15.1793 + have "dist z y < r"
15.1794 + unfolding z_def k_def using `0 < r`
15.1795 + by (simp add: dist_norm min_def)
15.1796 + hence "z \<in> T" using `\<forall>z. dist z y < r \<longrightarrow> z \<in> T` by simp
15.1797 + have "dist x z < dist x y"
15.1798 + unfolding z_def2 dist_norm
15.1799 + apply (simp add: norm_minus_commute)
15.1800 + apply (simp only: dist_norm [symmetric])
15.1801 + apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
15.1802 + apply (rule mult_strict_right_mono)
15.1803 + apply (simp add: k_def divide_pos_pos zero_less_dist_iff `0 < r` `x \<noteq> y`)
15.1804 + apply (simp add: zero_less_dist_iff `x \<noteq> y`)
15.1805 + done
15.1806 + hence "z \<in> ball x (dist x y)" by simp
15.1807 + have "z \<noteq> y"
15.1808 + unfolding z_def k_def using `x \<noteq> y` `0 < r`
15.1809 + by (simp add: min_def)
15.1810 + show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
15.1811 + using `z \<in> ball x (dist x y)` `z \<in> T` `z \<noteq> y`
15.1812 + by fast
15.1813 +qed
15.1814 +
15.1815 +lemma closure_ball:
15.1816 + fixes x :: "'a::real_normed_vector"
15.1817 + shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
15.1818 +apply (rule equalityI)
15.1819 +apply (rule closure_minimal)
15.1820 +apply (rule ball_subset_cball)
15.1821 +apply (rule closed_cball)
15.1822 +apply (rule subsetI, rename_tac y)
15.1823 +apply (simp add: le_less [where 'a=real])
15.1824 +apply (erule disjE)
15.1825 +apply (rule subsetD [OF closure_subset], simp)
15.1826 +apply (simp add: closure_def)
15.1827 +apply clarify
15.1828 +apply (rule closure_ball_lemma)
15.1829 +apply (simp add: zero_less_dist_iff)
15.1830 +done
15.1831 +
15.1832 +(* In a trivial vector space, this fails for e = 0. *)
15.1833 +lemma interior_cball:
15.1834 + fixes x :: "'a::{real_normed_vector, perfect_space}"
15.1835 + shows "interior (cball x e) = ball x e"
15.1836 +proof(cases "e\<ge>0")
15.1837 + case False note cs = this
15.1838 + from cs have "ball x e = {}" using ball_empty[of e x] by auto moreover
15.1839 + { fix y assume "y \<in> cball x e"
15.1840 + hence False unfolding mem_cball using dist_nz[of x y] cs by auto }
15.1841 + hence "cball x e = {}" by auto
15.1842 + hence "interior (cball x e) = {}" using interior_empty by auto
15.1843 + ultimately show ?thesis by blast
15.1844 +next
15.1845 + case True note cs = this
15.1846 + have "ball x e \<subseteq> cball x e" using ball_subset_cball by auto moreover
15.1847 + { fix S y assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
15.1848 + then obtain d where "d>0" and d:"\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S" unfolding open_dist by blast
15.1849 +
15.1850 + then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
15.1851 + using perfect_choose_dist [of d] by auto
15.1852 + have "xa\<in>S" using d[THEN spec[where x=xa]] using xa by(auto simp add: dist_commute)
15.1853 + hence xa_cball:"xa \<in> cball x e" using as(1) by auto
15.1854 +
15.1855 + hence "y \<in> ball x e" proof(cases "x = y")
15.1856 + case True
15.1857 + hence "e>0" using xa_y[unfolded dist_nz] xa_cball[unfolded mem_cball] by (auto simp add: dist_commute)
15.1858 + thus "y \<in> ball x e" using `x = y ` by simp
15.1859 + next
15.1860 + case False
15.1861 + have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d" unfolding dist_norm
15.1862 + using `d>0` norm_ge_zero[of "y - x"] `x \<noteq> y` by auto
15.1863 + hence *:"y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e" using d as(1)[unfolded subset_eq] by blast
15.1864 + have "y - x \<noteq> 0" using `x \<noteq> y` by auto
15.1865 + hence **:"d / (2 * norm (y - x)) > 0" unfolding zero_less_norm_iff[THEN sym]
15.1866 + using `d>0` divide_pos_pos[of d "2*norm (y - x)"] by auto
15.1867 +
15.1868 + have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) x = norm (y + (d / (2 * norm (y - x))) *\<^sub>R y - (d / (2 * norm (y - x))) *\<^sub>R x - x)"
15.1869 + by (auto simp add: dist_norm algebra_simps)
15.1870 + also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
15.1871 + by (auto simp add: algebra_simps)
15.1872 + also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
15.1873 + using ** by auto
15.1874 + also have "\<dots> = (dist y x) + d/2"using ** by (auto simp add: left_distrib dist_norm)
15.1875 + finally have "e \<ge> dist x y +d/2" using *[unfolded mem_cball] by (auto simp add: dist_commute)
15.1876 + thus "y \<in> ball x e" unfolding mem_ball using `d>0` by auto
15.1877 + qed }
15.1878 + hence "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e" by auto
15.1879 + ultimately show ?thesis using interior_unique[of "ball x e" "cball x e"] using open_ball[of x e] by auto
15.1880 +qed
15.1881 +
15.1882 +lemma frontier_ball:
15.1883 + fixes a :: "'a::real_normed_vector"
15.1884 + shows "0 < e ==> frontier(ball a e) = {x. dist a x = e}"
15.1885 + apply (simp add: frontier_def closure_ball interior_open open_ball order_less_imp_le)
15.1886 + apply (simp add: expand_set_eq)
15.1887 + by arith
15.1888 +
15.1889 +lemma frontier_cball:
15.1890 + fixes a :: "'a::{real_normed_vector, perfect_space}"
15.1891 + shows "frontier(cball a e) = {x. dist a x = e}"
15.1892 + apply (simp add: frontier_def interior_cball closed_cball closure_closed order_less_imp_le)
15.1893 + apply (simp add: expand_set_eq)
15.1894 + by arith
15.1895 +
15.1896 +lemma cball_eq_empty: "(cball x e = {}) \<longleftrightarrow> e < 0"
15.1897 + apply (simp add: expand_set_eq not_le)
15.1898 + by (metis zero_le_dist dist_self order_less_le_trans)
15.1899 +lemma cball_empty: "e < 0 ==> cball x e = {}" by (simp add: cball_eq_empty)
15.1900 +
15.1901 +lemma cball_eq_sing:
15.1902 + fixes x :: "'a::perfect_space"
15.1903 + shows "(cball x e = {x}) \<longleftrightarrow> e = 0"
15.1904 +proof (rule linorder_cases)
15.1905 + assume e: "0 < e"
15.1906 + obtain a where "a \<noteq> x" "dist a x < e"
15.1907 + using perfect_choose_dist [OF e] by auto
15.1908 + hence "a \<noteq> x" "dist x a \<le> e" by (auto simp add: dist_commute)
15.1909 + with e show ?thesis by (auto simp add: expand_set_eq)
15.1910 +qed auto
15.1911 +
15.1912 +lemma cball_sing:
15.1913 + fixes x :: "'a::metric_space"
15.1914 + shows "e = 0 ==> cball x e = {x}"
15.1915 + by (auto simp add: expand_set_eq)
15.1916 +
15.1917 +text{* For points in the interior, localization of limits makes no difference. *}
15.1918 +
15.1919 +lemma eventually_within_interior:
15.1920 + assumes "x \<in> interior S"
15.1921 + shows "eventually P (at x within S) \<longleftrightarrow> eventually P (at x)" (is "?lhs = ?rhs")
15.1922 +proof-
15.1923 + from assms obtain T where T: "open T" "x \<in> T" "T \<subseteq> S"
15.1924 + unfolding interior_def by fast
15.1925 + { assume "?lhs"
15.1926 + then obtain A where "open A" "x \<in> A" "\<forall>y\<in>A. y \<noteq> x \<longrightarrow> y \<in> S \<longrightarrow> P y"
15.1927 + unfolding Limits.eventually_within Limits.eventually_at_topological
15.1928 + by auto
15.1929 + with T have "open (A \<inter> T)" "x \<in> A \<inter> T" "\<forall>y\<in>(A \<inter> T). y \<noteq> x \<longrightarrow> P y"
15.1930 + by auto
15.1931 + then have "?rhs"
15.1932 + unfolding Limits.eventually_at_topological by auto
15.1933 + } moreover
15.1934 + { assume "?rhs" hence "?lhs"
15.1935 + unfolding Limits.eventually_within
15.1936 + by (auto elim: eventually_elim1)
15.1937 + } ultimately
15.1938 + show "?thesis" ..
15.1939 +qed
15.1940 +
15.1941 +lemma lim_within_interior:
15.1942 + "x \<in> interior S \<Longrightarrow> (f ---> l) (at x within S) \<longleftrightarrow> (f ---> l) (at x)"
15.1943 + unfolding tendsto_def by (simp add: eventually_within_interior)
15.1944 +
15.1945 +lemma netlimit_within_interior:
15.1946 + fixes x :: "'a::{perfect_space, real_normed_vector}"
15.1947 + (* FIXME: generalize to perfect_space *)
15.1948 + assumes "x \<in> interior S"
15.1949 + shows "netlimit(at x within S) = x" (is "?lhs = ?rhs")
15.1950 +proof-
15.1951 + from assms obtain e::real where e:"e>0" "ball x e \<subseteq> S" using open_interior[of S] unfolding open_contains_ball using interior_subset[of S] by auto
15.1952 + hence "\<not> trivial_limit (at x within S)" using islimpt_subset[of x "ball x e" S] unfolding trivial_limit_within islimpt_ball centre_in_cball by auto
15.1953 + thus ?thesis using netlimit_within by auto
15.1954 +qed
15.1955 +
15.1956 +subsection{* Boundedness. *}
15.1957 +
15.1958 + (* FIXME: This has to be unified with BSEQ!! *)
15.1959 +definition
15.1960 + bounded :: "'a::metric_space set \<Rightarrow> bool" where
15.1961 + "bounded S \<longleftrightarrow> (\<exists>x e. \<forall>y\<in>S. dist x y \<le> e)"
15.1962 +
15.1963 +lemma bounded_any_center: "bounded S \<longleftrightarrow> (\<exists>e. \<forall>y\<in>S. dist a y \<le> e)"
15.1964 +unfolding bounded_def
15.1965 +apply safe
15.1966 +apply (rule_tac x="dist a x + e" in exI, clarify)
15.1967 +apply (drule (1) bspec)
15.1968 +apply (erule order_trans [OF dist_triangle add_left_mono])
15.1969 +apply auto
15.1970 +done
15.1971 +
15.1972 +lemma bounded_iff: "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. norm x \<le> a)"
15.1973 +unfolding bounded_any_center [where a=0]
15.1974 +by (simp add: dist_norm)
15.1975 +
15.1976 +lemma bounded_empty[simp]: "bounded {}" by (simp add: bounded_def)
15.1977 +lemma bounded_subset: "bounded T \<Longrightarrow> S \<subseteq> T ==> bounded S"
15.1978 + by (metis bounded_def subset_eq)
15.1979 +
15.1980 +lemma bounded_interior[intro]: "bounded S ==> bounded(interior S)"
15.1981 + by (metis bounded_subset interior_subset)
15.1982 +
15.1983 +lemma bounded_closure[intro]: assumes "bounded S" shows "bounded(closure S)"
15.1984 +proof-
15.1985 + from assms obtain x and a where a: "\<forall>y\<in>S. dist x y \<le> a" unfolding bounded_def by auto
15.1986 + { fix y assume "y \<in> closure S"
15.1987 + then obtain f where f: "\<forall>n. f n \<in> S" "(f ---> y) sequentially"
15.1988 + unfolding closure_sequential by auto
15.1989 + have "\<forall>n. f n \<in> S \<longrightarrow> dist x (f n) \<le> a" using a by simp
15.1990 + hence "eventually (\<lambda>n. dist x (f n) \<le> a) sequentially"
15.1991 + by (rule eventually_mono, simp add: f(1))
15.1992 + have "dist x y \<le> a"
15.1993 + apply (rule Lim_dist_ubound [of sequentially f])
15.1994 + apply (rule trivial_limit_sequentially)
15.1995 + apply (rule f(2))
15.1996 + apply fact
15.1997 + done
15.1998 + }
15.1999 + thus ?thesis unfolding bounded_def by auto
15.2000 +qed
15.2001 +
15.2002 +lemma bounded_cball[simp,intro]: "bounded (cball x e)"
15.2003 + apply (simp add: bounded_def)
15.2004 + apply (rule_tac x=x in exI)
15.2005 + apply (rule_tac x=e in exI)
15.2006 + apply auto
15.2007 + done
15.2008 +
15.2009 +lemma bounded_ball[simp,intro]: "bounded(ball x e)"
15.2010 + by (metis ball_subset_cball bounded_cball bounded_subset)
15.2011 +
15.2012 +lemma finite_imp_bounded[intro]: assumes "finite S" shows "bounded S"
15.2013 +proof-
15.2014 + { fix a F assume as:"bounded F"
15.2015 + then obtain x e where "\<forall>y\<in>F. dist x y \<le> e" unfolding bounded_def by auto
15.2016 + hence "\<forall>y\<in>(insert a F). dist x y \<le> max e (dist x a)" by auto
15.2017 + hence "bounded (insert a F)" unfolding bounded_def by (intro exI)
15.2018 + }
15.2019 + thus ?thesis using finite_induct[of S bounded] using bounded_empty assms by auto
15.2020 +qed
15.2021 +
15.2022 +lemma bounded_Un[simp]: "bounded (S \<union> T) \<longleftrightarrow> bounded S \<and> bounded T"
15.2023 + apply (auto simp add: bounded_def)
15.2024 + apply (rename_tac x y r s)
15.2025 + apply (rule_tac x=x in exI)
15.2026 + apply (rule_tac x="max r (dist x y + s)" in exI)
15.2027 + apply (rule ballI, rename_tac z, safe)
15.2028 + apply (drule (1) bspec, simp)
15.2029 + apply (drule (1) bspec)
15.2030 + apply (rule min_max.le_supI2)
15.2031 + apply (erule order_trans [OF dist_triangle add_left_mono])
15.2032 + done
15.2033 +
15.2034 +lemma bounded_Union[intro]: "finite F \<Longrightarrow> (\<forall>S\<in>F. bounded S) \<Longrightarrow> bounded(\<Union>F)"
15.2035 + by (induct rule: finite_induct[of F], auto)
15.2036 +
15.2037 +lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x <= b)"
15.2038 + apply (simp add: bounded_iff)
15.2039 + apply (subgoal_tac "\<And>x (y::real). 0 < 1 + abs y \<and> (x <= y \<longrightarrow> x <= 1 + abs y)")
15.2040 + by metis arith
15.2041 +
15.2042 +lemma bounded_Int[intro]: "bounded S \<or> bounded T \<Longrightarrow> bounded (S \<inter> T)"
15.2043 + by (metis Int_lower1 Int_lower2 bounded_subset)
15.2044 +
15.2045 +lemma bounded_diff[intro]: "bounded S ==> bounded (S - T)"
15.2046 +apply (metis Diff_subset bounded_subset)
15.2047 +done
15.2048 +
15.2049 +lemma bounded_insert[intro]:"bounded(insert x S) \<longleftrightarrow> bounded S"
15.2050 + by (metis Diff_cancel Un_empty_right Un_insert_right bounded_Un bounded_subset finite.emptyI finite_imp_bounded infinite_remove subset_insertI)
15.2051 +
15.2052 +lemma not_bounded_UNIV[simp, intro]:
15.2053 + "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
15.2054 +proof(auto simp add: bounded_pos not_le)
15.2055 + obtain x :: 'a where "x \<noteq> 0"
15.2056 + using perfect_choose_dist [OF zero_less_one] by fast
15.2057 + fix b::real assume b: "b >0"
15.2058 + have b1: "b +1 \<ge> 0" using b by simp
15.2059 + with `x \<noteq> 0` have "b < norm (scaleR (b + 1) (sgn x))"
15.2060 + by (simp add: norm_sgn)
15.2061 + then show "\<exists>x::'a. b < norm x" ..
15.2062 +qed
15.2063 +
15.2064 +lemma bounded_linear_image:
15.2065 + assumes "bounded S" "bounded_linear f"
15.2066 + shows "bounded(f ` S)"
15.2067 +proof-
15.2068 + from assms(1) obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
15.2069 + from assms(2) obtain B where B:"B>0" "\<forall>x. norm (f x) \<le> B * norm x" using bounded_linear.pos_bounded by (auto simp add: mult_ac)
15.2070 + { fix x assume "x\<in>S"
15.2071 + hence "norm x \<le> b" using b by auto
15.2072 + hence "norm (f x) \<le> B * b" using B(2) apply(erule_tac x=x in allE)
15.2073 + by (metis B(1) B(2) real_le_trans real_mult_le_cancel_iff2)
15.2074 + }
15.2075 + thus ?thesis unfolding bounded_pos apply(rule_tac x="b*B" in exI)
15.2076 + using b B real_mult_order[of b B] by (auto simp add: real_mult_commute)
15.2077 +qed
15.2078 +
15.2079 +lemma bounded_scaling:
15.2080 + fixes S :: "'a::real_normed_vector set"
15.2081 + shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
15.2082 + apply (rule bounded_linear_image, assumption)
15.2083 + apply (rule scaleR.bounded_linear_right)
15.2084 + done
15.2085 +
15.2086 +lemma bounded_translation:
15.2087 + fixes S :: "'a::real_normed_vector set"
15.2088 + assumes "bounded S" shows "bounded ((\<lambda>x. a + x) ` S)"
15.2089 +proof-
15.2090 + from assms obtain b where b:"b>0" "\<forall>x\<in>S. norm x \<le> b" unfolding bounded_pos by auto
15.2091 + { fix x assume "x\<in>S"
15.2092 + hence "norm (a + x) \<le> b + norm a" using norm_triangle_ineq[of a x] b by auto
15.2093 + }
15.2094 + thus ?thesis unfolding bounded_pos using norm_ge_zero[of a] b(1) using add_strict_increasing[of b 0 "norm a"]
15.2095 + by (auto intro!: add exI[of _ "b + norm a"])
15.2096 +qed
15.2097 +
15.2098 +
15.2099 +text{* Some theorems on sups and infs using the notion "bounded". *}
15.2100 +
15.2101 +lemma bounded_real:
15.2102 + fixes S :: "real set"
15.2103 + shows "bounded S \<longleftrightarrow> (\<exists>a. \<forall>x\<in>S. abs x <= a)"
15.2104 + by (simp add: bounded_iff)
15.2105 +
15.2106 +lemma bounded_has_rsup: assumes "bounded S" "S \<noteq> {}"
15.2107 + shows "\<forall>x\<in>S. x <= rsup S" and "\<forall>b. (\<forall>x\<in>S. x <= b) \<longrightarrow> rsup S <= b"
15.2108 +proof
15.2109 + fix x assume "x\<in>S"
15.2110 + from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
15.2111 + hence *:"S *<= a" using setleI[of S a] by (metis abs_le_interval_iff mem_def)
15.2112 + thus "x \<le> rsup S" using rsup[OF `S\<noteq>{}`] using assms(1)[unfolded bounded_real] using isLubD2[of UNIV S "rsup S" x] using `x\<in>S` by auto
15.2113 +next
15.2114 + show "\<forall>b. (\<forall>x\<in>S. x \<le> b) \<longrightarrow> rsup S \<le> b" using assms
15.2115 + using rsup[of S, unfolded isLub_def isUb_def leastP_def setle_def setge_def]
15.2116 + apply (auto simp add: bounded_real)
15.2117 + by (auto simp add: isLub_def isUb_def leastP_def setle_def setge_def)
15.2118 +qed
15.2119 +
15.2120 +lemma rsup_insert: assumes "bounded S"
15.2121 + shows "rsup(insert x S) = (if S = {} then x else max x (rsup S))"
15.2122 +proof(cases "S={}")
15.2123 + case True thus ?thesis using rsup_finite_in[of "{x}"] by auto
15.2124 +next
15.2125 + let ?S = "insert x S"
15.2126 + case False
15.2127 + hence *:"\<forall>x\<in>S. x \<le> rsup S" using bounded_has_rsup(1)[of S] using assms by auto
15.2128 + hence "insert x S *<= max x (rsup S)" unfolding setle_def by auto
15.2129 + hence "isLub UNIV ?S (rsup ?S)" using rsup[of ?S] by auto
15.2130 + moreover
15.2131 + have **:"isUb UNIV ?S (max x (rsup S))" unfolding isUb_def setle_def using * by auto
15.2132 + { fix y assume as:"isUb UNIV (insert x S) y"
15.2133 + hence "max x (rsup S) \<le> y" unfolding isUb_def using rsup_le[OF `S\<noteq>{}`]
15.2134 + unfolding setle_def by auto }
15.2135 + hence "max x (rsup S) <=* isUb UNIV (insert x S)" unfolding setge_def Ball_def mem_def by auto
15.2136 + hence "isLub UNIV ?S (max x (rsup S))" using ** isLubI2[of UNIV ?S "max x (rsup S)"] unfolding Collect_def by auto
15.2137 + ultimately show ?thesis using real_isLub_unique[of UNIV ?S] using `S\<noteq>{}` by auto
15.2138 +qed
15.2139 +
15.2140 +lemma sup_insert_finite: "finite S \<Longrightarrow> rsup(insert x S) = (if S = {} then x else max x (rsup S))"
15.2141 + apply (rule rsup_insert)
15.2142 + apply (rule finite_imp_bounded)
15.2143 + by simp
15.2144 +
15.2145 +lemma bounded_has_rinf:
15.2146 + assumes "bounded S" "S \<noteq> {}"
15.2147 + shows "\<forall>x\<in>S. x >= rinf S" and "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S >= b"
15.2148 +proof
15.2149 + fix x assume "x\<in>S"
15.2150 + from assms(1) obtain a where a:"\<forall>x\<in>S. \<bar>x\<bar> \<le> a" unfolding bounded_real by auto
15.2151 + hence *:"- a <=* S" using setgeI[of S "-a"] unfolding abs_le_interval_iff by auto
15.2152 + thus "x \<ge> rinf S" using rinf[OF `S\<noteq>{}`] using isGlbD2[of UNIV S "rinf S" x] using `x\<in>S` by auto
15.2153 +next
15.2154 + show "\<forall>b. (\<forall>x\<in>S. x >= b) \<longrightarrow> rinf S \<ge> b" using assms
15.2155 + using rinf[of S, unfolded isGlb_def isLb_def greatestP_def setle_def setge_def]
15.2156 + apply (auto simp add: bounded_real)
15.2157 + by (auto simp add: isGlb_def isLb_def greatestP_def setle_def setge_def)
15.2158 +qed
15.2159 +
15.2160 +(* TODO: Move this to RComplete.thy -- would need to include Glb into RComplete *)
15.2161 +lemma real_isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::real)"
15.2162 + apply (frule isGlb_isLb)
15.2163 + apply (frule_tac x = y in isGlb_isLb)
15.2164 + apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
15.2165 + done
15.2166 +
15.2167 +lemma rinf_insert: assumes "bounded S"
15.2168 + shows "rinf(insert x S) = (if S = {} then x else min x (rinf S))" (is "?lhs = ?rhs")
15.2169 +proof(cases "S={}")
15.2170 + case True thus ?thesis using rinf_finite_in[of "{x}"] by auto
15.2171 +next
15.2172 + let ?S = "insert x S"
15.2173 + case False
15.2174 + hence *:"\<forall>x\<in>S. x \<ge> rinf S" using bounded_has_rinf(1)[of S] using assms by auto
15.2175 + hence "min x (rinf S) <=* insert x S" unfolding setge_def by auto
15.2176 + hence "isGlb UNIV ?S (rinf ?S)" using rinf[of ?S] by auto
15.2177 + moreover
15.2178 + have **:"isLb UNIV ?S (min x (rinf S))" unfolding isLb_def setge_def using * by auto
15.2179 + { fix y assume as:"isLb UNIV (insert x S) y"
15.2180 + hence "min x (rinf S) \<ge> y" unfolding isLb_def using rinf_ge[OF `S\<noteq>{}`]
15.2181 + unfolding setge_def by auto }
15.2182 + hence "isLb UNIV (insert x S) *<= min x (rinf S)" unfolding setle_def Ball_def mem_def by auto
15.2183 + hence "isGlb UNIV ?S (min x (rinf S))" using ** isGlbI2[of UNIV ?S "min x (rinf S)"] unfolding Collect_def by auto
15.2184 + ultimately show ?thesis using real_isGlb_unique[of UNIV ?S] using `S\<noteq>{}` by auto
15.2185 +qed
15.2186 +
15.2187 +lemma inf_insert_finite: "finite S ==> rinf(insert x S) = (if S = {} then x else min x (rinf S))"
15.2188 + by (rule rinf_insert, rule finite_imp_bounded, simp)
15.2189 +
15.2190 +subsection{* Compactness (the definition is the one based on convegent subsequences). *}
15.2191 +
15.2192 +definition
15.2193 + compact :: "'a::metric_space set \<Rightarrow> bool" where (* TODO: generalize *)
15.2194 + "compact S \<longleftrightarrow>
15.2195 + (\<forall>f. (\<forall>n. f n \<in> S) \<longrightarrow>
15.2196 + (\<exists>l\<in>S. \<exists>r. subseq r \<and> ((f o r) ---> l) sequentially))"
15.2197 +
15.2198 +text {*
15.2199 + A metric space (or topological vector space) is said to have the
15.2200 + Heine-Borel property if every closed and bounded subset is compact.
15.2201 +*}
15.2202 +
15.2203 +class heine_borel =
15.2204 + assumes bounded_imp_convergent_subsequence:
15.2205 + "bounded s \<Longrightarrow> \<forall>n. f n \<in> s
15.2206 + \<Longrightarrow> \<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
15.2207 +
15.2208 +lemma bounded_closed_imp_compact:
15.2209 + fixes s::"'a::heine_borel set"
15.2210 + assumes "bounded s" and "closed s" shows "compact s"
15.2211 +proof (unfold compact_def, clarify)
15.2212 + fix f :: "nat \<Rightarrow> 'a" assume f: "\<forall>n. f n \<in> s"
15.2213 + obtain l r where r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
15.2214 + using bounded_imp_convergent_subsequence [OF `bounded s` `\<forall>n. f n \<in> s`] by auto
15.2215 + from f have fr: "\<forall>n. (f \<circ> r) n \<in> s" by simp
15.2216 + have "l \<in> s" using `closed s` fr l
15.2217 + unfolding closed_sequential_limits by blast
15.2218 + show "\<exists>l\<in>s. \<exists>r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
15.2219 + using `l \<in> s` r l by blast
15.2220 +qed
15.2221 +
15.2222 +lemma subseq_bigger: assumes "subseq r" shows "n \<le> r n"
15.2223 +proof(induct n)
15.2224 + show "0 \<le> r 0" by auto
15.2225 +next
15.2226 + fix n assume "n \<le> r n"
15.2227 + moreover have "r n < r (Suc n)"
15.2228 + using assms [unfolded subseq_def] by auto
15.2229 + ultimately show "Suc n \<le> r (Suc n)" by auto
15.2230 +qed
15.2231 +
15.2232 +lemma eventually_subseq:
15.2233 + assumes r: "subseq r"
15.2234 + shows "eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
15.2235 +unfolding eventually_sequentially
15.2236 +by (metis subseq_bigger [OF r] le_trans)
15.2237 +
15.2238 +lemma lim_subseq:
15.2239 + "subseq r \<Longrightarrow> (s ---> l) sequentially \<Longrightarrow> ((s o r) ---> l) sequentially"
15.2240 +unfolding tendsto_def eventually_sequentially o_def
15.2241 +by (metis subseq_bigger le_trans)
15.2242 +
15.2243 +lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
15.2244 + unfolding Ex1_def
15.2245 + apply (rule_tac x="nat_rec e f" in exI)
15.2246 + apply (rule conjI)+
15.2247 +apply (rule def_nat_rec_0, simp)
15.2248 +apply (rule allI, rule def_nat_rec_Suc, simp)
15.2249 +apply (rule allI, rule impI, rule ext)
15.2250 +apply (erule conjE)
15.2251 +apply (induct_tac x)
15.2252 +apply (simp add: nat_rec_0)
15.2253 +apply (erule_tac x="n" in allE)
15.2254 +apply (simp)
15.2255 +done
15.2256 +
15.2257 +lemma convergent_bounded_increasing: fixes s ::"nat\<Rightarrow>real"
15.2258 + assumes "incseq s" and "\<forall>n. abs(s n) \<le> b"
15.2259 + shows "\<exists> l. \<forall>e::real>0. \<exists> N. \<forall>n \<ge> N. abs(s n - l) < e"
15.2260 +proof-
15.2261 + have "isUb UNIV (range s) b" using assms(2) and abs_le_D1 unfolding isUb_def and setle_def by auto
15.2262 + then obtain t where t:"isLub UNIV (range s) t" using reals_complete[of "range s" ] by auto
15.2263 + { fix e::real assume "e>0" and as:"\<forall>N. \<exists>n\<ge>N. \<not> \<bar>s n - t\<bar> < e"
15.2264 + { fix n::nat
15.2265 + obtain N where "N\<ge>n" and n:"\<bar>s N - t\<bar> \<ge> e" using as[THEN spec[where x=n]] by auto
15.2266 + have "t \<ge> s N" using isLub_isUb[OF t, unfolded isUb_def setle_def] by auto
15.2267 + with n have "s N \<le> t - e" using `e>0` by auto
15.2268 + hence "s n \<le> t - e" using assms(1)[unfolded incseq_def, THEN spec[where x=n], THEN spec[where x=N]] using `n\<le>N` by auto }
15.2269 + hence "isUb UNIV (range s) (t - e)" unfolding isUb_def and setle_def by auto
15.2270 + hence False using isLub_le_isUb[OF t, of "t - e"] and `e>0` by auto }
15.2271 + thus ?thesis by blast
15.2272 +qed
15.2273 +
15.2274 +lemma convergent_bounded_monotone: fixes s::"nat \<Rightarrow> real"
15.2275 + assumes "\<forall>n. abs(s n) \<le> b" and "monoseq s"
15.2276 + shows "\<exists>l. \<forall>e::real>0. \<exists>N. \<forall>n\<ge>N. abs(s n - l) < e"
15.2277 + using convergent_bounded_increasing[of s b] assms using convergent_bounded_increasing[of "\<lambda>n. - s n" b]
15.2278 + unfolding monoseq_def incseq_def
15.2279 + apply auto unfolding minus_add_distrib[THEN sym, unfolded diff_minus[THEN sym]]
15.2280 + unfolding abs_minus_cancel by(rule_tac x="-l" in exI)auto
15.2281 +
15.2282 +lemma compact_real_lemma:
15.2283 + assumes "\<forall>n::nat. abs(s n) \<le> b"
15.2284 + shows "\<exists>(l::real) r. subseq r \<and> ((s \<circ> r) ---> l) sequentially"
15.2285 +proof-
15.2286 + obtain r where r:"subseq r" "monoseq (\<lambda>n. s (r n))"
15.2287 + using seq_monosub[of s] by auto
15.2288 + thus ?thesis using convergent_bounded_monotone[of "\<lambda>n. s (r n)" b] and assms
15.2289 + unfolding tendsto_iff dist_norm eventually_sequentially by auto
15.2290 +qed
15.2291 +
15.2292 +instance real :: heine_borel
15.2293 +proof
15.2294 + fix s :: "real set" and f :: "nat \<Rightarrow> real"
15.2295 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
15.2296 + then obtain b where b: "\<forall>n. abs (f n) \<le> b"
15.2297 + unfolding bounded_iff by auto
15.2298 + obtain l :: real and r :: "nat \<Rightarrow> nat" where
15.2299 + r: "subseq r" and l: "((f \<circ> r) ---> l) sequentially"
15.2300 + using compact_real_lemma [OF b] by auto
15.2301 + thus "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
15.2302 + by auto
15.2303 +qed
15.2304 +
15.2305 +lemma bounded_component: "bounded s \<Longrightarrow> bounded ((\<lambda>x. x $ i) ` s)"
15.2306 +unfolding bounded_def
15.2307 +apply clarify
15.2308 +apply (rule_tac x="x $ i" in exI)
15.2309 +apply (rule_tac x="e" in exI)
15.2310 +apply clarify
15.2311 +apply (rule order_trans [OF dist_nth_le], simp)
15.2312 +done
15.2313 +
15.2314 +lemma compact_lemma:
15.2315 + fixes f :: "nat \<Rightarrow> 'a::heine_borel ^ 'n::finite"
15.2316 + assumes "bounded s" and "\<forall>n. f n \<in> s"
15.2317 + shows "\<forall>d.
15.2318 + \<exists>l r. subseq r \<and>
15.2319 + (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
15.2320 +proof
15.2321 + fix d::"'n set" have "finite d" by simp
15.2322 + thus "\<exists>l::'a ^ 'n. \<exists>r. subseq r \<and>
15.2323 + (\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r n) $ i) (l $ i) < e) sequentially)"
15.2324 + proof(induct d) case empty thus ?case unfolding subseq_def by auto
15.2325 + next case (insert k d)
15.2326 + have s': "bounded ((\<lambda>x. x $ k) ` s)" using `bounded s` by (rule bounded_component)
15.2327 + obtain l1::"'a^'n" and r1 where r1:"subseq r1" and lr1:"\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially"
15.2328 + using insert(3) by auto
15.2329 + have f': "\<forall>n. f (r1 n) $ k \<in> (\<lambda>x. x $ k) ` s" using `\<forall>n. f n \<in> s` by simp
15.2330 + obtain l2 r2 where r2:"subseq r2" and lr2:"((\<lambda>i. f (r1 (r2 i)) $ k) ---> l2) sequentially"
15.2331 + using bounded_imp_convergent_subsequence[OF s' f'] unfolding o_def by auto
15.2332 + def r \<equiv> "r1 \<circ> r2" have r:"subseq r"
15.2333 + using r1 and r2 unfolding r_def o_def subseq_def by auto
15.2334 + moreover
15.2335 + def l \<equiv> "(\<chi> i. if i = k then l2 else l1$i)::'a^'n"
15.2336 + { fix e::real assume "e>0"
15.2337 + from lr1 `e>0` have N1:"eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 n) $ i) (l1 $ i) < e) sequentially" by blast
15.2338 + from lr2 `e>0` have N2:"eventually (\<lambda>n. dist (f (r1 (r2 n)) $ k) l2 < e) sequentially" by (rule tendstoD)
15.2339 + from r2 N1 have N1': "eventually (\<lambda>n. \<forall>i\<in>d. dist (f (r1 (r2 n)) $ i) (l1 $ i) < e) sequentially"
15.2340 + by (rule eventually_subseq)
15.2341 + have "eventually (\<lambda>n. \<forall>i\<in>(insert k d). dist (f (r n) $ i) (l $ i) < e) sequentially"
15.2342 + using N1' N2 by (rule eventually_elim2, simp add: l_def r_def)
15.2343 + }
15.2344 + ultimately show ?case by auto
15.2345 + qed
15.2346 +qed
15.2347 +
15.2348 +instance "^" :: (heine_borel, finite) heine_borel
15.2349 +proof
15.2350 + fix s :: "('a ^ 'b) set" and f :: "nat \<Rightarrow> 'a ^ 'b"
15.2351 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
15.2352 + then obtain l r where r: "subseq r"
15.2353 + and l: "\<forall>e>0. eventually (\<lambda>n. \<forall>i\<in>UNIV. dist (f (r n) $ i) (l $ i) < e) sequentially"
15.2354 + using compact_lemma [OF s f] by blast
15.2355 + let ?d = "UNIV::'b set"
15.2356 + { fix e::real assume "e>0"
15.2357 + hence "0 < e / (real_of_nat (card ?d))"
15.2358 + using zero_less_card_finite using divide_pos_pos[of e, of "real_of_nat (card ?d)"] by auto
15.2359 + with l have "eventually (\<lambda>n. \<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))) sequentially"
15.2360 + by simp
15.2361 + moreover
15.2362 + { fix n assume n: "\<forall>i. dist (f (r n) $ i) (l $ i) < e / (real_of_nat (card ?d))"
15.2363 + have "dist (f (r n)) l \<le> (\<Sum>i\<in>?d. dist (f (r n) $ i) (l $ i))"
15.2364 + unfolding dist_vector_def using zero_le_dist by (rule setL2_le_setsum)
15.2365 + also have "\<dots> < (\<Sum>i\<in>?d. e / (real_of_nat (card ?d)))"
15.2366 + by (rule setsum_strict_mono) (simp_all add: n)
15.2367 + finally have "dist (f (r n)) l < e" by simp
15.2368 + }
15.2369 + ultimately have "eventually (\<lambda>n. dist (f (r n)) l < e) sequentially"
15.2370 + by (rule eventually_elim1)
15.2371 + }
15.2372 + hence *:"((f \<circ> r) ---> l) sequentially" unfolding o_def tendsto_iff by simp
15.2373 + with r show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially" by auto
15.2374 +qed
15.2375 +
15.2376 +lemma bounded_fst: "bounded s \<Longrightarrow> bounded (fst ` s)"
15.2377 +unfolding bounded_def
15.2378 +apply clarify
15.2379 +apply (rule_tac x="a" in exI)
15.2380 +apply (rule_tac x="e" in exI)
15.2381 +apply clarsimp
15.2382 +apply (drule (1) bspec)
15.2383 +apply (simp add: dist_Pair_Pair)
15.2384 +apply (erule order_trans [OF real_sqrt_sum_squares_ge1])
15.2385 +done
15.2386 +
15.2387 +lemma bounded_snd: "bounded s \<Longrightarrow> bounded (snd ` s)"
15.2388 +unfolding bounded_def
15.2389 +apply clarify
15.2390 +apply (rule_tac x="b" in exI)
15.2391 +apply (rule_tac x="e" in exI)
15.2392 +apply clarsimp
15.2393 +apply (drule (1) bspec)
15.2394 +apply (simp add: dist_Pair_Pair)
15.2395 +apply (erule order_trans [OF real_sqrt_sum_squares_ge2])
15.2396 +done
15.2397 +
15.2398 +instance "*" :: (heine_borel, heine_borel) heine_borel
15.2399 +proof
15.2400 + fix s :: "('a * 'b) set" and f :: "nat \<Rightarrow> 'a * 'b"
15.2401 + assume s: "bounded s" and f: "\<forall>n. f n \<in> s"
15.2402 + from s have s1: "bounded (fst ` s)" by (rule bounded_fst)
15.2403 + from f have f1: "\<forall>n. fst (f n) \<in> fst ` s" by simp
15.2404 + obtain l1 r1 where r1: "subseq r1"
15.2405 + and l1: "((\<lambda>n. fst (f (r1 n))) ---> l1) sequentially"
15.2406 + using bounded_imp_convergent_subsequence [OF s1 f1]
15.2407 + unfolding o_def by fast
15.2408 + from s have s2: "bounded (snd ` s)" by (rule bounded_snd)
15.2409 + from f have f2: "\<forall>n. snd (f (r1 n)) \<in> snd ` s" by simp
15.2410 + obtain l2 r2 where r2: "subseq r2"
15.2411 + and l2: "((\<lambda>n. snd (f (r1 (r2 n)))) ---> l2) sequentially"
15.2412 + using bounded_imp_convergent_subsequence [OF s2 f2]
15.2413 + unfolding o_def by fast
15.2414 + have l1': "((\<lambda>n. fst (f (r1 (r2 n)))) ---> l1) sequentially"
15.2415 + using lim_subseq [OF r2 l1] unfolding o_def .
15.2416 + have l: "((f \<circ> (r1 \<circ> r2)) ---> (l1, l2)) sequentially"
15.2417 + using tendsto_Pair [OF l1' l2] unfolding o_def by simp
15.2418 + have r: "subseq (r1 \<circ> r2)"
15.2419 + using r1 r2 unfolding subseq_def by simp
15.2420 + show "\<exists>l r. subseq r \<and> ((f \<circ> r) ---> l) sequentially"
15.2421 + using l r by fast
15.2422 +qed
15.2423 +
15.2424 +subsection{* Completeness. *}
15.2425 +
15.2426 +lemma cauchy_def:
15.2427 + "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m n. m \<ge> N \<and> n \<ge> N --> dist(s m)(s n) < e)"
15.2428 +unfolding Cauchy_def by blast
15.2429 +
15.2430 +definition
15.2431 + complete :: "'a::metric_space set \<Rightarrow> bool" where
15.2432 + "complete s \<longleftrightarrow> (\<forall>f. (\<forall>n. f n \<in> s) \<and> Cauchy f
15.2433 + --> (\<exists>l \<in> s. (f ---> l) sequentially))"
15.2434 +
15.2435 +lemma cauchy: "Cauchy s \<longleftrightarrow> (\<forall>e>0.\<exists> N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
15.2436 +proof-
15.2437 + { assume ?rhs
15.2438 + { fix e::real
15.2439 + assume "e>0"
15.2440 + with `?rhs` obtain N where N:"\<forall>n\<ge>N. dist (s n) (s N) < e/2"
15.2441 + by (erule_tac x="e/2" in allE) auto
15.2442 + { fix n m
15.2443 + assume nm:"N \<le> m \<and> N \<le> n"
15.2444 + hence "dist (s m) (s n) < e" using N
15.2445 + using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
15.2446 + by blast
15.2447 + }
15.2448 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
15.2449 + by blast
15.2450 + }
15.2451 + hence ?lhs
15.2452 + unfolding cauchy_def
15.2453 + by blast
15.2454 + }
15.2455 + thus ?thesis
15.2456 + unfolding cauchy_def
15.2457 + using dist_triangle_half_l
15.2458 + by blast
15.2459 +qed
15.2460 +
15.2461 +lemma convergent_imp_cauchy:
15.2462 + "(s ---> l) sequentially ==> Cauchy s"
15.2463 +proof(simp only: cauchy_def, rule, rule)
15.2464 + fix e::real assume "e>0" "(s ---> l) sequentially"
15.2465 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (s n) l < e/2" unfolding Lim_sequentially by(erule_tac x="e/2" in allE) auto
15.2466 + thus "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e" using dist_triangle_half_l[of _ l e _] by (rule_tac x=N in exI) auto
15.2467 +qed
15.2468 +
15.2469 +lemma cauchy_imp_bounded: assumes "Cauchy s" shows "bounded {y. (\<exists>n::nat. y = s n)}"
15.2470 +proof-
15.2471 + from assms obtain N::nat where "\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < 1" unfolding cauchy_def apply(erule_tac x= 1 in allE) by auto
15.2472 + hence N:"\<forall>n. N \<le> n \<longrightarrow> dist (s N) (s n) < 1" by auto
15.2473 + moreover
15.2474 + have "bounded (s ` {0..N})" using finite_imp_bounded[of "s ` {1..N}"] by auto
15.2475 + then obtain a where a:"\<forall>x\<in>s ` {0..N}. dist (s N) x \<le> a"
15.2476 + unfolding bounded_any_center [where a="s N"] by auto
15.2477 + ultimately show "?thesis"
15.2478 + unfolding bounded_any_center [where a="s N"]
15.2479 + apply(rule_tac x="max a 1" in exI) apply auto
15.2480 + apply(erule_tac x=n in allE) apply(erule_tac x=n in ballE) by auto
15.2481 +qed
15.2482 +
15.2483 +lemma compact_imp_complete: assumes "compact s" shows "complete s"
15.2484 +proof-
15.2485 + { fix f assume as: "(\<forall>n::nat. f n \<in> s)" "Cauchy f"
15.2486 + from as(1) obtain l r where lr: "l\<in>s" "subseq r" "((f \<circ> r) ---> l) sequentially" using assms unfolding compact_def by blast
15.2487 +
15.2488 + note lr' = subseq_bigger [OF lr(2)]
15.2489 +
15.2490 + { fix e::real assume "e>0"
15.2491 + from as(2) obtain N where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (f m) (f n) < e/2" unfolding cauchy_def using `e>0` apply (erule_tac x="e/2" in allE) by auto
15.2492 + from lr(3)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] obtain M where M:"\<forall>n\<ge>M. dist ((f \<circ> r) n) l < e/2" using `e>0` by auto
15.2493 + { fix n::nat assume n:"n \<ge> max N M"
15.2494 + have "dist ((f \<circ> r) n) l < e/2" using n M by auto
15.2495 + moreover have "r n \<ge> N" using lr'[of n] n by auto
15.2496 + hence "dist (f n) ((f \<circ> r) n) < e / 2" using N using n by auto
15.2497 + ultimately have "dist (f n) l < e" using dist_triangle_half_r[of "f (r n)" "f n" e l] by (auto simp add: dist_commute) }
15.2498 + hence "\<exists>N. \<forall>n\<ge>N. dist (f n) l < e" by blast }
15.2499 + hence "\<exists>l\<in>s. (f ---> l) sequentially" using `l\<in>s` unfolding Lim_sequentially by auto }
15.2500 + thus ?thesis unfolding complete_def by auto
15.2501 +qed
15.2502 +
15.2503 +instance heine_borel < complete_space
15.2504 +proof
15.2505 + fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
15.2506 + hence "bounded (range f)" unfolding image_def
15.2507 + using cauchy_imp_bounded [of f] by auto
15.2508 + hence "compact (closure (range f))"
15.2509 + using bounded_closed_imp_compact [of "closure (range f)"] by auto
15.2510 + hence "complete (closure (range f))"
15.2511 + using compact_imp_complete by auto
15.2512 + moreover have "\<forall>n. f n \<in> closure (range f)"
15.2513 + using closure_subset [of "range f"] by auto
15.2514 + ultimately have "\<exists>l\<in>closure (range f). (f ---> l) sequentially"
15.2515 + using `Cauchy f` unfolding complete_def by auto
15.2516 + then show "convergent f"
15.2517 + unfolding convergent_def LIMSEQ_conv_tendsto [symmetric] by auto
15.2518 +qed
15.2519 +
15.2520 +lemma complete_univ: "complete (UNIV :: 'a::complete_space set)"
15.2521 +proof(simp add: complete_def, rule, rule)
15.2522 + fix f :: "nat \<Rightarrow> 'a" assume "Cauchy f"
15.2523 + hence "convergent f" by (rule Cauchy_convergent)
15.2524 + hence "\<exists>l. f ----> l" unfolding convergent_def .
15.2525 + thus "\<exists>l. (f ---> l) sequentially" unfolding LIMSEQ_conv_tendsto .
15.2526 +qed
15.2527 +
15.2528 +lemma complete_imp_closed: assumes "complete s" shows "closed s"
15.2529 +proof -
15.2530 + { fix x assume "x islimpt s"
15.2531 + then obtain f where f: "\<forall>n. f n \<in> s - {x}" "(f ---> x) sequentially"
15.2532 + unfolding islimpt_sequential by auto
15.2533 + then obtain l where l: "l\<in>s" "(f ---> l) sequentially"
15.2534 + using `complete s`[unfolded complete_def] using convergent_imp_cauchy[of f x] by auto
15.2535 + hence "x \<in> s" using Lim_unique[of sequentially f l x] trivial_limit_sequentially f(2) by auto
15.2536 + }
15.2537 + thus "closed s" unfolding closed_limpt by auto
15.2538 +qed
15.2539 +
15.2540 +lemma complete_eq_closed:
15.2541 + fixes s :: "'a::complete_space set"
15.2542 + shows "complete s \<longleftrightarrow> closed s" (is "?lhs = ?rhs")
15.2543 +proof
15.2544 + assume ?lhs thus ?rhs by (rule complete_imp_closed)
15.2545 +next
15.2546 + assume ?rhs
15.2547 + { fix f assume as:"\<forall>n::nat. f n \<in> s" "Cauchy f"
15.2548 + then obtain l where "(f ---> l) sequentially" using complete_univ[unfolded complete_def, THEN spec[where x=f]] by auto
15.2549 + hence "\<exists>l\<in>s. (f ---> l) sequentially" using `?rhs`[unfolded closed_sequential_limits, THEN spec[where x=f], THEN spec[where x=l]] using as(1) by auto }
15.2550 + thus ?lhs unfolding complete_def by auto
15.2551 +qed
15.2552 +
15.2553 +lemma convergent_eq_cauchy:
15.2554 + fixes s :: "nat \<Rightarrow> 'a::complete_space"
15.2555 + shows "(\<exists>l. (s ---> l) sequentially) \<longleftrightarrow> Cauchy s" (is "?lhs = ?rhs")
15.2556 +proof
15.2557 + assume ?lhs then obtain l where "(s ---> l) sequentially" by auto
15.2558 + thus ?rhs using convergent_imp_cauchy by auto
15.2559 +next
15.2560 + assume ?rhs thus ?lhs using complete_univ[unfolded complete_def, THEN spec[where x=s]] by auto
15.2561 +qed
15.2562 +
15.2563 +lemma convergent_imp_bounded:
15.2564 + fixes s :: "nat \<Rightarrow> 'a::metric_space"
15.2565 + shows "(s ---> l) sequentially ==> bounded (s ` (UNIV::(nat set)))"
15.2566 + using convergent_imp_cauchy[of s]
15.2567 + using cauchy_imp_bounded[of s]
15.2568 + unfolding image_def
15.2569 + by auto
15.2570 +
15.2571 +subsection{* Total boundedness. *}
15.2572 +
15.2573 +fun helper_1::"('a::metric_space set) \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> 'a" where
15.2574 + "helper_1 s e n = (SOME y::'a. y \<in> s \<and> (\<forall>m<n. \<not> (dist (helper_1 s e m) y < e)))"
15.2575 +declare helper_1.simps[simp del]
15.2576 +
15.2577 +lemma compact_imp_totally_bounded:
15.2578 + assumes "compact s"
15.2579 + shows "\<forall>e>0. \<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> (\<Union>((\<lambda>x. ball x e) ` k))"
15.2580 +proof(rule, rule, rule ccontr)
15.2581 + fix e::real assume "e>0" and assm:"\<not> (\<exists>k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k)"
15.2582 + def x \<equiv> "helper_1 s e"
15.2583 + { fix n
15.2584 + have "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)"
15.2585 + proof(induct_tac rule:nat_less_induct)
15.2586 + fix n def Q \<equiv> "(\<lambda>y. y \<in> s \<and> (\<forall>m<n. \<not> dist (x m) y < e))"
15.2587 + assume as:"\<forall>m<n. x m \<in> s \<and> (\<forall>ma<m. \<not> dist (x ma) (x m) < e)"
15.2588 + have "\<not> s \<subseteq> (\<Union>x\<in>x ` {0..<n}. ball x e)" using assm apply simp apply(erule_tac x="x ` {0 ..< n}" in allE) using as by auto
15.2589 + then obtain z where z:"z\<in>s" "z \<notin> (\<Union>x\<in>x ` {0..<n}. ball x e)" unfolding subset_eq by auto
15.2590 + have "Q (x n)" unfolding x_def and helper_1.simps[of s e n]
15.2591 + apply(rule someI2[where a=z]) unfolding x_def[symmetric] and Q_def using z by auto
15.2592 + thus "x n \<in> s \<and> (\<forall>m<n. \<not> dist (x m) (x n) < e)" unfolding Q_def by auto
15.2593 + qed }
15.2594 + hence "\<forall>n::nat. x n \<in> s" and x:"\<forall>n. \<forall>m < n. \<not> (dist (x m) (x n) < e)" by blast+
15.2595 + then obtain l r where "l\<in>s" and r:"subseq r" and "((x \<circ> r) ---> l) sequentially" using assms(1)[unfolded compact_def, THEN spec[where x=x]] by auto
15.2596 + from this(3) have "Cauchy (x \<circ> r)" using convergent_imp_cauchy by auto
15.2597 + then obtain N::nat where N:"\<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist ((x \<circ> r) m) ((x \<circ> r) n) < e" unfolding cauchy_def using `e>0` by auto
15.2598 + show False
15.2599 + using N[THEN spec[where x=N], THEN spec[where x="N+1"]]
15.2600 + using r[unfolded subseq_def, THEN spec[where x=N], THEN spec[where x="N+1"]]
15.2601 + using x[THEN spec[where x="r (N+1)"], THEN spec[where x="r (N)"]] by auto
15.2602 +qed
15.2603 +
15.2604 +subsection{* Heine-Borel theorem (following Burkill \& Burkill vol. 2) *}
15.2605 +
15.2606 +lemma heine_borel_lemma: fixes s::"'a::metric_space set"
15.2607 + assumes "compact s" "s \<subseteq> (\<Union> t)" "\<forall>b \<in> t. open b"
15.2608 + shows "\<exists>e>0. \<forall>x \<in> s. \<exists>b \<in> t. ball x e \<subseteq> b"
15.2609 +proof(rule ccontr)
15.2610 + assume "\<not> (\<exists>e>0. \<forall>x\<in>s. \<exists>b\<in>t. ball x e \<subseteq> b)"
15.2611 + hence cont:"\<forall>e>0. \<exists>x\<in>s. \<forall>xa\<in>t. \<not> (ball x e \<subseteq> xa)" by auto
15.2612 + { fix n::nat
15.2613 + have "1 / real (n + 1) > 0" by auto
15.2614 + hence "\<exists>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> (ball x (inverse (real (n+1))) \<subseteq> xa))" using cont unfolding Bex_def by auto }
15.2615 + hence "\<forall>n::nat. \<exists>x. x \<in> s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)" by auto
15.2616 + then obtain f where f:"\<forall>n::nat. f n \<in> s \<and> (\<forall>xa\<in>t. \<not> ball (f n) (inverse (real (n + 1))) \<subseteq> xa)"
15.2617 + using choice[of "\<lambda>n::nat. \<lambda>x. x\<in>s \<and> (\<forall>xa\<in>t. \<not> ball x (inverse (real (n + 1))) \<subseteq> xa)"] by auto
15.2618 +
15.2619 + then obtain l r where l:"l\<in>s" and r:"subseq r" and lr:"((f \<circ> r) ---> l) sequentially"
15.2620 + using assms(1)[unfolded compact_def, THEN spec[where x=f]] by auto
15.2621 +
15.2622 + obtain b where "l\<in>b" "b\<in>t" using assms(2) and l by auto
15.2623 + then obtain e where "e>0" and e:"\<forall>z. dist z l < e \<longrightarrow> z\<in>b"
15.2624 + using assms(3)[THEN bspec[where x=b]] unfolding open_dist by auto
15.2625 +
15.2626 + then obtain N1 where N1:"\<forall>n\<ge>N1. dist ((f \<circ> r) n) l < e / 2"
15.2627 + using lr[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
15.2628 +
15.2629 + obtain N2::nat where N2:"N2>0" "inverse (real N2) < e /2" using real_arch_inv[of "e/2"] and `e>0` by auto
15.2630 + have N2':"inverse (real (r (N1 + N2) +1 )) < e/2"
15.2631 + apply(rule order_less_trans) apply(rule less_imp_inverse_less) using N2
15.2632 + using subseq_bigger[OF r, of "N1 + N2"] by auto
15.2633 +
15.2634 + def x \<equiv> "(f (r (N1 + N2)))"
15.2635 + have x:"\<not> ball x (inverse (real (r (N1 + N2) + 1))) \<subseteq> b" unfolding x_def
15.2636 + using f[THEN spec[where x="r (N1 + N2)"]] using `b\<in>t` by auto
15.2637 + have "\<exists>y\<in>ball x (inverse (real (r (N1 + N2) + 1))). y\<notin>b" apply(rule ccontr) using x by auto
15.2638 + then obtain y where y:"y \<in> ball x (inverse (real (r (N1 + N2) + 1)))" "y \<notin> b" by auto
15.2639 +
15.2640 + have "dist x l < e/2" using N1 unfolding x_def o_def by auto
15.2641 + hence "dist y l < e" using y N2' using dist_triangle[of y l x]by (auto simp add:dist_commute)
15.2642 +
15.2643 + thus False using e and `y\<notin>b` by auto
15.2644 +qed
15.2645 +
15.2646 +lemma compact_imp_heine_borel: "compact s ==> (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
15.2647 + \<longrightarrow> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))"
15.2648 +proof clarify
15.2649 + fix f assume "compact s" " \<forall>t\<in>f. open t" "s \<subseteq> \<Union>f"
15.2650 + then obtain e::real where "e>0" and "\<forall>x\<in>s. \<exists>b\<in>f. ball x e \<subseteq> b" using heine_borel_lemma[of s f] by auto
15.2651 + hence "\<forall>x\<in>s. \<exists>b. b\<in>f \<and> ball x e \<subseteq> b" by auto
15.2652 + hence "\<exists>bb. \<forall>x\<in>s. bb x \<in>f \<and> ball x e \<subseteq> bb x" using bchoice[of s "\<lambda>x b. b\<in>f \<and> ball x e \<subseteq> b"] by auto
15.2653 + then obtain bb where bb:"\<forall>x\<in>s. (bb x) \<in> f \<and> ball x e \<subseteq> (bb x)" by blast
15.2654 +
15.2655 + from `compact s` have "\<exists> k. finite k \<and> k \<subseteq> s \<and> s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" using compact_imp_totally_bounded[of s] `e>0` by auto
15.2656 + then obtain k where k:"finite k" "k \<subseteq> s" "s \<subseteq> \<Union>(\<lambda>x. ball x e) ` k" by auto
15.2657 +
15.2658 + have "finite (bb ` k)" using k(1) by auto
15.2659 + moreover
15.2660 + { fix x assume "x\<in>s"
15.2661 + hence "x\<in>\<Union>(\<lambda>x. ball x e) ` k" using k(3) unfolding subset_eq by auto
15.2662 + hence "\<exists>X\<in>bb ` k. x \<in> X" using bb k(2) by blast
15.2663 + hence "x \<in> \<Union>(bb ` k)" using Union_iff[of x "bb ` k"] by auto
15.2664 + }
15.2665 + ultimately show "\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f'" using bb k(2) by (rule_tac x="bb ` k" in exI) auto
15.2666 +qed
15.2667 +
15.2668 +subsection{* Bolzano-Weierstrass property. *}
15.2669 +
15.2670 +lemma heine_borel_imp_bolzano_weierstrass:
15.2671 + assumes "\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f) --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f'))"
15.2672 + "infinite t" "t \<subseteq> s"
15.2673 + shows "\<exists>x \<in> s. x islimpt t"
15.2674 +proof(rule ccontr)
15.2675 + assume "\<not> (\<exists>x \<in> s. x islimpt t)"
15.2676 + then obtain f where f:"\<forall>x\<in>s. x \<in> f x \<and> open (f x) \<and> (\<forall>y\<in>t. y \<in> f x \<longrightarrow> y = x)" unfolding islimpt_def
15.2677 + using bchoice[of s "\<lambda> x T. x \<in> T \<and> open T \<and> (\<forall>y\<in>t. y \<in> T \<longrightarrow> y = x)"] by auto
15.2678 + obtain g where g:"g\<subseteq>{t. \<exists>x. x \<in> s \<and> t = f x}" "finite g" "s \<subseteq> \<Union>g"
15.2679 + using assms(1)[THEN spec[where x="{t. \<exists>x. x\<in>s \<and> t = f x}"]] using f by auto
15.2680 + from g(1,3) have g':"\<forall>x\<in>g. \<exists>xa \<in> s. x = f xa" by auto
15.2681 + { fix x y assume "x\<in>t" "y\<in>t" "f x = f y"
15.2682 + hence "x \<in> f x" "y \<in> f x \<longrightarrow> y = x" using f[THEN bspec[where x=x]] and `t\<subseteq>s` by auto
15.2683 + hence "x = y" using `f x = f y` and f[THEN bspec[where x=y]] and `y\<in>t` and `t\<subseteq>s` by auto }
15.2684 + hence "infinite (f ` t)" using assms(2) using finite_imageD[unfolded inj_on_def, of f t] by auto
15.2685 + moreover
15.2686 + { fix x assume "x\<in>t" "f x \<notin> g"
15.2687 + from g(3) assms(3) `x\<in>t` obtain h where "h\<in>g" and "x\<in>h" by auto
15.2688 + then obtain y where "y\<in>s" "h = f y" using g'[THEN bspec[where x=h]] by auto
15.2689 + hence "y = x" using f[THEN bspec[where x=y]] and `x\<in>t` and `x\<in>h`[unfolded `h = f y`] by auto
15.2690 + hence False using `f x \<notin> g` `h\<in>g` unfolding `h = f y` by auto }
15.2691 + hence "f ` t \<subseteq> g" by auto
15.2692 + ultimately show False using g(2) using finite_subset by auto
15.2693 +qed
15.2694 +
15.2695 +subsection{* Complete the chain of compactness variants. *}
15.2696 +
15.2697 +primrec helper_2::"(real \<Rightarrow> 'a::metric_space) \<Rightarrow> nat \<Rightarrow> 'a" where
15.2698 + "helper_2 beyond 0 = beyond 0" |
15.2699 + "helper_2 beyond (Suc n) = beyond (dist undefined (helper_2 beyond n) + 1 )"
15.2700 +
15.2701 +lemma bolzano_weierstrass_imp_bounded: fixes s::"'a::metric_space set"
15.2702 + assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
15.2703 + shows "bounded s"
15.2704 +proof(rule ccontr)
15.2705 + assume "\<not> bounded s"
15.2706 + then obtain beyond where "\<forall>a. beyond a \<in>s \<and> \<not> dist undefined (beyond a) \<le> a"
15.2707 + unfolding bounded_any_center [where a=undefined]
15.2708 + apply simp using choice[of "\<lambda>a x. x\<in>s \<and> \<not> dist undefined x \<le> a"] by auto
15.2709 + hence beyond:"\<And>a. beyond a \<in>s" "\<And>a. dist undefined (beyond a) > a"
15.2710 + unfolding linorder_not_le by auto
15.2711 + def x \<equiv> "helper_2 beyond"
15.2712 +
15.2713 + { fix m n ::nat assume "m<n"
15.2714 + hence "dist undefined (x m) + 1 < dist undefined (x n)"
15.2715 + proof(induct n)
15.2716 + case 0 thus ?case by auto
15.2717 + next
15.2718 + case (Suc n)
15.2719 + have *:"dist undefined (x n) + 1 < dist undefined (x (Suc n))"
15.2720 + unfolding x_def and helper_2.simps
15.2721 + using beyond(2)[of "dist undefined (helper_2 beyond n) + 1"] by auto
15.2722 + thus ?case proof(cases "m < n")
15.2723 + case True thus ?thesis using Suc and * by auto
15.2724 + next
15.2725 + case False hence "m = n" using Suc(2) by auto
15.2726 + thus ?thesis using * by auto
15.2727 + qed
15.2728 + qed } note * = this
15.2729 + { fix m n ::nat assume "m\<noteq>n"
15.2730 + have "1 < dist (x m) (x n)"
15.2731 + proof(cases "m<n")
15.2732 + case True
15.2733 + hence "1 < dist undefined (x n) - dist undefined (x m)" using *[of m n] by auto
15.2734 + thus ?thesis using dist_triangle [of undefined "x n" "x m"] by arith
15.2735 + next
15.2736 + case False hence "n<m" using `m\<noteq>n` by auto
15.2737 + hence "1 < dist undefined (x m) - dist undefined (x n)" using *[of n m] by auto
15.2738 + thus ?thesis using dist_triangle2 [of undefined "x m" "x n"] by arith
15.2739 + qed } note ** = this
15.2740 + { fix a b assume "x a = x b" "a \<noteq> b"
15.2741 + hence False using **[of a b] by auto }
15.2742 + hence "inj x" unfolding inj_on_def by auto
15.2743 + moreover
15.2744 + { fix n::nat
15.2745 + have "x n \<in> s"
15.2746 + proof(cases "n = 0")
15.2747 + case True thus ?thesis unfolding x_def using beyond by auto
15.2748 + next
15.2749 + case False then obtain z where "n = Suc z" using not0_implies_Suc by auto
15.2750 + thus ?thesis unfolding x_def using beyond by auto
15.2751 + qed }
15.2752 + ultimately have "infinite (range x) \<and> range x \<subseteq> s" unfolding x_def using range_inj_infinite[of "helper_2 beyond"] using beyond(1) by auto
15.2753 +
15.2754 + then obtain l where "l\<in>s" and l:"l islimpt range x" using assms[THEN spec[where x="range x"]] by auto
15.2755 + then obtain y where "x y \<noteq> l" and y:"dist (x y) l < 1/2" unfolding islimpt_approachable apply(erule_tac x="1/2" in allE) by auto
15.2756 + then obtain z where "x z \<noteq> l" and z:"dist (x z) l < dist (x y) l" using l[unfolded islimpt_approachable, THEN spec[where x="dist (x y) l"]]
15.2757 + unfolding dist_nz by auto
15.2758 + show False using y and z and dist_triangle_half_l[of "x y" l 1 "x z"] and **[of y z] by auto
15.2759 +qed
15.2760 +
15.2761 +lemma sequence_infinite_lemma:
15.2762 + fixes l :: "'a::metric_space" (* TODO: generalize *)
15.2763 + assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially"
15.2764 + shows "infinite {y. (\<exists> n. y = f n)}"
15.2765 +proof(rule ccontr)
15.2766 + let ?A = "(\<lambda>x. dist x l) ` {y. \<exists>n. y = f n}"
15.2767 + assume "\<not> infinite {y. \<exists>n. y = f n}"
15.2768 + hence **:"finite ?A" "?A \<noteq> {}" by auto
15.2769 + obtain k where k:"dist (f k) l = Min ?A" using Min_in[OF **] by auto
15.2770 + have "0 < Min ?A" using assms(1) unfolding dist_nz unfolding Min_gr_iff[OF **] by auto
15.2771 + then obtain N where "dist (f N) l < Min ?A" using assms(2)[unfolded Lim_sequentially, THEN spec[where x="Min ?A"]] by auto
15.2772 + moreover have "dist (f N) l \<in> ?A" by auto
15.2773 + ultimately show False using Min_le[OF **(1), of "dist (f N) l"] by auto
15.2774 +qed
15.2775 +
15.2776 +lemma sequence_unique_limpt:
15.2777 + fixes l :: "'a::metric_space" (* TODO: generalize *)
15.2778 + assumes "\<forall>n::nat. (f n \<noteq> l)" "(f ---> l) sequentially" "l' islimpt {y. (\<exists>n. y = f n)}"
15.2779 + shows "l' = l"
15.2780 +proof(rule ccontr)
15.2781 + def e \<equiv> "dist l' l"
15.2782 + assume "l' \<noteq> l" hence "e>0" unfolding dist_nz e_def by auto
15.2783 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (f n) l < e / 2"
15.2784 + using assms(2)[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
15.2785 + def d \<equiv> "Min (insert (e/2) ((\<lambda>n. if dist (f n) l' = 0 then e/2 else dist (f n) l') ` {0 .. N}))"
15.2786 + have "d>0" using `e>0` unfolding d_def e_def using zero_le_dist[of _ l', unfolded order_le_less] by auto
15.2787 + obtain k where k:"f k \<noteq> l'" "dist (f k) l' < d" using `d>0` and assms(3)[unfolded islimpt_approachable, THEN spec[where x="d"]] by auto
15.2788 + have "k\<ge>N" using k(1)[unfolded dist_nz] using k(2)[unfolded d_def]
15.2789 + by force
15.2790 + hence "dist l' l < e" using N[THEN spec[where x=k]] using k(2)[unfolded d_def] and dist_triangle_half_r[of "f k" l' e l] by auto
15.2791 + thus False unfolding e_def by auto
15.2792 +qed
15.2793 +
15.2794 +lemma bolzano_weierstrass_imp_closed:
15.2795 + fixes s :: "'a::metric_space set" (* TODO: can this be generalized? *)
15.2796 + assumes "\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t)"
15.2797 + shows "closed s"
15.2798 +proof-
15.2799 + { fix x l assume as: "\<forall>n::nat. x n \<in> s" "(x ---> l) sequentially"
15.2800 + hence "l \<in> s"
15.2801 + proof(cases "\<forall>n. x n \<noteq> l")
15.2802 + case False thus "l\<in>s" using as(1) by auto
15.2803 + next
15.2804 + case True note cas = this
15.2805 + with as(2) have "infinite {y. \<exists>n. y = x n}" using sequence_infinite_lemma[of x l] by auto
15.2806 + then obtain l' where "l'\<in>s" "l' islimpt {y. \<exists>n. y = x n}" using assms[THEN spec[where x="{y. \<exists>n. y = x n}"]] as(1) by auto
15.2807 + thus "l\<in>s" using sequence_unique_limpt[of x l l'] using as cas by auto
15.2808 + qed }
15.2809 + thus ?thesis unfolding closed_sequential_limits by fast
15.2810 +qed
15.2811 +
15.2812 +text{* Hence express everything as an equivalence. *}
15.2813 +
15.2814 +lemma compact_eq_heine_borel:
15.2815 + fixes s :: "'a::heine_borel set"
15.2816 + shows "compact s \<longleftrightarrow>
15.2817 + (\<forall>f. (\<forall>t \<in> f. open t) \<and> s \<subseteq> (\<Union> f)
15.2818 + --> (\<exists>f'. f' \<subseteq> f \<and> finite f' \<and> s \<subseteq> (\<Union> f')))" (is "?lhs = ?rhs")
15.2819 +proof
15.2820 + assume ?lhs thus ?rhs using compact_imp_heine_borel[of s] by blast
15.2821 +next
15.2822 + assume ?rhs
15.2823 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. x islimpt t)"
15.2824 + by (blast intro: heine_borel_imp_bolzano_weierstrass[of s])
15.2825 + thus ?lhs using bolzano_weierstrass_imp_bounded[of s] bolzano_weierstrass_imp_closed[of s] bounded_closed_imp_compact[of s] by blast
15.2826 +qed
15.2827 +
15.2828 +lemma compact_eq_bolzano_weierstrass:
15.2829 + fixes s :: "'a::heine_borel set"
15.2830 + shows "compact s \<longleftrightarrow> (\<forall>t. infinite t \<and> t \<subseteq> s --> (\<exists>x \<in> s. x islimpt t))" (is "?lhs = ?rhs")
15.2831 +proof
15.2832 + assume ?lhs thus ?rhs unfolding compact_eq_heine_borel using heine_borel_imp_bolzano_weierstrass[of s] by auto
15.2833 +next
15.2834 + assume ?rhs thus ?lhs using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed bounded_closed_imp_compact by auto
15.2835 +qed
15.2836 +
15.2837 +lemma compact_eq_bounded_closed:
15.2838 + fixes s :: "'a::heine_borel set"
15.2839 + shows "compact s \<longleftrightarrow> bounded s \<and> closed s" (is "?lhs = ?rhs")
15.2840 +proof
15.2841 + assume ?lhs thus ?rhs unfolding compact_eq_bolzano_weierstrass using bolzano_weierstrass_imp_bounded bolzano_weierstrass_imp_closed by auto
15.2842 +next
15.2843 + assume ?rhs thus ?lhs using bounded_closed_imp_compact by auto
15.2844 +qed
15.2845 +
15.2846 +lemma compact_imp_bounded:
15.2847 + fixes s :: "'a::metric_space set"
15.2848 + shows "compact s ==> bounded s"
15.2849 +proof -
15.2850 + assume "compact s"
15.2851 + hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
15.2852 + by (rule compact_imp_heine_borel)
15.2853 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
15.2854 + using heine_borel_imp_bolzano_weierstrass[of s] by auto
15.2855 + thus "bounded s"
15.2856 + by (rule bolzano_weierstrass_imp_bounded)
15.2857 +qed
15.2858 +
15.2859 +lemma compact_imp_closed:
15.2860 + fixes s :: "'a::metric_space set"
15.2861 + shows "compact s ==> closed s"
15.2862 +proof -
15.2863 + assume "compact s"
15.2864 + hence "\<forall>f. (\<forall>t\<in>f. open t) \<and> s \<subseteq> \<Union>f \<longrightarrow> (\<exists>f'\<subseteq>f. finite f' \<and> s \<subseteq> \<Union>f')"
15.2865 + by (rule compact_imp_heine_borel)
15.2866 + hence "\<forall>t. infinite t \<and> t \<subseteq> s \<longrightarrow> (\<exists>x \<in> s. x islimpt t)"
15.2867 + using heine_borel_imp_bolzano_weierstrass[of s] by auto
15.2868 + thus "closed s"
15.2869 + by (rule bolzano_weierstrass_imp_closed)
15.2870 +qed
15.2871 +
15.2872 +text{* In particular, some common special cases. *}
15.2873 +
15.2874 +lemma compact_empty[simp]:
15.2875 + "compact {}"
15.2876 + unfolding compact_def
15.2877 + by simp
15.2878 +
15.2879 +(* TODO: can any of the next 3 lemmas be generalized to metric spaces? *)
15.2880 +
15.2881 + (* FIXME : Rename *)
15.2882 +lemma compact_union[intro]:
15.2883 + fixes s t :: "'a::heine_borel set"
15.2884 + shows "compact s \<Longrightarrow> compact t ==> compact (s \<union> t)"
15.2885 + unfolding compact_eq_bounded_closed
15.2886 + using bounded_Un[of s t]
15.2887 + using closed_Un[of s t]
15.2888 + by simp
15.2889 +
15.2890 +lemma compact_inter[intro]:
15.2891 + fixes s t :: "'a::heine_borel set"
15.2892 + shows "compact s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
15.2893 + unfolding compact_eq_bounded_closed
15.2894 + using bounded_Int[of s t]
15.2895 + using closed_Int[of s t]
15.2896 + by simp
15.2897 +
15.2898 +lemma compact_inter_closed[intro]:
15.2899 + fixes s t :: "'a::heine_borel set"
15.2900 + shows "compact s \<Longrightarrow> closed t ==> compact (s \<inter> t)"
15.2901 + unfolding compact_eq_bounded_closed
15.2902 + using closed_Int[of s t]
15.2903 + using bounded_subset[of "s \<inter> t" s]
15.2904 + by blast
15.2905 +
15.2906 +lemma closed_inter_compact[intro]:
15.2907 + fixes s t :: "'a::heine_borel set"
15.2908 + shows "closed s \<Longrightarrow> compact t ==> compact (s \<inter> t)"
15.2909 +proof-
15.2910 + assume "closed s" "compact t"
15.2911 + moreover
15.2912 + have "s \<inter> t = t \<inter> s" by auto ultimately
15.2913 + show ?thesis
15.2914 + using compact_inter_closed[of t s]
15.2915 + by auto
15.2916 +qed
15.2917 +
15.2918 +lemma closed_sing [simp]:
15.2919 + fixes a :: "'a::metric_space"
15.2920 + shows "closed {a}"
15.2921 + apply (clarsimp simp add: closed_def open_dist)
15.2922 + apply (rule ccontr)
15.2923 + apply (drule_tac x="dist x a" in spec)
15.2924 + apply (simp add: dist_nz dist_commute)
15.2925 + done
15.2926 +
15.2927 +lemma finite_imp_closed:
15.2928 + fixes s :: "'a::metric_space set"
15.2929 + shows "finite s ==> closed s"
15.2930 +proof (induct set: finite)
15.2931 + case empty show "closed {}" by simp
15.2932 +next
15.2933 + case (insert x F)
15.2934 + hence "closed ({x} \<union> F)" by (simp only: closed_Un closed_sing)
15.2935 + thus "closed (insert x F)" by simp
15.2936 +qed
15.2937 +
15.2938 +lemma finite_imp_compact:
15.2939 + fixes s :: "'a::heine_borel set"
15.2940 + shows "finite s ==> compact s"
15.2941 + unfolding compact_eq_bounded_closed
15.2942 + using finite_imp_closed finite_imp_bounded
15.2943 + by blast
15.2944 +
15.2945 +lemma compact_sing [simp]: "compact {a}"
15.2946 + unfolding compact_def o_def subseq_def
15.2947 + by (auto simp add: tendsto_const)
15.2948 +
15.2949 +lemma compact_cball[simp]:
15.2950 + fixes x :: "'a::heine_borel"
15.2951 + shows "compact(cball x e)"
15.2952 + using compact_eq_bounded_closed bounded_cball closed_cball
15.2953 + by blast
15.2954 +
15.2955 +lemma compact_frontier_bounded[intro]:
15.2956 + fixes s :: "'a::heine_borel set"
15.2957 + shows "bounded s ==> compact(frontier s)"
15.2958 + unfolding frontier_def
15.2959 + using compact_eq_bounded_closed
15.2960 + by blast
15.2961 +
15.2962 +lemma compact_frontier[intro]:
15.2963 + fixes s :: "'a::heine_borel set"
15.2964 + shows "compact s ==> compact (frontier s)"
15.2965 + using compact_eq_bounded_closed compact_frontier_bounded
15.2966 + by blast
15.2967 +
15.2968 +lemma frontier_subset_compact:
15.2969 + fixes s :: "'a::heine_borel set"
15.2970 + shows "compact s ==> frontier s \<subseteq> s"
15.2971 + using frontier_subset_closed compact_eq_bounded_closed
15.2972 + by blast
15.2973 +
15.2974 +lemma open_delete:
15.2975 + fixes s :: "'a::metric_space set"
15.2976 + shows "open s ==> open(s - {x})"
15.2977 + using open_Diff[of s "{x}"] closed_sing
15.2978 + by blast
15.2979 +
15.2980 +text{* Finite intersection property. I could make it an equivalence in fact. *}
15.2981 +
15.2982 +lemma compact_imp_fip:
15.2983 + fixes s :: "'a::heine_borel set"
15.2984 + assumes "compact s" "\<forall>t \<in> f. closed t"
15.2985 + "\<forall>f'. finite f' \<and> f' \<subseteq> f --> (s \<inter> (\<Inter> f') \<noteq> {})"
15.2986 + shows "s \<inter> (\<Inter> f) \<noteq> {}"
15.2987 +proof
15.2988 + assume as:"s \<inter> (\<Inter> f) = {}"
15.2989 + hence "s \<subseteq> \<Union>op - UNIV ` f" by auto
15.2990 + moreover have "Ball (op - UNIV ` f) open" using open_Diff closed_Diff using assms(2) by auto
15.2991 + ultimately obtain f' where f':"f' \<subseteq> op - UNIV ` f" "finite f'" "s \<subseteq> \<Union>f'" using assms(1)[unfolded compact_eq_heine_borel, THEN spec[where x="(\<lambda>t. UNIV - t) ` f"]] by auto
15.2992 + hence "finite (op - UNIV ` f') \<and> op - UNIV ` f' \<subseteq> f" by(auto simp add: Diff_Diff_Int)
15.2993 + hence "s \<inter> \<Inter>op - UNIV ` f' \<noteq> {}" using assms(3)[THEN spec[where x="op - UNIV ` f'"]] by auto
15.2994 + thus False using f'(3) unfolding subset_eq and Union_iff by blast
15.2995 +qed
15.2996 +
15.2997 +subsection{* Bounded closed nest property (proof does not use Heine-Borel). *}
15.2998 +
15.2999 +lemma bounded_closed_nest:
15.3000 + assumes "\<forall>n. closed(s n)" "\<forall>n. (s n \<noteq> {})"
15.3001 + "(\<forall>m n. m \<le> n --> s n \<subseteq> s m)" "bounded(s 0)"
15.3002 + shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s(n)"
15.3003 +proof-
15.3004 + from assms(2) obtain x where x:"\<forall>n::nat. x n \<in> s n" using choice[of "\<lambda>n x. x\<in> s n"] by auto
15.3005 + from assms(4,1) have *:"compact (s 0)" using bounded_closed_imp_compact[of "s 0"] by auto
15.3006 +
15.3007 + then obtain l r where lr:"l\<in>s 0" "subseq r" "((x \<circ> r) ---> l) sequentially"
15.3008 + unfolding compact_def apply(erule_tac x=x in allE) using x using assms(3) by blast
15.3009 +
15.3010 + { fix n::nat
15.3011 + { fix e::real assume "e>0"
15.3012 + with lr(3) obtain N where N:"\<forall>m\<ge>N. dist ((x \<circ> r) m) l < e" unfolding Lim_sequentially by auto
15.3013 + hence "dist ((x \<circ> r) (max N n)) l < e" by auto
15.3014 + moreover
15.3015 + have "r (max N n) \<ge> n" using lr(2) using subseq_bigger[of r "max N n"] by auto
15.3016 + hence "(x \<circ> r) (max N n) \<in> s n"
15.3017 + using x apply(erule_tac x=n in allE)
15.3018 + using x apply(erule_tac x="r (max N n)" in allE)
15.3019 + using assms(3) apply(erule_tac x=n in allE)apply( erule_tac x="r (max N n)" in allE) by auto
15.3020 + ultimately have "\<exists>y\<in>s n. dist y l < e" by auto
15.3021 + }
15.3022 + hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by blast
15.3023 + }
15.3024 + thus ?thesis by auto
15.3025 +qed
15.3026 +
15.3027 +text{* Decreasing case does not even need compactness, just completeness. *}
15.3028 +
15.3029 +lemma decreasing_closed_nest:
15.3030 + assumes "\<forall>n. closed(s n)"
15.3031 + "\<forall>n. (s n \<noteq> {})"
15.3032 + "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
15.3033 + "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y \<in> (s n). dist x y < e"
15.3034 + shows "\<exists>a::'a::heine_borel. \<forall>n::nat. a \<in> s n"
15.3035 +proof-
15.3036 + have "\<forall>n. \<exists> x. x\<in>s n" using assms(2) by auto
15.3037 + hence "\<exists>t. \<forall>n. t n \<in> s n" using choice[of "\<lambda> n x. x \<in> s n"] by auto
15.3038 + then obtain t where t: "\<forall>n. t n \<in> s n" by auto
15.3039 + { fix e::real assume "e>0"
15.3040 + then obtain N where N:"\<forall>x\<in>s N. \<forall>y\<in>s N. dist x y < e" using assms(4) by auto
15.3041 + { fix m n ::nat assume "N \<le> m \<and> N \<le> n"
15.3042 + hence "t m \<in> s N" "t n \<in> s N" using assms(3) t unfolding subset_eq t by blast+
15.3043 + hence "dist (t m) (t n) < e" using N by auto
15.3044 + }
15.3045 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (t m) (t n) < e" by auto
15.3046 + }
15.3047 + hence "Cauchy t" unfolding cauchy_def by auto
15.3048 + then obtain l where l:"(t ---> l) sequentially" using complete_univ unfolding complete_def by auto
15.3049 + { fix n::nat
15.3050 + { fix e::real assume "e>0"
15.3051 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (t n) l < e" using l[unfolded Lim_sequentially] by auto
15.3052 + have "t (max n N) \<in> s n" using assms(3) unfolding subset_eq apply(erule_tac x=n in allE) apply (erule_tac x="max n N" in allE) using t by auto
15.3053 + hence "\<exists>y\<in>s n. dist y l < e" apply(rule_tac x="t (max n N)" in bexI) using N by auto
15.3054 + }
15.3055 + hence "l \<in> s n" using closed_approachable[of "s n" l] assms(1) by auto
15.3056 + }
15.3057 + then show ?thesis by auto
15.3058 +qed
15.3059 +
15.3060 +text{* Strengthen it to the intersection actually being a singleton. *}
15.3061 +
15.3062 +lemma decreasing_closed_nest_sing:
15.3063 + assumes "\<forall>n. closed(s n)"
15.3064 + "\<forall>n. s n \<noteq> {}"
15.3065 + "\<forall>m n. m \<le> n --> s n \<subseteq> s m"
15.3066 + "\<forall>e>0. \<exists>n. \<forall>x \<in> (s n). \<forall> y\<in>(s n). dist x y < e"
15.3067 + shows "\<exists>a::'a::heine_borel. \<Inter> {t. (\<exists>n::nat. t = s n)} = {a}"
15.3068 +proof-
15.3069 + obtain a where a:"\<forall>n. a \<in> s n" using decreasing_closed_nest[of s] using assms by auto
15.3070 + { fix b assume b:"b \<in> \<Inter>{t. \<exists>n. t = s n}"
15.3071 + { fix e::real assume "e>0"
15.3072 + hence "dist a b < e" using assms(4 )using b using a by blast
15.3073 + }
15.3074 + hence "dist a b = 0" by (metis dist_eq_0_iff dist_nz real_less_def)
15.3075 + }
15.3076 + with a have "\<Inter>{t. \<exists>n. t = s n} = {a}" by auto
15.3077 + thus ?thesis by auto
15.3078 +qed
15.3079 +
15.3080 +text{* Cauchy-type criteria for uniform convergence. *}
15.3081 +
15.3082 +lemma uniformly_convergent_eq_cauchy: fixes s::"nat \<Rightarrow> 'b \<Rightarrow> 'a::heine_borel" shows
15.3083 + "(\<exists>l. \<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e) \<longleftrightarrow>
15.3084 + (\<forall>e>0. \<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e)" (is "?lhs = ?rhs")
15.3085 +proof(rule)
15.3086 + assume ?lhs
15.3087 + then obtain l where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e" by auto
15.3088 + { fix e::real assume "e>0"
15.3089 + then obtain N::nat where N:"\<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l x) < e / 2" using l[THEN spec[where x="e/2"]] by auto
15.3090 + { fix n m::nat and x::"'b" assume "N \<le> m \<and> N \<le> n \<and> P x"
15.3091 + hence "dist (s m x) (s n x) < e"
15.3092 + using N[THEN spec[where x=m], THEN spec[where x=x]]
15.3093 + using N[THEN spec[where x=n], THEN spec[where x=x]]
15.3094 + using dist_triangle_half_l[of "s m x" "l x" e "s n x"] by auto }
15.3095 + hence "\<exists>N. \<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x --> dist (s m x) (s n x) < e" by auto }
15.3096 + thus ?rhs by auto
15.3097 +next
15.3098 + assume ?rhs
15.3099 + hence "\<forall>x. P x \<longrightarrow> Cauchy (\<lambda>n. s n x)" unfolding cauchy_def apply auto by (erule_tac x=e in allE)auto
15.3100 + then obtain l where l:"\<forall>x. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l x) sequentially" unfolding convergent_eq_cauchy[THEN sym]
15.3101 + using choice[of "\<lambda>x l. P x \<longrightarrow> ((\<lambda>n. s n x) ---> l) sequentially"] by auto
15.3102 + { fix e::real assume "e>0"
15.3103 + then obtain N where N:"\<forall>m n x. N \<le> m \<and> N \<le> n \<and> P x \<longrightarrow> dist (s m x) (s n x) < e/2"
15.3104 + using `?rhs`[THEN spec[where x="e/2"]] by auto
15.3105 + { fix x assume "P x"
15.3106 + then obtain M where M:"\<forall>n\<ge>M. dist (s n x) (l x) < e/2"
15.3107 + using l[THEN spec[where x=x], unfolded Lim_sequentially] using `e>0` by(auto elim!: allE[where x="e/2"])
15.3108 + fix n::nat assume "n\<ge>N"
15.3109 + hence "dist(s n x)(l x) < e" using `P x`and N[THEN spec[where x=n], THEN spec[where x="N+M"], THEN spec[where x=x]]
15.3110 + using M[THEN spec[where x="N+M"]] and dist_triangle_half_l[of "s n x" "s (N+M) x" e "l x"] by (auto simp add: dist_commute) }
15.3111 + hence "\<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist(s n x)(l x) < e" by auto }
15.3112 + thus ?lhs by auto
15.3113 +qed
15.3114 +
15.3115 +lemma uniformly_cauchy_imp_uniformly_convergent:
15.3116 + fixes s :: "nat \<Rightarrow> 'a \<Rightarrow> 'b::heine_borel"
15.3117 + assumes "\<forall>e>0.\<exists>N. \<forall>m (n::nat) x. N \<le> m \<and> N \<le> n \<and> P x --> dist(s m x)(s n x) < e"
15.3118 + "\<forall>x. P x --> (\<forall>e>0. \<exists>N. \<forall>n. N \<le> n --> dist(s n x)(l x) < e)"
15.3119 + shows "\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x --> dist(s n x)(l x) < e"
15.3120 +proof-
15.3121 + obtain l' where l:"\<forall>e>0. \<exists>N. \<forall>n x. N \<le> n \<and> P x \<longrightarrow> dist (s n x) (l' x) < e"
15.3122 + using assms(1) unfolding uniformly_convergent_eq_cauchy[THEN sym] by auto
15.3123 + moreover
15.3124 + { fix x assume "P x"
15.3125 + hence "l x = l' x" using Lim_unique[OF trivial_limit_sequentially, of "\<lambda>n. s n x" "l x" "l' x"]
15.3126 + using l and assms(2) unfolding Lim_sequentially by blast }
15.3127 + ultimately show ?thesis by auto
15.3128 +qed
15.3129 +
15.3130 +subsection{* Define continuity over a net to take in restrictions of the set. *}
15.3131 +
15.3132 +definition
15.3133 + continuous :: "'a::t2_space net \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool" where
15.3134 + "continuous net f \<longleftrightarrow> (f ---> f(netlimit net)) net"
15.3135 +
15.3136 +lemma continuous_trivial_limit:
15.3137 + "trivial_limit net ==> continuous net f"
15.3138 + unfolding continuous_def tendsto_def trivial_limit_eq by auto
15.3139 +
15.3140 +lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f ---> f(x)) (at x within s)"
15.3141 + unfolding continuous_def
15.3142 + unfolding tendsto_def
15.3143 + using netlimit_within[of x s]
15.3144 + by (cases "trivial_limit (at x within s)") (auto simp add: trivial_limit_eventually)
15.3145 +
15.3146 +lemma continuous_at: "continuous (at x) f \<longleftrightarrow> (f ---> f(x)) (at x)"
15.3147 + using continuous_within [of x UNIV f] by (simp add: within_UNIV)
15.3148 +
15.3149 +lemma continuous_at_within:
15.3150 + assumes "continuous (at x) f" shows "continuous (at x within s) f"
15.3151 + using assms unfolding continuous_at continuous_within
15.3152 + by (rule Lim_at_within)
15.3153 +
15.3154 +text{* Derive the epsilon-delta forms, which we often use as "definitions" *}
15.3155 +
15.3156 +lemma continuous_within_eps_delta:
15.3157 + "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. \<forall>x'\<in> s. dist x' x < d --> dist (f x') (f x) < e)"
15.3158 + unfolding continuous_within and Lim_within
15.3159 + apply auto unfolding dist_nz[THEN sym] apply(auto elim!:allE) apply(rule_tac x=d in exI) by auto
15.3160 +
15.3161 +lemma continuous_at_eps_delta: "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
15.3162 + \<forall>x'. dist x' x < d --> dist(f x')(f x) < e)"
15.3163 + using continuous_within_eps_delta[of x UNIV f]
15.3164 + unfolding within_UNIV by blast
15.3165 +
15.3166 +text{* Versions in terms of open balls. *}
15.3167 +
15.3168 +lemma continuous_within_ball:
15.3169 + "continuous (at x within s) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
15.3170 + f ` (ball x d \<inter> s) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
15.3171 +proof
15.3172 + assume ?lhs
15.3173 + { fix e::real assume "e>0"
15.3174 + then obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
15.3175 + using `?lhs`[unfolded continuous_within Lim_within] by auto
15.3176 + { fix y assume "y\<in>f ` (ball x d \<inter> s)"
15.3177 + hence "y \<in> ball (f x) e" using d(2) unfolding dist_nz[THEN sym]
15.3178 + apply (auto simp add: dist_commute mem_ball) apply(erule_tac x=xa in ballE) apply auto using `e>0` by auto
15.3179 + }
15.3180 + hence "\<exists>d>0. f ` (ball x d \<inter> s) \<subseteq> ball (f x) e" using `d>0` unfolding subset_eq ball_def by (auto simp add: dist_commute) }
15.3181 + thus ?rhs by auto
15.3182 +next
15.3183 + assume ?rhs thus ?lhs unfolding continuous_within Lim_within ball_def subset_eq
15.3184 + apply (auto simp add: dist_commute) apply(erule_tac x=e in allE) by auto
15.3185 +qed
15.3186 +
15.3187 +lemma continuous_at_ball:
15.3188 + "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0. f ` (ball x d) \<subseteq> ball (f x) e)" (is "?lhs = ?rhs")
15.3189 +proof
15.3190 + assume ?lhs thus ?rhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
15.3191 + apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x=xa in allE) apply (auto simp add: dist_commute dist_nz)
15.3192 + unfolding dist_nz[THEN sym] by auto
15.3193 +next
15.3194 + assume ?rhs thus ?lhs unfolding continuous_at Lim_at subset_eq Ball_def Bex_def image_iff mem_ball
15.3195 + apply auto apply(erule_tac x=e in allE) apply auto apply(rule_tac x=d in exI) apply auto apply(erule_tac x="f xa" in allE) by (auto simp add: dist_commute dist_nz)
15.3196 +qed
15.3197 +
15.3198 +text{* For setwise continuity, just start from the epsilon-delta definitions. *}
15.3199 +
15.3200 +definition
15.3201 + continuous_on :: "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
15.3202 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d::real>0. \<forall>x' \<in> s. dist x' x < d --> dist (f x') (f x) < e)"
15.3203 +
15.3204 +
15.3205 +definition
15.3206 + uniformly_continuous_on ::
15.3207 + "'a::metric_space set \<Rightarrow> ('a \<Rightarrow> 'b::metric_space) \<Rightarrow> bool" where
15.3208 + "uniformly_continuous_on s f \<longleftrightarrow>
15.3209 + (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall> x'\<in>s. dist x' x < d
15.3210 + --> dist (f x') (f x) < e)"
15.3211 +
15.3212 +text{* Some simple consequential lemmas. *}
15.3213 +
15.3214 +lemma uniformly_continuous_imp_continuous:
15.3215 + " uniformly_continuous_on s f ==> continuous_on s f"
15.3216 + unfolding uniformly_continuous_on_def continuous_on_def by blast
15.3217 +
15.3218 +lemma continuous_at_imp_continuous_within:
15.3219 + "continuous (at x) f ==> continuous (at x within s) f"
15.3220 + unfolding continuous_within continuous_at using Lim_at_within by auto
15.3221 +
15.3222 +lemma continuous_at_imp_continuous_on: assumes "(\<forall>x \<in> s. continuous (at x) f)"
15.3223 + shows "continuous_on s f"
15.3224 +proof(simp add: continuous_at continuous_on_def, rule, rule, rule)
15.3225 + fix x and e::real assume "x\<in>s" "e>0"
15.3226 + hence "eventually (\<lambda>xa. dist (f xa) (f x) < e) (at x)" using assms unfolding continuous_at tendsto_iff by auto
15.3227 + then obtain d where d:"d>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" unfolding eventually_at by auto
15.3228 + { fix x' assume "\<not> 0 < dist x' x"
15.3229 + hence "x=x'"
15.3230 + using dist_nz[of x' x] by auto
15.3231 + hence "dist (f x') (f x) < e" using `e>0` by auto
15.3232 + }
15.3233 + thus "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using d by auto
15.3234 +qed
15.3235 +
15.3236 +lemma continuous_on_eq_continuous_within:
15.3237 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x within s) f)" (is "?lhs = ?rhs")
15.3238 +proof
15.3239 + assume ?rhs
15.3240 + { fix x assume "x\<in>s"
15.3241 + fix e::real assume "e>0"
15.3242 + assume "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e"
15.3243 + then obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" by auto
15.3244 + { fix x' assume as:"x'\<in>s" "dist x' x < d"
15.3245 + hence "dist (f x') (f x) < e" using `e>0` d `x'\<in>s` dist_eq_0_iff[of x' x] zero_le_dist[of x' x] as(2) by (metis dist_eq_0_iff dist_nz) }
15.3246 + hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `d>0` by auto
15.3247 + }
15.3248 + thus ?lhs using `?rhs` unfolding continuous_on_def continuous_within Lim_within by auto
15.3249 +next
15.3250 + assume ?lhs
15.3251 + thus ?rhs unfolding continuous_on_def continuous_within Lim_within by blast
15.3252 +qed
15.3253 +
15.3254 +lemma continuous_on:
15.3255 + "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. (f ---> f(x)) (at x within s))"
15.3256 + by (auto simp add: continuous_on_eq_continuous_within continuous_within)
15.3257 +
15.3258 +lemma continuous_on_eq_continuous_at:
15.3259 + "open s ==> (continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. continuous (at x) f))"
15.3260 + by (auto simp add: continuous_on continuous_at Lim_within_open)
15.3261 +
15.3262 +lemma continuous_within_subset:
15.3263 + "continuous (at x within s) f \<Longrightarrow> t \<subseteq> s
15.3264 + ==> continuous (at x within t) f"
15.3265 + unfolding continuous_within by(metis Lim_within_subset)
15.3266 +
15.3267 +lemma continuous_on_subset:
15.3268 + "continuous_on s f \<Longrightarrow> t \<subseteq> s ==> continuous_on t f"
15.3269 + unfolding continuous_on by (metis subset_eq Lim_within_subset)
15.3270 +
15.3271 +lemma continuous_on_interior:
15.3272 + "continuous_on s f \<Longrightarrow> x \<in> interior s ==> continuous (at x) f"
15.3273 +unfolding interior_def
15.3274 +apply simp
15.3275 +by (meson continuous_on_eq_continuous_at continuous_on_subset)
15.3276 +
15.3277 +lemma continuous_on_eq:
15.3278 + "(\<forall>x \<in> s. f x = g x) \<Longrightarrow> continuous_on s f
15.3279 + ==> continuous_on s g"
15.3280 + by (simp add: continuous_on_def)
15.3281 +
15.3282 +text{* Characterization of various kinds of continuity in terms of sequences. *}
15.3283 +
15.3284 +(* \<longrightarrow> could be generalized, but \<longleftarrow> requires metric space *)
15.3285 +lemma continuous_within_sequentially:
15.3286 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
15.3287 + shows "continuous (at a within s) f \<longleftrightarrow>
15.3288 + (\<forall>x. (\<forall>n::nat. x n \<in> s) \<and> (x ---> a) sequentially
15.3289 + --> ((f o x) ---> f a) sequentially)" (is "?lhs = ?rhs")
15.3290 +proof
15.3291 + assume ?lhs
15.3292 + { fix x::"nat \<Rightarrow> 'a" assume x:"\<forall>n. x n \<in> s" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (x n) a < e"
15.3293 + fix e::real assume "e>0"
15.3294 + from `?lhs` obtain d where "d>0" and d:"\<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e" unfolding continuous_within Lim_within using `e>0` by auto
15.3295 + from x(2) `d>0` obtain N where N:"\<forall>n\<ge>N. dist (x n) a < d" by auto
15.3296 + hence "\<exists>N. \<forall>n\<ge>N. dist ((f \<circ> x) n) (f a) < e"
15.3297 + apply(rule_tac x=N in exI) using N d apply auto using x(1)
15.3298 + apply(erule_tac x=n in allE) apply(erule_tac x=n in allE)
15.3299 + apply(erule_tac x="x n" in ballE) apply auto unfolding dist_nz[THEN sym] apply auto using `e>0` by auto
15.3300 + }
15.3301 + thus ?rhs unfolding continuous_within unfolding Lim_sequentially by simp
15.3302 +next
15.3303 + assume ?rhs
15.3304 + { fix e::real assume "e>0"
15.3305 + assume "\<not> (\<exists>d>0. \<forall>x\<in>s. 0 < dist x a \<and> dist x a < d \<longrightarrow> dist (f x) (f a) < e)"
15.3306 + hence "\<forall>d. \<exists>x. d>0 \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)" by blast
15.3307 + then obtain x where x:"\<forall>d>0. x d \<in> s \<and> (0 < dist (x d) a \<and> dist (x d) a < d \<and> \<not> dist (f (x d)) (f a) < e)"
15.3308 + using choice[of "\<lambda>d x.0<d \<longrightarrow> x\<in>s \<and> (0 < dist x a \<and> dist x a < d \<and> \<not> dist (f x) (f a) < e)"] by auto
15.3309 + { fix d::real assume "d>0"
15.3310 + hence "\<exists>N::nat. inverse (real (N + 1)) < d" using real_arch_inv[of d] by (auto, rule_tac x="n - 1" in exI)auto
15.3311 + then obtain N::nat where N:"inverse (real (N + 1)) < d" by auto
15.3312 + { fix n::nat assume n:"n\<ge>N"
15.3313 + hence "dist (x (inverse (real (n + 1)))) a < inverse (real (n + 1))" using x[THEN spec[where x="inverse (real (n + 1))"]] by auto
15.3314 + moreover have "inverse (real (n + 1)) < d" using N n by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
15.3315 + ultimately have "dist (x (inverse (real (n + 1)))) a < d" by auto
15.3316 + }
15.3317 + hence "\<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < d" by auto
15.3318 + }
15.3319 + hence "(\<forall>n::nat. x (inverse (real (n + 1))) \<in> s) \<and> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (x (inverse (real (n + 1)))) a < e)" using x by auto
15.3320 + hence "\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist (f (x (inverse (real (n + 1))))) (f a) < e" using `?rhs`[THEN spec[where x="\<lambda>n::nat. x (inverse (real (n+1)))"], unfolded Lim_sequentially] by auto
15.3321 + hence "False" apply(erule_tac x=e in allE) using `e>0` using x by auto
15.3322 + }
15.3323 + thus ?lhs unfolding continuous_within unfolding Lim_within unfolding Lim_sequentially by blast
15.3324 +qed
15.3325 +
15.3326 +lemma continuous_at_sequentially:
15.3327 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
15.3328 + shows "continuous (at a) f \<longleftrightarrow> (\<forall>x. (x ---> a) sequentially
15.3329 + --> ((f o x) ---> f a) sequentially)"
15.3330 + using continuous_within_sequentially[of a UNIV f] unfolding within_UNIV by auto
15.3331 +
15.3332 +lemma continuous_on_sequentially:
15.3333 + "continuous_on s f \<longleftrightarrow> (\<forall>x. \<forall>a \<in> s. (\<forall>n. x(n) \<in> s) \<and> (x ---> a) sequentially
15.3334 + --> ((f o x) ---> f(a)) sequentially)" (is "?lhs = ?rhs")
15.3335 +proof
15.3336 + assume ?rhs thus ?lhs using continuous_within_sequentially[of _ s f] unfolding continuous_on_eq_continuous_within by auto
15.3337 +next
15.3338 + assume ?lhs thus ?rhs unfolding continuous_on_eq_continuous_within using continuous_within_sequentially[of _ s f] by auto
15.3339 +qed
15.3340 +
15.3341 +lemma uniformly_continuous_on_sequentially:
15.3342 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
15.3343 + shows "uniformly_continuous_on s f \<longleftrightarrow> (\<forall>x y. (\<forall>n. x n \<in> s) \<and> (\<forall>n. y n \<in> s) \<and>
15.3344 + ((\<lambda>n. x n - y n) ---> 0) sequentially
15.3345 + \<longrightarrow> ((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially)" (is "?lhs = ?rhs")
15.3346 +proof
15.3347 + assume ?lhs
15.3348 + { fix x y assume x:"\<forall>n. x n \<in> s" and y:"\<forall>n. y n \<in> s" and xy:"((\<lambda>n. x n - y n) ---> 0) sequentially"
15.3349 + { fix e::real assume "e>0"
15.3350 + then obtain d where "d>0" and d:"\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e"
15.3351 + using `?lhs`[unfolded uniformly_continuous_on_def, THEN spec[where x=e]] by auto
15.3352 + obtain N where N:"\<forall>n\<ge>N. norm (x n - y n - 0) < d" using xy[unfolded Lim_sequentially dist_norm] and `d>0` by auto
15.3353 + { fix n assume "n\<ge>N"
15.3354 + hence "norm (f (x n) - f (y n) - 0) < e"
15.3355 + using N[THEN spec[where x=n]] using d[THEN bspec[where x="x n"], THEN bspec[where x="y n"]] using x and y
15.3356 + unfolding dist_commute and dist_norm by simp }
15.3357 + hence "\<exists>N. \<forall>n\<ge>N. norm (f (x n) - f (y n) - 0) < e" by auto }
15.3358 + hence "((\<lambda>n. f(x n) - f(y n)) ---> 0) sequentially" unfolding Lim_sequentially and dist_norm by auto }
15.3359 + thus ?rhs by auto
15.3360 +next
15.3361 + assume ?rhs
15.3362 + { assume "\<not> ?lhs"
15.3363 + then obtain e where "e>0" "\<forall>d>0. \<exists>x\<in>s. \<exists>x'\<in>s. dist x' x < d \<and> \<not> dist (f x') (f x) < e" unfolding uniformly_continuous_on_def by auto
15.3364 + then obtain fa where fa:"\<forall>x. 0 < x \<longrightarrow> fst (fa x) \<in> s \<and> snd (fa x) \<in> s \<and> dist (fst (fa x)) (snd (fa x)) < x \<and> \<not> dist (f (fst (fa x))) (f (snd (fa x))) < e"
15.3365 + using choice[of "\<lambda>d x. d>0 \<longrightarrow> fst x \<in> s \<and> snd x \<in> s \<and> dist (snd x) (fst x) < d \<and> \<not> dist (f (snd x)) (f (fst x)) < e"] unfolding Bex_def
15.3366 + by (auto simp add: dist_commute)
15.3367 + def x \<equiv> "\<lambda>n::nat. fst (fa (inverse (real n + 1)))"
15.3368 + def y \<equiv> "\<lambda>n::nat. snd (fa (inverse (real n + 1)))"
15.3369 + have xyn:"\<forall>n. x n \<in> s \<and> y n \<in> s" and xy0:"\<forall>n. dist (x n) (y n) < inverse (real n + 1)" and fxy:"\<forall>n. \<not> dist (f (x n)) (f (y n)) < e"
15.3370 + unfolding x_def and y_def using fa by auto
15.3371 + have 1:"\<And>(x::'a) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
15.3372 + have 2:"\<And>(x::'b) y. dist (x - y) 0 = dist x y" unfolding dist_norm by auto
15.3373 + { fix e::real assume "e>0"
15.3374 + then obtain N::nat where "N \<noteq> 0" and N:"0 < inverse (real N) \<and> inverse (real N) < e" unfolding real_arch_inv[of e] by auto
15.3375 + { fix n::nat assume "n\<ge>N"
15.3376 + hence "inverse (real n + 1) < inverse (real N)" using real_of_nat_ge_zero and `N\<noteq>0` by auto
15.3377 + also have "\<dots> < e" using N by auto
15.3378 + finally have "inverse (real n + 1) < e" by auto
15.3379 + hence "dist (x n - y n) 0 < e" unfolding 1 using xy0[THEN spec[where x=n]] by auto }
15.3380 + hence "\<exists>N. \<forall>n\<ge>N. dist (x n - y n) 0 < e" by auto }
15.3381 + hence "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. dist (f (x n) - f (y n)) 0 < e" using `?rhs`[THEN spec[where x=x], THEN spec[where x=y]] and xyn unfolding Lim_sequentially by auto
15.3382 + hence False unfolding 2 using fxy and `e>0` by auto }
15.3383 + thus ?lhs unfolding uniformly_continuous_on_def by blast
15.3384 +qed
15.3385 +
15.3386 +text{* The usual transformation theorems. *}
15.3387 +
15.3388 +lemma continuous_transform_within:
15.3389 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
15.3390 + assumes "0 < d" "x \<in> s" "\<forall>x' \<in> s. dist x' x < d --> f x' = g x'"
15.3391 + "continuous (at x within s) f"
15.3392 + shows "continuous (at x within s) g"
15.3393 +proof-
15.3394 + { fix e::real assume "e>0"
15.3395 + then obtain d' where d':"d'>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(4) unfolding continuous_within Lim_within by auto
15.3396 + { fix x' assume "x'\<in>s" "0 < dist x' x" "dist x' x < (min d d')"
15.3397 + hence "dist (f x') (g x) < e" using assms(2,3) apply(erule_tac x=x in ballE) using d' by auto }
15.3398 + hence "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
15.3399 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto }
15.3400 + hence "(f ---> g x) (at x within s)" unfolding Lim_within using assms(1) by auto
15.3401 + thus ?thesis unfolding continuous_within using Lim_transform_within[of d s x f g "g x"] using assms by blast
15.3402 +qed
15.3403 +
15.3404 +lemma continuous_transform_at:
15.3405 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
15.3406 + assumes "0 < d" "\<forall>x'. dist x' x < d --> f x' = g x'"
15.3407 + "continuous (at x) f"
15.3408 + shows "continuous (at x) g"
15.3409 +proof-
15.3410 + { fix e::real assume "e>0"
15.3411 + then obtain d' where d':"d'>0" "\<forall>xa. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < e" using assms(3) unfolding continuous_at Lim_at by auto
15.3412 + { fix x' assume "0 < dist x' x" "dist x' x < (min d d')"
15.3413 + hence "dist (f x') (g x) < e" using assms(2) apply(erule_tac x=x in allE) using d' by auto
15.3414 + }
15.3415 + hence "\<forall>xa. 0 < dist xa x \<and> dist xa x < (min d d') \<longrightarrow> dist (f xa) (g x) < e" by blast
15.3416 + hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (g x) < e" using `d>0` `d'>0` by(rule_tac x="min d d'" in exI)auto
15.3417 + }
15.3418 + hence "(f ---> g x) (at x)" unfolding Lim_at using assms(1) by auto
15.3419 + thus ?thesis unfolding continuous_at using Lim_transform_at[of d x f g "g x"] using assms by blast
15.3420 +qed
15.3421 +
15.3422 +text{* Combination results for pointwise continuity. *}
15.3423 +
15.3424 +lemma continuous_const: "continuous net (\<lambda>x. c)"
15.3425 + by (auto simp add: continuous_def Lim_const)
15.3426 +
15.3427 +lemma continuous_cmul:
15.3428 + fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
15.3429 + shows "continuous net f ==> continuous net (\<lambda>x. c *\<^sub>R f x)"
15.3430 + by (auto simp add: continuous_def Lim_cmul)
15.3431 +
15.3432 +lemma continuous_neg:
15.3433 + fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
15.3434 + shows "continuous net f ==> continuous net (\<lambda>x. -(f x))"
15.3435 + by (auto simp add: continuous_def Lim_neg)
15.3436 +
15.3437 +lemma continuous_add:
15.3438 + fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
15.3439 + shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x + g x)"
15.3440 + by (auto simp add: continuous_def Lim_add)
15.3441 +
15.3442 +lemma continuous_sub:
15.3443 + fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
15.3444 + shows "continuous net f \<Longrightarrow> continuous net g \<Longrightarrow> continuous net (\<lambda>x. f x - g x)"
15.3445 + by (auto simp add: continuous_def Lim_sub)
15.3446 +
15.3447 +text{* Same thing for setwise continuity. *}
15.3448 +
15.3449 +lemma continuous_on_const:
15.3450 + "continuous_on s (\<lambda>x. c)"
15.3451 + unfolding continuous_on_eq_continuous_within using continuous_const by blast
15.3452 +
15.3453 +lemma continuous_on_cmul:
15.3454 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3455 + shows "continuous_on s f ==> continuous_on s (\<lambda>x. c *\<^sub>R (f x))"
15.3456 + unfolding continuous_on_eq_continuous_within using continuous_cmul by blast
15.3457 +
15.3458 +lemma continuous_on_neg:
15.3459 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3460 + shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
15.3461 + unfolding continuous_on_eq_continuous_within using continuous_neg by blast
15.3462 +
15.3463 +lemma continuous_on_add:
15.3464 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3465 + shows "continuous_on s f \<Longrightarrow> continuous_on s g
15.3466 + \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
15.3467 + unfolding continuous_on_eq_continuous_within using continuous_add by blast
15.3468 +
15.3469 +lemma continuous_on_sub:
15.3470 + fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3471 + shows "continuous_on s f \<Longrightarrow> continuous_on s g
15.3472 + \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
15.3473 + unfolding continuous_on_eq_continuous_within using continuous_sub by blast
15.3474 +
15.3475 +text{* Same thing for uniform continuity, using sequential formulations. *}
15.3476 +
15.3477 +lemma uniformly_continuous_on_const:
15.3478 + "uniformly_continuous_on s (\<lambda>x. c)"
15.3479 + unfolding uniformly_continuous_on_def by simp
15.3480 +
15.3481 +lemma uniformly_continuous_on_cmul:
15.3482 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
15.3483 + (* FIXME: generalize 'a to metric_space *)
15.3484 + assumes "uniformly_continuous_on s f"
15.3485 + shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
15.3486 +proof-
15.3487 + { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
15.3488 + hence "((\<lambda>n. c *\<^sub>R f (x n) - c *\<^sub>R f (y n)) ---> 0) sequentially"
15.3489 + using Lim_cmul[of "(\<lambda>n. f (x n) - f (y n))" 0 sequentially c]
15.3490 + unfolding scaleR_zero_right scaleR_right_diff_distrib by auto
15.3491 + }
15.3492 + thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
15.3493 +qed
15.3494 +
15.3495 +lemma dist_minus:
15.3496 + fixes x y :: "'a::real_normed_vector"
15.3497 + shows "dist (- x) (- y) = dist x y"
15.3498 + unfolding dist_norm minus_diff_minus norm_minus_cancel ..
15.3499 +
15.3500 +lemma uniformly_continuous_on_neg:
15.3501 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3502 + shows "uniformly_continuous_on s f
15.3503 + ==> uniformly_continuous_on s (\<lambda>x. -(f x))"
15.3504 + unfolding uniformly_continuous_on_def dist_minus .
15.3505 +
15.3506 +lemma uniformly_continuous_on_add:
15.3507 + fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
15.3508 + assumes "uniformly_continuous_on s f" "uniformly_continuous_on s g"
15.3509 + shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
15.3510 +proof-
15.3511 + { fix x y assume "((\<lambda>n. f (x n) - f (y n)) ---> 0) sequentially"
15.3512 + "((\<lambda>n. g (x n) - g (y n)) ---> 0) sequentially"
15.3513 + hence "((\<lambda>xa. f (x xa) - f (y xa) + (g (x xa) - g (y xa))) ---> 0 + 0) sequentially"
15.3514 + using Lim_add[of "\<lambda> n. f (x n) - f (y n)" 0 sequentially "\<lambda> n. g (x n) - g (y n)" 0] by auto
15.3515 + hence "((\<lambda>n. f (x n) + g (x n) - (f (y n) + g (y n))) ---> 0) sequentially" unfolding Lim_sequentially and add_diff_add [symmetric] by auto }
15.3516 + thus ?thesis using assms unfolding uniformly_continuous_on_sequentially by auto
15.3517 +qed
15.3518 +
15.3519 +lemma uniformly_continuous_on_sub:
15.3520 + fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" (* FIXME: generalize 'a *)
15.3521 + shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s g
15.3522 + ==> uniformly_continuous_on s (\<lambda>x. f x - g x)"
15.3523 + unfolding ab_diff_minus
15.3524 + using uniformly_continuous_on_add[of s f "\<lambda>x. - g x"]
15.3525 + using uniformly_continuous_on_neg[of s g] by auto
15.3526 +
15.3527 +text{* Identity function is continuous in every sense. *}
15.3528 +
15.3529 +lemma continuous_within_id:
15.3530 + "continuous (at a within s) (\<lambda>x. x)"
15.3531 + unfolding continuous_within by (rule Lim_at_within [OF Lim_ident_at])
15.3532 +
15.3533 +lemma continuous_at_id:
15.3534 + "continuous (at a) (\<lambda>x. x)"
15.3535 + unfolding continuous_at by (rule Lim_ident_at)
15.3536 +
15.3537 +lemma continuous_on_id:
15.3538 + "continuous_on s (\<lambda>x. x)"
15.3539 + unfolding continuous_on Lim_within by auto
15.3540 +
15.3541 +lemma uniformly_continuous_on_id:
15.3542 + "uniformly_continuous_on s (\<lambda>x. x)"
15.3543 + unfolding uniformly_continuous_on_def by auto
15.3544 +
15.3545 +text{* Continuity of all kinds is preserved under composition. *}
15.3546 +
15.3547 +lemma continuous_within_compose:
15.3548 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3549 + fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
15.3550 + assumes "continuous (at x within s) f" "continuous (at (f x) within f ` s) g"
15.3551 + shows "continuous (at x within s) (g o f)"
15.3552 +proof-
15.3553 + { fix e::real assume "e>0"
15.3554 + with assms(2)[unfolded continuous_within Lim_within] obtain d where "d>0" and d:"\<forall>xa\<in>f ` s. 0 < dist xa (f x) \<and> dist xa (f x) < d \<longrightarrow> dist (g xa) (g (f x)) < e" by auto
15.3555 + from assms(1)[unfolded continuous_within Lim_within] obtain d' where "d'>0" and d':"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d' \<longrightarrow> dist (f xa) (f x) < d" using `d>0` by auto
15.3556 + { fix y assume as:"y\<in>s" "0 < dist y x" "dist y x < d'"
15.3557 + hence "dist (f y) (f x) < d" using d'[THEN bspec[where x=y]] by (auto simp add:dist_commute)
15.3558 + hence "dist (g (f y)) (g (f x)) < e" using as(1) d[THEN bspec[where x="f y"]] unfolding dist_nz[THEN sym] using `e>0` by auto }
15.3559 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (g (f xa)) (g (f x)) < e" using `d'>0` by auto }
15.3560 + thus ?thesis unfolding continuous_within Lim_within by auto
15.3561 +qed
15.3562 +
15.3563 +lemma continuous_at_compose:
15.3564 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3565 + fixes g :: "'b::metric_space \<Rightarrow> 'c::metric_space"
15.3566 + assumes "continuous (at x) f" "continuous (at (f x)) g"
15.3567 + shows "continuous (at x) (g o f)"
15.3568 +proof-
15.3569 + have " continuous (at (f x) within range f) g" using assms(2) using continuous_within_subset[of "f x" UNIV g "range f", unfolded within_UNIV] by auto
15.3570 + thus ?thesis using assms(1) using continuous_within_compose[of x UNIV f g, unfolded within_UNIV] by auto
15.3571 +qed
15.3572 +
15.3573 +lemma continuous_on_compose:
15.3574 + "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g o f)"
15.3575 + unfolding continuous_on_eq_continuous_within using continuous_within_compose[of _ s f g] by auto
15.3576 +
15.3577 +lemma uniformly_continuous_on_compose:
15.3578 + assumes "uniformly_continuous_on s f" "uniformly_continuous_on (f ` s) g"
15.3579 + shows "uniformly_continuous_on s (g o f)"
15.3580 +proof-
15.3581 + { fix e::real assume "e>0"
15.3582 + then obtain d where "d>0" and d:"\<forall>x\<in>f ` s. \<forall>x'\<in>f ` s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using assms(2) unfolding uniformly_continuous_on_def by auto
15.3583 + obtain d' where "d'>0" "\<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d' \<longrightarrow> dist (f x') (f x) < d" using `d>0` using assms(1) unfolding uniformly_continuous_on_def by auto
15.3584 + hence "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist ((g \<circ> f) x') ((g \<circ> f) x) < e" using `d>0` using d by auto }
15.3585 + thus ?thesis using assms unfolding uniformly_continuous_on_def by auto
15.3586 +qed
15.3587 +
15.3588 +text{* Continuity in terms of open preimages. *}
15.3589 +
15.3590 +lemma continuous_at_open:
15.3591 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3592 + shows "continuous (at x) f \<longleftrightarrow> (\<forall>t. open t \<and> f x \<in> t --> (\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x' \<in> s. (f x') \<in> t)))" (is "?lhs = ?rhs")
15.3593 +proof
15.3594 + assume ?lhs
15.3595 + { fix t assume as: "open t" "f x \<in> t"
15.3596 + then obtain e where "e>0" and e:"ball (f x) e \<subseteq> t" unfolding open_contains_ball by auto
15.3597 +
15.3598 + obtain d where "d>0" and d:"\<forall>y. 0 < dist y x \<and> dist y x < d \<longrightarrow> dist (f y) (f x) < e" using `e>0` using `?lhs`[unfolded continuous_at Lim_at open_dist] by auto
15.3599 +
15.3600 + have "open (ball x d)" using open_ball by auto
15.3601 + moreover have "x \<in> ball x d" unfolding centre_in_ball using `d>0` by simp
15.3602 + moreover
15.3603 + { fix x' assume "x'\<in>ball x d" hence "f x' \<in> t"
15.3604 + using e[unfolded subset_eq Ball_def mem_ball, THEN spec[where x="f x'"]] d[THEN spec[where x=x']]
15.3605 + unfolding mem_ball apply (auto simp add: dist_commute)
15.3606 + unfolding dist_nz[THEN sym] using as(2) by auto }
15.3607 + hence "\<forall>x'\<in>ball x d. f x' \<in> t" by auto
15.3608 + ultimately have "\<exists>s. open s \<and> x \<in> s \<and> (\<forall>x'\<in>s. f x' \<in> t)"
15.3609 + apply(rule_tac x="ball x d" in exI) by simp }
15.3610 + thus ?rhs by auto
15.3611 +next
15.3612 + assume ?rhs
15.3613 + { fix e::real assume "e>0"
15.3614 + then obtain s where s: "open s" "x \<in> s" "\<forall>x'\<in>s. f x' \<in> ball (f x) e" using `?rhs`[unfolded continuous_at Lim_at, THEN spec[where x="ball (f x) e"]]
15.3615 + unfolding centre_in_ball[of "f x" e, THEN sym] by auto
15.3616 + then obtain d where "d>0" and d:"ball x d \<subseteq> s" unfolding open_contains_ball by auto
15.3617 + { fix y assume "0 < dist y x \<and> dist y x < d"
15.3618 + hence "dist (f y) (f x) < e" using d[unfolded subset_eq Ball_def mem_ball, THEN spec[where x=y]]
15.3619 + using s(3)[THEN bspec[where x=y], unfolded mem_ball] by (auto simp add: dist_commute) }
15.3620 + hence "\<exists>d>0. \<forall>xa. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `d>0` by auto }
15.3621 + thus ?lhs unfolding continuous_at Lim_at by auto
15.3622 +qed
15.3623 +
15.3624 +lemma continuous_on_open:
15.3625 + "continuous_on s f \<longleftrightarrow>
15.3626 + (\<forall>t. openin (subtopology euclidean (f ` s)) t
15.3627 + --> openin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
15.3628 +proof
15.3629 + assume ?lhs
15.3630 + { fix t assume as:"openin (subtopology euclidean (f ` s)) t"
15.3631 + have "{x \<in> s. f x \<in> t} \<subseteq> s" using as[unfolded openin_euclidean_subtopology_iff] by auto
15.3632 + moreover
15.3633 + { fix x assume as':"x\<in>{x \<in> s. f x \<in> t}"
15.3634 + then obtain e where e: "e>0" "\<forall>x'\<in>f ` s. dist x' (f x) < e \<longrightarrow> x' \<in> t" using as[unfolded openin_euclidean_subtopology_iff, THEN conjunct2, THEN bspec[where x="f x"]] by auto
15.3635 + from this(1) obtain d where d: "d>0" "\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" using `?lhs`[unfolded continuous_on Lim_within, THEN bspec[where x=x]] using as' by auto
15.3636 + have "\<exists>e>0. \<forall>x'\<in>s. dist x' x < e \<longrightarrow> x' \<in> {x \<in> s. f x \<in> t}" using d e unfolding dist_nz[THEN sym] by (rule_tac x=d in exI, auto) }
15.3637 + ultimately have "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" unfolding openin_euclidean_subtopology_iff by auto }
15.3638 + thus ?rhs unfolding continuous_on Lim_within using openin by auto
15.3639 +next
15.3640 + assume ?rhs
15.3641 + { fix e::real and x assume "x\<in>s" "e>0"
15.3642 + { fix xa x' assume "dist (f xa) (f x) < e" "xa \<in> s" "x' \<in> s" "dist (f xa) (f x') < e - dist (f xa) (f x)"
15.3643 + hence "dist (f x') (f x) < e" using dist_triangle[of "f x'" "f x" "f xa"]
15.3644 + by (auto simp add: dist_commute) }
15.3645 + hence "ball (f x) e \<inter> f ` s \<subseteq> f ` s \<and> (\<forall>xa\<in>ball (f x) e \<inter> f ` s. \<exists>ea>0. \<forall>x'\<in>f ` s. dist x' xa < ea \<longrightarrow> x' \<in> ball (f x) e \<inter> f ` s)" apply auto
15.3646 + apply(rule_tac x="e - dist (f xa) (f x)" in exI) using `e>0` by (auto simp add: dist_commute)
15.3647 + hence "\<forall>xa\<in>{xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}. \<exists>ea>0. \<forall>x'\<in>s. dist x' xa < ea \<longrightarrow> x' \<in> {xa \<in> s. f xa \<in> ball (f x) e \<inter> f ` s}"
15.3648 + using `?rhs`[unfolded openin_euclidean_subtopology_iff, THEN spec[where x="ball (f x) e \<inter> f ` s"]] by auto
15.3649 + hence "\<exists>d>0. \<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < e" apply(erule_tac x=x in ballE) apply auto using `e>0` `x\<in>s` by (auto simp add: dist_commute) }
15.3650 + thus ?lhs unfolding continuous_on Lim_within by auto
15.3651 +qed
15.3652 +
15.3653 +(* ------------------------------------------------------------------------- *)
15.3654 +(* Similarly in terms of closed sets. *)
15.3655 +(* ------------------------------------------------------------------------- *)
15.3656 +
15.3657 +lemma continuous_on_closed:
15.3658 + "continuous_on s f \<longleftrightarrow> (\<forall>t. closedin (subtopology euclidean (f ` s)) t --> closedin (subtopology euclidean s) {x \<in> s. f x \<in> t})" (is "?lhs = ?rhs")
15.3659 +proof
15.3660 + assume ?lhs
15.3661 + { fix t
15.3662 + have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
15.3663 + have **:"f ` s - (f ` s - (f ` s - t)) = f ` s - t" by auto
15.3664 + assume as:"closedin (subtopology euclidean (f ` s)) t"
15.3665 + hence "closedin (subtopology euclidean (f ` s)) (f ` s - (f ` s - t))" unfolding closedin_def topspace_euclidean_subtopology unfolding ** by auto
15.3666 + hence "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?lhs`[unfolded continuous_on_open, THEN spec[where x="(f ` s) - t"]]
15.3667 + unfolding openin_closedin_eq topspace_euclidean_subtopology unfolding * by auto }
15.3668 + thus ?rhs by auto
15.3669 +next
15.3670 + assume ?rhs
15.3671 + { fix t
15.3672 + have *:"s - {x \<in> s. f x \<in> f ` s - t} = {x \<in> s. f x \<in> t}" by auto
15.3673 + assume as:"openin (subtopology euclidean (f ` s)) t"
15.3674 + hence "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}" using `?rhs`[THEN spec[where x="(f ` s) - t"]]
15.3675 + unfolding openin_closedin_eq topspace_euclidean_subtopology *[THEN sym] closedin_subtopology by auto }
15.3676 + thus ?lhs unfolding continuous_on_open by auto
15.3677 +qed
15.3678 +
15.3679 +text{* Half-global and completely global cases. *}
15.3680 +
15.3681 +lemma continuous_open_in_preimage:
15.3682 + assumes "continuous_on s f" "open t"
15.3683 + shows "openin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
15.3684 +proof-
15.3685 + have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
15.3686 + have "openin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
15.3687 + using openin_open_Int[of t "f ` s", OF assms(2)] unfolding openin_open by auto
15.3688 + thus ?thesis using assms(1)[unfolded continuous_on_open, THEN spec[where x="t \<inter> f ` s"]] using * by auto
15.3689 +qed
15.3690 +
15.3691 +lemma continuous_closed_in_preimage:
15.3692 + assumes "continuous_on s f" "closed t"
15.3693 + shows "closedin (subtopology euclidean s) {x \<in> s. f x \<in> t}"
15.3694 +proof-
15.3695 + have *:"\<forall>x. x \<in> s \<and> f x \<in> t \<longleftrightarrow> x \<in> s \<and> f x \<in> (t \<inter> f ` s)" by auto
15.3696 + have "closedin (subtopology euclidean (f ` s)) (t \<inter> f ` s)"
15.3697 + using closedin_closed_Int[of t "f ` s", OF assms(2)] unfolding Int_commute by auto
15.3698 + thus ?thesis
15.3699 + using assms(1)[unfolded continuous_on_closed, THEN spec[where x="t \<inter> f ` s"]] using * by auto
15.3700 +qed
15.3701 +
15.3702 +lemma continuous_open_preimage:
15.3703 + assumes "continuous_on s f" "open s" "open t"
15.3704 + shows "open {x \<in> s. f x \<in> t}"
15.3705 +proof-
15.3706 + obtain T where T: "open T" "{x \<in> s. f x \<in> t} = s \<inter> T"
15.3707 + using continuous_open_in_preimage[OF assms(1,3)] unfolding openin_open by auto
15.3708 + thus ?thesis using open_Int[of s T, OF assms(2)] by auto
15.3709 +qed
15.3710 +
15.3711 +lemma continuous_closed_preimage:
15.3712 + assumes "continuous_on s f" "closed s" "closed t"
15.3713 + shows "closed {x \<in> s. f x \<in> t}"
15.3714 +proof-
15.3715 + obtain T where T: "closed T" "{x \<in> s. f x \<in> t} = s \<inter> T"
15.3716 + using continuous_closed_in_preimage[OF assms(1,3)] unfolding closedin_closed by auto
15.3717 + thus ?thesis using closed_Int[of s T, OF assms(2)] by auto
15.3718 +qed
15.3719 +
15.3720 +lemma continuous_open_preimage_univ:
15.3721 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3722 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open {x. f x \<in> s}"
15.3723 + using continuous_open_preimage[of UNIV f s] open_UNIV continuous_at_imp_continuous_on by auto
15.3724 +
15.3725 +lemma continuous_closed_preimage_univ:
15.3726 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3727 + shows "(\<forall>x. continuous (at x) f) \<Longrightarrow> closed s ==> closed {x. f x \<in> s}"
15.3728 + using continuous_closed_preimage[of UNIV f s] closed_UNIV continuous_at_imp_continuous_on by auto
15.3729 +
15.3730 +lemma continuous_open_vimage:
15.3731 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3732 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> open s \<Longrightarrow> open (f -` s)"
15.3733 + unfolding vimage_def by (rule continuous_open_preimage_univ)
15.3734 +
15.3735 +lemma continuous_closed_vimage:
15.3736 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3737 + shows "\<forall>x. continuous (at x) f \<Longrightarrow> closed s \<Longrightarrow> closed (f -` s)"
15.3738 + unfolding vimage_def by (rule continuous_closed_preimage_univ)
15.3739 +
15.3740 +text{* Equality of continuous functions on closure and related results. *}
15.3741 +
15.3742 +lemma continuous_closed_in_preimage_constant:
15.3743 + "continuous_on s f ==> closedin (subtopology euclidean s) {x \<in> s. f x = a}"
15.3744 + using continuous_closed_in_preimage[of s f "{a}"] closed_sing by auto
15.3745 +
15.3746 +lemma continuous_closed_preimage_constant:
15.3747 + "continuous_on s f \<Longrightarrow> closed s ==> closed {x \<in> s. f x = a}"
15.3748 + using continuous_closed_preimage[of s f "{a}"] closed_sing by auto
15.3749 +
15.3750 +lemma continuous_constant_on_closure:
15.3751 + assumes "continuous_on (closure s) f"
15.3752 + "\<forall>x \<in> s. f x = a"
15.3753 + shows "\<forall>x \<in> (closure s). f x = a"
15.3754 + using continuous_closed_preimage_constant[of "closure s" f a]
15.3755 + assms closure_minimal[of s "{x \<in> closure s. f x = a}"] closure_subset unfolding subset_eq by auto
15.3756 +
15.3757 +lemma image_closure_subset:
15.3758 + assumes "continuous_on (closure s) f" "closed t" "(f ` s) \<subseteq> t"
15.3759 + shows "f ` (closure s) \<subseteq> t"
15.3760 +proof-
15.3761 + have "s \<subseteq> {x \<in> closure s. f x \<in> t}" using assms(3) closure_subset by auto
15.3762 + moreover have "closed {x \<in> closure s. f x \<in> t}"
15.3763 + using continuous_closed_preimage[OF assms(1)] and assms(2) by auto
15.3764 + ultimately have "closure s = {x \<in> closure s . f x \<in> t}"
15.3765 + using closure_minimal[of s "{x \<in> closure s. f x \<in> t}"] by auto
15.3766 + thus ?thesis by auto
15.3767 +qed
15.3768 +
15.3769 +lemma continuous_on_closure_norm_le:
15.3770 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.3771 + assumes "continuous_on (closure s) f" "\<forall>y \<in> s. norm(f y) \<le> b" "x \<in> (closure s)"
15.3772 + shows "norm(f x) \<le> b"
15.3773 +proof-
15.3774 + have *:"f ` s \<subseteq> cball 0 b" using assms(2)[unfolded mem_cball_0[THEN sym]] by auto
15.3775 + show ?thesis
15.3776 + using image_closure_subset[OF assms(1) closed_cball[of 0 b] *] assms(3)
15.3777 + unfolding subset_eq apply(erule_tac x="f x" in ballE) by (auto simp add: dist_norm)
15.3778 +qed
15.3779 +
15.3780 +text{* Making a continuous function avoid some value in a neighbourhood. *}
15.3781 +
15.3782 +lemma continuous_within_avoid:
15.3783 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3784 + assumes "continuous (at x within s) f" "x \<in> s" "f x \<noteq> a"
15.3785 + shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e --> f y \<noteq> a"
15.3786 +proof-
15.3787 + obtain d where "d>0" and d:"\<forall>xa\<in>s. 0 < dist xa x \<and> dist xa x < d \<longrightarrow> dist (f xa) (f x) < dist (f x) a"
15.3788 + using assms(1)[unfolded continuous_within Lim_within, THEN spec[where x="dist (f x) a"]] assms(3)[unfolded dist_nz] by auto
15.3789 + { fix y assume " y\<in>s" "dist x y < d"
15.3790 + hence "f y \<noteq> a" using d[THEN bspec[where x=y]] assms(3)[unfolded dist_nz]
15.3791 + apply auto unfolding dist_nz[THEN sym] by (auto simp add: dist_commute) }
15.3792 + thus ?thesis using `d>0` by auto
15.3793 +qed
15.3794 +
15.3795 +lemma continuous_at_avoid:
15.3796 + fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space" (* FIXME: generalize *)
15.3797 + assumes "continuous (at x) f" "f x \<noteq> a"
15.3798 + shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
15.3799 +using assms using continuous_within_avoid[of x UNIV f a, unfolded within_UNIV] by auto
15.3800 +
15.3801 +lemma continuous_on_avoid:
15.3802 + assumes "continuous_on s f" "x \<in> s" "f x \<noteq> a"
15.3803 + shows "\<exists>e>0. \<forall>y \<in> s. dist x y < e \<longrightarrow> f y \<noteq> a"
15.3804 +using assms(1)[unfolded continuous_on_eq_continuous_within, THEN bspec[where x=x], OF assms(2)] continuous_within_avoid[of x s f a] assms(2,3) by auto
15.3805 +
15.3806 +lemma continuous_on_open_avoid:
15.3807 + assumes "continuous_on s f" "open s" "x \<in> s" "f x \<noteq> a"
15.3808 + shows "\<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> f y \<noteq> a"
15.3809 +using assms(1)[unfolded continuous_on_eq_continuous_at[OF assms(2)], THEN bspec[where x=x], OF assms(3)] continuous_at_avoid[of x f a] assms(3,4) by auto
15.3810 +
15.3811 +text{* Proving a function is constant by proving open-ness of level set. *}
15.3812 +
15.3813 +lemma continuous_levelset_open_in_cases:
15.3814 + "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
15.3815 + openin (subtopology euclidean s) {x \<in> s. f x = a}
15.3816 + ==> (\<forall>x \<in> s. f x \<noteq> a) \<or> (\<forall>x \<in> s. f x = a)"
15.3817 +unfolding connected_clopen using continuous_closed_in_preimage_constant by auto
15.3818 +
15.3819 +lemma continuous_levelset_open_in:
15.3820 + "connected s \<Longrightarrow> continuous_on s f \<Longrightarrow>
15.3821 + openin (subtopology euclidean s) {x \<in> s. f x = a} \<Longrightarrow>
15.3822 + (\<exists>x \<in> s. f x = a) ==> (\<forall>x \<in> s. f x = a)"
15.3823 +using continuous_levelset_open_in_cases[of s f ]
15.3824 +by meson
15.3825 +
15.3826 +lemma continuous_levelset_open:
15.3827 + assumes "connected s" "continuous_on s f" "open {x \<in> s. f x = a}" "\<exists>x \<in> s. f x = a"
15.3828 + shows "\<forall>x \<in> s. f x = a"
15.3829 +using continuous_levelset_open_in[OF assms(1,2), of a, unfolded openin_open] using assms (3,4) by auto
15.3830 +
15.3831 +text{* Some arithmetical combinations (more to prove). *}
15.3832 +
15.3833 +lemma open_scaling[intro]:
15.3834 + fixes s :: "'a::real_normed_vector set"
15.3835 + assumes "c \<noteq> 0" "open s"
15.3836 + shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
15.3837 +proof-
15.3838 + { fix x assume "x \<in> s"
15.3839 + then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> s" using assms(2)[unfolded open_dist, THEN bspec[where x=x]] by auto
15.3840 + have "e * abs c > 0" using assms(1)[unfolded zero_less_abs_iff[THEN sym]] using real_mult_order[OF `e>0`] by auto
15.3841 + moreover
15.3842 + { fix y assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
15.3843 + hence "norm ((1 / c) *\<^sub>R y - x) < e" unfolding dist_norm
15.3844 + using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
15.3845 + assms(1)[unfolded zero_less_abs_iff[THEN sym]] by (simp del:zero_less_abs_iff)
15.3846 + hence "y \<in> op *\<^sub>R c ` s" using rev_image_eqI[of "(1 / c) *\<^sub>R y" s y "op *\<^sub>R c"] e[THEN spec[where x="(1 / c) *\<^sub>R y"]] assms(1) unfolding dist_norm scaleR_scaleR by auto }
15.3847 + ultimately have "\<exists>e>0. \<forall>x'. dist x' (c *\<^sub>R x) < e \<longrightarrow> x' \<in> op *\<^sub>R c ` s" apply(rule_tac x="e * abs c" in exI) by auto }
15.3848 + thus ?thesis unfolding open_dist by auto
15.3849 +qed
15.3850 +
15.3851 +lemma minus_image_eq_vimage:
15.3852 + fixes A :: "'a::ab_group_add set"
15.3853 + shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
15.3854 + by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
15.3855 +
15.3856 +lemma open_negations:
15.3857 + fixes s :: "'a::real_normed_vector set"
15.3858 + shows "open s ==> open ((\<lambda> x. -x) ` s)"
15.3859 + unfolding scaleR_minus1_left [symmetric]
15.3860 + by (rule open_scaling, auto)
15.3861 +
15.3862 +lemma open_translation:
15.3863 + fixes s :: "'a::real_normed_vector set"
15.3864 + assumes "open s" shows "open((\<lambda>x. a + x) ` s)"
15.3865 +proof-
15.3866 + { fix x have "continuous (at x) (\<lambda>x. x - a)" using continuous_sub[of "at x" "\<lambda>x. x" "\<lambda>x. a"] continuous_at_id[of x] continuous_const[of "at x" a] by auto }
15.3867 + moreover have "{x. x - a \<in> s} = op + a ` s" apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
15.3868 + ultimately show ?thesis using continuous_open_preimage_univ[of "\<lambda>x. x - a" s] using assms by auto
15.3869 +qed
15.3870 +
15.3871 +lemma open_affinity:
15.3872 + fixes s :: "'a::real_normed_vector set"
15.3873 + assumes "open s" "c \<noteq> 0"
15.3874 + shows "open ((\<lambda>x. a + c *\<^sub>R x) ` s)"
15.3875 +proof-
15.3876 + have *:"(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)" unfolding o_def ..
15.3877 + have "op + a ` op *\<^sub>R c ` s = (op + a \<circ> op *\<^sub>R c) ` s" by auto
15.3878 + thus ?thesis using assms open_translation[of "op *\<^sub>R c ` s" a] unfolding * by auto
15.3879 +qed
15.3880 +
15.3881 +lemma interior_translation:
15.3882 + fixes s :: "'a::real_normed_vector set"
15.3883 + shows "interior ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (interior s)"
15.3884 +proof (rule set_ext, rule)
15.3885 + fix x assume "x \<in> interior (op + a ` s)"
15.3886 + then obtain e where "e>0" and e:"ball x e \<subseteq> op + a ` s" unfolding mem_interior by auto
15.3887 + hence "ball (x - a) e \<subseteq> s" unfolding subset_eq Ball_def mem_ball dist_norm apply auto apply(erule_tac x="a + xa" in allE) unfolding ab_group_add_class.diff_diff_eq[THEN sym] by auto
15.3888 + thus "x \<in> op + a ` interior s" unfolding image_iff apply(rule_tac x="x - a" in bexI) unfolding mem_interior using `e > 0` by auto
15.3889 +next
15.3890 + fix x assume "x \<in> op + a ` interior s"
15.3891 + then obtain y e where "e>0" and e:"ball y e \<subseteq> s" and y:"x = a + y" unfolding image_iff Bex_def mem_interior by auto
15.3892 + { fix z have *:"a + y - z = y + a - z" by auto
15.3893 + assume "z\<in>ball x e"
15.3894 + hence "z - a \<in> s" using e[unfolded subset_eq, THEN bspec[where x="z - a"]] unfolding mem_ball dist_norm y ab_group_add_class.diff_diff_eq2 * by auto
15.3895 + hence "z \<in> op + a ` s" unfolding image_iff by(auto intro!: bexI[where x="z - a"]) }
15.3896 + hence "ball x e \<subseteq> op + a ` s" unfolding subset_eq by auto
15.3897 + thus "x \<in> interior (op + a ` s)" unfolding mem_interior using `e>0` by auto
15.3898 +qed
15.3899 +
15.3900 +subsection {* Preservation of compactness and connectedness under continuous function. *}
15.3901 +
15.3902 +lemma compact_continuous_image:
15.3903 + assumes "continuous_on s f" "compact s"
15.3904 + shows "compact(f ` s)"
15.3905 +proof-
15.3906 + { fix x assume x:"\<forall>n::nat. x n \<in> f ` s"
15.3907 + then obtain y where y:"\<forall>n. y n \<in> s \<and> x n = f (y n)" unfolding image_iff Bex_def using choice[of "\<lambda>n xa. xa \<in> s \<and> x n = f xa"] by auto
15.3908 + then obtain l r where "l\<in>s" and r:"subseq r" and lr:"((y \<circ> r) ---> l) sequentially" using assms(2)[unfolded compact_def, THEN spec[where x=y]] by auto
15.3909 + { fix e::real assume "e>0"
15.3910 + then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' l < d \<longrightarrow> dist (f x') (f l) < e" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=l], OF `l\<in>s`] by auto
15.3911 + then obtain N::nat where N:"\<forall>n\<ge>N. dist ((y \<circ> r) n) l < d" using lr[unfolded Lim_sequentially, THEN spec[where x=d]] by auto
15.3912 + { fix n::nat assume "n\<ge>N" hence "dist ((x \<circ> r) n) (f l) < e" using N[THEN spec[where x=n]] d[THEN bspec[where x="y (r n)"]] y[THEN spec[where x="r n"]] by auto }
15.3913 + hence "\<exists>N. \<forall>n\<ge>N. dist ((x \<circ> r) n) (f l) < e" by auto }
15.3914 + hence "\<exists>l\<in>f ` s. \<exists>r. subseq r \<and> ((x \<circ> r) ---> l) sequentially" unfolding Lim_sequentially using r lr `l\<in>s` by auto }
15.3915 + thus ?thesis unfolding compact_def by auto
15.3916 +qed
15.3917 +
15.3918 +lemma connected_continuous_image:
15.3919 + assumes "continuous_on s f" "connected s"
15.3920 + shows "connected(f ` s)"
15.3921 +proof-
15.3922 + { fix T assume as: "T \<noteq> {}" "T \<noteq> f ` s" "openin (subtopology euclidean (f ` s)) T" "closedin (subtopology euclidean (f ` s)) T"
15.3923 + have "{x \<in> s. f x \<in> T} = {} \<or> {x \<in> s. f x \<in> T} = s"
15.3924 + using assms(1)[unfolded continuous_on_open, THEN spec[where x=T]]
15.3925 + using assms(1)[unfolded continuous_on_closed, THEN spec[where x=T]]
15.3926 + using assms(2)[unfolded connected_clopen, THEN spec[where x="{x \<in> s. f x \<in> T}"]] as(3,4) by auto
15.3927 + hence False using as(1,2)
15.3928 + using as(4)[unfolded closedin_def topspace_euclidean_subtopology] by auto }
15.3929 + thus ?thesis unfolding connected_clopen by auto
15.3930 +qed
15.3931 +
15.3932 +text{* Continuity implies uniform continuity on a compact domain. *}
15.3933 +
15.3934 +lemma compact_uniformly_continuous:
15.3935 + assumes "continuous_on s f" "compact s"
15.3936 + shows "uniformly_continuous_on s f"
15.3937 +proof-
15.3938 + { fix x assume x:"x\<in>s"
15.3939 + hence "\<forall>xa. \<exists>y. 0 < xa \<longrightarrow> (y > 0 \<and> (\<forall>x'\<in>s. dist x' x < y \<longrightarrow> dist (f x') (f x) < xa))" using assms(1)[unfolded continuous_on_def, THEN bspec[where x=x]] by auto
15.3940 + hence "\<exists>fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)" using choice[of "\<lambda>e d. e>0 \<longrightarrow> d>0 \<and>(\<forall>x'\<in>s. (dist x' x < d \<longrightarrow> dist (f x') (f x) < e))"] by auto }
15.3941 + then have "\<forall>x\<in>s. \<exists>y. \<forall>xa. 0 < xa \<longrightarrow> (\<forall>x'\<in>s. y xa > 0 \<and> (dist x' x < y xa \<longrightarrow> dist (f x') (f x) < xa))" by auto
15.3942 + then obtain d where d:"\<forall>e>0. \<forall>x\<in>s. \<forall>x'\<in>s. d x e > 0 \<and> (dist x' x < d x e \<longrightarrow> dist (f x') (f x) < e)"
15.3943 + using bchoice[of s "\<lambda>x fa. \<forall>xa>0. \<forall>x'\<in>s. fa xa > 0 \<and> (dist x' x < fa xa \<longrightarrow> dist (f x') (f x) < xa)"] by blast
15.3944 +
15.3945 + { fix e::real assume "e>0"
15.3946 +
15.3947 + { fix x assume "x\<in>s" hence "x \<in> ball x (d x (e / 2))" unfolding centre_in_ball using d[THEN spec[where x="e/2"]] using `e>0` by auto }
15.3948 + hence "s \<subseteq> \<Union>{ball x (d x (e / 2)) |x. x \<in> s}" unfolding subset_eq by auto
15.3949 + moreover
15.3950 + { fix b assume "b\<in>{ball x (d x (e / 2)) |x. x \<in> s}" hence "open b" by auto }
15.3951 + ultimately obtain ea where "ea>0" and ea:"\<forall>x\<in>s. \<exists>b\<in>{ball x (d x (e / 2)) |x. x \<in> s}. ball x ea \<subseteq> b" using heine_borel_lemma[OF assms(2), of "{ball x (d x (e / 2)) | x. x\<in>s }"] by auto
15.3952 +
15.3953 + { fix x y assume "x\<in>s" "y\<in>s" and as:"dist y x < ea"
15.3954 + obtain z where "z\<in>s" and z:"ball x ea \<subseteq> ball z (d z (e / 2))" using ea[THEN bspec[where x=x]] and `x\<in>s` by auto
15.3955 + hence "x\<in>ball z (d z (e / 2))" using `ea>0` unfolding subset_eq by auto
15.3956 + hence "dist (f z) (f x) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `x\<in>s` and `z\<in>s`
15.3957 + by (auto simp add: dist_commute)
15.3958 + moreover have "y\<in>ball z (d z (e / 2))" using as and `ea>0` and z[unfolded subset_eq]
15.3959 + by (auto simp add: dist_commute)
15.3960 + hence "dist (f z) (f y) < e / 2" using d[THEN spec[where x="e/2"]] and `e>0` and `y\<in>s` and `z\<in>s`
15.3961 + by (auto simp add: dist_commute)
15.3962 + ultimately have "dist (f y) (f x) < e" using dist_triangle_half_r[of "f z" "f x" e "f y"]
15.3963 + by (auto simp add: dist_commute) }
15.3964 + then have "\<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e" using `ea>0` by auto }
15.3965 + thus ?thesis unfolding uniformly_continuous_on_def by auto
15.3966 +qed
15.3967 +
15.3968 +text{* Continuity of inverse function on compact domain. *}
15.3969 +
15.3970 +lemma continuous_on_inverse:
15.3971 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
15.3972 + (* TODO: can this be generalized more? *)
15.3973 + assumes "continuous_on s f" "compact s" "\<forall>x \<in> s. g (f x) = x"
15.3974 + shows "continuous_on (f ` s) g"
15.3975 +proof-
15.3976 + have *:"g ` f ` s = s" using assms(3) by (auto simp add: image_iff)
15.3977 + { fix t assume t:"closedin (subtopology euclidean (g ` f ` s)) t"
15.3978 + then obtain T where T: "closed T" "t = s \<inter> T" unfolding closedin_closed unfolding * by auto
15.3979 + have "continuous_on (s \<inter> T) f" using continuous_on_subset[OF assms(1), of "s \<inter> t"]
15.3980 + unfolding T(2) and Int_left_absorb by auto
15.3981 + moreover have "compact (s \<inter> T)"
15.3982 + using assms(2) unfolding compact_eq_bounded_closed
15.3983 + using bounded_subset[of s "s \<inter> T"] and T(1) by auto
15.3984 + ultimately have "closed (f ` t)" using T(1) unfolding T(2)
15.3985 + using compact_continuous_image [of "s \<inter> T" f] unfolding compact_eq_bounded_closed by auto
15.3986 + moreover have "{x \<in> f ` s. g x \<in> t} = f ` s \<inter> f ` t" using assms(3) unfolding T(2) by auto
15.3987 + ultimately have "closedin (subtopology euclidean (f ` s)) {x \<in> f ` s. g x \<in> t}"
15.3988 + unfolding closedin_closed by auto }
15.3989 + thus ?thesis unfolding continuous_on_closed by auto
15.3990 +qed
15.3991 +
15.3992 +subsection{* A uniformly convergent limit of continuous functions is continuous. *}
15.3993 +
15.3994 +lemma norm_triangle_lt:
15.3995 + fixes x y :: "'a::real_normed_vector"
15.3996 + shows "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
15.3997 +by (rule le_less_trans [OF norm_triangle_ineq])
15.3998 +
15.3999 +lemma continuous_uniform_limit:
15.4000 + fixes f :: "'a \<Rightarrow> 'b::metric_space \<Rightarrow> 'c::real_normed_vector"
15.4001 + assumes "\<not> (trivial_limit net)" "eventually (\<lambda>n. continuous_on s (f n)) net"
15.4002 + "\<forall>e>0. eventually (\<lambda>n. \<forall>x \<in> s. norm(f n x - g x) < e) net"
15.4003 + shows "continuous_on s g"
15.4004 +proof-
15.4005 + { fix x and e::real assume "x\<in>s" "e>0"
15.4006 + have "eventually (\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3) net" using `e>0` assms(3)[THEN spec[where x="e/3"]] by auto
15.4007 + then obtain n where n:"\<forall>xa\<in>s. norm (f n xa - g xa) < e / 3" "continuous_on s (f n)"
15.4008 + using eventually_and[of "(\<lambda>n. \<forall>x\<in>s. norm (f n x - g x) < e / 3)" "(\<lambda>n. continuous_on s (f n))" net] assms(1,2) eventually_happens by blast
15.4009 + have "e / 3 > 0" using `e>0` by auto
15.4010 + then obtain d where "d>0" and d:"\<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f n x') (f n x) < e / 3"
15.4011 + using n(2)[unfolded continuous_on_def, THEN bspec[where x=x], OF `x\<in>s`, THEN spec[where x="e/3"]] by blast
15.4012 + { fix y assume "y\<in>s" "dist y x < d"
15.4013 + hence "dist (f n y) (f n x) < e / 3" using d[THEN bspec[where x=y]] by auto
15.4014 + hence "norm (f n y - g x) < 2 * e / 3" using norm_triangle_lt[of "f n y - f n x" "f n x - g x" "2*e/3"]
15.4015 + using n(1)[THEN bspec[where x=x], OF `x\<in>s`] unfolding dist_norm unfolding ab_group_add_class.ab_diff_minus by auto
15.4016 + hence "dist (g y) (g x) < e" unfolding dist_norm using n(1)[THEN bspec[where x=y], OF `y\<in>s`]
15.4017 + unfolding norm_minus_cancel[of "f n y - g y", THEN sym] using norm_triangle_lt[of "f n y - g x" "g y - f n y" e] by (auto simp add: uminus_add_conv_diff) }
15.4018 + hence "\<exists>d>0. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (g x') (g x) < e" using `d>0` by auto }
15.4019 + thus ?thesis unfolding continuous_on_def by auto
15.4020 +qed
15.4021 +
15.4022 +subsection{* Topological properties of linear functions. *}
15.4023 +
15.4024 +lemma linear_lim_0:
15.4025 + assumes "bounded_linear f" shows "(f ---> 0) (at (0))"
15.4026 +proof-
15.4027 + interpret f: bounded_linear f by fact
15.4028 + have "(f ---> f 0) (at 0)"
15.4029 + using tendsto_ident_at by (rule f.tendsto)
15.4030 + thus ?thesis unfolding f.zero .
15.4031 +qed
15.4032 +
15.4033 +lemma linear_continuous_at:
15.4034 + assumes "bounded_linear f" shows "continuous (at a) f"
15.4035 + unfolding continuous_at using assms
15.4036 + apply (rule bounded_linear.tendsto)
15.4037 + apply (rule tendsto_ident_at)
15.4038 + done
15.4039 +
15.4040 +lemma linear_continuous_within:
15.4041 + shows "bounded_linear f ==> continuous (at x within s) f"
15.4042 + using continuous_at_imp_continuous_within[of x f s] using linear_continuous_at[of f] by auto
15.4043 +
15.4044 +lemma linear_continuous_on:
15.4045 + shows "bounded_linear f ==> continuous_on s f"
15.4046 + using continuous_at_imp_continuous_on[of s f] using linear_continuous_at[of f] by auto
15.4047 +
15.4048 +text{* Also bilinear functions, in composition form. *}
15.4049 +
15.4050 +lemma bilinear_continuous_at_compose:
15.4051 + shows "continuous (at x) f \<Longrightarrow> continuous (at x) g \<Longrightarrow> bounded_bilinear h
15.4052 + ==> continuous (at x) (\<lambda>x. h (f x) (g x))"
15.4053 + unfolding continuous_at using Lim_bilinear[of f "f x" "(at x)" g "g x" h] by auto
15.4054 +
15.4055 +lemma bilinear_continuous_within_compose:
15.4056 + shows "continuous (at x within s) f \<Longrightarrow> continuous (at x within s) g \<Longrightarrow> bounded_bilinear h
15.4057 + ==> continuous (at x within s) (\<lambda>x. h (f x) (g x))"
15.4058 + unfolding continuous_within using Lim_bilinear[of f "f x"] by auto
15.4059 +
15.4060 +lemma bilinear_continuous_on_compose:
15.4061 + shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> bounded_bilinear h
15.4062 + ==> continuous_on s (\<lambda>x. h (f x) (g x))"
15.4063 + unfolding continuous_on_eq_continuous_within apply auto apply(erule_tac x=x in ballE) apply auto apply(erule_tac x=x in ballE) apply auto
15.4064 + using bilinear_continuous_within_compose[of _ s f g h] by auto
15.4065 +
15.4066 +subsection{* Topological stuff lifted from and dropped to R *}
15.4067 +
15.4068 +
15.4069 +lemma open_real:
15.4070 + fixes s :: "real set" shows
15.4071 + "open s \<longleftrightarrow>
15.4072 + (\<forall>x \<in> s. \<exists>e>0. \<forall>x'. abs(x' - x) < e --> x' \<in> s)" (is "?lhs = ?rhs")
15.4073 + unfolding open_dist dist_norm by simp
15.4074 +
15.4075 +lemma islimpt_approachable_real:
15.4076 + fixes s :: "real set"
15.4077 + shows "x islimpt s \<longleftrightarrow> (\<forall>e>0. \<exists>x'\<in> s. x' \<noteq> x \<and> abs(x' - x) < e)"
15.4078 + unfolding islimpt_approachable dist_norm by simp
15.4079 +
15.4080 +lemma closed_real:
15.4081 + fixes s :: "real set"
15.4082 + shows "closed s \<longleftrightarrow>
15.4083 + (\<forall>x. (\<forall>e>0. \<exists>x' \<in> s. x' \<noteq> x \<and> abs(x' - x) < e)
15.4084 + --> x \<in> s)"
15.4085 + unfolding closed_limpt islimpt_approachable dist_norm by simp
15.4086 +
15.4087 +lemma continuous_at_real_range:
15.4088 + fixes f :: "'a::real_normed_vector \<Rightarrow> real"
15.4089 + shows "continuous (at x) f \<longleftrightarrow> (\<forall>e>0. \<exists>d>0.
15.4090 + \<forall>x'. norm(x' - x) < d --> abs(f x' - f x) < e)"
15.4091 + unfolding continuous_at unfolding Lim_at
15.4092 + unfolding dist_nz[THEN sym] unfolding dist_norm apply auto
15.4093 + apply(erule_tac x=e in allE) apply auto apply (rule_tac x=d in exI) apply auto apply (erule_tac x=x' in allE) apply auto
15.4094 + apply(erule_tac x=e in allE) by auto
15.4095 +
15.4096 +lemma continuous_on_real_range:
15.4097 + fixes f :: "'a::real_normed_vector \<Rightarrow> real"
15.4098 + shows "continuous_on s f \<longleftrightarrow> (\<forall>x \<in> s. \<forall>e>0. \<exists>d>0. (\<forall>x' \<in> s. norm(x' - x) < d --> abs(f x' - f x) < e))"
15.4099 + unfolding continuous_on_def dist_norm by simp
15.4100 +
15.4101 +lemma continuous_at_norm: "continuous (at x) norm"
15.4102 + unfolding continuous_at by (intro tendsto_intros)
15.4103 +
15.4104 +lemma continuous_on_norm: "continuous_on s norm"
15.4105 +unfolding continuous_on by (intro ballI tendsto_intros)
15.4106 +
15.4107 +lemma continuous_at_component: "continuous (at a) (\<lambda>x. x $ i)"
15.4108 +unfolding continuous_at by (intro tendsto_intros)
15.4109 +
15.4110 +lemma continuous_on_component: "continuous_on s (\<lambda>x. x $ i)"
15.4111 +unfolding continuous_on by (intro ballI tendsto_intros)
15.4112 +
15.4113 +lemma continuous_at_infnorm: "continuous (at x) infnorm"
15.4114 + unfolding continuous_at Lim_at o_def unfolding dist_norm
15.4115 + apply auto apply (rule_tac x=e in exI) apply auto
15.4116 + using order_trans[OF real_abs_sub_infnorm infnorm_le_norm, of _ x] by (metis xt1(7))
15.4117 +
15.4118 +text{* Hence some handy theorems on distance, diameter etc. of/from a set. *}
15.4119 +
15.4120 +lemma compact_attains_sup:
15.4121 + fixes s :: "real set"
15.4122 + assumes "compact s" "s \<noteq> {}"
15.4123 + shows "\<exists>x \<in> s. \<forall>y \<in> s. y \<le> x"
15.4124 +proof-
15.4125 + from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
15.4126 + { fix e::real assume as: "\<forall>x\<in>s. x \<le> rsup s" "rsup s \<notin> s" "0 < e" "\<forall>x'\<in>s. x' = rsup s \<or> \<not> rsup s - x' < e"
15.4127 + have "isLub UNIV s (rsup s)" using rsup[OF assms(2)] unfolding setle_def using as(1) by auto
15.4128 + moreover have "isUb UNIV s (rsup s - e)" unfolding isUb_def unfolding setle_def using as(4,2) by auto
15.4129 + ultimately have False using isLub_le_isUb[of UNIV s "rsup s" "rsup s - e"] using `e>0` by auto }
15.4130 + thus ?thesis using bounded_has_rsup(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rsup s"]]
15.4131 + apply(rule_tac x="rsup s" in bexI) by auto
15.4132 +qed
15.4133 +
15.4134 +lemma compact_attains_inf:
15.4135 + fixes s :: "real set"
15.4136 + assumes "compact s" "s \<noteq> {}" shows "\<exists>x \<in> s. \<forall>y \<in> s. x \<le> y"
15.4137 +proof-
15.4138 + from assms(1) have a:"bounded s" "closed s" unfolding compact_eq_bounded_closed by auto
15.4139 + { fix e::real assume as: "\<forall>x\<in>s. x \<ge> rinf s" "rinf s \<notin> s" "0 < e"
15.4140 + "\<forall>x'\<in>s. x' = rinf s \<or> \<not> abs (x' - rinf s) < e"
15.4141 + have "isGlb UNIV s (rinf s)" using rinf[OF assms(2)] unfolding setge_def using as(1) by auto
15.4142 + moreover
15.4143 + { fix x assume "x \<in> s"
15.4144 + hence *:"abs (x - rinf s) = x - rinf s" using as(1)[THEN bspec[where x=x]] by auto
15.4145 + have "rinf s + e \<le> x" using as(4)[THEN bspec[where x=x]] using as(2) `x\<in>s` unfolding * by auto }
15.4146 + hence "isLb UNIV s (rinf s + e)" unfolding isLb_def and setge_def by auto
15.4147 + ultimately have False using isGlb_le_isLb[of UNIV s "rinf s" "rinf s + e"] using `e>0` by auto }
15.4148 + thus ?thesis using bounded_has_rinf(1)[OF a(1) assms(2)] using a(2)[unfolded closed_real, THEN spec[where x="rinf s"]]
15.4149 + apply(rule_tac x="rinf s" in bexI) by auto
15.4150 +qed
15.4151 +
15.4152 +lemma continuous_attains_sup:
15.4153 + fixes f :: "'a::metric_space \<Rightarrow> real"
15.4154 + shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
15.4155 + ==> (\<exists>x \<in> s. \<forall>y \<in> s. f y \<le> f x)"
15.4156 + using compact_attains_sup[of "f ` s"]
15.4157 + using compact_continuous_image[of s f] by auto
15.4158 +
15.4159 +lemma continuous_attains_inf:
15.4160 + fixes f :: "'a::metric_space \<Rightarrow> real"
15.4161 + shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f
15.4162 + \<Longrightarrow> (\<exists>x \<in> s. \<forall>y \<in> s. f x \<le> f y)"
15.4163 + using compact_attains_inf[of "f ` s"]
15.4164 + using compact_continuous_image[of s f] by auto
15.4165 +
15.4166 +lemma distance_attains_sup:
15.4167 + assumes "compact s" "s \<noteq> {}"
15.4168 + shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a y \<le> dist a x"
15.4169 +proof (rule continuous_attains_sup [OF assms])
15.4170 + { fix x assume "x\<in>s"
15.4171 + have "(dist a ---> dist a x) (at x within s)"
15.4172 + by (intro tendsto_dist tendsto_const Lim_at_within Lim_ident_at)
15.4173 + }
15.4174 + thus "continuous_on s (dist a)"
15.4175 + unfolding continuous_on ..
15.4176 +qed
15.4177 +
15.4178 +text{* For *minimal* distance, we only need closure, not compactness. *}
15.4179 +
15.4180 +lemma distance_attains_inf:
15.4181 + fixes a :: "'a::heine_borel"
15.4182 + assumes "closed s" "s \<noteq> {}"
15.4183 + shows "\<exists>x \<in> s. \<forall>y \<in> s. dist a x \<le> dist a y"
15.4184 +proof-
15.4185 + from assms(2) obtain b where "b\<in>s" by auto
15.4186 + let ?B = "cball a (dist b a) \<inter> s"
15.4187 + have "b \<in> ?B" using `b\<in>s` by (simp add: dist_commute)
15.4188 + hence "?B \<noteq> {}" by auto
15.4189 + moreover
15.4190 + { fix x assume "x\<in>?B"
15.4191 + fix e::real assume "e>0"
15.4192 + { fix x' assume "x'\<in>?B" and as:"dist x' x < e"
15.4193 + from as have "\<bar>dist a x' - dist a x\<bar> < e"
15.4194 + unfolding abs_less_iff minus_diff_eq
15.4195 + using dist_triangle2 [of a x' x]
15.4196 + using dist_triangle [of a x x']
15.4197 + by arith
15.4198 + }
15.4199 + hence "\<exists>d>0. \<forall>x'\<in>?B. dist x' x < d \<longrightarrow> \<bar>dist a x' - dist a x\<bar> < e"
15.4200 + using `e>0` by auto
15.4201 + }
15.4202 + hence "continuous_on (cball a (dist b a) \<inter> s) (dist a)"
15.4203 + unfolding continuous_on Lim_within dist_norm real_norm_def
15.4204 + by fast
15.4205 + moreover have "compact ?B"
15.4206 + using compact_cball[of a "dist b a"]
15.4207 + unfolding compact_eq_bounded_closed
15.4208 + using bounded_Int and closed_Int and assms(1) by auto
15.4209 + ultimately obtain x where "x\<in>cball a (dist b a) \<inter> s" "\<forall>y\<in>cball a (dist b a) \<inter> s. dist a x \<le> dist a y"
15.4210 + using continuous_attains_inf[of ?B "dist a"] by fastsimp
15.4211 + thus ?thesis by fastsimp
15.4212 +qed
15.4213 +
15.4214 +subsection{* We can now extend limit compositions to consider the scalar multiplier. *}
15.4215 +
15.4216 +lemma Lim_mul:
15.4217 + fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
15.4218 + assumes "(c ---> d) net" "(f ---> l) net"
15.4219 + shows "((\<lambda>x. c(x) *\<^sub>R f x) ---> (d *\<^sub>R l)) net"
15.4220 + using assms by (rule scaleR.tendsto)
15.4221 +
15.4222 +lemma Lim_vmul:
15.4223 + fixes c :: "'a \<Rightarrow> real" and v :: "'b::real_normed_vector"
15.4224 + shows "(c ---> d) net ==> ((\<lambda>x. c(x) *\<^sub>R v) ---> d *\<^sub>R v) net"
15.4225 + by (intro tendsto_intros)
15.4226 +
15.4227 +lemma continuous_vmul:
15.4228 + fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
15.4229 + shows "continuous net c ==> continuous net (\<lambda>x. c(x) *\<^sub>R v)"
15.4230 + unfolding continuous_def using Lim_vmul[of c] by auto
15.4231 +
15.4232 +lemma continuous_mul:
15.4233 + fixes c :: "'a::metric_space \<Rightarrow> real"
15.4234 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.4235 + shows "continuous net c \<Longrightarrow> continuous net f
15.4236 + ==> continuous net (\<lambda>x. c(x) *\<^sub>R f x) "
15.4237 + unfolding continuous_def by (intro tendsto_intros)
15.4238 +
15.4239 +lemma continuous_on_vmul:
15.4240 + fixes c :: "'a::metric_space \<Rightarrow> real" and v :: "'b::real_normed_vector"
15.4241 + shows "continuous_on s c ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R v)"
15.4242 + unfolding continuous_on_eq_continuous_within using continuous_vmul[of _ c] by auto
15.4243 +
15.4244 +lemma continuous_on_mul:
15.4245 + fixes c :: "'a::metric_space \<Rightarrow> real"
15.4246 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
15.4247 + shows "continuous_on s c \<Longrightarrow> continuous_on s f
15.4248 + ==> continuous_on s (\<lambda>x. c(x) *\<^sub>R f x)"
15.4249 + unfolding continuous_on_eq_continuous_within using continuous_mul[of _ c] by auto
15.4250 +
15.4251 +text{* And so we have continuity of inverse. *}
15.4252 +
15.4253 +lemma Lim_inv:
15.4254 + fixes f :: "'a \<Rightarrow> real"
15.4255 + assumes "(f ---> l) (net::'a net)" "l \<noteq> 0"
15.4256 + shows "((inverse o f) ---> inverse l) net"
15.4257 + unfolding o_def using assms by (rule tendsto_inverse)
15.4258 +
15.4259 +lemma continuous_inv:
15.4260 + fixes f :: "'a::metric_space \<Rightarrow> real"
15.4261 + shows "continuous net f \<Longrightarrow> f(netlimit net) \<noteq> 0
15.4262 + ==> continuous net (inverse o f)"
15.4263 + unfolding continuous_def using Lim_inv by auto
15.4264 +
15.4265 +lemma continuous_at_within_inv:
15.4266 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
15.4267 + assumes "continuous (at a within s) f" "f a \<noteq> 0"
15.4268 + shows "continuous (at a within s) (inverse o f)"
15.4269 + using assms unfolding continuous_within o_def
15.4270 + by (intro tendsto_intros)
15.4271 +
15.4272 +lemma continuous_at_inv:
15.4273 + fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_field"
15.4274 + shows "continuous (at a) f \<Longrightarrow> f a \<noteq> 0
15.4275 + ==> continuous (at a) (inverse o f) "
15.4276 + using within_UNIV[THEN sym, of "at a"] using continuous_at_within_inv[of a UNIV] by auto
15.4277 +
15.4278 +subsection{* Preservation properties for pasted sets. *}
15.4279 +
15.4280 +lemma bounded_pastecart:
15.4281 + fixes s :: "('a::real_normed_vector ^ _) set" (* FIXME: generalize to metric_space *)
15.4282 + assumes "bounded s" "bounded t"
15.4283 + shows "bounded { pastecart x y | x y . (x \<in> s \<and> y \<in> t)}"
15.4284 +proof-
15.4285 + obtain a b where ab:"\<forall>x\<in>s. norm x \<le> a" "\<forall>x\<in>t. norm x \<le> b" using assms[unfolded bounded_iff] by auto
15.4286 + { fix x y assume "x\<in>s" "y\<in>t"
15.4287 + hence "norm x \<le> a" "norm y \<le> b" using ab by auto
15.4288 + hence "norm (pastecart x y) \<le> a + b" using norm_pastecart[of x y] by auto }
15.4289 + thus ?thesis unfolding bounded_iff by auto
15.4290 +qed
15.4291 +
15.4292 +lemma bounded_Times:
15.4293 + assumes "bounded s" "bounded t" shows "bounded (s \<times> t)"
15.4294 +proof-
15.4295 + obtain x y a b where "\<forall>z\<in>s. dist x z \<le> a" "\<forall>z\<in>t. dist y z \<le> b"
15.4296 + using assms [unfolded bounded_def] by auto
15.4297 + then have "\<forall>z\<in>s \<times> t. dist (x, y) z \<le> sqrt (a\<twosuperior> + b\<twosuperior>)"
15.4298 + by (auto simp add: dist_Pair_Pair real_sqrt_le_mono add_mono power_mono)
15.4299 + thus ?thesis unfolding bounded_any_center [where a="(x, y)"] by auto
15.4300 +qed
15.4301 +
15.4302 +lemma closed_pastecart:
15.4303 + fixes s :: "(real ^ 'a::finite) set" (* FIXME: generalize *)
15.4304 + assumes "closed s" "closed t"
15.4305 + shows "closed {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
15.4306 +proof-
15.4307 + { fix x l assume as:"\<forall>n::nat. x n \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" "(x ---> l) sequentially"
15.4308 + { fix n::nat have "fstcart (x n) \<in> s" "sndcart (x n) \<in> t" using as(1)[THEN spec[where x=n]] by auto } note * = this
15.4309 + moreover
15.4310 + { fix e::real assume "e>0"
15.4311 + then obtain N::nat where N:"\<forall>n\<ge>N. dist (x n) l < e" using as(2)[unfolded Lim_sequentially, THEN spec[where x=e]] by auto
15.4312 + { fix n::nat assume "n\<ge>N"
15.4313 + hence "dist (fstcart (x n)) (fstcart l) < e" "dist (sndcart (x n)) (sndcart l) < e"
15.4314 + using N[THEN spec[where x=n]] dist_fstcart[of "x n" l] dist_sndcart[of "x n" l] by auto }
15.4315 + hence "\<exists>N. \<forall>n\<ge>N. dist (fstcart (x n)) (fstcart l) < e" "\<exists>N. \<forall>n\<ge>N. dist (sndcart (x n)) (sndcart l) < e" by auto }
15.4316 + ultimately have "fstcart l \<in> s" "sndcart l \<in> t"
15.4317 + using assms(1)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. fstcart (x n)"], THEN spec[where x="fstcart l"]]
15.4318 + using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. sndcart (x n)"], THEN spec[where x="sndcart l"]]
15.4319 + unfolding Lim_sequentially by auto
15.4320 + hence "l \<in> {pastecart x y |x y. x \<in> s \<and> y \<in> t}" using pastecart_fst_snd[THEN sym, of l] by auto }
15.4321 + thus ?thesis unfolding closed_sequential_limits by auto
15.4322 +qed
15.4323 +
15.4324 +lemma compact_pastecart:
15.4325 + fixes s t :: "(real ^ _) set"
15.4326 + shows "compact s \<Longrightarrow> compact t ==> compact {pastecart x y | x y . x \<in> s \<and> y \<in> t}"
15.4327 + unfolding compact_eq_bounded_closed using bounded_pastecart[of s t] closed_pastecart[of s t] by auto
15.4328 +
15.4329 +lemma mem_Times_iff: "x \<in> A \<times> B \<longleftrightarrow> fst x \<in> A \<and> snd x \<in> B"
15.4330 +by (induct x) simp
15.4331 +
15.4332 +lemma compact_Times: "compact s \<Longrightarrow> compact t \<Longrightarrow> compact (s \<times> t)"
15.4333 +unfolding compact_def
15.4334 +apply clarify
15.4335 +apply (drule_tac x="fst \<circ> f" in spec)
15.4336 +apply (drule mp, simp add: mem_Times_iff)
15.4337 +apply (clarify, rename_tac l1 r1)
15.4338 +apply (drule_tac x="snd \<circ> f \<circ> r1" in spec)
15.4339 +apply (drule mp, simp add: mem_Times_iff)
15.4340 +apply (clarify, rename_tac l2 r2)
15.4341 +apply (rule_tac x="(l1, l2)" in rev_bexI, simp)
15.4342 +apply (rule_tac x="r1 \<circ> r2" in exI)
15.4343 +apply (rule conjI, simp add: subseq_def)
15.4344 +apply (drule_tac r=r2 in lim_subseq [COMP swap_prems_rl], assumption)
15.4345 +apply (drule (1) tendsto_Pair) back
15.4346 +apply (simp add: o_def)
15.4347 +done
15.4348 +
15.4349 +text{* Hence some useful properties follow quite easily. *}
15.4350 +
15.4351 +lemma compact_scaling:
15.4352 + fixes s :: "'a::real_normed_vector set"
15.4353 + assumes "compact s" shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
15.4354 +proof-
15.4355 + let ?f = "\<lambda>x. scaleR c x"
15.4356 + have *:"bounded_linear ?f" by (rule scaleR.bounded_linear_right)
15.4357 + show ?thesis using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
15.4358 + using linear_continuous_at[OF *] assms by auto
15.4359 +qed
15.4360 +
15.4361 +lemma compact_negations:
15.4362 + fixes s :: "'a::real_normed_vector set"
15.4363 + assumes "compact s" shows "compact ((\<lambda>x. -x) ` s)"
15.4364 + using compact_scaling [OF assms, of "- 1"] by auto
15.4365 +
15.4366 +lemma compact_sums:
15.4367 + fixes s t :: "'a::real_normed_vector set"
15.4368 + assumes "compact s" "compact t" shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
15.4369 +proof-
15.4370 + have *:"{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
15.4371 + apply auto unfolding image_iff apply(rule_tac x="(xa, y)" in bexI) by auto
15.4372 + have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
15.4373 + unfolding continuous_on by (rule ballI) (intro tendsto_intros)
15.4374 + thus ?thesis unfolding * using compact_continuous_image compact_Times [OF assms] by auto
15.4375 +qed
15.4376 +
15.4377 +lemma compact_differences:
15.4378 + fixes s t :: "'a::real_normed_vector set"
15.4379 + assumes "compact s" "compact t" shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
15.4380 +proof-
15.4381 + have "{x - y | x y. x\<in>s \<and> y \<in> t} = {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
15.4382 + apply auto apply(rule_tac x= xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
15.4383 + thus ?thesis using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
15.4384 +qed
15.4385 +
15.4386 +lemma compact_translation:
15.4387 + fixes s :: "'a::real_normed_vector set"
15.4388 + assumes "compact s" shows "compact ((\<lambda>x. a + x) ` s)"
15.4389 +proof-
15.4390 + have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s" by auto
15.4391 + thus ?thesis using compact_sums[OF assms compact_sing[of a]] by auto
15.4392 +qed
15.4393 +
15.4394 +lemma compact_affinity:
15.4395 + fixes s :: "'a::real_normed_vector set"
15.4396 + assumes "compact s" shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
15.4397 +proof-
15.4398 + have "op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
15.4399 + thus ?thesis using compact_translation[OF compact_scaling[OF assms], of a c] by auto
15.4400 +qed
15.4401 +
15.4402 +text{* Hence we get the following. *}
15.4403 +
15.4404 +lemma compact_sup_maxdistance:
15.4405 + fixes s :: "'a::real_normed_vector set"
15.4406 + assumes "compact s" "s \<noteq> {}"
15.4407 + shows "\<exists>x\<in>s. \<exists>y\<in>s. \<forall>u\<in>s. \<forall>v\<in>s. norm(u - v) \<le> norm(x - y)"
15.4408 +proof-
15.4409 + have "{x - y | x y . x\<in>s \<and> y\<in>s} \<noteq> {}" using `s \<noteq> {}` by auto
15.4410 + then obtain x where x:"x\<in>{x - y |x y. x \<in> s \<and> y \<in> s}" "\<forall>y\<in>{x - y |x y. x \<in> s \<and> y \<in> s}. norm y \<le> norm x"
15.4411 + using compact_differences[OF assms(1) assms(1)]
15.4412 + using distance_attains_sup[where 'a="'a", unfolded dist_norm, of "{x - y | x y . x\<in>s \<and> y\<in>s}" 0] by(auto simp add: norm_minus_cancel)
15.4413 + from x(1) obtain a b where "a\<in>s" "b\<in>s" "x = a - b" by auto
15.4414 + thus ?thesis using x(2)[unfolded `x = a - b`] by blast
15.4415 +qed
15.4416 +
15.4417 +text{* We can state this in terms of diameter of a set. *}
15.4418 +
15.4419 +definition "diameter s = (if s = {} then 0::real else rsup {norm(x - y) | x y. x \<in> s \<and> y \<in> s})"
15.4420 + (* TODO: generalize to class metric_space *)
15.4421 +
15.4422 +lemma diameter_bounded:
15.4423 + assumes "bounded s"
15.4424 + shows "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
15.4425 + "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)"
15.4426 +proof-
15.4427 + let ?D = "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}"
15.4428 + obtain a where a:"\<forall>x\<in>s. norm x \<le> a" using assms[unfolded bounded_iff] by auto
15.4429 + { fix x y assume "x \<in> s" "y \<in> s"
15.4430 + hence "norm (x - y) \<le> 2 * a" using norm_triangle_ineq[of x "-y", unfolded norm_minus_cancel] a[THEN bspec[where x=x]] a[THEN bspec[where x=y]] by (auto simp add: ring_simps) }
15.4431 + note * = this
15.4432 + { fix x y assume "x\<in>s" "y\<in>s" hence "s \<noteq> {}" by auto
15.4433 + have lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] using `s\<noteq>{}` unfolding setle_def by auto
15.4434 + have "norm(x - y) \<le> diameter s" unfolding diameter_def using `s\<noteq>{}` *[OF `x\<in>s` `y\<in>s`] `x\<in>s` `y\<in>s` isLubD1[OF lub] unfolding setle_def by auto }
15.4435 + moreover
15.4436 + { fix d::real assume "d>0" "d < diameter s"
15.4437 + hence "s\<noteq>{}" unfolding diameter_def by auto
15.4438 + hence lub:"isLub UNIV ?D (rsup ?D)" using * rsup[of ?D] unfolding setle_def by auto
15.4439 + have "\<exists>d' \<in> ?D. d' > d"
15.4440 + proof(rule ccontr)
15.4441 + assume "\<not> (\<exists>d'\<in>{norm (x - y) |x y. x \<in> s \<and> y \<in> s}. d < d')"
15.4442 + hence as:"\<forall>d'\<in>?D. d' \<le> d" apply auto apply(erule_tac x="norm (x - y)" in allE) by auto
15.4443 + hence "isUb UNIV ?D d" unfolding isUb_def unfolding setle_def by auto
15.4444 + thus False using `d < diameter s` `s\<noteq>{}` isLub_le_isUb[OF lub, of d] unfolding diameter_def by auto
15.4445 + qed
15.4446 + hence "\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d" by auto }
15.4447 + ultimately show "\<forall>x\<in>s. \<forall>y\<in>s. norm(x - y) \<le> diameter s"
15.4448 + "\<forall>d>0. d < diameter s --> (\<exists>x\<in>s. \<exists>y\<in>s. norm(x - y) > d)" by auto
15.4449 +qed
15.4450 +
15.4451 +lemma diameter_bounded_bound:
15.4452 + "bounded s \<Longrightarrow> x \<in> s \<Longrightarrow> y \<in> s ==> norm(x - y) \<le> diameter s"
15.4453 + using diameter_bounded by blast
15.4454 +
15.4455 +lemma diameter_compact_attained:
15.4456 + fixes s :: "'a::real_normed_vector set"
15.4457 + assumes "compact s" "s \<noteq> {}"
15.4458 + shows "\<exists>x\<in>s. \<exists>y\<in>s. (norm(x - y) = diameter s)"
15.4459 +proof-
15.4460 + have b:"bounded s" using assms(1) by (rule compact_imp_bounded)
15.4461 + then obtain x y where xys:"x\<in>s" "y\<in>s" and xy:"\<forall>u\<in>s. \<forall>v\<in>s. norm (u - v) \<le> norm (x - y)" using compact_sup_maxdistance[OF assms] by auto
15.4462 + hence "diameter s \<le> norm (x - y)" using rsup_le[of "{norm (x - y) |x y. x \<in> s \<and> y \<in> s}" "norm (x - y)"]
15.4463 + unfolding setle_def and diameter_def by auto
15.4464 + thus ?thesis using diameter_bounded(1)[OF b, THEN bspec[where x=x], THEN bspec[where x=y], OF xys] and xys by auto
15.4465 +qed
15.4466 +
15.4467 +text{* Related results with closure as the conclusion. *}
15.4468 +
15.4469 +lemma closed_scaling:
15.4470 + fixes s :: "'a::real_normed_vector set"
15.4471 + assumes "closed s" shows "closed ((\<lambda>x. c *\<^sub>R x) ` s)"
15.4472 +proof(cases "s={}")
15.4473 + case True thus ?thesis by auto
15.4474 +next
15.4475 + case False
15.4476 + show ?thesis
15.4477 + proof(cases "c=0")
15.4478 + have *:"(\<lambda>x. 0) ` s = {0}" using `s\<noteq>{}` by auto
15.4479 + case True thus ?thesis apply auto unfolding * using closed_sing by auto
15.4480 + next
15.4481 + case False
15.4482 + { fix x l assume as:"\<forall>n::nat. x n \<in> scaleR c ` s" "(x ---> l) sequentially"
15.4483 + { fix n::nat have "scaleR (1 / c) (x n) \<in> s"
15.4484 + using as(1)[THEN spec[where x=n]]
15.4485 + using `c\<noteq>0` by (auto simp add: vector_smult_assoc)
15.4486 + }
15.4487 + moreover
15.4488 + { fix e::real assume "e>0"
15.4489 + hence "0 < e *\<bar>c\<bar>" using `c\<noteq>0` mult_pos_pos[of e "abs c"] by auto
15.4490 + then obtain N where "\<forall>n\<ge>N. dist (x n) l < e * \<bar>c\<bar>"
15.4491 + using as(2)[unfolded Lim_sequentially, THEN spec[where x="e * abs c"]] by auto
15.4492 + hence "\<exists>N. \<forall>n\<ge>N. dist (scaleR (1 / c) (x n)) (scaleR (1 / c) l) < e"
15.4493 + unfolding dist_norm unfolding scaleR_right_diff_distrib[THEN sym]
15.4494 + using mult_imp_div_pos_less[of "abs c" _ e] `c\<noteq>0` by auto }
15.4495 + hence "((\<lambda>n. scaleR (1 / c) (x n)) ---> scaleR (1 / c) l) sequentially" unfolding Lim_sequentially by auto
15.4496 + ultimately have "l \<in> scaleR c ` s"
15.4497 + using assms[unfolded closed_sequential_limits, THEN spec[where x="\<lambda>n. scaleR (1/c) (x n)"], THEN spec[where x="scaleR (1/c) l"]]
15.4498 + unfolding image_iff using `c\<noteq>0` apply(rule_tac x="scaleR (1 / c) l" in bexI) by auto }
15.4499 + thus ?thesis unfolding closed_sequential_limits by fast
15.4500 + qed
15.4501 +qed
15.4502 +
15.4503 +lemma closed_negations:
15.4504 + fixes s :: "'a::real_normed_vector set"
15.4505 + assumes "closed s" shows "closed ((\<lambda>x. -x) ` s)"
15.4506 + using closed_scaling[OF assms, of "- 1"] by simp
15.4507 +
15.4508 +lemma compact_closed_sums:
15.4509 + fixes s :: "'a::real_normed_vector set"
15.4510 + assumes "compact s" "closed t" shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
15.4511 +proof-
15.4512 + let ?S = "{x + y |x y. x \<in> s \<and> y \<in> t}"
15.4513 + { fix x l assume as:"\<forall>n. x n \<in> ?S" "(x ---> l) sequentially"
15.4514 + from as(1) obtain f where f:"\<forall>n. x n = fst (f n) + snd (f n)" "\<forall>n. fst (f n) \<in> s" "\<forall>n. snd (f n) \<in> t"
15.4515 + using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> s \<and> snd y \<in> t"] by auto
15.4516 + obtain l' r where "l'\<in>s" and r:"subseq r" and lr:"(((\<lambda>n. fst (f n)) \<circ> r) ---> l') sequentially"
15.4517 + using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
15.4518 + have "((\<lambda>n. snd (f (r n))) ---> l - l') sequentially"
15.4519 + using Lim_sub[OF lim_subseq[OF r as(2)] lr] and f(1) unfolding o_def by auto
15.4520 + hence "l - l' \<in> t"
15.4521 + using assms(2)[unfolded closed_sequential_limits, THEN spec[where x="\<lambda> n. snd (f (r n))"], THEN spec[where x="l - l'"]]
15.4522 + using f(3) by auto
15.4523 + hence "l \<in> ?S" using `l' \<in> s` apply auto apply(rule_tac x=l' in exI) apply(rule_tac x="l - l'" in exI) by auto
15.4524 + }
15.4525 + thus ?thesis unfolding closed_sequential_limits by fast
15.4526 +qed
15.4527 +
15.4528 +lemma closed_compact_sums:
15.4529 + fixes s t :: "'a::real_normed_vector set"
15.4530 + assumes "closed s" "compact t"
15.4531 + shows "closed {x + y | x y. x \<in> s \<and> y \<in> t}"
15.4532 +proof-
15.4533 + have "{x + y |x y. x \<in> t \<and> y \<in> s} = {x + y |x y. x \<in> s \<and> y \<in> t}" apply auto
15.4534 + apply(rule_tac x=y in exI) apply auto apply(rule_tac x=y in exI) by auto
15.4535 + thus ?thesis using compact_closed_sums[OF assms(2,1)] by simp
15.4536 +qed
15.4537 +
15.4538 +lemma compact_closed_differences:
15.4539 + fixes s t :: "'a::real_normed_vector set"
15.4540 + assumes "compact s" "closed t"
15.4541 + shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
15.4542 +proof-
15.4543 + have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
15.4544 + apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
15.4545 + thus ?thesis using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
15.4546 +qed
15.4547 +
15.4548 +lemma closed_compact_differences:
15.4549 + fixes s t :: "'a::real_normed_vector set"
15.4550 + assumes "closed s" "compact t"
15.4551 + shows "closed {x - y | x y. x \<in> s \<and> y \<in> t}"
15.4552 +proof-
15.4553 + have "{x + y |x y. x \<in> s \<and> y \<in> uminus ` t} = {x - y |x y. x \<in> s \<and> y \<in> t}"
15.4554 + apply auto apply(rule_tac x=xa in exI) apply auto apply(rule_tac x=xa in exI) by auto
15.4555 + thus ?thesis using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
15.4556 +qed
15.4557 +
15.4558 +lemma closed_translation:
15.4559 + fixes a :: "'a::real_normed_vector"
15.4560 + assumes "closed s" shows "closed ((\<lambda>x. a + x) ` s)"
15.4561 +proof-
15.4562 + have "{a + y |y. y \<in> s} = (op + a ` s)" by auto
15.4563 + thus ?thesis using compact_closed_sums[OF compact_sing[of a] assms] by auto
15.4564 +qed
15.4565 +
15.4566 +lemma translation_UNIV:
15.4567 + fixes a :: "'a::ab_group_add" shows "range (\<lambda>x. a + x) = UNIV"
15.4568 + apply (auto simp add: image_iff) apply(rule_tac x="x - a" in exI) by auto
15.4569 +
15.4570 +lemma translation_diff:
15.4571 + fixes a :: "'a::ab_group_add"
15.4572 + shows "(\<lambda>x. a + x) ` (s - t) = ((\<lambda>x. a + x) ` s) - ((\<lambda>x. a + x) ` t)"
15.4573 + by auto
15.4574 +
15.4575 +lemma closure_translation:
15.4576 + fixes a :: "'a::real_normed_vector"
15.4577 + shows "closure ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (closure s)"
15.4578 +proof-
15.4579 + have *:"op + a ` (UNIV - s) = UNIV - op + a ` s"
15.4580 + apply auto unfolding image_iff apply(rule_tac x="x - a" in bexI) by auto
15.4581 + show ?thesis unfolding closure_interior translation_diff translation_UNIV
15.4582 + using interior_translation[of a "UNIV - s"] unfolding * by auto
15.4583 +qed
15.4584 +
15.4585 +lemma frontier_translation:
15.4586 + fixes a :: "'a::real_normed_vector"
15.4587 + shows "frontier((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (frontier s)"
15.4588 + unfolding frontier_def translation_diff interior_translation closure_translation by auto
15.4589 +
15.4590 +subsection{* Separation between points and sets. *}
15.4591 +
15.4592 +lemma separate_point_closed:
15.4593 + fixes s :: "'a::heine_borel set"
15.4594 + shows "closed s \<Longrightarrow> a \<notin> s ==> (\<exists>d>0. \<forall>x\<in>s. d \<le> dist a x)"
15.4595 +proof(cases "s = {}")
15.4596 + case True
15.4597 + thus ?thesis by(auto intro!: exI[where x=1])
15.4598 +next
15.4599 + case False
15.4600 + assume "closed s" "a \<notin> s"
15.4601 + then obtain x where "x\<in>s" "\<forall>y\<in>s. dist a x \<le> dist a y" using `s \<noteq> {}` distance_attains_inf [of s a] by blast
15.4602 + with `x\<in>s` show ?thesis using dist_pos_lt[of a x] and`a \<notin> s` by blast
15.4603 +qed
15.4604 +
15.4605 +lemma separate_compact_closed:
15.4606 + fixes s t :: "'a::{heine_borel, real_normed_vector} set"
15.4607 + (* TODO: does this generalize to heine_borel? *)
15.4608 + assumes "compact s" and "closed t" and "s \<inter> t = {}"
15.4609 + shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
15.4610 +proof-
15.4611 + have "0 \<notin> {x - y |x y. x \<in> s \<and> y \<in> t}" using assms(3) by auto
15.4612 + then obtain d where "d>0" and d:"\<forall>x\<in>{x - y |x y. x \<in> s \<and> y \<in> t}. d \<le> dist 0 x"
15.4613 + using separate_point_closed[OF compact_closed_differences[OF assms(1,2)], of 0] by auto
15.4614 + { fix x y assume "x\<in>s" "y\<in>t"
15.4615 + hence "x - y \<in> {x - y |x y. x \<in> s \<and> y \<in> t}" by auto
15.4616 + hence "d \<le> dist (x - y) 0" using d[THEN bspec[where x="x - y"]] using dist_commute
15.4617 + by (auto simp add: dist_commute)
15.4618 + hence "d \<le> dist x y" unfolding dist_norm by auto }
15.4619 + thus ?thesis using `d>0` by auto
15.4620 +qed
15.4621 +
15.4622 +lemma separate_closed_compact:
15.4623 + fixes s t :: "'a::{heine_borel, real_normed_vector} set"
15.4624 + assumes "closed s" and "compact t" and "s \<inter> t = {}"
15.4625 + shows "\<exists>d>0. \<forall>x\<in>s. \<forall>y\<in>t. d \<le> dist x y"
15.4626 +proof-
15.4627 + have *:"t \<inter> s = {}" using assms(3) by auto
15.4628 + show ?thesis using separate_compact_closed[OF assms(2,1) *]
15.4629 + apply auto apply(rule_tac x=d in exI) apply auto apply (erule_tac x=y in ballE)
15.4630 + by (auto simp add: dist_commute)
15.4631 +qed
15.4632 +
15.4633 +(* A cute way of denoting open and closed intervals using overloading. *)
15.4634 +
15.4635 +lemma interval: fixes a :: "'a::ord^'n::finite" shows
15.4636 + "{a <..< b} = {x::'a^'n. \<forall>i. a$i < x$i \<and> x$i < b$i}" and
15.4637 + "{a .. b} = {x::'a^'n. \<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i}"
15.4638 + by (auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
15.4639 +
15.4640 +lemma mem_interval: fixes a :: "'a::ord^'n::finite" shows
15.4641 + "x \<in> {a<..<b} \<longleftrightarrow> (\<forall>i. a$i < x$i \<and> x$i < b$i)"
15.4642 + "x \<in> {a .. b} \<longleftrightarrow> (\<forall>i. a$i \<le> x$i \<and> x$i \<le> b$i)"
15.4643 + using interval[of a b] by(auto simp add: expand_set_eq vector_less_def vector_less_eq_def)
15.4644 +
15.4645 +lemma mem_interval_1: fixes x :: "real^1" shows
15.4646 + "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b)"
15.4647 + "(x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
15.4648 +by(simp_all add: Cart_eq vector_less_def vector_less_eq_def dest_vec1_def forall_1)
15.4649 +
15.4650 +lemma interval_eq_empty: fixes a :: "real^'n::finite" shows
15.4651 + "({a <..< b} = {} \<longleftrightarrow> (\<exists>i. b$i \<le> a$i))" (is ?th1) and
15.4652 + "({a .. b} = {} \<longleftrightarrow> (\<exists>i. b$i < a$i))" (is ?th2)
15.4653 +proof-
15.4654 + { fix i x assume as:"b$i \<le> a$i" and x:"x\<in>{a <..< b}"
15.4655 + hence "a $ i < x $ i \<and> x $ i < b $ i" unfolding mem_interval by auto
15.4656 + hence "a$i < b$i" by auto
15.4657 + hence False using as by auto }
15.4658 + moreover
15.4659 + { assume as:"\<forall>i. \<not> (b$i \<le> a$i)"
15.4660 + let ?x = "(1/2) *\<^sub>R (a + b)"
15.4661 + { fix i
15.4662 + have "a$i < b$i" using as[THEN spec[where x=i]] by auto
15.4663 + hence "a$i < ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i < b$i"
15.4664 + unfolding vector_smult_component and vector_add_component
15.4665 + by (auto simp add: less_divide_eq_number_of1) }
15.4666 + hence "{a <..< b} \<noteq> {}" using mem_interval(1)[of "?x" a b] by auto }
15.4667 + ultimately show ?th1 by blast
15.4668 +
15.4669 + { fix i x assume as:"b$i < a$i" and x:"x\<in>{a .. b}"
15.4670 + hence "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" unfolding mem_interval by auto
15.4671 + hence "a$i \<le> b$i" by auto
15.4672 + hence False using as by auto }
15.4673 + moreover
15.4674 + { assume as:"\<forall>i. \<not> (b$i < a$i)"
15.4675 + let ?x = "(1/2) *\<^sub>R (a + b)"
15.4676 + { fix i
15.4677 + have "a$i \<le> b$i" using as[THEN spec[where x=i]] by auto
15.4678 + hence "a$i \<le> ((1/2) *\<^sub>R (a+b)) $ i" "((1/2) *\<^sub>R (a+b)) $ i \<le> b$i"
15.4679 + unfolding vector_smult_component and vector_add_component
15.4680 + by (auto simp add: less_divide_eq_number_of1) }
15.4681 + hence "{a .. b} \<noteq> {}" using mem_interval(2)[of "?x" a b] by auto }
15.4682 + ultimately show ?th2 by blast
15.4683 +qed
15.4684 +
15.4685 +lemma interval_ne_empty: fixes a :: "real^'n::finite" shows
15.4686 + "{a .. b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i \<le> b$i)" and
15.4687 + "{a <..< b} \<noteq> {} \<longleftrightarrow> (\<forall>i. a$i < b$i)"
15.4688 + unfolding interval_eq_empty[of a b] by (auto simp add: not_less not_le) (* BH: Why doesn't just "auto" work here? *)
15.4689 +
15.4690 +lemma subset_interval_imp: fixes a :: "real^'n::finite" shows
15.4691 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c .. d} \<subseteq> {a .. b}" and
15.4692 + "(\<forall>i. a$i < c$i \<and> d$i < b$i) \<Longrightarrow> {c .. d} \<subseteq> {a<..<b}" and
15.4693 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a .. b}" and
15.4694 + "(\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i) \<Longrightarrow> {c<..<d} \<subseteq> {a<..<b}"
15.4695 + unfolding subset_eq[unfolded Ball_def] unfolding mem_interval
15.4696 + by (auto intro: order_trans less_le_trans le_less_trans less_imp_le) (* BH: Why doesn't just "auto" work here? *)
15.4697 +
15.4698 +lemma interval_sing: fixes a :: "'a::linorder^'n::finite" shows
15.4699 + "{a .. a} = {a} \<and> {a<..<a} = {}"
15.4700 +apply(auto simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
15.4701 +apply (simp add: order_eq_iff)
15.4702 +apply (auto simp add: not_less less_imp_le)
15.4703 +done
15.4704 +
15.4705 +lemma interval_open_subset_closed: fixes a :: "'a::preorder^'n::finite" shows
15.4706 + "{a<..<b} \<subseteq> {a .. b}"
15.4707 +proof(simp add: subset_eq, rule)
15.4708 + fix x
15.4709 + assume x:"x \<in>{a<..<b}"
15.4710 + { fix i
15.4711 + have "a $ i \<le> x $ i"
15.4712 + using x order_less_imp_le[of "a$i" "x$i"]
15.4713 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
15.4714 + }
15.4715 + moreover
15.4716 + { fix i
15.4717 + have "x $ i \<le> b $ i"
15.4718 + using x order_less_imp_le[of "x$i" "b$i"]
15.4719 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
15.4720 + }
15.4721 + ultimately
15.4722 + show "a \<le> x \<and> x \<le> b"
15.4723 + by(simp add: expand_set_eq vector_less_def vector_less_eq_def Cart_eq)
15.4724 +qed
15.4725 +
15.4726 +lemma subset_interval: fixes a :: "real^'n::finite" shows
15.4727 + "{c .. d} \<subseteq> {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
15.4728 + "{c .. d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i \<le> d$i) --> (\<forall>i. a$i < c$i \<and> d$i < b$i)" (is ?th2) and
15.4729 + "{c<..<d} \<subseteq> {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
15.4730 + "{c<..<d} \<subseteq> {a<..<b} \<longleftrightarrow> (\<forall>i. c$i < d$i) --> (\<forall>i. a$i \<le> c$i \<and> d$i \<le> b$i)" (is ?th4)
15.4731 +proof-
15.4732 + show ?th1 unfolding subset_eq and Ball_def and mem_interval by (auto intro: order_trans)
15.4733 + show ?th2 unfolding subset_eq and Ball_def and mem_interval by (auto intro: le_less_trans less_le_trans order_trans less_imp_le)
15.4734 + { assume as: "{c<..<d} \<subseteq> {a .. b}" "\<forall>i. c$i < d$i"
15.4735 + hence "{c<..<d} \<noteq> {}" unfolding interval_eq_empty by (auto, drule_tac x=i in spec, simp) (* BH: Why doesn't just "auto" work? *)
15.4736 + fix i
15.4737 + (** TODO combine the following two parts as done in the HOL_light version. **)
15.4738 + { let ?x = "(\<chi> j. (if j=i then ((min (a$j) (d$j))+c$j)/2 else (c$j+d$j)/2))::real^'n"
15.4739 + assume as2: "a$i > c$i"
15.4740 + { fix j
15.4741 + have "c $ j < ?x $ j \<and> ?x $ j < d $ j" unfolding Cart_lambda_beta
15.4742 + apply(cases "j=i") using as(2)[THEN spec[where x=j]]
15.4743 + by (auto simp add: less_divide_eq_number_of1 as2) }
15.4744 + hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
15.4745 + moreover
15.4746 + have "?x\<notin>{a .. b}"
15.4747 + unfolding mem_interval apply auto apply(rule_tac x=i in exI)
15.4748 + using as(2)[THEN spec[where x=i]] and as2
15.4749 + by (auto simp add: less_divide_eq_number_of1)
15.4750 + ultimately have False using as by auto }
15.4751 + hence "a$i \<le> c$i" by(rule ccontr)auto
15.4752 + moreover
15.4753 + { let ?x = "(\<chi> j. (if j=i then ((max (b$j) (c$j))+d$j)/2 else (c$j+d$j)/2))::real^'n"
15.4754 + assume as2: "b$i < d$i"
15.4755 + { fix j
15.4756 + have "d $ j > ?x $ j \<and> ?x $ j > c $ j" unfolding Cart_lambda_beta
15.4757 + apply(cases "j=i") using as(2)[THEN spec[where x=j]]
15.4758 + by (auto simp add: less_divide_eq_number_of1 as2) }
15.4759 + hence "?x\<in>{c<..<d}" unfolding mem_interval by auto
15.4760 + moreover
15.4761 + have "?x\<notin>{a .. b}"
15.4762 + unfolding mem_interval apply auto apply(rule_tac x=i in exI)
15.4763 + using as(2)[THEN spec[where x=i]] and as2
15.4764 + by (auto simp add: less_divide_eq_number_of1)
15.4765 + ultimately have False using as by auto }
15.4766 + hence "b$i \<ge> d$i" by(rule ccontr)auto
15.4767 + ultimately
15.4768 + have "a$i \<le> c$i \<and> d$i \<le> b$i" by auto
15.4769 + } note part1 = this
15.4770 + thus ?th3 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
15.4771 + { assume as:"{c<..<d} \<subseteq> {a<..<b}" "\<forall>i. c$i < d$i"
15.4772 + fix i
15.4773 + from as(1) have "{c<..<d} \<subseteq> {a..b}" using interval_open_subset_closed[of a b] by auto
15.4774 + hence "a$i \<le> c$i \<and> d$i \<le> b$i" using part1 and as(2) by auto } note * = this
15.4775 + thus ?th4 unfolding subset_eq and Ball_def and mem_interval apply auto apply (erule_tac x=ia in allE, simp)+ by (erule_tac x=i in allE, erule_tac x=i in allE, simp)+
15.4776 +qed
15.4777 +
15.4778 +lemma disjoint_interval: fixes a::"real^'n::finite" shows
15.4779 + "{a .. b} \<inter> {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
15.4780 + "{a .. b} \<inter> {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
15.4781 + "{a<..<b} \<inter> {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
15.4782 + "{a<..<b} \<inter> {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)
15.4783 +proof-
15.4784 + let ?z = "(\<chi> i. ((max (a$i) (c$i)) + (min (b$i) (d$i))) / 2)::real^'n"
15.4785 + show ?th1 ?th2 ?th3 ?th4
15.4786 + unfolding expand_set_eq and Int_iff and empty_iff and mem_interval and all_conj_distrib[THEN sym] and eq_False
15.4787 + apply (auto elim!: allE[where x="?z"])
15.4788 + apply ((rule_tac x=x in exI, force) | (rule_tac x=i in exI, force))+
15.4789 + done
15.4790 +qed
15.4791 +
15.4792 +lemma inter_interval: fixes a :: "'a::linorder^'n::finite" shows
15.4793 + "{a .. b} \<inter> {c .. d} = {(\<chi> i. max (a$i) (c$i)) .. (\<chi> i. min (b$i) (d$i))}"
15.4794 + unfolding expand_set_eq and Int_iff and mem_interval
15.4795 + by (auto simp add: less_divide_eq_number_of1 intro!: bexI)
15.4796 +
15.4797 +(* Moved interval_open_subset_closed a bit upwards *)
15.4798 +
15.4799 +lemma open_interval_lemma: fixes x :: "real" shows
15.4800 + "a < x \<Longrightarrow> x < b ==> (\<exists>d>0. \<forall>x'. abs(x' - x) < d --> a < x' \<and> x' < b)"
15.4801 + by(rule_tac x="min (x - a) (b - x)" in exI, auto)
15.4802 +
15.4803 +lemma open_interval: fixes a :: "real^'n::finite" shows "open {a<..<b}"
15.4804 +proof-
15.4805 + { fix x assume x:"x\<in>{a<..<b}"
15.4806 + { fix i
15.4807 + have "\<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i"
15.4808 + using x[unfolded mem_interval, THEN spec[where x=i]]
15.4809 + using open_interval_lemma[of "a$i" "x$i" "b$i"] by auto }
15.4810 +
15.4811 + hence "\<forall>i. \<exists>d>0. \<forall>x'. abs (x' - (x$i)) < d \<longrightarrow> a$i < x' \<and> x' < b$i" by auto
15.4812 + then obtain d where d:"\<forall>i. 0 < d i \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d i \<longrightarrow> a $ i < x' \<and> x' < b $ i)"
15.4813 + using bchoice[of "UNIV" "\<lambda>i d. d>0 \<and> (\<forall>x'. \<bar>x' - x $ i\<bar> < d \<longrightarrow> a $ i < x' \<and> x' < b $ i)"] by auto
15.4814 +
15.4815 + let ?d = "Min (range d)"
15.4816 + have **:"finite (range d)" "range d \<noteq> {}" by auto
15.4817 + have "?d>0" unfolding Min_gr_iff[OF **] using d by auto
15.4818 + moreover
15.4819 + { fix x' assume as:"dist x' x < ?d"
15.4820 + { fix i
15.4821 + have "\<bar>x'$i - x $ i\<bar> < d i"
15.4822 + using norm_bound_component_lt[OF as[unfolded dist_norm], of i]
15.4823 + unfolding vector_minus_component and Min_gr_iff[OF **] by auto
15.4824 + hence "a $ i < x' $ i" "x' $ i < b $ i" using d[THEN spec[where x=i]] by auto }
15.4825 + hence "a < x' \<and> x' < b" unfolding vector_less_def by auto }
15.4826 + ultimately have "\<exists>e>0. \<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a<..<b}" by (auto, rule_tac x="?d" in exI, simp)
15.4827 + }
15.4828 + thus ?thesis unfolding open_dist using open_interval_lemma by auto
15.4829 +qed
15.4830 +
15.4831 +lemma closed_interval: fixes a :: "real^'n::finite" shows "closed {a .. b}"
15.4832 +proof-
15.4833 + { fix x i assume as:"\<forall>e>0. \<exists>x'\<in>{a..b}. x' \<noteq> x \<and> dist x' x < e"(* and xab:"a$i > x$i \<or> b$i < x$i"*)
15.4834 + { assume xa:"a$i > x$i"
15.4835 + with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < a$i - x$i" by(erule_tac x="a$i - x$i" in allE)auto
15.4836 + hence False unfolding mem_interval and dist_norm
15.4837 + using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xa by(auto elim!: allE[where x=i])
15.4838 + } hence "a$i \<le> x$i" by(rule ccontr)auto
15.4839 + moreover
15.4840 + { assume xb:"b$i < x$i"
15.4841 + with as obtain y where y:"y\<in>{a..b}" "y \<noteq> x" "dist y x < x$i - b$i" by(erule_tac x="x$i - b$i" in allE)auto
15.4842 + hence False unfolding mem_interval and dist_norm
15.4843 + using component_le_norm[of "y-x" i, unfolded vector_minus_component] and xb by(auto elim!: allE[where x=i])
15.4844 + } hence "x$i \<le> b$i" by(rule ccontr)auto
15.4845 + ultimately
15.4846 + have "a $ i \<le> x $ i \<and> x $ i \<le> b $ i" by auto }
15.4847 + thus ?thesis unfolding closed_limpt islimpt_approachable mem_interval by auto
15.4848 +qed
15.4849 +
15.4850 +lemma interior_closed_interval: fixes a :: "real^'n::finite" shows
15.4851 + "interior {a .. b} = {a<..<b}" (is "?L = ?R")
15.4852 +proof(rule subset_antisym)
15.4853 + show "?R \<subseteq> ?L" using interior_maximal[OF interval_open_subset_closed open_interval] by auto
15.4854 +next
15.4855 + { fix x assume "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> {a..b}"
15.4856 + then obtain s where s:"open s" "x \<in> s" "s \<subseteq> {a..b}" by auto
15.4857 + then obtain e where "e>0" and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> {a..b}" unfolding open_dist and subset_eq by auto
15.4858 + { fix i
15.4859 + have "dist (x - (e / 2) *\<^sub>R basis i) x < e"
15.4860 + "dist (x + (e / 2) *\<^sub>R basis i) x < e"
15.4861 + unfolding dist_norm apply auto
15.4862 + unfolding norm_minus_cancel using norm_basis[of i] and `e>0` by auto
15.4863 + hence "a $ i \<le> (x - (e / 2) *\<^sub>R basis i) $ i"
15.4864 + "(x + (e / 2) *\<^sub>R basis i) $ i \<le> b $ i"
15.4865 + using e[THEN spec[where x="x - (e/2) *\<^sub>R basis i"]]
15.4866 + and e[THEN spec[where x="x + (e/2) *\<^sub>R basis i"]]
15.4867 + unfolding mem_interval by (auto elim!: allE[where x=i])
15.4868 + hence "a $ i < x $ i" and "x $ i < b $ i"
15.4869 + unfolding vector_minus_component and vector_add_component
15.4870 + unfolding vector_smult_component and basis_component using `e>0` by auto }
15.4871 + hence "x \<in> {a<..<b}" unfolding mem_interval by auto }
15.4872 + thus "?L \<subseteq> ?R" unfolding interior_def and subset_eq by auto
15.4873 +qed
15.4874 +
15.4875 +lemma bounded_closed_interval: fixes a :: "real^'n::finite" shows
15.4876 + "bounded {a .. b}"
15.4877 +proof-
15.4878 + let ?b = "\<Sum>i\<in>UNIV. \<bar>a$i\<bar> + \<bar>b$i\<bar>"
15.4879 + { fix x::"real^'n" assume x:"\<forall>i. a $ i \<le> x $ i \<and> x $ i \<le> b $ i"
15.4880 + { fix i
15.4881 + have "\<bar>x$i\<bar> \<le> \<bar>a$i\<bar> + \<bar>b$i\<bar>" using x[THEN spec[where x=i]] by auto }
15.4882 + hence "(\<Sum>i\<in>UNIV. \<bar>x $ i\<bar>) \<le> ?b" by(rule setsum_mono)
15.4883 + hence "norm x \<le> ?b" using norm_le_l1[of x] by auto }
15.4884 + thus ?thesis unfolding interval and bounded_iff by auto
15.4885 +qed
15.4886 +
15.4887 +lemma bounded_interval: fixes a :: "real^'n::finite" shows
15.4888 + "bounded {a .. b} \<and> bounded {a<..<b}"
15.4889 + using bounded_closed_interval[of a b]
15.4890 + using interval_open_subset_closed[of a b]
15.4891 + using bounded_subset[of "{a..b}" "{a<..<b}"]
15.4892 + by simp
15.4893 +
15.4894 +lemma not_interval_univ: fixes a :: "real^'n::finite" shows
15.4895 + "({a .. b} \<noteq> UNIV) \<and> ({a<..<b} \<noteq> UNIV)"
15.4896 + using bounded_interval[of a b]
15.4897 + by auto
15.4898 +
15.4899 +lemma compact_interval: fixes a :: "real^'n::finite" shows
15.4900 + "compact {a .. b}"
15.4901 + using bounded_closed_imp_compact using bounded_interval[of a b] using closed_interval[of a b] by auto
15.4902 +
15.4903 +lemma open_interval_midpoint: fixes a :: "real^'n::finite"
15.4904 + assumes "{a<..<b} \<noteq> {}" shows "((1/2) *\<^sub>R (a + b)) \<in> {a<..<b}"
15.4905 +proof-
15.4906 + { fix i
15.4907 + have "a $ i < ((1 / 2) *\<^sub>R (a + b)) $ i \<and> ((1 / 2) *\<^sub>R (a + b)) $ i < b $ i"
15.4908 + using assms[unfolded interval_ne_empty, THEN spec[where x=i]]
15.4909 + unfolding vector_smult_component and vector_add_component
15.4910 + by(auto simp add: less_divide_eq_number_of1) }
15.4911 + thus ?thesis unfolding mem_interval by auto
15.4912 +qed
15.4913 +
15.4914 +lemma open_closed_interval_convex: fixes x :: "real^'n::finite"
15.4915 + assumes x:"x \<in> {a<..<b}" and y:"y \<in> {a .. b}" and e:"0 < e" "e \<le> 1"
15.4916 + shows "(e *\<^sub>R x + (1 - e) *\<^sub>R y) \<in> {a<..<b}"
15.4917 +proof-
15.4918 + { fix i
15.4919 + have "a $ i = e * a$i + (1 - e) * a$i" unfolding left_diff_distrib by simp
15.4920 + also have "\<dots> < e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
15.4921 + using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
15.4922 + using x unfolding mem_interval apply simp
15.4923 + using y unfolding mem_interval apply simp
15.4924 + done
15.4925 + finally have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i" by auto
15.4926 + moreover {
15.4927 + have "b $ i = e * b$i + (1 - e) * b$i" unfolding left_diff_distrib by simp
15.4928 + also have "\<dots> > e * x $ i + (1 - e) * y $ i" apply(rule add_less_le_mono)
15.4929 + using e unfolding mult_less_cancel_left and mult_le_cancel_left apply simp_all
15.4930 + using x unfolding mem_interval apply simp
15.4931 + using y unfolding mem_interval apply simp
15.4932 + done
15.4933 + finally have "(e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto
15.4934 + } ultimately have "a $ i < (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i \<and> (e *\<^sub>R x + (1 - e) *\<^sub>R y) $ i < b $ i" by auto }
15.4935 + thus ?thesis unfolding mem_interval by auto
15.4936 +qed
15.4937 +
15.4938 +lemma closure_open_interval: fixes a :: "real^'n::finite"
15.4939 + assumes "{a<..<b} \<noteq> {}"
15.4940 + shows "closure {a<..<b} = {a .. b}"
15.4941 +proof-
15.4942 + have ab:"a < b" using assms[unfolded interval_ne_empty] unfolding vector_less_def by auto
15.4943 + let ?c = "(1 / 2) *\<^sub>R (a + b)"
15.4944 + { fix x assume as:"x \<in> {a .. b}"
15.4945 + def f == "\<lambda>n::nat. x + (inverse (real n + 1)) *\<^sub>R (?c - x)"
15.4946 + { fix n assume fn:"f n < b \<longrightarrow> a < f n \<longrightarrow> f n = x" and xc:"x \<noteq> ?c"
15.4947 + have *:"0 < inverse (real n + 1)" "inverse (real n + 1) \<le> 1" unfolding inverse_le_1_iff by auto
15.4948 + have "(inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b)) + (1 - inverse (real n + 1)) *\<^sub>R x =
15.4949 + x + (inverse (real n + 1)) *\<^sub>R (((1 / 2) *\<^sub>R (a + b)) - x)"
15.4950 + by (auto simp add: algebra_simps)
15.4951 + hence "f n < b" and "a < f n" using open_closed_interval_convex[OF open_interval_midpoint[OF assms] as *] unfolding f_def by auto
15.4952 + hence False using fn unfolding f_def using xc by(auto simp add: vector_mul_lcancel vector_ssub_ldistrib) }
15.4953 + moreover
15.4954 + { assume "\<not> (f ---> x) sequentially"
15.4955 + { fix e::real assume "e>0"
15.4956 + hence "\<exists>N::nat. inverse (real (N + 1)) < e" using real_arch_inv[of e] apply (auto simp add: Suc_pred') apply(rule_tac x="n - 1" in exI) by auto
15.4957 + then obtain N::nat where "inverse (real (N + 1)) < e" by auto
15.4958 + hence "\<forall>n\<ge>N. inverse (real n + 1) < e" by (auto, metis Suc_le_mono le_SucE less_imp_inverse_less nat_le_real_less order_less_trans real_of_nat_Suc real_of_nat_Suc_gt_zero)
15.4959 + hence "\<exists>N::nat. \<forall>n\<ge>N. inverse (real n + 1) < e" by auto }
15.4960 + hence "((\<lambda>n. inverse (real n + 1)) ---> 0) sequentially"
15.4961 + unfolding Lim_sequentially by(auto simp add: dist_norm)
15.4962 + hence "(f ---> x) sequentially" unfolding f_def
15.4963 + using Lim_add[OF Lim_const, of "\<lambda>n::nat. (inverse (real n + 1)) *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x)" 0 sequentially x]
15.4964 + using Lim_vmul[of "\<lambda>n::nat. inverse (real n + 1)" 0 sequentially "((1 / 2) *\<^sub>R (a + b) - x)"] by auto }
15.4965 + ultimately have "x \<in> closure {a<..<b}"
15.4966 + using as and open_interval_midpoint[OF assms] unfolding closure_def unfolding islimpt_sequential by(cases "x=?c")auto }
15.4967 + thus ?thesis using closure_minimal[OF interval_open_subset_closed closed_interval, of a b] by blast
15.4968 +qed
15.4969 +
15.4970 +lemma bounded_subset_open_interval_symmetric: fixes s::"(real^'n::finite) set"
15.4971 + assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a<..<a}"
15.4972 +proof-
15.4973 + obtain b where "b>0" and b:"\<forall>x\<in>s. norm x \<le> b" using assms[unfolded bounded_pos] by auto
15.4974 + def a \<equiv> "(\<chi> i. b+1)::real^'n"
15.4975 + { fix x assume "x\<in>s"
15.4976 + fix i
15.4977 + have "(-a)$i < x$i" and "x$i < a$i" using b[THEN bspec[where x=x], OF `x\<in>s`] and component_le_norm[of x i]
15.4978 + unfolding vector_uminus_component and a_def and Cart_lambda_beta by auto
15.4979 + }
15.4980 + thus ?thesis by(auto intro: exI[where x=a] simp add: vector_less_def)
15.4981 +qed
15.4982 +
15.4983 +lemma bounded_subset_open_interval:
15.4984 + fixes s :: "(real ^ 'n::finite) set"
15.4985 + shows "bounded s ==> (\<exists>a b. s \<subseteq> {a<..<b})"
15.4986 + by (auto dest!: bounded_subset_open_interval_symmetric)
15.4987 +
15.4988 +lemma bounded_subset_closed_interval_symmetric:
15.4989 + fixes s :: "(real ^ 'n::finite) set"
15.4990 + assumes "bounded s" shows "\<exists>a. s \<subseteq> {-a .. a}"
15.4991 +proof-
15.4992 + obtain a where "s \<subseteq> {- a<..<a}" using bounded_subset_open_interval_symmetric[OF assms] by auto
15.4993 + thus ?thesis using interval_open_subset_closed[of "-a" a] by auto
15.4994 +qed
15.4995 +
15.4996 +lemma bounded_subset_closed_interval:
15.4997 + fixes s :: "(real ^ 'n::finite) set"
15.4998 + shows "bounded s ==> (\<exists>a b. s \<subseteq> {a .. b})"
15.4999 + using bounded_subset_closed_interval_symmetric[of s] by auto
15.5000 +
15.5001 +lemma frontier_closed_interval:
15.5002 + fixes a b :: "real ^ _"
15.5003 + shows "frontier {a .. b} = {a .. b} - {a<..<b}"
15.5004 + unfolding frontier_def unfolding interior_closed_interval and closure_closed[OF closed_interval] ..
15.5005 +
15.5006 +lemma frontier_open_interval:
15.5007 + fixes a b :: "real ^ _"
15.5008 + shows "frontier {a<..<b} = (if {a<..<b} = {} then {} else {a .. b} - {a<..<b})"
15.5009 +proof(cases "{a<..<b} = {}")
15.5010 + case True thus ?thesis using frontier_empty by auto
15.5011 +next
15.5012 + case False thus ?thesis unfolding frontier_def and closure_open_interval[OF False] and interior_open[OF open_interval] by auto
15.5013 +qed
15.5014 +
15.5015 +lemma inter_interval_mixed_eq_empty: fixes a :: "real^'n::finite"
15.5016 + assumes "{c<..<d} \<noteq> {}" shows "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> {a<..<b} \<inter> {c<..<d} = {}"
15.5017 + unfolding closure_open_interval[OF assms, THEN sym] unfolding open_inter_closure_eq_empty[OF open_interval] ..
15.5018 +
15.5019 +
15.5020 +(* Some special cases for intervals in R^1. *)
15.5021 +
15.5022 +lemma all_1: "(\<forall>x::1. P x) \<longleftrightarrow> P 1"
15.5023 + by (metis num1_eq_iff)
15.5024 +
15.5025 +lemma ex_1: "(\<exists>x::1. P x) \<longleftrightarrow> P 1"
15.5026 + by auto (metis num1_eq_iff)
15.5027 +
15.5028 +lemma interval_cases_1: fixes x :: "real^1" shows
15.5029 + "x \<in> {a .. b} ==> x \<in> {a<..<b} \<or> (x = a) \<or> (x = b)"
15.5030 + by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1, auto)
15.5031 +
15.5032 +lemma in_interval_1: fixes x :: "real^1" shows
15.5033 + "(x \<in> {a .. b} \<longleftrightarrow> dest_vec1 a \<le> dest_vec1 x \<and> dest_vec1 x \<le> dest_vec1 b) \<and>
15.5034 + (x \<in> {a<..<b} \<longleftrightarrow> dest_vec1 a < dest_vec1 x \<and> dest_vec1 x < dest_vec1 b)"
15.5035 +by(simp add: Cart_eq vector_less_def vector_less_eq_def all_1 dest_vec1_def)
15.5036 +
15.5037 +lemma interval_eq_empty_1: fixes a :: "real^1" shows
15.5038 + "{a .. b} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a"
15.5039 + "{a<..<b} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a"
15.5040 + unfolding interval_eq_empty and ex_1 and dest_vec1_def by auto
15.5041 +
15.5042 +lemma subset_interval_1: fixes a :: "real^1" shows
15.5043 + "({a .. b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
15.5044 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
15.5045 + "({a .. b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or>
15.5046 + dest_vec1 c < dest_vec1 a \<and> dest_vec1 a \<le> dest_vec1 b \<and> dest_vec1 b < dest_vec1 d)"
15.5047 + "({a<..<b} \<subseteq> {c .. d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
15.5048 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
15.5049 + "({a<..<b} \<subseteq> {c<..<d} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or>
15.5050 + dest_vec1 c \<le> dest_vec1 a \<and> dest_vec1 a < dest_vec1 b \<and> dest_vec1 b \<le> dest_vec1 d)"
15.5051 + unfolding subset_interval[of a b c d] unfolding all_1 and dest_vec1_def by auto
15.5052 +
15.5053 +lemma eq_interval_1: fixes a :: "real^1" shows
15.5054 + "{a .. b} = {c .. d} \<longleftrightarrow>
15.5055 + dest_vec1 b < dest_vec1 a \<and> dest_vec1 d < dest_vec1 c \<or>
15.5056 + dest_vec1 a = dest_vec1 c \<and> dest_vec1 b = dest_vec1 d"
15.5057 +using set_eq_subset[of "{a .. b}" "{c .. d}"]
15.5058 +using subset_interval_1(1)[of a b c d]
15.5059 +using subset_interval_1(1)[of c d a b]
15.5060 +by auto (* FIXME: slow *)
15.5061 +
15.5062 +lemma disjoint_interval_1: fixes a :: "real^1" shows
15.5063 + "{a .. b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b < dest_vec1 c \<or> dest_vec1 d < dest_vec1 a"
15.5064 + "{a .. b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b < dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
15.5065 + "{a<..<b} \<inter> {c .. d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d < dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
15.5066 + "{a<..<b} \<inter> {c<..<d} = {} \<longleftrightarrow> dest_vec1 b \<le> dest_vec1 a \<or> dest_vec1 d \<le> dest_vec1 c \<or> dest_vec1 b \<le> dest_vec1 c \<or> dest_vec1 d \<le> dest_vec1 a"
15.5067 + unfolding disjoint_interval and dest_vec1_def ex_1 by auto
15.5068 +
15.5069 +lemma open_closed_interval_1: fixes a :: "real^1" shows
15.5070 + "{a<..<b} = {a .. b} - {a, b}"
15.5071 + unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
15.5072 +
15.5073 +lemma closed_open_interval_1: "dest_vec1 (a::real^1) \<le> dest_vec1 b ==> {a .. b} = {a<..<b} \<union> {a,b}"
15.5074 + unfolding expand_set_eq apply simp unfolding vector_less_def and vector_less_eq_def and all_1 and dest_vec1_eq[THEN sym] and dest_vec1_def by auto
15.5075 +
15.5076 +(* Some stuff for half-infinite intervals too; FIXME: notation? *)
15.5077 +
15.5078 +lemma closed_interval_left: fixes b::"real^'n::finite"
15.5079 + shows "closed {x::real^'n. \<forall>i. x$i \<le> b$i}"
15.5080 +proof-
15.5081 + { fix i
15.5082 + fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. x $ i \<le> b $ i}. x' \<noteq> x \<and> dist x' x < e"
15.5083 + { assume "x$i > b$i"
15.5084 + then obtain y where "y $ i \<le> b $ i" "y \<noteq> x" "dist y x < x$i - b$i" using x[THEN spec[where x="x$i - b$i"]] by auto
15.5085 + hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
15.5086 + hence "x$i \<le> b$i" by(rule ccontr)auto }
15.5087 + thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
15.5088 +qed
15.5089 +
15.5090 +lemma closed_interval_right: fixes a::"real^'n::finite"
15.5091 + shows "closed {x::real^'n. \<forall>i. a$i \<le> x$i}"
15.5092 +proof-
15.5093 + { fix i
15.5094 + fix x::"real^'n" assume x:"\<forall>e>0. \<exists>x'\<in>{x. \<forall>i. a $ i \<le> x $ i}. x' \<noteq> x \<and> dist x' x < e"
15.5095 + { assume "a$i > x$i"
15.5096 + then obtain y where "a $ i \<le> y $ i" "y \<noteq> x" "dist y x < a$i - x$i" using x[THEN spec[where x="a$i - x$i"]] by auto
15.5097 + hence False using component_le_norm[of "y - x" i] unfolding dist_norm and vector_minus_component by auto }
15.5098 + hence "a$i \<le> x$i" by(rule ccontr)auto }
15.5099 + thus ?thesis unfolding closed_limpt unfolding islimpt_approachable by blast
15.5100 +qed
15.5101 +
15.5102 +subsection{* Intervals in general, including infinite and mixtures of open and closed. *}
15.5103 +
15.5104 +definition "is_interval s \<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)"
15.5105 +
15.5106 +lemma is_interval_interval: "is_interval {a .. b::real^'n::finite}" (is ?th1) "is_interval {a<..<b}" (is ?th2) proof -
15.5107 + have *:"\<And>x y z::real. x < y \<Longrightarrow> y < z \<Longrightarrow> x < z" by auto
15.5108 + show ?th1 ?th2 unfolding is_interval_def mem_interval Ball_def atLeastAtMost_iff
15.5109 + by(meson real_le_trans le_less_trans less_le_trans *)+ qed
15.5110 +
15.5111 +lemma is_interval_empty:
15.5112 + "is_interval {}"
15.5113 + unfolding is_interval_def
15.5114 + by simp
15.5115 +
15.5116 +lemma is_interval_univ:
15.5117 + "is_interval UNIV"
15.5118 + unfolding is_interval_def
15.5119 + by simp
15.5120 +
15.5121 +subsection{* Closure of halfspaces and hyperplanes. *}
15.5122 +
15.5123 +lemma Lim_inner:
15.5124 + assumes "(f ---> l) net" shows "((\<lambda>y. inner a (f y)) ---> inner a l) net"
15.5125 + by (intro tendsto_intros assms)
15.5126 +
15.5127 +lemma continuous_at_inner: "continuous (at x) (inner a)"
15.5128 + unfolding continuous_at by (intro tendsto_intros)
15.5129 +
15.5130 +lemma continuous_on_inner:
15.5131 + fixes s :: "'a::real_inner set"
15.5132 + shows "continuous_on s (inner a)"
15.5133 + unfolding continuous_on by (rule ballI) (intro tendsto_intros)
15.5134 +
15.5135 +lemma closed_halfspace_le: "closed {x. inner a x \<le> b}"
15.5136 +proof-
15.5137 + have "\<forall>x. continuous (at x) (inner a)"
15.5138 + unfolding continuous_at by (rule allI) (intro tendsto_intros)
15.5139 + hence "closed (inner a -` {..b})"
15.5140 + using closed_real_atMost by (rule continuous_closed_vimage)
15.5141 + moreover have "{x. inner a x \<le> b} = inner a -` {..b}" by auto
15.5142 + ultimately show ?thesis by simp
15.5143 +qed
15.5144 +
15.5145 +lemma closed_halfspace_ge: "closed {x. inner a x \<ge> b}"
15.5146 + using closed_halfspace_le[of "-a" "-b"] unfolding inner_minus_left by auto
15.5147 +
15.5148 +lemma closed_hyperplane: "closed {x. inner a x = b}"
15.5149 +proof-
15.5150 + have "{x. inner a x = b} = {x. inner a x \<ge> b} \<inter> {x. inner a x \<le> b}" by auto
15.5151 + thus ?thesis using closed_halfspace_le[of a b] and closed_halfspace_ge[of b a] using closed_Int by auto
15.5152 +qed
15.5153 +
15.5154 +lemma closed_halfspace_component_le:
15.5155 + shows "closed {x::real^'n::finite. x$i \<le> a}"
15.5156 + using closed_halfspace_le[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
15.5157 +
15.5158 +lemma closed_halfspace_component_ge:
15.5159 + shows "closed {x::real^'n::finite. x$i \<ge> a}"
15.5160 + using closed_halfspace_ge[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
15.5161 +
15.5162 +text{* Openness of halfspaces. *}
15.5163 +
15.5164 +lemma open_halfspace_lt: "open {x. inner a x < b}"
15.5165 +proof-
15.5166 + have "UNIV - {x. b \<le> inner a x} = {x. inner a x < b}" by auto
15.5167 + thus ?thesis using closed_halfspace_ge[unfolded closed_def Compl_eq_Diff_UNIV, of b a] by auto
15.5168 +qed
15.5169 +
15.5170 +lemma open_halfspace_gt: "open {x. inner a x > b}"
15.5171 +proof-
15.5172 + have "UNIV - {x. b \<ge> inner a x} = {x. inner a x > b}" by auto
15.5173 + thus ?thesis using closed_halfspace_le[unfolded closed_def Compl_eq_Diff_UNIV, of a b] by auto
15.5174 +qed
15.5175 +
15.5176 +lemma open_halfspace_component_lt:
15.5177 + shows "open {x::real^'n::finite. x$i < a}"
15.5178 + using open_halfspace_lt[of "(basis i)::real^'n" a] unfolding inner_basis[OF assms] by auto
15.5179 +
15.5180 +lemma open_halfspace_component_gt:
15.5181 + shows "open {x::real^'n::finite. x$i > a}"
15.5182 + using open_halfspace_gt[of a "(basis i)::real^'n"] unfolding inner_basis[OF assms] by auto
15.5183 +
15.5184 +text{* This gives a simple derivation of limit component bounds. *}
15.5185 +
15.5186 +lemma Lim_component_le: fixes f :: "'a \<Rightarrow> real^'n::finite"
15.5187 + assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. f(x)$i \<le> b) net"
15.5188 + shows "l$i \<le> b"
15.5189 +proof-
15.5190 + { fix x have "x \<in> {x::real^'n. inner (basis i) x \<le> b} \<longleftrightarrow> x$i \<le> b" unfolding inner_basis by auto } note * = this
15.5191 + show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<le> b}" f net l] unfolding *
15.5192 + using closed_halfspace_le[of "(basis i)::real^'n" b] and assms(1,2,3) by auto
15.5193 +qed
15.5194 +
15.5195 +lemma Lim_component_ge: fixes f :: "'a \<Rightarrow> real^'n::finite"
15.5196 + assumes "(f ---> l) net" "\<not> (trivial_limit net)" "eventually (\<lambda>x. b \<le> (f x)$i) net"
15.5197 + shows "b \<le> l$i"
15.5198 +proof-
15.5199 + { fix x have "x \<in> {x::real^'n. inner (basis i) x \<ge> b} \<longleftrightarrow> x$i \<ge> b" unfolding inner_basis by auto } note * = this
15.5200 + show ?thesis using Lim_in_closed_set[of "{x. inner (basis i) x \<ge> b}" f net l] unfolding *
15.5201 + using closed_halfspace_ge[of b "(basis i)::real^'n"] and assms(1,2,3) by auto
15.5202 +qed
15.5203 +
15.5204 +lemma Lim_component_eq: fixes f :: "'a \<Rightarrow> real^'n::finite"
15.5205 + assumes net:"(f ---> l) net" "~(trivial_limit net)" and ev:"eventually (\<lambda>x. f(x)$i = b) net"
15.5206 + shows "l$i = b"
15.5207 + using ev[unfolded order_eq_iff eventually_and] using Lim_component_ge[OF net, of b i] and Lim_component_le[OF net, of i b] by auto
15.5208 +
15.5209 +lemma Lim_drop_le: fixes f :: "'a \<Rightarrow> real^1" shows
15.5210 + "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. dest_vec1 (f x) \<le> b) net ==> dest_vec1 l \<le> b"
15.5211 + using Lim_component_le[of f l net 1 b] unfolding dest_vec1_def by auto
15.5212 +
15.5213 +lemma Lim_drop_ge: fixes f :: "'a \<Rightarrow> real^1" shows
15.5214 + "(f ---> l) net \<Longrightarrow> ~(trivial_limit net) \<Longrightarrow> eventually (\<lambda>x. b \<le> dest_vec1 (f x)) net ==> b \<le> dest_vec1 l"
15.5215 + using Lim_component_ge[of f l net b 1] unfolding dest_vec1_def by auto
15.5216 +
15.5217 +text{* Limits relative to a union. *}
15.5218 +
15.5219 +lemma eventually_within_Un:
15.5220 + "eventually P (net within (s \<union> t)) \<longleftrightarrow>
15.5221 + eventually P (net within s) \<and> eventually P (net within t)"
15.5222 + unfolding Limits.eventually_within
15.5223 + by (auto elim!: eventually_rev_mp)
15.5224 +
15.5225 +lemma Lim_within_union:
15.5226 + "(f ---> l) (net within (s \<union> t)) \<longleftrightarrow>
15.5227 + (f ---> l) (net within s) \<and> (f ---> l) (net within t)"
15.5228 + unfolding tendsto_def
15.5229 + by (auto simp add: eventually_within_Un)
15.5230 +
15.5231 +lemma continuous_on_union:
15.5232 + assumes "closed s" "closed t" "continuous_on s f" "continuous_on t f"
15.5233 + shows "continuous_on (s \<union> t) f"
15.5234 + using assms unfolding continuous_on unfolding Lim_within_union
15.5235 + unfolding Lim unfolding trivial_limit_within unfolding closed_limpt by auto
15.5236 +
15.5237 +lemma continuous_on_cases:
15.5238 + assumes "closed s" "closed t" "continuous_on s f" "continuous_on t g"
15.5239 + "\<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x"
15.5240 + shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
15.5241 +proof-
15.5242 + let ?h = "(\<lambda>x. if P x then f x else g x)"
15.5243 + have "\<forall>x\<in>s. f x = (if P x then f x else g x)" using assms(5) by auto
15.5244 + hence "continuous_on s ?h" using continuous_on_eq[of s f ?h] using assms(3) by auto
15.5245 + moreover
15.5246 + have "\<forall>x\<in>t. g x = (if P x then f x else g x)" using assms(5) by auto
15.5247 + hence "continuous_on t ?h" using continuous_on_eq[of t g ?h] using assms(4) by auto
15.5248 + ultimately show ?thesis using continuous_on_union[OF assms(1,2), of ?h] by auto
15.5249 +qed
15.5250 +
15.5251 +
15.5252 +text{* Some more convenient intermediate-value theorem formulations. *}
15.5253 +
15.5254 +lemma connected_ivt_hyperplane:
15.5255 + assumes "connected s" "x \<in> s" "y \<in> s" "inner a x \<le> b" "b \<le> inner a y"
15.5256 + shows "\<exists>z \<in> s. inner a z = b"
15.5257 +proof(rule ccontr)
15.5258 + assume as:"\<not> (\<exists>z\<in>s. inner a z = b)"
15.5259 + let ?A = "{x. inner a x < b}"
15.5260 + let ?B = "{x. inner a x > b}"
15.5261 + have "open ?A" "open ?B" using open_halfspace_lt and open_halfspace_gt by auto
15.5262 + moreover have "?A \<inter> ?B = {}" by auto
15.5263 + moreover have "s \<subseteq> ?A \<union> ?B" using as by auto
15.5264 + ultimately show False using assms(1)[unfolded connected_def not_ex, THEN spec[where x="?A"], THEN spec[where x="?B"]] and assms(2-5) by auto
15.5265 +qed
15.5266 +
15.5267 +lemma connected_ivt_component: fixes x::"real^'n::finite" shows
15.5268 + "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)"
15.5269 + using connected_ivt_hyperplane[of s x y "(basis k)::real^'n" a] by (auto simp add: inner_basis)
15.5270 +
15.5271 +text{* Also more convenient formulations of monotone convergence. *}
15.5272 +
15.5273 +lemma bounded_increasing_convergent: fixes s::"nat \<Rightarrow> real^1"
15.5274 + assumes "bounded {s n| n::nat. True}" "\<forall>n. dest_vec1(s n) \<le> dest_vec1(s(Suc n))"
15.5275 + shows "\<exists>l. (s ---> l) sequentially"
15.5276 +proof-
15.5277 + obtain a where a:"\<forall>n. \<bar>dest_vec1 (s n)\<bar> \<le> a" using assms(1)[unfolded bounded_iff abs_dest_vec1] by auto
15.5278 + { fix m::nat
15.5279 + have "\<And> n. n\<ge>m \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)"
15.5280 + apply(induct_tac n) apply simp using assms(2) apply(erule_tac x="na" in allE) by(auto simp add: not_less_eq_eq) }
15.5281 + hence "\<forall>m n. m \<le> n \<longrightarrow> dest_vec1 (s m) \<le> dest_vec1 (s n)" by auto
15.5282 + then obtain l where "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<bar>dest_vec1 (s n) - l\<bar> < e" using convergent_bounded_monotone[OF a] unfolding monoseq_def by auto
15.5283 + thus ?thesis unfolding Lim_sequentially apply(rule_tac x="vec1 l" in exI)
15.5284 + unfolding dist_norm unfolding abs_dest_vec1 and dest_vec1_sub by auto
15.5285 +qed
15.5286 +
15.5287 +subsection{* Basic homeomorphism definitions. *}
15.5288 +
15.5289 +definition "homeomorphism s t f g \<equiv>
15.5290 + (\<forall>x\<in>s. (g(f x) = x)) \<and> (f ` s = t) \<and> continuous_on s f \<and>
15.5291 + (\<forall>y\<in>t. (f(g y) = y)) \<and> (g ` t = s) \<and> continuous_on t g"
15.5292 +
15.5293 +definition
15.5294 + homeomorphic :: "'a::metric_space set \<Rightarrow> 'b::metric_space set \<Rightarrow> bool"
15.5295 + (infixr "homeomorphic" 60) where
15.5296 + homeomorphic_def: "s homeomorphic t \<equiv> (\<exists>f g. homeomorphism s t f g)"
15.5297 +
15.5298 +lemma homeomorphic_refl: "s homeomorphic s"
15.5299 + unfolding homeomorphic_def
15.5300 + unfolding homeomorphism_def
15.5301 + using continuous_on_id
15.5302 + apply(rule_tac x = "(\<lambda>x. x)" in exI)
15.5303 + apply(rule_tac x = "(\<lambda>x. x)" in exI)
15.5304 + by blast
15.5305 +
15.5306 +lemma homeomorphic_sym:
15.5307 + "s homeomorphic t \<longleftrightarrow> t homeomorphic s"
15.5308 +unfolding homeomorphic_def
15.5309 +unfolding homeomorphism_def
15.5310 +by blast (* FIXME: slow *)
15.5311 +
15.5312 +lemma homeomorphic_trans:
15.5313 + assumes "s homeomorphic t" "t homeomorphic u" shows "s homeomorphic u"
15.5314 +proof-
15.5315 + obtain f1 g1 where fg1:"\<forall>x\<in>s. g1 (f1 x) = x" "f1 ` s = t" "continuous_on s f1" "\<forall>y\<in>t. f1 (g1 y) = y" "g1 ` t = s" "continuous_on t g1"
15.5316 + using assms(1) unfolding homeomorphic_def homeomorphism_def by auto
15.5317 + obtain f2 g2 where fg2:"\<forall>x\<in>t. g2 (f2 x) = x" "f2 ` t = u" "continuous_on t f2" "\<forall>y\<in>u. f2 (g2 y) = y" "g2 ` u = t" "continuous_on u g2"
15.5318 + using assms(2) unfolding homeomorphic_def homeomorphism_def by auto
15.5319 +
15.5320 + { fix x assume "x\<in>s" hence "(g1 \<circ> g2) ((f2 \<circ> f1) x) = x" using fg1(1)[THEN bspec[where x=x]] and fg2(1)[THEN bspec[where x="f1 x"]] and fg1(2) by auto }
15.5321 + moreover have "(f2 \<circ> f1) ` s = u" using fg1(2) fg2(2) by auto
15.5322 + moreover have "continuous_on s (f2 \<circ> f1)" using continuous_on_compose[OF fg1(3)] and fg2(3) unfolding fg1(2) by auto
15.5323 + moreover { fix y assume "y\<in>u" hence "(f2 \<circ> f1) ((g1 \<circ> g2) y) = y" using fg2(4)[THEN bspec[where x=y]] and fg1(4)[THEN bspec[where x="g2 y"]] and fg2(5) by auto }
15.5324 + moreover have "(g1 \<circ> g2) ` u = s" using fg1(5) fg2(5) by auto
15.5325 + moreover have "continuous_on u (g1 \<circ> g2)" using continuous_on_compose[OF fg2(6)] and fg1(6) unfolding fg2(5) by auto
15.5326 + ultimately show ?thesis unfolding homeomorphic_def homeomorphism_def apply(rule_tac x="f2 \<circ> f1" in exI) apply(rule_tac x="g1 \<circ> g2" in exI) by auto
15.5327 +qed
15.5328 +
15.5329 +lemma homeomorphic_minimal:
15.5330 + "s homeomorphic t \<longleftrightarrow>
15.5331 + (\<exists>f g. (\<forall>x\<in>s. f(x) \<in> t \<and> (g(f(x)) = x)) \<and>
15.5332 + (\<forall>y\<in>t. g(y) \<in> s \<and> (f(g(y)) = y)) \<and>
15.5333 + continuous_on s f \<and> continuous_on t g)"
15.5334 +unfolding homeomorphic_def homeomorphism_def
15.5335 +apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI)
15.5336 +apply auto apply (rule_tac x=f in exI) apply (rule_tac x=g in exI) apply auto
15.5337 +unfolding image_iff
15.5338 +apply(erule_tac x="g x" in ballE) apply(erule_tac x="x" in ballE)
15.5339 +apply auto apply(rule_tac x="g x" in bexI) apply auto
15.5340 +apply(erule_tac x="f x" in ballE) apply(erule_tac x="x" in ballE)
15.5341 +apply auto apply(rule_tac x="f x" in bexI) by auto
15.5342 +
15.5343 +subsection{* Relatively weak hypotheses if a set is compact. *}
15.5344 +
15.5345 +definition "inv_on f s = (\<lambda>x. SOME y. y\<in>s \<and> f y = x)"
15.5346 +
15.5347 +lemma assumes "inj_on f s" "x\<in>s"
15.5348 + shows "inv_on f s (f x) = x"
15.5349 + using assms unfolding inj_on_def inv_on_def by auto
15.5350 +
15.5351 +lemma homeomorphism_compact:
15.5352 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
15.5353 + (* class constraint due to continuous_on_inverse *)
15.5354 + assumes "compact s" "continuous_on s f" "f ` s = t" "inj_on f s"
15.5355 + shows "\<exists>g. homeomorphism s t f g"
15.5356 +proof-
15.5357 + def g \<equiv> "\<lambda>x. SOME y. y\<in>s \<and> f y = x"
15.5358 + have g:"\<forall>x\<in>s. g (f x) = x" using assms(3) assms(4)[unfolded inj_on_def] unfolding g_def by auto
15.5359 + { fix y assume "y\<in>t"
15.5360 + then obtain x where x:"f x = y" "x\<in>s" using assms(3) by auto
15.5361 + hence "g (f x) = x" using g by auto
15.5362 + hence "f (g y) = y" unfolding x(1)[THEN sym] by auto }
15.5363 + hence g':"\<forall>x\<in>t. f (g x) = x" by auto
15.5364 + moreover
15.5365 + { fix x
15.5366 + have "x\<in>s \<Longrightarrow> x \<in> g ` t" using g[THEN bspec[where x=x]] unfolding image_iff using assms(3) by(auto intro!: bexI[where x="f x"])
15.5367 + moreover
15.5368 + { assume "x\<in>g ` t"
15.5369 + then obtain y where y:"y\<in>t" "g y = x" by auto
15.5370 + then obtain x' where x':"x'\<in>s" "f x' = y" using assms(3) by auto
15.5371 + hence "x \<in> s" unfolding g_def using someI2[of "\<lambda>b. b\<in>s \<and> f b = y" x' "\<lambda>x. x\<in>s"] unfolding y(2)[THEN sym] and g_def by auto }
15.5372 + ultimately have "x\<in>s \<longleftrightarrow> x \<in> g ` t" by auto }
15.5373 + hence "g ` t = s" by auto
15.5374 + ultimately
15.5375 + show ?thesis unfolding homeomorphism_def homeomorphic_def
15.5376 + apply(rule_tac x=g in exI) using g and assms(3) and continuous_on_inverse[OF assms(2,1), of g, unfolded assms(3)] and assms(2) by auto
15.5377 +qed
15.5378 +
15.5379 +lemma homeomorphic_compact:
15.5380 + fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
15.5381 + (* class constraint due to continuous_on_inverse *)
15.5382 + shows "compact s \<Longrightarrow> continuous_on s f \<Longrightarrow> (f ` s = t) \<Longrightarrow> inj_on f s
15.5383 + \<Longrightarrow> s homeomorphic t"
15.5384 + unfolding homeomorphic_def by(metis homeomorphism_compact)
15.5385 +
15.5386 +text{* Preservation of topological properties. *}
15.5387 +
15.5388 +lemma homeomorphic_compactness:
15.5389 + "s homeomorphic t ==> (compact s \<longleftrightarrow> compact t)"
15.5390 +unfolding homeomorphic_def homeomorphism_def
15.5391 +by (metis compact_continuous_image)
15.5392 +
15.5393 +text{* Results on translation, scaling etc. *}
15.5394 +
15.5395 +lemma homeomorphic_scaling:
15.5396 + fixes s :: "'a::real_normed_vector set"
15.5397 + assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
15.5398 + unfolding homeomorphic_minimal
15.5399 + apply(rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
15.5400 + apply(rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
15.5401 + using assms apply auto
15.5402 + using continuous_on_cmul[OF continuous_on_id] by auto
15.5403 +
15.5404 +lemma homeomorphic_translation:
15.5405 + fixes s :: "'a::real_normed_vector set"
15.5406 + shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
15.5407 + unfolding homeomorphic_minimal
15.5408 + apply(rule_tac x="\<lambda>x. a + x" in exI)
15.5409 + apply(rule_tac x="\<lambda>x. -a + x" in exI)
15.5410 + using continuous_on_add[OF continuous_on_const continuous_on_id] by auto
15.5411 +
15.5412 +lemma homeomorphic_affinity:
15.5413 + fixes s :: "'a::real_normed_vector set"
15.5414 + assumes "c \<noteq> 0" shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
15.5415 +proof-
15.5416 + have *:"op + a ` op *\<^sub>R c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
15.5417 + show ?thesis
15.5418 + using homeomorphic_trans
15.5419 + using homeomorphic_scaling[OF assms, of s]
15.5420 + using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a] unfolding * by auto
15.5421 +qed
15.5422 +
15.5423 +lemma homeomorphic_balls:
15.5424 + fixes a b ::"'a::real_normed_vector" (* FIXME: generalize to metric_space *)
15.5425 + assumes "0 < d" "0 < e"
15.5426 + shows "(ball a d) homeomorphic (ball b e)" (is ?th)
15.5427 + "(cball a d) homeomorphic (cball b e)" (is ?cth)
15.5428 +proof-
15.5429 + have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
15.5430 + show ?th unfolding homeomorphic_minimal
15.5431 + apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
15.5432 + apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
15.5433 + using assms apply (auto simp add: dist_commute)
15.5434 + unfolding dist_norm
15.5435 + apply (auto simp add: pos_divide_less_eq mult_strict_left_mono)
15.5436 + unfolding continuous_on
15.5437 + by (intro ballI tendsto_intros, simp, assumption)+
15.5438 +next
15.5439 + have *:"\<bar>e / d\<bar> > 0" "\<bar>d / e\<bar> >0" using assms using divide_pos_pos by auto
15.5440 + show ?cth unfolding homeomorphic_minimal
15.5441 + apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
15.5442 + apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
15.5443 + using assms apply (auto simp add: dist_commute)
15.5444 + unfolding dist_norm
15.5445 + apply (auto simp add: pos_divide_le_eq)
15.5446 + unfolding continuous_on
15.5447 + by (intro ballI tendsto_intros, simp, assumption)+
15.5448 +qed
15.5449 +
15.5450 +text{* "Isometry" (up to constant bounds) of injective linear map etc. *}
15.5451 +
15.5452 +lemma cauchy_isometric:
15.5453 + fixes x :: "nat \<Rightarrow> real ^ 'n::finite"
15.5454 + assumes e:"0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and xs:"\<forall>n::nat. x n \<in> s" and cf:"Cauchy(f o x)"
15.5455 + shows "Cauchy x"
15.5456 +proof-
15.5457 + interpret f: bounded_linear f by fact
15.5458 + { fix d::real assume "d>0"
15.5459 + then obtain N where N:"\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
15.5460 + using cf[unfolded cauchy o_def dist_norm, THEN spec[where x="e*d"]] and e and mult_pos_pos[of e d] by auto
15.5461 + { fix n assume "n\<ge>N"
15.5462 + hence "norm (f (x n - x N)) < e * d" using N[THEN spec[where x=n]] unfolding f.diff[THEN sym] by auto
15.5463 + moreover have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
15.5464 + using subspace_sub[OF s, of "x n" "x N"] using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
15.5465 + using normf[THEN bspec[where x="x n - x N"]] by auto
15.5466 + ultimately have "norm (x n - x N) < d" using `e>0`
15.5467 + using mult_left_less_imp_less[of e "norm (x n - x N)" d] by auto }
15.5468 + hence "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" by auto }
15.5469 + thus ?thesis unfolding cauchy and dist_norm by auto
15.5470 +qed
15.5471 +
15.5472 +lemma complete_isometric_image:
15.5473 + fixes f :: "real ^ _ \<Rightarrow> real ^ _"
15.5474 + assumes "0 < e" and s:"subspace s" and f:"bounded_linear f" and normf:"\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)" and cs:"complete s"
15.5475 + shows "complete(f ` s)"
15.5476 +proof-
15.5477 + { fix g assume as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g"
15.5478 + then obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)" unfolding image_iff and Bex_def
15.5479 + using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
15.5480 + hence x:"\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
15.5481 + hence "f \<circ> x = g" unfolding expand_fun_eq by auto
15.5482 + then obtain l where "l\<in>s" and l:"(x ---> l) sequentially"
15.5483 + using cs[unfolded complete_def, THEN spec[where x="x"]]
15.5484 + using cauchy_isometric[OF `0<e` s f normf] and cfg and x(1) by auto
15.5485 + hence "\<exists>l\<in>f ` s. (g ---> l) sequentially"
15.5486 + using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
15.5487 + unfolding `f \<circ> x = g` by auto }
15.5488 + thus ?thesis unfolding complete_def by auto
15.5489 +qed
15.5490 +
15.5491 +lemma dist_0_norm:
15.5492 + fixes x :: "'a::real_normed_vector"
15.5493 + shows "dist 0 x = norm x"
15.5494 +unfolding dist_norm by simp
15.5495 +
15.5496 +lemma injective_imp_isometric: fixes f::"real^'m::finite \<Rightarrow> real^'n::finite"
15.5497 + assumes s:"closed s" "subspace s" and f:"bounded_linear f" "\<forall>x\<in>s. (f x = 0) \<longrightarrow> (x = 0)"
15.5498 + shows "\<exists>e>0. \<forall>x\<in>s. norm (f x) \<ge> e * norm(x)"
15.5499 +proof(cases "s \<subseteq> {0::real^'m}")
15.5500 + case True
15.5501 + { fix x assume "x \<in> s"
15.5502 + hence "x = 0" using True by auto
15.5503 + hence "norm x \<le> norm (f x)" by auto }
15.5504 + thus ?thesis by(auto intro!: exI[where x=1])
15.5505 +next
15.5506 + interpret f: bounded_linear f by fact
15.5507 + case False
15.5508 + then obtain a where a:"a\<noteq>0" "a\<in>s" by auto
15.5509 + from False have "s \<noteq> {}" by auto
15.5510 + let ?S = "{f x| x. (x \<in> s \<and> norm x = norm a)}"
15.5511 + let ?S' = "{x::real^'m. x\<in>s \<and> norm x = norm a}"
15.5512 + let ?S'' = "{x::real^'m. norm x = norm a}"
15.5513 +
15.5514 + have "?S'' = frontier(cball 0 (norm a))" unfolding frontier_cball and dist_norm by (auto simp add: norm_minus_cancel)
15.5515 + hence "compact ?S''" using compact_frontier[OF compact_cball, of 0 "norm a"] by auto
15.5516 + moreover have "?S' = s \<inter> ?S''" by auto
15.5517 + ultimately have "compact ?S'" using closed_inter_compact[of s ?S''] using s(1) by auto
15.5518 + moreover have *:"f ` ?S' = ?S" by auto
15.5519 + ultimately have "compact ?S" using compact_continuous_image[OF linear_continuous_on[OF f(1)], of ?S'] by auto
15.5520 + hence "closed ?S" using compact_imp_closed by auto
15.5521 + moreover have "?S \<noteq> {}" using a by auto
15.5522 + 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
15.5523 + 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 *[THEN sym] unfolding image_iff by auto
15.5524 +
15.5525 + let ?e = "norm (f b) / norm b"
15.5526 + have "norm b > 0" using ba and a and norm_ge_zero by auto
15.5527 + moreover have "norm (f b) > 0" using f(2)[THEN bspec[where x=b], OF `b\<in>s`] using `norm b >0` unfolding zero_less_norm_iff by auto
15.5528 + ultimately have "0 < norm (f b) / norm b" by(simp only: divide_pos_pos)
15.5529 + moreover
15.5530 + { fix x assume "x\<in>s"
15.5531 + hence "norm (f b) / norm b * norm x \<le> norm (f x)"
15.5532 + proof(cases "x=0")
15.5533 + case True thus "norm (f b) / norm b * norm x \<le> norm (f x)" by auto
15.5534 + next
15.5535 + case False
15.5536 + hence *:"0 < norm a / norm x" using `a\<noteq>0` unfolding zero_less_norm_iff[THEN sym] by(simp only: divide_pos_pos)
15.5537 + have "\<forall>c. \<forall>x\<in>s. c *\<^sub>R x \<in> s" using s[unfolded subspace_def smult_conv_scaleR] by auto
15.5538 + hence "(norm a / norm x) *\<^sub>R x \<in> {x \<in> s. norm x = norm a}" using `x\<in>s` and `x\<noteq>0` by auto
15.5539 + thus "norm (f b) / norm b * norm x \<le> norm (f x)" using b[THEN bspec[where x="(norm a / norm x) *\<^sub>R x"]]
15.5540 + unfolding f.scaleR and ba using `x\<noteq>0` `a\<noteq>0`
15.5541 + by (auto simp add: real_mult_commute pos_le_divide_eq pos_divide_le_eq)
15.5542 + qed }
15.5543 + ultimately
15.5544 + show ?thesis by auto
15.5545 +qed
15.5546 +
15.5547 +lemma closed_injective_image_subspace:
15.5548 + fixes f :: "real ^ _ \<Rightarrow> real ^ _"
15.5549 + assumes "subspace s" "bounded_linear f" "\<forall>x\<in>s. f x = 0 --> x = 0" "closed s"
15.5550 + shows "closed(f ` s)"
15.5551 +proof-
15.5552 + 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
15.5553 + show ?thesis using complete_isometric_image[OF `e>0` assms(1,2) e] and assms(4)
15.5554 + unfolding complete_eq_closed[THEN sym] by auto
15.5555 +qed
15.5556 +
15.5557 +subsection{* Some properties of a canonical subspace. *}
15.5558 +
15.5559 +lemma subspace_substandard:
15.5560 + "subspace {x::real^'n. (\<forall>i. P i \<longrightarrow> x$i = 0)}"
15.5561 + unfolding subspace_def by(auto simp add: vector_add_component vector_smult_component elim!: ballE)
15.5562 +
15.5563 +lemma closed_substandard:
15.5564 + "closed {x::real^'n::finite. \<forall>i. P i --> x$i = 0}" (is "closed ?A")
15.5565 +proof-
15.5566 + let ?D = "{i. P i}"
15.5567 + let ?Bs = "{{x::real^'n. inner (basis i) x = 0}| i. i \<in> ?D}"
15.5568 + { fix x
15.5569 + { assume "x\<in>?A"
15.5570 + hence x:"\<forall>i\<in>?D. x $ i = 0" by auto
15.5571 + hence "x\<in> \<Inter> ?Bs" by(auto simp add: inner_basis x) }
15.5572 + moreover
15.5573 + { assume x:"x\<in>\<Inter>?Bs"
15.5574 + { fix i assume i:"i \<in> ?D"
15.5575 + then obtain B where BB:"B \<in> ?Bs" and B:"B = {x::real^'n. inner (basis i) x = 0}" by auto
15.5576 + hence "x $ i = 0" unfolding B using x unfolding inner_basis by auto }
15.5577 + hence "x\<in>?A" by auto }
15.5578 + ultimately have "x\<in>?A \<longleftrightarrow> x\<in> \<Inter>?Bs" by auto }
15.5579 + hence "?A = \<Inter> ?Bs" by auto
15.5580 + thus ?thesis by(auto simp add: closed_Inter closed_hyperplane)
15.5581 +qed
15.5582 +
15.5583 +lemma dim_substandard:
15.5584 + shows "dim {x::real^'n::finite. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0} = card d" (is "dim ?A = _")
15.5585 +proof-
15.5586 + let ?D = "UNIV::'n set"
15.5587 + let ?B = "(basis::'n\<Rightarrow>real^'n) ` d"
15.5588 +
15.5589 + let ?bas = "basis::'n \<Rightarrow> real^'n"
15.5590 +
15.5591 + have "?B \<subseteq> ?A" by auto
15.5592 +
15.5593 + moreover
15.5594 + { fix x::"real^'n" assume "x\<in>?A"
15.5595 + with finite[of d]
15.5596 + have "x\<in> span ?B"
15.5597 + proof(induct d arbitrary: x)
15.5598 + case empty hence "x=0" unfolding Cart_eq by auto
15.5599 + thus ?case using subspace_0[OF subspace_span[of "{}"]] by auto
15.5600 + next
15.5601 + case (insert k F)
15.5602 + hence *:"\<forall>i. i \<notin> insert k F \<longrightarrow> x $ i = 0" by auto
15.5603 + have **:"F \<subseteq> insert k F" by auto
15.5604 + def y \<equiv> "x - x$k *\<^sub>R basis k"
15.5605 + have y:"x = y + (x$k) *\<^sub>R basis k" unfolding y_def by auto
15.5606 + { fix i assume i':"i \<notin> F"
15.5607 + hence "y $ i = 0" unfolding y_def unfolding vector_minus_component
15.5608 + and vector_smult_component and basis_component
15.5609 + using *[THEN spec[where x=i]] by auto }
15.5610 + hence "y \<in> span (basis ` (insert k F))" using insert(3)
15.5611 + using span_mono[of "?bas ` F" "?bas ` (insert k F)"]
15.5612 + using image_mono[OF **, of basis] by auto
15.5613 + moreover
15.5614 + have "basis k \<in> span (?bas ` (insert k F))" by(rule span_superset, auto)
15.5615 + hence "x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
15.5616 + using span_mul [where 'a=real, unfolded smult_conv_scaleR] by auto
15.5617 + ultimately
15.5618 + have "y + x$k *\<^sub>R basis k \<in> span (?bas ` (insert k F))"
15.5619 + using span_add by auto
15.5620 + thus ?case using y by auto
15.5621 + qed
15.5622 + }
15.5623 + hence "?A \<subseteq> span ?B" by auto
15.5624 +
15.5625 + moreover
15.5626 + { fix x assume "x \<in> ?B"
15.5627 + hence "x\<in>{(basis i)::real^'n |i. i \<in> ?D}" using assms by auto }
15.5628 + hence "independent ?B" using independent_mono[OF independent_stdbasis, of ?B] and assms by auto
15.5629 +
15.5630 + moreover
15.5631 + have "d \<subseteq> ?D" unfolding subset_eq using assms by auto
15.5632 + hence *:"inj_on (basis::'n\<Rightarrow>real^'n) d" using subset_inj_on[OF basis_inj, of "d"] by auto
15.5633 + have "?B hassize (card d)" unfolding hassize_def and card_image[OF *] by auto
15.5634 +
15.5635 + ultimately show ?thesis using dim_unique[of "basis ` d" ?A] by auto
15.5636 +qed
15.5637 +
15.5638 +text{* Hence closure and completeness of all subspaces. *}
15.5639 +
15.5640 +lemma closed_subspace_lemma: "n \<le> card (UNIV::'n::finite set) \<Longrightarrow> \<exists>A::'n set. card A = n"
15.5641 +apply (induct n)
15.5642 +apply (rule_tac x="{}" in exI, simp)
15.5643 +apply clarsimp
15.5644 +apply (subgoal_tac "\<exists>x. x \<notin> A")
15.5645 +apply (erule exE)
15.5646 +apply (rule_tac x="insert x A" in exI, simp)
15.5647 +apply (subgoal_tac "A \<noteq> UNIV", auto)
15.5648 +done
15.5649 +
15.5650 +lemma closed_subspace: fixes s::"(real^'n::finite) set"
15.5651 + assumes "subspace s" shows "closed s"
15.5652 +proof-
15.5653 + have "dim s \<le> card (UNIV :: 'n set)" using dim_subset_univ by auto
15.5654 + then obtain d::"'n set" where t: "card d = dim s"
15.5655 + using closed_subspace_lemma by auto
15.5656 + let ?t = "{x::real^'n. \<forall>i. i \<notin> d \<longrightarrow> x$i = 0}"
15.5657 + obtain f where f:"bounded_linear f" "f ` ?t = s" "inj_on f ?t"
15.5658 + using subspace_isomorphism[unfolded linear_conv_bounded_linear, OF subspace_substandard[of "\<lambda>i. i \<notin> d"] assms]
15.5659 + using dim_substandard[of d] and t by auto
15.5660 + interpret f: bounded_linear f by fact
15.5661 + have "\<forall>x\<in>?t. f x = 0 \<longrightarrow> x = 0" using f.zero using f(3)[unfolded inj_on_def]
15.5662 + by(erule_tac x=0 in ballE) auto
15.5663 + moreover have "closed ?t" using closed_substandard .
15.5664 + moreover have "subspace ?t" using subspace_substandard .
15.5665 + ultimately show ?thesis using closed_injective_image_subspace[of ?t f]
15.5666 + unfolding f(2) using f(1) by auto
15.5667 +qed
15.5668 +
15.5669 +lemma complete_subspace:
15.5670 + fixes s :: "(real ^ _) set" shows "subspace s ==> complete s"
15.5671 + using complete_eq_closed closed_subspace
15.5672 + by auto
15.5673 +
15.5674 +lemma dim_closure:
15.5675 + fixes s :: "(real ^ _) set"
15.5676 + shows "dim(closure s) = dim s" (is "?dc = ?d")
15.5677 +proof-
15.5678 + have "?dc \<le> ?d" using closure_minimal[OF span_inc, of s]
15.5679 + using closed_subspace[OF subspace_span, of s]
15.5680 + using dim_subset[of "closure s" "span s"] unfolding dim_span by auto
15.5681 + thus ?thesis using dim_subset[OF closure_subset, of s] by auto
15.5682 +qed
15.5683 +
15.5684 +text{* Affine transformations of intervals. *}
15.5685 +
15.5686 +lemma affinity_inverses:
15.5687 + assumes m0: "m \<noteq> (0::'a::field)"
15.5688 + shows "(\<lambda>x. m *s x + c) o (\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) = id"
15.5689 + "(\<lambda>x. inverse(m) *s x + (-(inverse(m) *s c))) o (\<lambda>x. m *s x + c) = id"
15.5690 + using m0
15.5691 +apply (auto simp add: expand_fun_eq vector_add_ldistrib vector_smult_assoc)
15.5692 +by (simp add: vector_smult_lneg[symmetric] vector_smult_assoc vector_sneg_minus1[symmetric])
15.5693 +
15.5694 +lemma real_affinity_le:
15.5695 + "0 < (m::'a::ordered_field) ==> (m * x + c \<le> y \<longleftrightarrow> x \<le> inverse(m) * y + -(c / m))"
15.5696 + by (simp add: field_simps inverse_eq_divide)
15.5697 +
15.5698 +lemma real_le_affinity:
15.5699 + "0 < (m::'a::ordered_field) ==> (y \<le> m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) \<le> x)"
15.5700 + by (simp add: field_simps inverse_eq_divide)
15.5701 +
15.5702 +lemma real_affinity_lt:
15.5703 + "0 < (m::'a::ordered_field) ==> (m * x + c < y \<longleftrightarrow> x < inverse(m) * y + -(c / m))"
15.5704 + by (simp add: field_simps inverse_eq_divide)
15.5705 +
15.5706 +lemma real_lt_affinity:
15.5707 + "0 < (m::'a::ordered_field) ==> (y < m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) < x)"
15.5708 + by (simp add: field_simps inverse_eq_divide)
15.5709 +
15.5710 +lemma real_affinity_eq:
15.5711 + "(m::'a::ordered_field) \<noteq> 0 ==> (m * x + c = y \<longleftrightarrow> x = inverse(m) * y + -(c / m))"
15.5712 + by (simp add: field_simps inverse_eq_divide)
15.5713 +
15.5714 +lemma real_eq_affinity:
15.5715 + "(m::'a::ordered_field) \<noteq> 0 ==> (y = m * x + c \<longleftrightarrow> inverse(m) * y + -(c / m) = x)"
15.5716 + by (simp add: field_simps inverse_eq_divide)
15.5717 +
15.5718 +lemma vector_affinity_eq:
15.5719 + assumes m0: "(m::'a::field) \<noteq> 0"
15.5720 + shows "m *s x + c = y \<longleftrightarrow> x = inverse m *s y + -(inverse m *s c)"
15.5721 +proof
15.5722 + assume h: "m *s x + c = y"
15.5723 + hence "m *s x = y - c" by (simp add: ring_simps)
15.5724 + hence "inverse m *s (m *s x) = inverse m *s (y - c)" by simp
15.5725 + then show "x = inverse m *s y + - (inverse m *s c)"
15.5726 + using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
15.5727 +next
15.5728 + assume h: "x = inverse m *s y + - (inverse m *s c)"
15.5729 + show "m *s x + c = y" unfolding h diff_minus[symmetric]
15.5730 + using m0 by (simp add: vector_smult_assoc vector_ssub_ldistrib)
15.5731 +qed
15.5732 +
15.5733 +lemma vector_eq_affinity:
15.5734 + "(m::'a::field) \<noteq> 0 ==> (y = m *s x + c \<longleftrightarrow> inverse(m) *s y + -(inverse(m) *s c) = x)"
15.5735 + using vector_affinity_eq[where m=m and x=x and y=y and c=c]
15.5736 + by metis
15.5737 +
15.5738 +lemma image_affinity_interval: fixes m::real
15.5739 + fixes a b c :: "real^'n::finite"
15.5740 + shows "(\<lambda>x. m *\<^sub>R x + c) ` {a .. b} =
15.5741 + (if {a .. b} = {} then {}
15.5742 + else (if 0 \<le> m then {m *\<^sub>R a + c .. m *\<^sub>R b + c}
15.5743 + else {m *\<^sub>R b + c .. m *\<^sub>R a + c}))"
15.5744 +proof(cases "m=0")
15.5745 + { fix x assume "x \<le> c" "c \<le> x"
15.5746 + hence "x=c" unfolding vector_less_eq_def and Cart_eq by (auto intro: order_antisym) }
15.5747 + moreover case True
15.5748 + moreover have "c \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}" unfolding True by(auto simp add: vector_less_eq_def)
15.5749 + ultimately show ?thesis by auto
15.5750 +next
15.5751 + case False
15.5752 + { fix y assume "a \<le> y" "y \<le> b" "m > 0"
15.5753 + hence "m *\<^sub>R a + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R b + c"
15.5754 + unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component)
15.5755 + } moreover
15.5756 + { fix y assume "a \<le> y" "y \<le> b" "m < 0"
15.5757 + hence "m *\<^sub>R b + c \<le> m *\<^sub>R y + c" "m *\<^sub>R y + c \<le> m *\<^sub>R a + c"
15.5758 + unfolding vector_less_eq_def by(auto simp add: vector_smult_component vector_add_component mult_left_mono_neg elim!:ballE)
15.5759 + } moreover
15.5760 + { fix y assume "m > 0" "m *\<^sub>R a + c \<le> y" "y \<le> m *\<^sub>R b + c"
15.5761 + hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
15.5762 + unfolding image_iff Bex_def mem_interval vector_less_eq_def
15.5763 + apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
15.5764 + intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
15.5765 + by(auto simp add: pos_le_divide_eq pos_divide_le_eq real_mult_commute diff_le_iff)
15.5766 + } moreover
15.5767 + { fix y assume "m *\<^sub>R b + c \<le> y" "y \<le> m *\<^sub>R a + c" "m < 0"
15.5768 + hence "y \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}"
15.5769 + unfolding image_iff Bex_def mem_interval vector_less_eq_def
15.5770 + apply(auto simp add: vector_smult_component vector_add_component vector_minus_component vector_smult_assoc pth_3[symmetric]
15.5771 + intro!: exI[where x="(1 / m) *\<^sub>R (y - c)"])
15.5772 + by(auto simp add: neg_le_divide_eq neg_divide_le_eq real_mult_commute diff_le_iff)
15.5773 + }
15.5774 + ultimately show ?thesis using False by auto
15.5775 +qed
15.5776 +
15.5777 +lemma image_smult_interval:"(\<lambda>x. m *\<^sub>R (x::real^'n::finite)) ` {a..b} =
15.5778 + (if {a..b} = {} then {} else if 0 \<le> m then {m *\<^sub>R a..m *\<^sub>R b} else {m *\<^sub>R b..m *\<^sub>R a})"
15.5779 + using image_affinity_interval[of m 0 a b] by auto
15.5780 +
15.5781 +subsection{* Banach fixed point theorem (not really topological...) *}
15.5782 +
15.5783 +lemma banach_fix:
15.5784 + assumes s:"complete s" "s \<noteq> {}" and c:"0 \<le> c" "c < 1" and f:"(f ` s) \<subseteq> s" and
15.5785 + lipschitz:"\<forall>x\<in>s. \<forall>y\<in>s. dist (f x) (f y) \<le> c * dist x y"
15.5786 + shows "\<exists>! x\<in>s. (f x = x)"
15.5787 +proof-
15.5788 + have "1 - c > 0" using c by auto
15.5789 +
15.5790 + from s(2) obtain z0 where "z0 \<in> s" by auto
15.5791 + def z \<equiv> "\<lambda>n. (f ^^ n) z0"
15.5792 + { fix n::nat
15.5793 + have "z n \<in> s" unfolding z_def
15.5794 + proof(induct n) case 0 thus ?case using `z0 \<in>s` by auto
15.5795 + next case Suc thus ?case using f by auto qed }
15.5796 + note z_in_s = this
15.5797 +
15.5798 + def d \<equiv> "dist (z 0) (z 1)"
15.5799 +
15.5800 + have fzn:"\<And>n. f (z n) = z (Suc n)" unfolding z_def by auto
15.5801 + { fix n::nat
15.5802 + have "dist (z n) (z (Suc n)) \<le> (c ^ n) * d"
15.5803 + proof(induct n)
15.5804 + case 0 thus ?case unfolding d_def by auto
15.5805 + next
15.5806 + case (Suc m)
15.5807 + hence "c * dist (z m) (z (Suc m)) \<le> c ^ Suc m * d"
15.5808 + using `0 \<le> c` using mult_mono1_class.mult_mono1[of "dist (z m) (z (Suc m))" "c ^ m * d" c] by auto
15.5809 + thus ?case using lipschitz[THEN bspec[where x="z m"], OF z_in_s, THEN bspec[where x="z (Suc m)"], OF z_in_s]
15.5810 + unfolding fzn and mult_le_cancel_left by auto
15.5811 + qed
15.5812 + } note cf_z = this
15.5813 +
15.5814 + { fix n m::nat
15.5815 + have "(1 - c) * dist (z m) (z (m+n)) \<le> (c ^ m) * d * (1 - c ^ n)"
15.5816 + proof(induct n)
15.5817 + case 0 show ?case by auto
15.5818 + next
15.5819 + case (Suc k)
15.5820 + have "(1 - c) * dist (z m) (z (m + Suc k)) \<le> (1 - c) * (dist (z m) (z (m + k)) + dist (z (m + k)) (z (Suc (m + k))))"
15.5821 + using dist_triangle and c by(auto simp add: dist_triangle)
15.5822 + also have "\<dots> \<le> (1 - c) * (dist (z m) (z (m + k)) + c ^ (m + k) * d)"
15.5823 + using cf_z[of "m + k"] and c by auto
15.5824 + also have "\<dots> \<le> c ^ m * d * (1 - c ^ k) + (1 - c) * c ^ (m + k) * d"
15.5825 + using Suc by (auto simp add: ring_simps)
15.5826 + also have "\<dots> = (c ^ m) * (d * (1 - c ^ k) + (1 - c) * c ^ k * d)"
15.5827 + unfolding power_add by (auto simp add: ring_simps)
15.5828 + also have "\<dots> \<le> (c ^ m) * d * (1 - c ^ Suc k)"
15.5829 + using c by (auto simp add: ring_simps)
15.5830 + finally show ?case by auto
15.5831 + qed
15.5832 + } note cf_z2 = this
15.5833 + { fix e::real assume "e>0"
15.5834 + hence "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (z m) (z n) < e"
15.5835 + proof(cases "d = 0")
15.5836 + case True
15.5837 + hence "\<And>n. z n = z0" using cf_z2[of 0] and c unfolding z_def by (auto simp add: pos_prod_le[OF `1 - c > 0`])
15.5838 + thus ?thesis using `e>0` by auto
15.5839 + next
15.5840 + case False hence "d>0" unfolding d_def using zero_le_dist[of "z 0" "z 1"]
15.5841 + by (metis False d_def real_less_def)
15.5842 + hence "0 < e * (1 - c) / d" using `e>0` and `1-c>0`
15.5843 + using divide_pos_pos[of "e * (1 - c)" d] and mult_pos_pos[of e "1 - c"] by auto
15.5844 + then obtain N where N:"c ^ N < e * (1 - c) / d" using real_arch_pow_inv[of "e * (1 - c) / d" c] and c by auto
15.5845 + { fix m n::nat assume "m>n" and as:"m\<ge>N" "n\<ge>N"
15.5846 + have *:"c ^ n \<le> c ^ N" using `n\<ge>N` and c using power_decreasing[OF `n\<ge>N`, of c] by auto
15.5847 + have "1 - c ^ (m - n) > 0" using c and power_strict_mono[of c 1 "m - n"] using `m>n` by auto
15.5848 + hence **:"d * (1 - c ^ (m - n)) / (1 - c) > 0"
15.5849 + using real_mult_order[OF `d>0`, of "1 - c ^ (m - n)"]
15.5850 + using divide_pos_pos[of "d * (1 - c ^ (m - n))" "1 - c"]
15.5851 + using `0 < 1 - c` by auto
15.5852 +
15.5853 + have "dist (z m) (z n) \<le> c ^ n * d * (1 - c ^ (m - n)) / (1 - c)"
15.5854 + using cf_z2[of n "m - n"] and `m>n` unfolding pos_le_divide_eq[OF `1-c>0`]
15.5855 + by (auto simp add: real_mult_commute dist_commute)
15.5856 + also have "\<dots> \<le> c ^ N * d * (1 - c ^ (m - n)) / (1 - c)"
15.5857 + using mult_right_mono[OF * order_less_imp_le[OF **]]
15.5858 + unfolding real_mult_assoc by auto
15.5859 + also have "\<dots> < (e * (1 - c) / d) * d * (1 - c ^ (m - n)) / (1 - c)"
15.5860 + using mult_strict_right_mono[OF N **] unfolding real_mult_assoc by auto
15.5861 + also have "\<dots> = e * (1 - c ^ (m - n))" using c and `d>0` and `1 - c > 0` by auto
15.5862 + also have "\<dots> \<le> e" using c and `1 - c ^ (m - n) > 0` and `e>0` using mult_right_le_one_le[of e "1 - c ^ (m - n)"] by auto
15.5863 + finally have "dist (z m) (z n) < e" by auto
15.5864 + } note * = this
15.5865 + { fix m n::nat assume as:"N\<le>m" "N\<le>n"
15.5866 + hence "dist (z n) (z m) < e"
15.5867 + proof(cases "n = m")
15.5868 + case True thus ?thesis using `e>0` by auto
15.5869 + next
15.5870 + case False thus ?thesis using as and *[of n m] *[of m n] unfolding nat_neq_iff by (auto simp add: dist_commute)
15.5871 + qed }
15.5872 + thus ?thesis by auto
15.5873 + qed
15.5874 + }
15.5875 + hence "Cauchy z" unfolding cauchy_def by auto
15.5876 + then obtain x where "x\<in>s" and x:"(z ---> x) sequentially" using s(1)[unfolded compact_def complete_def, THEN spec[where x=z]] and z_in_s by auto
15.5877 +
15.5878 + def e \<equiv> "dist (f x) x"
15.5879 + have "e = 0" proof(rule ccontr)
15.5880 + assume "e \<noteq> 0" hence "e>0" unfolding e_def using zero_le_dist[of "f x" x]
15.5881 + by (metis dist_eq_0_iff dist_nz e_def)
15.5882 + then obtain N where N:"\<forall>n\<ge>N. dist (z n) x < e / 2"
15.5883 + using x[unfolded Lim_sequentially, THEN spec[where x="e/2"]] by auto
15.5884 + hence N':"dist (z N) x < e / 2" by auto
15.5885 +
15.5886 + have *:"c * dist (z N) x \<le> dist (z N) x" unfolding mult_le_cancel_right2
15.5887 + using zero_le_dist[of "z N" x] and c
15.5888 + by (metis dist_eq_0_iff dist_nz order_less_asym real_less_def)
15.5889 + have "dist (f (z N)) (f x) \<le> c * dist (z N) x" using lipschitz[THEN bspec[where x="z N"], THEN bspec[where x=x]]
15.5890 + using z_in_s[of N] `x\<in>s` using c by auto
15.5891 + also have "\<dots> < e / 2" using N' and c using * by auto
15.5892 + finally show False unfolding fzn
15.5893 + using N[THEN spec[where x="Suc N"]] and dist_triangle_half_r[of "z (Suc N)" "f x" e x]
15.5894 + unfolding e_def by auto
15.5895 + qed
15.5896 + hence "f x = x" unfolding e_def by auto
15.5897 + moreover
15.5898 + { fix y assume "f y = y" "y\<in>s"
15.5899 + hence "dist x y \<le> c * dist x y" using lipschitz[THEN bspec[where x=x], THEN bspec[where x=y]]
15.5900 + using `x\<in>s` and `f x = x` by auto
15.5901 + hence "dist x y = 0" unfolding mult_le_cancel_right1
15.5902 + using c and zero_le_dist[of x y] by auto
15.5903 + hence "y = x" by auto
15.5904 + }
15.5905 + ultimately show ?thesis unfolding Bex1_def using `x\<in>s` by blast+
15.5906 +qed
15.5907 +
15.5908 +subsection{* Edelstein fixed point theorem. *}
15.5909 +
15.5910 +lemma edelstein_fix:
15.5911 + fixes s :: "'a::real_normed_vector set"
15.5912 + assumes s:"compact s" "s \<noteq> {}" and gs:"(g ` s) \<subseteq> s"
15.5913 + and dist:"\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<longrightarrow> dist (g x) (g y) < dist x y"
15.5914 + shows "\<exists>! x\<in>s. g x = x"
15.5915 +proof(cases "\<exists>x\<in>s. g x \<noteq> x")
15.5916 + obtain x where "x\<in>s" using s(2) by auto
15.5917 + case False hence g:"\<forall>x\<in>s. g x = x" by auto
15.5918 + { fix y assume "y\<in>s"
15.5919 + hence "x = y" using `x\<in>s` and dist[THEN bspec[where x=x], THEN bspec[where x=y]]
15.5920 + unfolding g[THEN bspec[where x=x], OF `x\<in>s`]
15.5921 + unfolding g[THEN bspec[where x=y], OF `y\<in>s`] by auto }
15.5922 + thus ?thesis unfolding Bex1_def using `x\<in>s` and g by blast+
15.5923 +next
15.5924 + case True
15.5925 + then obtain x where [simp]:"x\<in>s" and "g x \<noteq> x" by auto
15.5926 + { fix x y assume "x \<in> s" "y \<in> s"
15.5927 + hence "dist (g x) (g y) \<le> dist x y"
15.5928 + using dist[THEN bspec[where x=x], THEN bspec[where x=y]] by auto } note dist' = this
15.5929 + def y \<equiv> "g x"
15.5930 + have [simp]:"y\<in>s" unfolding y_def using gs[unfolded image_subset_iff] and `x\<in>s` by blast
15.5931 + def f \<equiv> "\<lambda>n. g ^^ n"
15.5932 + have [simp]:"\<And>n z. g (f n z) = f (Suc n) z" unfolding f_def by auto
15.5933 + have [simp]:"\<And>z. f 0 z = z" unfolding f_def by auto
15.5934 + { fix n::nat and z assume "z\<in>s"
15.5935 + have "f n z \<in> s" unfolding f_def
15.5936 + proof(induct n)
15.5937 + case 0 thus ?case using `z\<in>s` by simp
15.5938 + next
15.5939 + case (Suc n) thus ?case using gs[unfolded image_subset_iff] by auto
15.5940 + qed } note fs = this
15.5941 + { fix m n ::nat assume "m\<le>n"
15.5942 + fix w z assume "w\<in>s" "z\<in>s"
15.5943 + have "dist (f n w) (f n z) \<le> dist (f m w) (f m z)" using `m\<le>n`
15.5944 + proof(induct n)
15.5945 + case 0 thus ?case by auto
15.5946 + next
15.5947 + case (Suc n)
15.5948 + thus ?case proof(cases "m\<le>n")
15.5949 + case True thus ?thesis using Suc(1)
15.5950 + using dist'[OF fs fs, OF `w\<in>s` `z\<in>s`, of n n] by auto
15.5951 + next
15.5952 + case False hence mn:"m = Suc n" using Suc(2) by simp
15.5953 + show ?thesis unfolding mn by auto
15.5954 + qed
15.5955 + qed } note distf = this
15.5956 +
15.5957 + def h \<equiv> "\<lambda>n. (f n x, f n y)"
15.5958 + let ?s2 = "s \<times> s"
15.5959 + obtain l r where "l\<in>?s2" and r:"subseq r" and lr:"((h \<circ> r) ---> l) sequentially"
15.5960 + using compact_Times [OF s(1) s(1), unfolded compact_def, THEN spec[where x=h]] unfolding h_def
15.5961 + using fs[OF `x\<in>s`] and fs[OF `y\<in>s`] by blast
15.5962 + def a \<equiv> "fst l" def b \<equiv> "snd l"
15.5963 + have lab:"l = (a, b)" unfolding a_def b_def by simp
15.5964 + have [simp]:"a\<in>s" "b\<in>s" unfolding a_def b_def using `l\<in>?s2` by auto
15.5965 +
15.5966 + have lima:"((fst \<circ> (h \<circ> r)) ---> a) sequentially"
15.5967 + and limb:"((snd \<circ> (h \<circ> r)) ---> b) sequentially"
15.5968 + using lr
15.5969 + unfolding o_def a_def b_def by (simp_all add: tendsto_intros)
15.5970 +
15.5971 + { fix n::nat
15.5972 + have *:"\<And>fx fy (x::'a) y. dist fx fy \<le> dist x y \<Longrightarrow> \<not> (dist (fx - fy) (a - b) < dist a b - dist x y)" unfolding dist_norm by norm
15.5973 + { fix x y :: 'a
15.5974 + have "dist (-x) (-y) = dist x y" unfolding dist_norm
15.5975 + using norm_minus_cancel[of "x - y"] by (auto simp add: uminus_add_conv_diff) } note ** = this
15.5976 +
15.5977 + { assume as:"dist a b > dist (f n x) (f n y)"
15.5978 + then obtain Na Nb where "\<forall>m\<ge>Na. dist (f (r m) x) a < (dist a b - dist (f n x) (f n y)) / 2"
15.5979 + and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
15.5980 + using lima limb unfolding h_def Lim_sequentially by (fastsimp simp del: less_divide_eq_number_of1)
15.5981 + hence "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) < dist a b - dist (f n x) (f n y)"
15.5982 + apply(erule_tac x="Na+Nb+n" in allE)
15.5983 + apply(erule_tac x="Na+Nb+n" in allE) apply simp
15.5984 + using dist_triangle_add_half[of a "f (r (Na + Nb + n)) x" "dist a b - dist (f n x) (f n y)"
15.5985 + "-b" "- f (r (Na + Nb + n)) y"]
15.5986 + unfolding ** unfolding group_simps(12) by (auto simp add: dist_commute)
15.5987 + moreover
15.5988 + have "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) \<ge> dist a b - dist (f n x) (f n y)"
15.5989 + using distf[of n "r (Na+Nb+n)", OF _ `x\<in>s` `y\<in>s`]
15.5990 + using subseq_bigger[OF r, of "Na+Nb+n"]
15.5991 + using *[of "f (r (Na + Nb + n)) x" "f (r (Na + Nb + n)) y" "f n x" "f n y"] by auto
15.5992 + ultimately have False by simp
15.5993 + }
15.5994 + hence "dist a b \<le> dist (f n x) (f n y)" by(rule ccontr)auto }
15.5995 + note ab_fn = this
15.5996 +
15.5997 + have [simp]:"a = b" proof(rule ccontr)
15.5998 + def e \<equiv> "dist a b - dist (g a) (g b)"
15.5999 + assume "a\<noteq>b" hence "e > 0" unfolding e_def using dist by fastsimp
15.6000 + hence "\<exists>n. dist (f n x) a < e/2 \<and> dist (f n y) b < e/2"
15.6001 + using lima limb unfolding Lim_sequentially
15.6002 + apply (auto elim!: allE[where x="e/2"]) apply(rule_tac x="r (max N Na)" in exI) unfolding h_def by fastsimp
15.6003 + then obtain n where n:"dist (f n x) a < e/2 \<and> dist (f n y) b < e/2" by auto
15.6004 + have "dist (f (Suc n) x) (g a) \<le> dist (f n x) a"
15.6005 + using dist[THEN bspec[where x="f n x"], THEN bspec[where x="a"]] and fs by auto
15.6006 + moreover have "dist (f (Suc n) y) (g b) \<le> dist (f n y) b"
15.6007 + using dist[THEN bspec[where x="f n y"], THEN bspec[where x="b"]] and fs by auto
15.6008 + ultimately have "dist (f (Suc n) x) (g a) + dist (f (Suc n) y) (g b) < e" using n by auto
15.6009 + thus False unfolding e_def using ab_fn[of "Suc n"] by norm
15.6010 + qed
15.6011 +
15.6012 + have [simp]:"\<And>n. f (Suc n) x = f n y" unfolding f_def y_def by(induct_tac n)auto
15.6013 + { fix x y assume "x\<in>s" "y\<in>s" moreover
15.6014 + fix e::real assume "e>0" ultimately
15.6015 + have "dist y x < e \<longrightarrow> dist (g y) (g x) < e" using dist by fastsimp }
15.6016 + hence "continuous_on s g" unfolding continuous_on_def by auto
15.6017 +
15.6018 + hence "((snd \<circ> h \<circ> r) ---> g a) sequentially" unfolding continuous_on_sequentially
15.6019 + apply (rule allE[where x="\<lambda>n. (fst \<circ> h \<circ> r) n"]) apply (erule ballE[where x=a])
15.6020 + using lima unfolding h_def o_def using fs[OF `x\<in>s`] by (auto simp add: y_def)
15.6021 + hence "g a = a" using Lim_unique[OF trivial_limit_sequentially limb, of "g a"]
15.6022 + unfolding `a=b` and o_assoc by auto
15.6023 + moreover
15.6024 + { fix x assume "x\<in>s" "g x = x" "x\<noteq>a"
15.6025 + hence "False" using dist[THEN bspec[where x=a], THEN bspec[where x=x]]
15.6026 + using `g a = a` and `a\<in>s` by auto }
15.6027 + ultimately show "\<exists>!x\<in>s. g x = x" unfolding Bex1_def using `a\<in>s` by blast
15.6028 +qed
15.6029 +
15.6030 +end